/[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 63 by dpavlin, Thu Feb 11 10:52:14 2010 UTC revision 67 by dpavlin, Thu Feb 11 14:59:56 2010 UTC
# Line 19  my $tags_data; Line 19  my $tags_data;
19  my $tags_security;  my $tags_security;
20  my $visible_tags;  my $visible_tags;
21    
 my $meteor_server; # = '192.168.1.13:4671';  
 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;  
                 }  
         }  
   
         if ( $meteor_fh ) {  
                 warn ">> meteor ",dump( @a );  
                 print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n"  
         }  
 }  
   
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";  my $server_url  = "http://localhost:$listen_port";
24    
# Line 118  sub http_server { Line 91  sub http_server {
91                                  my $status = 501; # Not implementd                                  my $status = 501; # Not implementd
92    
93                                  foreach my $p ( keys %$param ) {                                  foreach my $p ( keys %$param ) {
94                                          next unless $p =~ m/^tag_(\S+)/;                                          next unless $p =~ m/^(E[0-9A-F]{15})$/;
95                                          my $tag = $1;                                          my $tag = $1;
96                                          my $content = "\x04\x11\x00\x01" . $param->{$p};                                          my $content = "\x04\x11\x00\x01" . $param->{$p};
97                                          $content = "\x00" if $param->{$p} eq 'blank';                                          $content = "\x00" if $param->{$p} eq 'blank';
# Line 130  sub http_server { Line 103  sub http_server {
103    
104                                  print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";                                  print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
105    
106                            } elsif ( $method =~ m{/secure} ) {
107    
108                                    my $status = 501; # Not implementd
109    
110                                    foreach my $p ( keys %$param ) {
111                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
112                                            my $tag = $1;
113                                            my $data = $param->{$p};
114                                            $status = 302;
115    
116                                            warn "SECURE $tag $data\n";
117                                            secure_tag_with( $tag, $data );
118                                    }
119    
120                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
121    
122                          } else {                          } else {
123                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
124                          }                          }
# Line 194  GetOptions( Line 183  GetOptions(
183          'parity=s'    => \$parity,          'parity=s'    => \$parity,
184          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
185          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
         'meteor=s'    => \$meteor_server,  
186          'http-server!' => \$http_server,          'http-server!' => \$http_server,
187  ) or die $!;  ) or die $!;
188    
# Line 273  cmd( 'D5 00  05   04 00 11 Line 261  cmd( 'D5 00  05   04 00 11
261       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
262          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
263          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
264  });  });
265    
266  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 291  sub scan_for_tags { Line 278  sub scan_for_tags {
278                          if ( ! $nr ) {                          if ( ! $nr ) {
279                                  _log "no tags in range\n";                                  _log "no tags in range\n";
280                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
281                                  $tags_data = {};                                  $tags_data = {};
282                          } else {                          } else {
283    
# Line 303  sub scan_for_tags { Line 289  sub scan_for_tags {
289                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
290                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
291    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
292                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
293                          }                          }
294                  }                  }
# Line 338  sub update_visible_tags { Line 322  sub update_visible_tags {
322                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
323                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
324                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
325  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
326                          } else {                          } else {
                                 meteor( 'read', $tag );  
327                                  read_tag( $tag );                                  read_tag( $tag );
328                          }                          }
329                  } else {                  } else {
# Line 349  sub update_visible_tags { Line 332  sub update_visible_tags {
332                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
333    
334                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
335                                  write_tag( $tag );                                  write_tag( $tag );
336                  }                  }
337                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
338                                  secure_tag( $tag );                                  secure_tag( $tag );
339                  }                  }
340          }          }
341    
342          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
343                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
344                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
345          }          }
346    
347          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 431  sub decode_tag { Line 411  sub decode_tag {
411          return $hash;          return $hash;
412  }  }
413    
414    sub forget_tag {
415            my $tag = shift;
416            delete $tags_data->{$tag};
417            delete $visible_tags->{$tag};
418    }
419    
420  sub read_tag {  sub read_tag {
421          my ( $tag ) = @_;          my ( $tag ) = @_;
422    
# Line 443  sub read_tag { Line 429  sub read_tag {
429          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
430    
431                  cmd(                  cmd(
432                           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 ),
433                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
434                          "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";
435                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
436                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
437                          },                          },
438                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
439                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
440                          },                          },
441                  );                  );
# Line 459  sub read_tag { Line 445  sub read_tag {
445          my $security;          my $security;
446    
447          cmd(          cmd(
448                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
449                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
450                          my $rest = shift;                          my $rest = shift;
451                          my $from_tag;                          my $from_tag;
# Line 509  sub write_tag { Line 495  sub write_tag {
495          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
496    
497          cmd(          cmd(
498                  "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",
499                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
500          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
501    
502          my $to = $path;          my $to = $path;
# Line 519  sub write_tag { Line 505  sub write_tag {
505          rename $path, $to;          rename $path, $to;
506          print ">> $to\n";          print ">> $to\n";
507    
508          # force re-read of tag          forget_tag $tag;
509          delete $tags_data->{$tag};  }
510          delete $visible_tags->{$tag};  
511    sub secure_tag_with {
512            my ( $tag, $data ) = @_;
513    
514            cmd(
515                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
516                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
517            );
518    
519            forget_tag $tag;
520  }  }
521    
522  sub secure_tag {  sub secure_tag {
# Line 530  sub secure_tag { Line 525  sub secure_tag {
525          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
526          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
527    
528          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() },  
         );  
529    
530          my $to = $path;          my $to = $path;
531          $to .= '.' . time();          $to .= '.' . time();
# Line 654  sub checksum { Line 646  sub checksum {
646          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
647    
648          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
649                  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";
650                  return $bytes . $xor;                  return $bytes . $xor;
651          }          }
652          return $bytes . $checksum;          return $bytes . $checksum;
# Line 696  sub readchunk { Line 688  sub readchunk {
688                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
689                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
690          } else {          } else {
691                  print "NO DISPATCH for ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
692          }          }
693    
694          return $data;          return $data;
Legend:
Removed from v.63  
changed lines
  Added in v.67
  ViewVC Help
Powered by ViewVC 1.1.26