Subversion Repositories HomeAutomation

Rev

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

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