/[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 23 by dpavlin, Sat Mar 28 03:47:10 2009 UTC revision 52 by dpavlin, Wed Jun 24 10:20:20 2009 UTC
# Line 7  use warnings; Line 7  use warnings;
7  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
8  use Carp qw/confess/;  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10    use File::Slurp;
11    use JSON;
12    
13  use IO::Socket::INET;  use IO::Socket::INET;
14    
15  my $meteor = IO::Socket::INET->new( '192.168.1.13:4671' ) || die "can't connect to meteor: $!";  my $debug = 0;
16    
17    my $meteor_server = '192.168.1.13:4671';
18    my $meteor_fh;
19    
20  sub meteor {  sub meteor {
21          my ( $item, $html ) = @_;          my @a = @_;
22          warn ">> meteor $item $html\n";          push @a, scalar localtime() if $a[0] =~ m{^info};
23          print $meteor "ADDMESSAGE test $item|" . localtime() . "<br>$html\n";  
24            if ( ! defined $meteor_fh ) {
25                    if ( $meteor_fh =
26                                    IO::Socket::INET->new(
27                                            PeerAddr => $meteor_server,
28                                            Timeout => 1,
29                                    )
30                    ) {
31                            warn "# meteor connected to $meteor_server";
32                    } else {
33                            warn "can't connect to meteor $meteor_server: $!";
34                            $meteor_fh = 0;
35                    }
36            }
37    
38            if ( $meteor_fh ) {
39                    warn ">> meteor ",dump( @a );
40                    print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n"
41            }
42    }
43    
44    my $listen_port = 9000;                  # pick something not in use
45    sub http_server {
46    
47            my $server = IO::Socket::INET->new(
48                    Proto     => 'tcp',
49                    LocalPort => $listen_port,
50                    Listen    => SOMAXCONN,
51                    Reuse     => 1
52            );
53                                                                      
54            die "can't setup server" unless $server;
55    
56            print "Server $0 accepting clients at http://localhost:$listen_port/\n";
57    
58            sub static {
59                    my ($client,$path) = @_;
60    
61                    $path = "www/$path";
62    
63                    return unless -e $path;
64    
65                    my $type = 'text/plain';
66                    $type = 'text/html' if $path =~ m{\.htm};
67                    $type = 'application/javascript' if $path =~ m{\.js};
68    
69                    print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\n\r\n";
70                    open(my $html, $path);
71                    while(<$html>) {
72                            print $client $_;
73                    }
74                    close($html);
75    
76                    return $path;
77            }
78    
79            while (my $client = $server->accept()) {
80                    $client->autoflush(1);
81                    my $request = <$client>;
82    
83                    warn "WEB << $request\n" if $debug;
84    
85                    if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
86                            my $method = $1;
87                            my $param;
88                            if ( $method =~ s{\?(.+)}{} ) {
89                                    foreach my $p ( split(/[&;]/, $1) ) {
90                                            my ($n,$v) = split(/=/, $p, 2);
91                                            $param->{$n} = $v;
92                                    }
93                                    warn "WEB << param: ",dump( $param ) if $debug;
94                            }
95                            if ( my $path = static( $client,$1 ) ) {
96                                    warn "WEB >> $path" if $debug;
97                            } elsif ( $method =~ m{/scan} ) {
98                                    my $tags = scan_for_tags();
99                                    my $json = { time => time() };
100                                    map {
101                                            my $d = decode_tag($_);
102                                            $d->{sid} = $_;
103                                            push @{ $json->{tags} },  $d;
104                                    } keys %$tags;
105                                    print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",
106                                            $param->{callback}, "(", to_json($json), ")\r\n";
107                            } else {
108                                    print $client "HTTP/1.0 404 Unkown method\r\n";
109                            }
110                    } else {
111                            print $client "HTTP/1.0 500 No method\r\n";
112                    }
113                    close $client;
114            }
115    
116            die "server died";
117  }  }
118    
119  my $debug = 0;  
120    my $last_message = {};
121    sub _message {
122            my $type = shift @_;
123            my $text = join(' ',@_);
124            my $last = $last_message->{$type};
125            if ( $text ne $last ) {
126                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
127                    $last_message->{$type} = $text;
128            }
129    }
130    
131    sub _log { _message('log',@_) };
132    sub diag { _message('diag',@_) };
133    
134  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
135  my $baudrate  = "19200";  my $baudrate  = "19200";
# Line 27  my $parity       = "none"; Line 138  my $parity       = "none";
138  my $stopbits  = "1";  my $stopbits  = "1";
139  my $handshake = "none";  my $handshake = "none";
140    
141    my $program_path = './program/';
142    my $secure_path = './secure/';
143    
144    # http server
145    my $http_server = 1;
146    
147    # 3M defaults: 8,4
148    my $max_rfid_block = 16;
149    my $read_blocks = 8;
150    
151  my $response = {  my $response = {
152          'd500090400110a0500027250'                              => 'version?',          'd500090400110a0500027250'                              => 'version?',
153          'd60007fe00000500c97b'                                  => 'no tag in range',          'd60007fe00000500c97b'                                  => 'no tag in range',
# Line 47  GetOptions( Line 168  GetOptions(
168          'parity=s'    => \$parity,          'parity=s'    => \$parity,
169          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
170          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
171            'meteor=s'    => \$meteor_server,
172            'http-server!' => \$http_server,
173  ) or die $!;  ) or die $!;
174    
175  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 85  it under the same terms ans Perl itself. Line 208  it under the same terms ans Perl itself.
208  my $tags_data;  my $tags_data;
209  my $visible_tags;  my $visible_tags;
210    
211    my $item_type = {
212            1 => 'Book',
213            6 => 'CD/CD ROM',
214            2 => 'Magazine',
215            13 => 'Book with Audio Tape',
216            9 => 'Book with CD/CD ROM',
217            0 => 'Other',
218    
219            5 => 'Video',
220            4 => 'Audio Tape',
221            3 => 'Bound Journal',
222            8 => 'Book with Diskette',
223            7 => 'Diskette',
224    };
225    
226    warn "## known item type: ",dump( $item_type ) if $debug;
227    
228  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";
229  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
230  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
# Line 93  $databits=$port->databits($databits); Line 233  $databits=$port->databits($databits);
233  $parity=$port->parity($parity);  $parity=$port->parity($parity);
234  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
235    
236  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
237    
238  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
239  $port->lookclear();  $port->lookclear();
# Line 110  cmd( 'D5 00  05   04 00 11 Line 250  cmd( 'D5 00  05   04 00 11
250       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
251          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
252          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
253          meteor( -1, "Found reader $hw_ver" );          meteor( 'info', "Found reader hardware $hw_ver" );
254  });  });
255    
256  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?',
257       '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() }  );
258    
259  # start scanning for tags  sub scan_for_tags {
260    
261  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( -1, "No tags in range" );  
                 } else {  
262    
263                          my $tags = substr( $rest, 1 );          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
264                     'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
265                          my $tl = length( $tags );                          my $rest = shift || die "no rest?";
266                          die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;                          my $nr = ord( substr( $rest, 0, 1 ) );
267    
268                          my @tags;                          if ( ! $nr ) {
269                          push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );                                  _log "no tags in range\n";
270                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  update_visible_tags();
271                          print "$nr tags in range: ", join(',', @tags ) , "\n";                                  meteor( 'info-none-in-range' );
272                                    $tags_data = {};
273                            } else {
274    
275                                    my $tags = substr( $rest, 1 );
276                                    my $tl = length( $tags );
277                                    die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
278    
279                                    push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
280                                    warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
281                                    _log "$nr tags in range: ", join(',', @tags ) , "\n";
282    
283                          update_visible_tags( @tags );                                  meteor( 'info-in-range', join(' ',@tags));
284    
285                          my $html = join('', map { "<li><tt>$_</tt>" } @tags);                                  update_visible_tags( @tags );
286                          meteor( 0, "Tags:<ul>$html</ul>" );                          }
287                  }                  }
288          }          );
 ) foreach ( 1 .. 1000 );  
