/[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

3m-810.pl revision 52 by dpavlin, Wed Jun 24 10:20:20 2009 UTC cpr-m02.pl revision 89 by dpavlin, Fri Jul 16 13:50:52 2010 UTC
# Line 9  use Carp qw/confess/; Line 9  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10  use File::Slurp;  use File::Slurp;
11  use JSON;  use JSON;
12    use POSIX qw(strftime);
13    use Time::HiRes;
14    
15  use IO::Socket::INET;  use IO::Socket::INET;
16    
17  my $debug = 0;  my $debug = 0;
18    
19  my $meteor_server = '192.168.1.13:4671';  my $tags_data;
20  my $meteor_fh;  my $tags_security;
21    my $visible_tags;
 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"  
         }  
 }  
22    
23  my $listen_port = 9000;                  # pick something not in use  my $listen_port = 9000;                  # pick something not in use
24    my $server_url  = "http://localhost:$listen_port";
25    
26  sub http_server {  sub http_server {
27    
28          my $server = IO::Socket::INET->new(          my $server = IO::Socket::INET->new(
# Line 51  sub http_server { Line 32  sub http_server {
32                  Reuse     => 1                  Reuse     => 1
33          );          );
34                                                                                                                                        
35          die "can't setup server" unless $server;          die "can't setup server: $!" unless $server;
36    
37          print "Server $0 accepting clients at http://localhost:$listen_port/\n";          print "Server $0 ready at $server_url\n";
38    
39          sub static {          sub static {
40                  my ($client,$path) = @_;                  my ($client,$path) = @_;
41    
42                  $path = "www/$path";                  $path = "www/$path";
43                    $path .= 'rfid.html' if $path =~ m{/$};
44    
45                  return unless -e $path;                  return unless -e $path;
46    
# Line 100  sub http_server { Line 82  sub http_server {
82                                  map {                                  map {
83                                          my $d = decode_tag($_);                                          my $d = decode_tag($_);
84                                          $d->{sid} = $_;                                          $d->{sid} = $_;
85                                            $d->{security} = $tags_security->{$_};
86                                          push @{ $json->{tags} },  $d;                                          push @{ $json->{tags} },  $d;
87                                  } keys %$tags;                                  } keys %$tags;
88                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
89                                          $param->{callback}, "(", to_json($json), ")\r\n";                                          $param->{callback}, "(", to_json($json), ")\r\n";
90                            } elsif ( $method =~ m{/program} ) {
91    
92                                    my $status = 501; # Not implementd
93    
94                                    foreach my $p ( keys %$param ) {
95                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
96                                            my $tag = $1;
97                                            my $content = "\x04\x11\x00\x01" . $param->{$p};
98                                            $content = "\x00" if $param->{$p} eq 'blank';
99                                            $status = 302;
100    
101                                            warn "PROGRAM $tag $content\n";
102                                            write_tag( $tag, $content );
103                                            secure_tag_with( $tag, $param->{$p} =~ /^130/ ? 'DA' : 'D7' );
104                                    }
105    
106                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
107    
108                            } elsif ( $method =~ m{/secure(.js)} ) {
109    
110                                    my $json = $1;
111    
112                                    my $status = 501; # Not implementd
113    
114                                    foreach my $p ( keys %$param ) {
115                                            next unless $p =~ m/^(E[0-9A-F]{15})$/;
116                                            my $tag = $1;
117                                            my $data = $param->{$p};
118                                            $status = 302;
119    
120                                            warn "SECURE $tag $data\n";
121                                            secure_tag_with( $tag, $data );
122                                    }
123    
124                                    if ( $json ) {
125                                            print $client "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\n\r\n",
126                                                    $param->{callback}, "({ ok: 1 })\r\n";
127                                    } else {
128                                            print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
129                                    }
130    
131                          } else {                          } else {
132                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n\r\n";
133                          }                          }
134                  } else {                  } else {
135                          print $client "HTTP/1.0 500 No method\r\n";                          print $client "HTTP/1.0 500 No method\r\n\r\n";
136                  }                  }
137                  close $client;                  close $client;
138          }          }
# Line 132  sub _log { _message('log',@_) }; Line 156  sub _log { _message('log',@_) };
156  sub diag { _message('diag',@_) };  sub diag { _message('diag',@_) };
157    
158  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
159  my $baudrate  = "19200";  my $baudrate  = "38400";
160  my $databits  = "8";  my $databits  = "8";
161  my $parity        = "none";  my $parity        = "even";
162  my $stopbits  = "1";  my $stopbits  = "1";
163  my $handshake = "none";  my $handshake = "none";
164    
# Line 145  my $secure_path = './secure/'; Line 169  my $secure_path = './secure/';
169  my $http_server = 1;  my $http_server = 1;
170    
171  # 3M defaults: 8,4  # 3M defaults: 8,4
172  my $max_rfid_block = 16;  # cards 16, stickers: 8
173    my $max_rfid_block = 8;
174  my $read_blocks = 8;  my $read_blocks = 8;
175    
176  my $response = {  my $response = {
# Line 168  GetOptions( Line 193  GetOptions(
193          'parity=s'    => \$parity,          'parity=s'    => \$parity,
194          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
195          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
         'meteor=s'    => \$meteor_server,  
196          'http-server!' => \$http_server,          'http-server!' => \$http_server,
197  ) or die $!;  ) or die $!;
198    
# Line 205  it under the same terms ans Perl itself. Line 229  it under the same terms ans Perl itself.
229    
230  =cut  =cut
231    
 my $tags_data;  
 my $visible_tags;  
   
