From: Dobrica Pavlinusic Date: Wed, 25 Aug 2010 16:58:27 +0000 (+0200) Subject: rename directories X-Git-Url: http://git.rot13.org/?a=commitdiff_plain;h=adb46ed3356b3ed314e464df1bba64ec4eb033b5;hp=85092c9643bc97fbacab4113f1de90311c00e37d;p=Biblio-RFID.git rename directories --- diff --git a/lib/Biblio/RFID.pm b/lib/Biblio/RFID.pm new file mode 100644 index 0000000..7b8df2d --- /dev/null +++ b/lib/Biblio/RFID.pm @@ -0,0 +1,217 @@ +package Biblio::RFID; + +use warnings; +use strict; + +use base 'Exporter'; +our @EXPORT = qw( hex2bytes as_hex hex_tag $debug ); + +use Data::Dump qw(dump); + +=head1 NAME + +Biblio::RFID - perl tools to use different RFID readers for library use + +=cut + +our $VERSION = '0.02'; + +our $debug = 0; + + +=head1 DESCRIPTION + +Main idea is to develop simple API to reader, and than provide useful +abstractions on top of it to quickly write applications to respond on +tags which come in range of RFID reader using L. + +Writing support for new RFID readers should be easy. +L provides documentation on writing support +for different readers. + +Currently, two serial RFID readers based on L +are implemented: + +=over 4 + +=item * + +L + +=item * + +L + +=back + +There is also simple read-only reader using shell commands in +L. + +For implementing application take a look at L + +C is example of such application. It's local +interface to RFID reader and JSONP REST server. + +C is jQuery based JavaScript code which can be inserted +in Koha Library System to provide overlay with tags in range and +check-in/check-out form-fill functionality. + +Applications can use L which is some kind of +semi-standard 3M layout or blocks on RFID tags. + +=for readme stop + +=head1 EXPORT + +Formatting functions are exported + +=head2 hex2bytes + + my $bytes = hex2bytes($hex); + +=cut + +sub hex2bytes { + my $str = shift || die "no str?"; + my $b = $str; + $b =~ s/\s+//g; + $b =~ s/(..)/\\x$1/g; + $b = "\"$b\""; + my $bytes = eval $b; + die $@ if $@; + warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug; + return $bytes; +} + +=head2 as_hex + + print as_hex( $bytes ); + +=cut + +sub as_hex { + my @out; + foreach my $str ( @_ ) { + my $hex = uc unpack( 'H*', $str ); + $hex =~ s/(..)/$1 /g if length( $str ) > 2; + $hex =~ s/\s+$//; + push @out, $hex; + } + return join(' | ', @out); +} + +=head2 hex_tag + + print hex_tag $8bytes; + +=cut + +sub hex_tag { uc(unpack('H16', shift)) } + +=head1 WARN + +We are installing L handler to controll debug output +based on C<$Biblio::RFID::debug> level + +=cut + +BEGIN { + $SIG{'__WARN__'} = sub { + my $msg = join(' ', @_); + if ( $msg =~ m/^(#+)/ ) { + my $l = length $1; + return if $l > $debug; + } + warn join(' ', @_); + } +} + +=for readme continue + +=head1 HARDWARE SUPPORT + +=head2 3M 810 + +L + +=head2 CPR-M02 + +L + +=head2 librfid + +L + + +=head1 AUTHOR + +Dobrica Pavlinusic, C<< >> + +L + +=head1 BUGS + +Please report any bugs or feature requests to C, or through +the web interface at L. I will be notified, and then you'll +automatically be notified of progress on your bug as I make changes. + + + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Biblio::RFID + perldoc Biblio::RFID::Reader + perldoc Biblio::RFID::Reader::API + + +You can also look for information at: + +=over 4 + +=item * RT: CPAN's request tracker + +L + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * Search CPAN + +L + +=back + + +=head1 ACKNOWLEDGEMENTS + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2010 Dobrica Pavlinusic. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; version 2 dated June, 1991 or at your option +any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +A copy of the GNU General Public License is available in the source tree; +if not, write to the Free Software Foundation, Inc., +59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + +=cut + +1; # End of Biblio::RFID diff --git a/lib/Biblio/RFID/RFID501.pm b/lib/Biblio/RFID/RFID501.pm new file mode 100644 index 0000000..97d3ee0 --- /dev/null +++ b/lib/Biblio/RFID/RFID501.pm @@ -0,0 +1,178 @@ +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 + +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 + +=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); + + 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; diff --git a/lib/Biblio/RFID/Reader.pm b/lib/Biblio/RFID/Reader.pm new file mode 100644 index 0000000..f5e6fd4 --- /dev/null +++ b/lib/Biblio/RFID/Reader.pm @@ -0,0 +1,197 @@ +package Biblio::RFID::Reader; + +use warnings; +use strict; + +use Data::Dump qw(dump); +use Time::HiRes; +use lib 'lib'; +use Biblio::RFID; +use Carp qw(confess); + +=head1 NAME + +Biblio::RFID::Reader - simple way to write RFID applications in perl + +=head1 DESCRIPTION + +This module will probe all available readers and use calls from +L to invoke correct reader. + +=head1 FUNCTIONS + +=head2 new + + my $rfid = Biblio::RFID::Reader->new( 'optional reader filter' ); + +=cut + +sub new { + my ( $class, $filter ) = @_; + my $self = {}; + bless $self, $class; + $self->{_readers} = [ $self->_available( $filter ) ]; + return $self; +} + +=head2 tags + + my @visible = $rfid->tags( + enter => sub { my $tag = shift; }, + leave => sub { my $tag = shift; }, + ); + +=cut + +sub tags { + my $self = shift; + my $triggers = {@_}; + + $self->{_tags} ||= {}; + $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}}; + my $t = time; + + foreach my $rfid ( @{ $self->{_readers} } ) { + warn "# inventory on $rfid"; + my @tags = $rfid->inventory; + + foreach my $tag ( @tags ) { + + if ( ! exists $self->{_tags}->{$tag} ) { + eval { + my $blocks = $rfid->read_blocks($tag); + $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks); + my $afi = $rfid->read_afi($tag); + $self->{_tags}->{$tag}->{afi} = $afi; + + }; + if ( $@ ) { + warn "ERROR reading $tag: $@\n"; + $self->_invalidate_tag( $tag ); + next; + } + + $triggers->{enter}->( $tag ) if $triggers->{enter}; + } + + $self->{_tags}->{$tag}->{time} = $t; + + } + + foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) { + $triggers->{leave}->( $tag ) if $triggers->{leave}; + $self->_invalidate_tag( $tag ); + } + + } + + warn "## _tags ",dump( $self->{_tags} ); + + return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} }; +} + +=head2 blocks + + my $blocks_arrayref = $rfid->blocks( $tag ); + +=head2 afi + + my $afi = $rfid->afi( $tag ); + +=cut + +sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; }; +sub afi { $_[0]->{_tags}->{$_[1]}->{ 'afi' } || confess "no afi for $_[1]"; }; + +=head1 PRIVATE + +=head2 _invalidate_tag + + $rfid->_invalidate_tag( $tag ); + +=cut + +sub _invalidate_tag { + my ( $self, $tag ) = @_; + my @caller = caller(0); + warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n"; + my $old = delete $self->{_tags}->{$tag}; + warn "# _invalidate_tag $tag ", dump($old); +} + +=head2 _available + +Probe each RFID reader supported and returns succefull ones + + my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter ); + +=cut + +my @readers = ( '3M810', 'CPRM02', 'librfid' ); + +sub _available { + my ( $self, $filter ) = @_; + + $filter = '' unless defined $filter; + + warn "# filter: $filter"; + + my @rfid; + + foreach my $reader ( @readers ) { + next if $filter && $reader !~ /$filter/i; + my $module = "Biblio::RFID::Reader::$reader"; + eval "use $module"; + die $@ if $@; + if ( my $rfid = $module->new ) { + push @rfid, $rfid; + warn "# added $module\n"; + } else { + warn "# ignored $module\n"; + } + } + + die "no readers found" unless @rfid; + + return @rfid; +} + +=head1 AUTOLOAD + +On any other function calls, we just marshall to all readers + +=cut + +# we don't want DESTROY to fallback into AUTOLOAD +sub DESTROY {} + +our $AUTOLOAD; +sub AUTOLOAD { + my $self = shift; + my $command = $AUTOLOAD; + $command =~ s/.*://; + + my @out; + + foreach my $r ( @{ $self->{_readers} } ) { + push @out, $r->$command(@_); + } + + $self->_invalidate_tag( $_[0] ) if $command =~ m/write/; + + return @out; +} + +1 +__END__ + +=head1 SEE ALSO + +=head2 RFID reader implementations + +L + +L + +L + diff --git a/lib/Biblio/RFID/Reader/3M810.pm b/lib/Biblio/RFID/Reader/3M810.pm new file mode 100644 index 0000000..a1b21a1 --- /dev/null +++ b/lib/Biblio/RFID/Reader/3M810.pm @@ -0,0 +1,311 @@ +package Biblio::RFID::Reader::3M810; + +=head1 NAME + +Biblio::RFID::Reader::3M810 - support for 3M 810 RFID reader + +=head1 DESCRIPTION + +This module uses L 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. 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 + +Checksum for this reader is developed using help from C +L + +More inforation about process of reverse engeeniring protocol with +this reader is available at L + +=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); + 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 diff --git a/lib/Biblio/RFID/Reader/API.pm b/lib/Biblio/RFID/Reader/API.pm new file mode 100644 index 0000000..e6808c0 --- /dev/null +++ b/lib/Biblio/RFID/Reader/API.pm @@ -0,0 +1,67 @@ +package Biblio::RFID::Reader::API; + +use warnings; +use strict; + +=head1 NAME + +Biblio::RFID::Reader::API - low-level RFID reader documentation + +=cut + +=head1 MANDATORY METHODS + +Each reader must implement following hooks as sub-classes. + +=head2 init + + $self->init; + +=head2 inventory + + my @tags = $self->invetory; + +=head2 read_blocks + + my $hash = $self->read_blocks( $tag ); + +All blocks are under key which is tag UID with array of blocks returned from reader + + $hash = { 'E000000123456789' => [ 'blk1', 'blk2', ... ] }; + +L sends tag UID with data payload, so we might expect +to receive response from other tags from protocol specification, + +=head2 write_blocks + + $self->write_blocks( $tag => $bytes ); + + $self->write_blocks( $tag => [ 'blk1', 'blk2', ... ] ); + +=head2 read_afi + + my $afi = $self->read_afi( $tag ); + +=head2 write_afi + + $self->write_afi( $tag => $afi ); + + +=head1 METHODS + +=head2 new + +Just calls C in reader implementation so this class +can be used as simple stub base class like +L does + +=cut + +sub new { + my $class = shift; + my $self = {@_}; + bless $self, $class; + $self->init && return $self; +} + +1; diff --git a/lib/Biblio/RFID/Reader/CPRM02.pm b/lib/Biblio/RFID/Reader/CPRM02.pm new file mode 100644 index 0000000..0992fc8 --- /dev/null +++ b/lib/Biblio/RFID/Reader/CPRM02.pm @@ -0,0 +1,265 @@ +package Biblio::RFID::Reader::CPRM02; + +=head1 NAME + +Biblio::RFID::Reader::CPRM02 - support for CPR-M02 RFID reader + +=head1 DESCRIPTION + +This module implements serial protocol over usb/serial adapter with CPR-M02 +reader as described in document C + +=cut + +use warnings; +use strict; + +use base 'Biblio::RFID::Reader::Serial'; +use Biblio::RFID; + +use Time::HiRes; +use Data::Dump qw(dump); + +my $debug = 1; + +sub serial_settings {{ + device => "/dev/ttyUSB0", + baudrate => "38400", + databits => "8", + parity => "even", + stopbits => "1", + handshake => "none", +}} + +sub cpr_m02_checksum { + my $data = shift; + + my $preset = 0xffff; + my $polynom = 0x8408; + + my $crc = $preset; + foreach my $i ( 0 .. length($data) - 1 ) { + $crc ^= ord(substr($data,$i,1)); + for my $j ( 0 .. 7 ) { + if ( $crc & 0x0001 ) { + $crc = ( $crc >> 1 ) ^ $polynom; + } else { + $crc = $crc >> 1; + } + } +# warn sprintf('%d %04x', $i, $crc & 0xffff); + } + + return pack('v', $crc); +} + +sub wait_device { + Time::HiRes::sleep 0.010; +} + +our $port; + +sub cpr { + my ( $hex, $description, $coderef ) = @_; + my $bytes = hex2bytes($hex); + my $len = pack( 'c', length( $bytes ) + 3 ); + my $send = $len . $bytes; + my $checksum = cpr_m02_checksum($send); + $send .= $checksum; + + warn "##>> ", as_hex( $send ), "\t\t[$description]\n"; + $port->write( $send ); + + wait_device; + + my $r_len = $port->read(1); + + my $count = 100; + while ( ! $r_len ) { + if ( $count-- == 0 ) { + warn "no response from device"; + return; + } + wait_device; + $r_len = $port->read(1); + } + + wait_device; + + my $data_len = ord($r_len) - 1; + my $data = $port->read( $data_len ); + warn "##<< ", as_hex( $r_len . $data ),"\n"; + + wait_device; + + $coderef->( $data ) if $coderef; + +} + +# FF = COM-ADDR any + +sub init { + my $self = shift; + + $port = $self->port; + +cpr( 'FF 52 00', 'Boud Rate Detection' ); + +cpr( 'FF 65', 'Get Software Version' ); + +cpr( 'FF 66 00', 'Get Reader Info - General hard and firware' ); + +cpr( 'FF 69', 'RF Reset' ); + + return 1; +} + + +sub inventory { + + my @tags; + +cpr( 'FF B0 01 00', 'ISO - Inventory', sub { + my $data = shift; + if (length($data) < 5 + 2 ) { + warn "# no tags in range\n"; + return; + } + + my $data_sets = ord(substr($data,3,1)); + $data = substr($data,4); + foreach ( 1 .. $data_sets ) { + my $tr_type = substr($data,0,1); + die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03"; + my $dsfid = substr($data,1,1); + my $uid = substr($data,2,8); + $data = substr($data,10); + warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/; + push @tags, hex_tag $uid; + + } +}); + + warn "# tags ",dump(@tags),$/; + return @tags; +} + + +sub _get_system_info { + my $tag = shift; + + my $info; + + cpr( "FF B0 2B 01 $tag", "Get System Information $tag", sub { + my $data = shift; + + warn "# data ",as_hex($data); + + return if length($data) < 17; + + $info = { + DSFID => substr($data,5-2,1), + UID => substr($data,6-2,8), + AFI => substr($data,14-2,1), + MEM => substr($data,15-2,1), + SIZE => substr($data,16-2,1), + IC_REF => substr($data,17-2,1), + }; + + }); + + warn "# _get_system_info $tag ",dump( $info ); + + return $info; +} + + +sub read_blocks { + my $tag = shift; + $tag = shift if ref $tag; + + my $info = _get_system_info $tag; + + return unless $info->{SIZE}; + + my $max_block = ord($info->{SIZE}); + + my $tag_blocks; + + my $block = 0; + while ( $block < $max_block ) { + cpr( sprintf("FF B0 23 01 $tag %02x 04", $block), "Read Multiple Blocks $block", sub { + my $data = shift; + + my $DB_N = ord substr($data,5-2,1); + my $DB_SIZE = ord substr($data,6-2,1); + + $data = substr($data,7-2,-2); +# warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data ), " transponder_data: [$transponder_data] ",length($transponder_data),"\n"; + foreach my $n ( 1 .. $DB_N ) { + my $sec = ord(substr($data,0,1)); + my $db = substr($data,1,$DB_SIZE); + warn "## block $n ",dump( $sec, $db ) if $debug; + $tag_blocks->{$tag}->[$block+$n-1] = reverse split(//,$db); + $data = substr($data, $DB_SIZE + 1); + } + }); + $block += 4; + } + + 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'; + + my $DB_ADR = 0; # start at first block + my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded + if ( my $padding = length($data) % $DB_SIZE ) { + warn "WARNING: data block not padded to $DB_SIZE bytes"; + $data .= "\x00" x $padding; + } + my $DB_N = length($data) / $DB_SIZE; + + my $send_data; + foreach my $block ( 0 .. $DB_N ) { + $send_data .= reverse split(//, substr( $data, $block * $DB_SIZE, $DB_SIZE ) ); + } + + cpr( sprintf("FF B0 24 01 $tag %02x %02x %02x %s", $DB_ADR, $DB_N, $DB_SIZE, as_hex($send_data)), "Write Multiple Blocks $tag", sub { + my $data = shift; + warn dump( $data ); + }); + +} + +sub read_afi { + my $tag = shift; + $tag = shift if ref $tag; + + my $info = _get_system_info $tag; + return $info->{AFI} || warn "no AFI for $tag in ",dump($info); + +} + +sub write_afi { + my $tag = shift; + $tag = shift if ref $tag; + + my $afi = shift || die "no afi?"; + $afi = as_hex $afi; + + cpr( "FF B0 27 01 $tag $afi", "Write AFI $tag $afi", sub { + my $data = shift; + warn "## write_afi $tag got ",as_hex($data); + }); + +} + +1 diff --git a/lib/Biblio/RFID/Reader/Serial.pm b/lib/Biblio/RFID/Reader/Serial.pm new file mode 100644 index 0000000..39282f0 --- /dev/null +++ b/lib/Biblio/RFID/Reader/Serial.pm @@ -0,0 +1,89 @@ +package Biblio::RFID::Reader::Serial; + +use warnings; +use strict; + +use Device::SerialPort qw(:STAT); +use Data::Dump qw(dump); + +=head1 NAME + +Biblio::RFID::Reader::Serial - base class for serial RFID readers + +=head1 METHODS + +=head2 new + +Open serial port (if needed) and init reader + +=cut + +sub new { + my $class = shift; + my $self = {@_}; + bless $self, $class; + + $self->port && return $self; +} + + +=head2 port + +Tries to open usb serial ports C + + my $serial_obj = $self->port; + +To try just one device use C enviroment variable + +=cut + +our $serial_device; + +sub port { + my $self = shift; + + return $self->{port} if defined $self->{port}; + + my $settings = $self->serial_settings; + my @devices = $ENV{RFID_DEVICE} ? ( $ENV{RFID_DEVICE} ) : glob '/dev/ttyUSB*'; + warn "# port devices ",dump(@devices); + + foreach my $device ( @devices ) { + + next if $serial_device->{$device}; + + if ( my $port = Device::SerialPort->new($device) ) { + + foreach my $opt ( qw/handshake baudrate databits parity stopbits/ ) { + $port->$opt( $settings->{$opt} ); + } + + $self->{port} = $port; + + warn "# probe by init $device ",ref($self); + if ( $self->init ) { + warn "init OK ", ref($self), " $device settings ",dump $settings; + $serial_device->{$device} = $port; + last; + } else { + $self->{port} = 0; + } + } + } + + warn "# serial_device ",dump($serial_device); + + return $self->{port}; +} + +1 +__END__ + +=head1 SEE ALSO + +L + +L + +L + diff --git a/lib/Biblio/RFID/Reader/librfid.pm b/lib/Biblio/RFID/Reader/librfid.pm new file mode 100644 index 0000000..3cadbb1 --- /dev/null +++ b/lib/Biblio/RFID/Reader/librfid.pm @@ -0,0 +1,102 @@ +package Biblio::RFID::Reader::librfid; + +use warnings; +use strict; + +use base 'Biblio::RFID::Reader::API'; +use Biblio::RFID; + +use Data::Dump qw(dump); + +=head1 NAME + +Biblio::RFID::Reader::librfid - execute librfid-tool + +=head1 DESCRIPTION + +This is wrapper around C from + +L + +Due to limitation of L only +L and +L is supported. + +However, this code might provide template for integration +with any command-line utilities for different RFID readers. + +Currently tested with only with Omnikey CardMan 5321 which +has problems. After a while it stops responding to commands +by C so I provided small C program to reset it: + +C + +=cut + +sub serial_settings {} # don't open serial + +our $bin = '/rest/cvs/librfid/utils/librfid-tool'; + +sub init { + my $self = shift; + if ( -e $bin ) { + warn "# using $bin"; + return 1; + } else { + warn "# no $bin found\n"; + return 0; + } +} + +sub _grep_tool { + my ( $param, $coderef ) = @_; + + warn "# _grep_tool $bin $param\n"; + open(my $s, '-|', "$bin $param") || die $!; + while(<$s>) { + chomp; + warn "## $_\n"; + + my $sid; + if ( m/success.+:\s+(.+)/ ) { + $sid = $1; + $sid =~ s/\s*'\s*//g; + $sid = uc join('', reverse split(/\s+/, $sid)); + } + + $coderef->( $sid ); + } + + +} + +sub inventory { + + my @tags; + _grep_tool '--scan' => sub { + my $sid = shift; + push @tags, $sid if $sid; + }; + warn "# invetory ",dump(@tags); + return @tags; +} + +sub read_blocks { + + my $sid; + my $blocks; + _grep_tool '--read -1' => sub { + $sid ||= shift; + $blocks->{$sid}->[$1] = hex2bytes($2) + if m/block\[\s*(\d+):.+data.+:\s*(.+)/; + + }; + warn "# read_blocks ",dump($blocks); + return $blocks; +} + +sub write_blocks {} +sub read_afi { -1 } +sub write_afi {} + +1 diff --git a/lib/RFID/Biblio.pm b/lib/RFID/Biblio.pm deleted file mode 100644 index 7b8df2d..0000000 --- a/lib/RFID/Biblio.pm +++ /dev/null @@ -1,217 +0,0 @@ -package Biblio::RFID; - -use warnings; -use strict; - -use base 'Exporter'; -our @EXPORT = qw( hex2bytes as_hex hex_tag $debug ); - -use Data::Dump qw(dump); - -=head1 NAME - -Biblio::RFID - perl tools to use different RFID readers for library use - -=cut - -our $VERSION = '0.02'; - -our $debug = 0; - - -=head1 DESCRIPTION - -Main idea is to develop simple API to reader, and than provide useful -abstractions on top of it to quickly write applications to respond on -tags which come in range of RFID reader using L. - -Writing support for new RFID readers should be easy. -L provides documentation on writing support -for different readers. - -Currently, two serial RFID readers based on L -are implemented: - -=over 4 - -=item * - -L - -=item * - -L - -=back - -There is also simple read-only reader using shell commands in -L. - -For implementing application take a look at L - -C is example of such application. It's local -interface to RFID reader and JSONP REST server. - -C is jQuery based JavaScript code which can be inserted -in Koha Library System to provide overlay with tags in range and -check-in/check-out form-fill functionality. - -Applications can use L which is some kind of -semi-standard 3M layout or blocks on RFID tags. - -=for readme stop - -=head1 EXPORT - -Formatting functions are exported - -=head2 hex2bytes - - my $bytes = hex2bytes($hex); - -=cut - -sub hex2bytes { - my $str = shift || die "no str?"; - my $b = $str; - $b =~ s/\s+//g; - $b =~ s/(..)/\\x$1/g; - $b = "\"$b\""; - my $bytes = eval $b; - die $@ if $@; - warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug; - return $bytes; -} - -=head2 as_hex - - print as_hex( $bytes ); - -=cut - -sub as_hex { - my @out; - foreach my $str ( @_ ) { - my $hex = uc unpack( 'H*', $str ); - $hex =~ s/(..)/$1 /g if length( $str ) > 2; - $hex =~ s/\s+$//; - push @out, $hex; - } - return join(' | ', @out); -} - -=head2 hex_tag - - print hex_tag $8bytes; - -=cut - -sub hex_tag { uc(unpack('H16', shift)) } - -=head1 WARN - -We are installing L handler to controll debug output -based on C<$Biblio::RFID::debug> level - -=cut - -BEGIN { - $SIG{'__WARN__'} = sub { - my $msg = join(' ', @_); - if ( $msg =~ m/^(#+)/ ) { - my $l = length $1; - return if $l > $debug; - } - warn join(' ', @_); - } -} - -=for readme continue - -=head1 HARDWARE SUPPORT - -=head2 3M 810 - -L - -=head2 CPR-M02 - -L - -=head2 librfid - -L - - -=head1 AUTHOR - -Dobrica Pavlinusic, C<< >> - -L - -=head1 BUGS - -Please report any bugs or feature requests to C, or through -the web interface at L. I will be notified, and then you'll -automatically be notified of progress on your bug as I make changes. - - - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc Biblio::RFID - perldoc Biblio::RFID::Reader - perldoc Biblio::RFID::Reader::API - - -You can also look for information at: - -=over 4 - -=item * RT: CPAN's request tracker - -L - -=item * AnnoCPAN: Annotated CPAN documentation - -L - -=item * CPAN Ratings - -L - -=item * Search CPAN - -L - -=back - - -=head1 ACKNOWLEDGEMENTS - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2010 Dobrica Pavlinusic. - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; version 2 dated June, 1991 or at your option -any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -A copy of the GNU General Public License is available in the source tree; -if not, write to the Free Software Foundation, Inc., -59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - - -=cut - -1; # End of Biblio::RFID diff --git a/lib/RFID/Biblio/RFID501.pm b/lib/RFID/Biblio/RFID501.pm deleted file mode 100644 index 97d3ee0..0000000 --- a/lib/RFID/Biblio/RFID501.pm +++ /dev/null @@ -1,178 +0,0 @@ -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 - -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 - -=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); - - 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; diff --git a/lib/RFID/Biblio/Reader.pm b/lib/RFID/Biblio/Reader.pm deleted file mode 100644 index f5e6fd4..0000000 --- a/lib/RFID/Biblio/Reader.pm +++ /dev/null @@ -1,197 +0,0 @@ -package Biblio::RFID::Reader; - -use warnings; -use strict; - -use Data::Dump qw(dump); -use Time::HiRes; -use lib 'lib'; -use Biblio::RFID; -use Carp qw(confess); - -=head1 NAME - -Biblio::RFID::Reader - simple way to write RFID applications in perl - -=head1 DESCRIPTION - -This module will probe all available readers and use calls from -L to invoke correct reader. - -=head1 FUNCTIONS - -=head2 new - - my $rfid = Biblio::RFID::Reader->new( 'optional reader filter' ); - -=cut - -sub new { - my ( $class, $filter ) = @_; - my $self = {}; - bless $self, $class; - $self->{_readers} = [ $self->_available( $filter ) ]; - return $self; -} - -=head2 tags - - my @visible = $rfid->tags( - enter => sub { my $tag = shift; }, - leave => sub { my $tag = shift; }, - ); - -=cut - -sub tags { - my $self = shift; - my $triggers = {@_}; - - $self->{_tags} ||= {}; - $self->{_tags}->{$_}->{time} = 0 foreach keys %{$self->{_tags}}; - my $t = time; - - foreach my $rfid ( @{ $self->{_readers} } ) { - warn "# inventory on $rfid"; - my @tags = $rfid->inventory; - - foreach my $tag ( @tags ) { - - if ( ! exists $self->{_tags}->{$tag} ) { - eval { - my $blocks = $rfid->read_blocks($tag); - $self->{_tags}->{$tag}->{blocks} = $blocks->{$tag} || die "no $tag in ",dump($blocks); - my $afi = $rfid->read_afi($tag); - $self->{_tags}->{$tag}->{afi} = $afi; - - }; - if ( $@ ) { - warn "ERROR reading $tag: $@\n"; - $self->_invalidate_tag( $tag ); - next; - } - - $triggers->{enter}->( $tag ) if $triggers->{enter}; - } - - $self->{_tags}->{$tag}->{time} = $t; - - } - - foreach my $tag ( grep { $self->{_tags}->{$_}->{time} == 0 } keys %{ $self->{_tags} } ) { - $triggers->{leave}->( $tag ) if $triggers->{leave}; - $self->_invalidate_tag( $tag ); - } - - } - - warn "## _tags ",dump( $self->{_tags} ); - - return grep { $self->{_tags}->{$_}->{time} } keys %{ $self->{_tags} }; -} - -=head2 blocks - - my $blocks_arrayref = $rfid->blocks( $tag ); - -=head2 afi - - my $afi = $rfid->afi( $tag ); - -=cut - -sub blocks { $_[0]->{_tags}->{$_[1]}->{ 'blocks' } || confess "no blocks for $_[1]"; }; -sub afi { $_[0]->{_tags}->{$_[1]}->{ 'afi' } || confess "no afi for $_[1]"; }; - -=head1 PRIVATE - -=head2 _invalidate_tag - - $rfid->_invalidate_tag( $tag ); - -=cut - -sub _invalidate_tag { - my ( $self, $tag ) = @_; - my @caller = caller(0); - warn "## _invalidate_tag caller $caller[0] $caller[1] +$caller[2]\n"; - my $old = delete $self->{_tags}->{$tag}; - warn "# _invalidate_tag $tag ", dump($old); -} - -=head2 _available - -Probe each RFID reader supported and returns succefull ones - - my $rfid_readers = Biblio::RFID::Reader->_available( $regex_filter ); - -=cut - -my @readers = ( '3M810', 'CPRM02', 'librfid' ); - -sub _available { - my ( $self, $filter ) = @_; - - $filter = '' unless defined $filter; - - warn "# filter: $filter"; - - my @rfid; - - foreach my $reader ( @readers ) { - next if $filter && $reader !~ /$filter/i; - my $module = "Biblio::RFID::Reader::$reader"; - eval "use $module"; - die $@ if $@; - if ( my $rfid = $module->new ) { - push @rfid, $rfid; - warn "# added $module\n"; - } else { - warn "# ignored $module\n"; - } - } - - die "no readers found" unless @rfid; - - return @rfid; -} - -=head1 AUTOLOAD - -On any other function calls, we just marshall to all readers - -=cut - -# we don't want DESTROY to fallback into AUTOLOAD -sub DESTROY {} - -our $AUTOLOAD; -sub AUTOLOAD { - my $self = shift; - my $command = $AUTOLOAD; - $command =~ s/.*://; - - my @out; - - foreach my $r ( @{ $self->{_readers} } ) { - push @out, $r->$command(@_); - } - - $self->_invalidate_tag( $_[0] ) if $command =~ m/write/; - - return @out; -} - -1 -__END__ - -=head1 SEE ALSO - -=head2 RFID reader implementations - -L - -L - -L - diff --git a/lib/RFID/Biblio/Reader/3M810.pm b/lib/RFID/Biblio/Reader/3M810.pm deleted file mode 100644 index a1b21a1..0000000 --- a/lib/RFID/Biblio/Reader/3M810.pm +++ /dev/null @@ -1,311 +0,0 @@ -package Biblio::RFID::Reader::3M810; - -=head1 NAME - -Biblio::RFID::Reader::3M810 - support for 3M 810 RFID reader - -=head1 DESCRIPTION - -This module uses L 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. 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 - -Checksum for this reader is developed using help from C -L - -More inforation about process of reverse engeeniring protocol with -this reader is available at L - -=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); - 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 diff --git a/lib/RFID/Biblio/Reader/API.pm b/lib/RFID/Biblio/Reader/API.pm deleted file mode 100644 index e6808c0..0000000 --- a/lib/RFID/Biblio/Reader/API.pm +++ /dev/null @@ -1,67 +0,0 @@ -package Biblio::RFID::Reader::API; - -use warnings; -use strict; - -=head1 NAME - -Biblio::RFID::Reader::API - low-level RFID reader documentation - -=cut - -=head1 MANDATORY METHODS - -Each reader must implement following hooks as sub-classes. - -=head2 init - - $self->init; - -=head2 inventory - - my @tags = $self->invetory; - -=head2 read_blocks - - my $hash = $self->read_blocks( $tag ); - -All blocks are under key which is tag UID with array of blocks returned from reader - - $hash = { 'E000000123456789' => [ 'blk1', 'blk2', ... ] }; - -L sends tag UID with data payload, so we might expect -to receive response from other tags from protocol specification, - -=head2 write_blocks - - $self->write_blocks( $tag => $bytes ); - - $self->write_blocks( $tag => [ 'blk1', 'blk2', ... ] ); - -=head2 read_afi - - my $afi = $self->read_afi( $tag ); - -=head2 write_afi - - $self->write_afi( $tag => $afi ); - - -=head1 METHODS - -=head2 new - -Just calls C in reader implementation so this class -can be used as simple stub base class like -L does - -=cut - -sub new { - my $class = shift; - my $self = {@_}; - bless $self, $class; - $self->init && return $self; -} - -1; diff --git a/lib/RFID/Biblio/Reader/CPRM02.pm b/lib/RFID/Biblio/Reader/CPRM02.pm deleted file mode 100644 index 0992fc8..0000000 --- a/lib/RFID/Biblio/Reader/CPRM02.pm +++ /dev/null @@ -1,265 +0,0 @@ -package Biblio::RFID::Reader::CPRM02; - -=head1 NAME - -Biblio::RFID::Reader::CPRM02 - support for CPR-M02 RFID reader - -=head1 DESCRIPTION - -This module implements serial protocol over usb/serial adapter with CPR-M02 -reader as described in document C - -=cut - -use warnings; -use strict; - -use base 'Biblio::RFID::Reader::Serial'; -use Biblio::RFID; - -use Time::HiRes; -use Data::Dump qw(dump); - -my $debug = 1; - -sub serial_settings {{ - device => "/dev/ttyUSB0", - baudrate => "38400", - databits => "8", - parity => "even", - stopbits => "1", - handshake => "none", -}} - -sub cpr_m02_checksum { - my $data = shift; - - my $preset = 0xffff; - my $polynom = 0x8408; - - my $crc = $preset; - foreach my $i ( 0 .. length($data) - 1 ) { - $crc ^= ord(substr($data,$i,1)); - for my $j ( 0 .. 7 ) { - if ( $crc & 0x0001 ) { - $crc = ( $crc >> 1 ) ^ $polynom; - } else { - $crc = $crc >> 1; - } - } -# warn sprintf('%d %04x', $i, $crc & 0xffff); - } - - return pack('v', $crc); -} - -sub wait_device { - Time::HiRes::sleep 0.010; -} - -our $port; - -sub cpr { - my ( $hex, $description, $coderef ) = @_; - my $bytes = hex2bytes($hex); - my $len = pack( 'c', length( $bytes ) + 3 ); - my $send = $len . $bytes; - my $checksum = cpr_m02_checksum($send); - $send .= $checksum; - - warn "##>> ", as_hex( $send ), "\t\t[$description]\n"; - $port->write( $send ); - - wait_device; - - my $r_len = $port->read(1); - - my $count = 100; - while ( ! $r_len ) { - if ( $count-- == 0 ) { - warn "no response from device"; - return; - } - wait_device; - $r_len = $port->read(1); - } - - wait_device; - - my $data_len = ord($r_len) - 1; - my $data = $port->read( $data_len ); - warn "##<< ", as_hex( $r_len . $data ),"\n"; - - wait_device; - - $coderef->( $data ) if $coderef; - -} - -# FF = COM-ADDR any - -sub init { - my $self = shift; - - $port = $self->port; - -cpr( 'FF 52 00', 'Boud Rate Detection' ); - -cpr( 'FF 65', 'Get Software Version' ); - -cpr( 'FF 66 00', 'Get Reader Info - General hard and firware' ); - -cpr( 'FF 69', 'RF Reset' ); - - return 1; -} - - -sub inventory { - - my @tags; - -cpr( 'FF B0 01 00', 'ISO - Inventory', sub { - my $data = shift; - if (length($data) < 5 + 2 ) { - warn "# no tags in range\n"; - return; - } - - my $data_sets = ord(substr($data,3,1)); - $data = substr($data,4); - foreach ( 1 .. $data_sets ) { - my $tr_type = substr($data,0,1); - die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03"; - my $dsfid = substr($data,1,1); - my $uid = substr($data,2,8); - $data = substr($data,10); - warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/; - push @tags, hex_tag $uid; - - } -}); - - warn "# tags ",dump(@tags),$/; - return @tags; -} - - -sub _get_system_info { - my $tag = shift; - - my $info; - - cpr( "FF B0 2B 01 $tag", "Get System Information $tag", sub { - my $data = shift; - - warn "# data ",as_hex($data); - - return if length($data) < 17; - - $info = { - DSFID => substr($data,5-2,1), - UID => substr($data,6-2,8), - AFI => substr($data,14-2,1), - MEM => substr($data,15-2,1), - SIZE => substr($data,16-2,1), - IC_REF => substr($data,17-2,1), - }; - - }); - - warn "# _get_system_info $tag ",dump( $info ); - - return $info; -} - - -sub read_blocks { - my $tag = shift; - $tag = shift if ref $tag; - - my $info = _get_system_info $tag; - - return unless $info->{SIZE}; - - my $max_block = ord($info->{SIZE}); - - my $tag_blocks; - - my $block = 0; - while ( $block < $max_block ) { - cpr( sprintf("FF B0 23 01 $tag %02x 04", $block), "Read Multiple Blocks $block", sub { - my $data = shift; - - my $DB_N = ord substr($data,5-2,1); - my $DB_SIZE = ord substr($data,6-2,1); - - $data = substr($data,7-2,-2); -# warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data ), " transponder_data: [$transponder_data] ",length($transponder_data),"\n"; - foreach my $n ( 1 .. $DB_N ) { - my $sec = ord(substr($data,0,1)); - my $db = substr($data,1,$DB_SIZE); - warn "## block $n ",dump( $sec, $db ) if $debug; - $tag_blocks->{$tag}->[$block+$n-1] = reverse split(//,$db); - $data = substr($data, $DB_SIZE + 1); - } - }); - $block += 4; - } - - 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'; - - my $DB_ADR = 0; # start at first block - my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded - if ( my $padding = length($data) % $DB_SIZE ) { - warn "WARNING: data block not padded to $DB_SIZE bytes"; - $data .= "\x00" x $padding; - } - my $DB_N = length($data) / $DB_SIZE; - - my $send_data; - foreach my $block ( 0 .. $DB_N ) { - $send_data .= reverse split(//, substr( $data, $block * $DB_SIZE, $DB_SIZE ) ); - } - - cpr( sprintf("FF B0 24 01 $tag %02x %02x %02x %s", $DB_ADR, $DB_N, $DB_SIZE, as_hex($send_data)), "Write Multiple Blocks $tag", sub { - my $data = shift; - warn dump( $data ); - }); - -} - -sub read_afi { - my $tag = shift; - $tag = shift if ref $tag; - - my $info = _get_system_info $tag; - return $info->{AFI} || warn "no AFI for $tag in ",dump($info); - -} - -sub write_afi { - my $tag = shift; - $tag = shift if ref $tag; - - my $afi = shift || die "no afi?"; - $afi = as_hex $afi; - - cpr( "FF B0 27 01 $tag $afi", "Write AFI $tag $afi", sub { - my $data = shift; - warn "## write_afi $tag got ",as_hex($data); - }); - -} - -1 diff --git a/lib/RFID/Biblio/Reader/Serial.pm b/lib/RFID/Biblio/Reader/Serial.pm deleted file mode 100644 index 39282f0..0000000 --- a/lib/RFID/Biblio/Reader/Serial.pm +++ /dev/null @@ -1,89 +0,0 @@ -package Biblio::RFID::Reader::Serial; - -use warnings; -use strict; - -use Device::SerialPort qw(:STAT); -use Data::Dump qw(dump); - -=head1 NAME - -Biblio::RFID::Reader::Serial - base class for serial RFID readers - -=head1 METHODS - -=head2 new - -Open serial port (if needed) and init reader - -=cut - -sub new { - my $class = shift; - my $self = {@_}; - bless $self, $class; - - $self->port && return $self; -} - - -=head2 port - -Tries to open usb serial ports C - - my $serial_obj = $self->port; - -To try just one device use C enviroment variable - -=cut - -our $serial_device; - -sub port { - my $self = shift; - - return $self->{port} if defined $self->{port}; - - my $settings = $self->serial_settings; - my @devices = $ENV{RFID_DEVICE} ? ( $ENV{RFID_DEVICE} ) : glob '/dev/ttyUSB*'; - warn "# port devices ",dump(@devices); - - foreach my $device ( @devices ) { - - next if $serial_device->{$device}; - - if ( my $port = Device::SerialPort->new($device) ) { - - foreach my $opt ( qw/handshake baudrate databits parity stopbits/ ) { - $port->$opt( $settings->{$opt} ); - } - - $self->{port} = $port; - - warn "# probe by init $device ",ref($self); - if ( $self->init ) { - warn "init OK ", ref($self), " $device settings ",dump $settings; - $serial_device->{$device} = $port; - last; - } else { - $self->{port} = 0; - } - } - } - - warn "# serial_device ",dump($serial_device); - - return $self->{port}; -} - -1 -__END__ - -=head1 SEE ALSO - -L - -L - -L - diff --git a/lib/RFID/Biblio/Reader/librfid.pm b/lib/RFID/Biblio/Reader/librfid.pm deleted file mode 100644 index 3cadbb1..0000000 --- a/lib/RFID/Biblio/Reader/librfid.pm +++ /dev/null @@ -1,102 +0,0 @@ -package Biblio::RFID::Reader::librfid; - -use warnings; -use strict; - -use base 'Biblio::RFID::Reader::API'; -use Biblio::RFID; - -use Data::Dump qw(dump); - -=head1 NAME - -Biblio::RFID::Reader::librfid - execute librfid-tool - -=head1 DESCRIPTION - -This is wrapper around C from - -L - -Due to limitation of L only -L and -L is supported. - -However, this code might provide template for integration -with any command-line utilities for different RFID readers. - -Currently tested with only with Omnikey CardMan 5321 which -has problems. After a while it stops responding to commands -by C so I provided small C program to reset it: - -C - -=cut - -sub serial_settings {} # don't open serial - -our $bin = '/rest/cvs/librfid/utils/librfid-tool'; - -sub init { - my $self = shift; - if ( -e $bin ) { - warn "# using $bin"; - return 1; - } else { - warn "# no $bin found\n"; - return 0; - } -} - -sub _grep_tool { - my ( $param, $coderef ) = @_; - - warn "# _grep_tool $bin $param\n"; - open(my $s, '-|', "$bin $param") || die $!; - while(<$s>) { - chomp; - warn "## $_\n"; - - my $sid; - if ( m/success.+:\s+(.+)/ ) { - $sid = $1; - $sid =~ s/\s*'\s*//g; - $sid = uc join('', reverse split(/\s+/, $sid)); - } - - $coderef->( $sid ); - } - - -} - -sub inventory { - - my @tags; - _grep_tool '--scan' => sub { - my $sid = shift; - push @tags, $sid if $sid; - }; - warn "# invetory ",dump(@tags); - return @tags; -} - -sub read_blocks { - - my $sid; - my $blocks; - _grep_tool '--read -1' => sub { - $sid ||= shift; - $blocks->{$sid}->[$1] = hex2bytes($2) - if m/block\[\s*(\d+):.+data.+:\s*(.+)/; - - }; - warn "# read_blocks ",dump($blocks); - return $blocks; -} - -sub write_blocks {} -sub read_afi { -1 } -sub write_afi {} - -1