/[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 54 by dpavlin, Wed Jun 24 13:39:43 2009 UTC cpr-m02.pl revision 86 by dpavlin, Fri Jul 16 09:31:56 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    
# Line 18  my $tags_data; Line 20  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) = @_;
41    
42                  $path = "www/$path";                  $path = "www/$path";
43                    $path .= 'rfid.html' if $path =~ m{/$};
44    
45                  return unless -e $path;                  return unless -e $path;
46    
# Line 107  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 137  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 150  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 173  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 246  $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, $coderef ) = @_;
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 ), "\t\t[$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            my $t = Time::HiRes::time;
315    
316            $coderef->( $data ) if $coderef;
317    
318            my $dt = Time::HiRes::time - $t;
319            if ( $dt < 0.050 ) {
320                    my $s = 0.050 - $dt;
321                    warn "# sleep for more $s\n";
322                    Time::HiRes::sleep $s;
323            }
324    }
325    
326    # FF = COM-ADDR any
327    
328    cpr( 'FF  52 00',       'Boud Rate Detection' );
329    
330    cpr( 'FF  65',          'Get Software Version' );
331    
332    cpr( 'FF  66 00',       'Get Reader Info - General hard and firware' );
333    
334    cpr( 'FF  69',          'RF Reset' );
335    
336    my $inventory;
337    
338    while(1) {
339    
340    cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
341            my $data = shift;
342            my $data_sets = ord(substr($data,3,1));
343            $data = substr($data,4);
344            foreach ( 1 .. $data_sets ) {
345                    my $tr_type = substr($data,0,1);
346                    my $dsfid   = substr($data,1,1);
347                    my $uid     = substr($data,2,8);
348                    $inventory->{$uid}++;
349                    $data = substr($data,10);
350                    warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
351            }
352            warn "inventory: ",dump($inventory);
353    });
354    
355    }
356    
357    #cpr( '', '?' );
358    
359    exit;
360  # initial hand-shake with device  # initial hand-shake with device
361    
362  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
363       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
364          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
365          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
366  });  });
367    
368  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 270  sub scan_for_tags { Line 380  sub scan_for_tags {
380                          if ( ! $nr ) {                          if ( ! $nr ) {
381                                  _log "no tags in range\n";                                  _log "no tags in range\n";
382                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
383                                  $tags_data = {};                                  $tags_data = {};
384                          } else {                          } else {
385    
# Line 282  sub scan_for_tags { Line 391  sub scan_for_tags {
391                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
392                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
393    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
394                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
395                          }                          }
396                  }                  }
# Line 299  sub scan_for_tags { Line 406  sub scan_for_tags {
406  if ( $http_server ) {  if ( $http_server ) {
407          http_server;          http_server;
408  } else {  } else {
409          scan_for_tags while 1;          while (1) {
410                    scan_for_tags;
411                    sleep 1;
412            }
413  }  }
414    
415  die "over and out";  die "over and out";
# Line 314  sub update_visible_tags { Line 424  sub update_visible_tags {
424                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
425                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
426                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
427  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
428                          } else {                          } else {
                                 meteor( 'read', $tag );  
429                                  read_tag( $tag );                                  read_tag( $tag );
430                          }                          }
431                  } else {                  } else {
# Line 325  sub update_visible_tags { Line 434  sub update_visible_tags {
434                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
435    
436                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
437                                  write_tag( $tag );                                  write_tag( $tag );
438                  }                  }
439                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
440                                  secure_tag( $tag );                                  secure_tag( $tag );
441                  }                  }
442          }          }
443    
444          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
445                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
446                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
447          }          }
448    
449          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 375  sub read_tag_data { Line 481  sub read_tag_data {
481          return $last_block + 1;          return $last_block + 1;
482  }  }
483    
484    my $saved_in_log;
485    
486  sub decode_tag {  sub decode_tag {
487          my $tag = shift;          my $tag = shift;
488    
489          my $data = $tags_data->{$tag} || die "no data for $tag";          my $data = $tags_data->{$tag};
490            if ( ! $data ) {
491                    warn "no data for $tag\n";
492                    return;
493            }
494    
495          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);
496          my $hash = {          my $hash = {
# Line 396  sub decode_tag { Line 508  sub decode_tag {
508                  custom => $custom,                  custom => $custom,
509          };          };
510    
511            if ( ! $saved_in_log->{$tag}++ ) {
512                    open(my $log, '>>', 'rfid-log.txt');
513                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
514                    close($log);
515            }
516    
517          return $hash;          return $hash;
518  }  }
519    
520    sub forget_tag {
521            my $tag = shift;
522            delete $tags_data->{$tag};
523            delete $visible_tags->{$tag};
524    }
525    
526  sub read_tag {  sub read_tag {
527          my ( $tag ) = @_;          my ( $tag ) = @_;
528    
# Line 411  sub read_tag { Line 535  sub read_tag {
535          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
536    
537                  cmd(                  cmd(
538                           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 ),
539                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
540                          "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";
541                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
542                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
543                          },                          },
544                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
545                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
546                          },                          },
547                            "D6 00 0D 02 06 $tag", sub {
548                                    my $rest = shift;
549                                    print "ERROR reading $tag ", as_hex($rest), $/;
550                                    forget_tag $tag;
551                                    $start_block = $max_rfid_block; # XXX break out of while
552                            },
553                  );                  );
554    
555          }          }
# Line 427  sub read_tag { Line 557  sub read_tag {
557          my $security;          my $security;
558    
559          cmd(          cmd(
560                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
561                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
562                          my $rest = shift;                          my $rest = shift;
563                          my $from_tag;                          my $from_tag;
# Line 436  sub read_tag { Line 566  sub read_tag {
566                          $security = as_hex( $security );                          $security = as_hex( $security );
567                          $tags_security->{$tag} = $security;                          $tags_security->{$tag} = $security;
568                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
569                  }                  },
570                    "D6 00 0C 0A 06", sub {
571                            my $rest = shift;
572                            warn "ERROR reading security from $rest\n";
573                            forget_tag $tag;
574                    },
575          );          );
576    
577          print "TAG $tag ", dump(decode_tag( $tag ));          print "TAG $tag ", dump(decode_tag( $tag ));
578  }  }
579    
580  sub write_tag {  sub write_tag {
581          my ($tag) = @_;          my ($tag,$data) = @_;
582    
583          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
584            $data = read_file( $path ) if -e $path;
585    
586            die "no data" unless $data;
587    
         my $data = read_file( $path );  
588          my $hex_data;          my $hex_data;
589    
590          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 475  sub write_tag { Line 612  sub write_tag {
612          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
613    
614          cmd(          cmd(
615                  "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",
616                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
617          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
618    
619          my $to = $path;          my $to = $path;
# Line 485  sub write_tag { Line 622  sub write_tag {
622          rename $path, $to;          rename $path, $to;
623          print ">> $to\n";          print ">> $to\n";
624    
625          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
626    }
627    
628    sub secure_tag_with {
629            my ( $tag, $data ) = @_;
630    
631            cmd(
632                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
633                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
634            );
635    
636            forget_tag $tag;
637  }  }
638    
639  sub secure_tag {  sub secure_tag {
# Line 494  sub secure_tag { Line 642  sub secure_tag {
642          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
643          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
644    
645          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() },  
         );  
646    
647          my $to = $path;          my $to = $path;
648          $to .= '.' . time();          $to .= '.' . time();
# Line 546  sub writechunk Line 691  sub writechunk
691  sub as_hex {  sub as_hex {
692          my @out;          my @out;
693          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
694                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
695                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
696                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
697                  push @out, $hex;                  push @out, $hex;
# Line 560  sub read_bytes { Line 705  sub read_bytes {
705          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
706                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
707                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
708                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
709                    last if $c == 0;
710                  $data .= $b;                  $data .= $b;
711          }          }
712          $desc ||= '?';          $desc ||= '?';
# Line 618  sub checksum { Line 764  sub checksum {
764          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
765    
766          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
767                  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";
768                  return $bytes . $xor;                  return $bytes . $xor;
769          }          }
770          return $bytes . $checksum;          return $bytes . $checksum;
# Line 660  sub readchunk { Line 806  sub readchunk {
806                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
807                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
808          } else {          } else {
809                  print "NO DISPATCH for ",as_hex( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
810          }          }
811    
812          return $data;          return $data;
Legend:
Removed from v.54  
changed lines
  Added in v.86
  ViewVC Help
Powered by ViewVC 1.1.26