/[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 39 by dpavlin, Mon Jun 1 21:07:11 2009 UTC cpr-m02.pl revision 88 by dpavlin, Fri Jul 16 13:33:10 2010 UTC
# Line 8  use Data::Dump qw/dump/; Line 8  use Data::Dump qw/dump/;
8  use Carp qw/confess/;  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10  use File::Slurp;  use File::Slurp;
11    use JSON;
12    use POSIX qw(strftime);
13    use Time::HiRes;
14    
15  use IO::Socket::INET;  use IO::Socket::INET;
16    
17  my $meteor_server = '192.168.1.13:4671';  my $debug = 0;
18  my $meteor_fh;  
19    my $tags_data;
20    my $tags_security;
21    my $visible_tags;
22    
23    my $listen_port = 9000;                  # pick something not in use
24    my $server_url  = "http://localhost:$listen_port";
25    
26    sub http_server {
27    
28            my $server = IO::Socket::INET->new(
29                    Proto     => 'tcp',
30                    LocalPort => $listen_port,
31                    Listen    => SOMAXCONN,
32                    Reuse     => 1
33            );
34                                                                      
35            die "can't setup server: $!" unless $server;
36    
37            print "Server $0 ready at $server_url\n";
38    
39            sub static {
40                    my ($client,$path) = @_;
41    
42                    $path = "www/$path";
43                    $path .= 'rfid.html' if $path =~ m{/$};
44    
45                    return unless -e $path;
46    
47                    my $type = 'text/plain';
48                    $type = 'text/html' if $path =~ m{\.htm};
49                    $type = 'application/javascript' if $path =~ m{\.js};
50    
51                    print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\n\r\n";
52                    open(my $html, $path);
53                    while(<$html>) {
54                            print $client $_;
55                    }
56                    close($html);
57    
58                    return $path;
59            }
60    
61  sub meteor {          while (my $client = $server->accept()) {
62          my @a = @_;                  $client->autoflush(1);
63          push @a, scalar localtime() if $a[0] =~ m{^info};                  my $request = <$client>;
64    
65          if ( ! defined $meteor_fh ) {                  warn "WEB << $request\n" if $debug;
66                  if ( $meteor_fh =  
67                                  IO::Socket::INET->new(                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
68                                          PeerAddr => $meteor_server,                          my $method = $1;
69                                          Timeout => 1,                          my $param;
70                                  )                          if ( $method =~ s{\?(.+)}{} ) {
71                  ) {                                  foreach my $p ( split(/[&;]/, $1) ) {
72                          warn "# meteor connected to $meteor_server";                                          my ($n,$v) = split(/=/, $p, 2);
73                                            $param->{$n} = $v;
74                                    }
75                                    warn "WEB << param: ",dump( $param ) if $debug;
76                            }
77                            if ( my $path = static( $client,$1 ) ) {
78                                    warn "WEB >> $path" if $debug;
79                            } elsif ( $method =~ m{/scan} ) {
80                                    my $tags = scan_for_tags();
81                                    my $json = { time => time() };
82                                    map {
83                                            my $d = decode_tag($_);
84                                            $d->{sid} = $_;
85                                            $d->{security} = $tags_security->{$_};
86                                            push @{ $json->{tags} },  $d;
87                                    } keys %$tags;
88                                    print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
89                                            $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 {
132                                    print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
133                            }
134                  } else {                  } else {
135                          warn "can't connect to meteor $meteor_server: $!";                          print $client "HTTP/1.0 500 No method\r\n\r\n";
                         $meteor_fh = 0;  
136                  }                  }
137                    close $client;
138          }          }
139    
140          if ( $meteor_fh ) {          die "server died";
141                  warn ">> meteor ",dump( @a );  }
142                  print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n"  
143    
144    my $last_message = {};
145    sub _message {
146            my $type = shift @_;
147            my $text = join(' ',@_);
148            my $last = $last_message->{$type};
149            if ( $text ne $last ) {
150                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
151                    $last_message->{$type} = $text;
152          }          }
153  }  }
154    
155  my $debug = 0;  sub _log { _message('log',@_) };
156    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    
165  my $program_path = './program/';  my $program_path = './program/';
166  my $secure_path = './secure/';  my $secure_path = './secure/';
167    
168    # http server
169    my $http_server = 1;
170    
171    # 3M defaults: 8,4
172    # cards 16, stickers: 8
173    my $max_rfid_block = 8;
174    my $read_blocks = 8;
175    
176  my $response = {  my $response = {
177          'd500090400110a0500027250'                              => 'version?',          'd500090400110a0500027250'                              => 'version?',
178          'd60007fe00000500c97b'                                  => 'no tag in range',          'd60007fe00000500c97b'                                  => 'no tag in range',
# Line 70  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,
196          'meteor=s'    => \$meteor_server,          'http-server!' => \$http_server,
197  ) or die $!;  ) or die $!;
198    
199  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 106  it under the same terms ans Perl itself. Line 229  it under the same terms ans Perl itself.
229    
230  =cut  =cut
231    
 my $tags_data;  
 my $visible_tags;  
   
232  my $item_type = {  my $item_type = {
233          1 => 'Book',          1 => 'Book',
234          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 134  $databits=$port->databits($databits); Line 254  $databits=$port->databits($databits);
254  $parity=$port->parity($parity);  $parity=$port->parity($parity);
255  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
256    
257  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
258    
259  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
260  $port->lookclear();  $port->lookclear();
# Line 145  $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_psst_wait {
291            # Protocol Start Synchronization Time (PSST): 5ms < data timeout 12 ms
292            Time::HiRes::sleep 0.005;
293    }
294    
295    sub cpr {
296            my ( $hex, $description, $coderef ) = @_;
297            my $bytes = str2bytes($hex);
298            my $len = pack( 'c', length( $bytes ) + 3 );
299            my $send = $len . $bytes;
300            my $checksum = cpr_m02_checksum($send);
301            $send .= $checksum;
302    
303            warn ">> ", as_hex( $send ), "\t\t[$description]\n";
304            $port->write( $send );
305    
306            cpr_psst_wait;
307    
308            my $r_len = $port->read(1);
309    
310            while ( ! $r_len ) {
311                    warn "# wait for response length 5ms\n";
312                    cpr_psst_wait;
313                    $r_len = $port->read(1);
314            }
315    
316            my $data_len = ord($r_len) - 1;
317            my $data = $port->read( $data_len );
318            warn "<< ", as_hex( $r_len . $data ),"\n";
319    
320            cpr_psst_wait;
321    
322            $coderef->( $data ) if $coderef;
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    
337    sub cpr_read {
338            my $uid = shift;
339            my $hex_uid = as_hex($uid);
340    
341            cpr( "FF  B0 23  01  $hex_uid 00 04", "Read Multiple Blocks $hex_uid" );
342    #       cpr( "FF  B0 2B  01  $hex_uid", "Get System Information $hex_uid" );
343    }
344    
345    
346    my $inventory;
347    
348    while(1) {
349    
350    cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
351            my $data = shift;
352            if (length($data) < 5 + 2 ) {
353                    warn "# no tags in range\n";
354                    return;
355            }
356            my $data_sets = ord(substr($data,3,1));
357            $data = substr($data,4);
358            foreach ( 1 .. $data_sets ) {
359                    my $tr_type = substr($data,0,1);
360                    die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
361                    my $dsfid   = substr($data,1,1);
362                    my $uid     = substr($data,2,8);
363                    $inventory->{$uid}++;
364                    $data = substr($data,10);
365                    warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
366    
367                    cpr_read( $uid );
368            }
369            warn "inventory: ",dump($inventory);
370    });
371    
372    }
373    
374    #cpr( '', '?' );
375    
376    exit;
377  # initial hand-shake with device  # initial hand-shake with device
378    
379  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
380       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
381          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
382          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
383  });  });
384    
385  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?',
386       'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );       'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );
387    
388  # start scanning for tags  sub scan_for_tags {
389    
390  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          my @tags;
          'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8  
                 my $rest = shift || die "no rest?";  
                 my $nr = ord( substr( $rest, 0, 1 ) );  
   
                 if ( ! $nr ) {  
                         print "no tags in range\n";  
                         update_visible_tags();  
                         meteor( 'info-none-in-range' );  
                         $tags_data = {};  
                 } else {  
391    
392                          my $tags = substr( $rest, 1 );          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
393                     'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
394                            my $rest = shift || die "no rest?";
395                            my $nr = ord( substr( $rest, 0, 1 ) );
396    
397                            if ( ! $nr ) {
398                                    _log "no tags in range\n";
399                                    update_visible_tags();
400                                    $tags_data = {};
401                            } else {
402    
403                          my $tl = length( $tags );                                  my $tags = substr( $rest, 1 );
404                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;                                  my $tl = length( $tags );
405                                    die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
406    
407                                    push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
408                                    warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
409                                    _log "$nr tags in range: ", join(',', @tags ) , "\n";
410    
411                          my @tags;                                  update_visible_tags( @tags );
412                          push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );                          }
413                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                  }
414                          print "$nr tags in range: ", join(',', @tags ) , "\n";          );
415    
416                          meteor( 'info-in-range', join(' ',@tags));          diag "tags: ",dump( @tags );
417            return $tags_data;
418    
419                          update_visible_tags( @tags );  }
                 }  
         }  
 ) while(1);  
 #) foreach ( 1 .. 100 );  
