--- 3m-810.pl 2009/06/23 13:50:13 46 +++ cpr-m02.pl 2010/07/16 16:34:13 91 @@ -9,37 +9,20 @@ use Getopt::Long; use File::Slurp; use JSON; +use POSIX qw(strftime); +use Time::HiRes; use IO::Socket::INET; -my $meteor_server = '192.168.1.13:4671'; -my $meteor_fh; - -sub meteor { - my @a = @_; - push @a, scalar localtime() if $a[0] =~ m{^info}; - - if ( ! defined $meteor_fh ) { - if ( $meteor_fh = - IO::Socket::INET->new( - PeerAddr => $meteor_server, - Timeout => 1, - ) - ) { - warn "# meteor connected to $meteor_server"; - } else { - warn "can't connect to meteor $meteor_server: $!"; - $meteor_fh = 0; - } - } +my $debug = 0; - if ( $meteor_fh ) { - warn ">> meteor ",dump( @a ); - print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n" - } -} +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( @@ -49,14 +32,15 @@ Reuse => 1 ); - die "can't setup server" unless $server; + die "can't setup server: $!" unless $server; - print "Server $0 accepting clients at http://localhost:$listen_port/\n"; + 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; @@ -78,7 +62,7 @@ $client->autoflush(1); my $request = <$client>; - warn "<< $request\n"; + warn "WEB << $request\n" if $debug; if ($request =~ m{^GET (/.*) HTTP/1.[01]}) { my $method = $1; @@ -88,25 +72,67 @@ my ($n,$v) = split(/=/, $p, 2); $param->{$n} = $v; } - warn "<< param: ",dump( $param ); + warn "WEB << param: ",dump( $param ) if $debug; } if ( my $path = static( $client,$1 ) ) { - warn ">> $path"; + warn "WEB >> $path" if $debug; } elsif ( $method =~ m{/scan} ) { my $tags = scan_for_tags(); - my $json = {}; + 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/x-javascript\r\n\r\n", + 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"; + print $client "HTTP/1.0 404 Unkown method\r\n\r\n"; } } else { - print $client "HTTP/1.0 500 No method\r\n"; + print $client "HTTP/1.0 500 No method\r\n\r\n"; } close $client; } @@ -114,12 +140,25 @@ 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"; @@ -130,7 +169,8 @@ my $http_server = 1; # 3M defaults: 8,4 -my $max_rfid_block = 16; +# cards 16, stickers: 8 +my $max_rfid_block = 8; my $read_blocks = 8; my $response = { @@ -153,7 +193,6 @@ 'parity=s' => \$parity, 'stopbits=i' => \$stopbits, 'handshake=s' => \$handshake, - 'meteor=s' => \$meteor_server, 'http-server!' => \$http_server, ) or die $!; @@ -190,9 +229,6 @@ =cut -my $tags_data; -my $visible_tags; - my $item_type = { 1 => 'Book', 6 => 'CD/CD ROM', @@ -218,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(); @@ -229,13 +265,163 @@ #$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( 'info', "Found reader hardware $hw_ver" ); }); cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','FIXME: stats?', @@ -245,35 +431,31 @@ my @tags; - cmd( 'D6 00 05 FE 00 05 FA40', "scan for tags, retry $_", + 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 ) ); if ( ! $nr ) { - print "no tags in range\n"; + _log "no tags in range\n"; update_visible_tags(); - meteor( 'info-none-in-range' ); $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; - print "$nr tags in range: ", join(',', @tags ) , "\n"; - - meteor( 'info-in-range', join(' ',@tags)); + _log "$nr tags in range: ", join(',', @tags ) , "\n"; update_visible_tags( @tags ); } } ); - warn "## tags: ",dump( @tags ); + diag "tags: ",dump( @tags ); return $tags_data; } @@ -283,7 +465,10 @@ if ( $http_server ) { http_server; } else { - scan_for_tags while 1; + while (1) { + scan_for_tags; + sleep 1; + } } die "over and out"; @@ -295,33 +480,29 @@ $visible_tags = {}; foreach my $tag ( @tags ) { + $visible_tags->{$tag}++; if ( ! defined $last_visible_tags->{$tag} ) { if ( defined $tags_data->{$tag} ) { -# meteor( 'in-range', $tag ); + warn "$tag in range\n"; } else { - meteor( 'read', $tag ); read_tag( $tag ); } - $visible_tags->{$tag}++; } else { warn "## using cached data for $tag" if $debug; } delete $last_visible_tags->{$tag}; # leave just missing tags if ( -e "$program_path/$tag" ) { - meteor( 'write', $tag ); write_tag( $tag ); } if ( -e "$secure_path/$tag" ) { - meteor( 'secure', $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"; - meteor( 'removed', $tag ); + 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; @@ -359,10 +540,16 @@ return $last_block + 1; } +my $saved_in_log; + sub decode_tag { my $tag = shift; - my $data = $tags_data->{$tag} || die "no data for $tag"; + 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 = { @@ -380,9 +567,21 @@ 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 ) = @_; @@ -395,15 +594,21 @@ while ( $start_block < $max_rfid_block ) { cmd( - sprintf( "D6 00 0D 02 $tag %02x %02x ffff", $start_block, $read_blocks ), + 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 941A", sub { + "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 + }, ); } @@ -411,26 +616,34 @@ my $security; cmd( - "D6 00 0B 0A $tag 1234", "check security $tag", + "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 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) = @_; + my ($tag,$data) = @_; my $path = "$program_path/$tag"; + $data = read_file( $path ) if -e $path; + + die "no data" unless $data; - my $data = read_file( $path ); my $hex_data; if ( $data =~ s{^hex\s+}{} ) { @@ -458,8 +671,8 @@ print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n"; cmd( - "d6 00 ff 04 $tag 00 $blocks 00 $hex_data ffff", "write $tag", - "d6 00 0d 04 00 $tag $blocks afb1", sub { assert() }, + "d6 00 ff 04 $tag 00 $blocks 00 $hex_data BEEF", "write $tag", + "d6 00 0d 04 00 $tag $blocks BEEF", sub { assert() }, ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times! my $to = $path; @@ -468,7 +681,18 @@ rename $path, $to; print ">> $to\n"; - delete $tags_data->{$tag}; # force re-read of tag + 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() }, + ); + + forget_tag $tag; } sub secure_tag { @@ -477,10 +701,7 @@ my $path = "$secure_path/$tag"; my $data = substr(read_file( $path ),0,2); - cmd( - "d6 00 0c 09 $tag $data 1234", "secure $tag -> $data", - "d6 00 0c 09 00 $tag 1234", sub { assert() }, - ); + secure_tag_with( $tag, $data ); my $to = $path; $to .= '.' . time(); @@ -529,7 +750,7 @@ 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; @@ -543,7 +764,8 @@ 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"; + warn "## got $c bytes: ", as_hex($b), "\n"; + last if $c == 0; $data .= $b; } $desc ||= '?'; @@ -601,7 +823,7 @@ 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; @@ -643,7 +865,7 @@ 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 ),"\n"; } return $data;