/[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 56 by dpavlin, Fri Jun 26 11:46:45 2009 UTC cpr-m02.pl revision 84 by dpavlin, Mon Jul 12 11:46:21 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    use Time::HiRes;
14    
15  use IO::Socket::INET;  use IO::Socket::INET;
16    
17  my $debug = 0;  my $debug = 2;
18    
19  my $tags_data;  my $tags_data;
20  my $tags_security;  my $tags_security;
21  my $visible_tags;  my $visible_tags;
22    
 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"  
         }  
 }  
   
23  my $listen_port = 9000;                  # pick something not in use  my $listen_port = 9000;                  # pick something not in use
24    my $server_url  = "http://localhost:$listen_port";
25    
26  sub http_server {  sub http_server {
27    
28          my $server = IO::Socket::INET->new(          my $server = IO::Socket::INET->new(
# Line 55  sub http_server { Line 32  sub http_server {
32                  Reuse     => 1                  Reuse     => 1
33          );          );
34                                                                                                                                        
35          die "can't setup server" unless $server;          die "can't setup server: $!" unless $server;
36    
37          print "Server $0 accepting clients at http://localhost:$listen_port/\n";          print "Server $0 ready at $server_url\n";
38    
39          sub static {          sub static {
40                  my ($client,$path) = @_;                  my ($client,$path) = @_;
# Line 108  sub http_server { Line 85  sub http_server {
85                                          $d->{security} = $tags_security->{$_};                                          $d->{security} = $tags_security->{$_};
86                                          push @{ $json->{tags} },  $d;                                          push @{ $json->{tags} },  $d;
87                                  } keys %$tags;                                  } keys %$tags;
88                                  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",
89                                          $param->{callback}, "(", to_json($json), ")\r\n";                                          $param->{callback}, "(", to_json($json), ")\r\n";
90                            } elsif ( $method =~ m{/program} ) {
91    
92                                    my $status = 501; # Not implementd
93    
94                                    foreach my $p ( keys %$param ) {
95                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
96                                            my $tag = $1;
97                                            my $content = "\x04\x11\x00\x01" . $param->{$p};
98                                            $content = "\x00" if $param->{$p} eq 'blank';
99                                            $status = 302;
100    
101                                            warn "PROGRAM $tag $content\n";
102                                            write_tag( $tag, $content );
103                                            secure_tag_with( $tag, $param->{$p} =~ /^130/ ? 'DA' : 'D7' );
104                                    }
105    
106                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
107    
108                            } elsif ( $method =~ m{/secure(.js)} ) {
109    
110                                    my $json = $1;
111    
112                                    my $status = 501; # Not implementd
113    
114                                    foreach my $p ( keys %$param ) {
115                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
116                                            my $tag = $1;
117                                            my $data = $param->{$p};
118                                            $status = 302;
119    
120                                            warn "SECURE $tag $data\n";
121                                            secure_tag_with( $tag, $data );
122                                    }
123    
124                                    if ( $json ) {
125                                            print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
126                                                    $param->{callback}, "({ ok: 1 })\r\n";
127                                    } else {
128                                            print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
129                                    }
130    
131                          } else {                          } else {
132                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
133                          }                          }
134                  } else {                  } else {
135                          print $client "HTTP/1.0 500 No method\r\n";                          print $client "HTTP/1.0 500 No method\r\n\r\n";
136                  }                  }
137                  close $client;                  close $client;
138          }          }
# Line 138  sub _log { _message('log',@_) }; Line 156  sub _log { _message('log',@_) };
156  sub diag { _message('diag',@_) };  sub diag { _message('diag',@_) };
157    
158  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
159  my $baudrate  = "19200";  my $baudrate  = "38400";
160  my $databits  = "8";  my $databits  = "8";
161  my $parity        = "none";  my $parity        = "even";
162  my $stopbits  = "1";  my $stopbits  = "1";
163  my $handshake = "none";  my $handshake = "none";
164    
# Line 151  my $secure_path = './secure/'; Line 169  my $secure_path = './secure/';
169  my $http_server = 1;  my $http_server = 1;
170    
171  # 3M defaults: 8,4  # 3M defaults: 8,4
172  my $max_rfid_block = 16;  # cards 16, stickers: 8
173    my $max_rfid_block = 8;
174  my $read_blocks = 8;  my $read_blocks = 8;
175    
176  my $response = {  my $response = {
# Line 174  GetOptions( Line 193  GetOptions(
193          'parity=s'    => \$parity,          'parity=s'    => \$parity,
194          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
195          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
         'meteor=s'    => \$meteor_server,  
196          'http-server!' => \$http_server,          'http-server!' => \$http_server,
197  ) or die $!;  ) or die $!;
198    
# Line 247  $port->read_char_time(5); Line 265  $port->read_char_time(5);
265  #$port->stty_inpck(1);  #$port->stty_inpck(1);
266  #$port->stty_istrip(1);  #$port->stty_istrip(1);
267    
268    sub cpr_m02_checksum {
269            my $data = shift;
270    
271            my $preset = 0xffff;
272            my $polynom = 0x8408;
273    
274            my $crc = $preset;
275            foreach my $i ( 0 .. length($data) - 1 ) {
276                    $crc ^= ord(substr($data,$i,1));
277                    for my $j ( 0 .. 7 ) {
278                            if ( $crc & 0x0001 ) {
279                                    $crc = ( $crc >> 1 ) ^ $polynom;
280                            } else {
281                                    $crc = $crc >> 1;
282                            }
283                    }
284    #               warn sprintf('%d %04x', $i, $crc & 0xffff);
285            }
286    
287            return pack('v', $crc);
288    }
289    
290    sub cpr {
291            my ( $hex, $description ) = shift;
292            my $bytes = str2bytes($hex);
293            my $len = pack( 'c', length( $bytes ) + 3 );
294            my $send = $len . $bytes;
295            my $checksum = cpr_m02_checksum($send);
296            $send .= $checksum;
297    
298            warn ">> ", as_hex( $send ), "[$description]\n";
299            $port->write( $send );
300    
301            my $r_len = $port->read(1);
302    
303            while ( ! $r_len ) {
304                    warn "# wait for response length 0.050\n";
305                    Time::HiRes::sleep 0.050;
306                    $r_len = $port->read(1);
307            }
308    
309            warn "<< response len: ", as_hex($r_len), "\n";
310            $r_len = ord($r_len) - 1;
311            my $data = $port->read( $r_len );
312            warn "<< ", as_hex( $data );
313    
314            Time::HiRes::sleep 0.050;
315    }
316    
317    #cpr( 'FF  52 00', 'detect boud rate' );
318    
319    #cpr( '00  65', 'software version' );
320    
321    cpr( 'FF  65', 'get ? info' );
322    
323    cpr( 'FF  69 00', 'get reader info' );
324    
325    cpr( 'FF B0 01 00', '?' );
326    
327    cpr( 'FF 69', '?' );
328    
329    #cpr( '', '?' );
330    
331    exit;
332  # initial hand-shake with device  # initial hand-shake with device
333    
334  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
335       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
336          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
337          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
338  });  });
339    
340  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 352  sub scan_for_tags {
352                          if ( ! $nr ) {                          if ( ! $nr ) {
353                                  _log "no tags in range\n";                                  _log "no tags in range\n";
354                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
355                                  $tags_data = {};                                  $tags_data = {};
356                          } else {                          } else {
357    
# Line 283  sub scan_for_tags { Line 363  sub scan_for_tags {
363                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
364                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
365    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
366                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
367                          }                          }
368                  }                  }
# Line 300  sub scan_for_tags { Line 378  sub scan_for_tags {
378  if ( $http_server ) {  if ( $http_server ) {
379          http_server;          http_server;
380  } else {  } else {
381          scan_for_tags while 1;          while (1) {
382                    scan_for_tags;
383                    sleep 1;
384            }
385  }  }
386    
387  die "over and out";  die "over and out";
# Line 315  sub update_visible_tags { Line 396  sub update_visible_tags {
396                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
397                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
398                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
399  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
400                          } else {                          } else {
                                 meteor( 'read', $tag );  
401                                  read_tag( $tag );                                  read_tag( $tag );
402                          }                          }
403                  } else {                  } else {
# Line 326  sub update_visible_tags { Line 406  sub update_visible_tags {
406                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
407    
408                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
409                                  write_tag( $tag );                                  write_tag( $tag );
410                  }                  }
411                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
412                                  secure_tag( $tag );                                  secure_tag( $tag );
413                  }                  }
414          }          }
415    
416          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
417                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
418                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
419          }          }
420    
421          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 376  sub read_tag_data { Line 453  sub read_tag_data {
453          return $last_block + 1;          return $last_block + 1;
454  }  }
455    
456    my $saved_in_log;
457    
458  sub decode_tag {  sub decode_tag {
459          my $tag = shift;          my $tag = shift;
460    
461          my $data = $tags_data->{$tag} || die "no data for $tag";          my $data = $tags_data->{$tag};
462            if ( ! $data ) {
463                    warn "no data for $tag\n";
464                    return;
465            }
466    
467          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);
468          my $hash = {          my $hash = {
# Line 397  sub decode_tag { Line 480  sub decode_tag {
480                  custom => $custom,                  custom => $custom,
481          };          };
482    
483            if ( ! $saved_in_log->{$tag}++ ) {
484                    open(my $log, '>>', 'rfid-log.txt');
485                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
486                    close($log);
487            }
488    
489          return $hash;          return $hash;
490  }  }
491    
492    sub forget_tag {
493            my $tag = shift;
494            delete $tags_data->{$tag};
495            delete $visible_tags->{$tag};
496    }
497    
498  sub read_tag {  sub read_tag {
499          my ( $tag ) = @_;          my ( $tag ) = @_;
500    
# Line 412  sub read_tag { Line 507  sub read_tag {
507          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
508    
509                  cmd(                  cmd(
510                           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 ),
511                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
512                          "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";
513                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
514                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
515                          },                          },
516                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
517                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
518                          },                          },
519                            "D6 00 0D 02 06 $tag", sub {
520                                    my $rest = shift;
521                                    print "ERROR reading $tag ", as_hex($rest), $/;
522                                    forget_tag $tag;
523                                    $start_block = $max_rfid_block; # XXX break out of while
524                            },
525                  );                  );
526    
527          }          }
# Line 428  sub read_tag { Line 529  sub read_tag {
529          my $security;          my $security;
530    
531          cmd(          cmd(
532                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
533                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
534                          my $rest = shift;                          my $rest = shift;
535                          my $from_tag;                          my $from_tag;
# Line 437  sub read_tag { Line 538  sub read_tag {
538                          $security = as_hex( $security );                          $security = as_hex( $security );
539                          $tags_security->{$tag} = $security;                          $tags_security->{$tag} = $security;
540                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
541                  }                  },
542                    "D6 00 0C 0A 06", sub {
543                            my $rest = shift;
544                            warn "ERROR reading security from $rest\n";
545                            forget_tag $tag;
546                    },
547          );          );
548    
549          print "TAG $tag ", dump(decode_tag( $tag ));          print "TAG $tag ", dump(decode_tag( $tag ));
550  }  }
551    
552  sub write_tag {  sub write_tag {
553          my ($tag) = @_;          my ($tag,$data) = @_;
554    
555          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
556            $data = read_file( $path ) if -e $path;
557    
558            die "no data" unless $data;
559    
         my $data = read_file( $path );  
560          my $hex_data;          my $hex_data;
561    
562          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 476  sub write_tag { Line 584  sub write_tag {
584          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
585    
586          cmd(          cmd(
587                  "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",
588                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
589          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
590    
591          my $to = $path;          my $to = $path;
# Line 486  sub write_tag { Line 594  sub write_tag {
594          rename $path, $to;          rename $path, $to;
595          print ">> $to\n";          print ">> $to\n";
596    
597          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
598    }
599    
600    sub secure_tag_with {
601            my ( $tag, $data ) = @_;
602    
603            cmd(
604                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
605                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
606            );
607    
608            forget_tag $tag;
609  }  }
610    
611  sub secure_tag {  sub secure_tag {
# Line 495  sub secure_tag { Line 614  sub secure_tag {
614          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
615          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
616    
617          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() },  
         );  
618    
619          my $to = $path;          my $to = $path;
620          $to .= '.' . time();          $to .= '.' . time();
# Line 547  sub writechunk Line 663  sub writechunk
663  sub as_hex {  sub as_hex {
664          my @out;          my @out;
665          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
666                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
667                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
668                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
669                  push @out, $hex;                  push @out, $hex;
# Line 561  sub read_bytes { Line 677  sub read_bytes {
677          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
678                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
679                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
680                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
681                    last if $c == 0;
682                  $data .= $b;                  $data .= $b;
683          }          }
684          $desc ||= '?';          $desc ||= '?';
# Line 619  sub checksum { Line 736  sub checksum {
736          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
737    
738          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
739                  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";
740                  return $bytes . $xor;                  return $bytes . $xor;
741          }          }
742          return $bytes . $checksum;          return $bytes . $checksum;
# Line 661  sub readchunk { Line 778  sub readchunk {
778                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
779                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
780          } else {          } else {
781                  print "NO DISPATCH for ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
782          }          }
783    
784          return $data;          return $data;
Legend:
Removed from v.56  
changed lines
  Added in v.84
  ViewVC Help
Powered by ViewVC 1.1.26