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

#!/usr/bin/perl

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

use Data::Dump qw/dump/;
use Carp qw/confess/;

my $debug = 0;

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);

# initial hand-shake with device

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', sub {
        print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";
});

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','FIXME: unimplemented', sub { assert() }  );

# start scanning for tags

cmd( 'D6 00  05   FE     00  05         FA40', "XXX scan $_",
     'D6 00  07   FE  00 00  05     00  C97B', 'no tag', sub {
dispatch( 
         'D6 00  0F   FE  00 00  05 ',# 01 E00401003123AA26  941A        # seen, serial length: 8
                sub {
                        my $rest = shift || die "no rest?";
                        my $nr = ord( substr( $rest, 0, 1 ) );
                        my $tags = substr( $rest, 1 );

                        my $tl = length( $tags );
                        die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;

                        my @tags;
                        push @tags, substr($tags, $_ * 8, 8) foreach ( 0 .. $nr - 1 );
                        warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
                        print "seen $nr tags: ", join(',', map { unpack('H16', $_) } @tags ) , "\n";
                }
) }

) foreach ( 1 .. 100 );

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 if length( $str ) > 2;
                $hex =~ s/\s+$//;
                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" if $debug;
        return $data;
}

our $assert;

# my $rest = skip_assert( 3 );
sub skip_assert {
        assert( 0, shift );
}

sub assert {
        my ( $from, $to ) = @_;

        $from ||= 0;
        $to = length( $assert->{expect} ) if ! defined $to;

        my $p = substr( $assert->{payload}, $from, $to );
        my $e = substr( $assert->{expect},  $from, $to );
        warn "EXPECTED ",as_hex($e), " GOT ", as_hex($p), " [$from-$to] in ",dump( $assert ), "\n" if $e ne $p;

        # return the rest
        return substr( $assert->{payload}, $to );
}

our $dispatch;
sub dispatch {
        my ( $pattern, $coderef ) = @_;
        my $patt = substr( str2bytes($pattern), 3 ); # just payload
        my $l = length($patt);
        my $p = substr( $assert->{payload}, 0, $l );
        warn "## dispatch pattern $pattern [$l] ",dump( $patt, $p ) if $debug;

        if ( $assert->{payload} eq $assert->{expect} ) {
                warn "## no dispatch, payload expected" if $debug;
        } elsif ( $p eq $patt ) {
                # if matched call with rest of payload
                $coderef->( substr( $assert->{payload}, $l ) );
        } else {
                warn "## dispatch ignored" if $debug;
        }
}

# my $checksum = checksum( $bytes );
# my $checksum = checksum( $bytes, $original_checksum );
sub checksum {
        my ( $bytes, $checksum ) = @_;

        my $xor = $checksum; # FIXME

        if ( defined $checksum && $xor ne $checksum ) {
                print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";
        }
}

sub readchunk {
        my ( $parser ) = @_;

        sleep 1;        # FIXME remove

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

        my $payload  = substr( $data, 0, -2 );
        my $payload_len = length($data);
        warn "## payload too short $payload_len != $len\n" if $payload_len != $len;

        my $checksum = substr( $data, -2, 2 );
        checksum( $header . $length . $payload, $checksum );

        print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n";

        $assert->{len}      = $len;
        $assert->{payload}  = $payload;

        $parser->( $len, $payload ) if $parser && ref($parser) eq 'CODE';

        return $data;
}

sub str2bytes {
        my $str = shift || confess "no str?";
        my $b = $str;
        $b =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;    # fix checksum
        $b =~ s/\s+$//;
        $b =~ s/\s+/\\x/g;
        $b = '"\x' . $b . '"';
        my $bytes = eval $b;
        die $@ if $@;
        warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
        return $bytes;
}

sub cmd {
        my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;
        my $bytes = str2bytes( $cmd );

        warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";
        $assert->{send} = $cmd;
        writechunk( $bytes );

        if ( $expect ) {
                warn "?? $expect", $expect_desc ? "\t## $expect_desc" : '', "\n";
                $assert->{expect} = substr(str2bytes($expect), 3, -2); # just expected payload
                readchunk( $coderef );
        }
}

