niceload: Implemented '-q'

src/niceload

@@ -36,6 +36,32 @@ 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; }
 
+my $limit = Limit->new();
+my $process = Process->new($::opt_nice,@ARGV);
+if(not $::opt_pid) {
+    # 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_running()) {
+    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();
+    }
+}
+
+
 sub get_options_from_array {
     # Run GetOptions on @array
     # Returns:
@@ -77,6 +103,7 @@ sub get_options_from_array {
 	 "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,
@@ -88,11 +115,13 @@ sub get_options_from_array {
     return @retval;
 }
 
+
 sub die_usage {
     help();
     exit 1;
 }
 
+
 sub help {
     print q{
 Usage:
@@ -102,6 +131,22 @@ Usage:
 };
 }
 
+
+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 usleep {
     # Sleep this many milliseconds.
     my $secs = shift;
@@ -109,12 +154,14 @@ sub usleep {
     select(undef, undef, undef, $secs/1000);
 }
 
+
 sub debug {
     if($::opt_debug) {
 	print STDERR @_;
     }
 }
 
+
 sub my_dump {
     # Returns:
     #   ascii expression of object if Data::Dump(er) is installed
@@ -138,6 +185,7 @@ sub my_dump {
     }
 }
 
+
 sub version {
     # Returns: N/A
     print join("\n",
@@ -152,6 +200,7 @@ sub version {
 	);
 }
 
+
 sub multiply_binary_prefix {
     # Evalualte numbers with binary prefix
     # 13G = 13*1024*1024*1024 = 13958643712
@@ -169,6 +218,7 @@ sub multiply_binary_prefix {
     return $s;
 }
 
+
 sub max {
     # Returns:
     #   Maximum value of array
@@ -182,30 +232,6 @@ sub max {
     return $max;
 }
 
-my $limit = Limit->new();
-my $process = Process->new($::opt_nice,@ARGV);
-if(not $::opt_pid) {
-    # 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_running()) {
-    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();
-    }
-}
 
 package Process;
 
@@ -222,6 +248,7 @@ sub new {
     }, ref($class) || $class;
 }
 
+
 sub start {
     # Start the program
     my $self = shift;
@@ -240,12 +267,17 @@ sub start {
  	setpgrp(0,0);
  	::debug("Child pid: $$, pgrp: ",getpgrp $$,"\n");
  	::debug("@{$self->{'command'}}\n");
- 	system("@{$self->{'command'}}");
+	if($::opt_quote) {
+	    system(@{$self->{'command'}});
+	} else {
+	    system("@{$self->{'command'}}");
+	}
  	::debug("Child exit\n");
  	exit;
     }
 }
 
+
 use POSIX ":sys_wait_h";
 
 sub REAPER {
@@ -256,12 +288,14 @@ sub REAPER {
     $SIG{CHLD} = \&REAPER;                  # install *after* calling waitpid
 }
 
+
 sub kill_child_CONT {
     my $self = $Global::process;
     ::debug("SIGCONT received. Killing $self->{'pid'}\n");
     kill CONT => -getpgrp($self->{'pid'});
 }
 
+
 sub kill_child_TSTP {
     my $self = $Global::process;
     ::debug("SIGTSTP received. Killing $self->{'pid'} and self\n");
@@ -269,6 +303,7 @@ sub kill_child_TSTP {
     kill STOP => -$$;
 }
 
+
 sub kill_child_INT {
     my $self = $Global::process;
     ::debug("SIGINT received. Killing $self->{'pid'} Exit\n");
@@ -276,6 +311,7 @@ sub kill_child_INT {
     exit;
 }
 
+
 sub resume {
     my $self = shift;
     if(not $self->{'running'}) {
@@ -285,6 +321,7 @@ sub resume {
     }
 }
 
+
 sub suspend {
     my $self = shift;
     if($self->{'running'}) {
@@ -294,6 +331,7 @@ sub suspend {
     }
 }
 
+
 sub is_running {
     # The process is dead if none of the pids exist
     my $self = shift;
@@ -342,6 +380,7 @@ sub new {
     }, ref($class) || $class;
 }
 
+
 sub over_run_limit {
     my $self = shift;
     my $status = 0;
@@ -351,7 +390,6 @@ sub over_run_limit {
 	# 50% available => 1 (2-1)
 	# 10% available => 9 (10-1)
 	my $mem = $self->mem_status();
-#	$status += (::max(1,$self->{'runmem'}/$mem)-1)*10;
 	::debug("Run memory: $self->{'runmem'}/$mem\n");
 	$status += (::max(1,$self->{'runmem'}/$mem)-1);
     }
@@ -389,7 +427,6 @@ sub over_start_limit {
 	# 50% available => 1 (2-1)
 	# 10% available => 9 (10-1)
 	my $mem = $self->mem_status();
-#	$status += (::max(1,$self->{'startmem'}/$mem)-1)*10;
 	::debug("Start memory: $self->{'startmem'}/$mem\n");
 	$status += (::max(1,$self->{'startmem'}/$mem)-1);
     }
@@ -418,46 +455,19 @@ sub over_start_limit {
     return $self->{'over_start_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();
-#	$status += (::max(1,$self->{'startmem'}/$mem)-1)*10;
-	$status += (::max(1,$self->{'startmem'}/$mem)-1);
-    }
-    $self->{'over_start_limit'} = $status;
-    if(not $::opt_recheck) {
-	# Wait at least 0.5s. Otherwise niceload might cause the load
-	$self->{'recheck'} = $self->{'factor'} * $self->{'over_start_limit'};
-    }
-    ::debug("over_start_limit: $status\n");
-    return $self->{'over_start_limit'};
-}
-
-sub __over_general_limit {
-    # Return:
-    #   0 if under all limits
-    #   >0 if over limit
-    my $self = shift;
-    my $status = 0;
-    return $status;
-}
 
 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.5) {
@@ -472,6 +482,7 @@ sub sleep_for_recheck {
     ::usleep(1000*$self->{'recheck'});
 }
 
+
 sub sleep_while_running {
     my $self = shift;
     ::debug("check in $self->{'runtime'}s\n");
@@ -483,6 +494,7 @@ sub sleep_while_running {
     ::usleep(1000*$self->{'runtime'});
 }
 
+
 sub load_status {
     # Returns:
     #   loadavg
@@ -497,6 +509,7 @@ sub load_status {
     return $self->{'load_status'};
 }
 
+
 sub load_status_linux {
     my ($loadavg);
     if(open(IN,"/proc/loadavg")) {
@@ -505,7 +518,7 @@ sub load_status_linux {
 	if($upString =~ m/^(\d+\.\d+)/) {
 	    $loadavg = $1;
 	} else {
-	    die;
+	    ::die_bug("proc_loadavg");
 	}
 	close IN;
     } elsif (open(IN,"uptime|")) {
@@ -513,13 +526,14 @@ sub load_status_linux {
 	if($upString =~ m/average.\s*(\d+\.\d+)/) {
 	    $loadavg = $1;
 	} else {
-	    die;
+	    ::die_bug("uptime");
 	}	
 	close IN;
     }
     return $loadavg;
 }
 
+
 sub swap_status {
     # Returns:
     #   (swap in)*(swap out) kb
@@ -535,6 +549,7 @@ sub swap_status {
     return $self->{'swap_status'};
 }
 
+
 sub swap_status_linux {
     my $swap_activity;
     $swap_activity = "vmstat 1 2 | tail -n1 | awk '{print \$7*\$8}'";
@@ -542,6 +557,7 @@ sub swap_status_linux {
     return qx{ $swap_activity };
 }
 
+
 sub mem_status {
     # Returns:
     #   number of bytes (free+cache)
@@ -556,6 +572,7 @@ sub mem_status {
     return $self->{'mem_status'};
 }
 
+
 sub mem_status_linux {
     #              total       used       free     shared    buffers     cached
     # Mem:       3366496    2901664     464832          0     179228    1850692
@@ -566,6 +583,7 @@ sub mem_status_linux {
     return $free*1024;
 }
 
+
 sub io_status {
     # Returns:
     #   max percent for all devices
@@ -576,21 +594,16 @@ sub io_status {
 	$self->{'io_status'} = io_status_linux();
 	$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
+    # 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
+    # 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
-# sdb               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
-# sdd               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
-# sde               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
-# sdf               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
-# dm-0              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
-# sdg               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
-#    print @iostat_out;
     my @iostat;
     for(reverse @iostat_out) {
 	/Device:/ and last;
@@ -599,6 +612,3 @@ sub io_status_linux {
     my $io = ::max(@iostat);
     return $io/10;
 }
-
-# Keep -w happy
-# = 1;

src/niceload.pod

@@ -4,16 +4,19 @@ niceload - slow down a program when the load average is above a certain limit
 
 =head1 SYNOPSIS
 
-B<niceload> [-v] [-n nice] [-L load] [-t time] [-s time|-f factor] command
+B<niceload> [-v] [-h] [-n nice] [-I io] [-L load] [-M mem] [-N]
-
+[-t time] [-s time|-f factor] ( command | -p PID )
-B<niceload> [-v] [-h] [-n nice] [-l load] [-t time] [-s time|-f factor] -p=PID
 
 =head1 DESCRIPTION
 
-GNU B<niceload> will slow down a program when the load average is
+GNU B<niceload> will slow down a program when the load average (or
-above a certain limit. When the limit is reached the program will be
+other system activity) is above a certain limit. When the limit is
-suspended for some time. Then resumed again for some time.  Then the
+reached the program will be suspended for some time. Then resumed
-load average is checked again and we start over.
+again for some time.  Then the load average is checked again and we
+start over.
+
+Instead of load average B<niceload> can also look at disk I/O, amount
+of free memory, or swapping activity.
 
 If the load is 3.00 then the default settings will run a program
 like this:
@@ -102,6 +105,14 @@ Sets niceness. See B<nice>(1).
 Process ID of process to suspend.
 
 
+=item B<--quote>
+
+=item B<-q>
+
+Quote the command line. Useful if the command contains chars like *,
+$, >, and " that should not be interpreted by the shell.
+
+
 =item B<--run-io> I<iolimit>
 
 =item B<--ri> I<iolimit>
@@ -134,15 +145,6 @@ Start limit. The program will not start until the system is below the
 limit. See: B<--io>, B<--load>, B<--mem>, B<--noswap>.
 
 
-
-=item B<--suspend> I<SEC>
-
-=item B<-s> I<SEC>
-
-Suspend time. Suspend the command this many seconds when the max load
-average is reached.
-
-
 =item B<--soft>
 
 =item B<-S>
@@ -152,6 +154,14 @@ let it run for a second thus only slowing down a process while the
 system is over one of the given limits. This is the default.
 
 
+=item B<--suspend> I<SEC>
+
+=item B<-s> I<SEC>
+
+Suspend time. Suspend the command this many seconds when the max load
+average is reached.
+
+
 =item B<--recheck> I<SEC>
 
 =item B<-t> I<SEC>