/[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 71 by dpavlin, Thu Feb 11 20:57:51 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;  my $max_rfid_block = 16;
172  my $read_blocks = 8;  my $read_blocks = 8;
# Line 74  GetOptions( Line 191  GetOptions(
191          'parity=s'    => \$parity,          'parity=s'    => \$parity,
192          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
193          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
194          'meteor=s'    => \$meteor_server,          'http-server!' => \$http_server,
195  ) or die $!;  ) or die $!;
196    
197  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 110  it under the same terms ans Perl itself. Line 227  it under the same terms ans Perl itself.
227    
228  =cut  =cut
229    
 my $tags_data;  
 my $visible_tags;  
   
230  my $item_type = {  my $item_type = {
231          1 => 'Book',          1 => 'Book',
232          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 138  $databits=$port->databits($databits); Line 252  $databits=$port->databits($databits);
252  $parity=$port->parity($parity);  $parity=$port->parity($parity);
253  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
254    
255  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
256    
257  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
258  $port->lookclear();  $port->lookclear();
# Line 155  cmd( 'D5 00  05   04 00 11 Line 269  cmd( 'D5 00  05   04 00 11
269       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
270          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
271          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
272  });  });
273    
274  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?',
275       '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() }  );
276    
277  # start scanning for tags  sub scan_for_tags {
278    
279  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 {  
280    
281                          my $tags = substr( $rest, 1 );          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
282                     'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
283                            my $rest = shift || die "no rest?";
284                            my $nr = ord( substr( $rest, 0, 1 ) );
285    
286                            if ( ! $nr ) {
287                                    _log "no tags in range\n";
288                                    update_visible_tags();
289                                    $tags_data = {};
290                            } else {
291    
292                                    my $tags = substr( $rest, 1 );
293                                    my $tl = length( $tags );
294                                    die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
295    
296                                    push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
297                                    warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
298                                    _log "$nr tags in range: ", join(',', @tags ) , "\n";
299    
300                                    update_visible_tags( @tags );
301                            }
302                    }
303            );
304    
305                          my $tl = length( $tags );          diag "tags: ",dump( @tags );
306                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;          return $tags_data;
307    
308                          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";  
309    
310                          meteor( 'info-in-range', join(' ',@tags));  # start scanning for tags
311    
312                          update_visible_tags( @tags );  if ( $http_server ) {
313                  }          http_server;
314    } else {
315            while (1) {
316                    scan_for_tags;
317                    sleep 1;
318          }          }
319  ) while(1);  }
 #) foreach ( 1 .. 100 );  
   
320    
321    die "over and out";
322    
323  sub update_visible_tags {  sub update_visible_tags {
324          my @tags = @_;          my @tags = @_;
# Line 202  sub update_visible_tags { Line 327  sub update_visible_tags {
327          $visible_tags = {};          $visible_tags = {};
328    
329          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
330                    $visible_tags->{$tag}++;
331                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
332                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
333  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
334                          } else {                          } else {
                                 meteor( 'read', $tag );  
335                                  read_tag( $tag );                                  read_tag( $tag );
336                          }                          }
                         $visible_tags->{$tag}++;  
337                  } else {                  } else {
338                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
339                  }                  }
340                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
341    
342                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
343                                  write_tag( $tag );                                  write_tag( $tag );
344                  }                  }
345                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
346                                  secure_tag( $tag );                                  secure_tag( $tag );
347                  }                  }
348          }          }
349    
350          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
351                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
352                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
353          }          }
354    
355          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 387  sub read_tag_data {
387          return $last_block + 1;          return $last_block + 1;
388  }  }
389    
390    my $saved_in_log;
391    
392    sub decode_tag {
393            my $tag = shift;
394    
395            my $data = $tags_data->{$tag} || die "no data for $tag";
396    
397            my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
398            my $hash = {
399                    u1 => $u1,
400                    u2 => $u2,
401                    set => ( $set_item & 0xf0 ) >> 4,
402                    total => ( $set_item & 0x0f ),
403    
404                    type => $type,
405                    content => $content,
406    
407                    branch => $br_lib >> 20,
408                    library => $br_lib & 0x000fffff,
409    
410                    custom => $custom,
411            };
412    
413            if ( ! $saved_in_log->{$tag}++ ) {
414                    open(my $log, '>>', 'rfid-log.txt');
415                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
416                    close($log);
417            }
418    
419            return $hash;
420    }
421    
422    sub forget_tag {
423            my $tag = shift;
424            delete $tags_data->{$tag};
425            delete $visible_tags->{$tag};
426    }
427    
428  sub read_tag {  sub read_tag {
429          my ( $tag ) = @_;          my ( $tag ) = @_;
430    
# Line 278  sub read_tag { Line 437  sub read_tag {
437          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
438    
439                  cmd(                  cmd(
440                           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 ),
441                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
442                          "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";
443                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
444                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
445                          },                          },
446                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
447                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
448                          },                          },
449                  );                  );
# Line 294  sub read_tag { Line 453  sub read_tag {
453          my $security;          my $security;
454    
455          cmd(          cmd(
456                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
457                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
458                          my $rest = shift;                          my $rest = shift;
459                          my $from_tag;                          my $from_tag;
460                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
461                          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 );
462                          $security = as_hex( $security );                          $security = as_hex( $security );
463                            $tags_security->{$tag} = $security;
464                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
465                  }                  }
466          );          );
467    
468          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";  
   
469  }  }
470    
471  sub write_tag {  sub write_tag {
472          my ($tag) = @_;          my ($tag,$data) = @_;
473    
474          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
475            $data = read_file( $path ) if -e $path;
476    
477            die "no data" unless $data;
478    
         my $data = read_file( $path );  
479          my $hex_data;          my $hex_data;
480    
481          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 348  sub write_tag { Line 503  sub write_tag {
503          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
504    
505          cmd(          cmd(
506                  "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",
507                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
508          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
509    
510          my $to = $path;          my $to = $path;
# Line 358  sub write_tag { Line 513  sub write_tag {
513          rename $path, $to;          rename $path, $to;
514          print ">> $to\n";          print ">> $to\n";
515    
516          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
517    }
518    
519    sub secure_tag_with {
520            my ( $tag, $data ) = @_;
521    
522            cmd(
523                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
524                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
525            );
526    
527            forget_tag $tag;
528  }  }
529    
530  sub secure_tag {  sub secure_tag {
# Line 367  sub secure_tag { Line 533  sub secure_tag {
533          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
534          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
535    
536          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() },  
         );  
537    
538          my $to = $path;          my $to = $path;
539          $to .= '.' . time();          $to .= '.' . time();
# Line 491  sub checksum { Line 654  sub checksum {
654          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
655    
656          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
657                  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";
658                  return $bytes . $xor;                  return $bytes . $xor;
659          }          }
660          return $bytes . $checksum;          return $bytes . $checksum;
# Line 500  sub checksum { Line 663  sub checksum {
663  our $dispatch;  our $dispatch;
664    
665  sub readchunk {  sub readchunk {
666          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
667    
668          # read header of packet          # read header of packet
669          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
# Line 533  sub readchunk { Line 696  sub readchunk {
696                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
697                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
698          } else {          } else {
699                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
700          }          }
701    
702          return $data;          return $data;
Legend:
Removed from v.42  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.26