I don't know if all of you whould consider this to be as cool and most importantly as ethical as I do, but I'll tell you in advance that I have the approval of the sysadmins of the cluster of machines I'm currently running this on...
read directly the code to find what it does:
#!/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__
Note: the name is hidden to protect the foolish!
UPDATE: Due to the reactions to this post, here it is: yes, this program is an harassing project aimed at putting a machine under heavy load when a (or a few) certain user(s) is(are) logged and no other one is. The user under consideration is by vast consensus considered an arrogant, unbearable idiot.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|