/[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 62 by dpavlin, Tue Feb 9 14:52:13 2010 UTC revision 75 by dpavlin, Thu Feb 11 22:12:34 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 111  sub http_server { Line 84  sub http_server {
84                                          $d->{security} = $tags_security->{$_};                                          $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} ) {                          } elsif ( $method =~ m{/program} ) {
90    
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';
98                                          $status = 302;                                          $status = 302;
99    
100                                          warn "PROGRAM $tag $content\n";                                          warn "PROGRAM $tag $content\n";
101                                          write_tag( $tag, $content );                                          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";                                  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 170  my $secure_path = './secure/'; Line 168  my $secure_path = './secure/';
168  my $http_server = 1;  my $http_server = 1;
169    
170  # 3M defaults: 8,4  # 3M defaults: 8,4
171  my $max_rfid_block = 16;  # cards 16, stickers: 8
172    my $max_rfid_block = 8;
173  my $read_blocks = 8;  my $read_blocks = 8;
174    
175  my $response = {  my $response = {
# Line 193  GetOptions( Line 192  GetOptions(
192          'parity=s'    => \$parity,          'parity=s'    => \$parity,
193          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
194          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
         'meteor=s'    => \$meteor_server,  
195          'http-server!' => \$http_server,          'http-server!' => \$http_server,
196  ) or die $!;  ) or die $!;
197    
# Line 272  cmd( 'D5 00  05   04 00 11 Line 270  cmd( 'D5 00  05   04 00 11
270       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
271          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
272          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
273  });  });
274    
275  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 290  sub scan_for_tags { Line 287  sub scan_for_tags {
287                          if ( ! $nr ) {                          if ( ! $nr ) {
288                                  _log "no tags in range\n";                                  _log "no tags in range\n";
289                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
290                                  $tags_data = {};                                  $tags_data = {};
291                          } else {                          } else {
292    
# Line 302  sub scan_for_tags { Line 298  sub scan_for_tags {
298                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
299                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
300    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
301                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
302                          }                          }
303                  }                  }
# Line 337  sub update_visible_tags { Line 331  sub update_visible_tags {
331                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
332                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
333                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
334  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
335                          } else {                          } else {
                                 meteor( 'read', $tag );  
336                                  read_tag( $tag );                                  read_tag( $tag );
337                          }                          }
338                  } else {                  } else {
# Line 348  sub update_visible_tags { Line 341  sub update_visible_tags {
341                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
342    
343                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
344                                  write_tag( $tag );                                  write_tag( $tag );
345                  }                  }
346                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
347                                  secure_tag( $tag );                                  secure_tag( $tag );
348                  }                  }
349          }          }
350    
351          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
352                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
353                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
354          }          }
355    
356          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 430  sub decode_tag { Line 420  sub decode_tag {
420          return $hash;          return $hash;
421  }  }
422    
423    sub forget_tag {
424            my $tag = shift;
425            delete $tags_data->{$tag};
426            delete $visible_tags->{$tag};
427    }
428    
429  sub read_tag {  sub read_tag {
430          my ( $tag ) = @_;          my ( $tag ) = @_;
431    
# Line 442  sub read_tag { Line 438  sub read_tag {
438          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
439    
440                  cmd(                  cmd(
441                           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 ),
442                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
443                          "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";
444                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
445                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
446                          },                          },
447                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
448                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
449                          },                          },
450                  );                  );
# Line 458  sub read_tag { Line 454  sub read_tag {
454          my $security;          my $security;
455    
456          cmd(          cmd(
457                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
458                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
459                          my $rest = shift;                          my $rest = shift;
460                          my $from_tag;                          my $from_tag;
# Line 508  sub write_tag { Line 504  sub write_tag {
504          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
505    
506          cmd(          cmd(
507                  "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",
508                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
509          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
510    
511          my $to = $path;          my $to = $path;
# Line 518  sub write_tag { Line 514  sub write_tag {
514          rename $path, $to;          rename $path, $to;
515          print ">> $to\n";          print ">> $to\n";
516    
517          # force re-read of tag          forget_tag $tag;
518          delete $tags_data->{$tag};  }
519          delete $visible_tags->{$tag};  
520    sub secure_tag_with {
521            my ( $tag, $data ) = @_;
522    
523            cmd(
524                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
525                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
526            );
527    
528            forget_tag $tag;
529  }  }
530    
531  sub secure_tag {  sub secure_tag {
# Line 529  sub secure_tag { Line 534  sub secure_tag {
534          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
535          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
536    
537          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() },  
         );  
538    
539          my $to = $path;          my $to = $path;
540          $to .= '.' . time();          $to .= '.' . time();
# Line 653  sub checksum { Line 655  sub checksum {
655          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
656    
657          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
658                  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";
659                  return $bytes . $xor;                  return $bytes . $xor;
660          }          }
661          return $bytes . $checksum;          return $bytes . $checksum;
# Line 695  sub readchunk { Line 697  sub readchunk {
697                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
698                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
699          } else {          } else {
700                  print "NO DISPATCH for ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
701          }          }
702    
703          return $data;          return $data;
Legend:
Removed from v.62  
changed lines
  Added in v.75
  ViewVC Help
Powered by ViewVC 1.1.26