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

Subversion Repositories HomeAutomation

(root)/trunk/PcSoftware/scripts/canDaemon/canDaemon.pl – Rev 681 → 889