/[RFID]/3m-810.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /3m-810.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 42 by dpavlin, Thu Jun 4 13:52:10 2009 UTC revision 75 by dpavlin, Thu Feb 11 22:12:34 2010 UTC
# Line 8  use Data::Dump qw/dump/; Line 8  use Data::Dump qw/dump/;
8  use Carp qw/confess/;  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10  use File::Slurp;  use File::Slurp;
11    use JSON;
12    use POSIX qw(strftime);
13    
14  use IO::Socket::INET;  use IO::Socket::INET;
15    
16  my $meteor_server = '192.168.1.13:4671';  my $debug = 0;
17  my $meteor_fh;  
18    my $tags_data;
19    my $tags_security;
20    my $visible_tags;
21    
22    my $listen_port = 9000;                  # pick something not in use
23    my $server_url  = "http://localhost:$listen_port";
24    
25    sub http_server {
26    
27            my $server = IO::Socket::INET->new(
28                    Proto     => 'tcp',
29                    LocalPort => $listen_port,
30                    Listen    => SOMAXCONN,
31                    Reuse     => 1
32            );
33                                                                      
34            die "can't setup server" unless $server;
35    
36            print "Server $0 ready at $server_url\n";
37    
38  sub meteor {          sub static {
39          my @a = @_;                  my ($client,$path) = @_;
40          push @a, scalar localtime() if $a[0] =~ m{^info};  
41                    $path = "www/$path";
42          if ( ! defined $meteor_fh ) {                  $path .= 'rfid.html' if $path =~ m{/$};
43                  if ( $meteor_fh =  
44                                  IO::Socket::INET->new(                  return unless -e $path;
45                                          PeerAddr => $meteor_server,  
46                                          Timeout => 1,                  my $type = 'text/plain';
47                                  )                  $type = 'text/html' if $path =~ m{\.htm};
48                  ) {                  $type = 'application/javascript' if $path =~ m{\.js};
49                          warn "# meteor connected to $meteor_server";  
50                    print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\n\r\n";
51                    open(my $html, $path);
52                    while(<$html>) {
53                            print $client $_;
54                    }
55                    close($html);
56    
57                    return $path;
58            }
59    
60            while (my $client = $server->accept()) {
61                    $client->autoflush(1);
62                    my $request = <$client>;
63    
64                    warn "WEB << $request\n" if $debug;
65    
66                    if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
67                            my $method = $1;
68                            my $param;
69                            if ( $method =~ s{\?(.+)}{} ) {
70                                    foreach my $p ( split(/[&;]/, $1) ) {
71                                            my ($n,$v) = split(/=/, $p, 2);
72                                            $param->{$n} = $v;
73                                    }
74                                    warn "WEB << param: ",dump( $param ) if $debug;
75                            }
76                            if ( my $path = static( $client,$1 ) ) {
77                                    warn "WEB >> $path" if $debug;
78                            } elsif ( $method =~ m{/scan} ) {
79                                    my $tags = scan_for_tags();
80                                    my $json = { time => time() };
81                                    map {
82                                            my $d = decode_tag($_);
83                                            $d->{sid} = $_;
84                                            $d->{security} = $tags_security->{$_};
85                                            push @{ $json->{tags} },  $d;
86                                    } keys %$tags;
87                                    print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
88                                            $param->{callback}, "(", to_json($json), ")\r\n";
89                            } elsif ( $method =~ m{/program} ) {
90    
91                                    my $status = 501; # Not implementd
92    
93                                    foreach my $p ( keys %$param ) {
94                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
95                                            my $tag = $1;
96                                            my $content = "\x04\x11\x00\x01" . $param->{$p};
97                                            $content = "\x00" if $param->{$p} eq 'blank';
98                                            $status = 302;
99    
100                                            warn "PROGRAM $tag $content\n";
101                                            write_tag( $tag, $content );
102                                            secure_tag_with( $tag, $param->{$p} =~ /^130/ ? 'DA' : 'D7' );
103                                    }
104    
105                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
106    
107                            } elsif ( $method =~ m{/secure(.js)} ) {
108    
109                                    my $json = $1;
110    
111                                    my $status = 501; # Not implementd
112    
113                                    foreach my $p ( keys %$param ) {
114                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
115                                            my $tag = $1;
116                                            my $data = $param->{$p};
117                                            $status = 302;
118    
119                                            warn "SECURE $tag $data\n";
120                                            secure_tag_with( $tag, $data );
121                                    }
122    
123                                    if ( $json ) {
124                                            print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
125                                                    $param->{callback}, "({ ok: 1 })\r\n";
126                                    } else {
127                                            print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
128                                    }
129    
130                            } else {
131                                    print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
132                            }
133                  } else {                  } else {
134                          warn "can't connect to meteor $meteor_server: $!";                          print $client "HTTP/1.0 500 No method\r\n\r\n";
                         $meteor_fh = 0;  
135                  }                  }
136                    close $client;
137          }          }
138    
139          if ( $meteor_fh ) {          die "server died";
140                  warn ">> meteor ",dump( @a );  }
141                  print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n"  
142    
143    my $last_message = {};
144    sub _message {
145            my $type = shift @_;
146            my $text = join(' ',@_);
147            my $last = $last_message->{$type};
148            if ( $text ne $last ) {
149                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
150                    $last_message->{$type} = $text;
151          }          }
152  }  }
153    
154  my $debug = 0;  sub _log { _message('log',@_) };
155    sub diag { _message('diag',@_) };
156    
157  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
158  my $baudrate  = "19200";  my $baudrate  = "19200";
# Line 50  my $handshake = "none"; Line 164  my $handshake = "none";
164  my $program_path = './program/';  my $program_path = './program/';
165  my $secure_path = './secure/';  my $secure_path = './secure/';
166    
167    # http server
168    my $http_server = 1;
169    
170  # 3M defaults: 8,4  # 3M defaults: 8,4
171  my $max_rfid_block = 16;  # cards 16, stickers: 8
172    my $max_rfid_block = 8;
173  my $read_blocks = 8;  my $read_blocks = 8;
174    
175  my $response = {  my $response = {
# Line 74  GetOptions( Line 192  GetOptions(
192          'parity=s'    => \$parity,          'parity=s'    => \$parity,
193          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
194          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
195          'meteor=s'    => \$meteor_server,          'http-server!' => \$http_server,
196  ) or die $!;  ) or die $!;
197    
198  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 110  it under the same terms ans Perl itself. Line 228  it under the same terms ans Perl itself.
228    
229  =cut  =cut
230    
 my $tags_data;  
 my $visible_tags;  
   
