/[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 20 by dpavlin, Fri Oct 3 21:25:02 2008 UTC cpr-m02.pl revision 89 by dpavlin, Fri Jul 16 13:50:52 2010 UTC
# Line 7  use warnings; Line 7  use warnings;
7  use Data::Dump qw/dump/;  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;
11    use JSON;
12    use POSIX qw(strftime);
13    use Time::HiRes;
14    
15    use IO::Socket::INET;
16    
17  my $debug = 0;  my $debug = 0;
18    
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                            } else {
132                                    print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
133                            }
134                    } else {
135                            print $client "HTTP/1.0 500 No method\r\n\r\n";
136                    }
137                    close $client;
138            }
139    
140            die "server died";
141    }
142    
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    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/';
166    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 30  my $response = { Line 186  my $response = {
186  };  };
187    
188  GetOptions(  GetOptions(
189          'd|debug+'      => \$debug,          'd|debug+'    => \$debug,
190          'device=s'    => \$device,          'device=s'    => \$device,
191          'baudrate=i'  => \$baudrate,          'baudrate=i'  => \$baudrate,
192          'databits=i'  => \$databits,          'databits=i'  => \$databits,
193          'parity=s'    => \$parity,          'parity=s'    => \$parity,
194          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
195          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
196            'http-server!' => \$http_server,
197  ) or die $!;  ) or die $!;
198    
199    my $verbose = $debug > 0 ? $debug-- : 0;
200    
201  =head1 NAME  =head1 NAME
202    
203  3m-810 - support for 3M 810 RFID reader  3m-810 - support for 3M 810 RFID reader
# Line 70  it under the same terms ans Perl itself. Line 229  it under the same terms ans Perl itself.
229    
230  =cut  =cut
231    
232    my $item_type = {
233            1 => 'Book',
234            6 => 'CD/CD ROM',
235            2 => 'Magazine',
236            13 => 'Book with Audio Tape',
237            9 => 'Book with CD/CD ROM',
238            0 => 'Other',
239    
240            5 => 'Video',
241            4 => 'Audio Tape',
242            3 => 'Bound Journal',
243            8 => 'Book with Diskette',
244            7 => 'Diskette',
245    };
246    
247    warn "## known item type: ",dump( $item_type ) if $debug;
248    
249  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";
250  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
251  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
# Line 78  $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\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 89  $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", sub {
343                    my $data = shift;
344    
345                    warn "# data ",as_hex($data);
346    
347                    my $DSFID    = substr($data,5-2,1);
348                    my $UID      = substr($data,6-2,8);
349                    my $AFI      = substr($data,14-2,1);
350                    my $MEM_SIZE = substr($data,15-2,2);
351                    my $IC_REF   = substr($data,17-2,1);
352    
353                    warn "# split ",as_hex( $DSFID, $UID, $AFI, $MEM_SIZE, $IC_REF );
354    
355            });
356    }
357    
358    
359    my $inventory;
360    
361    while(1) {
362    
363    cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
364            my $data = shift;
365            if (length($data) < 5 + 2 ) {
366                    warn "# no tags in range\n";
367                    return;
368            }
369            my $data_sets = ord(substr($data,3,1));
370            $data = substr($data,4);
371            foreach ( 1 .. $data_sets ) {
372                    my $tr_type = substr($data,0,1);
373                    die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
374                    my $dsfid   = substr($data,1,1);
375                    my $uid     = substr($data,2,8);
376                    $inventory->{$uid}++;
377                    $data = substr($data,10);
378                    warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
379    
380                    cpr_read( $uid );
381            }
382            warn "inventory: ",dump($inventory);
383    });
384    
385    }
386    
387    #cpr( '', '?' );
388    
389    exit;
390  # initial hand-shake with device  # initial hand-shake with device
391    
392  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
393       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
394          print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
395            print "hardware version $hw_ver\n";
396  });  });
397    
398  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?',
399       '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() }  );
400    
401    sub scan_for_tags {
402    
403            my @tags;
404    
405            cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
406                     'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
407                            my $rest = shift || die "no rest?";
408                            my $nr = ord( substr( $rest, 0, 1 ) );
409    
410                            if ( ! $nr ) {
411                                    _log "no tags in range\n";
412                                    update_visible_tags();
413                                    $tags_data = {};
414                            } else {
415    
416                                    my $tags = substr( $rest, 1 );
417                                    my $tl = length( $tags );
418                                    die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
419    
420                                    push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
421                                    warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
422                                    _log "$nr tags in range: ", join(',', @tags ) , "\n";
423    
424                                    update_visible_tags( @tags );
425                            }
426                    }
427            );
428    
429            diag "tags: ",dump( @tags );
430            return $tags_data;
431    
432    }
433    
434  # start scanning for tags  # start scanning for tags
435    
436  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",  if ( $http_server ) {
437       'D6 00  07   FE  00 00  05     00  C97B', sub {          http_server;
438                  assert();  } else {
439                  print "no tag in range\n";          while (1) {
440                    scan_for_tags;
441          },                  sleep 1;
442           'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8          }
443                  my $rest = shift || die "no rest?";  }
444                  my $nr = ord( substr( $rest, 0, 1 ) );  
445    die "over and out";
446    
447    sub update_visible_tags {
448            my @tags = @_;
449    
450            my $last_visible_tags = $visible_tags;
451            $visible_tags = {};
452    
453                  if ( ! $nr ) {          foreach my $tag ( @tags ) {
454                          print "no tags in range\n";                  $visible_tags->{$tag}++;
455                    if ( ! defined $last_visible_tags->{$tag} ) {
456                            if ( defined $tags_data->{$tag} ) {
457                                    warn "$tag in range\n";
458                            } else {
459                                    read_tag( $tag );
460                            }
461                  } else {                  } else {
462                            warn "## using cached data for $tag" if $debug;
463                    }
464                    delete $last_visible_tags->{$tag}; # leave just missing tags
465    
466                    if ( -e "$program_path/$tag" ) {
467                                    write_tag( $tag );
468                    }
469                    if ( -e "$secure_path/$tag" ) {
470                                    secure_tag( $tag );
471                    }
472            }
473    
474                          my $tags = substr( $rest, 1 );          foreach my $tag ( keys %$last_visible_tags ) {
475                    my $data = delete $tags_data->{$tag};
476                    warn "$tag removed ", dump($data), $/;
477            }
478    
479                          my $tl = length( $tags );          warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
480                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;  }
481    
482                          my @tags;  my $tag_data_block;
                         push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );  
                         warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;  
                         print "seen $nr tags: ", join(',', @tags ) , "\n";  
