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

Subversion Repositories HomeAutomation

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