#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2020 University of Utah and the Flux Group.
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
use English;

# Drag in path stuff so we can find emulab stuff.
BEGIN { require "/etc/emulab/paths.pm"; import emulabpaths; }

#
# Prototypes.
#
sub fatal($);
sub background();
sub safe_startcmdstatus($;$$);

#
# Turn off line buffering on output
#
$| = 1;

#
# Load the OS independent support library. It will load the OS dependent
# library and initialize itself. 
#
use libsetup;

# Sigh, no POSIX module on the MFS. 
if (!MFS()) {
    require POSIX;
    import POSIX qw(setsid);
}

# Locals;
my $logname;
my $logtemplate;

#
# Get the config parameters so we can open up a log file in the proper
# location. See below.
#
if (JAILED() || GENVNODE() || PLAB() || SHADOW()) {
    $logtemplate = "$VARDIR/logs/runlog.XXXXXX";
}
else {
    my ($pid, $eid, $vname) = check_nickname();

    if (!defined($eid)) {
	fatal("Could not determine pid/eid");
    }
    my $piddir = PROJDIR();
    if (! -e "$piddir/logs") {
	$logtemplate = "$VARDIR/logs/runlog.XXXXXX";
    }
    else {
	$logtemplate = "$piddir/logs/runlog-$eid.$vname.XXXXXX";
    }
}

#
# Disconnect from the caller (at daemon).
#
if (background()) {
    #
    # Parent exits normally
    #
    exit 0;
}

#
# Delay to allow the boot to complete. 
# We are fired off last thing, so the boot should be pretty much done.
#
sleep(5);

#
# Open up the command file, which tells us what to do.
#
open(CMD, TMSTARTUPCMD) or
    fatal("Could not open " . TMSTARTUPCMD . ": $!");

my $runcmd;
my $login;

while (<CMD>) {
    if ($_ =~ /^CMD=\'(.*)\' UID=(.*)$/) {
	$runcmd = $1;
	$login  = $2;
    }
}

if (!defined($runcmd) || !defined($login)) {
    fatal(TMSTARTUPCMD . " not in proper format!");
}
(undef,undef,$uid,$gid,undef,undef,undef,$homedir) = getpwnam($login) or
    fatal("Could not determine UID for $login");

chown($uid, $gid, $logname) or
    fatal("Could not chown $logname to $uid/$gid: $!\n");

# Convenient.
$ENV{"HOME"} = $homedir;
$ENV{"USER"} = $login;

#
# Fork a child so that we can run the command as the user and wait for it.
# 
$mypid = fork();
if ($mypid) {
    #
    # Parent waits for child.
    #
    waitpid($mypid, 0);

    $stat = $? >> 8;
}
else {
    #
    # The child becomes the user and runs the command. Maybe cleaner to
    # just use sudo instead, so we get the entire group list of the
    # target user?
    #
    my $glist = `id -G $login`;
    chomp($glist);
    
    $GID  = $gid + 0;
    $EGID = "$gid $glist";
    $EUID = $UID = $uid;

    exec($runcmd);
    exit($!);
}

print STDOUT "$runcmd returned $stat\n";

#
# Use the TMCC to tell the TMCD what the exit status was.
#
safe_startcmdstatus($stat);
exit(0);

sub safe_startcmdstatus($;$$)
{
    my ($stat,$retries,$interval) = @_;
    if (!defined($retries)) {
	$retries = -1;
    }
    if (!defined($interval)) {
	$interval = 4;
    }

    my $tries = 0;
    my $ret = -1;
    while ($retries <= 0 || ++$tries <= $retries) {
	print "*** retrying startcmdstatus($stat) (code $ret)\n"
	    if ($tries > 1);
	($ret,) = startcmdstatus($stat,5);
	if ($ret == 0) {
	    print "*** succeeded sending startcmdstatus after $tries tries\n"
		if ($tries > 1);
	    return 0;
	}
	sleep($interval);
    }
    print "*** failed to send startcmdstatus after ".($tries-1)." tries!\n";
    return $ret;
}

sub fatal($)
{
    my($mesg) = $_[0];

    print STDOUT "$mesg\n";

    #
    # Use the TMCC to tell the TMCD that we screwed the pooch.
    #
    # We do use a retry strategy, but it is limited; we cannot block our
    # caller indefinitely if we are not in the background.  We will wait
    # for approximately 8 * (5 + 2) seconds, because
    # safe_startcmdstatus calls tmcc with timeout 5.
    #
    safe_startcmdstatus(666,8,2);
    exit(-1);
}

#
# Put ourselves into the background so that caller sees immediate response.
# 
sub background()
{
    # Turn off line buffering on output
    #
    $| = 1;

    $mypid = fork();
    if ($mypid) {
	return $mypid;
    }
    setsid()
	if (!MFS());

    #
    # We have to disconnect from the caller by redirecting both STDIN and
    # STDOUT away from the pipe. Otherwise the caller (the web server) will
    # continue to wait even though the parent has exited. 
    #
    open(STDIN, "< /dev/null") or
	die("opening /dev/null for STDIN: $!");

    #
    # Create a temporary name for a log file and untaint it.
    #
    $logname = `mktemp $logtemplate`;
    if ($?) {
    	die("mktemp failed!");
    }

    # Note different taint check (allow /).
    if ($logname =~ /^([-\@\w.\/]+)$/) {
	$logname = $1;
    } else {
	die "Bad data in $logname";
    }

    chmod(0644, $logname);
    open(STDERR, ">> $logname") or die("opening $logname for STDERR: $!");
    open(STDOUT, ">> $logname") or die("opening $logname for STDOUT: $!");

    return 0;
}
