viewvc.cgi/RFID/3m-810.pl

#!/usr/bin/perl

use Device::SerialPort qw (:STAT);
use strict;
use warnings;

use Data::Dump qw/dump/;

my $response = {
        'd500090400110a0500027250'                              => 'version?',
        'd60007fe00000500c97b'                                  => 'no tag in range',

        'd6000ffe00000501e00401003123aa26941a'  => 'tag #1',
        'd6000ffe00000501e0040100017c0c388e2b'  => 'rfid card',
        'd6000ffe00000501e00401003123aa2875d4'  => 'tag red-stripe',

        'd60017fe00000502e00401003123aa26e0040100017c0c38cadb' => 'tag #1 + card',
        'd60017fe00000502e00401003123aa26e00401003123aa283124' => 'tag #1 + tag red-stripe',
};

=head1 NAME

3m-810 - support for 3M 810 RFID reader

=head1 SYNOPSIS

3m-810.pl [DEVICE [BAUD [DATA [PARITY [STOP [FLOW]]]]]]

=head1 DESCRIPTION

Communicate with 3M 810 RFID reader and document it's protocol

=head1 SEE ALSO

L<Device::SerialPort(3)>

L<perl(1)>

=head1 AUTHOR

Dobrica Pavlinusic <dpavlin@rot13.org> L<http://www.rot13.org/~dpavlin/>

=head1 COPYRIGHT AND LICENSE

This program is free software; you may redistribute it and/or modify
it under the same terms ans Perl itself.

=cut

# your serial port.
my ($device,$baudrate,$databits,$parity,$stopbits,$handshake)=@ARGV;
$device    ||= "/dev/ttyUSB0";
$baudrate  ||= "19200";
$databits  ||= "8";
$parity    ||= "none";
$stopbits  ||= "1";
$handshake ||= "none";

my $port=new Device::SerialPort($device) || die "new($device): $!\n";
$handshake=$port->handshake($handshake);
$baudrate=$port->baudrate($baudrate);
$databits=$port->databits($databits);
$parity=$port->parity($parity);
$stopbits=$port->stopbits($stopbits);

print "## using $device $baudrate $databits $parity $stopbits\n";

# Just in case: reset our timing and buffers
$port->lookclear();
$port->read_const_time(100);
$port->read_char_time(5);

# Turn on parity checking:
#$port->stty_inpck(1);
#$port->stty_istrip(1);

sub cmd {
        my ( $cmd, $desc, $expect ) = @_;
        $cmd =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;  # fix checksum
        $cmd =~ s/\s+/\\x/g;
        $cmd = '"\x' . $cmd . '"';
        my $bytes = eval $cmd;
        die $@ if $@;
        warn ">> ", as_hex( $bytes ), "\t$desc\n";
        writechunk( $bytes );
        warn "?? $expect\n" if $expect;
        readchunk();
}

cmd( 'D5 00  05  04   00   11                 8C66', 'hw version?',
     'D5 00  09  04   00   11   0A 05 00 02   7250 -- hw 10.5.0.2' );

cmd( 'D6 00  0C  13   04   01 00  02 00  03 00  04 00   AAF2','stats?' );
#     D6 00  0C  13   00   02 01 01 03 02 02 03  00   E778

cmd( 'D6 00  05  FE     00  05  FA40', "XXX scan $_",
     'D6 00  07  FE  00 00  05  00  C97B -- no tag' ) foreach ( 1 .. 10 );

#     D6 00  0F  FE  00 00  05  01  E00401003123AA26  941A       # seen

cmd( 'D6 00  0D  02      E00401003123AA26   00   03     1CC4', 'read offset: 0 blocks: 3' );

#     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
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";

cmd( 'D6 00  0D  02      E00401003123AA26   03   04     3970', 'read offset: 3 blocks: 4' );

#     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";

for ( 1 .. 3 ) {

#                                                              ++-->type 00-0a
#     D6 00  2A  04     E00401003123AA26  00  07  00  04 11 00 01 31 31 31 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 1C D4
#     D6 00 2A 04 E0 04 01 00 31 23 AA 26 00  07  00  04 11 00 06 32 32 32 32 32 32 32 32 32 32 32 00 00 00 00 00 00 00 00 00 00 00 00 00 32B7
#     D6 00 2A 04 E0 04 01 00 31 23 AA 26 00  07  00  04 11 00 02 33 33 33 33 33 33 33 33 33 33 33 33 33 33 33 33 00 00 00 00 00 00 00 00 42 1F

cmd(' D6 00  2A  04     E00401003123AA26  00  07  00  04 11 00 01 30 30 30 30 30 30 30 30 30 30 00 00 00 00 00 00 00 00 00 00 00 00 00 00   8843', "write offset 0, block: 7 -- 0000000000 $_" );
warn "D6 00  0D  04 00  E00401003123AA26  07  CFF1 -- ack 7 block?\n";

}
warn "  D6 00   0F   FE 00   00   05 01  E00401003123AA26 941A\n";

