/[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 44 by dpavlin, Tue Jun 23 13:10:18 2009 UTC revision 66 by dpavlin, Thu Feb 11 14:14:21 2010 UTC
# Line 9  use Carp qw/confess/; Line 9  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10  use File::Slurp;  use File::Slurp;
11  use JSON;  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;
 my $meteor_fh;  
   
 sub meteor {  
         my @a = @_;  
         push @a, scalar localtime() if $a[0] =~ m{^info};  
   
         if ( ! defined $meteor_fh ) {  
                 if ( $meteor_fh =  
                                 IO::Socket::INET->new(  
                                         PeerAddr => $meteor_server,  
                                         Timeout => 1,  
                                 )  
                 ) {  
                         warn "# meteor connected to $meteor_server";  
                 } else {  
                         warn "can't connect to meteor $meteor_server: $!";  
                         $meteor_fh = 0;  
                 }  
         }  
17    
18          if ( $meteor_fh ) {  my $tags_data;
19                  warn ">> meteor ",dump( @a );  my $tags_security;
20                  print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n"  my $visible_tags;
         }  
 }  
21    
22  my $listen_port = 9000;                  # pick something not in use  my $listen_port = 9000;                  # pick something not in use
23    my $server_url  = "http://localhost:$listen_port";
24    
25  sub http_server {  sub http_server {
26    
27          my $server = IO::Socket::INET->new(          my $server = IO::Socket::INET->new(
# Line 51  sub http_server { Line 33  sub http_server {
33                                                                                                                                        
34          die "can't setup server" unless $server;          die "can't setup server" unless $server;
35    
36          print "Server $0 accepting clients at http://localhost:$listen_port/\n";          print "Server $0 ready at $server_url\n";
37    
38          sub static {          sub static {
39                  my ($client,$path) = @_;                  my ($client,$path) = @_;
40    
41                  $path = "www/$path";                  $path = "www/$path";
42                    $path .= 'rfid.html' if $path =~ m{/$};
43    
44                  return unless -e $path;                  return unless -e $path;
45    
# Line 78  sub http_server { Line 61  sub http_server {
61                  $client->autoflush(1);                  $client->autoflush(1);
62                  my $request = <$client>;                  my $request = <$client>;
63    
64                  warn "<< $request\n";                  warn "WEB << $request\n" if $debug;
65    
66                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
67                          my $method = $1;                          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 ) ) {                          if ( my $path = static( $client,$1 ) ) {
77                                  warn ">> $path";                                  warn "WEB >> $path" if $debug;
78                          } elsif ( $method =~ m{/scan} ) {                          } elsif ( $method =~ m{/scan} ) {
                                 my $callback = $1 if $method =~ m{\?callback=([^&;]+)};  
79                                  my $tags = scan_for_tags();                                  my $tags = scan_for_tags();
80                                  my $json;                                  my $json = { time => time() };
81                                  map {                                  map {
82                                          my $d = decode_tag($_);                                          my $d = decode_tag($_);
83                                          $d->{sid} = $_;                                          $d->{sid} = $_;
84                                            $d->{security} = $tags_security->{$_};
85                                          push @{ $json->{tags} },  $d;                                          push @{ $json->{tags} },  $d;
86                                  } keys %$tags;                                  } keys %$tags;
87                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n$callback(", to_json($json), ")\r\n";                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\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                                    }
103    
104                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
105    
106                          } else {                          } else {
107                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
108                          }                          }
# Line 106  sub http_server { Line 115  sub http_server {
115          die "server died";          die "server died";
116  }  }
117    
118  my $debug = 0;  
119    my $last_message = {};
120    sub _message {
121            my $type = shift @_;
122            my $text = join(' ',@_);
123            my $last = $last_message->{$type};
124            if ( $text ne $last ) {
125                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
126                    $last_message->{$type} = $text;
127            }
128    }
129    
130    sub _log { _message('log',@_) };
131    sub diag { _message('diag',@_) };
132    
133  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
134  my $baudrate  = "19200";  my $baudrate  = "19200";
# Line 145  GetOptions( Line 167  GetOptions(
167          'parity=s'    => \$parity,          'parity=s'    => \$parity,
168          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
169          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
170          'meteor=s'    => \$meteor_server,          'http-server!' => \$http_server,
171  ) or die $!;  ) or die $!;
172    
173  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 181  it under the same terms ans Perl itself. Line 203  it under the same terms ans Perl itself.
203    
204  =cut  =cut
205    
 my $tags_data;  
 my $visible_tags;  
   
206  my $item_type = {  my $item_type = {
207          1 => 'Book',          1 => 'Book',
208          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 209  $databits=$port->databits($databits); Line 228  $databits=$port->databits($databits);
228  $parity=$port->parity($parity);  $parity=$port->parity($parity);
229  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
230    
231  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
232    
233  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
234  $port->lookclear();  $port->lookclear();
# Line 226  cmd( 'D5 00  05   04 00 11 Line 245  cmd( 'D5 00  05   04 00 11
245       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
246          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
247          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
248  });  });
249    
250  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?',
# Line 236  sub scan_for_tags { Line 254  sub scan_for_tags {
254    
255          my @tags;          my @tags;
256    
257          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
258                   'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8                   'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
259                          my $rest = shift || die "no rest?";                          my $rest = shift || die "no rest?";
260                          my $nr = ord( substr( $rest, 0, 1 ) );                          my $nr = ord( substr( $rest, 0, 1 ) );
261    
262                          if ( ! $nr ) {                          if ( ! $nr ) {
263                                  print "no tags in range\n";                                  _log "no tags in range\n";
264                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
265                                  $tags_data = {};                                  $tags_data = {};
266                          } else {                          } else {
267    
268                                  my $tags = substr( $rest, 1 );                                  my $tags = substr( $rest, 1 );
   
269                                  my $tl = length( $tags );                                  my $tl = length( $tags );
270                                  die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;                                  die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
271    
272                                  push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );                                  push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
273                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
274                                  print "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
   
                                 meteor( 'info-in-range', join(' ',@tags));  
275    
276                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
277                          }                          }
278                  }                  }
279          );          );
280    
281          warn "## tags: ",dump( @tags );          diag "tags: ",dump( @tags );
282          return $tags_data;          return $tags_data;
283    
284  }  }
# Line 274  sub scan_for_tags { Line 288  sub scan_for_tags {
288  if ( $http_server ) {  if ( $http_server ) {
289          http_server;          http_server;
290  } else {  } else {
291          scan_for_tags while 1;          while (1) {
292                    scan_for_tags;
293                    sleep 1;
294            }
295  }  }
296    
297  die "over and out";  die "over and out";
# Line 286  sub update_visible_tags { Line 303  sub update_visible_tags {
303          $visible_tags = {};          $visible_tags = {};
304    
305          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
306                    $visible_tags->{$tag}++;
307                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
308                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
309  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
310                          } else {                          } else {
                                 meteor( 'read', $tag );  
311                                  read_tag( $tag );                                  read_tag( $tag );
312                          }                          }
                         $visible_tags->{$tag}++;  
