#!/usr/bin/perl

##############################################################################
## setid - part of setiherder (http://www.sackheads.org/setiherder/         ##
## (C) Brian L. Naylor, 1999                                                ##
##                                                                          ##
## This script runs in the background, listens for setiherder on a          ##
## configurable port, execs setiathome, and delivers the output back to     ##
## the setiherder gui.  See docs/README.setid in the setiherder             ##
## distribution for more information.                                       ##
##                                                                          ##
## setid is licensed under the GNU GPL.                                     ##
##############################################################################

##############################################################################
# The simple communication protocol used here is documented in src/shnet.c   #
#                                                                            #
# PERL ENTHUSIASTS BEWARE:                                                   #
# I am a C coder.  I write C code.  Even when I write perl code, I tend to   #
# write C code.  I don't wanna hear about how ugly my perl is, I like it     #
# that way.  All you freaky perl trolls go bother someone else! :)           #
##############################################################################

#
# defaults
#
$port       = 7501;                 # tcp port to listen on
$setidir    = '/usr/local/seti/';   # where does seti@home live?
$seticlient = 'setiathome';         # name of seti@home binary
$inetd      = 0;                    # running under inetd? (why?)
$allowhost  = '';                   # default to any

#
# important variables
#
@keeplines  = ();                   # client output to keep on detach
@lastlines  = ();                   # last $lastnum lines of client output
$lastnum    = 5;                    # *shrug*
$running    = 0;                    # is a client running? (set to pid if so)
$detach     = 0;                    # should we detach if the gui goes away?
$connected  = 0;                    # currently have gui connected?
$len        = 255;                  # max buffer size

#
# "#defines"
#
$cmd_start        = 'SD:start';        # start seti@home client
$cmd_kill         = 'SD:kill';         # kill seti@home client
$cmd_detach       = 'SD:detach';       # please detach when gui exits
$cmd_ping         = 'SD:ping';         # ping?
$err_ok           = 'SD:success';      # success
$err_pong         = 'SD:pong';         # pong
$err_active       = 'SD:active';       # seti@home client is already running
$err_nactive      = 'SD:nactive';      # seti@home client is not running
$err_connect      = 'SD:connect';      # a setiherder is already connected
$err_client_start = 'SD:client_start'; # couldn't start seti@home client
$err_client_comm  = 'SD:client_comm';  # client is not responding
$err_host         = 'SD:host';         # you are not allowed to connect
$err_died         = 'SD:died';         # the seti client died
$err_shutdown     = 'SD:shutdown';     # setid is being killed
$err_confused     = 'SD:confused';     # syntax error
$err_generic      = 'SD:generic';      # generic error

require 5.002;
use Socket;

sub init_sock {
  socket(SH_LISTEN, PF_INET, SOCK_STREAM, 0)                    || die "socket: $!";
  setsockopt(SH_LISTEN, SOL_SOCKET, SO_REUSEADDR, pack('l', 1)) || die "setsockopt: $!";
  bind(SH_LISTEN, sockaddr_in($port, INADDR_ANY))               || die "bind: $!";
  listen(SH_LISTEN, SOMAXCONN)                                  || die "listen: $!";
}

sub debug {
  my $severity = shift;
  my $msg = "@_";

  print "$msg\n";
  die "Fatal error.\n" if($severity == 0);
  return undef;
}

sub start_client {
  if($running) {
    send_client_text("$err_active\n");
    return 1;
  }
  else {
    chop($setidir) if($setidir =~ /.+\/$/); # remove trailing /
    if(!chdir($setidir))
    {
      send_client_text("$err_generic Couldn't change to $setidir\n");
      return 1;
    }

    $pid = open(SH_CLIENT, "-|");
    select((select(SH_CLIENT), $|=1)[0]);

    if($pid)              # parent
    {  
      send_client_text("$err_ok\n");
      $running = $pid;
    }
    else                  # child
    {
      select(SH_CLIENT); $|=1;
      { exec("./$seticlient") }; print "Couldn't exec $setidir/$seticlient.\n";
#      exec("/bin/cat","/etc/lilo.conf");
    }
  }
  return undef; 
}

sub kill_client {
  if($running) {
    close(SH_CLIENT); 
    print "Attempting to kill $running..\n";
    if(kill('TERM', $running)) {
      send_client_text("$err_ok\n");
    }
    else {
      &send_client_text("$err_generic Couldn't send TERM to child\n");
      if(kill("KILL", $running)) {
        &send_client_text("$err_client_comm\n");
      }
    }
    $running = 0;
  }
  else {
    send_client_text("$err_nactive\n");
  }
}

sub parse_host_cmd {
  my $line = "@_";
  
  if($line =~ /${cmd_start}/) {
    &start_client;
  }
  elsif($line =~ /${cmd_kill}/) {
    &kill_client;
  }
  elsif($line =~ /${cmd_detach} 1/) {
    $detach = 1;
  }
  elsif($line =~ /${cmd_detach} 0/) {
    $detach = 0;
  }
  elsif($line =~ /${cmd_ping}/)
  {
    &send_client_text("$err_pong\n");
  }
  else 
  {
    &send_client_text("$err_confused\n");
  }

  return undef;
}

