/[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 64 by dpavlin, Thu Feb 11 12:33:19 2010 UTC revision 92 by dpavlin, Fri Jul 23 13:16:51 2010 UTC
# Line 31  sub http_server { Line 31  sub http_server {
31                  Reuse     => 1                  Reuse     => 1
32          );          );
33                                                                                                                                        
34          die "can't setup server" unless $server;          die "can't setup server: $!" unless $server;
35    
36          print "Server $0 ready at $server_url\n";          print "Server $0 ready at $server_url\n";
37    
# Line 84  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';                                          $content = "\x00" if $param->{$p} eq 'blank';
# Line 99  sub http_server { Line 99  sub http_server {
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 144  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 368  my $saved_in_log; Line 393  my $saved_in_log;
393  sub decode_tag {  sub decode_tag {
394          my $tag = shift;          my $tag = shift;
395    
396          my $data = $tags_data->{$tag} || die "no data for $tag";          my $data = $tags_data->{$tag};
397            if ( ! $data ) {
398                    warn "no data for $tag\n";
399                    return;
400            }
401    
402          my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);          my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
403          my $hash = {          my $hash = {
# Line 395  sub decode_tag { Line 424  sub decode_tag {
424          return $hash;          return $hash;
425  }  }
426    
427    sub forget_tag {
428            my $tag = shift;
429            delete $tags_data->{$tag};
430            delete $visible_tags->{$tag};
431    }
432    
433  sub read_tag {  sub read_tag {
434          my ( $tag ) = @_;          my ( $tag ) = @_;
435    
# Line 407  sub read_tag { Line 442  sub read_tag {
442          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
443    
444                  cmd(                  cmd(
445                           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 ),
446                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
447                          "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";
448                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
449                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
450                          },                          },
451                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
452                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
453                          },                          },
454                            "D6 00 0D 02 06 $tag", sub {
455                                    my $rest = shift;
456                                    print "ERROR reading $tag ", as_hex($rest), $/;
457                                    forget_tag $tag;
458                                    $start_block = $max_rfid_block; # XXX break out of while
459                            },
460                  );                  );
461    
462          }          }
# Line 423  sub read_tag { Line 464  sub read_tag {
464          my $security;          my $security;
465    
466          cmd(          cmd(
467                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
468                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
469                          my $rest = shift;                          my $rest = shift;
470                          my $from_tag;                          my $from_tag;
# Line 432  sub read_tag { Line 473  sub read_tag {
473                          $security = as_hex( $security );                          $security = as_hex( $security );
474                          $tags_security->{$tag} = $security;                          $tags_security->{$tag} = $security;
475                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
476                  }                  },
477                    "D6 00 0C 0A 06", sub {
478                            my $rest = shift;
479                            warn "ERROR reading security from $rest\n";
480                            forget_tag $tag;
481                    },
482          );          );
483    
484          print "TAG $tag ", dump(decode_tag( $tag ));          print "TAG $tag ", dump(decode_tag( $tag ));
# Line 472  sub write_tag { Line 518  sub write_tag {
518    
519          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
520    
521            my $ok = 0;
522    
523          cmd(          cmd(
524                  "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",
525                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  06 00  $tag  $blocks  BEEF", sub { assert(); $ok++ },
526                    "d6 00  0d  04 06  ", sub {
527                            my $data = shift;
528                            warn "no tag ",as_hex( substr($data,0,8) ), " in range for write\n";
529                    },
530          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
531    
532          my $to = $path;          if ( $ok ) {
         $to .= '.' . time();  
533    
534          rename $path, $to;                  my $to = $path;
535          print ">> $to\n";                  $to .= '.' . time();
536    
537          # force re-read of tag                  rename $path, $to;
538          delete $tags_data->{$tag};                  print ">> $to\n";
539          delete $visible_tags->{$tag};  
540            }
541    
542            forget_tag $tag;
543    }
544    
545    sub secure_tag_with {
546            my ( $tag, $data ) = @_;
547    
548            cmd(
549                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
550                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
551                    "d6 00  0c  09 06  ", sub {
552                            my $data = shift;
553                            warn "no tag ",as_hex( substr($data,0,8) ), " in range for secure\n";
554                    },
555            );
556    
557            forget_tag $tag;
558  }  }
559    
560  sub secure_tag {  sub secure_tag {
# Line 494  sub secure_tag { Line 563  sub secure_tag {
563          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
564          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
565    
566          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() },  
         );  
567    
568          my $to = $path;          my $to = $path;
569          $to .= '.' . time();          $to .= '.' . time();
# Line 546  sub writechunk Line 612  sub writechunk
612  sub as_hex {  sub as_hex {
613          my @out;          my @out;
614          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
615                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
616                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
617                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
618                  push @out, $hex;                  push @out, $hex;
# Line 618  sub checksum { Line 684  sub checksum {
684          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
685    
686          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
687                  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";
688                  return $bytes . $xor;                  return $bytes . $xor;
689          }          }
690          return $bytes . $checksum;          return $bytes . $checksum;
# Line 660  sub readchunk { Line 726  sub readchunk {
726                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
727                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
728          } else {          } else {
729                  die "NO DISPATCH for ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ), " in ", dump( $dispatch );
730          }          }
731    
732          return $data;          return $data;
Legend:
Removed from v.64  
changed lines
  Added in v.92
  ViewVC Help
Powered by ViewVC 1.1.26