--- 3m-810.pl	2009/06/24 13:39:43	54
+++ 3m-810.pl	2010/02/11 14:14:21	66
@@ -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(
@@ -57,12 +33,13 @@
 								  
 	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;
 
@@ -109,6 +86,23 @@
 				} 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/^(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 );
+				}
+
+				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";
 			}
@@ -173,7 +167,6 @@
 	'parity=s'    => \$parity,
 	'stopbits=i'  => \$stopbits,
 	'handshake=s' => \$handshake,
-	'meteor=s'    => \$meteor_server,
 	'http-server!' => \$http_server,
 ) or die $!;
 
@@ -252,7 +245,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 +262,6 @@
 			if ( ! $nr ) {
 				_log "no tags in range\n";
 				update_visible_tags();
-				meteor( 'info-none-in-range' );
 				$tags_data = {};
 			} else {
 
@@ -282,8 +273,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 +288,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 +306,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 +316,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,6 +363,8 @@
 	return $last_block + 1;
 }
 
+my $saved_in_log;
+
 sub decode_tag {
 	my $tag = shift;
 
@@ -396,6 +386,12 @@
 		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;
 }
 
@@ -411,13 +407,13 @@
 	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";
 			},
 		);
@@ -427,7 +423,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;
@@ -443,11 +439,13 @@
 }
 
 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 +473,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 +483,9 @@
 	rename $path, $to;
 	print ">> $to\n";
 
-	delete $tags_data->{$tag};	# force re-read of tag
+	# force re-read of tag
+	delete $tags_data->{$tag};
+	delete $visible_tags->{$tag};
 }
 
 sub secure_tag {
@@ -495,8 +495,8 @@
 	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() },
+		"d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
+		"d6 00  0c  09 00  $tag    BEEF", sub { assert() },
 	);
 
 	my $to = $path;
@@ -618,7 +618,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 +660,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;