/[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 91 by dpavlin, Fri Jul 16 16:34:13 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            while (my $client = $server->accept()) {
62                    $client->autoflush(1);
63                    my $request = <$client>;
64    
65                    warn "WEB << $request\n" if $debug;
66    
67                    if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
68                            my $method = $1;
69                            my $param;
70                            if ( $method =~ s{\?(.+)}{} ) {
71                                    foreach my $p ( split(/[&;]/, $1) ) {
72                                            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  sub meteor {                          } else {
132          my @a = @_;                                  print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
133          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";  
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            my $max_block;
342    
343            cpr( "FF  B0 2B  01  $hex_uid", "Get System Information $hex_uid", sub {
344                    my $data = shift;
345    
346                    warn "# data ",as_hex($data);
347    
348                    my $DSFID    = substr($data,5-2,1);
349                    my $UID      = substr($data,6-2,8);
350                    my $AFI      = substr($data,14-2,1);
351                    my $MEM      = substr($data,15-2,1);
352                    my $SIZE     = substr($data,16-2,1);
353                    my $IC_REF   = substr($data,17-2,1);
354    
355                    warn "# split ",as_hex( $DSFID, $UID, $AFI, $MEM, $SIZE, $IC_REF );
356    
357                    $max_block = ord($SIZE);
358            });
359    
360            my $transponder_data;
361    
362            my $block = 0;
363            while ( $block < $max_block ) {
364                    cpr( sprintf("FF  B0 23  01  $hex_uid %02x 04", $block), "Read Multiple Blocks $block", sub {
365                            my $data = shift;
366    
367                            my $DB_N    = ord substr($data,5-2,1);
368                            my $DB_SIZE = ord substr($data,6-2,1);
369    
370                            $data = substr($data,7-2,-2);
371                            warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data );
372                            foreach ( 1 .. $DB_N ) {
373                                    my $sec = substr($data,0,1);
374                                    my $db  = substr($data,1,$DB_SIZE);
375                                    warn "block $_ ",dump( $sec, $db );
376                                    $transponder_data .= reverse split(//,$db);
377                                    $data = substr($data, $DB_SIZE + 1);
378                            }
379                    });
380                    $block += 4;
381            }
382    
383            warn "DATA $hex_uid ", dump($transponder_data);
384            exit;
385    }
386    
387    
388    my $inventory;
389    
390    while(1) {
391    
392    cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
393            my $data = shift;
394            if (length($data) < 5 + 2 ) {
395                    warn "# no tags in range\n";
396                    return;
397            }
398            my $data_sets = ord(substr($data,3,1));
399            $data = substr($data,4);
400            foreach ( 1 .. $data_sets ) {
401                    my $tr_type = substr($data,0,1);
402                    die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
403                    my $dsfid   = substr($data,1,1);
404                    my $uid     = substr($data,2,8);
405                    $inventory->{$uid}++;
406                    $data = substr($data,10);
407                    warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
408    
409                    cpr_read( $uid );
410            }
411            warn "inventory: ",dump($inventory);
412    });
413    
414    }
415    
416    #cpr( '', '?' );
417    
418    exit;
419  # initial hand-shake with device  # initial hand-shake with device
420    
421  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
422       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
423          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
424          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
425  });  });
426    
427  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?',
428       '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() }  );
429    
430  # start scanning for tags  sub scan_for_tags {
431    
432  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          my @tags;
433           'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8  
434                  my $rest = shift || die "no rest?";          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
435                  my $nr = ord( substr( $rest, 0, 1 ) );                   'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
436                            my $rest = shift || die "no rest?";
437                  if ( ! $nr ) {                          my $nr = ord( substr( $rest, 0, 1 ) );
438                          print "no tags in range\n";  
439                          update_visible_tags();                          if ( ! $nr ) {
440                          meteor( 'info-none-in-range' );                                  _log "no tags in range\n";
441                          $tags_data = {};                                  update_visible_tags();
442                  } else {                                  $tags_data = {};
443                            } else {
444    
445                                    my $tags = substr( $rest, 1 );
446                                    my $tl = length( $tags );
447                                    die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
448    
449                                    push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
450                                    warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
451                                    _log "$nr tags in range: ", join(',', @tags ) , "\n";
452    
453                          my $tags = substr( $rest, 1 );                                  update_visible_tags( @tags );
454                            }
455                    }
456            );
457    
458                          my $tl = length( $tags );          diag "tags: ",dump( @tags );
459                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;          return $tags_data;
460    
461                          my @tags;  }
                         push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );  
                         warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;  
                         print "$nr tags in range: ", join(',', @tags ) , "\n";  
462    
463                          meteor( 'info-in-range', join(' ',@tags));  # start scanning for tags
464    
465                          update_visible_tags( @tags );  if ( $http_server ) {
466                  }          http_server;
467    } else {
468            while (1) {
469                    scan_for_tags;
470                    sleep 1;
471          }          }
472  ) while(1);  }
 #) foreach ( 1 .. 100 );  
   