483    
484                          # read data from tag  sub read_tag_data {
485                          read_tag( $_ ) foreach @tags;          my ($start_block,$rest) = @_;
486            die "no rest?" unless $rest;
487    
488            my $last_block = 0;
489    
490            warn "## DATA [$start_block] ", dump( $rest ) if $debug;
491            my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
492            my $blocks = ord(substr($rest,8,1));
493            $rest = substr($rest,9); # leave just data blocks
494            foreach my $nr ( 0 .. $blocks - 1 ) {
495                    my $block = substr( $rest, $nr * 6, 6 );
496                    warn "## block ",as_hex( $block ) if $debug;
497                    my $ord   = unpack('v',substr( $block, 0, 2 ));
498                    my $expected_ord = $nr + $start_block;
499                    warn "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;
500                    my $data  = substr( $block, 2 );
501                    die "data payload should be 4 bytes" if length($data) != 4;
502                    warn sprintf "## tag %9s %02d: %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
503                    $tag_data_block->{$tag}->[ $ord ] = $data;
504                    $last_block = $ord;
505            }
506            $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });
507    
508                  }          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));
509            print "DATA $tag ",dump( $tags_data ), " item type: ", ( $item_type->{ $item_type_nr } || "UNKWOWN '$item_type_nr'" ), "\n";
510    
511            return $last_block + 1;
512    }
513    
514    my $saved_in_log;
515    
516    sub decode_tag {
517            my $tag = shift;
518    
519            my $data = $tags_data->{$tag};
520            if ( ! $data ) {
521                    warn "no data for $tag\n";
522                    return;
523          }          }
 ) foreach ( 1 .. 100 );  