231  my $item_type = {  my $item_type = {
232          1 => 'Book',          1 => 'Book',
233          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 138  $databits=$port->databits($databits); Line 253  $databits=$port->databits($databits);
253  $parity=$port->parity($parity);  $parity=$port->parity($parity);
254  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
255    
256  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
257    
258  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
259  $port->lookclear();  $port->lookclear();
# Line 155  cmd( 'D5 00  05   04 00 11 Line 270  cmd( 'D5 00  05   04 00 11
270       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
271          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
272          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
273  });  });
274    
275  cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',  cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',
276       'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );       'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );
277    
278  # start scanning for tags  sub scan_for_tags {
279    
280  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          my @tags;
          'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8  
                 my $rest = shift || die "no rest?";  
                 my $nr = ord( substr( $rest, 0, 1 ) );  
   
                 if ( ! $nr ) {  
                         print "no tags in range\n";  
                         update_visible_tags();  
                         meteor( 'info-none-in-range' );  
                         $tags_data = {};  
                 } else {  
281    
282                          my $tags = substr( $rest, 1 );          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
283                     'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
284                            my $rest = shift || die "no rest?";
285                            my $nr = ord( substr( $rest, 0, 1 ) );
286    
287                            if ( ! $nr ) {
288                                    _log "no tags in range\n";
289                                    update_visible_tags();
290                                    $tags_data = {};
291                            } else {
292    
293                                    my $tags = substr( $rest, 1 );
294                                    my $tl = length( $tags );
295                                    die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
296    
297                                    push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
298                                    warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
299                                    _log "$nr tags in range: ", join(',', @tags ) , "\n";
300    
301                                    update_visible_tags( @tags );
302                            }
303                    }
304            );
305    
306                          my $tl = length( $tags );          diag "tags: ",dump( @tags );
307                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;          return $tags_data;
308    
309                          my @tags;  }
                         push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );  
                         warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;  
                         print "$nr tags in range: ", join(',', @tags ) , "\n";  
310    
311                          meteor( 'info-in-range', join(' ',@tags));  # start scanning for tags
312    
313                          update_visible_tags( @tags );  if ( $http_server ) {
314                  }          http_server;
315    } else {
316            while (1) {
317                    scan_for_tags;
318                    sleep 1;
319          }          }
320  ) while(1);  }
 #) foreach ( 1 .. 100 );  
   
321    
322    die "over and out";
323    
324  sub update_visible_tags {  sub update_visible_tags {
325          my @tags = @_;          my @tags = @_;
# Line 202  sub update_visible_tags { Line 328  sub update_visible_tags {
328          $visible_tags = {};          $visible_tags = {};
329    
330          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
331                    $visible_tags->{$tag}++;
332                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
333                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
334  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
335                          } else {                          } else {
                                 meteor( 'read', $tag );  
336                                  read_tag( $tag );                                  read_tag( $tag );
337                          }                          }
                         $visible_tags->{$tag}++;  
