WebSVN – HomeAutomation – Diff – /trunk/PcSoftware/scripts/canDaemon/canDaemon.pl/


#!/usr/bin/perl
 
# 
# for use with serial ports, install module with apt-get install libdevice-serialport-perl
# 
# 
# 
 
 
$hubport = 1200;
#$udpip = "193.11.254.22";
#$udpport = 1100;
 
 
require 5.002;
use IO::Socket;
use IO::Select;
use threads;
use Getopt::Long;
 
use POSIX qw(setsid);
 
$binaryname = "canDaemon.pl";
if ( @ARGV > 0 ) {
    GetOptions( "baudrate=i"    => \$baudarg,           #
            "server=s"  => \$serverarg,         #
            "port=i"    => \$portarg,           #
            "tcpport=i" => \$tcpportarg,        #
            "device=s"  => \$devicearg,         #
            "help"      => \$help,          #
            "xDaemon"   => \$daemon,            #
                        );
} else {
    $help = 1;
}
 
if ($help) {
    print "Usage ./$binaryname [options]\n";
    print "Options:\n";
    print "  -x                     Make canDaemon detach as a UNIX daemon\n";
    print "  -d <device> (udp or /dev/ttyXYZ)   Choose hardware for communication\n";
    print "  -b <baudrate>          Baudrate, for serial devices\n";
    print "  -s <server>                Server, for udp devices\n";
    print "  -p <port>              Port, for udp devices\n";
    print "  -t <tcpport>               Port, for tcp server (default 1200)\n";
    print "  -h                     Shows this usage\n";
    print "\n";
    print "example: ./$binaryname -d /dev/ttyUSB0 -b 38400\n";
    print "example: ./$binaryname -d udp -s 192.168.0.10 -p 1100\n";
 
    exit 0;
}
if ($serverarg) {
    $udpip = $serverarg;
}
#print $udpip;
if ($portarg) {
    $udpport = $portarg;
}
if ($tcpportarg) {
    $hubport = $tcpportarg;
}
 
if ($daemon) {
    chdir '/'                 or die "Can't chdir to /: $!";
    umask 0;
    open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
    open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
    #open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
    defined(my $pid = fork)   or die "Can't fork: $!";
    exit if $pid;
    setsid                    or die "Can't start a new session: $!";
}
 
$C2SSTARTSTR = 253;
$C2SENDSTR = 250;
$C2PINGSTR = 251;
 
### create a tcp server ###
$linelength=1000;
&tcpServerInit;
$thr = threads->new(\&tcpServerThread);
$thr->detach;
 
### create a connection to hardware ###
if ($devicearg) {
    if ($devicearg =~ m/^udp$/) {
        ### if the hardware is an udp node ###
        &udpServerInit;
        $thr = threads->new(\&udpServerThread);
        $thr->detach;
    }
    ### else, the hardware is serial, check for device, this might not work in windows ###
#   elsif (-e $devicearg) {
    else {
        if (!$baudarg) {
            print "For a serial device you need to specifiy baudrate, now using default 19200\n";
            $baudarg = 19200;
        }
       
        eval 'use Device::SerialPort';      ### install module with aptitude install libdevice-serialport-perl
        if ($@) {
            eval 'use Win32::SerialPort';
            if ($@) {
                print "Could not find Device::SerialPort or Win32::SerialPort, I quit.\n";
                exit 0;
            } else {
                $usingWin32Serial = 1;
            }
        } else {
            $usingDeviceSerial = 1;
        }
       
        &serialConnInit;
        $thr = threads->new(\&serialConnThread);
        $thr->detach;      
    }
#   } else {
#       print "Argument $devicearg is not correct\n";
#       exit 0;
#   }
}
 
 
### loop here until user aborts with ctrl+c ###
while (1) { sleep 1; }
 
 
##################### Hardware connection to TCP HUB ############################
sub hardwareConnThread {
    ### Check for data from HUB ###
    while ( $newmsg = <$hwCremote> ) {
        ### Convert to can2serial format ### 
        &stringToc2s($newmsg, $retstring);
        if ($retstring) {
            #print length($retstring)."\n";
            #&c2sToString($retstring, $newretstring);
            #print "TO SEND: ".$newretstring."\n";
            #print $udpCsocket $retstring;
           
            ### Send data ###
            if (length($hardwareSendFunction) > 0) {
                &{$hardwareSendFunction}($retstring);
            }
           
        }
    }  
}
 
sub hardwareConnInit {
    print "Connecting hardware to tcpServer\n";
    $hwCremote = IO::Socket::INET->new(Proto    => "tcp", PeerAddr => "localhost", PeerPort => $hubport,)
                  or die "cannot connect to $hubport port at localhost";
}
 
##################### Serial Connection ############################
sub serialConnThread {
    $serialBuffer = "";
    while(1) {
        my ($count,$saw)=$serialPort->read(1); # will read _up to_ 1 chars
        if ($count > 0) {
            $serialBuffer.=$saw;
            serialConnProcessBuffer($serialBuffer);
        }
    }
}
 
sub serialConnProcessBuffer {
    my $input = $_[0];
    my $output = $input;
    my $newmsg;
    my $retstring;
       
    ### Cut all leading chars that is not a start-char ###
    for ($i = 0; $i < length($input); $i++) {
        if (ord(substr($input, 0, 1)) != $C2SSTARTSTR) {
            if (ord(substr($input, $i, 1)) == $C2SSTARTSTR) {
                $input = substr($input, $i);
                $output = $input;
                #print "debug: cutting character\n";
                break;
            }
            if (ord(substr($input, $i, 1)) == $C2PINGSTR) {
                print "Got pong from hardware\n";
                $input = substr($input, $i+1);
                $output = $input;
            }
        } else {
            break;
        }
    }
    ### Check for possible complete packets ###
    for ($i = 0; $i < length($input)-16; $i++) {
        my $newmsg = substr($input, $i, 17);
        $retstring = "";
        &c2sToString($newmsg, $retstring);
        if (length($retstring)>0) {
            if ($hwCremote) {
                ### Send to tcp hub ###
                print $hwCremote $retstring . "\n";
            }
            #print $retstring."\n";
            $output = substr($input, $i+17);
            $i+=16;
        }
    }
   
    ### Store modified buffer ###
    $_[0] = $output;
}
 