473    
474    die "over and out";
475    
476  sub update_visible_tags {  sub update_visible_tags {
477          my @tags = @_;          my @tags = @_;
# Line 198  sub update_visible_tags { Line 480  sub update_visible_tags {
480          $visible_tags = {};          $visible_tags = {};
481    
482          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
483                    $visible_tags->{$tag}++;
484                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
485                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
486  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
487                          } else {                          } else {
                                 meteor( 'read', $tag );  
488                                  read_tag( $tag );                                  read_tag( $tag );
489                          }                          }
                         $visible_tags->{$tag}++;  
490                  } else {                  } else {
491                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
492                  }                  }
493                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
494    
495                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
496                                  write_tag( $tag );                                  write_tag( $tag );
497                  }                  }
498                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
499                                  secure_tag( $tag );                                  secure_tag( $tag );
500                  }                  }
501          }          }
502    
503          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
504                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
505                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
506          }          }
507    
508          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 513  my $tag_data_block;
513  sub read_tag_data {  sub read_tag_data {
514          my ($start_block,$rest) = @_;          my ($start_block,$rest) = @_;
515          die "no rest?" unless $rest;          die "no rest?" unless $rest;
516    
517            my $last_block = 0;
518    
519          warn "## DATA [$start_block] ", dump( $rest ) if $debug;          warn "## DATA [$start_block] ", dump( $rest ) if $debug;
520          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
521          my $blocks = ord(substr($rest,8,1));          my $blocks = ord(substr($rest,8,1));
# Line 244  sub read_tag_data { Line 525  sub read_tag_data {
525                  warn "## block ",as_hex( $block ) if $debug;                  warn "## block ",as_hex( $block ) if $debug;
526                  my $ord   = unpack('v',substr( $block, 0, 2 ));                  my $ord   = unpack('v',substr( $block, 0, 2 ));
527                  my $expected_ord = $nr + $start_block;                  my $expected_ord = $nr + $start_block;
528                  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;
529                  my $data  = substr( $block, 2 );                  my $data  = substr( $block, 2 );
530                  die "data payload should be 4 bytes" if length($data) != 4;                  die "data payload should be 4 bytes" if length($data) != 4;
531                  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;
532                  $tag_data_block->{$tag}->[ $ord ] = $data;                  $tag_data_block->{$tag}->[ $ord ] = $data;
533                    $last_block = $ord;
534          }          }
535          $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });          $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });
536    
537          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));
538          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";
539    
540            return $last_block + 1;
541    }
542    
543    my $saved_in_log;
544    
545    sub decode_tag {
546            my $tag = shift;
547    
548            my $data = $tags_data->{$tag};
549            if ( ! $data ) {
550                    warn "no data for $tag\n";
551                    return;
552            }
553    
554            my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
555            my $hash = {
556                    u1 => $u1,
557                    u2 => $u2,
558                    set => ( $set_item & 0xf0 ) >> 4,
559                    total => ( $set_item & 0x0f ),
560    
561                    type => $type,
562                    content => $content,
563    
564                    branch => $br_lib >> 20,
565                    library => $br_lib & 0x000fffff,
566    
567                    custom => $custom,
568            };
569    
570            if ( ! $saved_in_log->{$tag}++ ) {
571                    open(my $log, '>>', 'rfid-log.txt');
572                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
573                    close($log);
574            }
575    
576            return $hash;
577    }
578    
579    sub forget_tag {
580            my $tag = shift;
581            delete $tags_data->{$tag};
582            delete $visible_tags->{$tag};
583  }  }
584    
585  sub read_tag {  sub read_tag {
# Line 263  sub read_tag { Line 589  sub read_tag {
589    
590          print "read_tag $tag\n";          print "read_tag $tag\n";
591    
592          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, @_ );  
                 },  
         );  
593    
594          cmd(          while ( $start_block < $max_rfid_block ) {
595                  "D6 00  0D  02      $tag   03   04     3970", "read $tag offset: 3 blocks: 4",  
596                  "D6 00  25  02 00", sub { # $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00                    cmd(
597                          read_tag_data( 3, @_ );                           sprintf( "D6 00  0D  02      $tag   %02x   %02x     BEEF", $start_block, $read_blocks ),
598                  }                                  "read $tag offset: $start_block blocks: $read_blocks",
599          );                          "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";
600                                    $start_block = read_tag_data( $start_block, @_ );
601                                    warn "# read tag upto $start_block\n";
602                            },
603                            "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
604                                    print "FIXME: tag $tag ready? (expected block read instead)\n";
605                            },
606                            "D6 00 0D 02 06 $tag", sub {
607                                    my $rest = shift;
608                                    print "ERROR reading $tag ", as_hex($rest), $/;
609                                    forget_tag $tag;
610                                    $start_block = $max_rfid_block; # XXX break out of while
611                            },
612                    );
613    
614            }
615    
616          my $security;          my $security;
617    
618          cmd(          cmd(
619                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
620                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
621                          my $rest = shift;                          my $rest = shift;
622                          my $from_tag;                          my $from_tag;
623                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
624                          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 );
625                          $security = as_hex( $security );                          $security = as_hex( $security );
626                            $tags_security->{$tag} = $security;
627                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
628                  }                  },
629                    "D6 00 0C 0A 06", sub {
630                            my $rest = shift;
631                            warn "ERROR reading security from $rest\n";
632                            forget_tag $tag;
633                    },
634          );          );
635    
636          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";  
   
