/[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 8 by dpavlin, Sun Sep 28 22:10:55 2008 UTC revision 16 by dpavlin, Thu Oct 2 22:53:57 2008 UTC
# Line 39  L<Device::SerialPort(3)> Line 39  L<Device::SerialPort(3)>
39    
40  L<perl(1)>  L<perl(1)>
41    
42    L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
43    
44  =head1 AUTHOR  =head1 AUTHOR
45    
46  Dobrica Pavlinusic <dpavlin@rot13.org> L<http://www.rot13.org/~dpavlin/>  Dobrica Pavlinusic <dpavlin@rot13.org> L<http://www.rot13.org/~dpavlin/>
# Line 102  dispatch( Line 104  dispatch(
104                          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;
105    
106                          my @tags;                          my @tags;
107                          push @tags, substr($tags, $_ * 8, 8) foreach ( 0 .. $nr - 1 );                          push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
108                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
109                          print "seen $nr tags: ", join(',', map { unpack('H16', $_) } @tags ) , "\n";                          print "seen $nr tags: ", join(',', @tags ) , "\n";
110    
111                            # XXX read first tag
112                            read_tag( @tags );
113    
114                  }                  }
115  ) }  ) }
116    
117  ) foreach ( 1 .. 100 );  ) foreach ( 1 .. 100 );
118    
119  cmd( 'D6 00  0D  02      E00401003123AA26   00   03     1CC4', 'read offset: 0 blocks: 3' );  my $read_cached;
120    
121    sub read_tag {
122            my ( $tag ) = @_;
123    
124  #     D6 00  1F  02 00   E00401003123AA26   03   00 00   04 11 00 01   01 00   30 30 30 30   02 00   30 30 30 30    E5F4          print "read_tag $tag\n";
125  warn "D6 00  1F  02 00   E00401003123AA26   03   00 00   04 11 00 01   01 00   31 32 33 34   02 00   35 36 37 38    531F\n";          return if $read_cached->{ $tag }++;
126    
127  cmd( 'D6 00  0D  02      E00401003123AA26   03   04     3970', 'read offset: 3 blocks: 4' );          cmd(    "D6 00  0D  02      $tag   00   03     1CC4", 'read offset: 0 blocks: 3' );
128    
129            #        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
130            warn "?? D6 00  1F  02 00   $tag   03   00 00   04 11 00 01   01 00   31 32 33 34   02 00   35 36 37 38    531F\n";
131    if (0) {
132            cmd(    "D6 00  0D  02      $tag   03   04     3970", 'read offset: 3 blocks: 4' );
133    
134            #        D6 00  25  02 00   $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00  
135            #                           $tag                              05 00   00 00 00 00   06 00   00 00 00 00    B9BA
136            warn "?? D6 00  25  02 00   $tag   04                         03 00   39 30 31 32   04 00   ....\n";
137    }
138            warn "?? D6 00  0F  FE  00 00  05 01   $tag  941A ##### ready?\n";
139    
140  #     D6 00  25  02 00   E00401003123AA26   04                         03 00   30 30 00 00   04 00   00 00 00 00    }
 #                                                                      05 00   00 00 00 00   06 00   00 00 00 00    B9BA  
 warn "D6 00  25  02 00   E00401003123AA26   04                         03 00   39 30 31 32   04 00   33 34 35 36  
                                                                        05 00   00 00 00 00   06 00   00 00 00 00    524B\n";  
 warn "D6 00  0F  FE  00 00  05 01   E00401003123AA26  941A ##### ready?\n";  
141    
142  for ( 1 .. 3 ) {  for ( 1 .. 3 ) {
143    
# Line 219  sub dispatch { Line 235  sub dispatch {
235          }          }
236  }  }
237    
238    use Digest::CRC;
239    
240    sub crcccitt {
241            my $bytes = shift;
242            my $crc = Digest::CRC->new(
243                    # midified CCITT to xor with 0xffff instead of 0x0000
244                    width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
245            ) or die $!;
246            $crc->add( $bytes );
247            pack('n', $crc->digest);
248    }
249    
250  # my $checksum = checksum( $bytes );  # my $checksum = checksum( $bytes );
251  # my $checksum = checksum( $bytes, $original_checksum );  # my $checksum = checksum( $bytes, $original_checksum );
252  sub checksum {  sub checksum {
253          my ( $bytes, $checksum ) = @_;          my ( $bytes, $checksum ) = @_;
254          my $xor = 0;  
255            my $xor = crcccitt( substr($bytes,1) ); # skip D6
256            warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
257    
258            my $len = ord(substr($bytes,2,1));
259            my $len_real = length($bytes);
260            print "length wrong: $len_real != $len\n" if $len_real != $len;
261    
262          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
263                  printf "checksum doesn't match: %04x != %04x data: %s\n", $xor, $checksum;                  print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";
264                    return $bytes . $xor;
265          }          }
266            return $bytes . $checksum;
267  }  }
268    
269  sub readchunk {  sub readchunk {
# Line 275  sub cmd { Line 311  sub cmd {
311          my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;          my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;
312          my $bytes = str2bytes( $cmd );          my $bytes = str2bytes( $cmd );
313    
314            # fix checksum if needed
315            $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
316    
317          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";
318          $assert->{send} = $cmd;          $assert->{send} = $cmd;
319          writechunk( $bytes );          writechunk( $bytes );
Legend:
Removed from v.8  
changed lines
  Added in v.16
  ViewVC Help
Powered by ViewVC 1.1.26