/[RFID]/cpr-m02.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 /cpr-m02.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

3m-810.pl revision 58 by dpavlin, Sat Jul 4 08:33:56 2009 UTC cpr-m02.pl revision 83 by dpavlin, Mon Jul 12 10:59:59 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 $debug = 0;  my $debug = 2;
17    
18  my $tags_data;  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";
24    
25  sub http_server {  sub http_server {
26    
27          my $server = IO::Socket::INET->new(          my $server = IO::Socket::INET->new(
# Line 55  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 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) = @_;
# Line 108  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} ) {
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 138  sub _log { _message('log',@_) }; Line 155  sub _log { _message('log',@_) };
155  sub diag { _message('diag',@_) };  sub diag { _message('diag',@_) };
156    
157  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
158  my $baudrate  = "19200";  my $baudrate  = "38400";
159  my $databits  = "8";  my $databits  = "8";
160  my $parity        = "none";  my $parity        = "even";
161  my $stopbits  = "1";  my $stopbits  = "1";
162  my $handshake = "none";  my $handshake = "none";
163    
# Line 151  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 174  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 247  $port->read_char_time(5); Line 264  $port->read_char_time(5);
264  #$port->stty_inpck(1);  #$port->stty_inpck(1);
265  #$port->stty_istrip(1);  #$port->stty_istrip(1);
266    
267    sub cpr_m02_checksum {
268            my $data = shift;
269    
270            my $preset = 0xffff;
271            my $polynom = 0x8408;
272    
273            my $crc = $preset;
274            foreach my $i ( 0 .. length($data) - 1 ) {
275                    $crc ^= ord(substr($data,$i,1));
276                    for my $j ( 0 .. 7 ) {
277                            if ( $crc & 0x0001 ) {
278                                    $crc = ( $crc >> 1 ) ^ $polynom;
279                            } else {
280                                    $crc = $crc >> 1;
281                            }
282                    }
283                    warn sprintf('%d %04x', $i, $crc & 0xffff);
284            }
285    
286            return pack('v', $crc);
287    }
288    
289    sub cpr {
290            my ( $hex, $description ) = shift;
291            my $bytes = str2bytes($hex);
292            my $len = pack( 'c', length( $bytes ) + 3 );
293            my $send = $len . $bytes;
294            my $checksum = cpr_m02_checksum($send);
295            $send .= $checksum;
296    
297            warn ">> ", as_hex( $send ), "[$description]\n";
298            $port->write( $send );
299            my $r_len = $port->read(1);
300            warn "<< response len: ", as_hex($r_len), "\n";
301            $r_len = ord($r_len) - 1;
302            my $data = $port->read( $r_len );
303            warn "<< ", as_hex( $data );
304    
305            warn "## ",dump( $port->read(1) );
306    }
307    
308    #cpr( 'FF  52 00', 'detect boud rate' );
309    
310    #cpr( '00  65', 'software version' );
311    
312    cpr( 'FF  65', 'get ? info' );
313    
314    cpr( 'FF  69 00', 'get reader info' );
315    
316    cpr( 'FF B0 01 00', '?' );
317    
318    cpr( 'FF 69', '?' );
319    
320    #cpr( '', '?' );
321    
322    exit;
323  # initial hand-shake with device  # initial hand-shake with device
324    
325  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
326       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
327          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
328          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
329  });  });
330    
331  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 271  sub scan_for_tags { Line 343  sub scan_for_tags {
343                          if ( ! $nr ) {                          if ( ! $nr ) {
344                                  _log "no tags in range\n";                                  _log "no tags in range\n";
345                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
346                                  $tags_data = {};                                  $tags_data = {};
347                          } else {                          } else {
348    
# Line 283  sub scan_for_tags { Line 354  sub scan_for_tags {
354                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
355                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
356    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
357                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
358                          }                          }
359                  }                  }
# Line 318  sub update_visible_tags { Line 387  sub update_visible_tags {
387                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
388                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
389                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
390  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
391                          } else {                          } else {
                                 meteor( 'read', $tag );  
392                                  read_tag( $tag );                                  read_tag( $tag );
393                          }                          }
394                  } else {                  } else {
# Line 329  sub update_visible_tags { Line 397  sub update_visible_tags {
397                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
398    
399                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
400                                  write_tag( $tag );                                  write_tag( $tag );
401                  }                  }
402                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
403                                  secure_tag( $tag );                                  secure_tag( $tag );
404                  }                  }
405          }          }
406    
407          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
408                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
409                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
410          }          }
411    
412          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 379  sub read_tag_data { Line 444  sub read_tag_data {
444          return $last_block + 1;          return $last_block + 1;
445  }  }
446    
447    my $saved_in_log;
448    
449  sub decode_tag {  sub decode_tag {
450          my $tag = shift;          my $tag = shift;
451    
452          my $data = $tags_data->{$tag} || die "no data for $tag";          my $data = $tags_data->{$tag};
453            if ( ! $data ) {
454                    warn "no data for $tag\n";
455                    return;
456            }
457    
458          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);
459          my $hash = {          my $hash = {
# Line 400  sub decode_tag { Line 471  sub decode_tag {
471                  custom => $custom,                  custom => $custom,
472          };          };
473    
474            if ( ! $saved_in_log->{$tag}++ ) {
475                    open(my $log, '>>', 'rfid-log.txt');
476                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
477                    close($log);
478            }
479    
480          return $hash;          return $hash;
481  }  }
482    
483    sub forget_tag {
484            my $tag = shift;
485            delete $tags_data->{$tag};
486            delete $visible_tags->{$tag};
487    }
488    
489  sub read_tag {  sub read_tag {
490          my ( $tag ) = @_;          my ( $tag ) = @_;
491    
# Line 415  sub read_tag { Line 498  sub read_tag {
498          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
499    
500                  cmd(                  cmd(
501                           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 ),
502                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
503                          "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";
504                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
505                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
506                          },                          },
507                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
508                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
509                          },                          },
510                            "D6 00 0D 02 06 $tag", sub {
511                                    my $rest = shift;
512                                    print "ERROR reading $tag ", as_hex($rest), $/;
513                                    forget_tag $tag;
514                                    $start_block = $max_rfid_block; # XXX break out of while
515                            },
516                  );                  );
517    
518          }          }
# Line 431  sub read_tag { Line 520  sub read_tag {
520          my $security;          my $security;
521    
522          cmd(          cmd(
523                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
524                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
525                          my $rest = shift;                          my $rest = shift;
526                          my $from_tag;                          my $from_tag;
# Line 440  sub read_tag { Line 529  sub read_tag {
529                          $security = as_hex( $security );                          $security = as_hex( $security );
530                          $tags_security->{$tag} = $security;                          $tags_security->{$tag} = $security;
531                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
532                  }                  },
533                    "D6 00 0C 0A 06", sub {
534                            my $rest = shift;
535                            warn "ERROR reading security from $rest\n";
536                            forget_tag $tag;
537                    },
538          );          );
539    
540          print "TAG $tag ", dump(decode_tag( $tag ));          print "TAG $tag ", dump(decode_tag( $tag ));
541  }  }
542    
543  sub write_tag {  sub write_tag {
544          my ($tag) = @_;          my ($tag,$data) = @_;
545    
546          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
547            $data = read_file( $path ) if -e $path;
548    
549            die "no data" unless $data;
550    
         my $data = read_file( $path );  
551          my $hex_data;          my $hex_data;
552    
553          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 479  sub write_tag { Line 575  sub write_tag {
575          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
576    
577          cmd(          cmd(
578                  "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",
579                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
580          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
581    
582          my $to = $path;          my $to = $path;
# Line 489  sub write_tag { Line 585  sub write_tag {
585          rename $path, $to;          rename $path, $to;
586          print ">> $to\n";          print ">> $to\n";
587    
588          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
589    }
590    
591    sub secure_tag_with {
592            my ( $tag, $data ) = @_;
593    
594            cmd(
595                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
596                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
597            );
598    
599            forget_tag $tag;
600  }  }
601    
602  sub secure_tag {  sub secure_tag {
# Line 498  sub secure_tag { Line 605  sub secure_tag {
605          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
606          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
607    
608          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() },  
         );  
609    
610          my $to = $path;          my $to = $path;
611          $to .= '.' . time();          $to .= '.' . time();
# Line 550  sub writechunk Line 654  sub writechunk
654  sub as_hex {  sub as_hex {
655          my @out;          my @out;
656          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
657                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
658                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
659                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
660                  push @out, $hex;                  push @out, $hex;
# Line 564  sub read_bytes { Line 668  sub read_bytes {
668          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
669                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
670                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
671                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
672                    last if $c == 0;
673                  $data .= $b;                  $data .= $b;
674          }          }
675          $desc ||= '?';          $desc ||= '?';
# Line 622  sub checksum { Line 727  sub checksum {
727          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
728    
729          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
730                  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";
731                  return $bytes . $xor;                  return $bytes . $xor;
732          }          }
733          return $bytes . $checksum;          return $bytes . $checksum;
# Line 664  sub readchunk { Line 769  sub readchunk {
769                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
770                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
771          } else {          } else {
772                  print "NO DISPATCH for ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
773          }          }
774    
775          return $data;          return $data;
Legend:
Removed from v.58  
changed lines
  Added in v.83
  ViewVC Help
Powered by ViewVC 1.1.26