#!/usr/bin/perl
use strict;
use warnings;

use IO::Socket;
use Carp;
use POSIX ":sys_wait_h";    # for WNOHANG
use Device::SerialPort qw(:STAT);

$| = 1;

#
# Set up the serial port
#
my $device = '/dev/ttyS0';

my $serialport = new Device::SerialPort($device) or die "new Device::S
+erialPort($device): $!";

$serialport->handshake('none');
$serialport->baudrate('9600');
$serialport->databits(8);
$serialport->parity('none');
$serialport->stopbits(1);

$serialport->read_const_time(100);
$serialport->read_char_time(5);



#
# Set up the TCP socket
#
my $port = 2345;

my $server = IO::Socket::INET->new(
    Proto       => 'tcp',
    LocalPort   => $port,
    Listen      => SOMAXCONN,
    Reuse       => 1,
);

die "Can't set up server: $!" unless($server);

logmsg("server started on port $port");



#
# Wait for a connection
#
my $client = $server->accept();

$client->autoflush(1);

print $client "Welcome to $0\n";

logmsg("Connection from " . $client->peerhost);

my @pids;
push(@pids, fork_reader($client));
push(@pids, fork_writer($client));

#
# Reap children
#
while((my $pid = wait()) > 0) {
    logmsg("reaped $pid");
    kill('INT', $_) foreach(@pids);
}

exit(0);





#
# fork_reader forks a child process to read from the socket
# and write to the serial port
#
sub fork_reader {
    my $client = shift;

    if(!defined(my $pid = fork())) {
        logmsg("cannot fork: $!");
        return;
    } elsif($pid) {
        logmsg("begat $pid");
        return $pid; # I'm the parent
    } else {
        logmsg("child reading from client and writing to serial port")
+;
        while(defined(recv($client, my $line, 255, 0))) {
            last unless(length($line) > 0);
            writechunk($line);
            $line=~s/([^\040-\176])/sprintf("{0x%02X}",ord($1))/ge;
            logmsg("Copied from client to serial port: \"$line\"");
        }
        exit(0);
    }
}



#
# fork_writer forks a child process to read from the serial
# port and write to the socket.
#
sub fork_writer {
    my $client = shift;
    if(!defined(my $pid = fork())) {
        logmsg("cannot fork: $!");
        return;
    } elsif($pid) {
        logmsg("begat $pid");
        return $pid; # I'm the parent
    } else {
        logmsg("child reading from serial port and writing to client")
+;
        while(1) {
            my ($count, $saw) = $serialport->read(255);
            if($count) {
                print $client $saw;
                $saw=~s/([^\040-\176])/sprintf("{0x%02X}",ord($1))/ge;
                logmsg("Copied from serial port to client: \"$saw\"");
            }
        }
        exit(0);
    }
}




#
# writechunk writes a chunk of data to the serial port
#
sub writechunk
{
    my $str=shift;

    my $count = $serialport->write($str);
    logmsg("wrote $count bytes from a string of " . length($str) . " b
+ytes") unless($count == length($str));
    print "wrote: $count\n";
    $str=~s/([^\040-\176])/sprintf("{0x%02X}",ord($1))/ge;
    print "written ->$str<-\n";
}


sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
[download]