/[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 45 by dpavlin, Tue Jun 23 13:29:10 2009 UTC revision 68 by dpavlin, Thu Feb 11 15:10:39 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                                            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} ) {
108    
109                                    my $status = 501; # Not implementd
110    
111                                    foreach my $p ( keys %$param ) {
112                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
113                                            my $tag = $1;
114                                            my $data = $param->{$p};
115                                            $status = 302;
116    
117                                            warn "SECURE $tag $data\n";
118                                            secure_tag_with( $tag, $data );
119                                    }
120    
121                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
122    
123                          } else {                          } else {
124                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
125                          }                          }
# Line 106  sub http_server { Line 132  sub http_server {
132          die "server died";          die "server died";
133  }  }
134    
135  my $debug = 0;  
136    my $last_message = {};
137    sub _message {
138            my $type = shift @_;
139            my $text = join(' ',@_);
140            my $last = $last_message->{$type};
141            if ( $text ne $last ) {
142                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
143                    $last_message->{$type} = $text;
144            }
145    }
146    
147    sub _log { _message('log',@_) };
148    sub diag { _message('diag',@_) };
149    
150  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
151  my $baudrate  = "19200";  my $baudrate  = "19200";
# Line 145  GetOptions( Line 184  GetOptions(
184          'parity=s'    => \$parity,          'parity=s'    => \$parity,
185          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
186          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
         'meteor=s'    => \$meteor_server,  
187          'http-server!' => \$http_server,          'http-server!' => \$http_server,
188  ) or die $!;  ) or die $!;
189    
# Line 182  it under the same terms ans Perl itself. Line 220  it under the same terms ans Perl itself.
220    
221  =cut  =cut
222    
 my $tags_data;  
 my $visible_tags;  
   
223  my $item_type = {  my $item_type = {
224          1 => 'Book',          1 => 'Book',
225          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 210  $databits=$port->databits($databits); Line 245  $databits=$port->databits($databits);
245  $parity=$port->parity($parity);  $parity=$port->parity($parity);
246  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
247    
248  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
249    
250  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
251  $port->lookclear();  $port->lookclear();
# Line 227  cmd( 'D5 00  05   04 00 11 Line 262  cmd( 'D5 00  05   04 00 11
262       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
263          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
264          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
265  });  });
266    
267  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 237  sub scan_for_tags { Line 271  sub scan_for_tags {
271    
272          my @tags;          my @tags;
273    
274          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
275                   '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
276                          my $rest = shift || die "no rest?";                          my $rest = shift || die "no rest?";
277                          my $nr = ord( substr( $rest, 0, 1 ) );                          my $nr = ord( substr( $rest, 0, 1 ) );
278    
279                          if ( ! $nr ) {                          if ( ! $nr ) {
280                                  print "no tags in range\n";                                  _log "no tags in range\n";
281                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
282                                  $tags_data = {};                                  $tags_data = {};
283                          } else {                          } else {
284    
285                                  my $tags = substr( $rest, 1 );                                  my $tags = substr( $rest, 1 );
   
286                                  my $tl = length( $tags );                                  my $tl = length( $tags );
287                                  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;
288    
289                                  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 );
290                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
291                                  print "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
   
                                 meteor( 'info-in-range', join(' ',@tags));  
292    
293                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
294                          }                          }
295                  }                  }
296          );          );
297    
298          warn "## tags: ",dump( @tags );          diag "tags: ",dump( @tags );
299          return $tags_data;          return $tags_data;
300    
301  }  }
# Line 275  sub scan_for_tags { Line 305  sub scan_for_tags {
305  if ( $http_server ) {  if ( $http_server ) {
306          http_server;          http_server;
307  } else {  } else {
308          scan_for_tags while 1;          while (1) {
309                    scan_for_tags;
310                    sleep 1;
311            }
312  }  }
313    
314  die "over and out";  die "over and out";
# Line 287  sub update_visible_tags { Line 320  sub update_visible_tags {
320          $visible_tags = {};          $visible_tags = {};
321    
322          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
323                    $visible_tags->{$tag}++;
324                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
325                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
326  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
327                          } else {                          } else {
                                 meteor( 'read', $tag );  
328                                  read_tag( $tag );                                  read_tag( $tag );
329                          }                          }
                         $visible_tags->{$tag}++;  
