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



        }
    }  
}
 
sub hardwareConnInit {
    print localtime()." 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 ############################

                $output = $input;
                #print "debug: cutting character\n";
                break;
            }
            if (ord(substr($input, $i, 1)) == $C2PINGSTR) {
                print localtime()." Got pong from hardware\n";
                $input = substr($input, $i+1);
                $output = $input;
            }
        } else {
            break;

    ### Store modified buffer ###
    $_[0] = $output;
}
 
sub serialConnInit {
    print localtime()." 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->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 localtime()." 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

            }
            elsif (length($newmsg) == 1)
            {
                if (ord(substr($newmsg, 0, 1)) == $C2PINGSTR)
                {
                    print localtime()." Got pong from hardware\n";
                }
            }
        }
    }
   
}
 
sub udpServerInit {
    print localtime()." 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: $@";

#   }
#   else
#   {
#       print "Could not create initpacket\n";
#   }
    print localtime()." Testing connection to hardware: ping (hardware should answer with a pong)\n";
    udpServerSend(chr($C2PINGSTR));
 
    ### create a connection between the hardware and the tcp-server ###
    &hardwareConnInit;
    $hardwareSendFunction = "udpServerSend";        ### set up callback for a 'send data' function

                    &tcpServerClientDis;
                } else {
                    $line =~ s/\r//gm;  #remove linefeed
                    @lines = split(/\n/, $line);
                    foreach $line (@lines) {
                        print localtime()." Got packet '".$line."' from client ".$tcpSsocket->fileno."\n";
                        if ($line eq "PING") {
                            print localtime()." Sending PONG to client ".$tcpSsocket->fileno."\n";
                       
                            $tcpSsocket->send("PONG\n");
                        }
                        else
                        {

sub tcpServerInit {
    $tcpSlisten = IO::Socket::INET->new(Proto => "tcp", LocalPort => $hubport, Listen => 1, Reuse => 1)
                or die $!;
 
    $tcpSselect = IO::Select->new($tcpSlisten);
    print localtime()." Starting tcpServer\n";
}
 
#a client connected
sub tcpServerConn {
    $new = $tcpSlisten->accept;
    $tcpSselect->add($new);
    print localtime()." ".$new->fileno . ": connected\n";
}
 
#a client disconnected
sub tcpServerClientDis {
    print localtime()." ".$tcpSsocket->fileno . ": disconnected\n";
    $tcpSselect->remove($tcpSsocket);
    $tcpSsocket->close;
}
 
#subroutine sends data to all connected clients except for one specified 

        } elsif ($eachsocket==$exception) {     #dont send to the specified exception
            next;
        } else {
            if ($first==0) {
                $first = 1;
                print localtime()." Sending to client ".$eachsocket->fileno;
            } else {
                print ", ".$eachsocket->fileno;
            }
            $eachsocket->send($data) or do {
                &tcpServerClientDis;

   
    #line should be parsed somewhat here, check PKT, AUT and so on
    $testErr = 0;
    if (length($input) < 16) {
        $testErr = 1;
        if ($messages!=1) {print localtime()." Packet was malformed, not long enough\n";}
    }
    if ($testErr == 0 && substr($input, 0, 4) != "PKT ") {
        $testErr = 1;
        if ($messages!=1) {print localtime()." 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 localtime()." Packet was malformed, to many or to few parts\n";}
    }
    if ($testErr == 0 && length($splitinput[1]) != 8) {
        $testErr = 1;
        if ($messages!=1) {print localtime()." 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 localtime()." Packet was malformed, ext part must be 1 digit\n";}
    }
    if ($testErr == 0 && length($splitinput[3]) != 1) {
        $testErr = 1;
        if ($messages!=1) {print localtime()." 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 localtime()." 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 localtime()." Packet was malformed, not hex\n";}
    }
   
    $_[2] = $testErr;
}
 

Rev 1305	Rev 1526
Line 146...	Line 146...
146	}	146	}
147	}	147	}
148	}	148	}
149		149
150	sub hardwareConnInit {	150	sub hardwareConnInit {
151	print "Connecting hardware to tcpServer\n";	151	print localtime()." Connecting hardware to tcpServer\n";
152	$hwCremote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "localhost", PeerPort => $hubport,)	152	$hwCremote = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "localhost", PeerPort => $hubport,)
153	or die "cannot connect to $hubport port at localhost";	153	or die "cannot connect to $hubport port at localhost";
154	}	154	}
155		155
156	##################### Serial Connection ############################	156	##################### Serial Connection ############################
Line 179...	Line 179...
179	$output = $input;	179	$output = $input;
180	#print "debug: cutting character\n";	180	#print "debug: cutting character\n";
181	break;	181	break;
182	}	182	}
183	if (ord(substr($input, $i, 1)) == $C2PINGSTR) {	183	if (ord(substr($input, $i, 1)) == $C2PINGSTR) {
184	print "Got pong from hardware\n";	184	print localtime()." Got pong from hardware\n";
185	$input = substr($input, $i+1);	185	$input = substr($input, $i+1);
186	$output = $input;	186	$output = $input;
187	}	187	}
188	} else {	188	} else {
189	break;	189	break;
Line 208...	Line 208...
208	### Store modified buffer ###	208	### Store modified buffer ###
209	$_[0] = $output;	209	$_[0] = $output;
210	}	210	}
211		211
212	sub serialConnInit {	212	sub serialConnInit {
213	print "Connecting to hardware over serial port\n";	213	print localtime()." Connecting to hardware over serial port\n";
214	$quiet=0;	214	$quiet=0;
215	if ($usingDeviceSerial == 1) {	215	if ($usingDeviceSerial == 1) {
216	$serialPort = new Device::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";	216	$serialPort = new Device::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";
217	} elsif ($usingWin32Serial == 1) {	217	} elsif ($usingWin32Serial == 1) {
218	$serialPort = new Win32::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";	218	$serialPort = new Win32::SerialPort($devicearg, $quiet) \|\| die "failed to open serial port, $devicearg is not valid?";
Line 225...	Line 225...
225	$serialPort->write_settings \|\| die "no settings";	225	$serialPort->write_settings \|\| die "no settings";
226		226
227	$serialPort->read_char_time(0); # don't wait for each character	227	$serialPort->read_char_time(0); # don't wait for each character
228	$serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call	228	$serialPort->read_const_time(1000); # 1 second per unfulfilled "read" call
229		229
230	print "Testing connection to hardware: ping (hardware should answer with a pong)\n";	230	print localtime()." Testing connection to hardware: ping (hardware should answer with a pong)\n";
231	serialConnSend(chr($C2PINGSTR));	231	serialConnSend(chr($C2PINGSTR));
232		232
233	### create a connection between the hardware and the tcp-server ###	233	### create a connection between the hardware and the tcp-server ###
234	&hardwareConnInit;	234	&hardwareConnInit;
235	$hardwareSendFunction = "serialConnSend"; ### set up callback for a 'send data' function	235	$hardwareSendFunction = "serialConnSend"; ### set up callback for a 'send data' function
Line 263...	Line 263...
263	}	263	}
264	elsif (length($newmsg) == 1)	264	elsif (length($newmsg) == 1)
265	{	265	{
266	if (ord(substr($newmsg, 0, 1)) == $C2PINGSTR)	266	if (ord(substr($newmsg, 0, 1)) == $C2PINGSTR)
267	{	267	{
268	print "Got pong from hardware\n";	268	print localtime()." Got pong from hardware\n";
269	}	269	}
270	}	270	}
271	}	271	}
272	}	272	}
273		273
274	}	274	}
275		275
276	sub udpServerInit {	276	sub udpServerInit {
277	print "Starting udpServer\n";	277	print localtime()." Starting udpServer\n";
278	$udpSsocket = IO::Socket::INET->new(LocalPort => $udpport, Proto => 'udp')	278	$udpSsocket = IO::Socket::INET->new(LocalPort => $udpport, Proto => 'udp')
279	or die "socket: $@";	279	or die "socket: $@";
280		280
281	$udpCsocket = IO::Socket::INET->new(PeerPort => $udpport, Proto => 'udp', PeerAddr => $udpip)	281	$udpCsocket = IO::Socket::INET->new(PeerPort => $udpport, Proto => 'udp', PeerAddr => $udpip)
282	or die "socket: $@";	282	or die "socket: $@";
Line 292...	Line 292...
292	# }	292	# }
293	# else	293	# else
294	# {	294	# {
295	# print "Could not create initpacket\n";	295	# print "Could not create initpacket\n";
296	# }	296	# }
297	print "Testing connection to hardware: ping (hardware should answer with a pong)\n";	297	print localtime()." Testing connection to hardware: ping (hardware should answer with a pong)\n";
298	udpServerSend(chr($C2PINGSTR));	298	udpServerSend(chr($C2PINGSTR));
299		299
300	### create a connection between the hardware and the tcp-server ###	300	### create a connection between the hardware and the tcp-server ###
301	&hardwareConnInit;	301	&hardwareConnInit;
302	$hardwareSendFunction = "udpServerSend"; ### set up callback for a 'send data' function	302	$hardwareSendFunction = "udpServerSend"; ### set up callback for a 'send data' function
Line 321...	Line 321...
321	&tcpServerClientDis;	321	&tcpServerClientDis;
322	} else {	322	} else {
323	$line =~ s/\r//gm; #remove linefeed	323	$line =~ s/\r//gm; #remove linefeed
324	@lines = split(/\n/, $line);	324	@lines = split(/\n/, $line);
325	foreach $line (@lines) {	325	foreach $line (@lines) {
326	print "Got packet '".$line."' from client ".$tcpSsocket->fileno."\n";	326	print localtime()." Got packet '".$line."' from client ".$tcpSsocket->fileno."\n";
327	if ($line eq "PING") {	327	if ($line eq "PING") {
328	print "Sending PONG to client ".$tcpSsocket->fileno."\n";	328	print localtime()." Sending PONG to client ".$tcpSsocket->fileno."\n";
329		329
330	$tcpSsocket->send("PONG\n");	330	$tcpSsocket->send("PONG\n");
331	}	331	}
332	else	332	else
333	{	333	{
Line 352...	Line 352...
352	sub tcpServerInit {	352	sub tcpServerInit {
353	$tcpSlisten = IO::Socket::INET->new(Proto => "tcp", LocalPort => $hubport, Listen => 1, Reuse => 1)	353	$tcpSlisten = IO::Socket::INET->new(Proto => "tcp", LocalPort => $hubport, Listen => 1, Reuse => 1)
354	or die $!;	354	or die $!;
355		355
356	$tcpSselect = IO::Select->new($tcpSlisten);	356	$tcpSselect = IO::Select->new($tcpSlisten);
357	print "Starting tcpServer\n";	357	print localtime()." Starting tcpServer\n";
358	}	358	}
359		359
360	#a client connected	360	#a client connected
361	sub tcpServerConn {	361	sub tcpServerConn {
362	$new = $tcpSlisten->accept;	362	$new = $tcpSlisten->accept;
363	$tcpSselect->add($new);	363	$tcpSselect->add($new);
364	print $new->fileno . ": connected\n";	364	print localtime()." ".$new->fileno . ": connected\n";
365	}	365	}
366		366
367	#a client disconnected	367	#a client disconnected
368	sub tcpServerClientDis {	368	sub tcpServerClientDis {
369	print $tcpSsocket->fileno . ": disconnected\n";	369	print localtime()." ".$tcpSsocket->fileno . ": disconnected\n";
370	$tcpSselect->remove($tcpSsocket);	370	$tcpSselect->remove($tcpSsocket);
371	$tcpSsocket->close;	371	$tcpSsocket->close;
372	}	372	}
373		373
374	#subroutine sends data to all connected clients except for one specified	374	#subroutine sends data to all connected clients except for one specified
Line 382...	Line 382...
382	} elsif ($eachsocket==$exception) { #dont send to the specified exception	382	} elsif ($eachsocket==$exception) { #dont send to the specified exception
383	next;	383	next;
384	} else {	384	} else {
385	if ($first==0) {	385	if ($first==0) {
386	$first = 1;	386	$first = 1;
387	print "Sending to client ".$eachsocket->fileno;	387	print localtime()." Sending to client ".$eachsocket->fileno;
388	} else {	388	} else {
389	print ", ".$eachsocket->fileno;	389	print ", ".$eachsocket->fileno;
390	}	390	}
391	$eachsocket->send($data) or do {	391	$eachsocket->send($data) or do {
392	&tcpServerClientDis;	392	&tcpServerClientDis;
Line 408...	Line 408...
408		408
409	#line should be parsed somewhat here, check PKT, AUT and so on	409	#line should be parsed somewhat here, check PKT, AUT and so on
410	$testErr = 0;	410	$testErr = 0;
411	if (length($input) < 16) {	411	if (length($input) < 16) {
412	$testErr = 1;	412	$testErr = 1;
413	if ($messages!=1) {print "Packet was malformed, not long enough\n";}	413	if ($messages!=1) {print localtime()." Packet was malformed, not long enough\n";}
414	}	414	}
415	if ($testErr == 0 && substr($input, 0, 4) != "PKT ") {	415	if ($testErr == 0 && substr($input, 0, 4) != "PKT ") {
416	$testErr = 1;	416	$testErr = 1;
417	if ($messages!=1) {print "Packet was malformed, should start with PKT\n";}	417	if ($messages!=1) {print localtime()." Packet was malformed, should start with PKT\n";}
418	}	418	}
419	#if (substr($line, 12, 1) != " " \|\| substr($line, 14, 1) != " ") {	419	#if (substr($line, 12, 1) != " " \|\| substr($line, 14, 1) != " ") {
420	# $testErr = 1;	420	# $testErr = 1;
421	# print "Packet was malformed, spaces not in the correct place\n";	421	# print "Packet was malformed, spaces not in the correct place\n";
422	#}	422	#}
423	@splitinput = split(/ +/, $input);	423	@splitinput = split(/ +/, $input);
424	$inputarrlen = @splitinput;	424	$inputarrlen = @splitinput;
425	if ($testErr == 0 && ($inputarrlen < 4 \|\| $inputarrlen > 12)) {	425	if ($testErr == 0 && ($inputarrlen < 4 \|\| $inputarrlen > 12)) {
426	$testErr = 1;	426	$testErr = 1;
427	if ($messages!=1) {print "Packet was malformed, to many or to few parts\n";}	427	if ($messages!=1) {print localtime()." Packet was malformed, to many or to few parts\n";}
428	}	428	}
429	if ($testErr == 0 && length($splitinput[1]) != 8) {	429	if ($testErr == 0 && length($splitinput[1]) != 8) {
430	$testErr = 1;	430	$testErr = 1;
431	if ($messages!=1) {print "Packet was malformed, id part must be 8 digits (padded with zeros)\n";}	431	if ($messages!=1) {print localtime()." Packet was malformed, id part must be 8 digits (padded with zeros)\n";}
432	}	432	}
433	if ($testErr == 0 && length($splitinput[2]) != 1) {	433	if ($testErr == 0 && length($splitinput[2]) != 1) {
434	$testErr = 1;	434	$testErr = 1;
435	if ($messages!=1) {print "Packet was malformed, ext part must be 1 digit\n";}	435	if ($messages!=1) {print localtime()." Packet was malformed, ext part must be 1 digit\n";}
436	}	436	}
437	if ($testErr == 0 && length($splitinput[3]) != 1) {	437	if ($testErr == 0 && length($splitinput[3]) != 1) {
438	$testErr = 1;	438	$testErr = 1;
439	if ($messages!=1) {print "Packet was malformed, rtr part must be 1 digit\n";}	439	if ($messages!=1) {print localtime()." Packet was malformed, rtr part must be 1 digit\n";}
440	}	440	}
441	for ($i = 4; $i < $inputarrlen; $i++) {	441	for ($i = 4; $i < $inputarrlen; $i++) {
442	if ($testErr == 0 && length($splitinput[$i]) != 2) {	442	if ($testErr == 0 && length($splitinput[$i]) != 2) {
443	$testErr = 1;	443	$testErr = 1;
444	if ($messages!=1) {print "Packet was malformed, data parts must be 2 digits (padded with zero)\n";}	444	if ($messages!=1) {print localtime()." Packet was malformed, data parts must be 2 digits (padded with zero)\n";}
445	}	445	}
446	}	446	}
447	$checkstrlen = length($input)-4;	447	$checkstrlen = length($input)-4;
448	$checkstr = substr($input, 4, $checkstrlen);	448	$checkstr = substr($input, 4, $checkstrlen);
449	if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) {	449	if ($testErr == 0 && $checkstr !~ m/^[0-9a-fA-F ]*$/) {
450	$testErr = 1;	450	$testErr = 1;
451	if ($messages!=1) {print "Packet was malformed, not hex\n";}	451	if ($messages!=1) {print localtime()." Packet was malformed, not hex\n";}
452	}	452	}
453		453
454	$_[2] = $testErr;	454	$_[2] = $testErr;
455	}	455	}
456		456

Subversion Repositories HomeAutomation

(root)/trunk/PcSoftware/scripts/canDaemon/canDaemon.pl @ 1305 – Rev 1305 → 1526