write_blocks
[Biblio-RFID.git] / lib / RFID / Serial / 3M810.pm
index 8cf0a5c..8fffb78 100644 (file)
@@ -3,8 +3,10 @@ package RFID::Serial::3M810;
 use base 'RFID::Serial';
 use RFID::Serial;
 
+use Data::Dump qw(dump);
 use Carp qw(confess);
 use Time::HiRes;
+use Digest::CRC;
 
 sub serial_settings {{
        device    => "/dev/ttyUSB1", # FIXME comment out before shipping
@@ -29,6 +31,16 @@ sub init {
 
 }
 
+sub checksum {
+       my $bytes = shift;
+       my $crc = Digest::CRC->new(
+               # midified CCITT to xor with 0xffff instead of 0x0000
+               width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
+       ) or die $!;
+       $crc->add( $bytes );
+       pack('n', $crc->digest);
+}
+
 sub wait_device {
        Time::HiRes::sleep 0.015;
 }
@@ -37,10 +49,10 @@ sub cmd {
        my ( $hex, $description, $coderef ) = @_;
        my $bytes = hex2bytes($hex);
        if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
-               my $len = pack( 'c', length( $bytes ) + 3 );
+               my $len = pack( 'n', length( $bytes ) + 2 );
                $bytes = $len . $bytes;
                my $checksum = checksum($bytes);
-               $bytes = "\xD6\x00" . $bytes . $checksum;
+               $bytes = "\xD6" . $bytes . $checksum;
        }
 
        warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
@@ -50,14 +62,27 @@ sub cmd {
 
        my $r_len = $port->read(3);
 
-       while ( ! $r_len ) {
+       while ( length($r_len) < 3 ) {
                wait_device;
-               $r_len = $port->read(3);
+               $r_len = $port->read( 3 - length($r_len) );
        }
 
+       wait_device;
+
        my $len = ord( substr($r_len,2,1) );
        $data = $port->read( $len );
-       warn "<< ", as_hex($r_len,$data)," $len\n";
+
+       while ( length($data) < $len ) {
+               warn "# short read ", length($data), " < $len\n";
+               wait_device;
+               $data .= $port->read( $len - length($data) );
+       }
+
+       warn "<< ", as_hex($r_len,$data),
+               ' | ',
+               substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
+               " $len bytes\n";
+
 
        $coderef->( $data ) if $coderef;
 
@@ -72,6 +97,8 @@ sub assert {
 
        confess "got ", as_hex($got), " expected ", as_hex($expected)
        unless substr($got,0,$len) eq substr($expected,0,$len);
+
+       return substr($got,$len);
 }
 
 sub setup {
@@ -79,16 +106,187 @@ sub setup {
 cmd(
 'D5 00  05   04 00 11   8C66', 'hw version', sub {
        my $data = shift;
-       assert $data => '04 00 11';
-       my $hw_ver = join('.', unpack('CCCC', substr($data,3)));
-       print "hardware version $hw_ver\n";
+       my $rest = assert $data => '04 00 11';
+       my $hw_ver = join('.', unpack('CCCC', $rest));
+       warn "# 3M 810 hardware version $hw_ver\n";
 });
 
 cmd(
-'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?', sub { assert(shift,
-'            13  00  02 01 01 03 02 02 03  00     E778'
+'13  04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
+'13  00 02 01 01 03 02 02 03 00'
 )});
+}
+
+=head2 inventory
+
+  my @tags = inventory;
+
+=cut
+
+sub inventory {
+
+       my @tags;
+
+cmd( 'FE  00 05', 'scan for tags', sub {
+       my $data = shift;
+       my $rest = assert $data => 'FE 00 00 05';
+       my $nr = ord( substr( $rest, 0, 1 ) );
+
+       if ( ! $nr ) {
+               warn "# no tags in range\n";
+       } else {
+               my $tags = substr( $rest, 1 );
+               my $tl = length( $tags );
+               die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+
+               foreach ( 0 .. $nr - 1 ) {
+                       push @tags, hex_tag substr($tags, $_ * 8, 8);
+               }
+       }
+
+});
+
+       warn "# tags ",dump @tags;
+       return @tags;
+}
+
+
+# 3M defaults: 8,4
+# cards 16, stickers: 8
+my $max_rfid_block = 8;
+my $blocks = 8;
+
+sub _matched {
+       my ( $data, $hex ) = @_;
+       my $b = hex2bytes $hex;
+       my $l = length($b);
+       if ( substr($data,0,$l) eq $b ) {
+               warn "_matched $hex [$l] in ",as_hex($data);
+               return substr($data,$l);
+       }
+}
+
+sub read_blocks {
+       my $tag = shift || confess "no tag?";
+       $tag = shift if ref($tag);
+
+       my $tag_blocks;
+       my $start = 0;
+       cmd(
+                sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
+                       my $data = shift;
+                       if ( my $rest = _matched $data => '02 00' ) {
+
+                               my $tag = hex_tag substr($rest,0,8);
+                               my $blocks = ord(substr($rest,8,1));
+                               warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
+                               foreach ( 1 .. $blocks ) {
+                                       my $pos = ( $_ - 1 ) * 6 + 9;
+                                       my $nr = unpack('v', substr($rest,$pos,2));
+                                       my $payload = substr($rest,$pos+2,4);
+                                       warn "## pos $pos block $nr ",as_hex($payload), $/;
+                                       $tag_blocks->{$tag}->[$nr] = $payload;
+                               }
+                       } elsif ( my $rest = _matched $data => 'FE 00 00 05 01' ) {
+                               warn "FIXME ready? ",as_hex $test;
+                       } elsif ( my $rest = _matched $data => '02 06' ) {
+                               warn "ERROR ",as_hex($rest);
+                       } else {
+                               warn "FIXME unsuported ",as_hex($rest);
+                       }
+       });
+
+       warn "# tag_blocks ",dump($tag_blocks);
+       return $tag_blocks;
+}
+
+sub write_blocks {
+       my $tag = shift;
+       $tag = shift if ref $tag;
+       my $data = join('', @_);
+
+       warn "## write_blocks ",dump($tag,$data);
+
+       if ( length($data) % 4 ) {
+               $data .= '\x00' x ( 4 - length($data) % 4 );
+               warn "# padded data to ",dump($data);
+       }
+
+       my $hex_data = as_hex $data;
+       my $blocks   = sprintf('%02x', length($data) / 4 );
+
+       cmd(
+               "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
+                       my $data = shift;
+                       if ( my $rest = _matched $data => '04 00' ) {
+                               my $tag = substr($rest,0,8);
+                               my $blocks = substr($rest,8,1);
+                               warn "# WRITE ",as_hex($tag), " [$blocks]\n";
+                       } elsif ( my $rest = _matched $data => '04 06' ) {
+                               warn "ERROR ",as_hex($rest);
+                       } else {
+                               die "UNSUPPORTED";
+                       }
+               }
+       );
+
+}
+
+sub read_afi {
+       my $tag = shift;
+       $tag = shift if ref $tag;
+
+       my $afi;
+
+       cmd(
+               "0A $tag", "read_afi $tag", sub {
+               my $data = shift;
+
+               if ( my $rest = _matched $data => '0A 00' ) {
+
+                       my $tag = substr($rest,0,8);
+                          $afi = substr($rest,8,1);
+
+                       warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+
+               } elsif ( my $rest = _matched $data => '0A 06' ) {
+                       warn "ERROR reading security from $tag ", as_hex($data);
+               } else {
+                       warn "IGNORED ",as_hex($data);
+               }
+       });
+       warn "## read_afi ",dump($tag, $afi);
+       return $afi;
+}
+
+sub write_afi {
+       my $tag = shift;
+       $tag = shift if ref $tag;
+       my $afi = shift || die "no afi?";
+
+       $afi = as_hex $afi;
+
+       cmd(
+               "09 $tag $afi", "write_afi $tag $afi", sub {
+               my $data = shift;
+
+               if ( my $rest = _matched $data => '09 00' ) {
+
+                       my $tag = substr($rest,0,8);
+                          $afi = substr($rest,8,1);
+
+                       warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
 
+               } elsif ( my $rest = _matched $data => '0A 06' ) {
+                       warn "ERROR writing AFI to $tag ", as_hex($data);
+                       undef $afi;
+               } else {
+                       warn "IGNORED ",as_hex($data);
+                       undef $afi;
+               }
+       });
+       warn "## write_afi ", dump( $tag, $afi );
+       return $afi;
 }
 
 1