--- 3m-810.pl 2009/03/28 03:47:10 23
+++ 3m-810.pl 2010/07/23 13:16:51 92
@@ -7,18 +7,152 @@
use Data::Dump qw/dump/;
use Carp qw/confess/;
use Getopt::Long;
+use File::Slurp;
+use JSON;
+use POSIX qw(strftime);
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);
-sub meteor {
- my ( $item, $html ) = @_;
- warn ">> meteor $item $html\n";
- print $meteor "ADDMESSAGE test $item|" . localtime() . "
$html\n";
+ 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;
+ }
+
+ 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";
@@ -27,6 +161,17 @@
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 +192,7 @@
'parity=s' => \$parity,
'stopbits=i' => \$stopbits,
'handshake=s' => \$handshake,
+ 'http-server!' => \$http_server,
) or die $!;
my $verbose = $debug > 0 ? $debug-- : 0;
@@ -82,8 +228,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 +253,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();
@@ -110,44 +270,56 @@
'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" );
- } 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 { "
$_" } @tags);
- meteor( 0, "Tags:" );
- }
- }
-) foreach ( 1 .. 1000 );
+}
+# start scanning for tags
+
+if ( $http_server ) {
+ http_server;
+} else {
+ while (1) {
+ scan_for_tags;
+ sleep 1;
+ }
+}
+die "over and out";
sub update_visible_tags {
my @tags = @_;
@@ -156,73 +328,248 @@
$visible_tags = {};
foreach my $tag ( @tags ) {
+ $visible_tags->{$tag}++;
if ( ! defined $last_visible_tags->{$tag} ) {
- read_tag( $tag );
- $visible_tags->{$tag}++;
+ if ( defined $tags_data->{$tag} ) {
+ warn "$tag in range\n";
+ } else {
+ read_tag( $tag );
+ }
} else {
warn "## using cached data for $tag" if $debug;
}
delete $last_visible_tags->{$tag}; # leave just missing tags
+
+ if ( -e "$program_path/$tag" ) {
+ write_tag( $tag );
+ }
+ if ( -e "$secure_path/$tag" ) {
+ secure_tag( $tag );
+ }
}
foreach my $tag ( keys %$last_visible_tags ) {
my $data = delete $tags_data->{$tag};
- print "removed tag $tag with data ",dump( $data ),"\n";
+ warn "$tag removed ", dump($data), $/;
}
warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
}
+my $tag_data_block;
+
+sub read_tag_data {
+ my ($start_block,$rest) = @_;
+ die "no rest?" unless $rest;
+
+ my $last_block = 0;
+
+ warn "## DATA [$start_block] ", dump( $rest ) if $debug;
+ my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
+ my $blocks = ord(substr($rest,8,1));
+ $rest = substr($rest,9); # leave just data blocks
+ foreach my $nr ( 0 .. $blocks - 1 ) {
+ my $block = substr( $rest, $nr * 6, 6 );
+ warn "## block ",as_hex( $block ) if $debug;
+ my $ord = unpack('v',substr( $block, 0, 2 ));
+ my $expected_ord = $nr + $start_block;
+ warn "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;
+ my $data = substr( $block, 2 );
+ die "data payload should be 4 bytes" if length($data) != 4;
+ warn sprintf "## tag %9s %02d: %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
+ $tag_data_block->{$tag}->[ $ord ] = $data;
+ $last_block = $ord;
+ }
+ $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });
+
+ my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));
+ print "DATA $tag ",dump( $tags_data ), " item type: ", ( $item_type->{ $item_type_nr } || "UNKWOWN '$item_type_nr'" ), "\n";
+
+ return $last_block + 1;
+}
+
+my $saved_in_log;
+
+sub decode_tag {
+ my $tag = shift;
+
+ my $data = $tags_data->{$tag};
+ if ( ! $data ) {
+ warn "no data for $tag\n";
+ return;
+ }
+
+ my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
+ my $hash = {
+ u1 => $u1,
+ u2 => $u2,
+ set => ( $set_item & 0xf0 ) >> 4,
+ total => ( $set_item & 0x0f ),
+
+ type => $type,
+ content => $content,
+
+ branch => $br_lib >> 20,
+ library => $br_lib & 0x000fffff,
+
+ custom => $custom,
+ };
+
+ if ( ! $saved_in_log->{$tag}++ ) {
+ open(my $log, '>>', 'rfid-log.txt');
+ print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
+ close($log);
+ }
+
+ return $hash;
+}
+
+sub forget_tag {
+ my $tag = shift;
+ delete $tags_data->{$tag};
+ delete $visible_tags->{$tag};
+}
sub read_tag {
my ( $tag ) = @_;
confess "no tag?" unless $tag;
- return if defined $tags_data->{$tag};
-
print "read_tag $tag\n";
+ my $start_block = 0;
+
+ while ( $start_block < $max_rfid_block ) {
+
+ cmd(
+ sprintf( "D6 00 0D 02 $tag %02x %02x BEEF", $start_block, $read_blocks ),
+ "read $tag offset: $start_block blocks: $read_blocks",
+ "D6 00 1F 02 00", sub { # $tag 03 00 00 04 11 00 01 01 00 31 32 33 34 02 00 35 36 37 38 531F\n";
+ $start_block = read_tag_data( $start_block, @_ );
+ warn "# read tag upto $start_block\n";
+ },
+ "D6 00 0F FE 00 00 05 01 $tag BEEF", sub {
+ print "FIXME: tag $tag ready? (expected block read instead)\n";
+ },
+ "D6 00 0D 02 06 $tag", sub {
+ my $rest = shift;
+ print "ERROR reading $tag ", as_hex($rest), $/;
+ forget_tag $tag;
+ $start_block = $max_rfid_block; # XXX break out of while
+ },
+ );
+
+ }
+
+ my $security;
+
cmd(
- "D6 00 0D 02 $tag 00 03 1CC4", 'read $tag offset: 0 blocks: 3',
- "D6 00 0F FE 00 00 05 01 $tag 941A", sub {
- print "FIXME: tag $tag ready?\n";
+ "D6 00 0B 0A $tag BEEF", "check security $tag",
+ "D6 00 0D 0A 00", sub {
+ my $rest = shift;
+ my $from_tag;
+ ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
+ die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
+ $security = as_hex( $security );
+ $tags_security->{$tag} = $security;
+ warn "# SECURITY $tag = $security\n";
},
- "D6 00 1F 02 00", sub { # $tag 03 00 00 04 11 00 01 01 00 31 32 33 34 02 00 35 36 37 38 531F\n";
- my $rest = shift || die "no rest?";
- warn "## DATA ", dump( $rest ) if $debug;
- my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
- my $blocks = ord(substr($rest,8,1));
- $rest = substr($rest,9); # leave just data blocks
- my @data;
- foreach my $nr ( 0 .. $blocks - 1 ) {
- my $block = substr( $rest, $nr * 6, 6 );
- warn "## block ",as_hex( $block ) if $debug;
- my $ord = unpack('v',substr( $block, 0, 2 ));
- die "got block $ord, expected block $nr from ",dump( $block ) if $ord != $nr;
- my $data = substr( $block, 2 );
- die "data payload should be 4 bytes" if length($data) != 4;
- warn sprintf "## tag %08s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
- $data[ $ord ] = $data;
- }
- $tags_data->{ $tag } = join('', @data);
- print "DATA $tag ",dump( $tags_data ), "\n";
+ "D6 00 0C 0A 06", sub {
+ my $rest = shift;
+ warn "ERROR reading security from $rest\n";
+ forget_tag $tag;
+ },
+ );
+
+ print "TAG $tag ", dump(decode_tag( $tag ));
+}
+
+sub write_tag {
+ my ($tag,$data) = @_;
+
+ my $path = "$program_path/$tag";
+ $data = read_file( $path ) if -e $path;
+
+ die "no data" unless $data;
+
+ my $hex_data;
+
+ if ( $data =~ s{^hex\s+}{} ) {
+ $hex_data = $data;
+ $hex_data =~ s{\s+}{}g;
+ } else {
+
+ $data .= "\0" x ( 4 - ( length($data) % 4 ) );
+
+ my $max_len = $max_rfid_block * 4;
+
+ if ( length($data) > $max_len ) {
+ $data = substr($data,0,$max_len);
+ warn "strip content to $max_len bytes\n";
}
+
+ $hex_data = unpack('H*', $data);
+ }
+
+ my $len = length($hex_data) / 2;
+ # pad to block size
+ $hex_data .= '00' x ( 4 - $len % 4 );
+ my $blocks = sprintf('%02x', length($hex_data) / 4);
+
+ print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
+
+ my $ok = 0;
+
+ cmd(
+ "d6 00 ff 04 $tag 00 $blocks 00 $hex_data BEEF", "write $tag",
+ "d6 00 0d 06 00 $tag $blocks BEEF", sub { assert(); $ok++ },
+ "d6 00 0d 04 06 ", sub {
+ my $data = shift;
+ warn "no tag ",as_hex( substr($data,0,8) ), " in range for write\n";
+ },
+ ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
+
+ if ( $ok ) {
+
+ my $to = $path;
+ $to .= '.' . time();
+
+ rename $path, $to;
+ print ">> $to\n";
+
+ }
+
+ forget_tag $tag;
+}
+
+sub secure_tag_with {
+ my ( $tag, $data ) = @_;
+
+ cmd(
+ "d6 00 0c 09 $tag $data BEEF", "secure $tag -> $data",
+ "d6 00 0c 09 00 $tag BEEF", sub { assert() },
+ "d6 00 0c 09 06 ", sub {
+ my $data = shift;
+ warn "no tag ",as_hex( substr($data,0,8) ), " in range for secure\n";
+ },
);
- # D6 00 1F 02 00 $tag 03 00 00 04 11 00 01 01 00 30 30 30 30 02 00 30 30 30 30 E5F4
-if (0) {
- cmd( "D6 00 0D 02 $tag 03 04 3970", 'read offset: 3 blocks: 4' );
-
- # D6 00 25 02 00 $tag 04 03 00 30 30 00 00 04 00 00 00 00 00
- # $tag 05 00 00 00 00 00 06 00 00 00 00 00 B9BA
- warn "?? D6 00 25 02 00 $tag 04 03 00 39 30 31 32 04 00 ....\n";
+ forget_tag $tag;
}
- warn "?? D6 00 0F FE 00 00 05 01 $tag 941A ##### ready?\n";
- my $item = unpack('H*', substr($tag,-8) ) % 100000;
- meteor( $item, "Loading $item" );
+sub secure_tag {
+ my ($tag) = @_;
+
+ my $path = "$secure_path/$tag";
+ my $data = substr(read_file( $path ),0,2);
+
+ secure_tag_with( $tag, $data );
+ my $to = $path;
+ $to .= '.' . time();
+
+ rename $path, $to;
+ print ">> $to\n";
}
exit;
@@ -257,13 +604,15 @@
{
my $str=shift;
my $count = $port->write($str);
+ my $len = length($str);
+ die "wrong write length $count != $len in ",as_hex( $str ) if $count != $len;
print "#> ", as_hex( $str ), "\t[$count]\n" if $debug;
}
sub as_hex {
my @out;
foreach my $str ( @_ ) {
- my $hex = unpack( 'H*', $str );
+ my $hex = uc unpack( 'H*', $str );
$hex =~ s/(..)/$1 /g if length( $str ) > 2;
$hex =~ s/\s+$//;
push @out, $hex;
@@ -276,6 +625,7 @@
my $data = '';
while ( length( $data ) < $len ) {
my ( $c, $b ) = $port->read(1);
+ die "no bytes on port: $!" unless defined $b;
#warn "## got $c bytes: ", as_hex($b), "\n";
$data .= $b;
}
@@ -322,19 +672,19 @@
sub checksum {
my ( $bytes, $checksum ) = @_;
- my $xor = crcccitt( substr($bytes,1) ); # skip D6
- warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
-
my $len = ord(substr($bytes,2,1));
my $len_real = length($bytes) - 1;
if ( $len_real != $len ) {
print "length wrong: $len_real != $len\n";
- $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,4);
+ $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,3);
}
+ my $xor = crcccitt( substr($bytes,1) ); # skip D6
+ warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
+
if ( defined $checksum && $xor ne $checksum ) {
- print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";
+ warn "checksum error: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n" if $checksum ne "\xBE\xEF";
return $bytes . $xor;
}
return $bytes . $checksum;
@@ -343,7 +693,7 @@
our $dispatch;
sub readchunk {
- sleep 1; # FIXME remove
+# sleep 1; # FIXME remove
# read header of packet
my $header = read_bytes( 2, 'header' );
@@ -372,11 +722,11 @@
warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;
if ( defined $to ) {
- my $rest = substr( $payload, length($to) );
+ my $rest = substr( $payload, length($to) ) if length($to) < length($payload);
warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
$dispatch->{ $to }->( $rest );
} else {
- print "NO DISPATCH for ",dump( $full ),"\n";
+ die "NO DISPATCH for ",as_hex( $full ), " in ", dump( $dispatch );
}
return $data;