524    
525  my $read_cached;          my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
526            my $hash = {
527                    u1 => $u1,
528                    u2 => $u2,
529                    set => ( $set_item & 0xf0 ) >> 4,
530                    total => ( $set_item & 0x0f ),
531    
532                    type => $type,
533                    content => $content,
534    
535                    branch => $br_lib >> 20,
536                    library => $br_lib & 0x000fffff,
537    
538                    custom => $custom,
539            };
540    
541            if ( ! $saved_in_log->{$tag}++ ) {
542                    open(my $log, '>>', 'rfid-log.txt');
543                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
544                    close($log);
545            }
546    
547            return $hash;
548    }
549    
550    sub forget_tag {
551            my $tag = shift;
552            delete $tags_data->{$tag};
553            delete $visible_tags->{$tag};
554    }
555    
556  sub read_tag {  sub read_tag {
557          my ( $tag ) = @_;          my ( $tag ) = @_;
558    
559          return if $read_cached->{ $tag }++;          confess "no tag?" unless $tag;
560            
561          print "read_tag $tag\n";          print "read_tag $tag\n";
562    
563            my $start_block = 0;
564    
565            while ( $start_block < $max_rfid_block ) {
566    
567                    cmd(
568                             sprintf( "D6 00  0D  02      $tag   %02x   %02x     BEEF", $start_block, $read_blocks ),
569                                    "read $tag offset: $start_block blocks: $read_blocks",
570                            "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";
571                                    $start_block = read_tag_data( $start_block, @_ );
572                                    warn "# read tag upto $start_block\n";
573                            },
574                            "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
575                                    print "FIXME: tag $tag ready? (expected block read instead)\n";
576                            },
577                            "D6 00 0D 02 06 $tag", sub {
578                                    my $rest = shift;
579                                    print "ERROR reading $tag ", as_hex($rest), $/;
580                                    forget_tag $tag;
581                                    $start_block = $max_rfid_block; # XXX break out of while
582                            },
583                    );
584    
585            }
586    
587            my $security;
588    
589          cmd(          cmd(
590                  "D6 00  0D  02      $tag   00   03     1CC4", 'read $tag offset: 0 blocks: 3',                  "D6 00 0B 0A $tag BEEF", "check security $tag",
591                  "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                  "D6 00 0D 0A 00", sub {
592                          print "FIXME: tag $tag ready?\n";                          my $rest = shift;
593                            my $from_tag;
594                            ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
595                            die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
596                            $security = as_hex( $security );
597                            $tags_security->{$tag} = $security;
598                            warn "# SECURITY $tag = $security\n";
599                  },                  },
600                  "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 0C 0A 06", sub {
601                          my $rest = shift || die "no rest?";                          my $rest = shift;
602                          warn "## DATA ", dump( $rest ) if $debug;                          warn "ERROR reading security from $rest\n";
603                          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));                          forget_tag $tag;
604                          my $blocks = ord(substr($rest,8,1));                  },
605                          $rest = substr($rest,9); # leave just data blocks          );
606                          my @data;  
607                          foreach my $nr ( 0 .. $blocks - 1 ) {          print "TAG $tag ", dump(decode_tag( $tag ));
608                                  my $block = substr( $rest, $nr * 6, 6 );  }
609                                  warn "## block ",as_hex( $block ) if $debug;  
610                                  my $ord   = unpack('v',substr( $block, 0, 2 ));  sub write_tag {
611                                  die "got block $ord, expected block $nr from ",dump( $block ) if $ord != $nr;          my ($tag,$data) = @_;
612                                  my $data  = substr( $block, 2 );  
613                                  die "data payload should be 4 bytes" if length($data) != 4;          my $path = "$program_path/$tag";
614                                  warn sprintf "## tag %08s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;          $data = read_file( $path ) if -e $path;
615                                  $data[ $ord ] = $data;  
616                          }          die "no data" unless $data;
617                          $read_cached->{ $tag } = join('', @data);  
618                          print "DATA $tag ",dump( $read_cached ), "\n";          my $hex_data;
619    
620            if ( $data =~ s{^hex\s+}{} ) {
621                    $hex_data = $data;
622                    $hex_data =~ s{\s+}{}g;
623            } else {
624    
625                    $data .= "\0" x ( 4 - ( length($data) % 4 ) );
626    
627                    my $max_len = $max_rfid_block * 4;
628    
629                    if ( length($data) > $max_len ) {
630                            $data = substr($data,0,$max_len);
631                            warn "strip content to $max_len bytes\n";
632                  }                  }
633    
634                    $hex_data = unpack('H*', $data);
635            }
636    
637            my $len = length($hex_data) / 2;
638            # pad to block size
639            $hex_data .= '00' x ( 4 - $len % 4 );
640            my $blocks = sprintf('%02x', length($hex_data) / 4);
641    
642            print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
643    
644            cmd(
645                    "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  BEEF", "write $tag",
646                    "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
647            ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
648    
649            my $to = $path;
650            $to .= '.' . time();
651    
652            rename $path, $to;
653            print ">> $to\n";
654    
655            forget_tag $tag;
656    }
657    
658    sub secure_tag_with {
659            my ( $tag, $data ) = @_;
660    
661            cmd(
662                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
663                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
664          );          );
665    
666          #        D6 00  1F  02 00   $tag   03   00 00   04 11 00 01   01 00   30 30 30 30   02 00   30 30 30 30    E5F4          forget_tag $tag;
 if (0) {  
         cmd(    "D6 00  0D  02      $tag   03   04     3970", 'read offset: 3 blocks: 4' );  
   
         #        D6 00  25  02 00   $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00    
         #                           $tag                              05 00   00 00 00 00   06 00   00 00 00 00    B9BA  
         warn "?? D6 00  25  02 00   $tag   04                         03 00   39 30 31 32   04 00   ....\n";  
667  }  }
         warn "?? D6 00  0F  FE  00 00  05 01   $tag  941A ##### ready?\n";  
