#!/usr/local/bin/perl -w

use strict;

BEGIN { $ENV{PATH} = '/usr/ucb:/bin';
	open(LOG, '>>/var/log/rdiald') or warn "Can't open log: $!";
	open(STDERR, '>&LOG') or warn "Can't dup stderr: $!";
      }

use Socket;
use Carp;
use FindBin;

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

my $port = 9216;
my $proto = getprotobyname('tcp');
my $if = inet_aton('192.168.0.3');
my $pon  = '/usr/sbin/pppd call schsr';
my $pidof = '/bin/pidof pppd';
my $route = '/sbin/route -n';
my @cmds = qw(DIAL DROP STAT ROUT FDRP FDIA HELP);
my $EOL = "\015\012";
my $maxloop = 100;
my ($paddr,$i,%locks);

socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
	   pack("l", 1))                            || die "setsockopt: $!";
bind(Server, sockaddr_in($port, $if))               || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!";

logmsg "server started on port $port";

sub add_lock {
  my $addr = shift;
  my $lock = inet_ntoa($addr) . ':' . time;
  $locks{$lock} = 1;
  return $lock;
}

sub rm_lock {
  my $lock = shift;
  return delete $locks{$lock};
}

sub pon {
  system($pon);
}

sub poff {
  kill 15, $_ foreach split(/\s+/,`$pidof`);
}

sub reset_self {
  return if keys %locks;
  my $self = "$FindBin::Bin/$FindBin::Script";
  exec $self;
}

sub route {
  chomp(my @rt = `$route`);
  return @rt;
}

sub usage {
  return ("Usage: @cmds",
	  '       DIAL: request a lock, dialup if necessary',
	  '       DROP [lock]: remove your lock from the stack',
	  '       STAT: get a lock status',
	  '       ROUT: get a routing status',
	  '       FDRP: force a lock reset and line drop',
	  '       FDIA: force a lock reset, line drop, and dialup',
	  '       HELP: this message',
	  '',
	  'DIAL returns a lock string, DROP requires one. All other',
	  '  commands take no args. Characters preceding the first space',
	  '  and beyond the fourth character are ignored. Case insensitive.',
	  '',
	  'Connection will be terminated after request; reconnect for further',
	  '  use.'
	 );
}

for ( ; $paddr = accept(Client,Server); close Client) {
  my($port,$iaddr) = sockaddr_in($paddr);
  my $name = gethostbyaddr($iaddr,AF_INET);

  $i++;

  logmsg "Connection $i from $name [",
    inet_ntoa($iaddr), "] at port $port";

  select Client; $| = 1; select STDOUT;

  print Client "+$i Go ahead $name$EOL";
  chomp(my $cmd = <Client>);
  $cmd =~ s/$EOL//g;

  $cmd = uc $cmd;

  logmsg "Got command $cmd with ", scalar keys(%locks) , " locks";

  my $arg;
  $arg = $1 if $cmd =~ /[A-Z]{4,}\s+([0-9.:]+)/;
  $cmd = substr($cmd, 0, 4);

  if ($cmd eq 'DIAL') {
    print Client add_lock($iaddr), $EOL;
    if (keys(%locks) == 1) {
      pon;
    }
  } elsif ($cmd eq 'DROP') {
    if ($arg) {
      rm_lock($arg) ? print Client "+OK DROP $arg$EOL" :
	print Client "-ERR No such lock $arg$EOL";
      poff unless keys %locks;
    } else {
      print Client "-ERR No lock provided$EOL";
    }
  } elsif ($cmd eq 'STAT') {
    print Client "+OK STAT$EOL", map { "\t$_$EOL" } keys %locks;
  } elsif ($cmd eq 'ROUT') {
    print Client "+OK ROUT$EOL", map { "$_$EOL" } route;
  } elsif ($cmd eq 'FDRP') {
    print Client "+OK FDRP Forcing line drop, resetting locks$EOL";
    %locks = ();
    poff;
  } elsif ($cmd eq 'FDIA') {
    print Client "+OK FDIA Forcing redial$EOL";
    poff;
    pon if keys(%locks);
  } else {
    print Client "+HLP HELP$EOL", map { "\t$_$EOL"} usage;
  }

  reset_self if $i > $maxloop;
}