ftp.cse.unsw.edu.au/2014.06.ftp.cse.unsw.edu.au.tar/ftp.cse.unsw.edu.au/pub/doc/languages/perl/nutshell/ch6/receptionist

Text File | 1992-10-18 | 4.9 KB | 231 lines

#!/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;
}