#!/usr/bin/perl require IO::Socket; require IO::Select; require Device::SerialPort; # charger IO thread # this forks a connection to talk to the charger # note that this does NOT handle queueing $port = shift || 6500; $dev = shift || "/dev/ttyS1"; $baud = 9600; $timeout1 = 500; $timeout2 = 800; $delay = 0.05; $currentbaud = $baud; $currenttimeout1 = $timeout1; $currenttimeout2 = $timeout2; $master_mode = 0; if(fork()) { $SIG{'CHLD'} = IGNORE; exit(0); } else { $SIG{'CHLD'} = IGNORE; $SIG{'INT'} = cleanshutdown; $SIG{'TERM'} = cleanshutdown; $main_socket = IO::Socket::INET->new( Listen => 5, LocalPort => $port, Proto => 'tcp', Reuse => 1); die "couldn't create socket on $port (already running?)" if (!$main_socket); $serial = Device::SerialPort->new($dev); die "couldn't open $dev" if (!$serial); $select = IO::Select->new($main_socket); # close(STDIN); # close(STDOUT); # close(STDERR); $serial->baudrate($baud); $serial->parity("none"); $serial->stopbits(1); $serial->handshake("none"); $serial->read_const_time($timeout1); $serial->read_char_time($timeout2); $serial->write_settings(); # we're all set up, now do selects and writes and reads $alive = 1; while($alive) { @readable = $select->can_read(); foreach $socket (@readable) { if($socket eq $main_socket) { $socket = $main_socket->accept(); $select->add($socket); write_socket($socket,"BATMOD>",1); $timeout1{$socket} = $timeout1; $timeout2{$socket} = $timeout2; $baud{$socket} = $baud; $mon{$socket}{socket} = $socket; $mon{$socket}{value} = 0; $delay{$socket} = $delay; $mode{$socket} = $master_mode; } else { $socket->recv($read,256,0); if(! defined $read) { # hang up $select->remove($socket); $socket->close(); delete $timeout1{$socket}; delete $timeout2{$socket}; delete $baud{$socket}; delete $mon{$socket}{socket}; delete $mon{$socket}{value}; delete $delay{$socket}; delete $mode{$socket}; } else { if(!do_command($read,$socket)) { $select->remove($socket); $socket->close(); delete $timeout1{$socket}; delete $timeout2{$socket}; delete $baud{$socket}; delete $mon{$socket}{socket}; delete $mon{$socket}{value}; delete $delay{$socket}; delete $mode{$socket}; } } } } } @writable = $select->can_write(0); foreach $socket (@writable) { print $socket "\nSHUTTING DOWN ($reason)\n"; $socket->close(); } exit(0); } # end child sub cleanshutdown { my $sig = shift; $alive = 0; $reason = "Got signal: $sig"; } sub do_command { my $read = shift; my $socket = shift; my ($bcast, $string); my ($val,$reti,$linecount); $read =~ s/\r//; $read =~ s/\n//; # remove CR and LF my @cmd = split(/\s/,$read); my $command = lc $cmd[0]; my $arg1 = lc $cmd[1]; my $arg2 = lc $cmd[2]; if($command eq "shutdown") { $alive = 0; shift(@cmd); foreach $foo (@cmd) { $reason .= "$foo "; } write_socket($socket, "OK"); } elsif($command eq "quit") { return(0); } elsif($command eq "set") { if($arg1 eq "timeout1") { if(($val = int($arg2))) { $msg = "OK TIMEOUT1 (BASE) SET TO $val"; $timeout1{$socket} = $val; write_socket($socket,$msg); } else { write_socket($socket,"ERR NEED ARG"); } } elsif ($arg1 eq "timeout2") { if(($val = int($arg2))) { $msg = "OK TIMEOUT2 (CHAR) SET TO $val"; $timeout2{$socket} = $val; write_socket($socket,$msg); } else { write_socket($socket,"ERR NEED ARG"); } } elsif ($arg1 eq "baud") { if(($val = int($arg2))) { $msg = "OK BAUD SET TO $val"; $baud{$socket} = $val; write_socket($socket,$msg); } else { write_socket($socket,"ERR NEED ARG"); } } elsif ($arg1 eq "mode") { if($arg2 eq "net") { $mode{$socket} = 1; write_socket($socket,"OK NET MODE SELECTED"); } elsif($arg2 eq "host") { $mode{$socket} = 0; write_socket($socket,"OK HOST MODE SELECTED"); } else { $msg = "ERR UNKNOWN MODE [$arg2]"; write_socket($socket,$msg); } } elsif ($arg1 eq "delay") { if(($val = $arg2)) { $msg = "OK DELAY SET TO $val"; $delay{$socket} = $val; write_socket($socket,$msg); } else { write_socket($socket,"ERR NEED ARG"); } } else { write_socket($socket,"ERR unknown variable $arg1"); } } elsif($command eq "cmd") { # do a command # zeroeth, verify if(@cmd < 9) { write_socket($socket,"ERR need 8 args"); } else { # first, setup the serial port if(($currentbaud != $baud{$socket}) || ($currenttimeout1 != $timeout1{$socket}) || ($currenttimeout2 != $timeout2{$socket})) { $serial->baudrate($baud{$socket}); $serial->parity("none"); $serial->stopbits(1); $serial->handshake("none"); $serial->read_const_time($timeout1{$socket}); $serial->read_char_time($timeout2{$socket}); $serial->write_settings(); $currentbaud = $baud{$socket}; $currenttimeout1 = $timeout1{$socket}; $currenttimeout2 = $timeout2{$socket}; } # then, execute the command # return all replies, seperated into 8 byte chunks $string = $cmd[1] . " " . $cmd[2] . " " . $cmd[3] . " " . $cmd[4] . " " . $cmd[5] . " " . $cmd[6] . " " . $cmd[7] . " " . $cmd[8]; $bcast = 0; $bcast = 1 if($cmd[1] == 255); do_serial_write($string,$delay{$socket},$mode{$socket}); $reti = do_serial_read($bcast); if($reti =~ /NODATA/) { $linecount = 0; } else { $linecount = split(/\n/,$reti); } $return = "RETURN BLOCK $linecount\n$reti"; write_socket($socket,$return); } } elsif($command eq "mon") { if(!$arg1) { write_socket($socket,"ERR NEED ARG"); } else { $mon{$socket}{value} = $arg1; $msg = "OK MON set to $arg1"; write_socket($socket,$msg); } } else { write_socket($socket, "ERR no such command [$command]"); } write_socket($socket,"BATMOD>",1); return(1); } sub write_socket { my $socket = shift; my $msg = shift; my $cr = shift || 0; my $select = IO::Select->new($socket); my $handle; $handle = undef; ($handle) = $select->can_write(0.05); return(-1) if(!$handle); if($cr) { print $handle "$msg"; } else { print $handle "$msg\n"; } return(0); } sub do_serial_write { my $string = shift; my $time_delay = shift || $delay; my $mode = shift || $master_mode; my $char; my $ord; my @chars = split(/ /,$string); my $m = "Writing at $currentbaud ($currenttimeout1/$currenttimeout2/$time_delay): "; foreach $char (@chars) { $serial->write(chr($char)); if($mode) { $serial->read(1); # remove our echo } $ord = ord(chr($char)); select(undef,undef,undef,$time_delay); $m .= " $char/$ord"; } mon($m,1); return(0); } sub do_serial_read { my $bcast = shift; my $m = "Reading at $currentbaud ($currenttimeout1/$currenttimeout2): \n"; my ($o,$rd); my ($len, $data) = $serial->read(8); return "NODATA" if($len < 8); my @r = split(//,$data); foreach $rd (@r) { $m .= ord($rd) . " "; $o .= ord($rd) . " "; } if($bcast) { while($len) { $m .= "\n"; $o .= "\n"; ($len, $data) = $serial->read(8); if($len > 7) { @r = split(//,$data); foreach $rd (@r) { $m .= ord($rd) . " "; $o .= ord($rd) . " "; } } } } chop($o); chop($m); # remove the last CR mon($m,2); return($o); } sub mon { my $msg = shift; my $level = shift; my $sock; my @writable = $select->can_write(0); foreach $sock (@writable) { if($mon{$sock}{value} & $level) { write_socket($mon{$sock}{socket},"$level:$msg\n"); } } }