420    
421    # start scanning for tags
422    
423    if ( $http_server ) {
424            http_server;
425    } else {
426            while (1) {
427                    scan_for_tags;
428                    sleep 1;
429            }
430    }
431    
432    die "over and out";
433    
434  sub update_visible_tags {  sub update_visible_tags {
435          my @tags = @_;          my @tags = @_;
# Line 198  sub update_visible_tags { Line 438  sub update_visible_tags {
438          $visible_tags = {};          $visible_tags = {};
439    
440          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
441                    $visible_tags->{$tag}++;
442                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
443                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
444  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
445                          } else {                          } else {
                                 meteor( 'read', $tag );  
446                                  read_tag( $tag );                                  read_tag( $tag );
447                          }                          }
                         $visible_tags->{$tag}++;  
448                  } else {                  } else {
449                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
450                  }                  }
451                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
452    
453                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
454                                  write_tag( $tag );                                  write_tag( $tag );
455                  }                  }
456                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
457                                  secure_tag( $tag );                                  secure_tag( $tag );
458                  }                  }
459          }          }
460    
461          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
462                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
463                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
464          }          }
465    
466          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 235  my $tag_data_block; Line 471  my $tag_data_block;
471  sub read_tag_data {  sub read_tag_data {
472          my ($start_block,$rest) = @_;          my ($start_block,$rest) = @_;
473          die "no rest?" unless $rest;          die "no rest?" unless $rest;
474    
475            my $last_block = 0;
476    
477          warn "## DATA [$start_block] ", dump( $rest ) if $debug;          warn "## DATA [$start_block] ", dump( $rest ) if $debug;
478          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
479          my $blocks = ord(substr($rest,8,1));          my $blocks = ord(substr($rest,8,1));
# Line 244  sub read_tag_data { Line 483  sub read_tag_data {
483                  warn "## block ",as_hex( $block ) if $debug;                  warn "## block ",as_hex( $block ) if $debug;
484                  my $ord   = unpack('v',substr( $block, 0, 2 ));                  my $ord   = unpack('v',substr( $block, 0, 2 ));
485                  my $expected_ord = $nr + $start_block;                  my $expected_ord = $nr + $start_block;
486                  die "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;                  warn "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;
487                  my $data  = substr( $block, 2 );                  my $data  = substr( $block, 2 );
488                  die "data payload should be 4 bytes" if length($data) != 4;                  die "data payload should be 4 bytes" if length($data) != 4;
489                  warn sprintf "## tag %9s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;                  warn sprintf "## tag %9s %02d: %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
490                  $tag_data_block->{$tag}->[ $ord ] = $data;                  $tag_data_block->{$tag}->[ $ord ] = $data;
491                    $last_block = $ord;
492          }          }
493          $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });          $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });
494    
495          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));
496          print "DATA $tag ",dump( $tags_data ), " item type: ", ( $item_type->{ $item_type_nr } || "UNKWOWN '$item_type_nr' in " . dump( $item_type ) ), "\n";          print "DATA $tag ",dump( $tags_data ), " item type: ", ( $item_type->{ $item_type_nr } || "UNKWOWN '$item_type_nr'" ), "\n";
497    
498            return $last_block + 1;
499    }
500    
501    my $saved_in_log;
502    
503    sub decode_tag {
504            my $tag = shift;
505    
506            my $data = $tags_data->{$tag};
507            if ( ! $data ) {
508                    warn "no data for $tag\n";
509                    return;
510            }
511    
512            my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
513            my $hash = {
514                    u1 => $u1,
515                    u2 => $u2,
516                    set => ( $set_item & 0xf0 ) >> 4,
517                    total => ( $set_item & 0x0f ),
518    
519                    type => $type,
520                    content => $content,
521    
522                    branch => $br_lib >> 20,
523                    library => $br_lib & 0x000fffff,
524    
525                    custom => $custom,
526            };
527    
528            if ( ! $saved_in_log->{$tag}++ ) {
529                    open(my $log, '>>', 'rfid-log.txt');
530                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
531                    close($log);
532            }
533    
534            return $hash;
535    }
536    
537    sub forget_tag {
538            my $tag = shift;
539            delete $tags_data->{$tag};
540            delete $visible_tags->{$tag};
541  }  }
542    
543  sub read_tag {  sub read_tag {
# Line 263  sub read_tag { Line 547  sub read_tag {
547    
548          print "read_tag $tag\n";          print "read_tag $tag\n";
549    
550          cmd(          my $start_block = 0;
                 "D6 00  0D  02      $tag   00   03     1CC4", "read $tag offset: 0 blocks: 3",  
                 "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {  
                         print "FIXME: tag $tag ready?\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";  
                         read_tag_data( 0, @_ );  
                 },  
         );  
551    
552          cmd(          while ( $start_block < $max_rfid_block ) {
553                  "D6 00  0D  02      $tag   03   04     3970", "read $tag offset: 3 blocks: 4",  
554                  "D6 00  25  02 00", sub { # $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00                    cmd(
555                          read_tag_data( 3, @_ );                           sprintf( "D6 00  0D  02      $tag   %02x   %02x     BEEF", $start_block, $read_blocks ),
556                  }                                  "read $tag offset: $start_block blocks: $read_blocks",
557          );                          "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";
558                                    $start_block = read_tag_data( $start_block, @_ );
559                                    warn "# read tag upto $start_block\n";
560                            },
561                            "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
562                                    print "FIXME: tag $tag ready? (expected block read instead)\n";
563                            },
564                            "D6 00 0D 02 06 $tag", sub {
565                                    my $rest = shift;
566                                    print "ERROR reading $tag ", as_hex($rest), $/;
567                                    forget_tag $tag;
568                                    $start_block = $max_rfid_block; # XXX break out of while
569                            },
570                    );
571    
572            }
573    
574          my $security;          my $security;
575    
576          cmd(          cmd(
577                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
578                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
579                          my $rest = shift;                          my $rest = shift;
580                          my $from_tag;                          my $from_tag;
581                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
582                          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 );
583                          $security = as_hex( $security );                          $security = as_hex( $security );
584                            $tags_security->{$tag} = $security;
585                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
586                  }                  },
587                    "D6 00 0C 0A 06", sub {
588                            my $rest = shift;
589                            warn "ERROR reading security from $rest\n";
590                            forget_tag $tag;
591                    },
592          );          );
593    
594          my $data = $tags_data->{$tag} || die "no data for $tag";          print "TAG $tag ", dump(decode_tag( $tag ));
         my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);  
         my $set   = ( $set_item & 0xf0 ) >> 4;  
         my $total = ( $set_item & 0x0f );  
         my $branch  = $br_lib >> 20;  
         my $library = $br_lib & 0x000fffff;  
         print "TAG $tag [$u1] set: $set/$total [$u2] type: $type '$content' library: $library branch: $branch custom: $custom security: $security\n";  
   
