--- /dev/null
+ package Biblio::RFID::RFID501;
+
+ use warnings;
+ use strict;
+
+ use Data::Dump qw(dump);
+
+ =head1 NAME
+
+ Biblio::RFID::RFID501 - RFID Standard for Libraries
+
+ =head1 DESCRIPTION
+
+ This module tries to decode tag format as described in document
+
+ RFID 501: RFID Standards for Libraries
+
+ L<http://solutions.3m.com/wps/portal/3M/en_US/3MLibrarySystems/Home/Resources/CaseStudiesAndWhitePapers/RFID501/>
+
+ Goal is to be compatibile with existing 3M Alphanumeric tag format
+ which, as far as I know, isn't specificed anywhere. My documentation about
+ this format is available at
+
+ L<http://saturn.ffzg.hr/rot13/index.cgi?hitchhikers_guide_to_rfid>
+
+ =head1 Data model
+
+ =head2 3M Alphanumeric tag
+
+ 0 04 is 00 tt i [4 bit] = number of item in set [1 .. i .. s]
+ s [4 bit] = total items in set
+ tt [8 bit] = item type
+
+ 1 dd dd dd dd dd [16 bytes] = barcode data
+ 2 dd dd dd dd
+ 3 dd dd dd dd
+ 4 dd dd dd dd
+
+ 5 bb bl ll ll b [12 bit] = branch [unsigned]
+ l [20 bit] = library [unsigned]
+
+ 6 cc cc cc cc c [32 bit] = custom signed integer
+
+ =head2 3M Manufacturing Blank
+
+ 0 55 55 55 55
+ 1 55 55 55 55
+ 2 55 55 55 55
+ 3 55 55 55 55
+ 4 55 55 55 55
+ 5 55 55 55 55
+ 6 00 00 00 00
+
+ =head2 Generic blank
+
+ 0 00 00 00 00
+ 1 00 00 00 00
+ 2 00 00 00 00
+
+ =head1 Security
+
+ AFI byte on RFID tag is used for security.
+
+ In my case, we have RFID door which can only read AFI bytes from tag and issue
+ alarm sound or ignore it depending on value of byte.
+
+ =over 8
+
+ =item 0xD7 214
+
+ secured item (door will beep)
+
+ =item 0xDA 218
+
+ unsecured (door will ignore it)
+
+ =back
+
+
+ =head1 METHODS
+
+ =head2 to_hash
+
+ my $hash = Biblio::RFID::Decode::RFID501->to_hash( $bytes );
+
+ my $hash = Biblio::RFID::Decode::RFID501->to_hash( [ 'blk1', 'blk2', ... , 'blk7' ] );
+
+ =head2 from_hash
+
+ my $blocks = Biblio::RFID::Decode::RFID->from_hash({ content => "1301234567" });
+
+ =head2 blank_3m
+
+ =head2 blank
+
+ my $blocks = Biblio::RFID::Decode::RFID->blank;
+
+ =cut
+
+ my $item_type = {
+ 1 => 'Book',
+ 6 => 'CD/CD ROM',
+ 2 => 'Magazine',
+ 13 => 'Book with Audio Tape',
+ 9 => 'Book with CD/CD ROM',
+ 0 => 'Other',
+
+ 5 => 'Video',
+ 4 => 'Audio Tape',
+ 3 => 'Bound Journal',
+ 8 => 'Book with Diskette',
+ 7 => 'Diskette',
+ };
+
+ sub to_hash {
+ my ( $self, $data ) = @_;
+
+ return unless $data;
+
+ $data = join('', @$data) if ref $data eq 'ARRAY';
+
+ warn "## to_hash ",dump($data);
+
+ my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom, $zero ) = unpack('C4Z16Nl>l',$data);
+ my $hash = {
+ u1 => $u1, # FIXME 0x04
+ set => ( $set_item & 0xf0 ) >> 4,
+ total => ( $set_item & 0x0f ),
+
+ u2 => $u2, # FIXME 0x00
+
+ type => $type,
+ type_label => $item_type->{$type},
+
+ content => $content,
+
+ branch => $br_lib >> 20,
+ library => $br_lib & 0x000fffff,
+
+ custom => $custom,
+ };
+
+ warn "expected first byte to be 0x04, not $u1\n" if $u1 != 4;
+ warn "expected third byte to be 0x00, not $u2\n" if $u2 != 0;
+ warn "expected last block to be zero, not $zero\n" if $zero != 0;
+
+ return $hash;
+ }
+
+ sub from_hash {
+ my ( $self, $hash ) = @_;
+
+ warn "## from_hash ",dump($hash);
+
++ $hash->{$_} ||= 0 foreach ( qw( set total type branch library ) );
++
+ return pack('C4Z16Nl>l',
+ 0x04,
+ ( $hash->{set} << 4 ) | ( $hash->{total} & 0x0f ),
+ 0x00,
+ $hash->{type},
+
+ $hash->{content},
+
+ ( $hash->{branch} << 20 ) | ( $hash->{library} & 0x000fffff ),
+
+ $hash->{custom},
+ 0x00,
+ );
+ }
+
+ sub blank_3m {
+ return ( "\x55" x ( 6 * 4 ) ) . ( "\x00" x 4 );
+ }
+
+ sub blank {
+ return "\x00" x ( 4 * 3 );
+ }
+
+ 1;
--- /dev/null
- my $data = $port->read( ord(substr($str,2,1)) );
- warn "drain ",as_hex( $str, $data ),"\n";
+ package Biblio::RFID::Reader::3M810;
+
+ =head1 NAME
+
+ Biblio::RFID::Reader::3M810 - support for 3M 810 RFID reader
+
+ =head1 DESCRIPTION
+
+ This module uses L<Biblio::RFID::Reader::Serial> over USB/serial adapter
+ with 3M 810 RFID reader, often used in library applications.
+
+ This is most mature implementation which supports full API defined
+ in L<Biblio::RFID::Reader::API>. This include scanning for all tags in reader
+ range, reading and writing of data, and AFI security manipulation.
+
+ This implementation is developed using Portmon on Windows to capture serial traffic
+ L<http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx>
+
+ Checksum for this reader is developed using help from C<selwyn>
+ L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
+
+ More inforation about process of reverse engeeniring protocol with
+ this reader is available at L<http://blog.rot13.org/rfid/>
+
+ =cut
+
+ use warnings;
+ use strict;
+
+ use base 'Biblio::RFID::Reader::Serial';
+ use Biblio::RFID;
+
+ use Data::Dump qw(dump);
+ use Carp qw(confess);
+ use Time::HiRes;
+ use Digest::CRC;
+
+ sub serial_settings {{
+ baudrate => "19200",
+ databits => "8",
+ parity => "none",
+ stopbits => "1",
+ handshake => "none",
+ }}
+
+ sub assert;
+
+ my $port;
+ sub init {
+ my $self = shift;
+ $port = $self->port;
+
+ # disable timeouts
+ $port->read_char_time(0);
+ $port->read_const_time(0);
+
+ # drain on startup
+ my ( $count, $str ) = $port->read(3);
++ if ( $count ) {
++ my $data = $port->read( ord(substr($str,2,1)) );
++ warn "drain ",as_hex( $str, $data ),"\n";
++ }
+
+ $port->read_char_time(100); # 0.1 s char timeout
+ $port->read_const_time(500); # 0.5 s read timeout
+
+ $port->write( hex2bytes( 'D5 00 05 04 00 11 8C66' ) );
+ # hw-version expect: 'D5 00 09 04 00 11 0A 05 00 02 7250'
+ my $data = $port->read( 12 );
+ return unless $data;
+
+ warn "# probe response: ",as_hex($data);
+ if ( my $rest = assert $data => 'D5 00 09 04 00 11' ) {
+ my $hw_ver = join('.', unpack('CCCC', $rest));
+ warn "# 3M 810 hardware version $hw_ver\n";
+
+ cmd(
+ '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
+ '13 00 02 01 01 03 02 02 03 00'
+ )});
+
+ return $hw_ver;
+ }
+
+ return;
+ }
+
+ sub checksum {
+ my $bytes = shift;
+ my $crc = Digest::CRC->new(
+ # midified CCITT to xor with 0xffff instead of 0x0000
+ width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
+ ) or die $!;
+ $crc->add( $bytes );
+ pack('n', $crc->digest);
+ }
+
+ sub cmd {
+ my ( $hex, $description, $coderef ) = @_;
+ my $bytes = hex2bytes($hex);
+ if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
+ my $len = pack( 'n', length( $bytes ) + 2 );
+ $bytes = $len . $bytes;
+ my $checksum = checksum($bytes);
+ $bytes = "\xD6" . $bytes . $checksum;
+ }
+
+ warn ">> ", as_hex( $bytes ), "\t\t[$description]\n" if $debug;
+ $port->write( $bytes );
+
+ my $r_len = $port->read(3);
+
+ while ( length($r_len) < 3 ) {
+ $r_len = $port->read( 3 - length($r_len) );
+ }
+
+ my $len = ord( substr($r_len,2,1) );
+ my $data = $port->read( $len );
+
+ warn "<< ", as_hex($r_len,$data),
+ ' | ',
+ substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
+ " $len bytes\n" if $debug;
+
+
+ $coderef->( $data ) if $coderef;
+
+ }
+
+ sub assert {
+ my ( $got, $expected ) = @_;
+ $expected = hex2bytes($expected);
+
+ my $len = length($got);
+ $len = length($expected) if length $expected < $len;
+
+ confess "got ", as_hex($got), " expected ", as_hex($expected)
+ unless substr($got,0,$len) eq substr($expected,0,$len);
+
+ return substr($got,$len);
+ }
+
+
+ sub inventory {
+
+ my @tags;
+
+ cmd( 'FE 00 05', 'scan for tags', sub {
+ my $data = shift;
+ my $rest = assert $data => 'FE 00 00 05';
+ my $nr = ord( substr( $rest, 0, 1 ) );
+
+ if ( ! $nr ) {
+ warn "# no tags in range\n";
+ } else {
+ my $tags = substr( $rest, 1 );
+ my $tl = length( $tags );
+ die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+
+ foreach ( 0 .. $nr - 1 ) {
+ push @tags, hex_tag substr($tags, $_ * 8, 8);
+ }
+ }
+
+ });
+
+ warn "# tags ",dump @tags;
+ return @tags;
+ }
+
+
+ # 3M defaults: 8,4
+ # cards 16, stickers: 8
+ my $max_rfid_block = 8;
+ my $blocks = 8;
+
+ sub _matched {
+ my ( $data, $hex ) = @_;
+ my $b = hex2bytes $hex;
+ my $l = length($b);
+ if ( substr($data,0,$l) eq $b ) {
+ warn "_matched $hex [$l] in ",as_hex($data) if $debug;
+ return substr($data,$l);
+ }
+ }
+
+ sub read_blocks {
+ my $tag = shift || confess "no tag?";
+ $tag = shift if ref($tag);
+
+ my $tag_blocks;
+ my $start = 0;
+ cmd(
+ sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
+ my $data = shift;
+ if ( my $rest = _matched $data => '02 00' ) {
+
+ my $tag = hex_tag substr($rest,0,8);
+ my $blocks = ord(substr($rest,8,1));
+ warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
+ foreach ( 1 .. $blocks ) {
+ my $pos = ( $_ - 1 ) * 6 + 9;
+ my $nr = unpack('v', substr($rest,$pos,2));
+ my $payload = substr($rest,$pos+2,4);
+ warn "## pos $pos block $nr ",as_hex($payload), $/;
+ $tag_blocks->{$tag}->[$nr] = $payload;
+ }
+ } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
+ warn "FIXME ready? ",as_hex $rest;
+ } elsif ( $rest = _matched $data => '02 06' ) {
+ die "ERROR ",as_hex($rest);
+ } else {
+ die "FIXME unsuported ",as_hex($rest);
+ }
+ });
+
+ warn "# tag_blocks ",dump($tag_blocks);
+ return $tag_blocks;
+ }
+
+ sub write_blocks {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $data = shift;
+ $data = join('', @$data) if ref $data eq 'ARRAY';
+
+ warn "## write_blocks ",dump($tag,$data);
+
+ if ( length($data) % 4 ) {
+ $data .= '\x00' x ( 4 - length($data) % 4 );
+ warn "# padded data to ",dump($data);
+ }
+
+ my $hex_data = as_hex $data;
+ my $blocks = sprintf('%02x', length($data) / 4 );
+
+ cmd(
+ "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
+ my $data = shift;
+ if ( my $rest = _matched $data => '04 00' ) {
+ my $tag = substr($rest,0,8);
+ my $blocks = substr($rest,8,1);
+ warn "# WRITE ",as_hex($tag), " [$blocks]\n";
+ } elsif ( $rest = _matched $data => '04 06' ) {
+ die "ERROR ",as_hex($rest);
+ } else {
+ die "UNSUPPORTED";
+ }
+ }
+ );
+
+ }
+
+ sub read_afi {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+
+ my $afi;
+
+ cmd(
+ "0A $tag", "read_afi $tag", sub {
+ my $data = shift;
+
+ if ( my $rest = _matched $data => '0A 00' ) {
+
+ my $tag = substr($rest,0,8);
+ $afi = substr($rest,8,1);
+
+ warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+
+ } elsif ( $rest = _matched $data => '0A 06' ) {
+ die "ERROR reading security from $tag ", as_hex($data);
+ } else {
+ die "IGNORED ",as_hex($data);
+ }
+ });
+ warn "## read_afi ",dump($tag, $afi);
+ return $afi;
+ }
+
+ sub write_afi {
+ my $tag = shift;
+ $tag = shift if ref $tag;
+ my $afi = shift || die "no afi?";
+
+ $afi = as_hex $afi;
+
+ cmd(
+ "09 $tag $afi", "write_afi $tag $afi", sub {
+ my $data = shift;
+
+ if ( my $rest = _matched $data => '09 00' ) {
+ my $tag_back = hex_tag substr($rest,0,8);
+ die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
+ warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+ } elsif ( $rest = _matched $data => '0A 06' ) {
+ die "ERROR writing AFI to $tag ", as_hex($data);
+ } else {
+ die "IGNORED ",as_hex($data);
+ }
+ });
+ warn "## write_afi ", dump( $tag, $afi );
+ return $afi;
+ }
+
+ 1
+
+ __END__
+
+ =head1 SEE ALSO
+
+ L<Biblio::RFID::Reader::API>
projects / Biblio-RFID.git / commitdiff