sub serialConnInit {
    print "Connecting to hardware over serial port\n";
    $quiet=0;
    if ($usingDeviceSerial == 1) {
        $serialPort = new Device::SerialPort($devicearg, $quiet) || die "failed to open serial port, $devicearg is not valid?";
    } elsif ($usingWin32Serial == 1) {
        $serialPort = new Win32::SerialPort($devicearg, $quiet) || die "failed to open serial port, $devicearg is not valid?";
    }
    $serialPort->databits(8)            || die "failed setting databits";
    $serialPort->baudrate($baudarg)     || die "failed setting baudrate";
    $serialPort->parity("none")         || die "failed setting parity";
    $serialPort->stopbits(1)            || die "failed setting stopbits";
    $serialPort->handshake("none")      || die "failed setting handshake";
    $serialPort->write_settings         || die "no settings";
   
    $serialPort->read_char_time(0);     # don't wait for each character
    $serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call
 
    print "Testing connection to hardware: ping (hardware should answer with a pong)\n";
    serialConnSend(chr($C2PINGSTR));
   
    ### create a connection between the hardware and the tcp-server ###
    &hardwareConnInit;
    $hardwareSendFunction = "serialConnSend";       ### set up callback for a 'send data' function
    $thr = threads->new(\&hardwareConnThread);
    $thr->detach;
}
 
sub serialConnSend {
    $cnt = $serialPort->write($_[0]);
}
 
##################### UDP Connection ############################
sub udpServerThread {
    $MAXLEN = 1024;
    my $newmsg;
    my $retstring;
    while ($udpSsocket->recv($newmsg, $MAXLEN)) {
        my($udpport, $ipaddr) = sockaddr_in($udpSsocket->peername);
        $peer_addr = inet_ntoa($ipaddr);
       
        ### check ipaddr to ip in commandlinearg ###
        if ($udpip == $peer_addr) {
            #check len of incomming data
            if (length($newmsg) > 16 && length($newmsg) < 20) {
                $retstring = "";
                &c2sToString($newmsg, $retstring);
                if (length($retstring) > 0 && $hwCremote) {
                    print $hwCremote $retstring . "\n";
                }
            }
        }
    }
   
}
 
sub udpServerInit {
    print "Starting udpServer\n";
    $udpSsocket = IO::Socket::INET->new(LocalPort => $udpport, Proto => 'udp')
        or die "socket: $@";
 
    $udpCsocket = IO::Socket::INET->new(PeerPort => $udpport, Proto => 'udp', PeerAddr => $udpip)
        or die "socket: $@";
   
    #här ska keep-alive/start-paket skickas till ipt enligt commandline-arg
 
    ### create a connection between the hardware and the tcp-server ###
    &hardwareConnInit;
    $hardwareSendFunction = "udpServerSend";        ### set up callback for a 'send data' function
    $thr = threads->new(\&hardwareConnThread);
    $thr->detach;
   
}
 
sub udpServerSend {
    print $udpCsocket $_[0];
}
 
##################### TCP HUB ############################
sub tcpServerThread {
    while(@ready = $tcpSselect->can_read) {
        for $tcpSsocket (@ready) {
            if($tcpSsocket == $tcpSlisten) {
                &tcpServerConn;
            } else {
                $tcpSsocket->recv($line,$linelength);
                if ($line eq "") {
                    &tcpServerClientDis;
                } else {
                    $line =~ s/\r//gm;  #remove linefeed
                    @lines = split(/\n/, $line);
                    foreach $line (@lines) {
                        print "Got packet '".$line."' from client ".$tcpSsocket->fileno."\n";
 
                        if ($line eq "PING") {
                            print "Sending PONG to client ".$tcpSsocket->fileno."\n";
                       
                            $tcpSsocket->send("PONG\n");
                        }
                        else
                        {
                            $rxerror = 0;
                            testPacket($line, 0, $rxerror);
                       
                            if ($rxerror == 0) {
                                #Add newline to each packet
                                $line .= "\n";
                                               
                                &tcpServerBroadcastExcept($line, $tcpSsocket);
                            }
                        }
                    }
                }
            }
        }
    }
}
 
#initiate the tcp server
sub tcpServerInit {
    $tcpSlisten = IO::Socket::INET->new(Proto => "tcp", LocalPort => $hubport, Listen => 1, Reuse => 1)
                or die $!;
 
    $tcpSselect = IO::Select->new($tcpSlisten);
    print "Starting tcpServer\n";
}
 
#a client connected
sub tcpServerConn {
    $new = $tcpSlisten->accept;
    $tcpSselect->add($new);
    print $new->fileno . ": connected\n";
}
 
#a client disconnected
sub tcpServerClientDis {
    print $tcpSsocket->fileno . ": disconnected\n";
    $tcpSselect->remove($tcpSsocket);
    $tcpSsocket->close;
}
 
#subroutine sends data to all connected clients except for one specified 
sub tcpServerBroadcastExcept {
    my $first = 0;
    my $data = $_[0];
    my $exception = $_[1];
    for $eachsocket ($tcpSselect->handles) {
        if ($eachsocket==$tcpSlisten) {     #dont send to self
            next;
        } elsif ($eachsocket==$exception) {     #dont send to the specified exception
            next;
        } else {
            if ($first==0) {
                $first = 1;
                print "Sending to client ".$eachsocket->fileno;
            } else {
                print ", ".$eachsocket->fileno;
            }
            $eachsocket->send($data) or do {
                &tcpServerClientDis;
            }
        }
    }
    if ($first==1) {
        print "\n";
    }
}
 
##################### General functions ############################
 
#this function should do a number of tests on $_[0] and print messages if packet is malformed and return 1 in $_[2]
#messages can be suppressed by having $_[1] as 1
sub testPacket {
    my $input = $_[0];
    my $messages = $_[1];
   
    #line should be parsed somewhat here, check PKT, AUT and so on
    $testErr = 0;
    if (length($input) < 16) {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, not long enough\n";}
    }
    if ($testErr == 0 && substr($input, 0, 4) != "PKT ") {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, should start with PKT\n";}
    }
    #if (substr($line, 12, 1) != " " || substr($line, 14, 1) != " ") {
    #   $testErr = 1;
    #   print "Packet was malformed, spaces not in the correct place\n";
    #}
    @splitinput = split(/ +/, $input);
    $inputarrlen = @splitinput;
    if ($testErr == 0 && ($inputarrlen < 4 || $inputarrlen > 12)) {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, to many or to few parts\n";}
    }
    if ($testErr == 0 && length($splitinput[1]) != 8) {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, id part must be 8 digits (padded with zeros)\n";}
    }
    if ($testErr == 0 && length($splitinput[2]) != 1) {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, ext part must be 1 digit\n";}
    }
    if ($testErr == 0 && length($splitinput[3]) != 1) {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, rtr part must be 1 digit\n";}
    }
    for ($i = 4; $i < $inputarrlen; $i++) {
        if ($testErr == 0 && length($splitinput[$i]) != 2) {
            $testErr = 1;
            if ($messages!=1) {print "Packet was malformed, data parts must be 2 digits (padded with zero)\n";}
        }
    }
    $checkstrlen = length($input)-4;
    $checkstr = substr($input, 4, $checkstrlen);
    if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) {
        $testErr = 1;
        if ($messages!=1) {print "Packet was malformed, not hex\n";}
    }
   
    $_[2] = $testErr;
}
 
