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 my ( $hex, $description, $coderef ) = @_;
79 my $bytes = hex2bytes($hex);
80 if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
81 my $len = pack( 'n', length( $bytes ) + 2 );
82 $bytes = $len . $bytes;
83 my $checksum = checksum($bytes);
84 $bytes = "\xD6" . $bytes . $checksum;
87 warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
88 $port->write( $bytes );
90 my $r_len = $port->read(3);
92 while ( length($r_len) < 3 ) {
93 $r_len = $port->read( 3 - length($r_len) );
96 my $len = ord( substr($r_len,2,1) );
97 my $data = $port->read( $len );
99 warn "<< ", as_hex($r_len,$data),
101 substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
105 $coderef->( $data ) if $coderef;
110 my ( $got, $expected ) = @_;
111 $expected = hex2bytes($expected);
113 my $len = length($got);
114 $len = length($expected) if length $expected < $len;
116 confess "got ", as_hex($got), " expected ", as_hex($expected)
117 unless substr($got,0,$len) eq substr($expected,0,$len);
119 return substr($got,$len);
125 'D5 00 05 04 00 11 8C66', 'hw version', sub {
127 my $rest = assert $data => '04 00 11';
128 my $hw_ver = join('.', unpack('CCCC', $rest));
129 warn "# 3M 810 hardware version $hw_ver\n";
133 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
134 '13 00 02 01 01 03 02 02 03 00'
142 cmd( 'FE 00 05', 'scan for tags', sub {
144 my $rest = assert $data => 'FE 00 00 05';
145 my $nr = ord( substr( $rest, 0, 1 ) );
148 warn "# no tags in range\n";
150 my $tags = substr( $rest, 1 );
151 my $tl = length( $tags );
152 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
154 foreach ( 0 .. $nr - 1 ) {
155 push @tags, hex_tag substr($tags, $_ * 8, 8);
161 warn "# tags ",dump @tags;
167 # cards 16, stickers: 8
168 my $max_rfid_block = 8;
172 my ( $data, $hex ) = @_;
173 my $b = hex2bytes $hex;
175 if ( substr($data,0,$l) eq $b ) {
176 warn "_matched $hex [$l] in ",as_hex($data);
177 return substr($data,$l);
182 my $tag = shift || confess "no tag?";
183 $tag = shift if ref($tag);
188 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
190 if ( my $rest = _matched $data => '02 00' ) {
192 my $tag = hex_tag substr($rest,0,8);
193 my $blocks = ord(substr($rest,8,1));
194 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
195 foreach ( 1 .. $blocks ) {
196 my $pos = ( $_ - 1 ) * 6 + 9;
197 my $nr = unpack('v', substr($rest,$pos,2));
198 my $payload = substr($rest,$pos+2,4);
199 warn "## pos $pos block $nr ",as_hex($payload), $/;
200 $tag_blocks->{$tag}->[$nr] = $payload;
202 } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
203 warn "FIXME ready? ",as_hex $rest;
204 } elsif ( $rest = _matched $data => '02 06' ) {
205 warn "ERROR ",as_hex($rest);
207 warn "FIXME unsuported ",as_hex($rest);
211 warn "# tag_blocks ",dump($tag_blocks);
217 $tag = shift if ref $tag;
220 $data = join('', @$data) if ref $data eq 'ARRAY';
222 warn "## write_blocks ",dump($tag,$data);
224 if ( length($data) % 4 ) {
225 $data .= '\x00' x ( 4 - length($data) % 4 );
226 warn "# padded data to ",dump($data);
229 my $hex_data = as_hex $data;
230 my $blocks = sprintf('%02x', length($data) / 4 );
233 "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
235 if ( my $rest = _matched $data => '04 00' ) {
236 my $tag = substr($rest,0,8);
237 my $blocks = substr($rest,8,1);
238 warn "# WRITE ",as_hex($tag), " [$blocks]\n";
239 } elsif ( $rest = _matched $data => '04 06' ) {
240 warn "ERROR ",as_hex($rest);
251 $tag = shift if ref $tag;
256 "0A $tag", "read_afi $tag", sub {
259 if ( my $rest = _matched $data => '0A 00' ) {
261 my $tag = substr($rest,0,8);
262 $afi = substr($rest,8,1);
264 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
266 } elsif ( $rest = _matched $data => '0A 06' ) {
267 warn "ERROR reading security from $tag ", as_hex($data);
269 warn "IGNORED ",as_hex($data);
272 warn "## read_afi ",dump($tag, $afi);
278 $tag = shift if ref $tag;
279 my $afi = shift || die "no afi?";
284 "09 $tag $afi", "write_afi $tag $afi", sub {
287 if ( my $rest = _matched $data => '09 00' ) {
288 my $tag_back = hex_tag substr($rest,0,8);
289 die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
290 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
291 } elsif ( $rest = _matched $data => '0A 06' ) {
292 warn "ERROR writing AFI to $tag ", as_hex($data);
295 warn "IGNORED ",as_hex($data);
299 warn "## write_afi ", dump( $tag, $afi );
309 L<RFID::Biblio::Reader::API>