lib/RFID/Biblio/CPRM02.pm

   1 package RFID::Biblio::CPRM02;
   2
   3 =head1 NAME
   4
   5 RFID::Biblio::CPRM02 - support for CPR-M02 RFID reader
   6
   7 =head1 DESCRIPTION
   8
   9 This module implements serial protocol over usb/serial adapter with CPR-M02
  10 reader as described in document C<H20800-16e-ID-B.pdf>
  11
  12 =cut
  13
  14 use warnings;
  15 use strict;
  16
  17 use base 'RFID::Biblio';
  18 use RFID::Biblio;
  19
  20 use Time::HiRes;
  21 use Data::Dump qw(dump);
  22
  23 my $debug = 1;
  24
  25 sub serial_settings {{
  26         device    => "/dev/ttyUSB0",
  27         baudrate  => "38400",
  28         databits  => "8",
  29         parity    => "even",
  30         stopbits  => "1",
  31         handshake => "none",
  32 }}
  33
  34 sub cpr_m02_checksum {
  35         my $data = shift;
  36
  37         my $preset = 0xffff;
  38         my $polynom = 0x8408;
  39
  40         my $crc = $preset;
  41         foreach my $i ( 0 .. length($data) - 1 ) {
  42                 $crc ^= ord(substr($data,$i,1));
  43                 for my $j ( 0 .. 7 ) {
  44                         if ( $crc & 0x0001 ) {
  45                                 $crc = ( $crc >> 1 ) ^ $polynom;
  46                         } else {
  47                                 $crc = $crc >> 1;
  48                         }
  49                 }
  50 #               warn sprintf('%d %04x', $i, $crc & 0xffff);
  51         }
  52
  53         return pack('v', $crc);
  54 }
  55
  56 sub wait_device {
  57         Time::HiRes::sleep 0.010;
  58 }
  59
  60 our $port;
  61
  62 sub cpr {
  63         my ( $hex, $description, $coderef ) = @_;
  64         my $bytes = hex2bytes($hex);
  65         my $len = pack( 'c', length( $bytes ) + 3 );
  66         my $send = $len . $bytes;
  67         my $checksum = cpr_m02_checksum($send);
  68         $send .= $checksum;
  69
  70         warn "##>> ", as_hex( $send ), "\t\t[$description]\n";
  71         $port->write( $send );
  72
  73         wait_device;
  74
  75         my $r_len = $port->read(1);
  76
  77         my $count = 100;
  78         while ( ! $r_len ) {
  79                 if ( $count-- == 0 ) {
  80                         warn "no response from device";
  81                         return;
  82                 }
  83                 wait_device;
  84                 $r_len = $port->read(1);
  85         }
  86
  87         wait_device;
  88
  89         my $data_len = ord($r_len) - 1;
  90         my $data = $port->read( $data_len );
  91         warn "##<< ", as_hex( $r_len . $data ),"\n";
  92
  93         wait_device;
  94
  95         $coderef->( $data ) if $coderef;
  96
  97 }
  98
  99 # FF = COM-ADDR any
 100
 101 sub init {
 102         my $self = shift;
 103
 104         $port = $self->port;
 105
 106 cpr( 'FF  52 00',       'Boud Rate Detection' );
 107
 108 cpr( 'FF  65',          'Get Software Version' );
 109
 110 cpr( 'FF  66 00',       'Get Reader Info - General hard and firware' );
 111
 112 cpr( 'FF  69',          'RF Reset' );
 113
 114         return 1;
 115 }
 116
 117
 118 sub inventory {
 119
 120         my @tags;
 121
 122 cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
 123         my $data = shift;
 124         if (length($data) < 5 + 2 ) {
 125                 warn "# no tags in range\n";
 126                 return;
 127         }
 128
 129         my $data_sets = ord(substr($data,3,1));
 130         $data = substr($data,4);
 131         foreach ( 1 .. $data_sets ) {
 132                 my $tr_type = substr($data,0,1);
 133                 die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
 134                 my $dsfid   = substr($data,1,1);
 135                 my $uid     = substr($data,2,8);
 136                 $data = substr($data,10);
 137                 warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
 138                 push @tags, hex_tag $uid;
 139
 140         }
 141 });
 142
 143         warn "# tags ",dump(@tags),$/;
 144         return @tags;
 145 }
 146
 147
 148 sub _get_system_info {
 149         my $tag = shift;
 150
 151         my $info;
 152
 153         cpr( "FF  B0 2B  01  $tag", "Get System Information $tag", sub {
 154                 my $data = shift;
 155
 156                 warn "# data ",as_hex($data);
 157
 158                 $info = {
 159                         DSFID    => substr($data,5-2,1),
 160                         UID      => substr($data,6-2,8),
 161                         AFI      => substr($data,14-2,1),
 162                         MEM      => substr($data,15-2,1),
 163                         SIZE     => substr($data,16-2,1),
 164                         IC_REF   => substr($data,17-2,1),
 165                 };
 166
 167         });
 168
 169         return $info;
 170 }
 171
 172
 173 sub read_blocks {
 174         my $tag = shift;
 175         $tag = shift if ref $tag;
 176
 177         my $info = _get_system_info $tag;
 178
 179         my $max_block = ord($info->{SIZE}) || die "no SIZE in ",dump( $info );
 180
 181         my $tag_blocks;
 182
 183         my $block = 0;
 184         while ( $block < $max_block ) {
 185                 cpr( sprintf("FF  B0 23  01  $tag %02x 04", $block), "Read Multiple Blocks $block", sub {
 186                         my $data = shift;
 187
 188                         my $DB_N    = ord substr($data,5-2,1);
 189                         my $DB_SIZE = ord substr($data,6-2,1);
 190
 191                         $data = substr($data,7-2,-2);
 192 #                       warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data ), " transponder_data: [$transponder_data] ",length($transponder_data),"\n";
 193                         foreach my $n ( 1 .. $DB_N ) {
 194                                 my $sec = ord(substr($data,0,1));
 195                                 my $db  = substr($data,1,$DB_SIZE);
 196                                 warn "## block $n ",dump( $sec, $db ) if $debug;
 197                                 $tag_blocks->{$tag}->[$block+$n-1] = reverse split(//,$db);
 198                                 $data = substr($data, $DB_SIZE + 1);
 199                         }
 200                 });
 201                 $block += 4;
 202         }
 203
 204         warn "# tag_blocks ",dump($tag_blocks),$/;
 205         return $tag_blocks;
 206 }
 207
 208
 209 sub write_blocks {
 210         my $tag = shift;
 211         $tag = shift if ref $tag;
 212
 213         my $data = shift;
 214         $data = join('', @$data) if ref $data eq 'ARRAY';
 215
 216         my $DB_ADR  = 0; # start at first block
 217         my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded
 218         if ( my $padding = length($data) % $DB_SIZE ) {
 219                 warn "WARNING: data block not padded to $DB_SIZE bytes";
 220                 $data .= "\x00" x $padding;
 221         }
 222         my $DB_N    = length($data) / $DB_SIZE;
 223
 224         my $send_data;
 225         foreach my $block ( 0 .. $DB_N ) {
 226                 $send_data .= reverse split(//, substr( $data, $block * $DB_SIZE, $DB_SIZE ) );
 227         }
 228
 229         cpr( sprintf("FF  B0 24  01  $tag   %02x %02x %02x  %s", $DB_ADR, $DB_N, $DB_SIZE, as_hex($send_data)), "Write Multiple Blocks $tag", sub {
 230                 my $data = shift;
 231                 warn dump( $data );
 232         });
 233
 234 }
 235
 236 sub read_afi {}
 237 sub write_afi {}
 238
 239 1