#this function should parse $_[0] (can2serial-data) and save in $_[1] as string
sub c2sToString {
    my $input = $_[0];
    my $output = "";
    #if not correct input data, then dont save anything in $_[1]
    if (ord(substr($input, 0, 1))==$C2SSTARTSTR && ord(substr($input, 16, 1))==$C2SENDSTR) {
        #$output = "boundaries=ok ";
        $id = ord(substr($input, 1, 1)) + ord(substr($input, 2, 1))*256 + ord(substr($input, 3, 1))*256*256 + ord(substr($input, 4, 1))*256*256*256;
        $ext = ord(substr($input, 5, 1));
        $rtr = ord(substr($input, 6, 1));
        $dl = ord(substr($input, 7, 1));
        if ($ext < 2 && $rtr < 2 && $dl < 9) {
            $output .= sprintf "%08x ", $id;
            $output .= $ext . " " . $rtr;
            for ($i = 0; $i < $dl; $i++) {
                $data = ord(substr($input, 8+$i, 1));
                $output .= sprintf " %02x", $data;
            }
            $_[1] = "PKT ".$output;
        } else {
            #print "debug: incorrect ext, rtr or dl\n";
 
        }
    } else {
        #print "debug: incorrect boundaries\n";
 
    }
}
 
#this function should parse $_[0] (string) and save in $_[1] as can2serial-data
sub stringToc2s {
    my $input = $_[0];
    my $output = "";
    #if not correct input data, then dont save anything in $_[1]
    if (length($input) > 15) {
        #minor checks, the data from the tcp-server should be valid
        @splitinput = split(/ +/, $input);
        $inputarrlen = @splitinput;
        if (substr($input, 0, 4) == "PKT " && substr($input, 12, 1) == " " && substr($input, 14, 1) == " " && $inputarrlen > 3 && $inputarrlen < 13) {
            $id = hex($splitinput[1]);
            $ext = hex($splitinput[2]);
            $rtr = hex($splitinput[3]);
            @data = @splitinput[4..($inputarrlen-1)];
            $dl = @data;
           
            $output .= chr($C2SSTARTSTR);
            $output .= chr($id & 0xff);
            $output .= chr(($id>>8) & 0xff);
            $output .= chr(($id>>16) & 0xff);
            $output .= chr(($id>>24) & 0xff);
            $output .= chr($ext);
            $output .= chr($rtr);
            $output .= chr($dl);
            for ($i = 0; $i < 8; $i++) {
                if ($i < $dl) {
                    $output .= chr(hex($data[$i]));
                } else {
                    $output .= chr(" ");
                }
            }
            $output .= chr($C2SENDSTR);
            $_[1] = $output;
        }
    }
}
 