289    
290            diag "tags: ",dump( @tags );
291            return $tags_data;
292    
293    }
294    
295    # start scanning for tags
296    
297    if ( $http_server ) {
298            http_server;
299    } else {
300            scan_for_tags while 1;
301    }
302    
303    die "over and out";
304    
305  sub update_visible_tags {  sub update_visible_tags {
306          my @tags = @_;          my @tags = @_;
# Line 156  sub update_visible_tags { Line 309  sub update_visible_tags {
309          $visible_tags = {};          $visible_tags = {};
310    
311          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
312                    $visible_tags->{$tag}++;
313                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
314                          read_tag( $tag );                          if ( defined $tags_data->{$tag} ) {
315                          $visible_tags->{$tag}++;  #                               meteor( 'in-range', $tag );
316                            } else {
317                                    meteor( 'read', $tag );
318                                    read_tag( $tag );
319                            }
320                  } else {                  } else {
321                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
322                  }                  }
323                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
324    
325                    if ( -e "$program_path/$tag" ) {
326                                    meteor( 'write', $tag );
327                                    write_tag( $tag );
328                    }
329                    if ( -e "$secure_path/$tag" ) {
330                                    meteor( 'secure', $tag );
331                                    secure_tag( $tag );
332                    }
333          }          }
334    
335          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
336                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
337                  print "removed tag $tag with data ",dump( $data ),"\n";                  print "removed tag $tag with data ",dump( $data ),"\n";
338                    meteor( 'removed', $tag );
339          }          }
340    
341          warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;          warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
342  }  }
343    
344    my $tag_data_block;
345    
346    sub read_tag_data {
347            my ($start_block,$rest) = @_;
348            die "no rest?" unless $rest;
349    
350            my $last_block = 0;
351    
352            warn "## DATA [$start_block] ", dump( $rest ) if $debug;
353            my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));
354            my $blocks = ord(substr($rest,8,1));
355            $rest = substr($rest,9); # leave just data blocks
356            foreach my $nr ( 0 .. $blocks - 1 ) {
357                    my $block = substr( $rest, $nr * 6, 6 );
358                    warn "## block ",as_hex( $block ) if $debug;
359                    my $ord   = unpack('v',substr( $block, 0, 2 ));
360                    my $expected_ord = $nr + $start_block;
361                    warn "got block $ord, expected block $expected_ord from ",dump( $block ) if $ord != $expected_ord;
362                    my $data  = substr( $block, 2 );
363                    die "data payload should be 4 bytes" if length($data) != 4;
364                    warn sprintf "## tag %9s %02d: %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
365                    $tag_data_block->{$tag}->[ $ord ] = $data;
366                    $last_block = $ord;
367            }
368            $tags_data->{ $tag } = join('', @{ $tag_data_block->{$tag} });
369    
370            my $item_type_nr = ord(substr( $tags_data->{$tag}, 3, 1 ));
371            print "DATA $tag ",dump( $tags_data ), " item type: ", ( $item_type->{ $item_type_nr } || "UNKWOWN '$item_type_nr'" ), "\n";
372    
373            return $last_block + 1;
374    }
375    
376    sub decode_tag {
377            my $tag = shift;
378    
379            my $data = $tags_data->{$tag} || die "no data for $tag";
380    
381            my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
382            my $hash = {
383                    u1 => $u1,
384                    u2 => $u2,
385                    set => ( $set_item & 0xf0 ) >> 4,
386                    total => ( $set_item & 0x0f ),
387    
388                    type => $type,
389                    content => $content,
390    
391                    branch => $br_lib >> 20,
392                    library => $br_lib & 0x000fffff,
393    
394                    custom => $custom,
395            };
396    
397            return $hash;
398    }
399    
400  sub read_tag {  sub read_tag {
401          my ( $tag ) = @_;          my ( $tag ) = @_;
402    
403          confess "no tag?" unless $tag;          confess "no tag?" unless $tag;
404    
         return if defined $tags_data->{$tag};  
   
405          print "read_tag $tag\n";          print "read_tag $tag\n";
406    
407            my $start_block = 0;
408    
409            while ( $start_block < $max_rfid_block ) {
410    
411                    cmd(
412                             sprintf( "D6 00  0D  02      $tag   %02x   %02x     ffff", $start_block, $read_blocks ),
413                                    "read $tag offset: $start_block blocks: $read_blocks",
414                            "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";
415                                    $start_block = read_tag_data( $start_block, @_ );
416                                    warn "# read tag upto $start_block\n";
417                            },
418                            "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {
419                                    print "FIXME: tag $tag ready? (expected block read instead)\n";
420                            },
421                    );
422    
423            }
424    
425            my $security;
426    
427          cmd(          cmd(
428                  "D6 00  0D  02      $tag   00   03     1CC4", 'read $tag offset: 0 blocks: 3',                  "D6 00 0B 0A $tag 1234", "check security $tag",
429                  "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                  "D6 00 0D 0A 00", sub {
430                          print "FIXME: tag $tag ready?\n";                          my $rest = shift;
431                  },                          my $from_tag;
432                  "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";                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
433                          my $rest = shift || die "no rest?";                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
434                          warn "## DATA ", dump( $rest ) if $debug;                          $security = as_hex( $security );
435                          my $tag = uc(unpack('H16',substr( $rest, 0, 8 )));                          warn "# SECURITY $tag = $security\n";
                         my $blocks = ord(substr($rest,8,1));  
                         $rest = substr($rest,9); # leave just data blocks  
                         my @data;  
                         foreach my $nr ( 0 .. $blocks - 1 ) {  
                                 my $block = substr( $rest, $nr * 6, 6 );  
                                 warn "## block ",as_hex( $block ) if $debug;  
                                 my $ord   = unpack('v',substr( $block, 0, 2 ));  
                                 die "got block $ord, expected block $nr from ",dump( $block ) if $ord != $nr;  
                                 my $data  = substr( $block, 2 );  
                                 die "data payload should be 4 bytes" if length($data) != 4;  
                                 warn sprintf "## tag %08s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;  
                                 $data[ $ord ] = $data;  
                         }  
                         $tags_data->{ $tag } = join('', @data);  
                         print "DATA $tag ",dump( $tags_data ), "\n";  
436                  }                  }
437          );          );
438    
439          #        D6 00  1F  02 00   $tag   03   00 00   04 11 00 01   01 00   30 30 30 30   02 00   30 30 30 30    E5F4          print "TAG $tag ", dump(decode_tag( $tag ));
440  if (0) {  }
441          cmd(    "D6 00  0D  02      $tag   03   04     3970", 'read offset: 3 blocks: 4' );  
442    sub write_tag {
443          #        D6 00  25  02 00   $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00            my ($tag) = @_;
444          #                           $tag                              05 00   00 00 00 00   06 00   00 00 00 00    B9BA  
445          warn "?? D6 00  25  02 00   $tag   04                         03 00   39 30 31 32   04 00   ....\n";          my $path = "$program_path/$tag";
446    
447            my $data = read_file( $path );
448            my $hex_data;
449    
450            if ( $data =~ s{^hex\s+}{} ) {
451                    $hex_data = $data;
452                    $hex_data =~ s{\s+}{}g;
453            } else {
454    
455                    $data .= "\0" x ( 4 - ( length($data) % 4 ) );
456    
457                    my $max_len = $max_rfid_block * 4;
458    
459                    if ( length($data) > $max_len ) {
460                            $data = substr($data,0,$max_len);
461                            warn "strip content to $max_len bytes\n";
462                    }
463    
464                    $hex_data = unpack('H*', $data);
465            }
466    
467            my $len = length($hex_data) / 2;
468            # pad to block size
469            $hex_data .= '00' x ( 4 - $len % 4 );
470            my $blocks = sprintf('%02x', length($hex_data) / 4);
471    
472            print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
473    
474            cmd(
475                    "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  ffff", "write $tag",
476                    "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },
477            ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
478    
479            my $to = $path;
480            $to .= '.' . time();
481    
482            rename $path, $to;
483            print ">> $to\n";
484    
485            delete $tags_data->{$tag};      # force re-read of tag
486  }  }
         warn "?? D6 00  0F  FE  00 00  05 01   $tag  941A ##### ready?\n";  
