/[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 52 by dpavlin, Wed Jun 24 10:20:20 2009 UTC cpr-m02.pl revision 82 by dpavlin, Fri Jul 9 23:10:05 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 $meteor_server = '192.168.1.13:4671';  my $tags_data;
19  my $meteor_fh;  my $tags_security;
20    my $visible_tags;
 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"  
         }  
 }  
21    
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 51  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) = @_;
40    
41                  $path = "www/$path";                  $path = "www/$path";
42                    $path .= 'rfid.html' if $path =~ m{/$};
43    
44                  return unless -e $path;                  return unless -e $path;
45    
# Line 100  sub http_server { Line 81  sub http_server {
81                                  map {                                  map {
82                                          my $d = decode_tag($_);                                          my $d = decode_tag($_);
83                                          $d->{sid} = $_;                                          $d->{sid} = $_;
84                                            $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 132  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 145  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 168  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 205  it under the same terms ans Perl itself. Line 228  it under the same terms ans Perl itself.
228    
229  =cut  =cut
230    
 my $tags_data;  
 my $visible_tags;  
   
231  my $item_type = {  my $item_type = {
232          1 => 'Book',          1 => 'Book',
233          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 244  $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 = 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 );
298            writechunk( $send );
299            my $r_len = read_bytes( 1, 'response length' );
300            $r_len = ord($r_len) - 1;
301            my $data = read_bytes( $r_len, 'data' );
302            warn "<< ", as_hex( $data );
303    }
304    
305    cpr( '00  52 00' );
306    
307    exit;
308  # initial hand-shake with device  # initial hand-shake with device
309    
310  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
311       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
312          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
313          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
314  });  });
315    
316  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 268  sub scan_for_tags { Line 328  sub scan_for_tags {
328                          if ( ! $nr ) {                          if ( ! $nr ) {
329                                  _log "no tags in range\n";                                  _log "no tags in range\n";
330                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
331                                  $tags_data = {};                                  $tags_data = {};
332                          } else {                          } else {
333    
# Line 280  sub scan_for_tags { Line 339  sub scan_for_tags {
339                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
340                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
341    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
342                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
343                          }                          }
344                  }                  }
# Line 297  sub scan_for_tags { Line 354  sub scan_for_tags {
354  if ( $http_server ) {  if ( $http_server ) {
355          http_server;          http_server;
356  } else {  } else {
357          scan_for_tags while 1;          while (1) {
358                    scan_for_tags;
359                    sleep 1;
360            }
361  }  }
362    
363  die "over and out";  die "over and out";
# Line 312  sub update_visible_tags { Line 372  sub update_visible_tags {
372                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
373                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
374                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
375  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
376                          } else {                          } else {
                                 meteor( 'read', $tag );  
377                                  read_tag( $tag );                                  read_tag( $tag );
378                          }                          }
379                  } else {                  } else {
# Line 323  sub update_visible_tags { Line 382  sub update_visible_tags {
382                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
383    
384                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
385                                  write_tag( $tag );                                  write_tag( $tag );
386                  }                  }
387                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
388                                  secure_tag( $tag );                                  secure_tag( $tag );
389                  }                  }
390          }          }
391    
392          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
393                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
394                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
395          }          }
396    
397          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 373  sub read_tag_data { Line 429  sub read_tag_data {
429          return $last_block + 1;          return $last_block + 1;
430  }  }
431    
432    my $saved_in_log;
433    
434  sub decode_tag {  sub decode_tag {
435          my $tag = shift;          my $tag = shift;
436    
437          my $data = $tags_data->{$tag} || die "no data for $tag";          my $data = $tags_data->{$tag};
438            if ( ! $data ) {
439                    warn "no data for $tag\n";
440                    return;
441            }
442    
443          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);
444          my $hash = {          my $hash = {
# Line 394  sub decode_tag { Line 456  sub decode_tag {
456                  custom => $custom,                  custom => $custom,
457          };          };
458    
459            if ( ! $saved_in_log->{$tag}++ ) {
460                    open(my $log, '>>', 'rfid-log.txt');
461                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
462                    close($log);
463            }
464    
465          return $hash;          return $hash;
466  }  }
467    
468    sub forget_tag {
469            my $tag = shift;
470            delete $tags_data->{$tag};
471            delete $visible_tags->{$tag};
472    }
473    
474  sub read_tag {  sub read_tag {
475          my ( $tag ) = @_;          my ( $tag ) = @_;
476    
# Line 409  sub read_tag { Line 483  sub read_tag {
483          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
484    
485                  cmd(                  cmd(
486                           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 ),
487                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
488                          "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";
489                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
490                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
491                          },                          },
492                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
493                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
494                          },                          },
495                            "D6 00 0D 02 06 $tag", sub {
496                                    my $rest = shift;
497                                    print "ERROR reading $tag ", as_hex($rest), $/;
498                                    forget_tag $tag;
499                                    $start_block = $max_rfid_block; # XXX break out of while
500                            },
501                  );                  );
502    
503          }          }
# Line 425  sub read_tag { Line 505  sub read_tag {
505          my $security;          my $security;
506    
507          cmd(          cmd(
508                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
509                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
510                          my $rest = shift;                          my $rest = shift;
511                          my $from_tag;                          my $from_tag;
512                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
513                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
514                          $security = as_hex( $security );                          $security = as_hex( $security );
515                            $tags_security->{$tag} = $security;
516                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
517                  }                  },
518                    "D6 00 0C 0A 06", sub {
519                            my $rest = shift;
520                            warn "ERROR reading security from $rest\n";
521                            forget_tag $tag;
522                    },
523          );          );
524    
525          print "TAG $tag ", dump(decode_tag( $tag ));          print "TAG $tag ", dump(decode_tag( $tag ));
526  }  }
527    
528  sub write_tag {  sub write_tag {
529          my ($tag) = @_;          my ($tag,$data) = @_;
530    
531          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
532            $data = read_file( $path ) if -e $path;
533    
534            die "no data" unless $data;
535    
         my $data = read_file( $path );  
536          my $hex_data;          my $hex_data;
537    
538          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 472  sub write_tag { Line 560  sub write_tag {
560          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
561    
562          cmd(          cmd(
563                  "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",
564                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
565          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
566    
567          my $to = $path;          my $to = $path;
# Line 482  sub write_tag { Line 570  sub write_tag {
570          rename $path, $to;          rename $path, $to;
571          print ">> $to\n";          print ">> $to\n";
572    
573          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
574    }
575    
576    sub secure_tag_with {
577            my ( $tag, $data ) = @_;
578    
579            cmd(
580                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
581                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
582            );
583    
584            forget_tag $tag;
585  }  }
586    
587  sub secure_tag {  sub secure_tag {
# Line 491  sub secure_tag { Line 590  sub secure_tag {
590          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
591          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
592    
593          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() },  
         );  
594    
595          my $to = $path;          my $to = $path;
596          $to .= '.' . time();          $to .= '.' . time();
# Line 543  sub writechunk Line 639  sub writechunk
639  sub as_hex {  sub as_hex {
640          my @out;          my @out;
641          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
642                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
643                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
644                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
645                  push @out, $hex;                  push @out, $hex;
# Line 557  sub read_bytes { Line 653  sub read_bytes {
653          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
654                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
655                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
656                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
657                  $data .= $b;                  $data .= $b;
658          }          }
659          $desc ||= '?';          $desc ||= '?';
# Line 615  sub checksum { Line 711  sub checksum {
711          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
712    
713          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
714                  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";
715                  return $bytes . $xor;                  return $bytes . $xor;
716          }          }
717          return $bytes . $checksum;          return $bytes . $checksum;
# Line 657  sub readchunk { Line 753  sub readchunk {
753                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
754                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
755          } else {          } else {
756                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
757          }          }
758    
759          return $data;          return $data;
Legend:
Removed from v.52  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.26