/[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 71 by dpavlin, Thu Feb 11 20:57:51 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 193  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 272  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 290  sub scan_for_tags { Line 286  sub scan_for_tags {
286                          if ( ! $nr ) {                          if ( ! $nr ) {
287                                  _log "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    
# Line 302  sub scan_for_tags { Line 297  sub scan_for_tags {
297                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
298                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
299    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
300                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
301                          }                          }
302                  }                  }
# Line 337  sub update_visible_tags { Line 330  sub update_visible_tags {
330                  $visible_tags->{$tag}++;                  $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                          }                          }
337                  } else {                  } else {
# Line 348  sub update_visible_tags { Line 340  sub update_visible_tags {
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 430  sub decode_tag { Line 419  sub decode_tag {
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 442  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 458  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;
# Line 508  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 518  sub write_tag { Line 513  sub write_tag {
513          rename $path, $to;          rename $path, $to;
514          print ">> $to\n";          print ">> $to\n";
515    
516          # force re-read of tag          forget_tag $tag;
517          delete $tags_data->{$tag};  }
518          delete $visible_tags->{$tag};  
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 529  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 653  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 695  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 ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
700          }          }
701    
702          return $data;          return $data;
Legend:
Removed from v.62  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.26