Subversion Repositories HomeAutomation

Rev

Rev 681 | Rev 935 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | SVN | RSS feed

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