338                  } else {                  } else {
339                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
340                  }                  }
341                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
342    
343                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
344                                  write_tag( $tag );                                  write_tag( $tag );
345                  }                  }
346                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
347                                  secure_tag( $tag );                                  secure_tag( $tag );
348                  }                  }
349          }          }
350    
351          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
352                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
353                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
354          }          }
355    
356          warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;          warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
# Line 266  sub read_tag_data { Line 388  sub read_tag_data {
388          return $last_block + 1;          return $last_block + 1;
389  }  }
390    
391    my $saved_in_log;
392    
393    sub decode_tag {
394            my $tag = shift;
395    
396            my $data = $tags_data->{$tag} || die "no data for $tag";
397    
398            my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
399            my $hash = {
400                    u1 => $u1,
401                    u2 => $u2,
402                    set => ( $set_item & 0xf0 ) >> 4,
403                    total => ( $set_item & 0x0f ),
404    
405                    type => $type,
406                    content => $content,
407    
408                    branch => $br_lib >> 20,
409                    library => $br_lib & 0x000fffff,
410    
411                    custom => $custom,
412            };
413    
414            if ( ! $saved_in_log->{$tag}++ ) {
415                    open(my $log, '>>', 'rfid-log.txt');
416                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
417                    close($log);
418            }
419    
420            return $hash;
421    }
422    
423    sub forget_tag {
424            my $tag = shift;
425            delete $tags_data->{$tag};
426            delete $visible_tags->{$tag};
427    }
428    
429  sub read_tag {  sub read_tag {
430          my ( $tag ) = @_;          my ( $tag ) = @_;
431    
# Line 278  sub read_tag { Line 438  sub read_tag {
438          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
439    
440                  cmd(                  cmd(
441                           sprintf( "D6 00  0D  02      $tag   %02x   %02x     ffff", $start_block, $read_blocks ),                           sprintf( "D6 00  0D  02      $tag   %02x   %02x     BEEF", $start_block, $read_blocks ),
442                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
443                          "D6 00  1F  02 00", sub { # $tag  03   00 00   04 11 00 01   01 00   31 32 33 34   02 00   35 36 37 38    531F\n";                          "D6 00  1F  02 00", sub { # $tag  03   00 00   04 11 00 01   01 00   31 32 33 34   02 00   35 36 37 38    531F\n";
444                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
445                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
446                          },                          },
447                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
448                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
449                          },                          },
450                  );                  );
# Line 294  sub read_tag { Line 454  sub read_tag {
454          my $security;          my $security;
455    
456          cmd(          cmd(
457                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
458                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
459                          my $rest = shift;                          my $rest = shift;
460                          my $from_tag;                          my $from_tag;
461                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
462                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
463                          $security = as_hex( $security );                          $security = as_hex( $security );
464                            $tags_security->{$tag} = $security;
465                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
466                  }                  }
467          );          );
468    
469          my $data = $tags_data->{$tag} || die "no data for $tag";          print "TAG $tag ", dump(decode_tag( $tag ));
         my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);  
         my $set   = ( $set_item & 0xf0 ) >> 4;  
         my $total = ( $set_item & 0x0f );  
         my $branch  = $br_lib >> 20;  
         my $library = $br_lib & 0x000fffff;  
         print "TAG $tag [$u1] set: $set/$total [$u2] type: $type '$content' library: $library branch: $branch custom: $custom security: $security\n";  
   
470  }  }
471    
472  sub write_tag {  sub write_tag {
473          my ($tag) = @_;          my ($tag,$data) = @_;
474    
475          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
476            $data = read_file( $path ) if -e $path;
477    
478            die "no data" unless $data;
479    
         my $data = read_file( $path );  
480          my $hex_data;          my $hex_data;
481    
482          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 348  sub write_tag { Line 504  sub write_tag {
504          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
505    
506          cmd(          cmd(
507                  "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  ffff", "write $tag",                  "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  BEEF", "write $tag",
508                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
509          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
510    
511          my $to = $path;          my $to = $path;
# Line 358  sub write_tag { Line 514  sub write_tag {
514          rename $path, $to;          rename $path, $to;
515          print ">> $to\n";          print ">> $to\n";
516    
517          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
518    }
519    
520    sub secure_tag_with {
521            my ( $tag, $data ) = @_;
522    
523            cmd(
524                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
525                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
526            );
527    
528            forget_tag $tag;
529  }  }
530    
531  sub secure_tag {  sub secure_tag {
# Line 367  sub secure_tag { Line 534  sub secure_tag {
534          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
535          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
536    
537          cmd(          secure_tag_with( $tag, $data );
                 "d6 00  0c  09  $tag $data 1234", "secure $tag -> $data",  
                 "d6 00  0c  09 00  $tag  1234", sub { assert() },  
         );  
538    
539          my $to = $path;          my $to = $path;
540          $to .= '.' . time();          $to .= '.' . time();
# Line 491  sub checksum { Line 655  sub checksum {
655          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
656    
657          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
658                  print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";                  warn "checksum error: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n" if $checksum ne "\xBE\xEF";
659                  return $bytes . $xor;                  return $bytes . $xor;
660          }          }
661          return $bytes . $checksum;          return $bytes . $checksum;
# Line 500  sub checksum { Line 664  sub checksum {
664  our $dispatch;  our $dispatch;
665    
666  sub readchunk {  sub readchunk {
667          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
668    
669          # read header of packet          # read header of packet
670          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
# Line 533  sub readchunk { Line 697  sub readchunk {
697                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
698                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
699          } else {          } else {
700                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
701          }          }
702    
703          return $data;          return $data;
Legend:
Removed from v.42  
changed lines
  Added in v.75
  ViewVC Help
Powered by ViewVC 1.1.26