cmd( 'D6 00 05 FE 00 05 FA 40', "port-write scan $_" ) foreach ( 1 .. 2 );

cmd('D6 00  0C  09    E00401003123AA26  D7  3AF0', 'checkin?',
    'D6 00  0C  09 00 E00401003123AA26      6A44 -- no?' );
cmd('D6 00  0C  09    E00401003123AA26  DA  EB5D', 'checkout?',
    'D6 00  0C  09 00 E00401003123AA26      6A44 -- no?' );

cmd('D6 00  26  04    E00401003123AA26  00  06  00  55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55  A98B', 'blank offset: 0 blocks: 6', 
    'D6 00  0D  04 00 E00401003123AA26  06  DFD0 -- ack 6 blocks' ) foreach ( 1 .. 3 );

undef $port;
print "Port closed\n";

sub writechunk
{
        my $str=shift;

        my $count = $port->write($str);
        print ">> ", as_hex( $str ), "\t[$count]\n";
}

sub as_hex {
        my @out;
        foreach my $str ( @_ ) {
                my $hex = unpack( 'H*', $str );
                $hex =~ s/(..)/$1 /g;
                push @out, $hex;
        }
        return join('  ', @out);
}

sub read_bytes {
        my ( $len, $desc ) = @_;
        my $data = '';
        while ( length( $data ) < $len ) {
                my ( $c, $b ) = $port->read(1);
                #warn "## got $c bytes: ", as_hex($b), "\n";
                $data .= $b;
        }
        $desc ||= '?';
        warn "#< ", as_hex($data), "\t$desc\n";
        return $data;
}

sub readchunk {

        # read header of packet
        my $header = read_bytes( 2, 'header' );
        my $len = ord( read_bytes( 1, 'length' ) );
        my $data = read_bytes( $len, 'data' );

        warn "<< ",as_hex( $header, ), " [$len] ", as_hex( $data ), "\n";

        sleep 1;
}

