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


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

Subversion Repositories HomeAutomation

(root)/trunk/PcSoftware/scripts/canDaemon/canDaemon.pl/ – Rev 626 → 633