Subversion Repositories HomeAutomation

Rev

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