595  }  }
596    
597  sub write_tag {  sub write_tag {
598          my ($tag) = @_;          my ($tag,$data) = @_;
599    
600          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
601            $data = read_file( $path ) if -e $path;
602    
603            die "no data" unless $data;
604    
         my $data = read_file( $path );  
605          my $hex_data;          my $hex_data;
606    
607          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 317  sub write_tag { Line 609  sub write_tag {
609                  $hex_data =~ s{\s+}{}g;                  $hex_data =~ s{\s+}{}g;
610          } else {          } else {
611    
                 # pad to block size  
612                  $data .= "\0" x ( 4 - ( length($data) % 4 ) );                  $data .= "\0" x ( 4 - ( length($data) % 4 ) );
613    
614                  my $max_len = 7 * 4;                  my $max_len = $max_rfid_block * 4;
615    
616                  if ( length($data) > $max_len ) {                  if ( length($data) > $max_len ) {
617                          $data = substr($data,0,$max_len);                          $data = substr($data,0,$max_len);
# Line 331  sub write_tag { Line 622  sub write_tag {
622          }          }
623    
624          my $len = length($hex_data) / 2;          my $len = length($hex_data) / 2;
625          my $blocks = sprintf('%02x', $len / 4);          # pad to block size
626            $hex_data .= '00' x ( 4 - $len % 4 );
627            my $blocks = sprintf('%02x', length($hex_data) / 4);
628    
629          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
630    
631          cmd(          cmd(
632                  "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",
633                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
634          ) foreach ( 1 .. 3 ); # xxx 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
635    
636          my $to = $path;          my $to = $path;
637          $to .= '.' . time();          $to .= '.' . time();
# Line 346  sub write_tag { Line 639  sub write_tag {
639          rename $path, $to;          rename $path, $to;
640          print ">> $to\n";          print ">> $to\n";
641    
642          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
643    }
644    
645    sub secure_tag_with {
646            my ( $tag, $data ) = @_;
647    
648            cmd(
649                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
650                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
651            );
652    
653            forget_tag $tag;
654  }  }
655    
656  sub secure_tag {  sub secure_tag {
# Line 355  sub secure_tag { Line 659  sub secure_tag {
659          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
660          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
661    
662          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() },  
         );  
663    
664          my $to = $path;          my $to = $path;
665          $to .= '.' . time();          $to .= '.' . time();
# Line 407  sub writechunk Line 708  sub writechunk
708  sub as_hex {  sub as_hex {
709          my @out;          my @out;
710          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
711                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
712                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
713                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
714                  push @out, $hex;                  push @out, $hex;
# Line 421  sub read_bytes { Line 722  sub read_bytes {
722          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
723                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
724                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
725                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
726                    last if $c == 0;
727                  $data .= $b;                  $data .= $b;
728          }          }
729          $desc ||= '?';          $desc ||= '?';
# Line 439  sub skip_assert { Line 741  sub skip_assert {
741  sub assert {  sub assert {
742          my ( $from, $to ) = @_;          my ( $from, $to ) = @_;
743    
         return unless $assert->{expect};  
   
744          $from ||= 0;          $from ||= 0;
745          $to = length( $assert->{expect} ) if ! defined $to;          $to = length( $assert->{expect} ) if ! defined $to;
746    
# Line 481  sub checksum { Line 781  sub checksum {
781          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
782    
783          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
784                  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";
785                  return $bytes . $xor;                  return $bytes . $xor;
786          }          }
787          return $bytes . $checksum;          return $bytes . $checksum;
# Line 490  sub checksum { Line 790  sub checksum {
790  our $dispatch;  our $dispatch;
791    
792  sub readchunk {  sub readchunk {
793          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
794    
795          # read header of packet          # read header of packet
796          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
# Line 518  sub readchunk { Line 818  sub readchunk {
818          } sort { length($a) <=> length($b) } keys %$dispatch;          } sort { length($a) <=> length($b) } keys %$dispatch;
819          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;
820    
821          if ( defined $to && $payload ) {          if ( defined $to ) {
822                  my $rest = substr( $payload, length($to) );                  my $rest = substr( $payload, length($to) ) if length($to) < length($payload);
823                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
824                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
825          } else {          } else {
826                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
827          }          }
828    
829          return $data;          return $data;
Legend:
Removed from v.39  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.26