1	#!/usr/bin/perl
2
3	use Device::SerialPort qw (:STAT);
4	use strict;
5	use warnings;
6
7	use Data::Dump qw/dump/;
8
9	my $response = {
10	'd500090400110a0500027250' => 'version?',
11	'd60007fe00000500c97b' => 'no tag in range',
12
13	'd6000ffe00000501e00401003123aa26941a' => 'tag #1',
14	'd6000ffe00000501e0040100017c0c388e2b' => 'rfid card',
15	'd6000ffe00000501e00401003123aa2875d4' => 'tag red-stripe',
16
17	'd60017fe00000502e00401003123aa26e0040100017c0c38cadb' => 'tag #1 + card',
18	'd60017fe00000502e00401003123aa26e00401003123aa283124' => 'tag #1 + tag red-stripe',
19	};
20
21	=head1 NAME
22
23	3m-810 - support for 3M 810 RFID reader
24
25	=head1 SYNOPSIS
26
27	3m-810.pl [DEVICE [BAUD [DATA [PARITY [STOP [FLOW]]]]]]
28
29	=head1 DESCRIPTION
30
31	Communicate with 3M 810 RFID reader and document it's protocol
32
33	=head1 SEE ALSO
34
35	L<Device::SerialPort(3)>
36
37	L<perl(1)>
38
39	=head1 AUTHOR
40
41	Dobrica Pavlinusic <dpavlin@rot13.org> L<http://www.rot13.org/~dpavlin/>
42
43	=head1 COPYRIGHT AND LICENSE
44
45	This program is free software; you may redistribute it and/or modify
46	it under the same terms ans Perl itself.
47
48	=cut
49
50	# your serial port.
51	my ($device,$baudrate,$databits,$parity,$stopbits,$handshake)=@ARGV;
52	$device \|\|= "/dev/ttyUSB0";
53	$baudrate \|\|= "19200";
54	$databits \|\|= "8";
55	$parity \|\|= "none";
56	$stopbits \|\|= "1";
57	$handshake \|\|= "none";
58
59	my $port=new Device::SerialPort($device) \|\| die "new($device): $!\n";
60	$handshake=$port->handshake($handshake);
61	$baudrate=$port->baudrate($baudrate);
62	$databits=$port->databits($databits);
63	$parity=$port->parity($parity);
64	$stopbits=$port->stopbits($stopbits);
65
66	print "## using $device $baudrate $databits $parity $stopbits\n";
67
68	# Just in case: reset our timing and buffers
69	$port->lookclear();
70	$port->read_const_time(100);
71	$port->read_char_time(5);
72
73	# Turn on parity checking:
74	#$port->stty_inpck(1);
75	#$port->stty_istrip(1);
76
77	sub cmd {
78	my ( $cmd, $desc, $expect ) = @_;
79	$cmd =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/; # fix checksum
80	$cmd =~ s/\s+/\\x/g;
81	$cmd = '"\x' . $cmd . '"';
82	my $bytes = eval $cmd;
83	die $@ if $@;
84	warn ">> ", as_hex( $bytes ), "\t$desc\n";
85	writechunk( $bytes );
86	warn "?? $expect\n" if $expect;
87	readchunk();
88	}
89
90	cmd( 'D5 00 05 04 00 11 8C66', 'hw version?',
91	'D5 00 09 04 00 11 0A 05 00 02 7250 -- hw 10.5.0.2' );
92
93	cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','stats?' );
94	# D6 00 0C 13 00 02 01 01 03 02 02 03 00 E778
95
96	cmd( 'D6 00 05 FE 00 05 FA40', "XXX scan $_",
97	'D6 00 07 FE 00 00 05 00 C97B -- no tag' ) foreach ( 1 .. 10 );
98
99	# D6 00 0F FE 00 00 05 01 E00401003123AA26 941A # seen
100
101	cmd( 'D6 00 0D 02 E00401003123AA26 00 03 1CC4', 'read offset: 0 blocks: 3' );
102
103	# 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
104	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";
105
106	cmd( 'D6 00 0D 02 E00401003123AA26 03 04 3970', 'read offset: 3 blocks: 4' );
107
108	# D6 00 25 02 00 E00401003123AA26 04 03 00 30 30 00 00 04 00 00 00 00 00
109	# 05 00 00 00 00 00 06 00 00 00 00 00 B9BA
110	warn "D6 00 25 02 00 E00401003123AA26 04 03 00 39 30 31 32 04 00 33 34 35 36
111	05 00 00 00 00 00 06 00 00 00 00 00 524B\n";
112	warn "D6 00 0F FE 00 00 05 01 E00401003123AA26 941A ##### ready?\n";
113
114	for ( 1 .. 3 ) {
115
116	# ++-->type 00-0a
117	# D6 00 2A 04 E00401003123AA26 00 07 00 04 11 00 01 31 31 31 31 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 1C D4
118	# D6 00 2A 04 E0 04 01 00 31 23 AA 26 00 07 00 04 11 00 06 32 32 32 32 32 32 32 32 32 32 32 00 00 00 00 00 00 00 00 00 00 00 00 00 32B7
119	# D6 00 2A 04 E0 04 01 00 31 23 AA 26 00 07 00 04 11 00 02 33 33 33 33 33 33 33 33 33 33 33 33 33 33 33 33 00 00 00 00 00 00 00 00 42 1F
120
121	cmd(' D6 00 2A 04 E00401003123AA26 00 07 00 04 11 00 01 30 30 30 30 30 30 30 30 30 30 00 00 00 00 00 00 00 00 00 00 00 00 00 00 8843', "write offset 0, block: 7 -- 0000000000 $_" );
122	warn "D6 00 0D 04 00 E00401003123AA26 07 CFF1 -- ack 7 block?\n";
123
124	}
125	warn " D6 00 0F FE 00 00 05 01 E00401003123AA26 941A\n";
126
127	cmd( 'D6 00 05 FE 00 05 FA 40', "port-write scan $_" ) foreach ( 1 .. 2 );
128
129	cmd('D6 00 0C 09 E00401003123AA26 D7 3AF0', 'checkin?',
130	'D6 00 0C 09 00 E00401003123AA26 6A44 -- no?' );
131	cmd('D6 00 0C 09 E00401003123AA26 DA EB5D', 'checkout?',
132	'D6 00 0C 09 00 E00401003123AA26 6A44 -- no?' );
133
134	cmd('D6 00 26 04 E00401003123AA26 00 06 00 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 55 A98B', 'blank offset: 0 blocks: 6',
135	'D6 00 0D 04 00 E00401003123AA26 06 DFD0 -- ack 6 blocks' ) foreach ( 1 .. 3 );
136
137	undef $port;
138	print "Port closed\n";
139
140	sub writechunk
141	{
142	my $str=shift;
143
144	my $count = $port->write($str);
145	print ">> ", as_hex( $str ), "\t[$count]\n";
146	}
147
148	sub as_hex {
149	my @out;
150	foreach my $str ( @_ ) {
151	my $hex = unpack( 'H*', $str );
152	$hex =~ s/(..)/$1 /g;
153	push @out, $hex;
154	}
155	return join(' ', @out);
156	}
157
158	sub read_bytes {
159	my ( $len, $desc ) = @_;
160	my $data = '';
161	while ( length( $data ) < $len ) {
162	my ( $c, $b ) = $port->read(1);
163	#warn "## got $c bytes: ", as_hex($b), "\n";
164	$data .= $b;
165	}
166	$desc \|\|= '?';
167	warn "#< ", as_hex($data), "\t$desc\n";
168	return $data;
169	}
170
171	sub readchunk {
172
173	# read header of packet
174	my $header = read_bytes( 2, 'header' );
175	my $len = ord( read_bytes( 1, 'length' ) );
176	my $data = read_bytes( $len, 'data' );
177
178	warn "<< ",as_hex( $header, ), " [$len] ", as_hex( $data ), "\n";
179
180	sleep 1;
181	}
182