#!/usr/bin/perl
#$Id: dummy-serial-server.pl,v 1.2 2023/05/11 19:06:12 sqko Exp $
use POSIX qw(strftime);
use IO::Socket;
use IO::Interface::Simple;
use strict;
use warnings;
use Sys::Hostname;

my $VERSION = '$Revision: 1.2 $';
my $debug = 0;
if (!@ARGV)
{
    die "Not enough parameters for dummy-serial-server\nUsage: dummy-serial-server DEVICE [opt --host IP-ADDR] [opt --nowarning]\n";
}
my $this_host = undef;
my $nowarning = 0;
if (scalar(@ARGV) > 0)
{
    for(my $x = 0; $x < scalar(@ARGV);$x++)
    {
        if ($ARGV[$x] =~ /--version/)
        {
            print "$0 is: $VERSION\n";
            exit 0;
        }
        if ($ARGV[$x] =~ /--debug/)
        {
            $debug = 1;
        }
        if ($ARGV[$x] =~ /--host/)
        {
            $this_host = $ARGV[$x+1];
        }
        if ($ARGV[$x] =~ /--nowarning$/)
        {
            $nowarning = 1;
        }
    } 
}


#### Base port number is 202020, added to this is the ttys nr ###
#### EG ttyS0 => 202020, ttyS4 => 202024 etc.                 ###
my $portbase = 202020;
#### Try to get ip address of netwrok interface ###
my @ilst = ('eth','em','en','lo');
my $local = '';
my @ifl = IO::Interface::Simple->interfaces();
OUTER:
foreach my $try (@ilst)
{
    foreach my $interface (@ifl)
    {
	if ($interface =~ /$try/)
	{
	    my $if = IO::Interface::Simple->new($interface);
	    $local = $if->address();
	    last OUTER if ($local);
	}
    }
}
### Use localhost if everything else fails ###
$local = 'localhost' unless ($local);
$local = $this_host if ($this_host);
$| = 1;

my $pre = sprintf "%c%c%c%c%c", 255, 255, 255, 255, 255;
my $cmdpre = sprintf "%c%c", 130, 138;
my $serialport = shift;
$serialport =~ /(\d+)/;
my $port = $portbase + $1;

my $file = "/dev/" . $serialport;
my $lockfile = "/var/lock/" . $serialport . "..lock";
### Initalise serial port ####
if (@ARGV)
{
    my $p = shift;
    if ($p =~ /(\d+)/)
    {
	$port = $portbase + $1;
    }
}


my $ip = inet_ntoa(inet_aton($local));
$port = $port & 0xffff;
print "Using host $local and port $port\n" if ($debug);
### Bind to socket ###
my $sock = new IO::Socket::INET(
    LocalHost => $local,
    LocalPort => $port,
    Proto  => 'tcp',
    Listen => 10,
    Reuse  => 1
);
die "Could not create socket: $!\n" unless $sock;
$| = 1;
my $new_sock;
while ( $new_sock = $sock->accept() ) 
{
    if ($debug)
    {
	print strftime "%Y:%m:%d:%H:%M:%S", localtime;
    }
    my $other_end = getpeername($new_sock);
    my ( $port, $iaddr ) = unpack_sockaddr_in($other_end);
    my $ip_address = inet_ntoa($iaddr);
    print "  ",$ip_address, "\n" if ($debug);
    if (my $str = <$new_sock>) {
        my ($cmd,@args) = split (/[\s\t]+/,$str);
	$cmd = lc($cmd);
	print $str if ($debug);
	my $res = "Warning: no hardware TTY $serialport";
	$res = undef if ($nowarning);
	print $new_sock $res;
	close $new_sock;
    }
    else
    {
	close $new_sock;
    }
}
close($sock);
exit;