Rev 974	Rev 1035
1	#!/usr/bin/perl	1	#!/usr/bin/perl
2		2
3	#	3	#
4	# for use with serial ports, install module with apt-get install libdevice-serialport-perl	4	# for use with serial ports, install module with apt-get install libdevice-serialport-perl
5	#	5	#
6	#	6	#
7	#	7	#
8		8
9		9
10	$hubport = 1200;	10	$hubport = 1200;
11	#$udpip = "193.11.254.22";	11	#$udpip = "193.11.254.22";
12	#$udpport = 1100;	12	#$udpport = 1100;
13		13
14		14
15	require 5.002;	15	require 5.002;
16	use IO::Socket;	16	use IO::Socket;
17	use IO::Select;	17	use IO::Select;
18	use threads;	18	use threads;
19	use Getopt::Long;	19	use Getopt::Long;
20		20
21	use POSIX qw(setsid);	21	use POSIX qw(setsid);
22		22
23	$binaryname = "canDaemon.pl";	23	$binaryname = "canDaemon.pl";
24	if ( @ARGV > 0 ) {	24	if ( @ARGV > 0 ) {
25	GetOptions( "baudrate=i" => \$baudarg, #	25	GetOptions( "baudrate=i" => \$baudarg, #
26	"server=s" => \$serverarg, #	26	"server=s" => \$serverarg, #
27	"port=i" => \$portarg, #	27	"port=i" => \$portarg, #
28	"tcpport=i" => \$tcpportarg, #	28	"tcpport=i" => \$tcpportarg, #
29	"device=s" => \$devicearg, #	29	"device=s" => \$devicearg, #
30	"help" => \$help, #	30	"help" => \$help, #
31	"xDaemon" => \$daemon, #	31	"xDaemon" => \$daemon, #
32	);	32	);
33	} else {	33	} else {
34	$help = 1;	34	$help = 1;
35	}	35	}
36		36
37	if ($help) {	37	if ($help) {
38	print "Usage ./$binaryname [options]\n";	38	print "Usage ./$binaryname [options]\n";
39	print "Options:\n";	39	print "Options:\n";
40	print " -x Make canDaemon detach as a UNIX daemon\n";	40	print " -x Make canDaemon detach as a UNIX daemon\n";
41	print " -d <device> (udp or /dev/ttyXYZ) Choose hardware for communication\n";	41	print " -d <device> (udp or /dev/ttyXYZ) Choose hardware for communication\n";
42	print " -b <baudrate> Baudrate, for serial devices\n";	42	print " -b <baudrate> Baudrate, for serial devices\n";
43	print " -s <server> Server, for udp devices\n";	43	print " -s <server> Server, for udp devices\n";
44	print " -p <port> Port, for udp devices\n";	44	print " -p <port> Port, for udp devices\n";
45	print " -t <tcpport> Port, for tcp server (default 1200)\n";	45	print " -t <tcpport> Port, for tcp server (default 1200)\n";
46	print " -h Shows this usage\n";	46	print " -h Shows this usage\n";
47	print "\n";	47	print "\n";
48	print "example: ./$binaryname -d /dev/ttyUSB0 -b 38400\n";	48	print "example: ./$binaryname -d /dev/ttyUSB0 -b 38400\n";
49	print "example: ./$binaryname -d udp -s 192.168.0.10 -p 1100\n";	49	print "example: ./$binaryname -d udp -s 192.168.0.10 -p 1100\n";
50		50
51	exit 0;	51	exit 0;
52	}	52	}
53	if ($serverarg) {	53	if ($serverarg) {
54	$udpip = $serverarg;	54	$udpip = $serverarg;
55	}	55	}
56	#print $udpip;	56	#print $udpip;
57	if ($portarg) {	57	if ($portarg) {
58	$udpport = $portarg;	58	$udpport = $portarg;
59	}	59	}
60	if ($tcpportarg) {	60	if ($tcpportarg) {
61	$hubport = $tcpportarg;	61	$hubport = $tcpportarg;
62	}	62	}
63		63
64	if ($daemon) {	64	if ($daemon) {
65	chdir '/' or die "Can't chdir to /: $!";	65	chdir '/' or die "Can't chdir to /: $!";
66	umask 0;	66	umask 0;
67	open STDIN, '/dev/null' or die "Can't read /dev/null: $!";	67	open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
68	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";	68	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
69	#open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";	69	#open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
70	defined(my $pid = fork) or die "Can't fork: $!";	70	defined(my $pid = fork) or die "Can't fork: $!";
71	exit if $pid;	71	exit if $pid;
72	setsid or die "Can't start a new session: $!";	72	setsid or die "Can't start a new session: $!";
73	}	73	}
74		74
75	$C2SSTARTSTR = 253;	75	$C2SSTARTSTR = 253;
76	$C2SENDSTR = 250;	76	$C2SENDSTR = 250;
77	$C2PINGSTR = 251;	77	$C2PINGSTR = 251;
78		78
79	### create a tcp server ###	79	### create a tcp server ###
80	$linelength=1000;	80	$linelength=1000;
81	&tcpServerInit;	81	&tcpServerInit;
82	$thr = threads->new(\&tcpServerThread);	82	$thr = threads->new(\&tcpServerThread);
83	$thr->detach;	83	$thr->detach;
84		84
85	### create a connection to hardware ###	85	### create a connection to hardware ###
86	if ($devicearg) {	86	if ($devicearg) {
87	if ($devicearg =~ m/^udp$/) {	87	if ($devicearg =~ m/^udp$/) {
88	### if the hardware is an udp node ###	88	### if the hardware is an udp node ###
89	&udpServerInit;	89	&udpServerInit;
90	$thr = threads->new(\&udpServerThread);	90	$thr = threads->new(\&udpServerThread);
91	$thr->detach;	91	$thr->detach;
92	}	92	}
93	### else, the hardware is serial, check for device, this might not work in windows ###	93	### else, the hardware is serial, check for device, this might not work in windows ###
94	# elsif (-e $devicearg) {	94	# elsif (-e $devicearg) {
95	else {	95	else {
96	if (!$baudarg) {	96	if (!$baudarg) {
97	print "For a serial device you need to specifiy baudrate, now using default 19200\n";	97	print "For a serial device you need to specifiy baudrate, now using default 19200\n";
98	$baudarg = 19200;	98	$baudarg = 19200;
99	}	99	}
100		100
101	eval 'use Device::SerialPort'; ### install module with aptitude install libdevice-serialport-perl	101	eval 'use Device::SerialPort'; ### install module with aptitude install libdevice-serialport-perl
102	if ($@) {	102	if ($@) {
103	eval 'use Win32::SerialPort';	103	eval 'use Win32::SerialPort';
104	if ($@) {	104	if ($@) {
105	print "Could not find Device::SerialPort or Win32::SerialPort, I quit.\n";	105	print "Could not find Device::SerialPort or Win32::SerialPort, I quit.\n";
106	exit 0;	106	exit 0;
107	} else {	107	} else {
108	$usingWin32Serial = 1;	108	$usingWin32Serial = 1;
109	}	109	}
110	} else {	110	} else {
111	$usingDeviceSerial = 1;	111	$usingDeviceSerial = 1;
112	}	112	}
113		113
114	&serialConnInit;	114	&serialConnInit;
115	$thr = threads->new(\&serialConnThread);	115	$thr = threads->new(\&serialConnThread);
116	$thr->detach;	116	$thr->detach;
117	}	117	}
118	# } else {	118	# } else {
119	# print "Argument $devicearg is not correct\n";	119	# print "Argument $devicearg is not correct\n";
120	# exit 0;	120	# exit 0;
121	# }	121	# }
122	}	122	}
123		123
124		124
125	### loop here until user aborts with ctrl+c ###	125	### loop here until user aborts with ctrl+c ###
126	while (1) { sleep 1; }	126	while (1) { sleep 1; }
127		127
128		128
129	##################### Hardware connection to TCP HUB ############################	129	##################### Hardware connection to TCP HUB ############################
130	sub hardwareConnThread {	130	sub hardwareConnThread {
131	### Check for data from HUB ###	131	### Check for data from HUB ###
132	while ( $newmsg = <$hwCremote> ) {	132	while ( $newmsg = <$hwCremote> ) {
133	### Convert to can2serial format ###	133	### Convert to can2serial format ###
134	&stringToc2s($newmsg, $retstring);	134	&stringToc2s($newmsg, $retstring);
135	if ($retstring) {	135	if ($retstring) {
136	#print length($retstring)."\n";	136	#print length($retstring)."\n";
137	#&c2sToString($retstring, $newretstring);	137	#&c2sToString($retstring, $newretstring);
138	#print "TO SEND: ".$newretstring."\n";	138	#print "TO SEND: ".$newretstring."\n";
139	#print $udpCsocket $retstring;	139	#print $udpCsocket $retstring;
140		140
141	### Send data ###	141	### Send data ###
142	if (length($hardwareSendFunction) > 0) {	142	if (length($hardwareSendFunction) > 0) {
143	&{$hardwareSendFunction}($retstring);	143	&{$hardwareSendFunction}($retstring);
144	}	144	}
145		145
146	}	146	}
147	}	147	}
148	}	148	}
149		149
150	sub hardwareConnInit {	150	sub hardwareConnInit {
151	print "Connecting hardware to tcpServer\n";	151	print "Connecting hardware to tcpServer\n";
152	$hwCremote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "localhost", PeerPort => $hubport,)	152	$hwCremote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "localhost", PeerPort => $hubport,)
153	or die "cannot connect to $hubport port at localhost";	153	or die "cannot connect to $hubport port at localhost";
154	}	154	}
155		155
156	##################### Serial Connection ############################	156	##################### Serial Connection ############################
157	sub serialConnThread {	157	sub serialConnThread {
158	$serialBuffer = "";	158	$serialBuffer = "";
159	while(1) {	159	while(1) {
160	my ($count,$saw)=$serialPort->read(1); # will read _up to_ 1 chars	160	my ($count,$saw)=$serialPort->read(1); # will read _up to_ 1 chars
161	if ($count > 0) {	161	if ($count > 0) {
162	$serialBuffer.=$saw;	162	$serialBuffer.=$saw;
163	serialConnProcessBuffer($serialBuffer);	163	serialConnProcessBuffer($serialBuffer);
164	}	164	}
165	}	165	}
166	}	166	}
167		167
168	sub serialConnProcessBuffer {	168	sub serialConnProcessBuffer {
169	my $input = $_[0];	169	my $input = $_[0];
170	my $output = $input;	170	my $output = $input;
171	my $newmsg;	171	my $newmsg;
172	my $retstring;	172	my $retstring;
173		173
174	### Cut all leading chars that is not a start-char ###	174	### Cut all leading chars that is not a start-char ###
175	for ($i = 0; $i < length($input); $i++) {	175	for ($i = 0; $i < length($input); $i++) {
176	if (ord(substr($input, 0, 1)) != $C2SSTARTSTR) {	176	if (ord(substr($input, 0, 1)) != $C2SSTARTSTR) {
177	if (ord(substr($input, $i, 1)) == $C2SSTARTSTR) {	177	if (ord(substr($input, $i, 1)) == $C2SSTARTSTR) {
178	$input = substr($input, $i);	178	$input = substr($input, $i);
179	$output = $input;	179	$output = $input;
180	#print "debug: cutting character\n";	180	#print "debug: cutting character\n";
181	break;	181	break;
182	}	182	}
183	if (ord(substr($input, $i, 1)) == $C2PINGSTR) {	183	if (ord(substr($input, $i, 1)) == $C2PINGSTR) {
184	print "Got pong from hardware\n";	184	print "Got pong from hardware\n";
185	$input = substr($input, $i+1);	185	$input = substr($input, $i+1);
186	$output = $input;	186	$output = $input;
187	}	187	}
188	} else {	188	} else {
189	break;	189	break;
190	}	190	}
191	}	191	}
192	### Check for possible complete packets ###	192	### Check for possible complete packets ###
193	for ($i = 0; $i < length($input)-16; $i++) {	193	for ($i = 0; $i < length($input)-16; $i++) {
194	my $newmsg = substr($input, $i, 17);	194	my $newmsg = substr($input, $i, 17);
195	$retstring = "";	195	$retstring = "";
196	&c2sToString($newmsg, $retstring);	196	&c2sToString($newmsg, $retstring);
197	if (length($retstring)>0) {	197	if (length($retstring)>0) {
198	if ($hwCremote) {	198	if ($hwCremote) {
199	### Send to tcp hub ###	199	### Send to tcp hub ###
200	print $hwCremote $retstring . "\n";	200	print $hwCremote $retstring . "\n";
201	}	201	}
202	#print $retstring."\n";	202	#print $retstring."\n";
203	$output = substr($input, $i+17);	203	$output = substr($input, $i+17);
204	$i+=16;	204	$i+=16;
205	}	205	}
206	}	206	}
207		207
208	### Store modified buffer ###	208	### Store modified buffer ###
209	$_[0] = $output;	209	$_[0] = $output;
210	}	210	}
211		211
212	sub serialConnInit {	212	sub serialConnInit {
213	print "Connecting to hardware over serial port\n";	213	print "Connecting to hardware over serial port\n";
214	$quiet=0;	214	$quiet=0;
215	if ($usingDeviceSerial == 1) {	215	if ($usingDeviceSerial == 1) {
216	$serialPort = new Device::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";	216	$serialPort = new Device::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";
217	} elsif ($usingWin32Serial == 1) {	217	} elsif ($usingWin32Serial == 1) {
218	$serialPort = new Win32::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";	218	$serialPort = new Win32::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";
219	}	219	}
220	$serialPort->databits(8) \|\| die "failed setting databits";	220	$serialPort->databits(8) \|\| die "failed setting databits";
221	$serialPort->baudrate($baudarg) \|\| die "failed setting baudrate";	221	$serialPort->baudrate($baudarg) \|\| die "failed setting baudrate";
222	$serialPort->parity("none") \|\| die "failed setting parity";	222	$serialPort->parity("none") \|\| die "failed setting parity";
223	$serialPort->stopbits(1) \|\| die "failed setting stopbits";	223	$serialPort->stopbits(1) \|\| die "failed setting stopbits";
224	$serialPort->handshake("none") \|\| die "failed setting handshake";	224	$serialPort->handshake("none") \|\| die "failed setting handshake";
225	$serialPort->write_settings \|\| die "no settings";	225	$serialPort->write_settings \|\| die "no settings";
226		226
227	$serialPort->read_char_time(0); # don't wait for each character	227	$serialPort->read_char_time(0); # don't wait for each character
228	$serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call	228	$serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call
229		229
230	print "Testing connection to hardware: ping (hardware should answer with a pong)\n";	230	print "Testing connection to hardware: ping (hardware should answer with a pong)\n";
231	serialConnSend(chr($C2PINGSTR));	231	serialConnSend(chr($C2PINGSTR));
232		232
233	### create a connection between the hardware and the tcp-server ###	233	### create a connection between the hardware and the tcp-server ###
234	&hardwareConnInit;	234	&hardwareConnInit;
235	$hardwareSendFunction = "serialConnSend"; ### set up callback for a 'send data' function	235	$hardwareSendFunction = "serialConnSend"; ### set up callback for a 'send data' function
236	$thr = threads->new(\&hardwareConnThread);	236	$thr = threads->new(\&hardwareConnThread);
237	$thr->detach;	237	$thr->detach;
238	}	238	}
239		239
240	sub serialConnSend {	240	sub serialConnSend {
241	$cnt = $serialPort->write($_[0]);	241	$cnt = $serialPort->write($_[0]);
242	}	242	}
243		243
244	##################### UDP Connection ############################	244	##################### UDP Connection ############################
245	sub udpServerThread {	245	sub udpServerThread {
246	$MAXLEN = 1024;	246	$MAXLEN = 1024;
247	my $newmsg;	247	my $newmsg;
248	my $retstring;	248	my $retstring;
249	while ($udpSsocket->recv($newmsg, $MAXLEN)) {	249	while ($udpSsocket->recv($newmsg, $MAXLEN)) {
250	my($udpport, $ipaddr) = sockaddr_in($udpSsocket->peername);	250	my($udpport, $ipaddr) = sockaddr_in($udpSsocket->peername);
251	$peer_addr = inet_ntoa($ipaddr);	251	$peer_addr = inet_ntoa($ipaddr);
252		252
253	### check ipaddr to ip in commandlinearg ###	253	### check ipaddr to ip in commandlinearg ###
254	if ($udpip == $peer_addr) {	254	if ($udpip == $peer_addr) {
255	#check len of incomming data	255	#check len of incomming data
256	if (length($newmsg) > 16 && length($newmsg) < 20) {	256	if (length($newmsg) > 16 && length($newmsg) < 20) {
257	$retstring = "";	257	$retstring = "";
258	&c2sToString($newmsg, $retstring);	258	&c2sToString($newmsg, $retstring);
259	if (length($retstring) > 0 && $hwCremote) {	259	if (length($retstring) > 0 && $hwCremote) {
260	print $hwCremote $retstring . "\n";	260	print $hwCremote $retstring . "\n";
261	}	261	}
262	}	262	}
263	}	263	}
264	}	264	}
265		265
266	}	266	}
267		267
268	sub udpServerInit {	268	sub udpServerInit {
269	print "Starting udpServer\n";	269	print "Starting udpServer\n";
270	$udpSsocket = IO::Socket::INET->new(LocalPort => $udpport, Proto => 'udp')	270	$udpSsocket = IO::Socket::INET->new(LocalPort => $udpport, Proto => 'udp')
271	or die "socket: $@";	271	or die "socket: $@";
272		272
273	$udpCsocket = IO::Socket::INET->new(PeerPort => $udpport, Proto => 'udp', PeerAddr => $udpip)	273	$udpCsocket = IO::Socket::INET->new(PeerPort => $udpport, Proto => 'udp', PeerAddr => $udpip)
274	or die "socket: $@";	274	or die "socket: $@";
275		275
276	#här ska keep-alive/start-paket skickas till ipt enligt commandline-arg	276	#här ska keep-alive/start-paket skickas till ipt enligt commandline-arg
277		277
278	### create a connection between the hardware and the tcp-server ###	278	### create a connection between the hardware and the tcp-server ###
279	&hardwareConnInit;	279	&hardwareConnInit;
280	$hardwareSendFunction = "udpServerSend"; ### set up callback for a 'send data' function	280	$hardwareSendFunction = "udpServerSend"; ### set up callback for a 'send data' function
281	$thr = threads->new(\&hardwareConnThread);	281	$thr = threads->new(\&hardwareConnThread);
282	$thr->detach;	282	$thr->detach;
283		283
284	}	284	}
285		285
286	sub udpServerSend {	286	sub udpServerSend {
287	print $udpCsocket $_[0];	287	print $udpCsocket $_[0];
288	}	288	}
289		289
290	##################### TCP HUB ############################	290	##################### TCP HUB ############################
291	sub tcpServerThread {	291	sub tcpServerThread {
292	while(@ready = $tcpSselect->can_read) {	292	while(@ready = $tcpSselect->can_read) {
293	for $tcpSsocket (@ready) {	293	for $tcpSsocket (@ready) {
294	if($tcpSsocket == $tcpSlisten) {	294	if($tcpSsocket == $tcpSlisten) {
295	&tcpServerConn;	295	&tcpServerConn;
296	} else {	296	} else {
297	$tcpSsocket->recv($line,$linelength);	297	$tcpSsocket->recv($line,$linelength);
298	if ($line eq "") {	298	if ($line eq "") {
299	&tcpServerClientDis;	299	&tcpServerClientDis;
300	} else {	300	} else {
301	$line =~ s/\n.*//gm; #remove ~~newline and everything after it~~	301	$line =~ s/\r//gm; #remove linefeed
302	~~$line~~ =~ s/~~\r.*//gm~~; #remove linefeed and everything after it	302	@lines = split(/\n/, $line);
-		303	foreach $line (@lines) {
303	print "Got packet '".$line."' from client ".$tcpSsocket->fileno."\n";	304	print "Got packet '".$line."' from client ".$tcpSsocket->fileno."\n";
304		-
305	if ($line eq "PING") {	305	if ($line eq "PING") {
306	print "Sending PONG to client ".$tcpSsocket->fileno."\n";	306	print "Sending PONG to client ".$tcpSsocket->fileno."\n";
307		307
308	$tcpSsocket->send("PONG\n");	308	$tcpSsocket->send("PONG\n");
309	}	309	}
310	else	310	else
311	{	311	{
312	$rxerror = 0;	312	$rxerror = 0;
313	testPacket($line, 0, $rxerror);	313	testPacket($line, 0, $rxerror);
314		314
315	if ($rxerror == 0) {	315	if ($rxerror == 0) {
316	#Add newline to each packet	316	#Add newline to each packet
317	$line .= "\n";	317	$line .= "\n";
318		318
319	&tcpServerBroadcastExcept($line, $tcpSsocket);	319	&tcpServerBroadcastExcept($line, $tcpSsocket);
-		320	}
320	}	321	}
321	}	322	}
322	}	323	}
323	}	324	}
324	}	325	}
325	}	326	}
326	}	327	}
327		328
328	#initiate the tcp server	329	#initiate the tcp server
329	sub tcpServerInit {	330	sub tcpServerInit {
330	$tcpSlisten = IO::Socket::INET->new(Proto => "tcp", LocalPort => $hubport, Listen => 1, Reuse => 1)	331	$tcpSlisten = IO::Socket::INET->new(Proto => "tcp", LocalPort => $hubport, Listen => 1, Reuse => 1)
331	or die $!;	332	or die $!;
332		333
333	$tcpSselect = IO::Select->new($tcpSlisten);	334	$tcpSselect = IO::Select->new($tcpSlisten);
334	print "Starting tcpServer\n";	335	print "Starting tcpServer\n";
335	}	336	}
336		337
337	#a client connected	338	#a client connected
338	sub tcpServerConn {	339	sub tcpServerConn {
339	$new = $tcpSlisten->accept;	340	$new = $tcpSlisten->accept;
340	$tcpSselect->add($new);	341	$tcpSselect->add($new);
341	print $new->fileno . ": connected\n";	342	print $new->fileno . ": connected\n";
342	}	343	}
343		344
344	#a client disconnected	345	#a client disconnected
345	sub tcpServerClientDis {	346	sub tcpServerClientDis {
346	print $tcpSsocket->fileno . ": disconnected\n";	347	print $tcpSsocket->fileno . ": disconnected\n";
347	$tcpSselect->remove($tcpSsocket);	348	$tcpSselect->remove($tcpSsocket);
348	$tcpSsocket->close;	349	$tcpSsocket->close;
349	}	350	}
350		351
351	#subroutine sends data to all connected clients except for one specified	352	#subroutine sends data to all connected clients except for one specified
352	sub tcpServerBroadcastExcept {	353	sub tcpServerBroadcastExcept {
353	my $first = 0;	354	my $first = 0;
354	my $data = $_[0];	355	my $data = $_[0];
355	my $exception = $_[1];	356	my $exception = $_[1];
356	for $eachsocket ($tcpSselect->handles) {	357	for $eachsocket ($tcpSselect->handles) {
357	if ($eachsocket==$tcpSlisten) { #dont send to self	358	if ($eachsocket==$tcpSlisten) { #dont send to self
358	next;	359	next;
359	} elsif ($eachsocket==$exception) { #dont send to the specified exception	360	} elsif ($eachsocket==$exception) { #dont send to the specified exception
360	next;	361	next;
361	} else {	362	} else {
362	if ($first==0) {	363	if ($first==0) {
363	$first = 1;	364	$first = 1;
364	print "Sending to client ".$eachsocket->fileno;	365	print "Sending to client ".$eachsocket->fileno;
365	} else {	366	} else {
366	print ", ".$eachsocket->fileno;	367	print ", ".$eachsocket->fileno;
367	}	368	}
368	$eachsocket->send($data) or do {	369	$eachsocket->send($data) or do {
369	&tcpServerClientDis;	370	&tcpServerClientDis;
370	}	371	}
371	}	372	}
372	}	373	}
373	if ($first==1) {	374	if ($first==1) {
374	print "\n";	375	print "\n";
375	}	376	}
376	}	377	}
377		378
378	##################### General functions ############################	379	##################### General functions ############################
379		380
380	#this function should do a number of tests on $_[0] and print messages if packet is malformed and return 1 in $_[2]	381	#this function should do a number of tests on $_[0] and print messages if packet is malformed and return 1 in $_[2]
381	#messages can be suppressed by having $_[1] as 1	382	#messages can be suppressed by having $_[1] as 1
382	sub testPacket {	383	sub testPacket {
383	my $input = $_[0];	384	my $input = $_[0];
384	my $messages = $_[1];	385	my $messages = $_[1];
385		386
386	#line should be parsed somewhat here, check PKT, AUT and so on	387	#line should be parsed somewhat here, check PKT, AUT and so on
387	$testErr = 0;	388	$testErr = 0;
388	if (length($input) < 16) {	389	if (length($input) < 16) {
389	$testErr = 1;	390	$testErr = 1;
390	if ($messages!=1) {print "Packet was malformed, not long enough\n";}	391	if ($messages!=1) {print "Packet was malformed, not long enough\n";}
391	}	392	}
392	if ($testErr == 0 && substr($input, 0, 4) != "PKT ") {	393	if ($testErr == 0 && substr($input, 0, 4) != "PKT ") {
393	$testErr = 1;	394	$testErr = 1;
394	if ($messages!=1) {print "Packet was malformed, should start with PKT\n";}	395	if ($messages!=1) {print "Packet was malformed, should start with PKT\n";}
395	}	396	}
396	#if (substr($line, 12, 1) != " " \|\| substr($line, 14, 1) != " ") {	397	#if (substr($line, 12, 1) != " " \|\| substr($line, 14, 1) != " ") {
397	# $testErr = 1;	398	# $testErr = 1;
398	# print "Packet was malformed, spaces not in the correct place\n";	399	# print "Packet was malformed, spaces not in the correct place\n";
399	#}	400	#}
400	@splitinput = split(/ +/, $input);	401	@splitinput = split(/ +/, $input);
401	$inputarrlen = @splitinput;	402	$inputarrlen = @splitinput;
402	if ($testErr == 0 && ($inputarrlen < 4 \|\| $inputarrlen > 12)) {	403	if ($testErr == 0 && ($inputarrlen < 4 \|\| $inputarrlen > 12)) {
403	$testErr = 1;	404	$testErr = 1;
404	if ($messages!=1) {print "Packet was malformed, to many or to few parts\n";}	405	if ($messages!=1) {print "Packet was malformed, to many or to few parts\n";}
405	}	406	}
406	if ($testErr == 0 && length($splitinput[1]) != 8) {	407	if ($testErr == 0 && length($splitinput[1]) != 8) {
407	$testErr = 1;	408	$testErr = 1;
408	if ($messages!=1) {print "Packet was malformed, id part must be 8 digits (padded with zeros)\n";}	409	if ($messages!=1) {print "Packet was malformed, id part must be 8 digits (padded with zeros)\n";}
409	}	410	}
410	if ($testErr == 0 && length($splitinput[2]) != 1) {	411	if ($testErr == 0 && length($splitinput[2]) != 1) {
411	$testErr = 1;	412	$testErr = 1;
412	if ($messages!=1) {print "Packet was malformed, ext part must be 1 digit\n";}	413	if ($messages!=1) {print "Packet was malformed, ext part must be 1 digit\n";}
413	}	414	}
414	if ($testErr == 0 && length($splitinput[3]) != 1) {	415	if ($testErr == 0 && length($splitinput[3]) != 1) {
415	$testErr = 1;	416	$testErr = 1;
416	if ($messages!=1) {print "Packet was malformed, rtr part must be 1 digit\n";}	417	if ($messages!=1) {print "Packet was malformed, rtr part must be 1 digit\n";}
417	}	418	}
418	for ($i = 4; $i < $inputarrlen; $i++) {	419	for ($i = 4; $i < $inputarrlen; $i++) {
419	if ($testErr == 0 && length($splitinput[$i]) != 2) {	420	if ($testErr == 0 && length($splitinput[$i]) != 2) {
420	$testErr = 1;	421	$testErr = 1;
421	if ($messages!=1) {print "Packet was malformed, data parts must be 2 digits (padded with zero)\n";}	422	if ($messages!=1) {print "Packet was malformed, data parts must be 2 digits (padded with zero)\n";}
422	}	423	}
423	}	424	}
424	$checkstrlen = length($input)-4;	425	$checkstrlen = length($input)-4;
425	$checkstr = substr($input, 4, $checkstrlen);	426	$checkstr = substr($input, 4, $checkstrlen);
426	if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) {	427	if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) {
427	$testErr = 1;	428	$testErr = 1;
428	if ($messages!=1) {print "Packet was malformed, not hex\n";}	429	if ($messages!=1) {print "Packet was malformed, not hex\n";}
429	}	430	}
430		431
431	$_[2] = $testErr;	432	$_[2] = $testErr;
432	}	433	}
433		434
434	#this function should parse $_[0] (can2serial-data) and save in $_[1] as string	435	#this function should parse $_[0] (can2serial-data) and save in $_[1] as string
435	sub c2sToString {	436	sub c2sToString {
436	my $input = $_[0];	437	my $input = $_[0];
437	my $output = "";	438	my $output = "";
438	#if not correct input data, then dont save anything in $_[1]	439	#if not correct input data, then dont save anything in $_[1]
439	if (ord(substr($input, 0, 1))==$C2SSTARTSTR && ord(substr($input, 16, 1))==$C2SENDSTR) {	440	if (ord(substr($input, 0, 1))==$C2SSTARTSTR && ord(substr($input, 16, 1))==$C2SENDSTR) {
440	#$output = "boundaries=ok ";	441	#$output = "boundaries=ok ";
441	$id = ord(substr($input, 1, 1)) + ord(substr($input, 2, 1))256 + ord(substr($input, 3, 1))256256 + ord(substr($input, 4, 1))256256256;	442	$id = ord(substr($input, 1, 1)) + ord(substr($input, 2, 1))256 + ord(substr($input, 3, 1))256256 + ord(substr($input, 4, 1))256256256;
442	$ext = ord(substr($input, 5, 1));	443	$ext = ord(substr($input, 5, 1));
443	$rtr = ord(substr($input, 6, 1));	444	$rtr = ord(substr($input, 6, 1));
444	$dl = ord(substr($input, 7, 1));	445	$dl = ord(substr($input, 7, 1));
445	if ($ext < 2 && $rtr < 2 && $dl < 9) {	446	if ($ext < 2 && $rtr < 2 && $dl < 9) {
446	$output .= sprintf "%08x ", $id;	447	$output .= sprintf "%08x ", $id;
447	$output .= $ext . " " . $rtr;	448	$output .= $ext . " " . $rtr;
448	for ($i = 0; $i < $dl; $i++) {	449	for ($i = 0; $i < $dl; $i++) {
449	$data = ord(substr($input, 8+$i, 1));	450	$data = ord(substr($input, 8+$i, 1));
450	$output .= sprintf " %02x", $data;	451	$output .= sprintf " %02x", $data;
451	}	452	}
452	$_[1] = "PKT ".$output;	453	$_[1] = "PKT ".$output;
453	} else {	454	} else {
454	#print "debug: incorrect ext, rtr or dl\n";	455	#print "debug: incorrect ext, rtr or dl\n";
455		456
456	}	457	}
457	} else {	458	} else {
458	#print "debug: incorrect boundaries\n";	459	#print "debug: incorrect boundaries\n";
459		460
460	}	461	}
461	}	462	}
462		463
463	#this function should parse $_[0] (string) and save in $_[1] as can2serial-data	464	#this function should parse $_[0] (string) and save in $_[1] as can2serial-data
464	sub stringToc2s {	465	sub stringToc2s {
465	my $input = $_[0];	466	my $input = $_[0];
466	my $output = "";	467	my $output = "";
467	#if not correct input data, then dont save anything in $_[1]	468	#if not correct input data, then dont save anything in $_[1]
468	if (length($input) > 15) {	469	if (length($input) > 15) {
469	#minor checks, the data from the tcp-server should be valid	470	#minor checks, the data from the tcp-server should be valid
470	@splitinput = split(/ +/, $input);	471	@splitinput = split(/ +/, $input);
471	$inputarrlen = @splitinput;	472	$inputarrlen = @splitinput;
472	if (substr($input, 0, 4) == "PKT " && substr($input, 12, 1) == " " && substr($input, 14, 1) == " " && $inputarrlen > 3 && $inputarrlen < 13) {	473	if (substr($input, 0, 4) == "PKT " && substr($input, 12, 1) == " " && substr($input, 14, 1) == " " && $inputarrlen > 3 && $inputarrlen < 13) {
473	$id = hex($splitinput[1]);	474	$id = hex($splitinput[1]);
474	$ext = hex($splitinput[2]);	475	$ext = hex($splitinput[2]);
475	$rtr = hex($splitinput[3]);	476	$rtr = hex($splitinput[3]);
476	@data = @splitinput[4..($inputarrlen-1)];	477	@data = @splitinput[4..($inputarrlen-1)];
477	$dl = @data;	478	$dl = @data;
478		479
479	$output .= chr($C2SSTARTSTR);	480	$output .= chr($C2SSTARTSTR);
480	$output .= chr($id & 0xff);	481	$output .= chr($id & 0xff);
481	$output .= chr(($id>>8) & 0xff);	482	$output .= chr(($id>>8) & 0xff);
482	$output .= chr(($id>>16) & 0xff);	483	$output .= chr(($id>>16) & 0xff);
483	$output .= chr(($id>>24) & 0xff);	484	$output .= chr(($id>>24) & 0xff);
484	$output .= chr($ext);	485	$output .= chr($ext);
485	$output .= chr($rtr);	486	$output .= chr($rtr);
486	$output .= chr($dl);	487	$output .= chr($dl);
487	for ($i = 0; $i < 8; $i++) {	488	for ($i = 0; $i < 8; $i++) {
488	if ($i < $dl) {	489	if ($i < $dl) {
489	$output .= chr(hex($data[$i]));	490	$output .= chr(hex($data[$i]));
490	} else {	491	} else {
491	$output .= chr(" ");	492	$output .= chr(" ");
492	}	493	}
493	}	494	}
494	$output .= chr($C2SENDSTR);	495	$output .= chr($C2SENDSTR);
495	$_[1] = $output;	496	$_[1] = $output;
496	}	497	}
497	}	498	}
498	}	499	}

Subversion Repositories HomeAutomation

(root)/trunk/PcSoftware/scripts/canDaemon/canDaemon.pl/ – Rev 974 → 1035