--- 3m-810.pl 2009/03/28 14:20:27 24
+++ cpr-m02.pl 2010/07/16 16:34:13 91
@@ -7,26 +7,172 @@
use Data::Dump qw/dump/;
use Carp qw/confess/;
use Getopt::Long;
+use File::Slurp;
+use JSON;
+use POSIX qw(strftime);
+use Time::HiRes;
use IO::Socket::INET;
-my $meteor = IO::Socket::INET->new( '192.168.1.13:4671' ) || die "can't connect to meteor: $!";
+my $debug = 0;
+
+my $tags_data;
+my $tags_security;
+my $visible_tags;
+
+my $listen_port = 9000; # pick something not in use
+my $server_url = "http://localhost:$listen_port";
+
+sub http_server {
+
+ my $server = IO::Socket::INET->new(
+ Proto => 'tcp',
+ LocalPort => $listen_port,
+ Listen => SOMAXCONN,
+ Reuse => 1
+ );
+
+ die "can't setup server: $!" unless $server;
+
+ print "Server $0 ready at $server_url\n";
+
+ sub static {
+ my ($client,$path) = @_;
+
+ $path = "www/$path";
+ $path .= 'rfid.html' if $path =~ m{/$};
+
+ return unless -e $path;
+
+ my $type = 'text/plain';
+ $type = 'text/html' if $path =~ m{\.htm};
+ $type = 'application/javascript' if $path =~ m{\.js};
+
+ print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\n\r\n";
+ open(my $html, $path);
+ while(<$html>) {
+ print $client $_;
+ }
+ close($html);
+
+ return $path;
+ }
+
+ while (my $client = $server->accept()) {
+ $client->autoflush(1);
+ my $request = <$client>;
+
+ warn "WEB << $request\n" if $debug;
+
+ if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
+ my $method = $1;
+ my $param;
+ if ( $method =~ s{\?(.+)}{} ) {
+ foreach my $p ( split(/[&;]/, $1) ) {
+ my ($n,$v) = split(/=/, $p, 2);
+ $param->{$n} = $v;
+ }
+ warn "WEB << param: ",dump( $param ) if $debug;
+ }
+ if ( my $path = static( $client,$1 ) ) {
+ warn "WEB >> $path" if $debug;
+ } elsif ( $method =~ m{/scan} ) {
+ my $tags = scan_for_tags();
+ my $json = { time => time() };
+ map {
+ my $d = decode_tag($_);
+ $d->{sid} = $_;
+ $d->{security} = $tags_security->{$_};
+ push @{ $json->{tags} }, $d;
+ } keys %$tags;
+ print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
+ $param->{callback}, "(", to_json($json), ")\r\n";
+ } elsif ( $method =~ m{/program} ) {
+
+ my $status = 501; # Not implementd
+
+ foreach my $p ( keys %$param ) {
+ next unless $p =~ m/^(E[0-9A-F]{15})$/;
+ my $tag = $1;
+ my $content = "\x04\x11\x00\x01" . $param->{$p};
+ $content = "\x00" if $param->{$p} eq 'blank';
+ $status = 302;
+
+ warn "PROGRAM $tag $content\n";
+ write_tag( $tag, $content );
+ secure_tag_with( $tag, $param->{$p} =~ /^130/ ? 'DA' : 'D7' );
+ }
+
+ print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
+
+ } elsif ( $method =~ m{/secure(.js)} ) {
+
+ my $json = $1;
+
+ my $status = 501; # Not implementd
+
+ foreach my $p ( keys %$param ) {
+ next unless $p =~ m/^(E[0-9A-F]{15})$/;
+ my $tag = $1;
+ my $data = $param->{$p};
+ $status = 302;
+
+ warn "SECURE $tag $data\n";
+ secure_tag_with( $tag, $data );
+ }
+
+ if ( $json ) {
+ print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
+ $param->{callback}, "({ ok: 1 })\r\n";
+ } else {
+ print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
+ }
+
+ } else {
+ print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
+ }
+ } else {
+ print $client "HTTP/1.0 500 No method\r\n\r\n";
+ }
+ close $client;
+ }
-sub meteor {
- my ( $item, $html ) = @_;
- warn ">> meteor $item $html\n";
- print $meteor "ADDMESSAGE test $item|" . localtime() . "
$html\n";
+ die "server died";
}
-my $debug = 0;
+
+my $last_message = {};
+sub _message {
+ my $type = shift @_;
+ my $text = join(' ',@_);
+ my $last = $last_message->{$type};
+ if ( $text ne $last ) {
+ warn $type eq 'diag' ? '# ' : '', $text, "\n";
+ $last_message->{$type} = $text;
+ }
+}
+
+sub _log { _message('log',@_) };
+sub diag { _message('diag',@_) };
my $device = "/dev/ttyUSB0";
-my $baudrate = "19200";
+my $baudrate = "38400";
my $databits = "8";
-my $parity = "none";
+my $parity = "even";
my $stopbits = "1";
my $handshake = "none";
+my $program_path = './program/';
+my $secure_path = './secure/';
+
+# http server
+my $http_server = 1;
+
+# 3M defaults: 8,4
+# cards 16, stickers: 8
+my $max_rfid_block = 8;
+my $read_blocks = 8;
+
my $response = {
'd500090400110a0500027250' => 'version?',
'd60007fe00000500c97b' => 'no tag in range',
@@ -47,6 +193,7 @@
'parity=s' => \$parity,
'stopbits=i' => \$stopbits,
'handshake=s' => \$handshake,
+ 'http-server!' => \$http_server,
) or die $!;
my $verbose = $debug > 0 ? $debug-- : 0;
@@ -82,8 +229,22 @@
=cut
-my $tags_data;
-my $visible_tags;
+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',
+};
+
+warn "## known item type: ",dump( $item_type ) if $debug;
my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";
warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
@@ -93,7 +254,7 @@
$parity=$port->parity($parity);
$stopbits=$port->stopbits($stopbits);
-print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
+warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
# Just in case: reset our timing and buffers
$port->lookclear();
@@ -104,52 +265,213 @@
#$port->stty_inpck(1);
#$port->stty_istrip(1);
+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 cpr_psst_wait {
+ # Protocol Start Synchronization Time (PSST): 5ms < data timeout 12 ms
+ Time::HiRes::sleep 0.005;
+}
+
+sub cpr {
+ my ( $hex, $description, $coderef ) = @_;
+ my $bytes = str2bytes($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 );
+
+ cpr_psst_wait;
+
+ my $r_len = $port->read(1);
+
+ while ( ! $r_len ) {
+ warn "# wait for response length 5ms\n";
+ cpr_psst_wait;
+ $r_len = $port->read(1);
+ }
+
+ my $data_len = ord($r_len) - 1;
+ my $data = $port->read( $data_len );
+ warn "<< ", as_hex( $r_len . $data ),"\n";
+
+ cpr_psst_wait;
+
+ $coderef->( $data ) if $coderef;
+
+}
+
+# FF = COM-ADDR any
+
+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' );
+
+
+sub cpr_read {
+ my $uid = shift;
+ my $hex_uid = as_hex($uid);
+
+ my $max_block;
+
+ cpr( "FF B0 2B 01 $hex_uid", "Get System Information $hex_uid", sub {
+ my $data = shift;
+
+ warn "# data ",as_hex($data);
+
+ my $DSFID = substr($data,5-2,1);
+ my $UID = substr($data,6-2,8);
+ my $AFI = substr($data,14-2,1);
+ my $MEM = substr($data,15-2,1);
+ my $SIZE = substr($data,16-2,1);
+ my $IC_REF = substr($data,17-2,1);
+
+ warn "# split ",as_hex( $DSFID, $UID, $AFI, $MEM, $SIZE, $IC_REF );
+
+ $max_block = ord($SIZE);
+ });
+
+ my $transponder_data;
+
+ my $block = 0;
+ while ( $block < $max_block ) {
+ cpr( sprintf("FF B0 23 01 $hex_uid %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 );
+ foreach ( 1 .. $DB_N ) {
+ my $sec = substr($data,0,1);
+ my $db = substr($data,1,$DB_SIZE);
+ warn "block $_ ",dump( $sec, $db );
+ $transponder_data .= reverse split(//,$db);
+ $data = substr($data, $DB_SIZE + 1);
+ }
+ });
+ $block += 4;
+ }
+
+ warn "DATA $hex_uid ", dump($transponder_data);
+ exit;
+}
+
+
+my $inventory;
+
+while(1) {
+
+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);
+ $inventory->{$uid}++;
+ $data = substr($data,10);
+ warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
+
+ cpr_read( $uid );
+ }
+ warn "inventory: ",dump($inventory);
+});
+
+}
+
+#cpr( '', '?' );
+
+exit;
# initial hand-shake with device
cmd( 'D5 00 05 04 00 11 8C66', 'hw version',
'D5 00 09 04 00 11 0A 05 00 02 7250', sub {
my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
print "hardware version $hw_ver\n";
- meteor( -1, "Found reader $hw_ver" );
});
cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','FIXME: stats?',
'D6 00 0C 13 00 02 01 01 03 02 02 03 00 E778', sub { assert() } );
-# start scanning for tags
+sub scan_for_tags {
-cmd( 'D6 00 05 FE 00 05 FA40', "scan for tags, retry $_",
- 'D6 00 0F FE 00 00 05 ', sub { # 01 E00401003123AA26 941A # seen, serial length: 8
- my $rest = shift || die "no rest?";
- my $nr = ord( substr( $rest, 0, 1 ) );
-
- if ( ! $nr ) {
- print "no tags in range\n";
- update_visible_tags();
- meteor( -1, "No tags in range" );
- $tags_data = {};
- } else {
+ my @tags;
- my $tags = substr( $rest, 1 );
+ cmd( 'D6 00 05 FE 00 05 FA40', "scan for tags",
+ 'D6 00 0F FE 00 00 05 ', sub { # 01 E00401003123AA26 941A # seen, serial length: 8
+ my $rest = shift || die "no rest?";
+ my $nr = ord( substr( $rest, 0, 1 ) );
- my $tl = length( $tags );
- die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+ if ( ! $nr ) {
+ _log "no tags in range\n";
+ update_visible_tags();
+ $tags_data = {};
+ } else {
+
+ my $tags = substr( $rest, 1 );
+ my $tl = length( $tags );
+ die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+
+ push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
+ warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
+ _log "$nr tags in range: ", join(',', @tags ) , "\n";
- my @tags;
- push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
- warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
- print "$nr tags in range: ", join(',', @tags ) , "\n";
+ update_visible_tags( @tags );
+ }
+ }
+ );
- update_visible_tags( @tags );
+ diag "tags: ",dump( @tags );
+ return $tags_data;
- my $html = join('', map { "