313                  } else {                  } else {
314                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
315                  }                  }
316                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
317    
318                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
319                                  write_tag( $tag );                                  write_tag( $tag );
320                  }                  }
321                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
322                                  secure_tag( $tag );                                  secure_tag( $tag );
323                  }                  }
324          }          }
325    
326          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
327                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
328                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
329          }          }
330    
331          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 350  sub read_tag_data { Line 363  sub read_tag_data {
363          return $last_block + 1;          return $last_block + 1;
364  }  }
365    
366    my $saved_in_log;
367    
368  sub decode_tag {  sub decode_tag {
369          my $tag = shift;          my $tag = shift;
370    
# Line 371  sub decode_tag { Line 386  sub decode_tag {
386                  custom => $custom,                  custom => $custom,
387          };          };
388    
389            if ( ! $saved_in_log->{$tag}++ ) {
390                    open(my $log, '>>', 'rfid-log.txt');
391                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
392                    close($log);
393            }
394    
395          return $hash;          return $hash;
396  }  }
397    
# Line 386  sub read_tag { Line 407  sub read_tag {
407          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
408    
409                  cmd(                  cmd(
410                           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 ),
411                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
412                          "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";
413                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
414                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
415                          },                          },
416                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
417                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
418                          },                          },
419                  );                  );
# Line 402  sub read_tag { Line 423  sub read_tag {
423          my $security;          my $security;
424    
425          cmd(          cmd(
426                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
427                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
428                          my $rest = shift;                          my $rest = shift;
429                          my $from_tag;                          my $from_tag;
430                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
431                          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 );
432                          $security = as_hex( $security );                          $security = as_hex( $security );
433                            $tags_security->{$tag} = $security;
434                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
435                  }                  }
436          );          );
# Line 417  sub read_tag { Line 439  sub read_tag {
439  }  }
440    
441  sub write_tag {  sub write_tag {
442          my ($tag) = @_;          my ($tag,$data) = @_;
443    
444          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
445            $data = read_file( $path ) if -e $path;
446    
447            die "no data" unless $data;
448    
         my $data = read_file( $path );  
449          my $hex_data;          my $hex_data;
450    
451          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 449  sub write_tag { Line 473  sub write_tag {
473          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
474    
475          cmd(          cmd(
476                  "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",
477                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
478          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
479    
480          my $to = $path;          my $to = $path;
# Line 459  sub write_tag { Line 483  sub write_tag {
483          rename $path, $to;          rename $path, $to;
484          print ">> $to\n";          print ">> $to\n";
485    
486          delete $tags_data->{$tag};      # force re-read of tag          # force re-read of tag
487            delete $tags_data->{$tag};
488            delete $visible_tags->{$tag};
489  }  }
490    
491  sub secure_tag {  sub secure_tag {
# Line 469  sub secure_tag { Line 495  sub secure_tag {
495          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
496    
497          cmd(          cmd(
498                  "d6 00  0c  09  $tag $data 1234", "secure $tag -> $data",                  "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
499                  "d6 00  0c  09 00  $tag  1234", sub { assert() },                  "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
500          );          );
501    
502          my $to = $path;          my $to = $path;
# Line 592  sub checksum { Line 618  sub checksum {
618          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
619    
620          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
621                  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";
622                  return $bytes . $xor;                  return $bytes . $xor;
623          }          }
624          return $bytes . $checksum;          return $bytes . $checksum;
# Line 634  sub readchunk { Line 660  sub readchunk {
660                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
661                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
662          } else {          } else {
663                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
664          }          }
665    
666          return $data;          return $data;
Legend:
Removed from v.44  
changed lines
  Added in v.66
  ViewVC Help
Powered by ViewVC 1.1.26