/[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 46 by dpavlin, Tue Jun 23 13:50:13 2009 UTC revision 71 by dpavlin, Thu Feb 11 20:57:51 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;
# Line 88  sub http_server { Line 71  sub http_server {
71                                          my ($n,$v) = split(/=/, $p, 2);                                          my ($n,$v) = split(/=/, $p, 2);
72                                          $param->{$n} = $v;                                          $param->{$n} = $v;
73                                  }                                  }
74                                  warn "<< param: ",dump( $param );                                  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} ) {
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",                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
88                                          $param->{callback}, "(", to_json($json), ")\r\n";                                          $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 {                          } else {
131                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
132                          }                          }
133                  } else {                  } else {
134                          print $client "HTTP/1.0 500 No method\r\n";                          print $client "HTTP/1.0 500 No method\r\n\r\n";
135                  }                  }
136                  close $client;                  close $client;
137          }          }
# Line 114  sub http_server { Line 139  sub http_server {
139          die "server died";          die "server died";
140  }  }
141    
142  my $debug = 0;  
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    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 153  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,
         'meteor=s'    => \$meteor_server,  
194          'http-server!' => \$http_server,          'http-server!' => \$http_server,
195  ) or die $!;  ) or die $!;
196    
# Line 190  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 218  $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 235  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?',
# Line 245  sub scan_for_tags { Line 278  sub scan_for_tags {
278    
279          my @tags;          my @tags;
280    
281          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          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                   'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
283                          my $rest = shift || die "no rest?";                          my $rest = shift || die "no rest?";
284                          my $nr = ord( substr( $rest, 0, 1 ) );                          my $nr = ord( substr( $rest, 0, 1 ) );
285    
286                          if ( ! $nr ) {                          if ( ! $nr ) {
287                                  print "no tags in range\n";                                  _log "no tags in range\n";
288                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
289                                  $tags_data = {};                                  $tags_data = {};
290                          } else {                          } else {
291    
292                                  my $tags = substr( $rest, 1 );                                  my $tags = substr( $rest, 1 );
   
293                                  my $tl = length( $tags );                                  my $tl = length( $tags );
294                                  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;
295    
296                                  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 );
297                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
298                                  print "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
   
                                 meteor( 'info-in-range', join(' ',@tags));  
299    
300                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
301                          }                          }
302                  }                  }
303          );          );
304    
305          warn "## tags: ",dump( @tags );          diag "tags: ",dump( @tags );
306          return $tags_data;          return $tags_data;
307    
308  }  }
# Line 283  sub scan_for_tags { Line 312  sub scan_for_tags {
312  if ( $http_server ) {  if ( $http_server ) {
313          http_server;          http_server;
314  } else {  } else {
315          scan_for_tags while 1;          while (1) {
316                    scan_for_tags;
317                    sleep 1;
318            }
319  }  }
320    
321  die "over and out";  die "over and out";
# Line 295  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 359  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 {  sub decode_tag {
393          my $tag = shift;          my $tag = shift;
394    
# Line 380  sub decode_tag { Line 410  sub decode_tag {
410                  custom => $custom,                  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;          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 395  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 411  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          );          );
# Line 426  sub read_tag { Line 469  sub read_tag {
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 458  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 468  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 477  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 601  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 643  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.46  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.26