diff --git a/src/niceload b/src/niceload index 6bfb555e..39720b3c 100755 --- a/src/niceload +++ b/src/niceload @@ -24,7 +24,7 @@ use strict; use Getopt::Long; $Global::progname="niceload"; -$Global::version = 20160222; +$Global::version = 20160223; Getopt::Long::Configure("bundling","require_order"); get_options_from_array(\@ARGV) || die_usage(); if($opt::version) { @@ -67,8 +67,37 @@ my $process = Process->new($opt::nice,@ARGV); $::exitstatus = 0; if(@opt::prg) { # Find all pids of prg - my $out = `pidof -x @opt::prg`; - $process->set_pid(split /\s+/,$out); + 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(@substr_name_pids) { + $name_of->{$_} =~ s/ .*//; + push @{$name_pids{$name_of->{$_}}},$_; + } + warning("Niceloading", + map { "$_ (".(join",",@{$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) { @@ -101,11 +130,94 @@ while($process->is_alive()) { 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 <> + # 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 } @_ }}; @@ -665,7 +777,7 @@ sub read_sensor { } # 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) { @@ -695,7 +807,7 @@ sub load_status { while (not defined $self->{'load_status'}) { sleep 1; $self->{'load_status'} = $self->read_sensor(); - } + } $self->{'load_status_cache_time'} = time - 0.001; } } else { diff --git a/src/niceload.pod b/src/niceload.pod index 6a91761a..c61af0fe 100644 --- a/src/niceload.pod +++ b/src/niceload.pod @@ -117,12 +117,14 @@ Process ID of process to suspend. You can specify multiple process IDs with multiple B<-p> I. -=item B<--prg> I +=item B<--prg> I (alpha testing) -=item B<--program> I +=item B<--program> I (alpha testing) Name of running program to suspend. You can specify multiple programs -with multiple B<--prg> I. +with multiple B<--prg> I. If no processes with the name +I is found, B with search for substrings containing +I. =item B<--quote>