/[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 18 by dpavlin, Fri Oct 3 12:31:58 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 $tag offset: 0 blocks: 3',
128                            "D6 00  0F  FE  00 00  05 01   $tag    941A", "$tag ready?", sub {
129    dispatch(       "D6 00  1F  02 00   $tag   ", sub { # 03   00 00   04 11 00 01   01 00   31 32 33 34   02 00   35 36 37 38    531F\n";
130                            my $rest = shift || die "no rest?";
131                            warn "## DATA ", dump( $rest ) if $debug;
132                            my $blocks = ord(substr($rest,0,1));
133                            my @data;
134                            foreach my $nr ( 0 .. $blocks - 1 ) {
135                                    my $block = substr( $rest, 1 + $nr * 6, 6 );
136                                    warn "## block ",as_hex( $block ) if $debug;
137                                    my $ord   = unpack('v',substr( $block, 0, 2 ));
138                                    die "got block $ord, expected block $nr from ",dump( $block ) if $ord != $nr;
139                                    my $data  = substr( $block, 2 );
140                                    die "data payload should be 4 bytes" if length($data) != 4;
141                                    warn sprintf "## tag %08s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data;
142                                    $data[ $ord ] = $data;
143                            }
144                            $read_cached->{ $tag } = join('', @data);
145                            print "DATA $tag ",dump( $read_cached->{ $tag } ), "\n";
146                    })
147            });
148    
149            #        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
150    if (0) {
151            cmd(    "D6 00  0D  02      $tag   03   04     3970", 'read offset: 3 blocks: 4' );
152    
153            #        D6 00  25  02 00   $tag   04                         03 00   30 30 00 00   04 00   00 00 00 00  
154            #                           $tag                              05 00   00 00 00 00   06 00   00 00 00 00    B9BA
155            warn "?? D6 00  25  02 00   $tag   04                         03 00   39 30 31 32   04 00   ....\n";
156    }
157            warn "?? D6 00  0F  FE  00 00  05 01   $tag  941A ##### ready?\n";
158    
159  #     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";  
160    
161  for ( 1 .. 3 ) {  for ( 1 .. 3 ) {
162    
# Line 153  sub writechunk Line 188  sub writechunk
188  {  {
189          my $str=shift;          my $str=shift;
190          my $count = $port->write($str);          my $count = $port->write($str);
191          print "#> ", as_hex( $str ), "\t[$count]\n";          print "#> ", as_hex( $str ), "\t[$count]" if $debug;
192  }  }
193    
194  sub as_hex {  sub as_hex {
# Line 219  sub dispatch { Line 254  sub dispatch {
254          }          }
255  }  }
256    
257    use Digest::CRC;
258    
259    sub crcccitt {
260            my $bytes = shift;
261            my $crc = Digest::CRC->new(
262                    # midified CCITT to xor with 0xffff instead of 0x0000
263                    width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
264            ) or die $!;
265            $crc->add( $bytes );
266            pack('n', $crc->digest);
267    }
268    
269  # my $checksum = checksum( $bytes );  # my $checksum = checksum( $bytes );
270  # my $checksum = checksum( $bytes, $original_checksum );  # my $checksum = checksum( $bytes, $original_checksum );
271  sub checksum {  sub checksum {
272          my ( $bytes, $checksum ) = @_;          my ( $bytes, $checksum ) = @_;
273          my $xor = 0;  
274            my $xor = crcccitt( substr($bytes,1) ); # skip D6
275            warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug;
276    
277            my $len = ord(substr($bytes,2,1));
278            my $len_real = length($bytes) - 1;
279    
280            if ( $len_real != $len ) {
281                    print "length wrong: $len_real != $len\n";
282                    $bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,4);
283            }
284    
285          if ( defined $checksum && $xor ne $checksum ) {          if ( defined $checksum && $xor ne $checksum ) {
286                  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";
287                    return $bytes . $xor;
288          }          }
289            return $bytes . $checksum;
290  }  }
291    
292  sub readchunk {  sub readchunk {
# Line 261  sub readchunk { Line 320  sub readchunk {
320  sub str2bytes {  sub str2bytes {
321          my $str = shift || confess "no str?";          my $str = shift || confess "no str?";
322          my $b = $str;          my $b = $str;
323          $b =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;    # fix checksum          $b =~ s/\s+//g;
324          $b =~ s/\s+$//;          $b =~ s/(..)/\\x$1/g;
325          $b =~ s/\s+/\\x/g;          $b = "\"$b\"";
         $b = '"\x' . $b . '"';  
326          my $bytes = eval $b;          my $bytes = eval $b;
327          die $@ if $@;          die $@ if $@;
328          warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;          warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
# Line 275  sub cmd { Line 333  sub cmd {
333          my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;          my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;
334          my $bytes = str2bytes( $cmd );          my $bytes = str2bytes( $cmd );
335    
336            # fix checksum if needed
337            $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
338    
339          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";
340          $assert->{send} = $cmd;          $assert->{send} = $cmd;
341          writechunk( $bytes );          writechunk( $bytes );
Legend:
Removed from v.8  
changed lines
  Added in v.18
  ViewVC Help
Powered by ViewVC 1.1.26