1 package Biblio::RFID::Reader::3M810;
5 Biblio::RFID::Reader::3M810 - support for 3M 810 RFID reader
9 This module uses L<Biblio::RFID::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<Biblio::RFID::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 'Biblio::RFID::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);
60 my $data = $port->read( ord(substr($str,2,1)) );
61 warn "drain ",as_hex( $str, $data ),"\n";
64 $port->read_char_time(100); # 0.1 s char timeout
65 $port->read_const_time(500); # 0.5 s read timeout
67 $port->write( hex2bytes( 'D5 00 05 04 00 11 8C66' ) );
68 # hw-version expect: 'D5 00 09 04 00 11 0A 05 00 02 7250'
69 my $data = $port->read( 12 );
72 warn "# probe response: ",as_hex($data);
73 if ( my $rest = assert $data => 'D5 00 09 04 00 11' ) {
74 my $hw_ver = join('.', unpack('CCCC', $rest));
75 warn "# 3M 810 hardware version $hw_ver\n";
78 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
79 '13 00 02 01 01 03 02 02 03 00'
90 my $crc = Digest::CRC->new(
91 # midified CCITT to xor with 0xffff instead of 0x0000
92 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
95 pack('n', $crc->digest);
99 my ( $hex, $description, $coderef ) = @_;
100 my $bytes = hex2bytes($hex);
101 if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
102 my $len = pack( 'n', length( $bytes ) + 2 );
103 $bytes = $len . $bytes;
104 my $checksum = checksum($bytes);
105 $bytes = "\xD6" . $bytes . $checksum;
108 warn ">> ", as_hex( $bytes ), "\t\t[$description]\n" if $debug;
109 $port->write( $bytes );
111 my $r_len = $port->read(3);
113 while ( length($r_len) < 3 ) {
114 $r_len = $port->read( 3 - length($r_len) );
117 my $len = ord( substr($r_len,2,1) );
118 my $data = $port->read( $len );
120 warn "<< ", as_hex($r_len,$data),
122 substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
123 " $len bytes\n" if $debug;
126 $coderef->( $data ) if $coderef;
131 my ( $got, $expected ) = @_;
132 $expected = hex2bytes($expected);
134 my $len = length($got);
135 $len = length($expected) if length $expected < $len;
137 confess "got ", as_hex($got), " expected ", as_hex($expected)
138 unless substr($got,0,$len) eq substr($expected,0,$len);
140 return substr($got,$len);
148 cmd( 'FE 00 05', 'scan for tags', sub {
150 my $rest = assert $data => 'FE 00 00 05';
151 my $nr = ord( substr( $rest, 0, 1 ) );
154 warn "# no tags in range\n";
156 my $tags = substr( $rest, 1 );
157 my $tl = length( $tags );
158 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
160 foreach ( 0 .. $nr - 1 ) {
161 push @tags, hex_tag substr($tags, $_ * 8, 8);
167 warn "# tags ",dump @tags;
173 # cards 16, stickers: 8
174 my $max_rfid_block = 8;
178 my ( $data, $hex ) = @_;
179 my $b = hex2bytes $hex;
181 if ( substr($data,0,$l) eq $b ) {
182 warn "_matched $hex [$l] in ",as_hex($data) if $debug;
183 return substr($data,$l);
188 my $tag = shift || confess "no tag?";
189 $tag = shift if ref($tag);
194 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
196 if ( my $rest = _matched $data => '02 00' ) {
198 my $tag = hex_tag substr($rest,0,8);
199 my $blocks = ord(substr($rest,8,1));
200 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
201 foreach ( 1 .. $blocks ) {
202 my $pos = ( $_ - 1 ) * 6 + 9;
203 my $nr = unpack('v', substr($rest,$pos,2));
204 my $payload = substr($rest,$pos+2,4);
205 warn "## pos $pos block $nr ",as_hex($payload), $/;
206 $tag_blocks->{$tag}->[$nr] = $payload;
208 } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
209 warn "FIXME ready? ",as_hex $rest;
210 } elsif ( $rest = _matched $data => '02 06' ) {
211 die "ERROR ",as_hex($rest);
213 die "FIXME unsuported ",as_hex($rest);
217 warn "# tag_blocks ",dump($tag_blocks);
223 $tag = shift if ref $tag;
226 $data = join('', @$data) if ref $data eq 'ARRAY';
228 warn "## write_blocks ",dump($tag,$data);
230 if ( length($data) % 4 ) {
231 $data .= '\x00' x ( 4 - length($data) % 4 );
232 warn "# padded data to ",dump($data);
235 my $hex_data = as_hex $data;
236 my $blocks = sprintf('%02x', length($data) / 4 );
239 "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
241 if ( my $rest = _matched $data => '04 00' ) {
242 my $tag = substr($rest,0,8);
243 my $blocks = substr($rest,8,1);
244 warn "# WRITE ",as_hex($tag), " [$blocks]\n";
245 } elsif ( $rest = _matched $data => '04 06' ) {
246 die "ERROR ",as_hex($rest);
257 $tag = shift if ref $tag;
262 "0A $tag", "read_afi $tag", sub {
265 if ( my $rest = _matched $data => '0A 00' ) {
267 my $tag = substr($rest,0,8);
268 $afi = substr($rest,8,1);
270 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
272 } elsif ( $rest = _matched $data => '0A 06' ) {
273 die "ERROR reading security from $tag ", as_hex($data);
275 die "IGNORED ",as_hex($data);
278 warn "## read_afi ",dump($tag, $afi);
284 $tag = shift if ref $tag;
285 my $afi = shift || die "no afi?";
293 "09 $tag $afi", "write_afi $tag $afi", sub {
296 if ( my $rest = _matched $data => '09 00' ) {
297 my $tag_back = hex_tag substr($rest,0,8);
298 die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
299 warn "# SECURITY ", hex_tag($tag), " AFI: $afi";
300 } elsif ( $rest = _matched $data => '09 06' ) {
301 if ( $retry++ <= 30 ) { # FIXME lover this number?
302 # warn "ERROR writing AFI $afi to $tag retry $retry\n";
305 die "ERROR writing AFI $afi to $tag ", as_hex($data);
307 die "IGNORED ",as_hex($data);
311 warn "INFO: tag $tag AFI $afi retry: $retry\n";
313 warn "## write_afi ", dump( $tag, $afi );
317 sub tag_type { 'RFID501' }
325 L<Biblio::RFID::Reader::API>