232  my $item_type = {  my $item_type = {
233          1 => 'Book',          1 => 'Book',
234          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 244  $port->read_char_time(5); Line 265  $port->read_char_time(5);
265  #$port->stty_inpck(1);  #$port->stty_inpck(1);
266  #$port->stty_istrip(1);  #$port->stty_istrip(1);
267    
268    sub cpr_m02_checksum {
269            my $data = shift;
270    
271            my $preset = 0xffff;
272            my $polynom = 0x8408;
273    
274            my $crc = $preset;
275            foreach my $i ( 0 .. length($data) - 1 ) {
276                    $crc ^= ord(substr($data,$i,1));
277                    for my $j ( 0 .. 7 ) {
278                            if ( $crc & 0x0001 ) {
279                                    $crc = ( $crc >> 1 ) ^ $polynom;
280                            } else {
281                                    $crc = $crc >> 1;
282                            }
283                    }
284    #               warn sprintf('%d %04x', $i, $crc & 0xffff);
285            }
286    
287            return pack('v', $crc);
288    }
289    
290    sub cpr_psst_wait {
291            # Protocol Start Synchronization Time (PSST): 5ms < data timeout 12 ms
292            Time::HiRes::sleep 0.005;
293    }
294    
295    sub cpr {
296            my ( $hex, $description, $coderef ) = @_;
297            my $bytes = str2bytes($hex);
298            my $len = pack( 'c', length( $bytes ) + 3 );
299            my $send = $len . $bytes;
300            my $checksum = cpr_m02_checksum($send);
301            $send .= $checksum;
302    
303            warn ">> ", as_hex( $send ), "\t\t[$description]\n";
304            $port->write( $send );
305    
306            cpr_psst_wait;
307    
308            my $r_len = $port->read(1);
309    
310            while ( ! $r_len ) {
311                    warn "# wait for response length 5ms\n";
312                    cpr_psst_wait;
313                    $r_len = $port->read(1);
314            }
315    
316            my $data_len = ord($r_len) - 1;
317            my $data = $port->read( $data_len );
318            warn "<< ", as_hex( $r_len . $data ),"\n";
319    
320            cpr_psst_wait;
321    
322            $coderef->( $data ) if $coderef;
323    
324    }
325    
326    # FF = COM-ADDR any
327    
328    cpr( 'FF  52 00',       'Boud Rate Detection' );
329    
330    cpr( 'FF  65',          'Get Software Version' );
331    
332    cpr( 'FF  66 00',       'Get Reader Info - General hard and firware' );
333    
334    cpr( 'FF  69',          'RF Reset' );
335    
336    
337    sub cpr_read {
338            my $uid = shift;
339            my $hex_uid = as_hex($uid);
340    
341            cpr( "FF  B0 23  01  $hex_uid 00 04", "Read Multiple Blocks $hex_uid" );
342            cpr( "FF  B0 2B  01  $hex_uid", "Get System Information $hex_uid", sub {
343                    my $data = shift;
344    
345                    warn "# data ",as_hex($data);
346    
347                    my $DSFID    = substr($data,5-2,1);
348                    my $UID      = substr($data,6-2,8);
349                    my $AFI      = substr($data,14-2,1);
350                    my $MEM_SIZE = substr($data,15-2,2);
351                    my $IC_REF   = substr($data,17-2,1);
352    
353                    warn "# split ",as_hex( $DSFID, $UID, $AFI, $MEM_SIZE, $IC_REF );
354    
355            });
356    }
357    
358    
359    my $inventory;
360    
361    while(1) {
362    
363    cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
364            my $data = shift;
365            if (length($data) < 5 + 2 ) {
366                    warn "# no tags in range\n";
367                    return;
368            }
369            my $data_sets = ord(substr($data,3,1));
370            $data = substr($data,4);
371            foreach ( 1 .. $data_sets ) {
372                    my $tr_type = substr($data,0,1);
373                    die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
374                    my $dsfid   = substr($data,1,1);
375                    my $uid     = substr($data,2,8);
376                    $inventory->{$uid}++;
377                    $data = substr($data,10);
378                    warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
379    
380                    cpr_read( $uid );
381            }
382            warn "inventory: ",dump($inventory);
383    });
384    
385    }
386    
387    #cpr( '', '?' );
388    
389    exit;
390  # initial hand-shake with device  # initial hand-shake with device
391    
392  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
393       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
394          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
395          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
         meteor( 'info', "Found reader hardware $hw_ver" );  
