1 package RFID::Biblio::Reader::3M810;
5 RFID::Biblio::Reader::3M810 - support for 3M 810 RFID reader
9 This module uses L<RFID::Biblio::Reader::Serial> over USB/serial adapter
10 with 3M 810 RFID reader, often used in library applications.
12 This is most mature implementation which supports full API defined
13 in L<RFID::Biblio::Reader::API>. This include scanning for all tags in reader
14 range, reading and writing of data, and AFI security manipulation.
16 This implementation is developed using Portmon on Windows to capture serial traffic
17 L<http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx>
19 Checksum for this reader is developed using help from C<selwyn>
20 L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
22 More inforation about process of reverse engeeniring protocol with
23 this reader is available at L<http://blog.rot13.org/rfid/>
30 use base 'RFID::Biblio::Reader::Serial';
33 use Data::Dump qw(dump);
38 sub serial_settings {{
54 $port->read_char_time(0);
55 $port->read_const_time(0);
58 my ( $count, $str ) = $port->read(3);
59 my $data = $port->read( ord(substr($str,2,1)) );
60 warn "drain ",as_hex( $str, $data ),"\n";
62 $port->read_char_time(100); # 0.1 s char timeout
63 $port->read_const_time(500); # 0.5 s read timeout
65 $port->write( hex2bytes( 'D5 00 05 04 00 11 8C66' ) );
66 # hw-version expect: 'D5 00 09 04 00 11 0A 05 00 02 7250'
67 my $data = $port->read( 12 );
70 warn "# probe response: ",as_hex($data);
71 if ( my $rest = assert $data => 'D5 00 09 04 00 11' ) {
72 my $hw_ver = join('.', unpack('CCCC', $rest));
73 warn "# 3M 810 hardware version $hw_ver\n";
76 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
77 '13 00 02 01 01 03 02 02 03 00'
88 my $crc = Digest::CRC->new(
89 # midified CCITT to xor with 0xffff instead of 0x0000
90 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
93 pack('n', $crc->digest);
97 my ( $hex, $description, $coderef ) = @_;
98 my $bytes = hex2bytes($hex);
99 if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
100 my $len = pack( 'n', length( $bytes ) + 2 );
101 $bytes = $len . $bytes;
102 my $checksum = checksum($bytes);
103 $bytes = "\xD6" . $bytes . $checksum;
106 warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
107 $port->write( $bytes );
109 my $r_len = $port->read(3);
111 while ( length($r_len) < 3 ) {
112 $r_len = $port->read( 3 - length($r_len) );
115 my $len = ord( substr($r_len,2,1) );
116 my $data = $port->read( $len );
118 warn "<< ", as_hex($r_len,$data),
120 substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
124 $coderef->( $data ) if $coderef;
129 my ( $got, $expected ) = @_;
130 $expected = hex2bytes($expected);
132 my $len = length($got);
133 $len = length($expected) if length $expected < $len;
135 confess "got ", as_hex($got), " expected ", as_hex($expected)
136 unless substr($got,0,$len) eq substr($expected,0,$len);
138 return substr($got,$len);
146 cmd( 'FE 00 05', 'scan for tags', sub {
148 my $rest = assert $data => 'FE 00 00 05';
149 my $nr = ord( substr( $rest, 0, 1 ) );
152 warn "# no tags in range\n";
154 my $tags = substr( $rest, 1 );
155 my $tl = length( $tags );
156 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
158 foreach ( 0 .. $nr - 1 ) {
159 push @tags, hex_tag substr($tags, $_ * 8, 8);
165 warn "# tags ",dump @tags;
171 # cards 16, stickers: 8
172 my $max_rfid_block = 8;
176 my ( $data, $hex ) = @_;
177 my $b = hex2bytes $hex;
179 if ( substr($data,0,$l) eq $b ) {
180 warn "_matched $hex [$l] in ",as_hex($data);
181 return substr($data,$l);
186 my $tag = shift || confess "no tag?";
187 $tag = shift if ref($tag);
192 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
194 if ( my $rest = _matched $data => '02 00' ) {
196 my $tag = hex_tag substr($rest,0,8);
197 my $blocks = ord(substr($rest,8,1));
198 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
199 foreach ( 1 .. $blocks ) {
200 my $pos = ( $_ - 1 ) * 6 + 9;
201 my $nr = unpack('v', substr($rest,$pos,2));
202 my $payload = substr($rest,$pos+2,4);
203 warn "## pos $pos block $nr ",as_hex($payload), $/;
204 $tag_blocks->{$tag}->[$nr] = $payload;
206 } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
207 warn "FIXME ready? ",as_hex $rest;
208 } elsif ( $rest = _matched $data => '02 06' ) {
209 warn "ERROR ",as_hex($rest);
211 warn "FIXME unsuported ",as_hex($rest);
215 warn "# tag_blocks ",dump($tag_blocks);
221 $tag = shift if ref $tag;
224 $data = join('', @$data) if ref $data eq 'ARRAY';
226 warn "## write_blocks ",dump($tag,$data);
228 if ( length($data) % 4 ) {
229 $data .= '\x00' x ( 4 - length($data) % 4 );
230 warn "# padded data to ",dump($data);
233 my $hex_data = as_hex $data;
234 my $blocks = sprintf('%02x', length($data) / 4 );
237 "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
239 if ( my $rest = _matched $data => '04 00' ) {
240 my $tag = substr($rest,0,8);
241 my $blocks = substr($rest,8,1);
242 warn "# WRITE ",as_hex($tag), " [$blocks]\n";
243 } elsif ( $rest = _matched $data => '04 06' ) {
244 warn "ERROR ",as_hex($rest);
255 $tag = shift if ref $tag;
260 "0A $tag", "read_afi $tag", sub {
263 if ( my $rest = _matched $data => '0A 00' ) {
265 my $tag = substr($rest,0,8);
266 $afi = substr($rest,8,1);
268 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
270 } elsif ( $rest = _matched $data => '0A 06' ) {
271 warn "ERROR reading security from $tag ", as_hex($data);
273 warn "IGNORED ",as_hex($data);
276 warn "## read_afi ",dump($tag, $afi);
282 $tag = shift if ref $tag;
283 my $afi = shift || die "no afi?";
288 "09 $tag $afi", "write_afi $tag $afi", sub {
291 if ( my $rest = _matched $data => '09 00' ) {
292 my $tag_back = hex_tag substr($rest,0,8);
293 die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
294 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
295 } elsif ( $rest = _matched $data => '0A 06' ) {
296 warn "ERROR writing AFI to $tag ", as_hex($data);
299 warn "IGNORED ",as_hex($data);
303 warn "## write_afi ", dump( $tag, $afi );
313 L<RFID::Biblio::Reader::API>