/[RFID]/cpr-m02.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 /cpr-m02.pl

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

revision 39 by dpavlin, Mon Jun 1 21:07:11 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
121    my $max_rfid_block = 16;
122    my $read_blocks = 8;
123    
124  my $response = {  my $response = {
125          'd500090400110a0500027250'                              => 'version?',          'd500090400110a0500027250'                              => 'version?',
126          'd60007fe00000500c97b'                                  => 'no tag in range',          'd60007fe00000500c97b'                                  => 'no tag in range',
# Line 157  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;
234           'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8  
235                  my $rest = shift || die "no rest?";          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",
236                  my $nr = ord( substr( $rest, 0, 1 ) );                   'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
237                            my $rest = shift || die "no rest?";
238                  if ( ! $nr ) {                          my $nr = ord( substr( $rest, 0, 1 ) );
239                          print "no tags in range\n";  
240                          update_visible_tags();                          if ( ! $nr ) {
241                          meteor( 'info-none-in-range' );                                  print "no tags in range\n";
242                          $tags_data = {};                                  update_visible_tags();
243                  } else {                                  meteor( 'info-none-in-range' );
244                                    $tags_data = {};
245                            } else {
246    
247                          my $tags = substr( $rest, 1 );                                  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          }          );
 ) while(1);  
 #) foreach ( 1 .. 100 );  
262    
263            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 235  my $tag_data_block; Line 319  my $tag_data_block;
319  sub read_tag_data {  sub read_tag_data {
320          my ($start_block,$rest) = @_;          my ($start_block,$rest) = @_;
321          die "no rest?" unless $rest;          die "no rest?" unless $rest;
322    
323            my $last_block = 0;
324    
325          warn "## DATA [$start_block] ", dump( $rest ) if $debug;          warn "## DATA [$start_block] ", dump( $rest ) if $debug;
326          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
327          my $blocks = ord(substr($rest,8,1));          my $blocks = ord(substr($rest,8,1));
# Line 244  sub read_tag_data { Line 331  sub read_tag_data {
331                  warn "## block ",as_hex( $block ) if $debug;                  warn "## block ",as_hex( $block ) if $debug;
332                  my $ord   = unpack('v',substr( $block, 0, 2 ));                  my $ord   = unpack('v',substr( $block, 0, 2 ));
333                  my $expected_ord = $nr + $start_block;                  my $expected_ord = $nr + $start_block;
334                  die "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;                  warn "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;
335                  my $data  = substr( $block, 2 );                  my $data  = substr( $block, 2 );
336                  die "data payload should be 4 bytes" if length($data) != 4;                  die "data payload should be 4 bytes" if length($data) != 4;
337                  warn sprintf "## tag %9s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;                  warn sprintf "## tag %9s %02d: %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
338                  $tag_data_block->{$tag}->[ $ord ] = $data;                  $tag_data_block->{$tag}->[ $ord ] = $data;
339                    $last_block = $ord;
340          }          }
341          $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });          $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });
342    
343          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));          my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));
344          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";
345    
346            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 {
# Line 263  sub read_tag { Line 377  sub read_tag {
377    
378          print "read_tag $tag\n";          print "read_tag $tag\n";
379    
380          cmd(          my $start_block = 0;
                 "D6 00  0D  02      $tag   00   03     1CC4", "read $tag offset: 0 blocks: 3",  
                 "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {  
                         print "FIXME: tag $tag ready?\n";  
                 },  
                 "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";  
                         read_tag_data( 0, @_ );  
                 },  
         );  
381    
382          cmd(          while ( $start_block < $max_rfid_block ) {
383                  "D6 00  0D  02      $tag   03   04     3970", "read $tag offset: 3 blocks: 4",  
384                  "D6 00  25  02 00", sub { # $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00                    cmd(
385                          read_tag_data( 3, @_ );                           sprintf( "D6 00  0D  02      $tag   %02x   %02x     ffff", $start_block, $read_blocks ),
386                  }                                  "read $tag offset: $start_block blocks: $read_blocks",
387          );                          "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";
388                                    $start_block = read_tag_data( $start_block, @_ );
389                                    warn "# read tag upto $start_block\n";
390                            },
391                            "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {
392                                    print "FIXME: tag $tag ready? (expected block read instead)\n";
393                            },
394                    );
395    
396            }
397    
398          my $security;          my $security;
399    
# Line 294  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 317  sub write_tag { Line 425  sub write_tag {
425                  $hex_data =~ s{\s+}{}g;                  $hex_data =~ s{\s+}{}g;
426          } else {          } else {
427    
                 # pad to block size  
428                  $data .= "\0" x ( 4 - ( length($data) % 4 ) );                  $data .= "\0" x ( 4 - ( length($data) % 4 ) );
429    
430                  my $max_len = 7 * 4;                  my $max_len = $max_rfid_block * 4;
431    
432                  if ( length($data) > $max_len ) {                  if ( length($data) > $max_len ) {
433                          $data = substr($data,0,$max_len);                          $data = substr($data,0,$max_len);
# Line 331  sub write_tag { Line 438  sub write_tag {
438          }          }
439    
440          my $len = length($hex_data) / 2;          my $len = length($hex_data) / 2;
441          my $blocks = sprintf('%02x', $len / 4);          # pad to block size
442            $hex_data .= '00' x ( 4 - $len % 4 );
443            my $blocks = sprintf('%02x', length($hex_data) / 4);
444    
445          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
446    
447          cmd(          cmd(
448                  "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  ffff", "write $tag",                  "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  ffff", "write $tag",
449                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },
450          ) foreach ( 1 .. 3 ); # xxx 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
451    
452          my $to = $path;          my $to = $path;
453          $to .= '.' . time();          $to .= '.' . time();
# Line 439  sub skip_assert { Line 548  sub skip_assert {
548  sub assert {  sub assert {
549          my ( $from, $to ) = @_;          my ( $from, $to ) = @_;
550    
         return unless $assert->{expect};  
   
551          $from ||= 0;          $from ||= 0;
552          $to = length( $assert->{expect} ) if ! defined $to;          $to = length( $assert->{expect} ) if ! defined $to;
553    
# Line 490  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' );
# Line 518  sub readchunk { Line 625  sub readchunk {
625          } sort { length($a) <=> length($b) } keys %$dispatch;          } sort { length($a) <=> length($b) } keys %$dispatch;
626          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;
627    
628          if ( defined $to && $payload ) {          if ( defined $to ) {
629                  my $rest = substr( $payload, length($to) );                  my $rest = substr( $payload, length($to) ) if length($to) < length($payload);
630                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
631                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
632          } else {          } else {
Legend:
Removed from v.39  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.26