1	dpavlin	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	dpavlin	2	use Carp qw/confess/;
9	dpavlin	1
10	dpavlin	4	my $debug = 0;
11
12	dpavlin	1	my $response = {
13			'd500090400110a0500027250' => 'version?',
14			'd60007fe00000500c97b' => 'no tag in range',
15
16			'd6000ffe00000501e00401003123aa26941a' => 'tag #1',
17			'd6000ffe00000501e0040100017c0c388e2b' => 'rfid card',
18			'd6000ffe00000501e00401003123aa2875d4' => 'tag red-stripe',
19
20			'd60017fe00000502e00401003123aa26e0040100017c0c38cadb' => 'tag #1 + card',
21			'd60017fe00000502e00401003123aa26e00401003123aa283124' => 'tag #1 + tag red-stripe',
22			};
23
24			=head1 NAME
25
26			3m-810 - support for 3M 810 RFID reader
27
28			=head1 SYNOPSIS
29
30			3m-810.pl [DEVICE [BAUD [DATA [PARITY [STOP [FLOW]]]]]]
31
32			=head1 DESCRIPTION
33
34			Communicate with 3M 810 RFID reader and document it's protocol
35
36			=head1 SEE ALSO
37
38			L<Device::SerialPort(3)>
39
40			L<perl(1)>
41
42			=head1 AUTHOR
43
44			Dobrica Pavlinusic <dpavlin@rot13.org> L<http://www.rot13.org/~dpavlin/>
45
46			=head1 COPYRIGHT AND LICENSE
47
48			This program is free software; you may redistribute it and/or modify
49			it under the same terms ans Perl itself.
50
51			=cut
52
53			# your serial port.
54			my ($device,$baudrate,$databits,$parity,$stopbits,$handshake)=@ARGV;
55			$device \|\|= "/dev/ttyUSB0";
56			$baudrate \|\|= "19200";
57			$databits \|\|= "8";
58			$parity \|\|= "none";
59			$stopbits \|\|= "1";
60			$handshake \|\|= "none";
61
62			my $port=new Device::SerialPort($device) \|\| die "new($device): $!\n";
63			$handshake=$port->handshake($handshake);
64			$baudrate=$port->baudrate($baudrate);
65			$databits=$port->databits($databits);
66			$parity=$port->parity($parity);
67			$stopbits=$port->stopbits($stopbits);
68
69			print "## using $device $baudrate $databits $parity $stopbits\n";
70
71			# Just in case: reset our timing and buffers
72			$port->lookclear();
73			$port->read_const_time(100);
74			$port->read_char_time(5);
75
76			# Turn on parity checking:
77			#$port->stty_inpck(1);
78			#$port->stty_istrip(1);
79
80	dpavlin	4	# initial hand-shake with device
81
82			cmd( 'D5 00 05 04 00 11 8C66', 'hw version?',
83			'D5 00 09 04 00 11 0A 05 00 02 7250', 'hw 10.5.0.2', sub {
84	dpavlin	5	print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";
85	dpavlin	2	});
86	dpavlin	1
87	dpavlin	4	cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','stats?',
88	dpavlin	5	'D6 00 0C 13 00 02 01 01 03 02 02 03 00 E778','FIXME: unimplemented', sub { assert() } );
89	dpavlin	1
90	dpavlin	4	# start scanning for tags
91	dpavlin	1
92	dpavlin	5	cmd( 'D6 00 05 FE 00 05 FA40', "XXX scan $_",
93			'D6 00 07 FE 00 00 05 00 C97B', 'no tag', sub {
94			dispatch(
95			'D6 00 0F FE 00 00 05 ',# 01 E00401003123AA26 941A # seen, serial length: 8
96			sub {
97			my $rest = shift \|\| die "no rest?";
98			my $nr = ord( substr( $rest, 0, 1 ) );
99			my $tags = substr( $rest, 1 );
100	dpavlin	1
101	dpavlin	5	my $tl = length( $tags );
102			die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
103
104			my @tags;
105			push @tags, substr($tags, $_ * 8, 8) foreach ( 0 .. $nr - 1 );
106	dpavlin	8	warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
107	dpavlin	5	print "seen $nr tags: ", join(',', map { unpack('H16', $_) } @tags ) , "\n";
108			}
109			) }
110
111			) foreach ( 1 .. 100 );
112
113	dpavlin	1	cmd( 'D6 00 0D 02 E00401003123AA26 00 03 1CC4', 'read offset: 0 blocks: 3' );
114
115			# 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
116			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";
117
118			cmd( 'D6 00 0D 02 E00401003123AA26 03 04 3970', 'read offset: 3 blocks: 4' );
119
120			# D6 00 25 02 00 E00401003123AA26 04 03 00 30 30 00 00 04 00 00 00 00 00
121			# 05 00 00 00 00 00 06 00 00 00 00 00 B9BA
122			warn "D6 00 25 02 00 E00401003123AA26 04 03 00 39 30 31 32 04 00 33 34 35 36
123			05 00 00 00 00 00 06 00 00 00 00 00 524B\n";
124			warn "D6 00 0F FE 00 00 05 01 E00401003123AA26 941A ##### ready?\n";
125
126			for ( 1 .. 3 ) {
127
128			# ++-->type 00-0a
129			# 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
130			# 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
131			# 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
132
133			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 $_" );
134			warn "D6 00 0D 04 00 E00401003123AA26 07 CFF1 -- ack 7 block?\n";
135
136			}
137			warn " D6 00 0F FE 00 00 05 01 E00401003123AA26 941A\n";
138
139			cmd( 'D6 00 05 FE 00 05 FA 40', "port-write scan $_" ) foreach ( 1 .. 2 );
140
141			cmd('D6 00 0C 09 E00401003123AA26 D7 3AF0', 'checkin?',
142			'D6 00 0C 09 00 E00401003123AA26 6A44 -- no?' );
143			cmd('D6 00 0C 09 E00401003123AA26 DA EB5D', 'checkout?',
144			'D6 00 0C 09 00 E00401003123AA26 6A44 -- no?' );
145
146			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',
147			'D6 00 0D 04 00 E00401003123AA26 06 DFD0 -- ack 6 blocks' ) foreach ( 1 .. 3 );
148
149			undef $port;
150			print "Port closed\n";
151
152			sub writechunk
153			{
154			my $str=shift;
155			my $count = $port->write($str);
156	dpavlin	6	print "#> ", as_hex( $str ), "\t[$count]\n";
157	dpavlin	1	}
158
159			sub as_hex {
160			my @out;
161			foreach my $str ( @_ ) {
162			my $hex = unpack( 'H*', $str );
163	dpavlin	2	$hex =~ s/(..)/$1 /g if length( $str ) > 2;
164	dpavlin	8	$hex =~ s/\s+$//;
165	dpavlin	1	push @out, $hex;
166			}
167	dpavlin	8	return join(' \| ', @out);
168	dpavlin	1	}
169
170			sub read_bytes {
171			my ( $len, $desc ) = @_;
172			my $data = '';
173			while ( length( $data ) < $len ) {
174			my ( $c, $b ) = $port->read(1);
175			#warn "## got $c bytes: ", as_hex($b), "\n";
176			$data .= $b;
177			}
178			$desc \|\|= '?';
179	dpavlin	4	warn "#< ", as_hex($data), "\t$desc\n" if $debug;
180	dpavlin	1	return $data;
181			}
182
183	dpavlin	5	our $assert;
184	dpavlin	2
185	dpavlin	5	# my $rest = skip_assert( 3 );
186			sub skip_assert {
187			assert( 0, shift );
188			}
189
190	dpavlin	2	sub assert {
191			my ( $from, $to ) = @_;
192
193	dpavlin	5	$from \|\|= 0;
194	dpavlin	4	$to = length( $assert->{expect} ) if ! defined $to;
195
196	dpavlin	2	my $p = substr( $assert->{payload}, $from, $to );
197			my $e = substr( $assert->{expect}, $from, $to );
198	dpavlin	3	warn "EXPECTED ",as_hex($e), " GOT ", as_hex($p), " [$from-$to] in ",dump( $assert ), "\n" if $e ne $p;
199	dpavlin	5
200			# return the rest
201			return substr( $assert->{payload}, $to );
202	dpavlin	2	}
203
204	dpavlin	5	our $dispatch;
205			sub dispatch {
206			my ( $pattern, $coderef ) = @_;
207			my $patt = substr( str2bytes($pattern), 3 ); # just payload
208			my $l = length($patt);
209			my $p = substr( $assert->{payload}, 0, $l );
210	dpavlin	6	warn "## dispatch pattern $pattern [$l] ",dump( $patt, $p ) if $debug;
211	dpavlin	5
212			if ( $assert->{payload} eq $assert->{expect} ) {
213	dpavlin	6	warn "## no dispatch, payload expected" if $debug;
214	dpavlin	5	} elsif ( $p eq $patt ) {
215			# if matched call with rest of payload
216			$coderef->( substr( $assert->{payload}, $l ) );
217			} else {
218	dpavlin	6	warn "## dispatch ignored" if $debug;
219	dpavlin	5	}
220			}
221
222	dpavlin	8	# my $checksum = checksum( $bytes );
223			# my $checksum = checksum( $bytes, $original_checksum );
224			sub checksum {
225			my ( $bytes, $checksum ) = @_;
226
227	dpavlin	10	my $xor = $checksum; # FIXME
228
229	dpavlin	8	if ( defined $checksum && $xor ne $checksum ) {
230	dpavlin	10	print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n";
231	dpavlin	8	}
232			}
233
234	dpavlin	1	sub readchunk {
235	dpavlin	2	my ( $parser ) = @_;
236	dpavlin	1
237	dpavlin	2	sleep 1; # FIXME remove
238
239	dpavlin	1	# read header of packet
240			my $header = read_bytes( 2, 'header' );
241	dpavlin	2	my $length = read_bytes( 1, 'length' );
242			my $len = ord($length);
243	dpavlin	1	my $data = read_bytes( $len, 'data' );
244
245	dpavlin	2	my $payload = substr( $data, 0, -2 );
246			my $payload_len = length($data);
247			warn "## payload too short $payload_len != $len\n" if $payload_len != $len;
248	dpavlin	8
249	dpavlin	2	my $checksum = substr( $data, -2, 2 );
250	dpavlin	8	checksum( $header . $length . $payload, $checksum );
251	dpavlin	1
252	dpavlin	8	print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " \| sum: ",as_hex($checksum),"\n";
253	dpavlin	2
254			$assert->{len} = $len;
255			$assert->{payload} = $payload;
256
257	dpavlin	8	$parser->( $len, $payload ) if $parser && ref($parser) eq 'CODE';
258	dpavlin	2
259			return $data;
260	dpavlin	1	}
261
262	dpavlin	2	sub str2bytes {
263			my $str = shift \|\| confess "no str?";
264	dpavlin	5	my $b = $str;
265			$b =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/; # fix checksum
266			$b =~ s/\s+$//;
267			$b =~ s/\s+/\\x/g;
268			$b = '"\x' . $b . '"';
269			my $bytes = eval $b;
270	dpavlin	2	die $@ if $@;
271	dpavlin	5	warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
272	dpavlin	2	return $bytes;
273			}
274
275			sub cmd {
276			my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;
277			my $bytes = str2bytes( $cmd );
278
279			warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";
280			$assert->{send} = $cmd;
281			writechunk( $bytes );
282
283			if ( $expect ) {
284			warn "?? $expect", $expect_desc ? "\t## $expect_desc" : '', "\n";
285			$assert->{expect} = substr(str2bytes($expect), 3, -2); # just expected payload
286			readchunk( $coderef );
287			}
288			}
289