#/usr/bin/perl

# Usage:
#       receptionist [-d] [conf file]
#       -d: debug
#       conf file: configuration file
#               (default file is /etc/recept.conf)

require 'sys/socket.ph';
require 'sys/errno.ph';
require 'sys/wait.ph';
require 'getopts.pl';

$SIG{'CHLD'} = 'reapchild';
$WNOHANG = defined &WNOHANG ? &WNOHANG : 1;

$sockaddr = 'S n a4 x8';
$fileDescs = '';
do Getopts('d');
$debug = $opt_d;

($conf) = @ARGV;
$conf = "/etc/recept.conf" unless $conf;

	# Read the entries from the configuration file.

open(CONF, "<$conf") || die "open: $conf: $!";
while (<CONF>) {
    next if (/^#/ || /^$/);
    ($service, $sockettype, $proto, 
	    $waitstatus, $uid, $server, @commandlist) = split;
    $tmp = (getpwnam($uid))[2];
    $uid = $tmp if defined $tmp;
    $service .= "/$proto";
    push (@services, $service);
    $sockettype{$service} = $sockettype;
    $proto{$service} = $proto;
    $waitstatus{$service} = $waitstatus;
    $uid{$service} = $uid;
    $server{$service} = $server;
    $commandlist[0] = $server unless @commandlist;
    $command{$service} = "@commandlist";
}
close(CONF);

	# Begin each service in the conf file.

foreach $service (@services) {
    &addBits(&startService($service));
}

	# Main loop (never exits)

$| = 1;
for (;;) {
    print "fileDescs:  ", &printVec($fileDescs), "\n"
	if $debug;
    $nfound = select($rout = $fileDescs, undef, undef, undef);
    if ($nfound == -1) {
	if ($! == &EINTR) {
	    next;
	}
	else {
	    die "select: $!";
	}
    }

    print "rout:  ", &printVec($rout), ", " if $debug;
    foreach $service (@services) {
	if (vec($rout, $fileno{$service}, 1)) {
	    print "$service ready\n" if $debug;
	    &spawn($service);
	}
    }
}
die "Shouldn't ever get here!!!  Stopped";

	# Start an individual service.

sub startService {
    local($serviceName) = @_;

    print "starting service $serviceName...\n" if ($debug);

    $protoName = $proto{$serviceName};
    local($serv) = split(m#/#, $serviceName);
    (($pname, $paliases, $proto) = getprotobyname($protoName))
      || die "Couldn't get proto by name $protoName: $!";

    if ($serviceName =~ /\d+/) {
	$port = $serviceName;
    }
    else {
	print "Getting service from ($serv, $proto)\n"
	    if $debug;
	(($name, $aliases, $port)
	    = getservbyname($serv, $protoName))
	  || die "Couldn't get by name $serviceName: $!";
    }

    if ($sockettype{$serviceName} eq "stream") {
	$socktype = &SOCK_STREAM;
    }
    elsif ($sockettype{$serviceName} eq "dgram") {
	$socktype = &SOCK_DGRAM;
    }
    else {
	$socktype = -1;
    }

    $name = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");
    socket($service, &PF_INET, $socktype, $proto) || 
	    die "socket ($serviceName): $!";
    print "binding to port $port.\n" if $debug;
    bind($service, $name) || die "bind($serviceName): $!";
    if ($socktype == &SOCK_STREAM) {
	listen($service, 10) || die "listen($serviceName): $!";
    }
    $fileno{$service} = fileno($service);
}

	# Utility functions to deal with select() bits.

sub addBits {
    local($fd) = @_;
    vec($fileDescs, $fd, 1) = 1;
}

sub delBits {
    local($fd) = @_;
    vec($fileDescs, $fd, 1) = 0;
}

	# Start a new server.

sub spawn {
    local($service) = @_;
    local($stream) = ($sockettype{$service} eq "stream");
    local($fd);

    # Only datagram sockets can be 'wait'.

    local($wait)
	= ($waitstatus{$service} eq "wait" && (! $stream));

    if ($wait) {
	$fd = $service;
    }
    else {
	accept($fd, $service) || die "accept: $!";
    }

    print "Running: ", $command{$service}, "\n";
    for (;;) {
	$pid = fork;
	last if defined $pid;
	sleep 5;
    }
    if (! $pid) {
	select($fd);
	$| = 1;

	$inputStr = "<&" . fileno($fd);
	$outputStr = ">&" . fileno($fd);

	close(STDIN);
	open(STDIN, $inputStr) || die "open STDIN: $!";

	close(STDOUT);
	open(STDOUT, $outputStr) || die "open STDOUT: $!";

	# Die can't print an error, since STDERR is closed.

	close(STDERR);
	open(STDERR, $outputStr) || die;

	# Change uid, even on machines that only do setuid().

	$uid = $uid{$service};
	($<, $>) = ($uid,$uid) unless $>;

	# Insulate against any signals coming from above.

	setpgrp(0,$$);

	# Exec the daemon, lying to it about its name.
	#  (Is it wrong to lie to a daemon?  Beats me.)

	$realname = $server{$service};
	exec $realname split(' ', $command{$service});
	exit 255;
    }
    else {
	if ($wait) {
	    $serviceof{$pid} = $service;
	    &delBits($fileno{$service});
	}
	else {
	    close($fd);
	}
    }
}

	# When a child dies, if it's a "wait" server, put the
	# file descriptor for the child back in select mask.

sub reapchild {
    while (1) {
	print "Reaping child\n";
	$pid = waitpid(-1,$WNOHANG);
	last if ($pid < 1);
	$service = $serviceof{$pid};
	last unless $service;
	print "$service restored\n" if $debug;
	&addBits($fileno{$service});
    }
}

	# Debugging subroutine.

sub printVec {
    local($v) = @_;
    local($i, $result);

    for ($i = (8*length($v)) - 1; $i >= 0; $i--) {
	$result .= (vec($v, $i, 1)) ? "1" : "0";
    }
    $result;
}