grady@fx.com (Steven Grady) (07/07/90)
Because I don't think I'll be spending much time hacking on this in the
near future, I figured I'd post this now. This is a version of inetd
written in perl. It parses BSD/SunOS-style inetd.conf files. It is
intended to allow individual (non-root type) users to run their own
servers -- a feature sorely lacking in standard versions. Other
than allowing you to specify your own configuration file, it supports
numbered services as well as names. It handles tcp (stream) and udp
(dgram), wait and nowait sockets. No RPC or internal services. The
two main problems are that it doesn't set the uid (trivial to add, but
I don't have the time or the need), and it can't set argv[0] (since
perl doesn't seem to let you do that). The closest I've come is to
replace argv[0] in the command with the specified server. This may or
may not be adequate.
I haven't spent time cleaning this up, so it could probably use quite
a bit of polishing. I encourage people to hack on it and improve it.
Here's a sample inetd.conf that I used when testing it
(Mind you, I had to remove comsat from the real inetd.conf
to test this completely.)
# Test for perl inetd
# Service socket-type protocol wait-st uid server-prog arguments
4444 stream tcp nowait grady /bin/cat
4455 stream tcp nowait grady /bin/csh -if
comsat dgram udp wait grady /tmp/comsat.pl
(BTW, comsat.pl would cat an audio file of a cow mooing to the
speaker of my sparcstation every time I got mail. My officemates
got annoyed pretty quick.. Also, I had to run it as root to bind
to the comsat port.)
You'll need to use makelib (in the perl distribution) to create
sys/socket.h and sys/errno.h.
Enjoy.
Steven
#!/usr/share/new/bin/perl
# Usage:
# inetd.pl [-d] [conf file]
# -d: debug
# conf file: configuration file (defaults to /etd/inetd.conf)
# Todo:
# Use uid
# Close all file descriptors before exec'ing
# statuses from exited children
# Problems:
# Can't have argv[0] different from server path
do 'sys/socket.h' || die "can't do sys/socket.h: $@";
do 'sys/errno.h' || die "can't do sys/errno.h: $@";
do 'getopts.pl' || die "couldn't find getopts.pl";
$SIG{'CHLD'} = 'reapchild';
$sockaddr = 'S n a4 x8';
$fileDescs = '';
do Getopts('d');
$debug = $opt_d;
($conf) = @ARGV;
$conf = "/etc/inetd.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;
push (@services, $service);
$sockettype{$service} = $sockettype;
$proto{$service} = $proto;
$waitstatus{$service} = $waitstatus;
$uid{$service} = $uid;
if ($commandlist[0] ne $server) {
$commandlist[0] = $server;
}
$command{$service} = join(' ', @commandlist);
}
close(conf);
# Begin each service in the conf file.
foreach $service (@services) {
&addBits(&startService($service));
}
# Main loop
$| = 1;
while (1) {
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);
}
}
}
# Start an individual service.
sub startService {
local($serviceName) = @_;
print "starting service $serviceName...\n" if ($debug);
$protoName = $proto{$serviceName};
($pname, $paliases, $proto) = getprotobyname($protoName);
die "Couldn't get proto by name $protoName: $!" if ($pname eq "");
if ($serviceName =~ /\d+/) {
$port = $serviceName;
} else {
print "Getting service from ($serviceName, $proto)\n" if $debug;
($name, $aliases, $port) = getservbyname($serviceName, $protoName);
die "Couldn't get by name $serviceName: $!" if ($name eq "");
}
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() bit arguments.
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");
# Only datagram sockets can be 'wait'.
local($wait) = ($waitstatus{$service} eq "wait" && (! $stream));
local($fd);
if ($wait) {
$fd = $service;
} else {
accept($fd, $service) || die "accept: $!";
}
print "Running: " . $command{$service} . "\n";
$pid = fork;
if (! $pid) {
select($fd);
$| = 1;
# I'd like to do `open(STDIN, "<&$fd")..', but that's not allowed.
$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;
exec split(' ', $command{$service});
} 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 the select mask.
sub reapchild {
while (1) {
print "Reaping child\n";
$pid = wait;
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;
}lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (07/10/90)
In article <1990Jul7.030248.11160@fxgrp.fx.com> grady@postgres.berkeley.edu writes:
: Because I don't think I'll be spending much time hacking on this in the
: near future, I figured I'd post this now. This is a version of inetd
: written in perl. It parses BSD/SunOS-style inetd.conf files. It is
: intended to allow individual (non-root type) users to run their own
: servers -- a feature sorely lacking in standard versions. Other
: than allowing you to specify your own configuration file, it supports
: numbered services as well as names. It handles tcp (stream) and udp
: (dgram), wait and nowait sockets. No RPC or internal services. The
: two main problems are that it doesn't set the uid (trivial to add, but
: I don't have the time or the need), and it can't set argv[0] (since
: perl doesn't seem to let you do that). The closest I've come is to
: replace argv[0] in the command with the specified server. This may or
: may not be adequate.
From the manual:
If you don't really want to execute the first argu-
ment, but want to lie to the program you are execut-
ing about its own name, you can specify the program
you actually want to run by assigning that to a
variable and putting the name of the variable in
front of the LIST without a comma. (This always
forces interpretation of the LIST as a multi-valued
list, even if there is only a single scalar in the
list.) Example:
$shell = '/bin/csh';
exec $shell '-sh'; # pretend it's a login shell
So, in your case, instead of
exec split(' ', $command{$service});
you want to say
($realname,@args) = split(' ', $command{$service});
exec $realname @args;
and of course add the extra field back into your inetd.conf.
The reason for this weird usage is that it's actually just piggy-backed
onto the syntax that lets you say
print $filehandle LIST;
It's a little odd but it helps keep the size of the yacc file within reason.
Well, closer to being within reason, anyway.
Larry