188 lines
3.7 KiB
Perl
188 lines
3.7 KiB
Perl
|
#!/usr/bin/perl
|
||
|
#
|
||
|
# vim:set ts=4 sw=4:
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use IO::Select;
|
||
|
use Digest::CRC qw(crc16 crcccitt);
|
||
|
|
||
|
$|=1;
|
||
|
|
||
|
my @fh;
|
||
|
my $read;
|
||
|
|
||
|
sub sprint{
|
||
|
my @str=split(//,shift);
|
||
|
for (@str){
|
||
|
if (ord($_)>30 && ord($_)<127){
|
||
|
print $_;
|
||
|
}else{
|
||
|
print "[x",unpack("H*",$_),"]";
|
||
|
};
|
||
|
};
|
||
|
};
|
||
|
|
||
|
my $ser=shift || "/dev/ttyS3";
|
||
|
|
||
|
open(SER, "+<",$ser) || die "open: $!";
|
||
|
|
||
|
my $sel = IO::Select->new;
|
||
|
|
||
|
$sel->add(\*SER);
|
||
|
|
||
|
my $cmd=shift;
|
||
|
|
||
|
if($cmd =~ /^r/){
|
||
|
$cmd=~s/r//;
|
||
|
$cmd+=1;
|
||
|
my $fmt=shift;
|
||
|
while($cmd-->0){
|
||
|
my $read="";
|
||
|
while($read !~ /\\1.*\\0/){
|
||
|
my $rr="";
|
||
|
if (@fh = $sel->can_read(100)) {
|
||
|
sysread($fh[0],$rr,1024);
|
||
|
$read.=$rr;
|
||
|
}
|
||
|
};
|
||
|
print "Read: <"; sprint $read; print ">\n";
|
||
|
$read =~ s/^\\1//;
|
||
|
if($fmt eq "m"){
|
||
|
print "M [",substr($read,0,1),"] ";
|
||
|
print "g=",unpack("C",substr($read,1,1))," ";
|
||
|
print "t=",unpack("N",substr($read,2,4))," ";
|
||
|
print "beacon=",unpack("H*",substr($read,26,4))," ";
|
||
|
print "\n";
|
||
|
};
|
||
|
my $cs=substr($read,0,30);
|
||
|
my $crc=substr($read,30,2);
|
||
|
print unpack("n",$crc),"<>";
|
||
|
print crcccitt($cs),"\n";
|
||
|
};
|
||
|
}elsif ($cmd eq "mt"){
|
||
|
my $par=pack("H*",shift);
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
syswrite(SER, '\3'.$par.'\0');
|
||
|
}elsif ($cmd eq "mta"){
|
||
|
my $par=shift;
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
print "len: ",length($par),"\n";
|
||
|
syswrite(SER, '\3'.$par.'\0');
|
||
|
}elsif ($cmd eq "mr"){
|
||
|
my $par=pack("H*",shift);
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
syswrite(SER, '\4'.$par.'\0');
|
||
|
}elsif ($cmd eq "mra"){
|
||
|
my $par=shift;
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
syswrite(SER, '\4'.$par.'\0');
|
||
|
}elsif ($cmd eq "ch"){
|
||
|
my $par=pack("H*",shift);
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
syswrite(SER, '\5'.$par.'\0');
|
||
|
}elsif ($cmd eq "len"){
|
||
|
my $par=pack("H*",shift);
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
syswrite(SER, '\6'.$par.'\0');
|
||
|
}elsif ($cmd =~ /^S/){
|
||
|
$cmd=~s/S//;
|
||
|
$cmd+=1;
|
||
|
|
||
|
my $par="";
|
||
|
my $scmd=shift||"t";
|
||
|
if($scmd eq "t"){
|
||
|
$par.="T";
|
||
|
$par.=chr(shift); #gen
|
||
|
$par.=pack("N",scalar(time)+1*60*60);
|
||
|
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
}elsif($scmd eq "a"){
|
||
|
$par.="A";
|
||
|
$par.=chr(shift); #gen
|
||
|
$par.=pack("N",scalar(time)+1*60*60+ 300);
|
||
|
|
||
|
$par.= pack("C",shift||0);
|
||
|
$par.= pack("C",0);
|
||
|
$par.= pack("C",0);
|
||
|
$par.= pack("C",0);
|
||
|
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
}elsif($scmd eq "b"){
|
||
|
$par.="B";
|
||
|
$par.=chr(shift); #gen
|
||
|
$par.=pack("N",scalar(time)+1*60*60+ 300);
|
||
|
|
||
|
$par.= pack("C",shift||0);
|
||
|
$par.= pack("C",0);
|
||
|
$par.= pack("C",0);
|
||
|
$par.= pack("C",0);
|
||
|
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
$par.=pack("N",0);
|
||
|
}else{
|
||
|
die;
|
||
|
};
|
||
|
|
||
|
$par.=pack("n",crcccitt($par));
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
while($cmd-->0){
|
||
|
syswrite(SER, '\1'.$par.'\0');
|
||
|
print "len: ",length($par),"\n" if($cmd==0);
|
||
|
|
||
|
my $read="";
|
||
|
while($read !~ /\\2.*\\0/){
|
||
|
my $rr="";
|
||
|
if (@fh = $sel->can_read(100)) {
|
||
|
sysread($fh[0],$rr,1024);
|
||
|
$read.=$rr;
|
||
|
}
|
||
|
};
|
||
|
|
||
|
if($cmd==0){
|
||
|
print "Send: <"; sprint $read; print ">\n";
|
||
|
};
|
||
|
};
|
||
|
}elsif ($cmd =~ /^s/){
|
||
|
$cmd=~s/s//;
|
||
|
$cmd+=1;
|
||
|
my $par=pack("H*",shift);
|
||
|
$par.=pack("n",crcccitt($par));
|
||
|
print "Write: <"; sprint $par; print ">\n";
|
||
|
while($cmd-->0){
|
||
|
syswrite(SER, '\1'.$par.'\0');
|
||
|
print "len: ",length($par),"\n";
|
||
|
|
||
|
my $read="";
|
||
|
while($read !~ /\\2.*\\0/){
|
||
|
my $rr="";
|
||
|
if (@fh = $sel->can_read(100)) {
|
||
|
sysread($fh[0],$rr,1024);
|
||
|
$read.=$rr;
|
||
|
}
|
||
|
};
|
||
|
|
||
|
print "Send: <"; sprint $read; print ">\n";
|
||
|
};
|
||
|
}else{
|
||
|
die;
|
||
|
};
|
||
|
|
||
|
if (@fh = $sel->can_read(10)) {
|
||
|
sysread($fh[0],$read,1024);
|
||
|
}
|
||
|
print "PostRead: <"; sprint $read; print ">\n";
|
||
|
|