/[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 6 by dpavlin, Sun Sep 28 18:19:37 2008 UTC revision 17 by dpavlin, Fri Oct 3 08: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 );                          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  #     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  sub read_tag {
122  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";          my ( $tag ) = @_;
123    
124  cmd( 'D6 00  0D  02      E00401003123AA26   03   04     3970', 'read offset: 3 blocks: 4' );          print "read_tag $tag\n";
125            return if $read_cached->{ $tag }++;
126    
127  #     D6 00  25  02 00   E00401003123AA26   04                         03 00   30 30 00 00   04 00   00 00 00 00            cmd(    "D6 00  0D  02      $tag   00   03     1CC4", 'read offset: 0 blocks: 3' );
128  #                                                                      05 00   00 00 00 00   06 00   00 00 00 00    B9BA  
129  warn "D6 00  25  02 00   E00401003123AA26   04                         03 00   39 30 31 32   04 00   33 34 35 36          #        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                                                                         05 00   00 00 00 00   06 00   00 00 00 00    524B\n";          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  warn "D6 00  0F  FE  00 00  05 01   E00401003123AA26  941A ##### ready?\n";  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    }
141    
142  for ( 1 .. 3 ) {  for ( 1 .. 3 ) {
143    
# Line 161  sub as_hex { Line 177  sub as_hex {
177          foreach my $str ( @_ ) {          foreach my $str ( @_ ) {
178                  my $hex = unpack( 'H*', $str );                  my $hex = unpack( 'H*', $str );
179                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;                  $hex =~ s/(..)/$1 /g if length( $str ) > 2;
180                    $hex =~ s/\s+$//;
181                  push @out, $hex;                  push @out, $hex;
182          }          }
183          return join('  ', @out);          return join(' | ', @out);
184  }  }
185    
186  sub read_bytes {  sub read_bytes {
# Line 218  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 );
251    # my $checksum = checksum( $bytes, $original_checksum );
252    sub checksum {
253            my ( $bytes, $checksum ) = @_;
254    
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) - 1;
260    
261            if ( $len_real != $len ) {
262                    print "length wrong: $len_real != $len\n";
263                    $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,4);
264            }
265    
266            if ( defined $checksum && $xor ne $checksum ) {
267                    print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";
268                    return $bytes . $xor;
269            }
270            return $bytes . $checksum;
271    }
272    
273  sub readchunk {  sub readchunk {
274          my ( $parser ) = @_;          my ( $parser ) = @_;
275    
# Line 228  sub readchunk { Line 280  sub readchunk {
280          my $length = read_bytes( 1, 'length' );          my $length = read_bytes( 1, 'length' );
281          my $len = ord($length);          my $len = ord($length);
282          my $data = read_bytes( $len, 'data' );          my $data = read_bytes( $len, 'data' );
         my ( $cmd ) = unpack('C', $data );  
283    
284          my $payload  = substr( $data, 0, -2 );          my $payload  = substr( $data, 0, -2 );
285          my $payload_len = length($data);          my $payload_len = length($data);
286          warn "## payload too short $payload_len != $len\n" if $payload_len != $len;          warn "## payload too short $payload_len != $len\n" if $payload_len != $len;
287    
288          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
289          # FIXME check checksum          checksum( $header . $length . $payload, $checksum );
290    
291          print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), "checksum: ", as_hex( $checksum ),"\n";          print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n";
292    
293          $assert->{len}      = $len;          $assert->{len}      = $len;
294          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
         $assert->{checksum} = $checksum;  
295    
296          $parser->( $len, $payload, $checksum ) if $parser && ref($parser) eq 'CODE';          $parser->( $len, $payload ) if $parser && ref($parser) eq 'CODE';
297    
298          return $data;          return $data;
299  }  }
# Line 250  sub readchunk { Line 301  sub readchunk {
301  sub str2bytes {  sub str2bytes {
302          my $str = shift || confess "no str?";          my $str = shift || confess "no str?";
303          my $b = $str;          my $b = $str;
304          $b =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;    # fix checksum          $b =~ s/\s+//g;
305          $b =~ s/\s+$//;          $b =~ s/(..)/\\x$1/g;
306          $b =~ s/\s+/\\x/g;          $b = "\"$b\"";
         $b = '"\x' . $b . '"';  
307          my $bytes = eval $b;          my $bytes = eval $b;
308          die $@ if $@;          die $@ if $@;
309          warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;          warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
# Line 264  sub cmd { Line 314  sub cmd {
314          my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;          my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;
315          my $bytes = str2bytes( $cmd );          my $bytes = str2bytes( $cmd );
316    
317            # fix checksum if needed
318            $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
319    
320          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";
321          $assert->{send} = $cmd;          $assert->{send} = $cmd;
322          writechunk( $bytes );          writechunk( $bytes );
Legend:
Removed from v.6  
changed lines
  Added in v.17
  ViewVC Help
Powered by ViewVC 1.1.26