--- 3m-810.pl 2009/06/24 13:39:43 54 +++ 3m-810.pl 2010/07/06 15:05:44 80 @@ -9,6 +9,7 @@ use Getopt::Long; use File::Slurp; use JSON; +use POSIX qw(strftime); use IO::Socket::INET; @@ -18,34 +19,9 @@ my $tags_security; my $visible_tags; -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; - } - } - - if ( $meteor_fh ) { - warn ">> meteor ",dump( @a ); - print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n" - } -} - 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( @@ -55,14 +31,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; @@ -107,13 +84,54 @@ $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; } @@ -150,7 +168,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 = { @@ -173,7 +192,6 @@ 'parity=s' => \$parity, 'stopbits=i' => \$stopbits, 'handshake=s' => \$handshake, - 'meteor=s' => \$meteor_server, 'http-server!' => \$http_server, ) or die $!; @@ -252,7 +270,6 @@ '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?', @@ -270,7 +287,6 @@ if ( ! $nr ) { _log "no tags in range\n"; update_visible_tags(); - meteor( 'info-none-in-range' ); $tags_data = {}; } else { @@ -282,8 +298,6 @@ warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug; _log "$nr tags in range: ", join(',', @tags ) , "\n"; - meteor( 'info-in-range', join(' ',@tags)); - update_visible_tags( @tags ); } } @@ -299,7 +313,10 @@ if ( $http_server ) { http_server; } else { - scan_for_tags while 1; + while (1) { + scan_for_tags; + sleep 1; + } } die "over and out"; @@ -314,9 +331,8 @@ $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 ); } } else { @@ -325,19 +341,16 @@ 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; @@ -375,10 +388,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 = { @@ -396,9 +415,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 ) = @_; @@ -411,15 +442,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 + }, ); } @@ -427,7 +464,7 @@ 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; @@ -436,18 +473,25 @@ $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+}{} ) { @@ -475,8 +519,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; @@ -485,7 +529,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 { @@ -494,10 +549,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(); @@ -546,7 +598,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; @@ -618,7 +670,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; @@ -660,7 +712,7 @@ warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug; $dispatch->{ $to }->( $rest ); } else { - print "NO DISPATCH for ",as_hex( $full ),"\n"; + die "NO DISPATCH for ",as_hex( $full ),"\n"; } return $data;