news.utdallas.edu!wupost!howland.reston.ans.net!gatech!concert!duke!khera Thu Feb 25 18:31:14 CST 1993
Article: 1231 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1231
Path: feenix.metronet.com!news.utdallas.edu!wupost!howland.reston.ans.net!gatech!concert!duke!khera
From: khera@cs.duke.edu (Vivek Khera)
Newsgroups: comp.lang.perl
#Subject: Re: socket-based server (not from inetd)
Message-ID: <KHERA.93Feb25141828@thneed.cs.duke.edu>
Date: 25 Feb 93 19:18:28 GMT
References: <1mimbd$ac3@milk.Warren.MENTORG.COM>
Sender: news@duke.cs.duke.edu
Organization: Duke University CS Dept., Durham, NC
Lines: 182
Nntp-Posting-Host: thneed.cs.duke.edu
To: tal@Warren.MENTORG.COM (Tom Limoncelli)
In-reply-to: tal@Warren.MENTORG.COM's message of 25 Feb 93 14:50:21 GMT
X-Md4-Signature: 876f378184b5a49ff0bd7a8dbbfea73b

In article <1mimbd$ac3@milk.Warren.MENTORG.COM> tal@Warren.MENTORG.COM (Tom Limoncelli) writes:

   I would like to develop a long-running daemon that accepts connections
   via sockets but never spawns.  (i.e. all connections are handled by one
   program, a lot like INN's innd).

here's a piece of the Internet Programming Contest judging software I
wrote last October.  This particular server keeps track of which jobs
are currently active in the system (it also does the job number
assignment).

this is the raw code, before being run through my configure script to
fill in the things like the host names and such. all such
substitutions are done to things of the form @@VAR@@ in the code.
these should be obvious as to what they should be.  but then, you
probably won't want to run this code anyway...


--cut here--
#@@PERL@@
#
# TaskMaster program.  This program should only run on one machine.
# assigns task numbers and tracks completed problems.  if log file exists,
# then assumes it needs to restart any outstanding jobs.
# V. Khera	5-OCT-1992
# $Id: TaskMaster.perl,v 1.6 1992/10/19 02:17:44 khera Exp $

require 'ctime.pl';

#
# assigned port for ScoreServer
#
$port = 6616;
$machine = '@@TMHOST@@';	# must run on specified machine
$imach = '@@INHOST@@';		# machine where `incoming' runs
# other private info
$logfile = '@@TMLOGFILE@@';
$savedir = '@@TMSTASH@@';

#
# some networking constants (values from header files)
#
$SecretCode = "42";		# used in private communication
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';	# used for pack()
$LOCK_EX = 2;
$LOCK_NB = 4;

$SIG{'PIPE'} = 'handlepipe';
sub handlepipe {
    print "Got a SIGPIPE! Client must have died.\nContinuing...\n";
}

$SIG{'INT'} = 'cleanup';
sub cleanup {
  print "\nExiting...\n";
  shutdown(S,2);
  exit(0);			# should close/flush all pipes/files
}

#
# first check to see if another TaskMaster is running (has a lock on the
# log file).  this only checks that there are no other servers running
# on *this* machine.
#
umask(077);			# make sure file is secure

chop($hostname = `hostname`);
die "Must run on $machine\n" unless $hostname eq $machine;

open(LOGFILE,">>$logfile") || die "Cannot open $logfile: $!\n";
flock(LOGFILE,$LOCK_EX | $LOCK_NB)
     || die "Could not lock $logfile, must be another TaskMaster running\n";

#
# create a socket on which to await connections
#
($name, $aliases, $proto) = getprotobyname('tcp');
$myconn = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");

socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!\n";
bind(S,$myconn) || die "bind: $!\n";
listen(S,5) || die "listen: $!\n";

# force flush on every write
select(NS); $| = 1;
select(S); $| = 1;
select(LOGFILE); $| = 1;
select(STDOUT); $| = 1;

print "TaskMaster running...\n";

$tasknumber = 0;
&restartjobs() unless -z $logfile;

# now loop forever until we get some requests

for(;;) {
  accept(NS,S) || die "accept: $!\n";

  chop($_ = <NS>);
  if ($_ eq $SecretCode) {
    print NS "OK\n";
  } else {
    print NS "GO AWAY\n";
    close(NS);
    next;
  }
  chop($cmd = <NS>);
  if ($cmd eq "NEW") {
    $tasknumber++;
    $scoreboard{$tasknumber} = time; # mark the time assigned
    print "assigned $tasknumber\n";
    print NS "$tasknumber\n";
    print LOGFILE "$tasknumber a\n"; # job assigned
  } elsif ($cmd eq "PRINT") {
    &showjobs();
  } elsif (($jobnum) = $cmd =~ m/DONE\s+(\d+)/) {
    delete $scoreboard{$jobnum};
    print "job $jobnum completed\n";
    print LOGFILE "$jobnum d\n"; # job done
    unlink("$savedir/$jobnum");	# no longer needed
  }
  close (NS);
}

# in case TaskMaster somhow died, we can restart it using the log file.
# TaskMaster assumes that all pending processes are also terminated, and
# restarts them. this is not a problem as we ignore duplicate score entries
# for the same job number.
sub restartjobs {
  local($jn,$status);
  open(F,$logfile) || die "Cannot read $logfile to restart jobs.\n";
  $tasknumber = 0;
  while (<F>) {
    ($jn,$status) = m/(\d+)\s([ad])/;
    if ($status eq 'a') {
      $tasknumber++;
      $scoreboard{$jn} = time;
    } elsif ($status eq 'd') {
      delete $scoreboard{$jn};
    }
  }
  close(F);
  foreach (keys %scoreboard) {
    print "***restarting job $_\n";
    # feed stored file to `incoming' program.
    system "rsh $imach incoming $_";
  }
}

# scan list of jobs and print the time that it was assigned.
sub showjobs {
  local($jn);
  &boldtext();
  print "Pending jobs: ",&ctime(time);
  &normtext();
  print "Job\tTime assigned\n";
  foreach $jn (sort { $a <=> $b; } (keys %scoreboard)) {
    print "$jn\t",&ctime($scoreboard{$jn});
  }
  &boldtext();
  print "End of list.\n";
  &normtext();
}

# set xterm character attributes
sub setxattr {
  local($val) = @_;
  local($|) = 1;
  print "\033[${val}m";
}

sub normtext { &setxattr(0); }
sub boldtext { &setxattr(1); }
--cut here--
--
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Vivek Khera, Gradual Student/Systems Guy  Department of Computer Science
Internet:   khera@cs.duke.edu             Box 90129
            (MIME mail accepted)          Durham, NC 27708-0129 (919)660-6528