396  });  });
397    
398  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?',
# Line 268  sub scan_for_tags { Line 410  sub scan_for_tags {
410                          if ( ! $nr ) {                          if ( ! $nr ) {
411                                  _log "no tags in range\n";                                  _log "no tags in range\n";
412                                  update_visible_tags();                                  update_visible_tags();
                                 meteor( 'info-none-in-range' );  
413                                  $tags_data = {};                                  $tags_data = {};
414                          } else {                          } else {
415    
# Line 280  sub scan_for_tags { Line 421  sub scan_for_tags {
421                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
422                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
423    
                                 meteor( 'info-in-range', join(' ',@tags));  
   
424                                  update_visible_tags( @tags );                                  update_visible_tags( @tags );
425                          }                          }
426                  }                  }
# Line 297  sub scan_for_tags { Line 436  sub scan_for_tags {
436  if ( $http_server ) {  if ( $http_server ) {
437          http_server;          http_server;
438  } else {  } else {
439          scan_for_tags while 1;          while (1) {
440                    scan_for_tags;
441                    sleep 1;
442            }
443  }  }
444    
445  die "over and out";  die "over and out";
# Line 312  sub update_visible_tags { Line 454  sub update_visible_tags {
454                  $visible_tags->{$tag}++;                  $visible_tags->{$tag}++;
455                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
456                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
457  #                               meteor( 'in-range', $tag );                                  warn "$tag in range\n";
458                          } else {                          } else {
                                 meteor( 'read', $tag );  
459                                  read_tag( $tag );                                  read_tag( $tag );
460                          }                          }
461                  } else {                  } else {
# Line 323  sub update_visible_tags { Line 464  sub update_visible_tags {
464                  delete $last_visible_tags->{$tag}; # leave just missing tags                  delete $last_visible_tags->{$tag}; # leave just missing tags
465    
466                  if ( -e "$program_path/$tag" ) {                  if ( -e "$program_path/$tag" ) {
                                 meteor( 'write', $tag );  
467                                  write_tag( $tag );                                  write_tag( $tag );
468                  }                  }
469                  if ( -e "$secure_path/$tag" ) {                  if ( -e "$secure_path/$tag" ) {
                                 meteor( 'secure', $tag );  
470                                  secure_tag( $tag );                                  secure_tag( $tag );
471                  }                  }
472          }          }
473    
474          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
475                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
476                  print "removed tag $tag with data ",dump( $data ),"\n";                  warn "$tag removed ", dump($data), $/;
                 meteor( 'removed', $tag );  
