#!/usr/bin/env perl

# Copyright (c) 2003-2023 Vincent Lefevre <vincent@vinc17.net>.
# Written for and used in the SPACES project at LORIA / INRIA Lorraine and
# the Arenaire and AriC INRIA project-teams at LIP, ENS-Lyon, France.

# This program is free software; you may redistribute it
# and/or modify it under the same terms as Perl itself.

# History:
#   * Written in 2003-12.
#   * Various changes in 2006.
#   * Minor changes in 2007, 2012, 2019, and 2023.

use strict;
use integer;
use POSIX;
use Fcntl qw(:DEFAULT :flock);

### Init #########################################################

my ($proc,$vers) = '$Id: idlexec 163646 2023-11-29 15:56:20Z vinc17/cventin $'
  =~ /^.Id: (\S+) (\d+ \d{4}-\d\d-\d\d \d\d:\d\d:\d\d)Z / or die;

my $Usage = <<EOF;
Usage: $proc
       $proc [-n] <nice> <command> ...
       $proc -g <group>
EOF

my $debug    = $ENV{'IDLEXECDEBUG'};
my $idledir  = $ENV{'IDLEXECDIR'} if -d $ENV{'IDLEXECDIR'};
my $idlelock = $ENV{'IDLEXECLOCK'};  # for the daemon only.
my $idletime = $ENV{'IDLEXECTIME'} || 600;
my $idlestep = $ENV{'IDLEXECSTEP'} || 10;
my $idlegroup = '/tmp/.idlegroup';

my $first = shift;

if ($first eq '-g')
  {
    @ARGV == 1 or die $Usage;
    -d $idledir or die "$proc: \$IDLEXECDIR must be a directory\n";
    symlink "$idledir/$ARGV[0]", $idlegroup
      or die "$proc: symlink failed: $!\n";
    exit;
  }

### Routines #####################################################

my @state = qw(running stopped);
my $stopped = 0;
my ($killed,$pid);

sub outdbg ($)
  {
    print STDERR POSIX::strftime("[%Y-%m-%d %T]", localtime), " $_[0]\n"
      if $debug;
  }

sub killgrp ($)
  {
    outdbg "sending SIG$_[0] to -$pid...";
    my $ret = kill $_[0], -$pid or outdbg "failed ($!)";
    return $ret;
  }

sub sendcont ()
  {
    killgrp 'CONT' and $stopped = 0;
  }

sub sendstop ()
  {
    killgrp 'STOP' and $stopped = 1;
  }

sub sendsig ($)
  {
    killgrp $_[0];
    $killed = 1;
    # The signal cannot be delivered if the process is stopped.
    sendcont;
  }

sub setalarm ($)
  {
    outdbg "alarm $_[0] (process $state[$stopped])";
    alarm $_[0];
  }

sub daemon_exit
  {
    if (defined $idlelock)
      {
        unlink $idlelock or die "$proc: can't remove lock file\n$!\n";
      }
    exit;
  }

### Main code ####################################################

outdbg "$proc $vers";

if (!defined $first)
  {
    if (defined $idlelock)
      {
        substr($idlelock, 0, 1) eq '/' or $! = 1,
          die "$proc: \$IDLEXECLOCK must be an absolute pathname\n";
        open LOCK, ">$idlelock" or die "$proc: can't create lock file\n$!\n";
        flock LOCK, LOCK_EX | LOCK_NB or die "$proc: already running\n$!\n";
      }
    $SIG{'HUP'}  = \&daemon_exit;
    $SIG{'INT'}  = \&daemon_exit;
    $SIG{'QUIT'} = \&daemon_exit;
    $SIG{'TERM'} = \&daemon_exit;
    # Useful if the cwd is on a NFS filesystem, so that it is not kept busy.
    chdir '/';
    my ($dir) = $idlegroup =~ m!^(.*/)!;
    my $oldt = &maxatime;
    while (my $file = readlink $idlegroup)
      {
        substr($file, 0, 1) eq '/' or $file = "$dir$file";
        $file =~ m!^\Q$idledir\E/[^/]+$! or exit;  # for more security
        my $t = &maxatime;
        if ($t > $oldt)
          {
            $oldt = $t;
            outdbg "changing the atime and mtime of $file";
            utime undef, undef, $file;
          }
        sleep $idlestep;
      }
    &daemon_exit;
  }

# Use the -n option to redirect the standard file handles of idlexec
# from/to /dev/null. This is useful when idlexec is executed via SSH,
# so that the SSH connection will not block. The file descriptors of
# the controlled process are not affected by these redirections to
# allow this process to use the SSH channel before entering a loop,
# for instance.
# Note: the name of this option comes from the ssh option -n, which
# is a bit similar (but here, all the standard file descriptors are
# redirected).
my $fdr = $first eq '-n'
  and $first = shift;

my ($nice) = $first =~ /^-?(\d+)$/ and @ARGV or die $Usage;

$pid = fork;
defined $pid or die "$proc: can't fork: $!\n";
unless ($pid)  # child
  {
    POSIX::nice($nice);
    POSIX::setsid != -1 or die "$proc: setsid failed: $!\n";
    exec @ARGV;
    die "$proc: exec failed: $!\n";
  }

if ($fdr)
  {
    open STDIN, '/dev/null';
    open STDOUT, '>', '/dev/null';
    open STDERR, '>', '/dev/null';
  }

my $ctrl;
if ($ENV{'HOST'} =~ /^([-a-z0-9]+)/ and open HOSTS, '<', "$idledir/hosts")
  {
    my $host = $1;
    while (<HOSTS>)
      { /^\Q$host\E\s/ and $ctrl = 1, last; }
    close HOSTS;
  }
else
  { $ctrl = 1; }
$ctrl and outdbg "process $pid will be controlled by idlexec";

# Useful if the cwd is on a NFS filesystem, so that it is not kept busy.
chdir '/';

$SIG{'ALRM'} = sub { };
$SIG{'CHLD'} = sub { };  # to interrupt pause(2) when the child terminates
$SIG{'INT'}  = sub { sendsig 'INT' };
$SIG{'TERM'} = sub { sendsig 'TERM' };
while (outdbg('waitpid called'), waitpid($pid, &WNOHANG) != $pid)
  {
    outdbg 'waitpid(2) ended';
    if ($ctrl && ! $killed)
      {
        my $t = &maxatime;
        my $g = (stat $idlegroup)[9];
        my $diff = $idletime - (time - ($t > $g ? $t : $g));
        # Note: If the kill fails, one sets the alarm to 2 seconds.
        # This may happen in particular when a SIGSTOP is sent at the
        # very beginning, because the child did not have the time to
        # do its setsid.
        if ($diff > 0)
          {
            $stopped or sendstop;
            setalarm($stopped ? $diff : 2);
          }
        else
          {
            $stopped and sendcont;
            setalarm($stopped ? 2 : $idlestep);
          }
      }
    POSIX::pause;
    outdbg 'pause(2) ended';
  }

WIFSIGNALED($?)
  and print STDERR "Process $pid killed by signal ", WTERMSIG($?), "\n";
exit(WIFEXITED($?) && WEXITSTATUS($?));

sub maxatime
  {
    my $t = (stat '/dev/mouse')[8];
    opendir DEV, '/dev' or return $t;
    while (defined($_ = readdir DEV))
      {
        /^tty\d+$/ or next;
        my $u = (stat "/dev/$_")[8];
        $u > $t and $t = $u;
      }
    closedir DEV;
    return $t;
  }

# End of idlexec