487    
488          my $item = unpack('H*', substr($tag,-8) ) % 100000;  sub secure_tag {
489          meteor( $item, "Loading $item" );          my ($tag) = @_;
490    
491            my $path = "$secure_path/$tag";
492            my $data = substr(read_file( $path ),0,2);
493    
494            cmd(
495                    "d6 00  0c  09  $tag $data 1234", "secure $tag -> $data",
496                    "d6 00  0c  09 00  $tag  1234", sub { assert() },
497            );
498    
499            my $to = $path;
500            $to .= '.' . time();
501    
502            rename $path, $to;
503            print ">> $to\n";
504  }  }
505    
506  exit;  exit;
# Line 257  sub writechunk Line 535  sub writechunk
535  {  {
536          my $str=shift;          my $str=shift;
537          my $count = $port->write($str);          my $count = $port->write($str);
538            my $len = length($str);
539            die "wrong write length $count != $len in ",as_hex( $str ) if $count != $len;
540          print "#> ", as_hex( $str ), "\t[$count]\n" if $debug;          print "#> ", as_hex( $str ), "\t[$count]\n" if $debug;
541  }  }
542    
# Line 276  sub read_bytes { Line 556  sub read_bytes {
556          my $data = '';          my $data = '';
557          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
558                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
559                    die "no bytes on port: $!" unless defined $b;
560                  #warn "## got $c bytes: ", as_hex($b), "\n";                  #warn "## got $c bytes: ", as_hex($b), "\n";
561                  $data .= $b;                  $data .= $b;
562          }          }
# Line 322  sub crcccitt { Line 603  sub crcccitt {
603  sub checksum {  sub checksum {
604          my ( $bytes, $checksum ) = @_;          my ( $bytes, $checksum ) = @_;
605    
         my $xor = crcccitt( substr($bytes,1) ); # skip D6  
         warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;  
   
606          my $len = ord(substr($bytes,2,1));          my $len = ord(substr($bytes,2,1));
607          my $len_real = length($bytes) - 1;          my $len_real = length($bytes) - 1;
608    
609          if ( $len_real != $len ) {          if ( $len_real != $len ) {
610                  print "length wrong: $len_real != $len\n";                  print "length wrong: $len_real != $len\n";
611                  $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,4);                  $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,3);
612          }          }
613    
614            my $xor = crcccitt( substr($bytes,1) ); # skip D6
615            warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
616    
617          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
618                  print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";                  print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";
619                  return $bytes . $xor;                  return $bytes . $xor;
# Line 343  sub checksum { Line 624  sub checksum {
624  our $dispatch;  our $dispatch;
625    
626  sub readchunk {  sub readchunk {
627          sleep 1;        # FIXME remove  #       sleep 1;        # FIXME remove
628    
629          # read header of packet          # read header of packet
630          my $header = read_bytes( 2, 'header' );          my $header = read_bytes( 2, 'header' );
# Line 372  sub readchunk { Line 653  sub readchunk {
653          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;          warn "?? payload dispatch to ",dump( $payload, $dispatch, $to ) if $debug;
654    
655          if ( defined $to ) {          if ( defined $to ) {
656                  my $rest = substr( $payload, length($to) );                  my $rest = substr( $payload, length($to) ) if length($to) < length($payload);
657                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
658                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
659          } else {          } else {
Legend:
Removed from v.23  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.26