330                  } else {                  } else {
331                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
332                  }                  }
333                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
334    
335                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
336                                  write_tag( $tag );                                  write_tag( $tag );
337                  }                  }
338                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
339                                  secure_tag( $tag );                                  secure_tag( $tag );
340                  }                  }
341          }          }
342    
343          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
344                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
345                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
346          }          }
347    
348          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 351  sub read_tag_data { Line 380  sub read_tag_data {
380          return $last_block + 1;          return $last_block + 1;
381  }  }
382    
383    my $saved_in_log;
384    
385  sub decode_tag {  sub decode_tag {
386          my $tag = shift;          my $tag = shift;
387    
# Line 372  sub decode_tag { Line 403  sub decode_tag {
403                  custom => $custom,                  custom => $custom,
404          };          };
405    
406            if ( ! $saved_in_log->{$tag}++ ) {
407                    open(my $log, '>>', 'rfid-log.txt');
408                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
409                    close($log);
410            }
411    
412          return $hash;          return $hash;
413  }  }
414    
415    sub forget_tag {
416            my $tag = shift;
417            delete $tags_data->{$tag};
418            delete $visible_tags->{$tag};
419    }
420    
421  sub read_tag {  sub read_tag {
422          my ( $tag ) = @_;          my ( $tag ) = @_;
423    
# Line 387  sub read_tag { Line 430  sub read_tag {
430          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
431    
432                  cmd(                  cmd(
433                           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 ),
434                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
435                          "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";
436                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
437                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
438                          },                          },
439                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
440                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
441                          },                          },
442                  );                  );
# Line 403  sub read_tag { Line 446  sub read_tag {
446          my $security;          my $security;
447    
448          cmd(          cmd(
449                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
450                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
451                          my $rest = shift;                          my $rest = shift;
452                          my $from_tag;                          my $from_tag;
453                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
454                          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 );
455                          $security = as_hex( $security );                          $security = as_hex( $security );
456                            $tags_security->{$tag} = $security;
457                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
458                  }                  }
459          );          );
# Line 418  sub read_tag { Line 462  sub read_tag {
462  }  }
463    
464  sub write_tag {  sub write_tag {
465          my ($tag) = @_;          my ($tag,$data) = @_;
466    
467          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
468            $data = read_file( $path ) if -e $path;
469    
470            die "no data" unless $data;
471    
         my $data = read_file( $path );  
472          my $hex_data;          my $hex_data;
473    
474          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 450  sub write_tag { Line 496  sub write_tag {
496          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
497    
498          cmd(          cmd(
499                  "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",
500                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
501          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
502    
503          my $to = $path;          my $to = $path;
# Line 460  sub write_tag { Line 506  sub write_tag {
506          rename $path, $to;          rename $path, $to;
507          print ">> $to\n";          print ">> $to\n";
508    
509          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
510    }
511    
512    sub secure_tag_with {
513            my ( $tag, $data ) = @_;
514    
515            cmd(
516                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
517                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
518            );
519    
520            forget_tag $tag;
521  }  }
522    
523  sub secure_tag {  sub secure_tag {
# Line 469  sub secure_tag { Line 526  sub secure_tag {
526          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
527          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
528    
529          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() },  
         );  
530    
531          my $to = $path;          my $to = $path;
532          $to .= '.' . time();          $to .= '.' . time();
# Line 593  sub checksum { Line 647  sub checksum {
647          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
648    
649          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
650                  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";
651                  return $bytes . $xor;                  return $bytes . $xor;
652          }          }
653          return $bytes . $checksum;          return $bytes . $checksum;
# Line 635  sub readchunk { Line 689  sub readchunk {
689                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
690                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
691          } else {          } else {
692                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
693          }          }
694    
695          return $data;          return $data;
Legend:
Removed from v.45  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.26