477          }          }
478    
479          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;
# Line 373  sub read_tag_data { Line 511  sub read_tag_data {
511          return $last_block + 1;          return $last_block + 1;
512  }  }
513    
514    my $saved_in_log;
515    
516  sub decode_tag {  sub decode_tag {
517          my $tag = shift;          my $tag = shift;
518    
519          my $data = $tags_data->{$tag} || die "no data for $tag";          my $data = $tags_data->{$tag};
520            if ( ! $data ) {
521                    warn "no data for $tag\n";
522                    return;
523            }
524    
525          my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);          my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
526          my $hash = {          my $hash = {
# Line 394  sub decode_tag { Line 538  sub decode_tag {
538                  custom => $custom,                  custom => $custom,
539          };          };
540    
541            if ( ! $saved_in_log->{$tag}++ ) {
542                    open(my $log, '>>', 'rfid-log.txt');
543                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
544                    close($log);
545            }
546    
547          return $hash;          return $hash;
548  }  }
549    
550    sub forget_tag {
551            my $tag = shift;
552            delete $tags_data->{$tag};
553            delete $visible_tags->{$tag};
554    }
555    
556  sub read_tag {  sub read_tag {
557          my ( $tag ) = @_;          my ( $tag ) = @_;
558    
# Line 409  sub read_tag { Line 565  sub read_tag {
565          while ( $start_block < $max_rfid_block ) {          while ( $start_block < $max_rfid_block ) {
566    
567                  cmd(                  cmd(
568                           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 ),
569                                  "read $tag offset: $start_block blocks: $read_blocks",                                  "read $tag offset: $start_block blocks: $read_blocks",
570                          "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";                          "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";
571                                  $start_block = read_tag_data( $start_block, @_ );                                  $start_block = read_tag_data( $start_block, @_ );
572                                  warn "# read tag upto $start_block\n";                                  warn "# read tag upto $start_block\n";
573                          },                          },
574                          "D6 00  0F  FE  00 00  05 01   $tag    941A", sub {                          "D6 00  0F  FE  00 00  05 01   $tag    BEEF", sub {
575                                  print "FIXME: tag $tag ready? (expected block read instead)\n";                                  print "FIXME: tag $tag ready? (expected block read instead)\n";
576                          },                          },
577                            "D6 00 0D 02 06 $tag", sub {
578                                    my $rest = shift;
579                                    print "ERROR reading $tag ", as_hex($rest), $/;
580                                    forget_tag $tag;
581                                    $start_block = $max_rfid_block; # XXX break out of while
582                            },
583                  );                  );
584    
585          }          }
# Line 425  sub read_tag { Line 587  sub read_tag {
587          my $security;          my $security;
588    
589          cmd(          cmd(
590                  "D6 00 0B 0A $tag 1234", "check security $tag",                  "D6 00 0B 0A $tag BEEF", "check security $tag",
591                  "D6 00 0D 0A 00", sub {                  "D6 00 0D 0A 00", sub {
592                          my $rest = shift;                          my $rest = shift;
593                          my $from_tag;                          my $from_tag;
594                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
595                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
596                          $security = as_hex( $security );                          $security = as_hex( $security );
597                            $tags_security->{$tag} = $security;
598                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
599                  }                  },
600                    "D6 00 0C 0A 06", sub {
601                            my $rest = shift;
602                            warn "ERROR reading security from $rest\n";
603                            forget_tag $tag;
604                    },
605          );          );
606    
607          print "TAG $tag ", dump(decode_tag( $tag ));          print "TAG $tag ", dump(decode_tag( $tag ));
608  }  }
609    
610  sub write_tag {  sub write_tag {
611          my ($tag) = @_;          my ($tag,$data) = @_;
612    
613          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
614            $data = read_file( $path ) if -e $path;
615    
616            die "no data" unless $data;
617    
         my $data = read_file( $path );  
618          my $hex_data;          my $hex_data;
619    
620          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
# Line 472  sub write_tag { Line 642  sub write_tag {
642          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";          print "write_tag $tag = ",dump( $data ), " [$len/$blocks] == $hex_data\n";
643    
644          cmd(          cmd(
645                  "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  ffff", "write $tag",                  "d6 00  ff  04  $tag  00 $blocks 00  $hex_data  BEEF", "write $tag",
646                  "d6 00  0d  04 00  $tag  $blocks  afb1", sub { assert() },                  "d6 00  0d  04 00  $tag  $blocks  BEEF", sub { assert() },
647          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!          ); # foreach ( 1 .. 3 ); # XXX 3m software does this three times!
648    
649          my $to = $path;          my $to = $path;
# Line 482  sub write_tag { Line 652  sub write_tag {
652          rename $path, $to;          rename $path, $to;
653          print ">> $to\n";          print ">> $to\n";
654    
655          delete $tags_data->{$tag};      # force re-read of tag          forget_tag $tag;
656    }
657    
658    sub secure_tag_with {
659            my ( $tag, $data ) = @_;
660    
661            cmd(
662                    "d6 00  0c  09  $tag $data BEEF", "secure $tag -> $data",
663                    "d6 00  0c  09 00  $tag    BEEF", sub { assert() },
664            );
665    
666            forget_tag $tag;
667  }  }
668    
669  sub secure_tag {  sub secure_tag {
# Line 491  sub secure_tag { Line 672  sub secure_tag {
672          my $path = "$secure_path/$tag";          my $path = "$secure_path/$tag";
673          my $data = substr(read_file( $path ),0,2);          my $data = substr(read_file( $path ),0,2);
674    
675          cmd(          secure_tag_with( $tag, $data );
                 "d6 00  0c  09  $tag $data 1234", "secure $tag -> $data",  
                 "d6 00  0c  09 00  $tag  1234", sub { assert() },  
         );  
676    
677          my $to = $path;          my $to = $path;
678          $to .= '.' . time();          $to .= '.' . time();
# Line 543  sub writechunk Line 721  sub writechunk
721  sub as_hex {  sub as_hex {
722          my @out;          my @out;
723          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
724                  my $hex = unpack( 'H*', $str );                  my $hex = uc unpack( 'H*', $str );
725                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
726                  $hex =~ s/\s+$//;                  $hex =~ s/\s+$//;
727                  push @out, $hex;                  push @out, $hex;
# Line 557  sub read_bytes { Line 735  sub read_bytes {
735          while ( length( $data ) < $len ) {          while ( length( $data ) < $len ) {
736                  my ( $c, $b ) = $port->read(1);                  my ( $c, $b ) = $port->read(1);
737                  die "no bytes on port: $!" unless defined $b;                  die "no bytes on port: $!" unless defined $b;
738                  #warn "## got $c bytes: ", as_hex($b), "\n";                  warn "## got $c bytes: ", as_hex($b), "\n";
739                    last if $c == 0;
740                  $data .= $b;                  $data .= $b;
741          }          }
742          $desc ||= '?';          $desc ||= '?';
# Line 615  sub checksum { Line 794  sub checksum {
794          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;          warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
795    
796          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
797                  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";
798                  return $bytes . $xor;                  return $bytes . $xor;
799          }          }
800          return $bytes . $checksum;          return $bytes . $checksum;
# Line 657  sub readchunk { Line 836  sub readchunk {
836                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
837                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
838          } else {          } else {
839                  print "NO DISPATCH for ",dump( $full ),"\n";                  die "NO DISPATCH for ",as_hex( $full ),"\n";
840          }          }
841    
842          return $data;          return $data;
Legend:
Removed from v.52  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26