/[RFID]/3m-810.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /3m-810.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 42 by dpavlin, Thu Jun 4 13:52:10 2009 UTC revision 43 by dpavlin, Tue Jun 23 12:19:30 2009 UTC
# Line 38  sub meteor { Line 38  sub meteor {
38          }          }
39  }  }
40    
41    my $listen_port = 9000;                  # pick something not in use
42    sub http_server {
43    
44            my $server = IO::Socket::INET->new(
45                    Proto     => 'tcp',
46                    LocalPort => $listen_port,
47                    Listen    => SOMAXCONN,
48                    Reuse     => 1
49            );
50                                                                      
51            die "can't setup server" unless $server;
52    
53            print "Server $0 accepting clients at http://localhost:$listen_port/\n";
54    
55            sub static {
56                    my ($client,$path) = @_;
57    
58                    $path = "www/$path";
59    
60                    return unless -e $path;
61    
62                    my $type = 'text/plain';
63                    $type = 'text/html' if $path =~ m{\.htm};
64                    $type = 'application/javascript' if $path =~ m{\.js};
65    
66                    print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\n\r\n";
67                    open(my $html, $path);
68                    while(<$html>) {
69                            print $client $_;
70                    }
71                    close($html);
72    
73                    return $path;
74            }
75    
76            while (my $client = $server->accept()) {
77                    $client->autoflush(1);
78                    my $request = <$client>;
79    
80                    warn "<< $request\n";
81    
82                    if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
83                            my $method = $1;
84                            if ( my $path = static( $client,$1 ) ) {
85                                    warn ">> $path";
86                            } elsif ( $method =~ m{/scan} ) {
87                                    print $client "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\n";
88                                    my $tags = scan_for_tags();
89                                    print $client "tags: ",dump($tags);
90                                    my $json;
91                                    map { $json->{$_} = decode_tag($_) } keys %$tags;
92                                    print $client "decoded: ",dump( $json );
93                            } else {
94                                    print $client "HTTP/1.0 404 Unkown method\r\n";
95                            }
96                    } else {
97                            print $client "HTTP/1.0 500 No method\r\n";
98                    }
99                    close $client;
100            }
101    
102            die "server died";
103    }
104    
105  my $debug = 0;  my $debug = 0;
106    
107  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 50  my $handshake = "none"; Line 114  my $handshake = "none";
114  my $program_path = './program/';  my $program_path = './program/';
115  my $secure_path = './secure/';  my $secure_path = './secure/';
116    
117    # http server
118    my $http_server = 1;
119    
120  # 3M defaults: 8,4  # 3M defaults: 8,4
121  my $max_rfid_block = 16;  my $max_rfid_block = 16;
122  my $read_blocks = 8;  my $read_blocks = 8;
# Line 161  cmd( 'D5 00  05   04 00 11 Line 228  cmd( 'D5 00  05   04 00 11
228  cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',  cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',
229       'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );       'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );
230    
231  # start scanning for tags  sub scan_for_tags {
232    
233  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          my @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";  
                         update_visible_tags();  
                         meteor( 'info-none-in-range' );  
                         $tags_data = {};  
                 } else {  
234    
235                          my $tags = substr( $rest, 1 );          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",
236                     'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
237                            my $rest = shift || die "no rest?";
238                            my $nr = ord( substr( $rest, 0, 1 ) );
239    
240                            if ( ! $nr ) {
241                                    print "no tags in range\n";
242                                    update_visible_tags();
243                                    meteor( 'info-none-in-range' );
244                                    $tags_data = {};
245                            } else {
246    
247                                    my $tags = substr( $rest, 1 );
248    
249                          my $tl = length( $tags );                                  my $tl = length( $tags );
250                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;                                  die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
251    
252                          my @tags;                                  push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
253                          push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
254                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  print "$nr tags in range: ", join(',', @tags ) , "\n";
                         print "$nr tags in range: ", join(',', @tags ) , "\n";  
255    
256                          meteor( 'info-in-range', join(' ',@tags));                                  meteor( 'info-in-range', join(' ',@tags));
257    
258                          update_visible_tags( @tags );                                  update_visible_tags( @tags );
259                            }
260                  }                  }
261          }          );
262  ) while(1);  
263  #) foreach ( 1 .. 100 );          warn "## tags: ",dump( @tags );
264            return $tags_data;
265    
266    }
267    
268    # start scanning for tags
269    
270    if ( $http_server ) {
271            http_server;
272    } else {
273            scan_for_tags while 1;
274    }
275    
276    die "over and out";
277    
278  sub update_visible_tags {  sub update_visible_tags {
279          my @tags = @_;          my @tags = @_;
# Line 266  sub read_tag_data { Line 346  sub read_tag_data {
346          return $last_block + 1;          return $last_block + 1;
347  }  }
348    
349    sub decode_tag {
350            my $tag = shift;
351    
352            my $data = $tags_data->{$tag} || die "no data for $tag";
353    
354            my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
355            my $hash = {
356                    u1 => $u1,
357                    u2 => $u2,
358                    set => ( $set_item & 0xf0 ) >> 4,
359                    total => ( $set_item & 0x0f ),
360    
361                    type => $type,
362                    content => $content,
363    
364                    branch => $br_lib >> 20,
365                    library => $br_lib & 0x000fffff,
366    
367                    custom => $custom,
368            };
369    
370            return $hash;
371    }
372    
373  sub read_tag {  sub read_tag {
374          my ( $tag ) = @_;          my ( $tag ) = @_;
375    
# Line 305  sub read_tag { Line 409  sub read_tag {
409                  }                  }
410          );          );
411    
412          my $data = $tags_data->{$tag} || die "no data for $tag";          print "TAG $tag ", dump(decode_tag( $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";  
   
413  }  }
414    
415  sub write_tag {  sub write_tag {
# Line 500  sub checksum { Line 597  sub checksum {
597  our $dispatch;  our $dispatch;
598    
599  sub readchunk {  sub readchunk {
600          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
601    
602          # read header of packet          # read header of packet
603          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
Legend:
Removed from v.42  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.26