--- 3m-810.pl 2009/06/04 13:36:20 41 +++ 3m-810.pl 2010/02/09 13:55:18 61 @@ -8,10 +8,18 @@ use Carp qw/confess/; use Getopt::Long; use File::Slurp; +use JSON; +use POSIX qw(strftime); use IO::Socket::INET; -my $meteor_server = '192.168.1.13:4671'; +my $debug = 0; + +my $tags_data; +my $tags_security; +my $visible_tags; + +my $meteor_server; # = '192.168.1.13:4671'; my $meteor_fh; sub meteor { @@ -38,7 +46,115 @@ } } -my $debug = 0; +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/x-javascript\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/^tag_(\S+)/; + my $tag = $1; + my $content = "\x04\x11\x00\x01" . $param->{$p}; + $status = 302; + + warn "PROGRAM $tag $content\n"; + write_tag( $tag, $content ); + } + + 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"; + } + } else { + print $client "HTTP/1.0 500 No method\r\n"; + } + close $client; + } + + die "server died"; +} + + +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"; @@ -50,6 +166,9 @@ my $program_path = './program/'; my $secure_path = './secure/'; +# http server +my $http_server = 1; + # 3M defaults: 8,4 my $max_rfid_block = 16; my $read_blocks = 8; @@ -75,6 +194,7 @@ 'stopbits=i' => \$stopbits, 'handshake=s' => \$handshake, 'meteor=s' => \$meteor_server, + 'http-server!' => \$http_server, ) or die $!; my $verbose = $debug > 0 ? $debug-- : 0; @@ -110,9 +230,6 @@ =cut -my $tags_data; -my $visible_tags; - my $item_type = { 1 => 'Book', 6 => 'CD/CD ROM', @@ -138,7 +255,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(); @@ -161,39 +278,54 @@ 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( 'info-none-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 ) ); + + if ( ! $nr ) { + _log "no tags in range\n"; + update_visible_tags(); + meteor( 'info-none-in-range' ); + $tags_data = {}; + } else { - my $tl = length( $tags ); - die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8; + my $tags = substr( $rest, 1 ); + my $tl = length( $tags ); + die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8; - 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"; + 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"; - meteor( 'info-in-range', join(' ',@tags)); + meteor( 'info-in-range', join(' ',@tags)); - update_visible_tags( @tags ); + update_visible_tags( @tags ); + } } - } -) while(1); -#) foreach ( 1 .. 100 ); + ); + diag "tags: ",dump( @tags ); + return $tags_data; +} + +# 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 = @_; @@ -202,6 +334,7 @@ $visible_tags = {}; foreach my $tag ( @tags ) { + $visible_tags->{$tag}++; if ( ! defined $last_visible_tags->{$tag} ) { if ( defined $tags_data->{$tag} ) { # meteor( 'in-range', $tag ); @@ -209,7 +342,6 @@ meteor( 'read', $tag ); read_tag( $tag ); } - $visible_tags->{$tag}++; } else { warn "## using cached data for $tag" if $debug; } @@ -261,9 +393,41 @@ $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' in " . dump( $item_type ) ), "\n"; + print "DATA $tag ",dump( $tags_data ), " item type: ", ( $item_type->{ $item_type_nr } || "UNKWOWN '$item_type_nr'" ), "\n"; - return $last_block; + 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 ( $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 read_tag { @@ -301,26 +465,22 @@ ( $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"; } ); - my $data = $tags_data->{$tag} || die "no data for $tag"; - my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data); - my $set = ( $set_item & 0xf0 ) >> 4; - my $total = ( $set_item & 0x0f ); - my $branch = $br_lib >> 20; - my $library = $br_lib & 0x000fffff; - print "TAG $tag [$u1] set: $set/$total [$u2] type: $type '$content' library: $library branch: $branch custom: $custom security: $security\n"; - + 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+}{} ) { @@ -451,8 +611,6 @@ sub assert { my ( $from, $to ) = @_; - return unless $assert->{expect}; - $from ||= 0; $to = length( $assert->{expect} ) if ! defined $to; @@ -502,7 +660,7 @@ our $dispatch; sub readchunk { - sleep 1; # FIXME remove +# sleep 1; # FIXME remove # read header of packet my $header = read_bytes( 2, 'header' ); @@ -530,12 +688,12 @@ } sort { length($a) <=> length($b) } keys %$dispatch; warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug; - if ( defined $to && $payload ) { - my $rest = substr( $payload, length($to) ); + if ( defined $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"; + print "NO DISPATCH for ",as_hex( $full ),"\n"; } return $data;