use warnings;
use strict;

use IO::Pty;
use IO::Select;
use POSIX ":sys_wait_h";


if (@ARGV < 2)
{
    die "Arguments: logfile executable ...";
}

exit if (fork);

my $logfile;

POSIX::setsid() or die "Can't start a new session: $!\n";

sub signal_handler
{
    my $signame = shift;
    logMsg($logfile, "ERROR: caught signal $signame, exiting.");
}

$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;

sub terminate
{
    my $pid = shift;
    my $signal = shift;

    kill $signal, $pid;
    my ($r, $starttime);

    $starttime = time;

    do
    {
        $r = waitpid($pid, &WNOHANG);
    }
    until ($r == $pid || (time - $starttime > 5));

    if ($r == $pid)
    {
        return 1;
    }
    else
    {
        return undef;
    }
}

sub logMsg
{
    my $fh = shift;
    my $msg = shift;
    my $t = scalar localtime;
    my $oldfh = select($fh);
    
    $|=1;
    print $fh "$t [$$]: $msg\n";
    select($oldfh);
}
    


my $logfileName = shift @ARGV;
$logfile = new IO::File ">>$logfileName" || die "Unable to open logfil
+e $logfileName";

while (1)
{
    my $pty = new IO::Pty;
    my ($readerr, $writeerr);
    pipe($readerr, $writeerr) || die "pipe $!\n";

    if (my $pid = fork)
    {
        close($writeerr);
        my $select = new IO::Select;
        $select->add($pty);
        $select->add($readerr);

        my $run = 1;
        my $runtime = time;
        

        while ($run)
        {
            foreach my $fh ($select->can_read(0.25))
            {
                my $buf;
                if (sysread($fh, $buf, 4096))
                {
                    logMsg($logfile, "child reports \"$buf\"");
                }
            }

            my $r = waitpid($pid, &WNOHANG);
            if ($r == $pid)
            {
                logMsg($logfile, "Warning: $pid died unexpectedly, res
+tarting.\n");
                $run = 0;
            }
            else
            {
                my @times = localtime(time);
                if ($times[2] == 7 && $times[1] == 0 && ($times[0] > 0
+ && $times[0] < 05))
                {
                    sleep 5;

                    unless (terminate($pid, 15))
                    {
                        unless (terminate($pid, 9))
                        {
                            die "Unable to kill process $pid with SIGT
+ERM or SIGKILL!";
                        }
                        else
                        {
                            logMsg($logfile, "Warning: had to resort t
+o SIGKILL to remove $pid.\n");
                        }
                    }
                    else
                    {
                        logMsg($logfile, "Info: killed $pid with SIGTE
+RM.\n");
                    }
                    $run = 0;
                }
            }
        }

        close($readerr);
        close($pty);
    }
    else
    {
        logMsg($logfile, "Info: starting " . join(" ", @ARGV));
        close($readerr);
        my $slave = $pty->slave();
        close $pty;
        $slave->set_raw();
        
        open(STDOUT, ">&" . $slave->fileno);
        open(STDERR, ">&" . $writeerr->fileno);
        close($slave);
        
        exec(@ARGV) || die "exec: $!\n";
    }
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.