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 {{
52 $port->read_char_time(0);
53 $port->read_const_time(0);
56 my ( $count, $str ) = $port->read(3);
57 my $data = $port->read( ord(substr($str,2,1)) );
58 warn "drain ",as_hex( $str, $data ),"\n";
60 $port->read_char_time(100); # 0.1 s char timeout
61 $port->read_const_time(500); # 0.5 s read timeout
69 my $crc = Digest::CRC->new(
70 # midified CCITT to xor with 0xffff instead of 0x0000
71 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
74 pack('n', $crc->digest);
78 Time::HiRes::sleep 0.015;
82 my ( $hex, $description, $coderef ) = @_;
83 my $bytes = hex2bytes($hex);
84 if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
85 my $len = pack( 'n', length( $bytes ) + 2 );
86 $bytes = $len . $bytes;
87 my $checksum = checksum($bytes);
88 $bytes = "\xD6" . $bytes . $checksum;
91 warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
92 $port->write( $bytes );
96 my $r_len = $port->read(3);
98 while ( length($r_len) < 3 ) {
100 $r_len = $port->read( 3 - length($r_len) );
105 my $len = ord( substr($r_len,2,1) );
106 my $data = $port->read( $len );
108 while ( length($data) < $len ) {
109 warn "# short read ", length($data), " < $len\n";
111 $data .= $port->read( $len - length($data) );
114 warn "<< ", as_hex($r_len,$data),
116 substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
120 $coderef->( $data ) if $coderef;
125 my ( $got, $expected ) = @_;
126 $expected = hex2bytes($expected);
128 my $len = length($got);
129 $len = length($expected) if length $expected < $len;
131 confess "got ", as_hex($got), " expected ", as_hex($expected)
132 unless substr($got,0,$len) eq substr($expected,0,$len);
134 return substr($got,$len);
140 'D5 00 05 04 00 11 8C66', 'hw version', sub {
142 my $rest = assert $data => '04 00 11';
143 my $hw_ver = join('.', unpack('CCCC', $rest));
144 warn "# 3M 810 hardware version $hw_ver\n";
148 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
149 '13 00 02 01 01 03 02 02 03 00'
157 cmd( 'FE 00 05', 'scan for tags', sub {
159 my $rest = assert $data => 'FE 00 00 05';
160 my $nr = ord( substr( $rest, 0, 1 ) );
163 warn "# no tags in range\n";
165 my $tags = substr( $rest, 1 );
166 my $tl = length( $tags );
167 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
169 foreach ( 0 .. $nr - 1 ) {
170 push @tags, hex_tag substr($tags, $_ * 8, 8);
176 warn "# tags ",dump @tags;
182 # cards 16, stickers: 8
183 my $max_rfid_block = 8;
187 my ( $data, $hex ) = @_;
188 my $b = hex2bytes $hex;
190 if ( substr($data,0,$l) eq $b ) {
191 warn "_matched $hex [$l] in ",as_hex($data);
192 return substr($data,$l);
197 my $tag = shift || confess "no tag?";
198 $tag = shift if ref($tag);
203 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
205 if ( my $rest = _matched $data => '02 00' ) {
207 my $tag = hex_tag substr($rest,0,8);
208 my $blocks = ord(substr($rest,8,1));
209 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
210 foreach ( 1 .. $blocks ) {
211 my $pos = ( $_ - 1 ) * 6 + 9;
212 my $nr = unpack('v', substr($rest,$pos,2));
213 my $payload = substr($rest,$pos+2,4);
214 warn "## pos $pos block $nr ",as_hex($payload), $/;
215 $tag_blocks->{$tag}->[$nr] = $payload;
217 } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
218 warn "FIXME ready? ",as_hex $rest;
219 } elsif ( $rest = _matched $data => '02 06' ) {
220 warn "ERROR ",as_hex($rest);
222 warn "FIXME unsuported ",as_hex($rest);
226 warn "# tag_blocks ",dump($tag_blocks);
232 $tag = shift if ref $tag;
235 $data = join('', @$data) if ref $data eq 'ARRAY';
237 warn "## write_blocks ",dump($tag,$data);
239 if ( length($data) % 4 ) {
240 $data .= '\x00' x ( 4 - length($data) % 4 );
241 warn "# padded data to ",dump($data);
244 my $hex_data = as_hex $data;
245 my $blocks = sprintf('%02x', length($data) / 4 );
248 "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
250 if ( my $rest = _matched $data => '04 00' ) {
251 my $tag = substr($rest,0,8);
252 my $blocks = substr($rest,8,1);
253 warn "# WRITE ",as_hex($tag), " [$blocks]\n";
254 } elsif ( $rest = _matched $data => '04 06' ) {
255 warn "ERROR ",as_hex($rest);
266 $tag = shift if ref $tag;
271 "0A $tag", "read_afi $tag", sub {
274 if ( my $rest = _matched $data => '0A 00' ) {
276 my $tag = substr($rest,0,8);
277 $afi = substr($rest,8,1);
279 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
281 } elsif ( $rest = _matched $data => '0A 06' ) {
282 warn "ERROR reading security from $tag ", as_hex($data);
284 warn "IGNORED ",as_hex($data);
287 warn "## read_afi ",dump($tag, $afi);
293 $tag = shift if ref $tag;
294 my $afi = shift || die "no afi?";
299 "09 $tag $afi", "write_afi $tag $afi", sub {
302 if ( my $rest = _matched $data => '09 00' ) {
303 my $tag_back = hex_tag substr($rest,0,8);
304 die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
305 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
306 } elsif ( $rest = _matched $data => '0A 06' ) {
307 warn "ERROR writing AFI to $tag ", as_hex($data);
310 warn "IGNORED ",as_hex($data);
314 warn "## write_afi ", dump( $tag, $afi );
324 L<RFID::Biblio::Reader::API>