sub send_client_text {
  my $line = "@_";

  if($connected) {
    syswrite(SH_HOST, $line, $len);
  }
  return undef;
}

sub accept_conn {
  my $action = shift;
  local(*PEER) = @_;

  my $sock = getsockname(PEER);
  my $ip   = inet_ntoa((sockaddr_in($sock))[1]);
  # XXX do a name lookup XXX
  &debug(1, "Got connection from $ip");

  if($action == 0)  # reject
  { 
    print PEER "$err_connect\n";
    close(PEER);
  }
  else
  {
    # XXX check allowhost first XXX

    if($running)
    {
      print "Would be filling head with lies..\n";
    }
    else 
    {
      print "$err_ok\n";
    }
  }

  return undef;
}

sub signal_handler {
  my($signal) = @_;

  if( ($signal =~ /INT/) || ($signal =~ /TERM/) )
  {
    &send_client_text("$err_shutdown\n");
    close(SH_HOST);
    &kill_client;
    exit(0);
  }  
  if($signal =~ /CHLD/)
  {
    printf("Caught SIGCHLD.\n");
    $running = 0;
    close(SH_CLIENT);
    &send_client_text("$err_died $?\n");
    my($wpid) = wait;
    # gotta reset this handler..  :-/
    $SIG{CHLD} = \&signal_handler;
  }

  return undef;
}


#
# let us begin (aka main())
#

# parse args
while(@ARGV) 
{
  my $next = shift;
  if($next =~ /-p/) 
  {
    $port = int(shift);
    if($port == 0)
    {
      &debug(0, "-p requires an additional argument");
    }
  }
  elsif($next =~ /-d/)
  {
    $setidir = shift;
    if($setidir eq '')
    {
      &debug(0, "-d requires an additional argument");
    }
  }
  elsif($next =~ /-c/)
  {
    $seticlient = shift;
    if($seticlient eq '')
    {
      &debug(0, "-c requires an additional argument");
    }
  } 
  elsif($next =~ /-i/)
  {
    &debug(0, "-i not currently supported");
    $inetd = 1;
  }
  elsif($next =~ /-a/)
  {
    $allowhost = shift;
  }
  else 
  {
    print
      'Usage: setid [-p port][-d dir][-c client][-i]', "\n",
      "\t-p port  : override the default port (7501)\n",
      "\t-d dir   : override the default seti\@home directory (/usr/local/seti)",
      "\n",
      "\t-c client: override the default seti\@home binary name (setiathome)\n",
      "\t-i       : tell setid that it's running under inetd\n",
      "\n";
    exit(1);
  }
}

#
# verify that what we were told is true
#

# directory exists

# binary exists and is executable

#
# install signal handlers
#
$SIG{CHLD} = \&signal_handler;
$SIG{INT}  = \&signal_handler;
$SIG{TERM} = \&signal_handler;


#
# initialize sockets
#
&init_sock;

#
# wait for connection
#
while(1)
{
  undef $select_bits;
  vec($select_bits, fileno(SH_LISTEN), 1) = 1;
  vec($select_bits, fileno(SH_HOST),   1) = 1; 
  vec($select_bits, fileno(SH_CLIENT), 1) = 1;
  if(select($rbits=$select_bits, undef, $ebits=$select_bits, undef))
  {
    # there's something to read, somewhere
    if(vec($rbits, fileno(SH_LISTEN), 1) &&     # master socket?
       ! vec($ebits, fileno(SH_LISTEN), 1))
    {
      if(!$connected) 
      {
        # no current connection
        accept(SH_HOST, SH_LISTEN);
        &accept_conn(1, *SH_HOST);
        $connected = 1;
      }
      else
      {
        # already connected
        accept(SH_REJECT, SH_LISTEN);
        &accept_conn(0, *SH_REJECT);
      }
    }
    elsif(vec($rbits, fileno(SH_HOST), 1) &&    # host socket?
          ! vec($ebits, fileno(SH_HOST), 1))
    {
      my($in) = '';
      $nread = sysread(SH_HOST, $in, $len);
      if($nread == 0 && eof(SH_HOST))
      { 
        print "Host closed connection.\n";
        $connected = 0;
        if(!$detach)
        {
          print "Would be killing client now..\n";
        }
        close(SH_HOST);
      }
      &parse_host_cmd($in);
    }
    elsif(vec($rbits, fileno(SH_CLIENT), 1) &&  # seti@home socket?
          ! vec($ebits, fileno(SH_CLIENT), 1))
    {
      my($in) = '';
      $nread = sysread(SH_CLIENT, $in, $len);
      if($nread > 0) {
        &send_client_text($in);
      }
      else {
        print "hmmm.\n";
        sleep 5;
      }
    }
  }
}


