Adding upstream version 20221122+ds.upstream/20221122+dsupstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 1173 insertions, 0 deletions

diff --git a/src/niceload b/src/niceload
new file mode 100755
index 0000000..2e59aee
--- /dev/null
+++ b/src/niceload
@@ -0,0 +1,1173 @@
+#!/usr/bin/perl -w
+
+# Copyright (C) 2004-2010 Ole Tange, http://ole.tange.dk
+#
+# Copyright (C) 2010-2022 Ole Tange, http://ole.tange.dk and
+# Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program 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
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see <http://www.gnu.org/licenses/>
+# or write to the Free Software Foundation, Inc., 51 Franklin St,
+# Fifth Floor, Boston, MA 02110-1301 USA
+#
+# SPDX-FileCopyrightText: 2021-2022 Ole Tange, http://ole.tange.dk and Free Software and Foundation, Inc.
+# SPDX-License-Identifier: GPL-3.0-or-later
+
+use strict;
+use Getopt::Long;
+$Global::progname="niceload";
+$Global::version = 20221122;
+Getopt::Long::Configure("bundling","require_order");
+get_options_from_array(\@ARGV) || die_usage();
+if($opt::version) {
+    version();
+    exit 0;
+}
+if($opt::help) {
+    help();
+    exit 0;
+}
+if($opt::factor and $opt::suspend) {
+    # You cannot have --suspend and --factor
+    help();
+    exit;
+}
+
+if(not (defined $opt::start_io or defined $opt::run_io
+	or defined $opt::start_load or defined $opt::run_load
+	or defined $opt::start_mem or defined $opt::run_mem
+	or defined $opt::start_noswap or defined $opt::run_noswap
+	or defined $opt::io or defined $opt::load
+	or defined $opt::mem or defined $opt::noswap)) {
+    # Default is --runload=1
+    $opt::run_load = 1;
+}
+
+if(not defined $opt::start_io) { $opt::start_io = $opt::io; }
+if(not defined $opt::run_io) { $opt::run_io = $opt::io; }
+if(not defined $opt::start_load) { $opt::start_load = $opt::load; }
+if(not defined $opt::run_load) { $opt::run_load = $opt::load; }
+if(not defined $opt::start_mem) { $opt::start_mem = $opt::mem; }
+if(not defined $opt::run_mem) { $opt::run_mem = $opt::mem; }
+if(not defined $opt::start_noswap) { $opt::start_noswap = $opt::noswap; }
+if(not defined $opt::run_noswap) { $opt::run_noswap = $opt::noswap; }
+
+if(defined $opt::load) { multiply_binary_prefix($opt::load); }
+if(defined $opt::baseline) { collect_net_baseline(); }
+
+my $limit = Limit->new();
+my $process = Process->new($opt::nice,@ARGV);
+$::exitstatus = 0;
+if(@opt::prg) {
+    # Find all pids of prg
+    my($children_of, $parent_of, $name_of) = pid_table();
+    my @exact_name_pids;
+    my @substr_name_pids;
+    for my $name (@opt::prg) {
+	push(@exact_name_pids,
+	     grep { index($name_of->{$_},$name) == 0 and $_ } keys %$name_of);
+	push(@substr_name_pids,
+	     grep { index($name_of->{$_},$name) != -1 and $_ } keys %$name_of);
+    }
+    # Remove current pid
+    @exact_name_pids = grep { $_ != $$ } @exact_name_pids;
+    @substr_name_pids = grep { $_ != $$ } @substr_name_pids;
+    my @pids;
+    if(@exact_name_pids) {
+	@pids = @exact_name_pids;
+    } elsif(@substr_name_pids) {
+	warning("@opt::prg no exact matches. Using substrings.");
+	my %name_pids;
+	for(sort @substr_name_pids) {
+	    # If the process has run for long, then time column will
+	    # enter the name, so remove leading digits
+	    $name_of->{$_} =~ s/^\d+ //;
+	    # Remove arguments
+	    $name_of->{$_} =~ s/ .*//;
+	    push @{$name_pids{$name_of->{$_}}},$_;
+	}
+	warning("Niceloading",
+		map { "$_ (".(join" ",sort @{$name_pids{$_}}).")" } keys %name_pids
+		);
+	@pids = @substr_name_pids;
+    } else {
+	error("@opt::prg no matches.");
+	exit(1);
+    }
+    $process->set_pid(@pids);
+    $::resume_process = $process;
+    $SIG{TERM} = $SIG{INT} = \&resume;
+} elsif(@opt::pid) {
+    # Support --pid 3567,25678
+    @opt::pid = map { split /,/, $_ } @opt::pid;
+    $process->set_pid(@opt::pid);
+    $::resume_process = $process;
+    $SIG{TERM} = $SIG{INT} = \&resume;
+} elsif (@ARGV) {
+    # Wait until limit is below start_limit and run_limit
+    while($limit->over_start_limit()
+	  or
+	  ($limit->hard() and $limit->over_run_limit())) {
+	$limit->sleep_for_recheck();
+    }
+    $process->start();
+}
+
+while($process->is_alive()) {
+    if($limit->over_run_limit()) {
+	$process->suspend();
+	$limit->sleep_for_recheck();
+	if(not $limit->hard()) {
+	    $process->resume();
+	    $limit->sleep_while_running();
+	}
+    } else {
+	$process->resume();
+	$limit->sleep_while_running();
+    }
+}
+
+exit($::exitstatus);
+
+{
+    my %pid_parentpid_cmd;
+
+    sub pid_table {
+	# Returns:
+	#   %children_of = { pid -> children of pid }
+	#   %parent_of = { pid -> pid of parent }
+	#   %name_of = { pid -> commandname }
+
+       	if(not %pid_parentpid_cmd) {
+	    # Filter for SysV-style `ps`
+	    my $sysv = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
+		q(s/^.{$s}//; print "@F[1,2] $_"' );
+	    # Crazy msys: ' is not accepted on the cmd line, but " are treated as '
+	    my $msys = q( ps -ef | perl -ane "1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
+		q(s/^.{$s}//; print qq{@F[1,2] $_}" );
+	    # BSD-style `ps`
+	    my $bsd = q(ps -o pid,ppid,command -ax);
+	    %pid_parentpid_cmd =
+	    (
+	     'aix' => $sysv,
+	     'cygwin' => $sysv,
+	     'darwin' => $bsd,
+	     'dec_osf' => $sysv,
+	     'dragonfly' => $bsd,
+	     'freebsd' => $bsd,
+	     'gnu' => $sysv,
+	     'hpux' => $sysv,
+	     'linux' => $sysv,
+	     'mirbsd' => $bsd,
+	     'msys' => $msys,
+	     'MSWin32' => $sysv,
+	     'netbsd' => $bsd,
+	     'nto' => $sysv,
+	     'openbsd' => $bsd,
+	     'solaris' => $sysv,
+	     'svr5' => $sysv,
+	     'syllable' => "echo ps not supported",
+	    );
+	}
+	$pid_parentpid_cmd{$^O} or ::die_bug("pid_parentpid_cmd for $^O missing");
+
+	my (@pidtable,%parent_of,%children_of,%name_of);
+	# Table with pid -> children of pid
+	@pidtable = `$pid_parentpid_cmd{$^O}`;
+	my $p=$$;
+	for (@pidtable) {
+	    # must match: 24436 21224 busybox ash
+	    # must match: 24436 21224 <<empty on MacOSX running cubase>>
+	    #   or: perl -e 'while($0=" "){}'
+	    if(/^\s*(\S+)\s+(\S+)\s+(\S+.*)/
+	       or
+	       $^O eq "darwin" and /^\s*(\S+)\s+(\S+)\s+()$/) {
+		$parent_of{$1} = $2;
+		push @{$children_of{$2}}, $1;
+		$name_of{$1} = $3;
+	    } else {
+		::die_bug("pidtable format: $_");
+	    }
+	}
+	return(\%children_of, \%parent_of, \%name_of);
+    }
+}
+
+sub resume {
+    $::resume_process->resume();
+    exit(0);
+}
+
+sub status {
+    my @w = @_;
+    my $fh = *STDERR;
+    print $fh @w;
+    flush $fh;
+}
+
+sub warning {
+    my @w = @_;
+    my $prog = $Global::progname || "niceload";
+    status(map { ($prog, ": Warning: ", $_, "\n"); } @w);
+}
+
+sub error {
+    my @w = @_;
+    my $prog = $Global::progname || "niceload";
+    status(map { ($prog, ": Error: ", $_, "\n"); } @w);
+}
+
+sub uniq {
+    # Remove duplicates and return unique values
+    return keys %{{ map { $_ => 1 } @_ }};
+}
+
+sub multiply_binary_prefix {
+    # Evalualte numbers with binary prefix
+    # k=10^3, m=10^6, g=10^9, t=10^12, p=10^15, e=10^18, z=10^21, y=10^24
+    # K=2^10, M=2^20, G=2^30, T=2^40, P=2^50, E=2^70, Z=2^80, Y=2^80
+    # Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80
+    # ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80
+    # 13G = 13*1024*1024*1024 = 13958643712
+    my $s = shift;
+    $s =~ s/k/*1000/g;
+    $s =~ s/M/*1000*1000/g;
+    $s =~ s/G/*1000*1000*1000/g;
+    $s =~ s/T/*1000*1000*1000*1000/g;
+    $s =~ s/P/*1000*1000*1000*1000*1000/g;
+    $s =~ s/E/*1000*1000*1000*1000*1000*1000/g;
+    $s =~ s/Z/*1000*1000*1000*1000*1000*1000*1000/g;
+    $s =~ s/Y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
+    $s =~ s/X/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;
+
+    $s =~ s/Ki?/*1024/gi;
+    $s =~ s/Mi?/*1024*1024/gi;
+    $s =~ s/Gi?/*1024*1024*1024/gi;
+    $s =~ s/Ti?/*1024*1024*1024*1024/gi;
+    $s =~ s/Pi?/*1024*1024*1024*1024*1024/gi;
+    $s =~ s/Ei?/*1024*1024*1024*1024*1024*1024/gi;
+    $s =~ s/Zi?/*1024*1024*1024*1024*1024*1024*1024/gi;
+    $s =~ s/Yi?/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
+    $s =~ s/Xi?/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;
+    $s = eval $s;
+    return $s;
+}
+
+sub get_options_from_array {
+    # Run GetOptions on @array
+    # Returns:
+    #   true if parsing worked
+    #   false if parsing failed
+    #   @array is changed
+    my $array_ref = shift;
+    # A bit of shuffling of @ARGV needed as GetOptionsFromArray is not
+    # supported everywhere
+    my @save_argv;
+    my $this_is_ARGV = (\@::ARGV == $array_ref);
+    if(not $this_is_ARGV) {
+	@save_argv = @::ARGV;
+	@::ARGV = @{$array_ref};
+    }
+    my @retval = GetOptions
+	("debug|D" => \$opt::debug,
+	 "factor|f=s" => \$opt::factor,
+	 "hard|H" => \$opt::hard,
+	 "soft|S" => \$opt::soft,
+	 "sensor=s" => \$opt::sensor,
+
+	 "si|sio|startio|start-io=s" => \$opt::start_io,
+	 "ri|rio|runio|run-io=s" => \$opt::run_io,
+	 "io|I=s" => \$opt::io,
+
+	 "sl|startload|start-load=s" => \$opt::start_load,
+	 "rl|runload|run-load=s" => \$opt::run_load,
+	 "load|L|l=s" => \$opt::load,
+
+	 "sm|startmem|start-mem=s" => \$opt::start_mem,
+	 "rm|runmem|run-mem=s" => \$opt::run_mem,
+	 "mem|M=s" => \$opt::mem,
+
+	 "sn|startnoswap|start-noswap|start-no-swap" => \$opt::start_noswap,
+	 "rn|runnoswap|run-noswap|run-no-swap" => \$opt::run_noswap,
+	 "noswap|N" => \$opt::noswap,
+
+	 "battery|B" => \$opt::battery,
+	 "net" => \$opt::net,
+	 "nethops=i" => \$opt::nethops,
+	 "baseline" => \$opt::baseline,
+
+	 "nice|n=i" => \$opt::nice,
+	 "program|prg=s" => \@opt::prg,
+	 "process|pid|p=s" => \@opt::pid,
+	 "suspend|s=s" => \$opt::suspend,
+	 "recheck|t=s" => \$opt::recheck,
+	 "quote|q" => \$opt::quote,
+	 "help|h" => \$opt::help,
+	 "verbose|v" => \$opt::verbose,
+	 "version|V" => \$opt::version,
+	);
+    if($opt::battery) {
+	# niceload -l -1 --sensor \
+	#   'cat /sys/class/power_supply/BAT0/status \
+	#    /proc/acpi/battery/BAT0/state 2>/dev/null |
+	#    grep -i -q discharging; echo $?'
+	$opt::sensor = ('cat /sys/class/power_supply/BAT0/status '.
+			'/proc/acpi/battery/BAT0/state 2>/dev/null | '.
+			'grep -i -q discharging; echo $?');
+	$opt::load = -1;
+    }
+    if($opt::net) {
+	$opt::nethops ||= 3;
+    }
+    if($opt::nethops) {
+	# niceload -l 0.01 --sensor 'netsensor_script'
+	$opt::sensor = netsensor_script($opt::nethops);
+	$opt::load ||= 0.01;
+    }
+    if(not $this_is_ARGV) {
+	@{$array_ref} = @::ARGV;
+	@::ARGV = @save_argv;
+    }
+    return @retval;
+}
+
+sub shell_quote_scalar {
+    # Quote for other shells
+    my $a = $_[0];
+    if(defined $a) {
+	# zsh wants '=' quoted
+	# Solaris sh wants ^ quoted.
+	# $a =~ s/([\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\>\<\~\|\; \"\!\$\&\'\202-\377])/\\$1/g;
+	# This is 1% faster than the above
+	if(($a =~ s/[\002-\011\013-\032\\\#\?\`\(\)\{\}\[\]\^\*\<\=\>\~\|\; \"\!\$\&\'\202-\377]/\\$&/go)
+	   +
+	   # quote newline as '\n'
+	   ($a =~ s/[\n]/'\n'/go)) {
+	    # A string was replaced
+	    # No need to test for "" or \0
+	} elsif($a eq "") {
+	    $a = "''";
+	} elsif($a eq "\0") {
+	    $a = "";
+	}
+    }
+    return $a;
+}
+
+sub die_usage {
+    help();
+    exit 1;
+}
+
+
+sub help {
+    print q{
+Usage:
+   niceload [-v] [-n niceness] [-L loadavg] [-I io] [-N] [-M mem]
+            [-s suspend_sec|-f factor] [-H] [-S]
+            command or -p pid
+};
+}
+
+
+sub die_bug {
+    my $bugid = shift;
+    print STDERR
+	("$Global::progname: This should not happen. You have found a bug.\n",
+	 "Please contact <parallel\@gnu.org> and include:\n",
+	 "* The version number: $Global::version\n",
+	 "* The bugid: $bugid\n",
+	 "* The command line being run\n",
+	 "* The files being read (put the files on a webserver if they are big)\n",
+	 "\n",
+	 "If you get the error on smaller/fewer files, please include those instead.\n");
+    exit(255);
+}
+
+sub now {
+    # Returns time since epoch as in seconds with 3 decimals
+    # Uses:
+    #   @Global::use
+    # Returns:
+    #   $time = time now with millisecond accuracy
+    if(not $Global::use{"Time::HiRes"}) {
+	if(eval "use Time::HiRes qw ( time );") {
+	    eval "sub TimeHiRestime { return Time::HiRes::time };";
+	} else {
+	    eval "sub TimeHiRestime { return time() };";
+	}
+	$Global::use{"Time::HiRes"} = 1;
+    }
+
+    return (int(TimeHiRestime()*1000))/1000;
+}
+
+sub usleep {
+    # Sleep this many milliseconds.
+    my $ms = shift;
+    ::debug("Sleeping ",$ms," millisecs\n");
+    my $start = now();
+    my $now;
+    do {
+	# Something makes 'select' wake up too early
+	# when using --sensor
+	select(undef, undef, undef, $ms/1000);
+	$now = now();
+    } while($now < $start + $ms/1000);
+}
+
+sub debug {
+    if($opt::debug) {
+	print STDERR @_;
+    }
+}
+
+
+sub my_dump {
+    # Returns:
+    #   ascii expression of object if Data::Dump(er) is installed
+    #   error code otherwise
+    my @dump_this = (@_);
+    eval "use Data::Dump qw(dump);";
+    if ($@) {
+        # Data::Dump not installed
+        eval "use Data::Dumper;";
+        if ($@) {
+            my $err =  "Neither Data::Dump nor Data::Dumper is installed\n".
+                "Not dumping output\n";
+            print STDERR $err;
+            return $err;
+        } else {
+            return Dumper(@dump_this);
+        }
+    } else {
+        eval "use Data::Dump qw(dump);";
+        return (Data::Dump::dump(@dump_this));
+    }
+}
+
+
+sub version {
+    # Returns: N/A
+    print join("\n",
+	       "GNU $Global::progname $Global::version",
+	       "Copyright (C) 2004,2005,2006,2007,2008,2009 Ole Tange",
+	       "Copyright (C) 2010,2011 Ole Tange and Free Software Foundation, Inc.",
+	       "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
+	       "This is free software: you are free to change and redistribute it.",
+	       "GNU $Global::progname comes with no warranty.",
+	       "",
+	       "Web site: http://www.gnu.org/software/parallel\n"
+	);
+}
+
+
+sub max {
+    # Returns:
+    #   Maximum value of array
+    my $max;
+    for (@_) {
+        # Skip undefs
+        defined $_ or next;
+        defined $max or do { $max = $_; next; }; # Set $_ to the first non-undef
+        $max = ($max > $_) ? $max : $_;
+    }
+    return $max;
+}
+
+sub min {
+    # Returns:
+    #   Minimum value of array
+    my $min;
+    for (@_) {
+        # Skip undefs
+        defined $_ or next;
+        defined $min or do { $min = $_; next; }; # Set $_ to the first non-undef
+        $min = ($min < $_) ? $min : $_;
+    }
+    return $min;
+}
+
+sub collect_net_baseline {
+    # Collect what a normal (unloaded) net connection looks line
+}
+
+
+sub netsensor_script {
+    # Script for --sensor when using --net
+    my $hops = shift;
+    my $perlscript = q{
+	use Net::Traceroute;
+	use Net::Ping;
+
+	my $medtrc = MedianTraceroute->new(shift);
+	$medtrc->set_remedian($medtrc->ping());
+	$medtrc->set_remedian($medtrc->ping());
+	while(1) {
+	    my $ms = $medtrc->ping();
+	    my $m = $medtrc->remedian();
+	    if($m*1.5 < $ms) {
+		# Bad 1 = median*1.5 < current latency
+	    } else {
+		# OK 0 = median*1.5 > current latency
+		$medtrc->set_remedian($ms);
+	    }
+	    printf("%d\n",$m*1.5 < $ms);
+	    sleep(1);
+	}
+
+	package MedianTraceroute;
+
+	sub new {
+	    my $class = shift;
+	    my $hop = shift;
+	    # Find router
+	    my $tr = Net::Traceroute->new(host => "8.8.8.8",
+					  max_ttl => $hop);
+	    if($tr->found) {
+		$host = $tr->hop_query_host($hop, 0);
+	    } else {
+		# ns1.censurfridns.dk
+		$tr = Net::Traceroute->new(host => "89.233.43.71",
+					   max_ttl => $hop);
+		if($tr->found) {
+		    $host = $tr->hop_query_host($hop, 0);
+		} else {
+		    die("Cannot traceroute to 8.8.8.8 and 89.233.43.71");
+		}
+	    }
+	    my $p = Net::Ping->new();
+	    $p->hires();
+
+	    return bless {
+		'hop' => $hop,
+		'host' => $host,
+		'pinger' => $p,
+		'remedian_idx' => 0,
+		'remedian_arr' => [],
+		'remedian' => undef,
+	    }, ref($class) || $class;
+	}
+
+	sub ping {
+	    my $self = shift;
+	    for(1..3) {
+		# Ping should never take longer than 5.5 sec
+		my ($ret, $duration, $ip) =
+		    $self->{'pinger'}->ping($self->{'host'}, 5.5);
+		if($ret) {
+		    return $duration;
+		}
+	    }
+	    warn("Ping failed 3 times.");
+	}
+
+	sub remedian {
+	    my $self = shift;
+	    return $self->{'remedian'};
+	}
+
+	sub set_remedian {
+	    # Set median of the last 999^3 (=997002999) values using Remedian
+	    #
+	    # Rousseeuw, Peter J., and Gilbert W. Bassett Jr. "The remedian: A
+	    # robust averaging method for large data sets." Journal of the
+	    # American Statistical Association 85.409 (1990): 97-104.
+	    my $self = shift;
+	    my $val = shift;
+	    my $i = $self->{'remedian_idx'}++;
+	    my $rref = $self->{'remedian_arr'};
+	    $rref->[0][$i%999] = $val;
+	    $rref->[1][$i/999%999] = (sort @{$rref->[0]})[$#{$rref->[0]}/2];
+	    $rref->[2][$i/999/999%999] = (sort @{$rref->[1]})[$#{$rref->[1]}/2];
+	    $self->{'remedian'} = (sort @{$rref->[2]})[$#{$rref->[2]}/2];
+	}
+    };
+    return "perl -e ".shell_quote_scalar($perlscript)." $hops";
+}
+
+
+package Process;
+
+sub new {
+    my $class = shift;
+    my $nice = shift;
+    my @ARGV = @_;
+    if($nice) {
+	unshift(@ARGV, "nice", "-n", $nice);
+    }
+    return bless {
+	'running' => 0, # Is the process running now?
+	'command' => [@ARGV],
+    }, ref($class) || $class;
+}
+
+sub pgrp {
+    my $self = shift;
+    my @pgrp;
+    if(not $self->{'pgrp'}) {
+	for(@{$self->{'pids'}}) {
+	    push @pgrp,-getpgrp($_);
+	}
+	@pgrp = ::uniq(@pgrp);
+	@{$self->{'pgrp'}} = @pgrp;
+    }
+    return @{$self->{'pgrp'}};
+}
+
+sub set_pid {
+    my $self = shift;
+    push(@{$self->{'pids'}},@_);
+    $self->{'running'} = 1;
+    $::exitstatus = 0;
+}
+
+sub start {
+    # Start the program
+    my $self = shift;
+    ::debug("Starting @{$self->{'command'}}\n");
+    $self->{'running'} = 1;
+    if($self->{'pid'} = fork) {
+	# set signal handler to kill children if parent is killed
+	push @{$self->{'pids'}}, $self->{'pid'};
+	$Global::process = $self;
+	$SIG{CHLD} = \&REAPER;
+	$SIG{INT}=\&kill_child_INT;
+	$SIG{TSTP}=\&kill_child_TSTP;
+	$SIG{CONT}=\&kill_child_CONT;
+ 	sleep 1; # Give child time to setpgrp(0,0);
+    } else {
+ 	setpgrp(0,0);
+ 	::debug("Child pid: $$, pgrp: ",getpgrp $$,"\n");
+ 	::debug("@{$self->{'command'}}\n");
+	if($opt::quote) {
+	    system(@{$self->{'command'}});
+	} else {
+	    system("@{$self->{'command'}}");
+	}
+	$::exitstatus = $? >> 8;
+	$::exitsignal = $? & 127;
+	::debug("Child exit $::exitstatus\n");
+	exit($::exitstatus);
+    }
+}
+
+use POSIX ":sys_wait_h";
+use POSIX qw(:sys_wait_h);
+
+sub REAPER {
+    my $stiff;
+    while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
+        # do something with $stiff if you want
+        $::exitstatus = $? >> 8;
+        $::exitsignal = $? & 127;
+    }
+    $SIG{CHLD} = \&REAPER;                  # install *after* calling waitpid
+}
+
+
+sub kill_child_CONT {
+    my $self = $Global::process;
+    ::debug("SIGCONT received. Killing @{$self->{'pgrp'}}\n");
+    kill CONT => $self->pgrp();
+}
+
+
+sub kill_child_TSTP {
+    my $self = $Global::process;
+    ::debug("SIGTSTP received. Killing $self->{'pid'} and self ($$)\n");
+    kill TSTP => $self->pgrp();
+    kill STOP => -$$;
+    kill STOP => $$;
+}
+
+
+sub kill_child_INT {
+    my $self = $Global::process;
+    ::debug("SIGINT received.\n");
+    if(not @opt::pid) {
+	::debug("Killing $self->{'pid'} Exit\n");
+	kill INT => $self->pgrp();
+    } else {
+	::debug("Continue pids $self->{'pid'} Exit\n");
+	kill CONT => $self->pgrp();
+    }
+    exit;
+}
+
+
+sub resume {
+    my $self = shift;
+    ::debug("Resume @{$self->{'pids'}}\n");
+    if(not $self->{'running'}) {
+	# - = PID group
+	map { kill "CONT", -$_ } @{$self->{'pids'}};
+	# If using -p it is not in a group
+	map { kill "CONT", $_ } @{$self->{'pids'}};
+	$self->{'running'} = 1;
+    }
+}
+
+
+sub suspend {
+    my $self = shift;
+    ::debug("Suspend @{$self->{'pids'}}\n");
+    if($self->{'running'}) {
+	# - = PID group
+	map { kill "STOP", -$_ } @{$self->{'pids'}};
+	# If using -p it is not in a group
+	map { kill "STOP", $_ } @{$self->{'pids'}};
+	$self->{'running'} = 0;
+    }
+}
+
+
+sub is_alive {
+    # The process is dead if none of the pids exist
+    my $self = shift;
+    my ($exists) = 0;
+    for my $pid (@{$self->{'pids'}}) {
+	if(kill 0 => $pid) { $exists++ }
+    }
+    ::debug("is_alive: $exists\n");
+    return $exists;
+}
+
+
+package Limit;
+
+sub new {
+    my $class = shift;
+    my %limits = @_;
+    my $hard = $opt::soft ? 0 : $opt::hard;
+    my $runio = $opt::run_io ? ::multiply_binary_prefix($opt::run_io) : 0;
+    my $startio = $opt::start_io ? ::multiply_binary_prefix($opt::start_io) : 0;
+    my $runload = $opt::run_load ? ::multiply_binary_prefix($opt::run_load) : 0;
+    my $startload = $opt::start_load ? ::multiply_binary_prefix($opt::start_load) : 0;
+    my $runmem = $opt::run_mem ? ::multiply_binary_prefix($opt::run_mem) : 0;
+    my $startmem = $opt::start_mem ? ::multiply_binary_prefix($opt::start_mem) : 0;
+    my $runnoswap = $opt::run_noswap ? ::multiply_binary_prefix($opt::run_noswap) : 0;
+    my $startnoswap = $opt::start_noswap ? ::multiply_binary_prefix($opt::start_noswap) : 0;
+    my $recheck = $opt::recheck ? ::multiply_binary_prefix($opt::recheck) : 1; # Default
+    my $runtime = $opt::suspend ? ::multiply_binary_prefix($opt::suspend) : 1; # Default
+
+    return bless {
+	'hard' => $hard,
+	'recheck' => $recheck,
+	'runio' => $runio,
+	'startio' => $startio,
+	'runload' => $runload,
+	'startload' => $startload,
+	'runmem' => $runmem,
+	'startmem' => $startmem,
+	'runnoswap' => $runnoswap,
+	'startnoswap' => $startnoswap,
+	'factor' => $opt::factor || 1,
+	'recheck' => $recheck,
+	'runtime' => $runtime,
+	'over_run_limit' => 1,
+	'over_start_limit' => 1,
+	'verbose' => $opt::verbose,
+    }, ref($class) || $class;
+}
+
+
+sub over_run_limit {
+    my $self = shift;
+    my $status = 0;
+    if($self->{'runmem'}) {
+	# mem should be between 0-10ish
+	# 100% available => 0 (1-1)
+	# 50% available => 1 (2-1)
+	# 10% available => 9 (10-1)
+	my $mem = $self->mem_status();
+	::debug("Run memory: $self->{'runmem'}/$mem\n");
+	$status += (::max(1,$self->{'runmem'}/$mem)-1);
+    }
+    if($self->{'runload'}) {
+	# If used with other limits load should be between 0-10ish
+	no warnings 'numeric';
+	my $load = $self->load_status();
+	if($self->{'runload'} > 0) {
+	    # Stop if the load is above the limit
+	    $status += ::max(0,$load - $self->{'runload'});
+	} else {
+	    # Stop if the load is below the limit (for sensor)
+	    $status += ::max(0,-$load - $self->{'runload'});
+	}
+    }
+    if($self->{'runnoswap'}) {
+	# swap should be between 0-10ish
+	# swap in or swap out or no swap = 0
+	# else log(swapin*swapout)
+	my $swap = $self->swap_status();
+	$status += log(::max(1, $swap - $self->{'runnoswap'}));
+    }
+    if($self->{'runio'}) {
+	my $io = $self->io_status();
+	$status += ::max(0,$io - $self->{'runio'});
+    }
+    $self->{'over_run_limit'} = $status;
+    if(not $opt::recheck) {
+	$self->{'recheck'} = $self->{'factor'} * $self->{'over_run_limit'};
+    }
+    ::debug("over_run_limit: $status\n");
+    return $self->{'over_run_limit'};
+}
+
+sub over_start_limit {
+    my $self = shift;
+    my $status = 0;
+    if($self->{'startmem'}) {
+	# mem should be between 0-10ish
+	# 100% available => 0 (1-1)
+	# 50% available => 1 (2-1)
+	# 10% available => 9 (10-1)
+	my $mem = $self->mem_status();
+	::debug("Start memory: $self->{'startmem'}/$mem\n");
+	$status += (::max(1,$self->{'startmem'}/$mem)-1);
+    }
+    if($self->{'startload'}) {
+	# load should be between 0-10ish
+	# 0 load => 0
+	no warnings 'numeric';
+	my $load = $self->load_status();
+	if($self->{'startload'} > 0) {
+	    # Stop if the load is above the limit
+	    $status += ::max(0,$load - $self->{'startload'});
+	} else {
+	    # Stop if the load is below the limit (for sensor)
+	    $status += ::max(0,-$load - $self->{'startload'});
+	}
+    }
+    if($self->{'startnoswap'}) {
+	# swap should be between 0-10ish
+	# swap in or swap out or no swap = 0
+	# else log(swapin*swapout)
+	my $swap = $self->swap_status();
+	$status += log(::max(1, $swap - $self->{'startnoswap'}));
+    }
+    if($self->{'startio'}) {
+	my $io = $self->io_status();
+	$status += ::max(0,$io - $self->{'startio'});
+    }
+    $self->{'over_start_limit'} = $status;
+    if(not $opt::recheck) {
+	$self->{'recheck'} = $self->{'factor'} * $self->{'over_start_limit'};
+    }
+    ::debug("over_start_limit: $status\n");
+    return $self->{'over_start_limit'};
+}
+
+
+sub hard {
+    my $self = shift;
+    return $self->{'hard'};
+}
+
+
+sub verbose {
+    my $self = shift;
+    return $self->{'verbose'};
+}
+
+
+sub sleep_for_recheck {
+    my $self = shift;
+    if($self->{'recheck'} < 0.01) {
+	# Never sleep less than 0.01 sec
+	$self->{'recheck'} = 0.01;
+    }
+    if($self->verbose()) {
+	$self->{'recheck'} = int($self->{'recheck'}*100)/100;
+	print STDERR "Sleeping $self->{'recheck'}s\n";
+    }
+    ::debug("recheck in $self->{'recheck'}s\n");
+    ::usleep(1000*$self->{'recheck'});
+}
+
+
+sub sleep_while_running {
+    my $self = shift;
+    ::debug("check in $self->{'runtime'}s\n");
+    if($self->verbose()) {
+	$self->{'runtime'} = int($self->{'runtime'}*100)/100;
+	print STDERR "Running $self->{'runtime'}s\n";
+    }
+    ::usleep(1000*$self->{'runtime'});
+}
+
+
+sub nonblockGetLines {
+    # An non-blocking filehandle read that returns an array of lines read
+    # Returns:  ($eof,@lines)
+    # Example: --sensor 'vmstat 1 | perl -ane '\''$|=1; 4..0 and print $F[8],"\n"'\'
+    my ($fh,$timeout) = @_;
+
+    $timeout = 0 unless defined $timeout;
+    my $rfd = '';
+    $::nonblockGetLines_last{$fh} = ''
+        unless defined $::nonblockGetLines_last{$fh};
+
+    vec($rfd,fileno($fh),1) = 1;
+    return unless select($rfd, undef, undef, $timeout)>=0;
+    # I'm not sure the following is necessary?
+    return unless vec($rfd,fileno($fh),1);
+    my $buf = '';
+    my $n = sysread($fh,$buf,1024*1024);
+
+    my $eof = eof($fh);
+    # If we're done, make sure to send the last unfinished line
+    return ($eof,$::nonblockGetLines_last{$fh}) unless $n;
+    # Prepend the last unfinished line
+    $buf = $::nonblockGetLines_last{$fh}.$buf;
+    # And save any newly unfinished lines
+    $::nonblockGetLines_last{$fh} =
+        (substr($buf,-1) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$//)
+	? $1 : '';
+    $buf ? ($eof,split(/\n/,$buf)) : ($eof);
+}
+
+sub read_sensor {
+    my $self = shift;
+    ::debug("read_sensor: ");
+    my $fh = $self->{'sensor_fh'};
+    if(not $fh) {
+	# Start the sensor
+	$self->{'sensor_pid'} =
+	    open($fh, "-|", $opt::sensor) ||
+	    ::die_bug("Cannot open: $opt::sensor");
+	$self->{'sensor_fh'} = $fh;
+    }
+    # Read as much as we can (non_block)
+    my ($eof,@lines) = nonblockGetLines($fh);
+
+    # new load = last full line
+    foreach my $line (@lines) {
+	if(defined $line) {
+	    ::debug("Pipe saw: [$line] eof=$eof\n");
+	    $Global::last_sensor_reading = $line;
+	}
+    }
+    if($eof) {
+	# End of file => Restart the sensor
+	close $fh;
+#	waitpid($self->{'sensor_pid'},0);
+	$self->{'sensor_pid'} =
+	    open($fh, "-|", $opt::sensor) ||
+	    ::die_bug("Cannot open: $opt::sensor");
+	$self->{'sensor_fh'} = $fh;
+    }
+
+    return $Global::last_sensor_reading;
+}
+
+sub load_status {
+    # Returns:
+    #   loadavg or sensor measurement
+    my $self = shift;
+
+    if($opt::sensor) {
+	if(not defined $self->{'load_status'} or
+	   $self->{'load_status_cache_time'} + $self->{'recheck'} < time) {
+	    $self->{'load_status'} = $self->read_sensor();
+	    while (not defined $self->{'load_status'}) {
+		sleep 1;
+		$self->{'load_status'} = $self->read_sensor();
+	    }
+	    $self->{'load_status_cache_time'} = time - 0.001;
+	}
+    } else {
+	# Normal load avg
+	# Cache for some seconds
+	if(not defined $self->{'load_status'} or
+	   $self->{'load_status_cache_time'} + $self->{'recheck'} < time) {
+	    $self->{'load_status'} = load_status_linux() if $^O ne 'darwin';
+	    $self->{'load_status'} = load_status_darwin() if $^O eq 'darwin';
+	    $self->{'load_status_cache_time'} = time;
+	}
+    }
+    ::debug("load_status: ".$self->{'load_status'}."\n");
+    return $self->{'load_status'};
+}
+
+sub undef_as_zero {
+    my $a = shift;
+    return $a ? $a : 0;
+}
+
+
+sub load_status_linux {
+    my ($loadavg);
+    if(open(IN,"/proc/loadavg")) {
+	# Linux specific (but fast)
+	my $upString = <IN>;
+	if($upString =~ m/^(\d+\.\d+)/) {
+	    $loadavg = $1;
+	} else {
+	    ::die_bug("proc_loadavg");
+	}
+	close IN;
+    } elsif (open(IN,"LANG=C uptime|")) {
+	my $upString = <IN>;
+	if($upString =~ m/averages?.\s*(\d+\.\d+)/) {
+	    $loadavg = $1;
+	} else {
+	    ::die_bug("uptime");
+	}	
+	close IN;
+    }
+    return $loadavg;
+}
+
+sub load_status_darwin {
+    my $loadavg = `sysctl vm.loadavg`;
+    if($loadavg =~ /vm\.loadavg: \{ ([0-9.]+) ([0-9.]+) ([0-9.]+) \}/) {
+	$loadavg = $1;
+    } elsif (open(IN,"LANG=C uptime|")) {
+	my $upString = <IN>;
+	if($upString =~ m/averages?.\s*(\d+\.\d+)/) {
+	    $loadavg = $1;
+	} else {
+	    ::die_bug("uptime");
+	}
+	close IN;
+    }
+    return $loadavg;
+}
+
+
+sub swap_status {
+    # Returns:
+    #   (swap in)*(swap out) kb
+    my $self = shift;
+    my $status;
+    # Cache for some seconds
+    if(not defined $self->{'swap_status'} or
+       $self->{'swap_status_cache_time'}+$self->{'recheck'} < time) {
+	$status = swap_status_linux() if $^O ne 'darwin';
+	$status = swap_status_darwin() if $^O eq 'darwin';
+	$self->{'swap_status'} = ::max($status,0);
+	$self->{'swap_status_cache_time'} = time;
+    }
+    ::debug("swap_status: $self->{'swap_status'}\n");
+    return $self->{'swap_status'};
+}
+
+
+sub swap_status_linux {
+    my $swap_activity;
+    $swap_activity = "vmstat 1 2 | tail -n1 | awk '{print \$7*\$8}'";
+    # Run swap_activity measuring.
+    return qx{ $swap_activity };
+}
+
+sub swap_status_darwin {
+    # Mach Virtual Memory Statistics: (page size of 4096 bytes, cache hits 0%)
+    #   free active   spec inactive   wire   faults     copy    0fill reactive  pageins  pageout
+    # 298987 251463 162637    69437 265724 29730558   299022  2308237        1   110058        0
+    # 298991 251479 162637    69437 265726       43        4       16        0        0        0
+    my ($pagesize, $pageins, $pageouts);
+    my @vm_stat = `vm_stat 1 | head -n4`;
+    $pagesize = $1 if $vm_stat[0] =~ m/page size of (\d+) bytes/;
+    $pageins = (split(/\s+/,$vm_stat[3]))[9];
+    $pageouts = (split(/\s+/,$vm_stat[3]))[10];
+    return ($pageins*$pageouts*$pagesize)/1024;
+}
+
+
+sub mem_status {
+    # Returns:
+    #   number of bytes (free+cache)
+    my $self = shift;
+    # Cache for one second
+    if(not defined $self->{'mem_status'} or
+       $self->{'mem_status_cache_time'}+$self->{'recheck'} < time) {
+	$self->{'mem_status'} = mem_status_linux() if $^O ne 'darwin';
+	$self->{'mem_status'} = mem_status_darwin() if $^O eq 'darwin';
+	$self->{'mem_status_cache_time'} = time;
+    }
+    ::debug("mem_status: $self->{'mem_status'}\n");
+    return $self->{'mem_status'};
+}
+
+
+sub mem_status_linux {
+    #              total       used       free     shared    buffers     cached
+    # Mem:       3366496    2901664     464832          0     179228    1850692
+    # -/+ buffers/cache:     871744    2494752
+    # Swap:      6445476    1396860    5048616
+    my @free = `free`;
+    my $free = (split(/\s+/,$free[2]))[3];
+    return $free*1024;
+}
+
+sub mem_status_darwin {
+    # Mach Virtual Memory Statistics: (page size of 4096 bytes, cache hits 0%)
+    #   free active   spec inactive   wire   faults     copy    0fill reactive  pageins  pageout
+    # 298987 251463 162637    69437 265724 29730558   299022  2308237        1   110058        0
+    # 298991 251479 162637    69437 265726       43        4       16        0        0        0
+    my ($pagesize, $pages_free, $pages_speculative);
+    my @vm_stat = `vm_stat 1 | head -n4`;
+    $pagesize = $1 if $vm_stat[0] =~ m/page size of (\d+) bytes/;
+    $pages_free = (split(/\s+/,$vm_stat[3]))[0];
+    $pages_speculative = (split(/\s+/,$vm_stat[3]))[2];
+    return ($pages_free+$pages_speculative)*$pagesize;
+}
+
+
+sub io_status {
+    # Returns:
+    #   max percent for all devices
+    my $self = shift;
+    # Cache for one second
+    if(not defined $self->{'io_status'} or
+       $self->{'io_status_cache_time'}+$self->{'recheck'} < time) {
+	$self->{'io_status'} = io_status_linux() if $^O ne 'darwin';
+	$self->{'io_status'} = io_status_darwin() if $^O eq 'darwin';
+	$self->{'io_status_cache_time'} = time;
+    }
+    ::debug("io_status: $self->{'io_status'}\n");
+    return $self->{'io_status'};
+}
+
+
+sub io_status_linux {
+    # Device rrqm/s   wrqm/s     r/s     w/s    rkB/s    wkB/s avgrq-sz avgqu-sz   await r_await w_await  svctm  %util
+    # sda       0.00     0.00    0.00    0.00     0.00     0.00     0.00     0.00    0.00    0.00    0.00   0.00   0.00
+    my @iostat_out = `LANG=C iostat -x 1 2`;
+    # throw away all execpt the last Device-section
+    my @iostat;
+    for(reverse @iostat_out) {
+	/Device/ and last;
+	my @col = (split(/\s+/,$_));
+	# Util% is last column
+	push @iostat, pop @col;
+    }
+    my $io = ::max(@iostat);
+    return undef_as_zero($io)/10;
+}
+
+sub io_status_darwin {
+    #           disk0           disk1           disk2
+    #     KB/t tps  MB/s     KB/t tps  MB/s     KB/t tps  MB/s
+    #    14.95  15  0.22    11.18  35  0.38     2.00   0  0.00
+    #     0.00   0  0.00     0.00   0  0.00     0.00   0  0.00
+    my @iostat_out = `LANG=C iostat -d -w 1 -c 2`;
+    # return the MB/s of the last second (not the %util)
+    my @iostat = split(/\s+/, $iostat_out[3]);
+    my $io = $iostat[3] + $iostat[6] + $iostat[9];
+    return ::min($io, 10);
+}
+
+$::exitsignal = $::exitstatus = 0; # Dummy