668    
669    sub secure_tag {
670            my ($tag) = @_;
671    
672            my $path = "$secure_path/$tag";
673            my $data = substr(read_file( $path ),0,2);
674    
675            secure_tag_with( $tag, $data );
676    
677            my $to = $path;
678            $to .= '.' . time();
679    
680            rename $path, $to;
681            print ">> $to\n";
682  }  }
683    
684  exit;  exit;
# Line 212  sub writechunk Line 713  sub writechunk
713  {  {
714          my $str=shift;          my $str=shift;
715          my $count = $port->write($str);          my $count = $port->write($str);
716            my $len = length($str);
717            die "wrong write length $count != $len in ",as_hex( $str ) if $count != $len;
718          print "#> ", as_hex( $str ), "\t[$count]\n" if $debug;          print "#> ", as_hex( $str ), "\t[$count]\n" if $debug;
719  }  }
720    
721  sub as_hex {  sub as_hex {
722          my @out;          my @out;
723          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
724                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
725                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
726                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
727                  push @out, $hex;                  push @out, $hex;
# Line 231  sub read_bytes { Line 734  sub read_bytes {
734          my $data = '';          my $data = '';
735          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
736                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
737                  #warn "## got $c bytes: ", as_hex($b), "\n";                  die "no bytes on port: $!" unless defined $b;
738                    warn "## got $c bytes: ", as_hex($b), "\n";
739                    last if $c == 0;
740                  $data .= $b;                  $data .= $b;
741          }          }
742          $desc ||= '?';          $desc ||= '?';
# Line 277  sub crcccitt { Line 782  sub crcccitt {
782  sub checksum {  sub checksum {
783          my ( $bytes, $checksum ) = @_;          my ( $bytes, $checksum ) = @_;
784    
         my $xor = crcccitt( substr($bytes,1) ); # skip D6  
         warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;  
   
785          my $len = ord(substr($bytes,2,1));          my $len = ord(substr($bytes,2,1));
786          my $len_real = length($bytes) - 1;          my $len_real = length($bytes) - 1;
787    
788          if ( $len_real != $len ) {          if ( $len_real != $len ) {
789                  print "length wrong: $len_real != $len\n";                  print "length wrong: $len_real != $len\n";
790                  $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,4);                  $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,3);
791          }          }
792    
793            my $xor = crcccitt( substr($bytes,1) ); # skip D6
794            warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
795    
796          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
797                  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";
798                  return $bytes . $xor;                  return $bytes . $xor;
799          }          }
800          return $bytes . $checksum;          return $bytes . $checksum;
# Line 298  sub checksum { Line 803  sub checksum {
803  our $dispatch;  our $dispatch;
804    
805  sub readchunk {  sub readchunk {
806          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
807    
808          # read header of packet          # read header of packet
809          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
# Line 313  sub readchunk { Line 818  sub readchunk {
818          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
819          checksum( $header . $length . $payload , $checksum );          checksum( $header . $length . $payload , $checksum );
820    
821          print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n";          print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n" if $verbose;
822    
823          $assert->{len}      = $len;          $assert->{len}      = $len;
824          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
# Line 327  sub readchunk { Line 832  sub readchunk {
832          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;
833    
834          if ( defined $to ) {          if ( defined $to ) {
835                  my $rest = substr( $payload, length($to) );                  my $rest = substr( $payload, length($to) ) if length($to) < length($payload);
836                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
837                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
838          } else {          } else {
839                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
840          }          }
841    
842          return $data;          return $data;
# Line 359  sub cmd { Line 864  sub cmd {
864          # fix checksum if needed          # fix checksum if needed
865          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
866    
867          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose;
868          $assert->{send} = $cmd;          $assert->{send} = $cmd;
869          writechunk( $bytes );          writechunk( $bytes );
870    
Legend:
Removed from v.20  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26