637  }  }
638    
639  sub write_tag {  sub write_tag {
640          my ($tag) = @_;          my ($tag,$data) = @_;
641    
642          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
643            $data = read_file( $path ) if -e $path;
644    
645            die "no data" unless $data;
646    
         my $data = read_file( $path );  
647          my $hex_data;          my $hex_data;
648    
649          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 317  sub write_tag { Line 651  sub write_tag {
651                  $hex_data =~ s{\s+}{}g;                  $hex_data =~ s{\s+}{}g;
652          } else {          } else {
653    
                 # pad to block size  
654                  $data .= "\0" x ( 4 - ( length($data) % 4 ) );                  $data .= "\0" x ( 4 - ( length($data) % 4 ) );
655    
656                  my $max_len = 7 * 4;                  my $max_len = $max_rfid_block * 4;
657    
658                  if ( length($data) > $max_len ) {                  if ( length($data) > $max_len ) {
659                          $data = substr($data,0,$max_len);                          $data = substr($data,0,$max_len);
# Line 331  sub write_tag { Line 664  sub write_tag {
664          }          }
665    
666          my $len = length($hex_data) / 2;          my $len = length($hex_data) / 2;
667          my $blocks = sprintf('%02x', $len / 4);          # pad to block size
668            $hex_data .= '00' x ( 4 - $len % 4 );
669            my $blocks = sprintf('%02x', length($hex_data) / 4);
670    
671          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
672    
673          cmd(          cmd(
674                  "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",
675                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
676          ) foreach ( 1 .. 3 ); # xxx 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
677    
678          my $to = $path;          my $to = $path;
679          $to .= '.' . time();          $to .= '.' . time();
# Line 346  sub write_tag { Line 681  sub write_tag {
681          rename $path, $to;          rename $path, $to;
682          print ">> $to\n";          print ">> $to\n";
683    
684          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
685    }
686    
687    sub secure_tag_with {
688            my ( $tag, $data ) = @_;
689    
690            cmd(
691                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
692                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
693            );
694    
695            forget_tag $tag;
696  }  }
697    
698  sub secure_tag {  sub secure_tag {
# Line 355  sub secure_tag { Line 701  sub secure_tag {
701          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
702          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
703    
704          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() },  
         );  
705    
706          my $to = $path;          my $to = $path;
707          $to .= '.' . time();          $to .= '.' . time();
# Line 407  sub writechunk Line 750  sub writechunk
750  sub as_hex {  sub as_hex {
751          my @out;          my @out;
752          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
753                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
754                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
755                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
756                  push @out, $hex;                  push @out, $hex;
# Line 421  sub read_bytes { Line 764  sub read_bytes {
764          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
765                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
766                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
767                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
768                    last if $c == 0;
769                  $data .= $b;                  $data .= $b;
770          }          }
771          $desc ||= '?';          $desc ||= '?';
# Line 439  sub skip_assert { Line 783  sub skip_assert {
783  sub assert {  sub assert {
784          my ( $from, $to ) = @_;          my ( $from, $to ) = @_;
785    
         return unless $assert->{expect};  
   
786          $from ||= 0;          $from ||= 0;
787          $to = length( $assert->{expect} ) if ! defined $to;          $to = length( $assert->{expect} ) if ! defined $to;
788    
# Line 481  sub checksum { Line 823  sub checksum {
823          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
824    
825          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
826                  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";
827                  return $bytes . $xor;                  return $bytes . $xor;
828          }          }
829          return $bytes . $checksum;          return $bytes . $checksum;
# Line 490  sub checksum { Line 832  sub checksum {
832  our $dispatch;  our $dispatch;
833    
834  sub readchunk {  sub readchunk {
835          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
836    
837          # read header of packet          # read header of packet
838          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
# Line 518  sub readchunk { Line 860  sub readchunk {
860          } sort { length($a) <=> length($b) } keys %$dispatch;          } sort { length($a) <=> length($b) } keys %$dispatch;
861          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;
862    
863          if ( defined $to && $payload ) {          if ( defined $to ) {
864                  my $rest = substr( $payload, length($to) );                  my $rest = substr( $payload, length($to) ) if length($to) < length($payload);
865                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
866                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
867          } else {          } else {
868                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
869          }          }
870    
871          return $data;          return $data;
Legend:
Removed from v.39  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.26