Proc-ProcessTable-0.59/0000755000175000017500000000000013502757612013074 5ustar jwbjwbProc-ProcessTable-0.59/lib/0000755000175000017500000000000013502757611013641 5ustar jwbjwbProc-ProcessTable-0.59/lib/Proc/0000755000175000017500000000000013502757611014544 5ustar jwbjwbProc-ProcessTable-0.59/lib/Proc/ProcessTable.pm0000644000175000017500000001473713502757517017511 0ustar jwbjwbpackage Proc::ProcessTable; use 5.006; use strict; use warnings; use Carp; use Config; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.59'; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. If a constant is not found then control is passed # to the AUTOLOAD in AutoLoader. my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined Proc::ProcessTable macro $constname"; } } eval "sub $AUTOLOAD { $val }"; goto &$AUTOLOAD; } bootstrap Proc::ProcessTable $VERSION; # Preloaded methods go here. use Proc::ProcessTable::Process; use File::Find; my %TTYDEVS; our $TTYDEVSFILE = "/tmp/TTYDEVS_" . $Config{byteorder}; # Where we store the TTYDEVS hash sub new { my ($this, %args) = @_; my $class = ref($this) || $this; my $self = {}; bless $self, $class; mutex_new(1); if ( exists $args{cache_ttys} && $args{cache_ttys} == 1 ) { $self->{cache_ttys} = 1 } if ( exists $args{enable_ttys} && (! $args{enable_ttys})) { $self->{enable_ttys} = 0; if ($self->{'cache_ttys'}) { carp("cache_ttys specified with enable_ttys, cache_ttys a no-op"); } } else { $self->{enable_ttys} = 1; } my $status = $self->initialize; mutex_new(0); if($status) { return $self; } else { return undef; } } sub initialize { my ($self) = @_; if ($self->{enable_ttys}) { # Get the mapping of TTYs to device nums # reading/writing the cache if we are caching if( $self->{cache_ttys} ) { require Storable; if( -r $TTYDEVSFILE ) { $_ = Storable::retrieve($TTYDEVSFILE); %Proc::ProcessTable::TTYDEVS = %$_; } else { $self->_get_tty_list; require File::Temp; require File::Basename; my($ttydevs_fh, $ttydevs_tmpfile) = File::Temp::tempfile('ProcessTable_XXXXXXXX', DIR => File::Basename::dirname($TTYDEVSFILE)); chmod 0644, $ttydevs_tmpfile; Storable::store_fd( \%Proc::ProcessTable::TTYDEVS, $ttydevs_fh ); close $ttydevs_fh; if( !rename $ttydevs_tmpfile, $TTYDEVSFILE ) { my $err = $!; unlink $ttydevs_tmpfile; if( !-r $TTYDEVSFILE) { die "Renaming $ttydevs_tmpfile to $TTYDEVSFILE failed: $err"; } # else somebody else obviously created the file in the meantime } } } else { $self->_get_tty_list; } } # Call the os-specific initialization $self->_initialize_os; return 1; } ############################################### # Generate a hash mapping TTY numbers to paths. # This might be faster in Table.xs, # but it's a lot more portable here ############################################### sub _get_tty_list { my ($self) = @_; undef %Proc::ProcessTable::TTYDEVS; find({ wanted => sub{ $File::Find::prune = 1 if -d $_ && ! -x $_; my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($File::Find::name); $Proc::ProcessTable::TTYDEVS{$rdev} = $File::Find::name if(-c $File::Find::name); }, no_chdir => 1}, "/dev" ); } # Apparently needed for mod_perl sub DESTROY {} 1; __END__ =head1 NAME Proc::ProcessTable - Perl extension to access the unix process table =head1 SYNOPSIS use Proc::ProcessTable; my $p = Proc::ProcessTable->new( 'cache_ttys' => 1 ); my @fields = $p->fields; my $ref = $p->table; =head1 DESCRIPTION Perl interface to the unix process table. =head1 METHODS =over 4 =item new Creates a new ProcessTable object. The constructor can take the following flags: enable_ttys -- causes the constructor to use the tty determination code, which is the default behavior. Setting this to 0 disables this code, thus preventing the module from traversing the device tree, which on some systems, can be quite large and/or contain invalid device paths (for example, Solaris does not clean up invalid device entries when disks are swapped). If this is specified with cache_ttys, a warning is generated and the cache_ttys is overridden to be false. cache_ttys -- causes the constructor to look for and use a file that caches a mapping of tty names to device numbers, and to create the file if it doesn't exist. This feature requires the Storable module. By default, the cache file name consists of a prefix F and a byte order tag. The file name can be accessed (and changed) via C<$Proc::ProcessTable::TTYDEVSFILE>. =item fields Returns a list of the field names supported by the module on the current architecture. =item table Reads the process table and returns a reference to an array of Proc::ProcessTable::Process objects. Attributes of a process object are returned by accessors named for the attribute; for example, to get the uid of a process just do: $process->uid The priority and pgrp methods also allow values to be set, since these are supported directly by internal perl functions. =back =head1 EXAMPLES # A cheap and sleazy version of ps use Proc::ProcessTable; my $FORMAT = "%-6s %-10s %-8s %-24s %s\n"; my $t = Proc::ProcessTable->new; printf($FORMAT, "PID", "TTY", "STAT", "START", "COMMAND"); foreach my $p ( @{$t->table} ){ printf($FORMAT, $p->pid, $p->ttydev, $p->state, scalar(localtime($p->start)), $p->cmndline); } # Dump all the information in the current process table use Proc::ProcessTable; my $t = Proc::ProcessTable->new; foreach my $p (@{$t->table}) { print "--------------------------------\n"; foreach my $f ($t->fields){ print $f, ": ", $p->{$f}, "\n"; } } =head1 CAVEATS Please see the file README in the distribution for a list of supported operating systems. Please see the file PORTING for information on how to help make this work on your OS. =head1 AUTHOR D. Urist, durist@frii.com =head1 SEE ALSO L, L. =cut Proc-ProcessTable-0.59/lib/Proc/Killfam.pm0000644000175000017500000000251013501006311016436 0ustar jwbjwb$Proc::Killfam::VERSION = '1.0'; package Proc::Killfam; use Exporter; use base qw/Exporter/; use subs qw/get_pids/; use vars qw/@EXPORT @EXPORT_OK $ppt_OK/; use strict; use warnings; @EXPORT = qw/killfam/; @EXPORT_OK = qw/killfam/; BEGIN { $ppt_OK = 1; eval "require Proc::ProcessTable"; if ($@) { $ppt_OK = 0; warn "Proc::ProcessTable missing, can't kill sub-children."; } } sub killfam { my($signal, @pids) = @_; if ($ppt_OK) { my $pt = Proc::ProcessTable->new; my(@procs) = @{$pt->table}; my(@kids) = get_pids \@procs, @pids; @pids = (@pids, @kids); } kill $signal, @pids; } # end killfam sub get_pids { my($procs, @kids) = @_; my @pids; foreach my $kid (@kids) { foreach my $proc (@$procs) { if ($proc->ppid == $kid) { my $pid = $proc->pid; push @pids, $pid, get_pids $procs, $pid; } } } @pids; } # end get_pids 1; __END__ =head1 NAME Proc::Killfam - kill a list of pids, and all their sub-children =head1 SYNOPSIS use Proc::Killfam; killfam $signal, @pids; =head1 DESCRIPTION B accepts the same arguments as the Perl builtin B command, but, additionally, recursively searches the process table for children and kills them as well. =head1 EXAMPLE B; =head1 KEYWORDS kill, signal =cut Proc-ProcessTable-0.59/lib/Proc/ProcessTable/0000755000175000017500000000000013502757611017132 5ustar jwbjwbProc-ProcessTable-0.59/lib/Proc/ProcessTable/Process.pm0000644000175000017500000001174413501006311021074 0ustar jwbjwbpackage Proc::ProcessTable::Process; use strict; use warnings; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.02'; # Preloaded methods go here. use Carp; use File::Basename; sub AUTOLOAD { my $self = shift; my $type = ref($self) or croak "$self is not an object"; my $name = $AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion unless (exists $self->{$name} ) { croak "Can't access `$name' field in class $type"; } if (@_) { return $self->{$name} = shift; } else { return $self->{$name}; } } ######################################################## # Kill; just a wrapper for perl's kill at the moment ######################################################## sub kill { my ($self, $signal) = @_; die "PID " . $self->pid . " not valid." unless($self->pid =~ /^-?\d+$/); return( kill($signal, $self->pid) ); } ######################################################## # Get/set accessors for priority and process group # (everything else is just a get, so handled by autoload) ######################################################### # Hmmm... These could use the perl functions to get if not stored on the object sub priority { my ($self, $priority) = @_; if( defined($priority) ){ setpriority(0, $self->pid, $priority); if( getpriority(0, $self->pid) == $priority ){ # Yuck; getpriority doesn't return a status $self->{priority} = $priority; } } return $self->{priority}; } sub pgrp { my ($self, $pgrp) = @_; if( defined($pgrp) ){ setpgrp($self->pid, $pgrp); if( getpgrp($self->pid) == $pgrp ){ # Ditto setpgrp $self->{pgrp} = $pgrp; } } return $self->{pgrp}; } # Apparently needed for mod_perl sub DESTROY {} # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ =head1 NAME Proc::ProcessTable::Process - Perl process objects =head1 SYNOPSIS $process->kill(9); $process->priority(19); $process->pgrp(500); $uid = $process->uid; ... =head1 DESCRIPTION This is a stub module to provide OO process attribute access for Proc::ProcessTable. Proc::ProcessTable::Process objects are constructed directly by Proc::ProcessTable; there is no constructor method, only accessors. =head1 METHODS =over 4 =item kill Sends a signal to the process; just an aesthetic wrapper for perl's kill. Takes the signal (name or number) as an argument. Returns number of processes signalled. =item priority Get/set accessor; if called with a numeric argument, attempts to reset the process's priority to that number using perl's setpriority function. Returns the process priority. =item pgrp Same as above for the process group. =item all other methods... are simple accessors that retrieve the process attributes for which they are named. Currently supported are: uid UID of process gid GID of process euid effective UID of process (Solaris only) egid effective GID of process (Solaris only) pid process ID ppid parent process ID spid sprod ID (IRIX only) pgrp process group sess session ID cpuid CPU ID of processor running on (IRIX only) priority priority of process ttynum tty number of process flags flags of process minflt minor page faults (Linux only) cminflt child minor page faults (Linux only) majflt major page faults (Linux only) cmajflt child major page faults (Linux only) utime user mode time (1/100s of seconds) (Linux only) stime kernel mode time (Linux only) cutime child utime (Linux only) cstime child stime (Linux only) time user + system time ctime child user + system time timensec user + system nanoseconds part (Solaris only) ctimensec child user + system nanoseconds (Solaris only) qtime cumulative cpu time (IRIX only) size virtual memory size (bytes) rss resident set size (bytes) wchan address of current system call fname file name start start time (seconds since the epoch) pctcpu percent cpu used since process started state state of process pctmem percent memory cmndline full command line of process ttydev path of process's tty clname scheduling class name (IRIX only) See the "README.osname" files in the distribution for more up-to-date information. =back =head1 AUTHOR D. Urist, durist@frii.com =head1 SEE ALSO L, L. =cut Proc-ProcessTable-0.59/lib/Proc/Killall.pm0000644000175000017500000000524113501006311016447 0ustar jwbjwb# # Kill all instances of a process by pattern-matching the command-line # # (c) 2000 by Aaron Sherman, see documentation, below for details. package Proc::Killall; require Exporter; use Carp; use Proc::ProcessTable; use Config; use strict; use warnings; use vars qw(@EXPORT @EXPORT_OK @ISA $VERSION); @EXPORT=qw(killall); @EXPORT_OK=qw(killall); @ISA=qw(Exporter); $VERSION='1.0'; # Private function for checking to see if a signal identifier is # valid. sub is_sig { my $sig = shift; if (defined($sig)) { if ($sig =~ /^-?(\d+)/) { my $n = $1; my @sigs = split ' ', $Config{sig_num}; return grep {$_ == $n} @sigs; } elsif ($sig =~ /^[A-Z][A-Z0-9]+$/) { my @sigs = split ' ', $Config{sig_name}; return grep {$_ eq $sig} @sigs; } else { return 0; } } else { return 0; } } # usage: killall(signal, pattern) # return: number of procs killed sub killall { croak("Usage: killall(signal, pattern)") unless @_==2; my $signal = shift; my $pat = shift; my $self = shift; $self = 0 unless defined $self; my $nkilled = 0; croak("killall: Unsupported signal: $signal") unless is_sig($signal); my $t = Proc::ProcessTable->new; my $BANG = undef; foreach my $p (@{$t->table}) { my $cmndline = $p->{cmndline} || $p->{fname}; if ($cmndline =~ /$pat/) { next unless $p->pid != $$ || $self; if (kill $signal, $p->pid) { $nkilled++; } else { $BANG = $!; } } } $! = $BANG if defined $BANG; return $nkilled; } 1; __END__ =head1 NAME killall - Kill all instances of a process by pattern matching the command-line =head1 SYNOPSIS use Proc::Killall; killall('HUP', 'xterm'); # SIGHUP all xterms killall('KILL', '^netscape$'); # SIGKILL to "netscape" =head1 DESCRIPTION This module provides one function, C, which takes two parameters: a signal name or number (see C) and a process pattern. This pattern is matched against the process' command-line as the C command would show it (C is not used internally, instead a package called C is used). C searches the process table and sends that signal to all processes which match the pattern. The return value is the number of processes that were successfully signaled. If any kills failed, the C<$!> variable will be set based on that last one that failed (even if a successful kill happened afterward). =head1 AUTHOR Written in 2000 by Aaron Sherman Eajs@ajs.comE C is copyright 2000 by Aaron Sherman, and may be distributed under the same terms as Perl itself. =head1 PREREQUISITES C is required for C to function. =head1 SEE ALSO L, L, L, L Proc-ProcessTable-0.59/README.bsdi0000644000175000017500000000120113501006311014644 0ustar jwbjwb SUPPORTED ATTRIBUTES ================================== uid UID of process gid GID of process pid process ID ppid parent process ID pgrp process group ID pri priority of process sess pointer to session leader pid of session leader time cpu time of process wchan address of current system call fname command name state state of process started time/day process started ttydev path of process' tty ttynum tty number of process cmndline command line of process Proc-ProcessTable-0.59/t/0000755000175000017500000000000013502757611013336 5ustar jwbjwbProc-ProcessTable-0.59/t/openbsd-size-rss.t0000644000175000017500000000213613502757225016735 0ustar jwbjwb# Test size & RSS attribute on OpenBSD # Added by Joelle Maslak , used bugfix-51470 for # outline. use warnings; use Test::More; use Data::Dumper; BEGIN { if ($^O ne 'openbsd') { plan skip_all => 'OpenBSD-specific tests'; } use_ok('Proc::ProcessTable'); } SKIP: { $0 = "PROC_PROCESSTABLE_TEST_CMD"; sleep(1); my ($ps) = grep {/^$$\s+/} map { chomp; s/^\s*//; $_ } `ps xww`; skip 'Cannot set process name', 1 unless ($ps && $ps =~ /PROC_PROCESSTABLE_TEST_CMD/); $SIG{CHLD} = 'IGNORE'; my $pid = fork; die "cannot fork" unless defined $pid; if ($pid == 0) { #child sleep 10000; } else { #main sleep 1; my ($pstmp) = grep {/^$pid\s+/} map { chomp; s/^\s*//; $_ } `ps xo pid,vsz,rss`; my ($ps_pid, $ps_vsize, $ps_rss) = split /\s+/, $pstmp; $ps_vsize *= 1024; $ps_rss *= 1024; my $t = Proc::ProcessTable->new; my ($p) = grep { $_->{pid} == $pid } @{ $t->table }; is($p->{size}, $ps_vsize, "Process size = ps vsz"); is($p->{rss}, $ps_rss, "Process rss = ps rss"); kill 9, $pid; } } done_testing(); Proc-ProcessTable-0.59/t/pod.t0000644000175000017500000000053613501006311014270 0ustar jwbjwb#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Proc-ProcessTable-0.59/t/bugfix-61946_odd_process_name.t0000644000175000017500000000156513501241771021063 0ustar jwbjwbuse warnings; use Test::More; use Data::Dumper; BEGIN { if ( $^O eq 'cygwin' ) { plan skip_all => 'Test irrelevant on cygwin'; } use_ok('Proc::ProcessTable'); } SKIP: { $0 = "PROC_PROCESSTABLE_TEST_CMD"; sleep(1); my ($ps) = grep {/^$$\s+/} map { chomp; s/^\s*//; $_ } `ps xww`; skip 'Cannot set process name', 1 unless ($ps && $ps =~ /PROC_PROCESSTABLE_TEST_CMD/); $SIG{CHLD} = 'IGNORE'; my $pid = fork; die "cannot fork" unless defined $pid; if ( $pid == 0 ) { #child $0 = '(ib_fmr(mlx4_0))'; sleep 10000; } else { #main sleep 1; my $t = Proc::ProcessTable->new; my $cmnd_quoted = quotemeta('(ib_fmr(mlx4_0))'); my ($p) = grep { $_->{pid} == $pid } @{ $t->table }; like( $p->{cmndline}, qr/$cmnd_quoted/, "odd process commandline bugfix ($cmnd_quoted)" ); kill 9, $pid; } } done_testing(); Proc-ProcessTable-0.59/t/01-instiantied_object_only_methods.t0000644000175000017500000000106013501006311022342 0ustar jwbjwb# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' use strict; use Test::More; BEGIN { plan tests => 2 } # check wether ProcProcessTable is there use Proc::ProcessTable; eval { Proc::ProcessTable->fields; }; like( $@, qr/Must call fields from an initalized object created with new.*/, 'Uninitialized object 1' ); eval { Proc::ProcessTable->table; }; like( $@, qr/Must call table from an initalized object created with new.*/, 'Uninitialized object 2' ); Proc-ProcessTable-0.59/t/manifest.t0000644000175000017500000000047013501006311015311 0ustar jwbjwb#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } my $min_tcm = 0.9; eval "use Test::CheckManifest $min_tcm"; plan skip_all => "Test::CheckManifest $min_tcm required" if $@; ok_manifest(); Proc-ProcessTable-0.59/t/bugfix-106571_odd_process_name.t0000644000175000017500000000257413501242004021124 0ustar jwbjwbuse warnings; use Test::More; use Data::Dumper; BEGIN { if ($^O eq 'cygwin') { plan skip_all => 'Test irrelevant on cygwin'; } use_ok('Proc::ProcessTable'); } SKIP: { $0 = "PROC_PROCESSTABLE_TEST_CMD"; sleep(1); my ($ps) = grep {/^$$\s+/} map { chomp; s/^\s*//; $_ } `ps xww`; skip 'Cannot set process name', 1 unless ($ps && $ps =~ /PROC_PROCESSTABLE_TEST_CMD/); # From Joelle Maslak: Can't set a process name to a blank name on # OpenBSD, so this test is not relevant. From reading perlvar, it # appears that this is likely true on other BSDs, so rather than # looking for the OpenBSD operating system, we see if the command line # starts with "perl:" as it does on OpenBSD (and presumably other # BSDs). See OpenBSD's setproctitle(3) for information on what at # least OpenBSD allows: # https://man.openbsd.org/setproctitle.3 skip 'Likely *BSD system, can\'t blank process name', 1 unless ($ps =~ /^perl: /); $SIG{CHLD} = 'IGNORE'; my $pid = fork; die "cannot fork" unless defined $pid; if ($pid == 0) { #child $0 = ''; sleep 10000; } else { #main sleep 1; my $t = Proc::ProcessTable->new; my $cmnd_quoted = ''; my ($p) = grep { $_->{pid} == $pid } @{ $t->table }; is($p->{cmndline}, $cmnd_quoted, "odd process commandline bugfix ($cmnd_quoted)"); kill 9, $pid; } } done_testing(); Proc-ProcessTable-0.59/t/bugfix-51470_cmndline_mod_error.t0000644000175000017500000000145213501241775021406 0ustar jwbjwbuse warnings; use Test::More; use Data::Dumper; BEGIN { if ($^O eq 'cygwin') { plan skip_all => 'Test irrelevant on cygwin'; } use_ok('Proc::ProcessTable'); } SKIP: { $0 = "PROC_PROCESSTABLE_TEST_CMD"; sleep(1); my ($ps) = grep {/^$$\s+/} map { chomp; s/^\s*//; $_ } `ps xww`; skip 'Cannot set process name', 1 unless ($ps && $ps =~ /PROC_PROCESSTABLE_TEST_CMD/); $SIG{CHLD} = 'IGNORE'; my $pid = fork; die "cannot fork" unless defined $pid; if ($pid == 0) { #child $0 = '01234567890123456789'; sleep 10000; } else { #main sleep 1; my $t = Proc::ProcessTable->new; my ($p) = grep { $_->{pid} == $pid } @{ $t->table }; like($p->{cmndline}, qr/01234567890123456789/, "modulo 20 commandline bugfix"); kill 9, $pid; } } done_testing(); Proc-ProcessTable-0.59/t/process.t0000644000175000017500000000325013501006311015160 0ustar jwbjwb# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' use strict; use Test::More; use Config; # check wether ProcProcessTable is there use Proc::ProcessTable; # Test code $SIG{CHLD} = sub{wait;}; my ( $got, $field ); my $t = Proc::ProcessTable->new; # Is there a process called cron foreach $got ( @{$t->table} ) { next unless $got->pid == $$; # print STDERR $got->pid, " ", $got->fname, "\n"; print STDERR "--------------------------------\n"; foreach $field ($t->fields){ my $v = $got->{$field}; if (ref($v) eq "ARRAY") { $v = "\"" . join ("\",\"", @$v) . "\""; } print STDERR $field, ": ", (defined $v ? $v : ""), "\n"; } } plan skip_all => 'This test needs real fork() implementation' if $Config{d_pseudofork} || !$Config{d_fork}; plan tests => 3; # fork a child process my $child_pid = fork; if ( $child_pid ) { # parent, fork returned pod of the child process foreach $got ( @{$t->table} ) { if( $got->pid == $child_pid ) { ok(1); # pid of the child process found if( $got->kill(9) ) { ok(1); } else { ok(0); kill 9, $child_pid; exit -1; } sleep 2; # the child process should be dead now foreach $got ( @{$t->table} ) { if( $got->pid == $child_pid ) { ok(0); kill 9, $child_pid; exit -1; } } ok(1); exit 0; } } # pid of child was never found ok(0); exit -1; } else { # child, fork returned 0 # child process will be killed soon sleep 10000; } Proc-ProcessTable-0.59/t/pod-coverage.t0000644000175000017500000000125013501006311016053 0ustar jwbjwb#!perl -T use 5.006; use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Proc-ProcessTable-0.59/t/00-load.t0000644000175000017500000000027613501006311014643 0ustar jwbjwb#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Proc::ProcessTable' ) || print "Bail out!\n"; } diag( "Testing Proc::ProcessTable $Proc::ProcessTable::VERSION, Perl $], $^X" ); Proc-ProcessTable-0.59/README.hpux0000644000175000017500000000070613501006311014720 0ustar jwbjwbSupported fields: uid pid ppid dsize tsize ssize nice ttynum pgrp pri addr cpu utime stime start flag state wchan procnum cmd fname time cpticks cptickstotal fss pctcpu rssize suid ucomm shmsize mmsize usize iosize vtsize vdsize vssize vshmsize vmmsize vusize viosize minorfaults majorfaults nswap nsignals msgrcv msgsnd maxrss sid schedpolicy ticksleft rdir cdir text highestfd euid egid ioch usercycles systemcycles interruptcycles gid lwpid Proc-ProcessTable-0.59/README.unixware0000644000175000017500000000171113501006311015573 0ustar jwbjwbSUPPORTED SYSTEMS ================= Tested on UnixWare 7 and 7.1. SUPPORTED ATTRIBUTES ==================== uid UID of process gid GID of process pid process ID ppid parent process ID pgrp process group sess session ID priority priority of process ttynum tty number of process flags flags of process time user + system time size virtual memory size (bytes) rss resident set size (bytes) wchan address of current system call fname file name start start time (seconds since the epoch) state state of process onpro number of processor cmndline full command line of process TODO ==== From the cred structure available from /proc we could get euid, egid and others. BUGS ==== Times for the "time" field are in seconds; this is both inconsistent with the linux module (1/100 seconds) and really crude. Proc-ProcessTable-0.59/README.darwin0000644000175000017500000000477613501006311015233 0ustar jwbjwb SUPPORTED ATTRIBUTES ====================================================== pid process ID ppid parent process ID pgrp process group ID uid UID of process gid GID of process euid effective UID egid effective GID suid saved UID sgid saved GID priority priority of process size size of process in KB (data + stack) rss resident set size in KB flags process flags (see ) nice nice for cpu usage sess session pointer time total cpu time, microseconds stime system time, microseconds utime user time, microseconds start start time of process in seconds since epoch wchan address of current system call (though the docs make it look like we can have a name if we hold our tongues right) ttydev device name of tty, or empty if none ttynum device number of tty, or -1 if none pctcpu (decayed) %cpu for this process pctmem %memory for this process state state of process cmndline entire command line for the process fname command name Note that although time, stime, and utime are returned in microseconds, the actual resolution appears to be centiseconds. BUGS ==== The comments in the code for ps indicate that the cmndline and fname values are not to be relied on, since they are modifiable by the program itself once it begins execution. I'd like to provide the following attributes, I just can't figure out how: sid session id majflt major page faults minflt minor page faults The page fault information actually looks like it might be available, but it appears not to be. At any rate, the distributed ps doesn't provide it. The source for ps contains a bunch of conditionalizations on FIXME, which appears not to be defined. I have dropped them, but it appears that only if FIXME is defined do you get the page fault information, and even then not always. The sess is actually the address of a session structure. I'd love to extract the sid from this structure, but I segv when I try. I didn't try too hard, because the ps command also reports session pointer, not session ID. I'd like to provide the following attributes, but the Darwin ps documentation makes me believe they're not available: exec absolute filename (including path) of executed commandProc-ProcessTable-0.59/README.md0000644000175000017500000001206313501006311014333 0ustar jwbjwb# Proc::ProcessTable [![Build Status](https://travis-ci.org/jwbargsten/perl-proc-processtable.svg?branch=master)](https://travis-ci.org/jwbargsten/perl-proc-processtable) [![Coverage Status](https://coveralls.io/repos/github/jwbargsten/perl-proc-processtable/badge.svg?branch=master)](https://coveralls.io/github/jwbargsten/perl-proc-processtable?branch=master) Please use github or [rt.cpan.org](https://rt.cpan.org/Public/Dist/Display.html?Name=Proc-ProcessTable) to submit bugs and patches. ## MAINTENANCE STATUS This module is maintained by Joachim Bargsten. I have nearly zero knowledge of the implementation within but wanted to rescue the distribution from abandonment and try to get critical bug fixes out. This will need to be a community effort. The source is in github - https://github.com/jwbargsten/perl-proc-processtable Commit bits will be generously granted, send me your github id. ## STATUS This is BETA software; it seems to work, but use at your own risk :) Currently works on darwin, nonstop-ux, Windows (both native MSWin32 and Cygwin), linux, solaris, aix, hpux, freebsd, irix, dec_osf, bsdi, netbsd, unixware 7.x, SunOS and openbsd. Please see the "README.osname" files for details on individual os implementations. Please see the file PORTING if you are interested in making it work on something else. Please see the file TODO for a list of issues that need to be addressed (and send me patches!). Please note that the Windows port is derived from Cygwin code and is therefore covered by the Cygwin license (http://cygwin.com/licensing.html). Multithread support is now available for Solaris; please see README.solaris for info. It may work under other OS's as well; please let me know if it does. Comments, bug reports, patches and especially ports are greatly appreciated. If you want to submit a patch, *please* use standard context-diff format; if you're submitting a port, a tarball of the new files is great. ## DESCRIPTION This module is a first crack at providing a consistent interface to Unix (and maybe other multitasking OS's) process table information. The impetus for this came about with my frustration at having to parse the output of various systems' ps commands to check whether specific processes were running on different boxes at a larged mixed Unix site. The output format of ps was different on each OS, and sometimes changed with each new release of an OS. Also, running a ps subprocess from within a perl or shell script and parsing the output was not a very efficient or aesthetic way to do things. With this module, you can do things like this: # kill memory pigs use Proc::ProcessTable; my $t = Proc::ProcessTable->new; foreach my $p ( @{$t->table} ) { if( $p->pctmem > 95 ){ $p->kill(9); } } There is another short example in the file "example.pl" in the distribution. For a more elaborate example (in German), see . If you can't read German, try my other module, WWW::Babelfish! There are also two contributed modules: a module called Proc::Killall contributed by Aaron Sherman to kill all processes whose command-lines match a given pattern, and a module called Proc::Killfam by Stephen Lidie to kill a list of processes and their children. These modules are installed along with Proc::ProcessTable. Pod documentation is included in both of them. ## INSTALLATION This module needs the File::Find and Storable modules in order to work. File::Find is generally included with perl distributions; Storable is available from CPAN. After unpacking the tar file, do: perl Makefile.PL make make test make install There is embedded POD documentation in ProcessTable.pm and Process/Process.pm. ## ACKNOWLEDGEMENTS Thanks to the many people who have sent in ports and patches. Without them this module would be impossible to support on so many platforms. Patches are noted in the Changes file. * David Paquet : AIX port * Mike Romberg : HPUX port * Slaven Rezic : FreeBSD port * W. Phillip Moore : IRIX port * Peter ? : IRIX version patch * Bernhard Schmalhofer : dec_osf port * Sean Eskins : bsdi port * Peter Reich : netbsd port * Aaron Sherman : Proc::Killall module * Steve Lidie : Killfam.pm module * Martin Lucina : Unixware 7.x port * Shawn Clifford SunOS port * J Robert Ray :Windows (Cygwin) port. * Tom Wyant :Darwin port. * Mike Steinert : Nonstop-UX port. * : Openbsd port. Please note that Bernard Schmalhofer is no longer able to provide support for the dec_osf port. ## COPYRIGHT Copyright (c) 1998-2008 Daniel J. Urist. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Proc-ProcessTable-0.59/README.cygwin0000644000175000017500000000043313501006311015231 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== uid UID of process pid process ID ppid parent process ID pgid process group ID winpid Windows process ID fname file name start start time (seconds since the epoch) ttynum tty number of process state state of process Proc-ProcessTable-0.59/README.freebsd-procfs0000644000175000017500000000141613501006311016637 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== uid UID of process gid GID of process euid effective UID of process egid effective GID of process pid process ID ppid parent process ID pgrp process group sess session ID priority priority of process ttynum tty number of process flags flags of process utime user mode time stime kernel mode time time user + system time wchan address of current system call fname file name start start time (seconds since the epoch) state state of process ttydev path of process's tty cmndline full command line of process priority priority of process Proc-ProcessTable-0.59/README0000644000175000017500000001136713501006311013742 0ustar jwbjwbProc::ProcessTable Please use rt.cpan.org to submit bugs and patches. MAINTENANCE STATUS ================== This module is now being lightly "maintained" by Jonathan Swartz . I have nearly zero knowledge of the implementation within but wanted to rescue the distribution from abandonment and try to get critical bug fixes out. This will need to be a community effort. The source is in github - https://github.com/jwbargsten/perl-proc-processtable Commit bits will be generously granted, send me your github id. STATUS ====== This is BETA software; it seems to work, but use at your own risk :) Currently works on darwin, nonstop-ux, Windows (both native MSWin32 and Cygwin), linux, solaris, aix, hpux, freebsd, irix, dec_osf, bsdi, netbsd, unixware 7.x, SunOS and openbsd. Please see the "README.osname" files for details on individual os implementations. Please see the file PORTING if you are interested in making it work on something else. Please see the file TODO for a list of issues that need to be addressed (and send me patches!). Please note that the Windows port is derived from Cygwin code and is therefore covered by the Cygwin license (http://cygwin.com/licensing.html). Multithread support is now available for Solaris; please see README.solaris for info. It may work under other OS's as well; please let me know if it does. Comments, bug reports, patches and especially ports are greatly appreciated. If you want to submit a patch, *please* use standard context-diff format; if you're submitting a port, a tarball of the new files is great. DESCRIPTION =========== This module is a first crack at providing a consistent interface to Unix (and maybe other multitasking OS's) process table information. The impetus for this came about with my frustration at having to parse the output of various systems' ps commands to check whether specific processes were running on different boxes at a larged mixed Unix site. The output format of ps was different on each OS, and sometimes changed with each new release of an OS. Also, running a ps subprocess from within a perl or shell script and parsing the output was not a very efficient or aesthetic way to do things. With this module, you can do things like this: # kill memory pigs use Proc::ProcessTable; my $t = Proc::ProcessTable->new; foreach my $p ( @{$t->table} ) { if( $p->pctmem > 95 ){ $p->kill(9); } } There is another short example in the file "example.pl" in the distribution. For a more elaborate example (in German), see . If you can't read German, try my other module, WWW::Babelfish! There are also two contributed modules: a module called Proc::Killall contributed by Aaron Sherman to kill all processes whose command-lines match a given pattern, and a module called Proc::Killfam by Stephen Lidie to kill a list of processes and their children. These modules are installed along with Proc::ProcessTable. Pod documentation is included in both of them. INSTALLATION ============ This module needs the File::Find and Storable modules in order to work. File::Find is generally included with perl distributions; Storable is available from CPAN. After unpacking the tar file, do: perl Makefile.PL make make test make install There is embedded POD documentation in ProcessTable.pm and Process/Process.pm. ACKNOWLEDGEMENTS ================ Thanks to the many people who have sent in ports and patches. Without them this module would be impossible to support on so many platforms. Patches are noted in the Changes file. David Paquet AIX port Mike Romberg HPUX port Slaven Rezic FreeBSD port W. Phillip Moore IRIX port Peter ? IRIX version patch Bernhard Schmalhofer dec_osf port Sean Eskins bsdi port Peter Reich netbsd port Aaron Sherman Proc::Killall module Steve Lidie Killfam.pm module Martin Lucina Unixware 7.x port Shawn Clifford SunOS port J Robert Ray Windows (Cygwin) port. Tom Wyant Darwin port. Mike Steinert Nonstop-UX port. Openbsd port. Please note that Bernard Schmalhofer is no longer able to provide support for the dec_osf port. COPYRIGHT ========= Copyright (c) 1998-2008 Daniel J. Urist. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -- Daniel J. Urist durist@frii.com Proc-ProcessTable-0.59/MANIFEST0000644000175000017500000000315613502757612014232 0ustar jwbjwbChanges contrib/pctcpu_example.pl contrib/ppt_profile.pl contrib/ppt_profile_plot.R contrib/pswait hints/aix.pl hints/aix_4_2.pl hints/aix_4_3.pl hints/aix_5.pl hints/aix_6.pl hints/aix_7.pl hints/bsdi.pl hints/cygwin.pl hints/darwin.pl hints/dec_osf.pl hints/dragonfly.pl hints/freebsd.pl hints/gnukfreebsd.pl hints/hpux.pl hints/irix.pl hints/linux.pl hints/midnightbsd.pl hints/MSWin32.pl hints/netbsd.pl hints/openbsd.pl hints/solaris.pl hints/sunos.pl hints/svr4.pl hints/svr5.pl lib/Proc/Killall.pm lib/Proc/Killfam.pm lib/Proc/ProcessTable.pm lib/Proc/ProcessTable/Process.pm Makefile.PL MANIFEST This list of files os/aix.c os/aix.h os/aix_getprocs.c os/aix_getprocs.h os/bsdi.c os/bsdi.h os/darwin.c os/darwin.h os/DecOSF.c os/DecOSF.h os/FreeBSD-kvm.c os/FreeBSD-kvm.h os/FreeBSD.c os/FreeBSD.h os/HPUX.c os/IRIX.c os/IRIX.h os/Linux.c os/Linux.h os/MSWin32.c os/MSWin32.h os/NetBSD.c os/NetBSD.h os/OpenBSD.c os/Solaris.c os/Solaris.h os/SunOS.c os/SunOS.h os/UnixWare.c os/UnixWare.h ProcessTable.xs README README.aix README.bsdi README.cygwin README.darwin README.dec_osf README.freebsd-kvm README.freebsd-procfs README.hpux README.linux README.md README.MSWin32 README.netbsd README.openbsd README.solaris README.sunos README.unixware t/00-load.t t/01-instiantied_object_only_methods.t t/bugfix-106571_odd_process_name.t t/bugfix-51470_cmndline_mod_error.t t/bugfix-61946_odd_process_name.t t/manifest.t t/openbsd-size-rss.t t/pod-coverage.t t/pod.t t/process.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Proc-ProcessTable-0.59/Changes0000644000175000017500000003600713502757557014405 0ustar jwbjwbRevision history for Perl extension Proc::ProcessTable. 0.01 Mon Jun 8 11:37:47 1998 - original version; created by h2xs 1.18 0.03 Sun Jul 26 09:07:50 1998 - added argument to va_end to make linux-ppc work 0.04 Fri Aug 14 22:51:31 1998 - preliminary pre-alpha solaris support 0.05 Wed Dec 9 18:47:39 1998 - fixed minor compilation problems for solaris. Changed rss to bytes on linux for consistency with solaris; also added "time" and "ctime" fields to linux for consistency. Updated documentation in Process.pm. Folded in AIX port by David Paquet . 0.06 Wed Dec 9 23:42:05 1998 - added HPUX port by Mike Romberg . 0.07 Wed Jan 6 14:57:04 1999 - added FreeBSD port by Slaven Rezic . 0.08 Thu Feb 4 00:35:53 1999 - Fixed bug in solaris hints file that was looking for a version of solaris returned by "uname -r" as > 2.5, when "uname -r" returns the "SunOS" version of 5.5. Fixed bug in linux module in which only the first field of the command line was getting passed in cmndline attribute. 0.09 Fri Feb 19 23:23:53 1999 - Fixed bug in Linux.c, fopen() called without corresponding fclose. Added empty DESTROY subs to ProcessTable.pm and Process.pm to fix occasional problems with mod_perl. Changed all instances of sv_undef in ProcessTable.xs to PL_sv_undef to comply with new standard. 0.10 Sat Feb 20 11:29:35 1999 - Added code to ProcessTable.xs to check perl patchlevel version and use either PL_sv_undef or sv_undef since lots of people are still using older versions of perl. 0.11 Sat Mar 6 19:04:39 1999 - Fixed code that checked perl patchlevel version to check directly for definition of PL_sv_undef and define it as sv_undef if it's not there, since it's not clear what patchlevel we need to check for. Also fixed embarrassing and unnecessary call to close() a string in Solaris.c 0.12 Sun Mar 21 10:53:56 1999 - Hopefully the final fix for the sv_undef buglet. 0.14 Fri May 14 06:30:15 1999 - Added port for IRIX from W. Phillip Moore in 0.13, but forgot to add files to MANIFEST and edit Changes (Duh). W. Phillip Moore's port also included a minor patch for Solaris to get the page size from the system. 0.15 Tue Jun 1 21:33:16 1999 - Added patch from Peter ? for IRIX version differences. There seems to be a lot of IRIX out there. 0.16 Mon Aug 9 22:59:46 1999 - Added nanosecond Solaris patch from Rolf Petter Halle . Added port for dec_osf from Bernhard Schmalhofer , which included new version of test code as well. Added bsdi port from Sean Eskins . 0.17 Thu Aug 19 10:57:16 1999 - Lost connection to ISP during upload to PAUSE, and PAUSE won't let me reload it so I have to increment the version number. Kind of annoying. 0.18 Thu Aug 19 10:57:16 1999 - Fixed bug (at least for linux) in Makefile.PL that was causing ProcessTable.xs not to be converted to ProcessTable.c; this was carelessly introduced by me with integration of the port to dec_osf. Added port for netbsd from Peter Reich . 0.19 Mon Aug 30 00:22:02 1999 - Reinstated 'OBJECT' argument in WriteMakefile in Makefile.PL since it was breaking the build on dec-osf, but this time with explicit object files to look for which seems to work, at least under Linux. Why this should be necessary is unclear. Added "fname" field to HPUX (was "cmd") for consistency with other ports and for new test. Added very basic "README.hpux". Added check in ProcessTable.pm to prune search tree for unreadable directories when finding TTY list; this was causing spurious errors during build on dec_osf since some directories under /dev are readable only by root. 0.20 Wed Sep 8 22:27:28 1999 - Added "fields" method to module to return list of fields supported for the current architecture. This is implemented in a slightly kludgy way, since it needs to call the table method if the table method hasn't been called before, since only the table method knows the names of the fields. Also changed the test code to dump all the fields/values available for the current process table, instead of just dumping pids and "fname" which isn't supported on all architectures (though it should be). Added "example.pl" file which contains the same code. 0.21 Fri Sep 10 12:32:13 1999 - Bug fix; new "fields" method was crapping out on everything except Linux-Intel. 0.22 Tue Oct 5 07:47:54 1999 - Bug fix for Solaris; nanosecond process times are only available on 2.6 (and above?); this was causing the module to dump core on earlier systems. Also, size and rss appear to be in kilobytes, not pages in 2.6 and above (they are in pages in the struct prpsinfo in < 2.6, but also available directly as bytes). 0.23 Mon Nov 1 08:32:54 1999 - Added patch from Dave Alden for solaris "nice" and "onproc" fields. 0.24 Thu Jan 20 08:00:30 2000 - Added patches from Noel Paul for dec_osf pctcpu and pctmem, and for IRIX for pctmem. 0.25 Thu Feb 3 11:20:27 2000 - Added patch from F. Buirey for AIX SMP. 0.26 Fri Feb 11 16:43:48 2000 - Added Proc::Killall from Aaraon Sherman . 0.27 Thu Jun 29 08:27:23 2000 - Added patch for converting jiffies to microseconds in linux from Philip Gwyn . Added patch from Slaven Rezic for FreeBSD and to make Storable optional. 0.28 Mon Aug 14 16:31:43 MYT 2000 - Patch from Slaven Rezic to make test script -w clean. 0.29 Tue Jan 9 07:36:13 EST 2001 - Patch from Wolfgang Friebel for os/HPUX.c to make the time method return useful values. Patch from Adrian Phillips to fix AIX cmndline field. Patch from Tryggvi Farestveit to fix bug in cmndline under Linux. Killfam.pm module from Steve Lidie . 0.30 Sun Mar 4 05:05:26 EST 2001 - Patch from David Good for 32-bit HPUX 11.0 support via the 64-bit interface. Port to Unixware 7.x from Martin Lucina . Upgraded status to beta :) 0.31 Fri Jun 1 08:27:03 EDT 2001 - Removed bogus test code line from os/Linux.c that was opening "/tmp/tedddi". 0.32 Sun Aug 19 04:45:25 EDT 2001 -SunOS port from Shawn Clifford . Patch from Thomas Linden for additional Linux fields. Patch for bsdi from Nicolas Belan to add cmndline. 0.33 Wed Oct 10 15:50:17 EDT 2001 -Fixed Solaris large file environment problem (by turning off large file environment CCFLAGS!). Patches from Chris Adams for TTYs with device number(s) zero and Digital Unix table() call to read processes. Added README.taint for workarounds for perl -T. Changed umask for 644 permissions for /tmp/TTYDEVS. 0.34 Sun Feb 24 21:55:07 EST 2002 -Corrected documentation type pointed out by Marcus Crafter . Fix for JIFFIES_TO_MICROSECONDS potential int overflow on linux from Stephen Pillinger . Patch for File::Find routine on AIX (broken POSIX?) from H.Merijn Brand . Big linux code cleanup patch from Anthony Higa ; I *think* this also fixes the linux-ppc problem reported by Marcus Crafter. 0.35 Mon Jul 1 11:24:43 EDT 2002 -Patch from Thomas Glanzmann to fix starttime overflow bug on linux. This should also fix multiprocessor starttime bugs. He says there is another overflow after 25 days of uptime though :( Nearly identical patches from Doug Lewis and Jan L. Peterson to fix taint problem. Patch from Peter van Hooft to allow non-root users to list processes on IRIX. 0.36 Tue Nov 5 23:04:12 EST 2002 -Patch for documentation typo for Killfam.pm from Mike Castle . Patch for AIX v4.2 from James FitzGibbon to take advantage of newer OS API; this also required addition of a new return type (long-long, specified as "j") to ProcessTable.xs. Patch to add new field "numthr" for number of threads for Solaris from Joseph Cavanaugh . Patch for linux compiler warnings from Marcus Crafter . Changed HPUX "cmd" field to "cmndline" for consistency with other ports at the suggestion of Craig Cook . Windows port via Cygwin from J Robert Ray . Patch for multithread support under Solaris from Kong Li . Patch for File::Find::prune tty mapping buglet from . Changed behavior of store_ttydev() in ProcessTable.xs to insert an empty string for processes that don't have a tty, instead of having it return undef. I *think* this will fix a problem reported on HPUX by H.Merijn Brand . Changed ttynums to be treated as unsigned to fix occasional negative ttynum bug reported by Daniel Berger . 0.37 Fri Nov 8 09:50:56 EST 2002 -Patch from Philip Molter to fix typo in Solaris.c. 0.38 Fri Dec 6 22:23:20 EST 2002 -Fixed my omission of new AIX files from MANIFEST. Patch from Tim Cutts for Tru64 clusters. 0.39 Fri Oct 3 11:45:21 MDT 2003 -Project is now hosted on SourceForge. Patch from Aaron Sherman from rt.cpan.org ticket #2578 to add a warn function ppt_warn() instead of sending errors to stderr; changed linux, bsdi and aix. Added ppt_croak and updated PORTING docs. Added port to Darwin from Tom Wyant . Added port to Nonstop-UX from Mike Steinert . Patch from James.FitzGibbon for AIX 5.1 command line args. Added note to README.dec_osf that root access is required. 0.40 Sun Jul 10 19:10:16 MDT 2005 -Added patch for support of FreeBSD-5 via kvm from Oleg King . Added contrib directory and pswait script from dominix . Patch from Steve Linn to handle processes larger than 2GB. Added jiffies-to-microseconds patch for linux from Jason A. Smith . Added patch from rt.cpan.org ticket #12951 to fix Solaris 8 with multi-threaded Perl where readdir_r is defined differently for POSIX compiles. Patch for misreport of PID in cygwin (rt.cpan.org ticket #12840). Fix for FC4 gcc-4 buffer overrun complaint. 0.41 Fri Jun 30 22:04:43 MDT 2006 -Port to openbsd from . Fix for EOVERFLOW in HPUX 11.11 from (rt.cpan.org ticket #18932). Module now requires perl 5.6 as suggested by (rt.cpan.org ticket #15279). Patches from for killall to use fname if cmndline is not defined and rename PID_ZOMBIE to PID_ORPHANED under cygwin (rt.cpan.org ticket #14837, #14836). Fixed empty pctmem bug on linux due to change in format of /proc/meminfo (hopefully this format is stable now??). 0.42 Fri Jan 25 22:29:00 MST 2008 -Patch to fix PROC_FS define in Solaris 5.10 from jlv ; patch to replace kinfo array and use KINFO structure on darwin. Patch from Steve Linn for x86_64 linux. Shortened test code so it only shows info for current process. 0.43 Thu Jul 17 20:59:23 MDT 2008 -Changed 'my $TTYDEVSFILE;' to 'our' to permit multiple versions of perl (rt.cpan.org bug ID 37722); fixed up include file order in os/Linux.h so module will build on OpenSuse 11 per request of Steve Linn ; fixed warning under perl 5,10 (rt.cpan.org bug ID 36666); fixes for numerous problems on darwin from Tom Wyant (rt.cpan.org bug IDs 24331, 32761, and 33698); fix for ARG_MAX dynamic configuration in os/Linux.h (rt.cpan.org bug ID 36283). 0.44 Fri Jul 25 08:25:52 MDT 2008 -Patch from Tom Wyant for darwin issues that didn't make it into 0.43. 0.45 Mon Sep 8 09:13:14 MDT 2008 -Patch from Milosz Tanski to make module thread-safe on linux (rt.cpan.org ID 38709). Patch from Scott Davis for new constructor flag enable_ttys, which when set to 0 disables traversing the device tree. 0.46 Fri, Oct 19 2012 -Initial release by new maintainer jswartz, identical to 0.45 except for meta files and README 0.47 16 Feb. 2013 -Initial releas by new maintainer jwb. Incorporated meta file updates from Jonathan Swartz . Closed a bunch of bugs: Patch from Christian Boitel (fixes #51470); added suggestion from Opera Wang (fixes #51470 even more); patches from Michael Schilli (MSCHILLI) (fix #41397, #46861 and #58236), work on perl w/o threads; pulled commits from Slaven Rezić , use kvm implementation for FreeBSD >= 6.0 (closes #68405 and #16978); fixed bug #69397, fh not closed; fixed RT #72862, unsafe use of /tmp; added tests; 0.48 -Pulled commits from Chris Williams , fixes build errors on NetBSD and OpenBSD. Fixed #72862 (byte order tag in cache file), applied patch to fix #67224 (cygwin PID_ORPHANED) by . Pulled FreeBSD patches from Slaven Rezić ; Pulled from David Zaebst ): Fixes to stay accurate on machines with many cpus (#82175), to include system time into calculations (#80391) and others (#81312, #82175 and #80391) and to fix unknown process states for debian kernels #71976. Tried to get it compiling under MidnightBSD. 0.49 -Fixed #61946 (odd process names), solution by Bernd Kallies. Fixed #48445, patch from Guillaume Rousse. Pulled fixes from Opera Wang. Fixed typos discovered by Salvatore Bonaccorso, David Steinbrunner and HMBRAND. Fixed #89117, patch from yyang. Got it (hopefully) running under kfreebsd. 0.50 - Added hint file for gnukfreebsd. 0.51 - Fixed #65347 (installation hangs on AIX), patch from Rainer Tammer; Fixed #99163 (segfault from canonicalize_file_name), pulled patch from Borislav Nikolov. 0.52 2015-08-23 * Incorporated mainly bugfixes (see github repo for details); OS affected: NetBSD, cygwin, AIX, bsdi, Linux * Added test for another odd command name ([]) * Added some scripts for process tracking. Still in beta-phase. 0.53 2015-08-24 * Fixed bug in Linux occurring if process name is empty (RT#106571) * Added missing includes on AIX (RT#39748) * Some minor changes on tests and documentation 0.56 2019-02-07 * Testing support for mswin32 * minor fix for FreeBSD 0.59 2019-06-20 * works again on AIX * fixed mswin32 stuff, hope it works now * reogranized code and started to use newest version ExtUtils::MakeMaker Proc-ProcessTable-0.59/README.dec_osf0000644000175000017500000000224713501006311015340 0ustar jwbjwbNote: On Tru64, scripts have to run as root to get process table access. SUPPORTED ATTRIBUTES ==================== uid UID of process gid GID of process euid EUID of process egid EGID of process suid SUID of process sgid SGID of process groups array of supplemental groups pid process ID ppid parent process ID pgrp process group sess session ID priority priority of process ttynum tty number of process flags flags of process time user + system time size virtual memory size (bytes) rss resident set size (bytes) start start time (seconds since the epoch) fname file name pctcpu percent cpu used since process started state state of process cmndline full command line of process TODO ==== From the pstatus structure available from /proc we could get utime, stime, cutime and cstime. Where can we get the number of threads running within the process? BUGS ==== Time for the "time" field is in seconds; this is both inconsistent with the linux module (1/100 seconds) and really crude. Proc-ProcessTable-0.59/ProcessTable.xs0000644000175000017500000002546013501006311016023 0ustar jwbjwb#ifdef PROCESSTABLE_THREAD #define __REENTRANT #endif #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #ifdef PROCESSTABLE_THREAD #include #endif /* dTHX was used in perl 5.005 */ #ifndef dTHX #define dTHX dTHR #endif /********************/ /* General includes */ /********************/ #include #include #include #include #include /* prototypes to make the compiler shut up */ void ppt_warn(const char*, ...); void ppt_die(const char*, ...); void store_ttydev(HV*, unsigned long); void bless_into_proc(char* , char**, ...); void OS_get_table(); char* OS_initialize(); char** Fields = NULL; int Numfields; /* Cache a pointer the TTY device number hash for quick lookups */ HV* Ttydevs; /* This holds a pointer to the list of process objects we will build */ AV* Proclist; /* Our local varargs warn which can be called as extern by code * that doesn't know Perl internals (and thus doesn't have a * warn() defined). * * I think vwarn() and vcroak() have been changed to warn() and * croak() in perl 5.8?? warn and croak exist in 5.6, but don't * seem to accept format args. */ void ppt_warn(const char *pat, ...) { dTHX; va_list args; va_start(args, pat); vwarn(pat, &args); va_end(args); } /* same with croak */ void ppt_croak(const char *pat, ...) { dTHX; va_list args; va_start(args, pat); vcroak(pat, &args); va_end(args); } /* Look up the tty device, given the ttynum and store it */ void store_ttydev( HV* myhash, unsigned long ttynum ){ SV** ttydev; char ttynumbuf[1024]; sprintf(ttynumbuf, "%lu", ttynum); if( Ttydevs != NULL && (ttydev = hv_fetch(Ttydevs, ttynumbuf, strlen(ttynumbuf), 0)) != NULL ){ hv_store(myhash, "ttydev", strlen("ttydev"), newSVsv(*ttydev), 0); } else{ /* hv_store(myhash, "ttydev", strlen("ttydev"), newSV(0), 0); */ /* Stuff an empty string into the hash if there is no tty; this */ /* way the ttydev method won't return undef for nonexistent ttys. I'm */ /* not sure if this is really the right behavior... */ hv_store(myhash, "ttydev", strlen("ttydev"), newSVpv("",0), 0); } } /**********************************************************************/ /* This gets called by OS-specific get_table */ /* format specifies what types are being passed in, in a string */ /* containing these specifiers: */ /* A ignore this array of strings */ /* a array of strings, delimated with NULL, next argument is len */ /* S ignore this string */ /* s string */ /* I ignore this int */ /* i int */ /* L ignore this long */ /* l long */ /* J ignore this long-long */ /* j long-long */ /* U ignore this unsigned */ /* u unsigned */ /* V perl scalar value */ /* P ignore this string */ /* p unsigned long */ /* fields is an array of pointers to field names */ /* following that is a var args list of field values */ /**********************************************************************/ void bless_into_proc(char* format, char** fields, ...){ va_list args; char* key; char* s_val; SV *SV_val; int i_val; unsigned u_val; long l_val; unsigned long p_val; long long ll_val; HV* myhash; SV* ref; HV* mystash; SV* blessed; /* Blech */ if(Fields == NULL){ Fields = fields; Numfields = strlen(format); } myhash = newHV(); /* create a perl hash */ va_start(args, fields); while( *format ){ key = *fields; switch(*format) { case 'A': /* ignore; creates an undef value for this key in the hash */ va_arg(args, char *); va_arg(args, int); hv_store(myhash, key, strlen(key), &PL_sv_undef, 0); break; case 'a': /* string */ s_val = va_arg(args, char *); i_val = va_arg(args, int); { int len; char *s; AV *av = newAV(); for (s = s_val; s < (s_val + i_val); s += len + 1) { len = strlen(s); av_push (av, newSVpvn (s, len)); } hv_store (myhash, key, strlen(key), newRV_noinc((SV *) av), 0); } break; case 'S': /* ignore; creates an undef value for this key in the hash */ va_arg(args, char *); hv_store(myhash, key, strlen(key), newSV(0), 0); break; case 's': /* string */ s_val = va_arg(args, char *); hv_store(myhash, key, strlen(key), newSVpv(s_val, strlen(s_val)), 0); break; case 'I': /* ignore; creates an undef value for this key in the hash */ va_arg(args, int); hv_store(myhash, key, strlen(key), newSV(0), 0); break; case 'i': /* int */ i_val = va_arg(args, int); hv_store(myhash, key, strlen(key), newSViv(i_val), 0); /* Look up and store the tty if this is ttynum */ if( !strcmp(key, "ttynum") ) store_ttydev( myhash, i_val ); break; case 'U': /* ignore; creates an undef value for this key in the hash */ va_arg(args, unsigned ); hv_store(myhash, key, strlen(key), newSV(0), 0); break; case 'u': /* int */ u_val = va_arg(args, unsigned); hv_store(myhash, key, strlen(key), newSVuv(u_val), 0); break; case 'L': /* ignore; creates an undef value for this key in the hash */ va_arg(args, long); hv_store(myhash, key, strlen(key), newSV(0), 0); break; case 'l': /* long */ l_val = va_arg(args, long); hv_store(myhash, key, strlen(key), newSVnv(l_val), 0); /* Look up and store the tty if this is ttynum */ if( !strcmp(key, "ttynum") ) store_ttydev( myhash, l_val ); break; case 'P': /* ignore; creates an undef value for this key in the hash */ va_arg(args, unsigned long); hv_store(myhash, key, strlen(key), newSV(0), 0); break; case 'p': /* unsigned long */ p_val = va_arg(args, unsigned long); hv_store(myhash, key, strlen(key), newSVnv(p_val), 0); break; case 'J': /* ignore; creates an undef value for this key in the hash */ va_arg(args, long long); hv_store(myhash, key, strlen(key), newSV(0), 0); break; case 'j': /* long long */ ll_val = va_arg(args, long long); hv_store(myhash, key, strlen(key), newSVnv(ll_val), 0); break; case 'V': /* perl scalar value */ SV_val = va_arg(args, SV *); hv_store(myhash, key, strlen(key), SV_val, 0); break; default: croak("Unknown data format type `%c' returned from OS_get_table", *format); va_end(args); } format++; fields++; } /* objectify the hash */ ref = newRV_noinc((SV*) myhash); /* create ref from hash pointer */ mystash = gv_stashpv("Proc::ProcessTable::Process", 1); /* create symbol table for this obj */ blessed = sv_bless(ref, mystash); /* bless it */ /* push it onto the array */ av_push(Proclist, blessed); va_end(args); } /**********************************************************************/ /* Generic funcs generated by h2xs */ /**********************************************************************/ static int not_here(s) char *s; { croak("%s not implemented on this architecture", s); return -1; } static double constant(name, arg) char *name; int arg; { errno = 0; switch (*name) { } errno = EINVAL; return 0; not_there: errno = ENOENT; return 0; } #ifdef PROCESSTABLE_THREAD pthread_mutex_t _mutex_table; pthread_mutex_t _mutex_new; void mutex_op(int lock, pthread_mutex_t *mutex) { if (lock == 0) { /*unlock*/ pthread_mutex_unlock(mutex); } else { /*lock*/ pthread_mutex_lock(mutex); } } #endif void mutex_new(int lock) { #ifdef PROCESSTABLE_THREAD mutex_op(lock, &_mutex_new); #endif } void mutex_table(int lock) { #ifdef PROCESSTABLE_THREAD mutex_op(lock, &_mutex_table); #endif } MODULE = Proc::ProcessTable PACKAGE = Proc::ProcessTable PROTOTYPES: DISABLE BOOT: #ifdef PROCESSTABLE_THREAD pthread_mutex_init(&_mutex_table, NULL); pthread_mutex_init(&_mutex_new, NULL); #endif void mutex_new(lock) int lock void mutex_table(lock) int lock double constant(name,arg) char * name int arg SV* table(obj) SV* obj CODE: /* Check that we have an actual object. calling Proc::Processtable->table SIGSEVs calling on an actual object is valid my $proc_obj = Proc::ProcessTable->new; $proc_obj->table; */ if (!obj || !SvOK (obj) || !SvROK (obj) || !sv_isobject (obj)) { croak("Must call table from an initalized object created with new"); } HV* hash; SV** fetched; mutex_table(1); /* Cache a pointer to the tty device hash */ Ttydevs = perl_get_hv("Proc::ProcessTable::TTYDEVS", FALSE); /* dereference our object to a hash */ hash = (HV*) SvRV(obj); /* If the Table array already exists on our object we clear it and store a pointer to it in Proclist */ if( hv_exists(hash, "Table", 5) ){ /* fetch the hash entry */ fetched = hv_fetch(hash, "Table", 5, 0); /* what's stored in the hash is a ref to the array, so we need to dereference it */ Proclist = (AV*) SvRV(*fetched); av_clear(Proclist); } else{ /* Otherwise we create the array and store it on the object. */ Proclist = newAV(); hv_store(hash, "Table", 5, newRV_noinc((SV*)Proclist), 0); } /* Call get_table to build the process objects and push them onto the Proclist */ OS_get_table(); /* Return a ref to our process list */ RETVAL = newRV_inc((SV*) Proclist); mutex_table(0); OUTPUT: RETVAL void fields(obj) SV* obj PPCODE: /* see above. This should be called on an object generated by new */ if (!obj || !SvOK (obj) || !SvROK (obj) || !sv_isobject (obj)) { croak("Must call fields from an initalized object created with new"); } int i; SV* my_sv; if( Fields == NULL ){ PUSHMARK(SP); XPUSHs(obj); PUTBACK; perl_call_method("table", G_DISCARD); } EXTEND(SP,Numfields); for (i=0; i < Numfields; i++ ){ my_sv = newSVpv(Fields[i],0); PUSHs(sv_2mortal(my_sv)); } void _initialize_os(obj) SV* obj CODE: char* error; if( (error = OS_initialize()) != NULL ){ croak("%s", error); } Proc-ProcessTable-0.59/README.linux0000644000175000017500000000345513501006311015077 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== uid UID of process euid Effective UID of process suid Saved UID of process fuid File UID of process gid GID of process egid Effective GID of process sgid Saved GID of process fgid File GID of process pid process ID ppid parent process ID pgrp process group sess session ID priority priority of process ttynum tty number of process flags flags of process minflt minor page faults cminflt child minor page faults majflt major page faults cmajflt child major page faults utime user mode time (microseconds) stime kernel mode time (microseconds) cutime child utime (microseconds) cstime child stime (microseconds) time user + system time (microseconds) ctime child user + system time (microseconds) size virtual memory size (bytes) rss resident set size (bytes) wchan address of current system call fname file name start start time (seconds since the epoch) pctcpu percent cpu used since process started state state of process pctmem percent memory cmndline full command line of process exec absolute filename (including path) of executed command ttydev path of process's tty cwd current directory of process NOTE ==== This now correctly gives you microseconds. Previously all times were actually in milliseconds even though this file said microseconds. -Jason Smith BUGS ==== Though times are now converted to microseconds, they are limited to jiffie resolution. A jiffie is 100 Hertz on most platforms, 1024 Hertz on Alpha. -Philip Gwyn Proc-ProcessTable-0.59/hints/0000755000175000017500000000000013502757611014220 5ustar jwbjwbProc-ProcessTable-0.59/hints/freebsd.pl0000644000175000017500000000062113501006311016145 0ustar jwbjwbrequire Config; my($maj) = $Config::Config{osvers} =~ m{^(\d+)}; if ($maj < 5) { print STDERR "Using procfs implementation\n"; symlink "os/FreeBSD.c", "OS.c" || die "Could not link os/FreeBSD.c to os/OS.c\n"; } else { print STDERR "Using kvm implementation\n"; symlink "os/FreeBSD-kvm.c", "OS.c" || die "Could not link os/FreeBSD-kvm.c to os/OS.c\n"; $self->{LIBS} = ['-lkvm']; } Proc-ProcessTable-0.59/hints/linux.pl0000644000175000017500000000051213501006311015671 0ustar jwbjwbuse Config; symlink "os/Linux.c", "OS.c" || die "Could not link os/Linux.c to os/OS.c\n"; # We might have a non-threading perl, which doesn't add this # necessary link option. my $thread_lib = "-lpthread"; if( $Config{libs} !~ /(?:^|\s)$thread_lib(?:\s|$)/ ) { $self->{LIBS} ||= []; push @{ $self->{LIBS} }, $thread_lib; } Proc-ProcessTable-0.59/hints/svr5.pl0000644000175000017500000000055513501006311015440 0ustar jwbjwb# Check this is UnixWare 7 or above. `uname` =~ /UnixWare/ || die "Not a supported SVR5\n"; # If this OS version supports the new /proc filesystem, use it. `uname -v` =~ /^([\d\.]+)$/; unless( $1 >= 7 ){ die "Unsupported OS Version: $1\n"; } symlink "os/UnixWare.c", "OS.c" || die "Could not link os/UnixWare.c to os/OS.c\n"; $self->{DEFINE} = "-D_KMEMUSER"; Proc-ProcessTable-0.59/hints/cygwin.pl0000644000175000017500000000016413501006311016035 0ustar jwbjwbsymlink "os/MSWin32.c", "OS.c" || die "Could not link os/MSWin32.c to OS.c\n"; $self->{DEFINE} .= " -DUSE_CYGWIN"; Proc-ProcessTable-0.59/hints/MSWin32.pl0000644000175000017500000000032413501006311015675 0ustar jwbjwbuse File::Copy; unlink "OS.c" if -e "OS.c"; File::Copy::copy "os/MSWin32.c", "OS.c" or die "Could not copy os/MSWin32.c to OS.c\n"; utime time, time, "OS.c"; # Win32 does not update the mod time of a copied file Proc-ProcessTable-0.59/hints/bsdi.pl0000644000175000017500000000011413501006311015451 0ustar jwbjwbsymlink "os/bsdi.c", "OS.c" || die "Could not link os/bsdi.c to os/OS.c\n"; Proc-ProcessTable-0.59/hints/aix_4_3.pl0000644000175000017500000000017413501006311015764 0ustar jwbjwbsymlink "os/aix_getprocs.c", "OS.c" || die "Could not link os/aix_getprocs.c to os/OS.c\n"; $self->{LIBS} = "-lodm -lcfg"; Proc-ProcessTable-0.59/hints/aix_5.pl0000644000175000017500000000017413501006311015543 0ustar jwbjwbsymlink "os/aix_getprocs.c", "OS.c" || die "Could not link os/aix_getprocs.c to os/OS.c\n"; $self->{LIBS} = "-lodm -lcfg"; Proc-ProcessTable-0.59/hints/aix_4_2.pl0000644000175000017500000000017413501006311015763 0ustar jwbjwbsymlink "os/aix_getprocs.c", "OS.c" || die "Could not link os/aix_getprocs.c to os/OS.c\n"; $self->{LIBS} = "-lodm -lcfg"; Proc-ProcessTable-0.59/hints/aix.pl0000644000175000017500000000015213501006311015313 0ustar jwbjwbsymlink "os/aix.c", "OS.c" || die "Could not link os/aix.c to os/OS.c\n"; $self->{LIBS} = "-lodm -lcfg"; Proc-ProcessTable-0.59/hints/aix_7.pl0000644000175000017500000000017413501006311015545 0ustar jwbjwbsymlink "os/aix_getprocs.c", "OS.c" || die "Could not link os/aix_getprocs.c to os/OS.c\n"; $self->{LIBS} = "-lodm -lcfg"; Proc-ProcessTable-0.59/hints/dec_osf.pl0000644000175000017500000000011513501006311016133 0ustar jwbjwbsymlink "os/DecOSF.c", "OS.c" || die "Could not link os/DecOSF.c to OS.c\n"; Proc-ProcessTable-0.59/hints/netbsd.pl0000644000175000017500000000012013501006311016004 0ustar jwbjwbsymlink "os/NetBSD.c", "OS.c" || die "Could not link os/NetBSD.c to os/OS.c\n"; Proc-ProcessTable-0.59/hints/darwin.pl0000644000175000017500000000012013501006311016011 0ustar jwbjwbsymlink "os/darwin.c", "OS.c" || die "Could not link os/darwin.c to os/OS.c\n"; Proc-ProcessTable-0.59/hints/dragonfly.pl0000644000175000017500000000012213501006311016514 0ustar jwbjwbsymlink "os/FreeBSD.c", "OS.c" || die "Could not link os/FreeBSD.c to os/OS.c\n"; Proc-ProcessTable-0.59/hints/hpux.pl0000644000175000017500000000011413501006311015514 0ustar jwbjwbsymlink "os/HPUX.c", "OS.c" || die "Could not link os/HPUX.c to os/OS.c\n"; Proc-ProcessTable-0.59/hints/svr4.pl0000644000175000017500000000055513501006311015437 0ustar jwbjwb# Check this is UnixWare 7 or above. `uname` =~ /UnixWare/ || die "Not a supported SVR5\n"; # If this OS version supports the new /proc filesystem, use it. `uname -v` =~ /^([\d\.]+)$/; unless( $1 >= 7 ){ die "Unsupported OS Version: $1\n"; } symlink "os/UnixWare.c", "OS.c" || die "Could not link os/UnixWare.c to os/OS.c\n"; $self->{DEFINE} = "-D_KMEMUSER"; Proc-ProcessTable-0.59/hints/midnightbsd.pl0000644000175000017500000000025413501006311017031 0ustar jwbjwbprint STDERR "Using kvm implementation for FreeBSD\n"; symlink "os/FreeBSD-kvm.c", "OS.c" || die "Could not link os/FreeBSD-kvm.c to os/OS.c\n"; $self->{LIBS} = ['-lkvm']; Proc-ProcessTable-0.59/hints/solaris.pl0000644000175000017500000000261413501006311016213 0ustar jwbjwbsymlink "os/Solaris.c", "OS.c" || die "Could not link os/Solaris.c to os/OS.c\n"; # Historical Note (please correct me if this is wrong!): # # A linux-like /proc filesystem was introduced with Solaris 2.6, with # process information available in pseudo-files under pseudo-directories # named for process ids in /proc. Previous to 2.6 Solaris used a # half-baked ioctl-based /proc scheme. Previous to this (SunOS, maybe # much earlier versions of Solaris?) process information was only # available through /dev/kmem, which required root access (ps is setuid # on SunOS-- yuck). All three schemes are supported and available in 2.6, # but at least the ioctl-based /proc support is supposed to be going away. # If this OS version supports the new /proc filesystem, use it; # otherwise default to ioctl-proc `uname -r` =~ /^(\d+\.\d+)/; if( $1 !~ /^5.[012345]$/ ){ $self->{DEFINE} = $self->{DEFINE} . " -DPROC_FS"; } $self->{DEFINE} .= " -D_POSIX_PTHREAD_SEMANTICS"; # For reasons I don't understand, we have to turn off the large file # environment flags in order to compile in the large file environment #10/28/2002: # Should not set CCLFAGS to empty. Should only remove these two symbol while preserving others. if( `/usr/bin/getconf LFS_CFLAGS` =~ /-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64/){ $self->{CCFLAGS} = $Config{ccflags}; $self->{CCFLAGS} =~ s/-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64//; } Proc-ProcessTable-0.59/hints/sunos.pl0000644000175000017500000000014713501006311015705 0ustar jwbjwbsymlink "os/SunOS.c", "OS.c" || die "Could not link os/SunOS.c to os/OS.c\n"; $self->{LIBS} = "-lkvm"; Proc-ProcessTable-0.59/hints/openbsd.pl0000644000175000017500000000015513501006311016167 0ustar jwbjwbsymlink "os/OpenBSD.c", "OS.c" || die "Could not link os/OpenBSD.c to os/OS.c\n"; $self->{LIBS} = ['-lkvm']; Proc-ProcessTable-0.59/hints/aix_6.pl0000644000175000017500000000017413501006311015544 0ustar jwbjwbsymlink "os/aix_getprocs.c", "OS.c" || die "Could not link os/aix_getprocs.c to os/OS.c\n"; $self->{LIBS} = "-lodm -lcfg"; Proc-ProcessTable-0.59/hints/gnukfreebsd.pl0000644000175000017500000000051213501006311017031 0ustar jwbjwbuse Config; symlink "os/Linux.c", "OS.c" || die "Could not link os/Linux.c to os/OS.c\n"; # We might have a non-threading perl, which doesn't add this # necessary link option. my $thread_lib = "-lpthread"; if( $Config{libs} !~ /(?:^|\s)$thread_lib(?:\s|$)/ ) { $self->{LIBS} ||= []; push @{ $self->{LIBS} }, $thread_lib; } Proc-ProcessTable-0.59/hints/irix.pl0000644000175000017500000000062113501006311015506 0ustar jwbjwbsymlink "os/IRIX.c", "OS.c" || die "Could not link os/IRIX.c to OS.c\n"; # If this OS version supports the new /proc filesystem, use it; # otherwise default to ioctl-proc #`uname -r` =~ /^(\d+\.\d+)/; #if( $1 > 5.5 ){ # $self->{DEFINE} = "-DPROC_FS"; #} # I really hope we won't go beyond IRIX 999.999 `uname -r` =~ /^(\d+)\.(\d+)/; $self->{DEFINE} = sprintf "-DIRIX_VERSION=0x%03d%03d", $1,$2; Proc-ProcessTable-0.59/README.freebsd-kvm0000644000175000017500000000355113501006311016142 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== pid process ID ppid parent process ID uid UID euid effective UID gid GID groups array of group ids pgrp process GID sess process session ID jid Jail ID flags P_* flags sflags PS_* flags start start time time running time (in seconds) utime user time (in seconds) stime system time (in seconds) ctime running child time (in seconds) cutime child user time (in seconds) cstime child system time (in seconds) pctcpu percent CPU usage wchan current system call state state of process ttydev path of process's tty ttynum tty number of process fname command name cmndline full command line of process priority user priority of process nice nice value of process vmsize virtual size (bytes) size alias for vmsize rssize current resident set size in pages rss current resident set size in bytes tsize text size (pages) XXX dsize data size (pages) XXX ssize stack size (pages) minflt minor page faults cminflt child minor page faults majflt major page faults cmajflt child major page faults numthr number of threads in total onpro which cpu process in on (starting from 0), or undef COMMENT ======= FreeBSD 5.X not mounting /proc by default. Procfs is vulnerable system and its use is not recommended in future. In addition, mapping processes space to /proc is not correct (at least, in 7 of 7 my freebsd servers with FreeBSD5 installed). So, I decided to write this code. This module works via the kvm system. Any comments please send to king2@kaluga.ru. Proc-ProcessTable-0.59/README.solaris0000644000175000017500000000257113501006311015412 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== uid UID of process gid GID of process euid effective UID of process egid effective GID of process pid process ID ppid parent process ID pgrp process group sess session ID priority priority of process ttynum tty number of process flags flags of process time user + system time ctime child user + system time size virtual memory size (bytes) rss resident set size (bytes) wchan address of current system call fname file name start start time (seconds since the epoch) pctcpu percent cpu used since process started state state of process pctmem percent memory cmndline full command line of process ttydev path of process's tty Thread ====== One can enable thread support by adding -DPROCESSTABLE_THREAD to the DEFINE line in Makefile.PL. Once this is done, one can invoke Proc::ProcessTable module from multiple threads within the same process. BUGS ==== There is an 80-character limit for the cmndline field; this is a limitation of the Solaris proc filesystem (at least up to Solaris 2.7). The only way to get at commandlines longer than that is to read /dev/kmem, which would be a major pain. Hopefully sun will fix this at some point in the future. Proc-ProcessTable-0.59/README.netbsd0000644000175000017500000000130213501006311015204 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== uid UID of process gid GID of process euid effective UID of process egid effective GID of process pid process ID ppid parent process ID pgrp process group sess session ID priority priority of process ttynum tty number of process flags flags of process utime user mode time stime kernel mode time time user + system time wchan address of current system call fname file name start start time (seconds since the epoch) state state of process ttydev path of process's tty Proc-ProcessTable-0.59/README.MSWin320000644000175000017500000000041113501006311015067 0ustar jwbjwbSUPPORTED ATTRIBUTES ==================== uid UID of process pid process ID ppid parent process ID fname file name start start time (seconds since the epoch) sid SID of process user_name user name of process domain_name domain name of process Proc-ProcessTable-0.59/contrib/0000755000175000017500000000000013502757611014533 5ustar jwbjwbProc-ProcessTable-0.59/contrib/pswait0000755000175000017500000000526713501006311015761 0ustar jwbjwb#!/usr/bin/perl use strict; use Proc::ProcessTable; exit if ( $#ARGV == -1 ); $|++; my $ptable = Proc::ProcessTable->new; my %waited = (); my %proc; $proc{ $_->pid }=$_->fname foreach (@{$ptable->table}); use Getopt::Long; use Pod::Usage; GetOptions( 'e|exit+' => \( my $endfirst = 0 ), 'v|verbose+' => \( my $verbose = 0 ), 'h|help+' => \( my $help = 0 ), 's|sleep=i' => \( my $sleeptime = 1 ) ); pod2usage(-verbose => 1) && exit if $help; foreach (@ARGV) { next if ( $_ == $$ ); # DON'T wait for myself ! if (/\d+/) { if ( exists $proc{$_} ) { $waited{$_}++; } else { print "nothing like $_\n" if $verbose } next; } foreach my $p ( keys %proc ) { next if ( $p == $$ ); # DON'T wait for myself I said ! $waited{$p}++ if ( $proc{$p} =~ /$_/ ); } } if ($verbose) { print "I am process $$\n"; print "waiting after $_ \n" for ( keys %waited ); print "sleep time set to $sleeptime s\n"; print "will exit on first terminated process\n" if ( $endfirst ); } my $count = scalar keys(%waited); while ( scalar keys(%waited) ) { sleep $sleeptime; %proc = (); $proc{ $_->pid }++ foreach (@{$ptable->table}); foreach my $p ( keys %waited ) { if ( !exists $proc{$p} ) { print "gone $p\n" if $verbose; delete $waited{$p}; } } last if (( scalar keys(%waited) < $count ) && ($endfirst)); } __END__ =head1 PSWAIT pswait - waiting for process(es) to end before doing things =head1 SYNOPSIS pswait [options] [process ID|NAME ...] =head1 USAGE pswait [options] [process ID|NAME ...] Options: -h --help brief help message -v --verbose be verbose -e --exit exit after first process end -s x --sleep x set sleep time to x second (default to 1) =head1 OPTIONS =over 8 =item B<-e, --exit> When giving a list of process to watch, exit when the first process end, it is usefull to easily manage a pool of proces with a shell script. =item B<-h. --help> Print a brief help message and exits. =item B<-s x, --sleep x> set sleep time to x seconds between process checking, default to 1 second. On small machines (or overloaded machines) it could help to check process state only once every minutes instead, using for example -s 60 =item B<-v, --verbose> Inform you on what happening ... which process ends, which process ID are watched for state (usefull when using process names on command line). =back =head1 DESCRIPTION B will read the process table of the system and wait for some process to end =head1 AUTHOR DominiX =cut Proc-ProcessTable-0.59/contrib/pctcpu_example.pl0000644000175000017500000000407213501006311020063 0ustar jwbjwb#!/usr/bin/env perl # created on 2018-02-12 use warnings; use strict; use v5.11; use Proc::ProcessTable; use Time::HiRes; my @time_spans; my %cpu_times; my $ppt = Proc::ProcessTable->new; my $start_time = [ Time::HiRes::gettimeofday() ]; my $poll_intervall = int( 2 * 1000 * 1000 ); # 2 sec my $num_steps = 2; local $| = 1; my $cur_step = 0; while (1) { # current and old index of array. # because of modulo, the idcs are rotated. # the old index is always the oldest recorded entry # this means the entry *after* the current index #[ c o . . . ] #[ . c o . . ] #[ . . c o . ] #[ . . . c o ] #[ o . . . c ] my $cur_idx = $cur_step % $num_steps; my $old_idx = ( $cur_step + 1 ) % $num_steps; # calc pct cpu per interval: # we need seconds since # https://stackoverflow.com/questions/16726779/how-do-i-get-the-total-cpu-usage-of-an-application-from-proc-pid-stat my $t = Time::HiRes::tv_interval($start_time); my $pt = $ppt->table; my %active_procs = (); for my $p (@$pt) { # init process info if non-existent my $pid = $p->pid; $active_procs{$pid} = 1; $cpu_times{$pid} //= []; $cpu_times{$pid}[$cur_idx] = $p->time; } $time_spans[$cur_idx] = $t; # clean the cputimes hash my @killed_procs = grep { !$active_procs{$_} } keys %cpu_times ; delete @cpu_times{@killed_procs}; my $ratio = 0; # make sure the array is filled with cpu times if ( $cur_step >= $num_steps ) { # move cursor to top left of screen print "\033[2J"; printf( "%-5s %s\n", "cpu", "pid"); # show cpu usage per process for my $pid (keys %cpu_times) { my $cpu_time = $cpu_times{$pid}; my $diff_cpu = ( $cpu_time->[$cur_idx] - ( $cpu_time->[$old_idx] // 0 ) ) / 1e6; my $diff_start = ( $time_spans[$cur_idx] - $time_spans[$old_idx] ); $ratio = $diff_cpu / $diff_start if ( $diff_start > 0 ); # show only processes that have a usage > 1% printf( "%5.1f %s\n", $ratio * 100, $pid ) if ( $ratio > 0.01 ); } } $cur_step++; Time::HiRes::usleep($poll_intervall); } Proc-ProcessTable-0.59/contrib/ppt_profile.pl0000755000175000017500000000665013501006311017404 0ustar jwbjwb#!/usr/bin/env perl use warnings; use strict; use Time::HiRes; use Proc::ProcessTable; use Pod::Usage; use Getopt::Long qw(:config auto_help); use IO::Handle; my %opt = ( interval => 1, num_steps => 3, ); GetOptions( \%opt, 'process_id|pid|p', 'help|?', 'interval=f', 'num_steps=i' ) or pod2usage(2); pod2usage( -exitval => 0, -verbose => 2 ) if ( $opt{help} ); pod2usage(2) unless ( @ARGV && @ARGV > 1 ); my ( $log_fn, @cmd ) = @ARGV; my $poll_intervall = int($opt{interval} * 1000 * 1000); my $num_steps = $opt{num_steps}; my $script_start_time = [ Time::HiRes::gettimeofday() ]; my $pid; if ( $opt{process_id} ) { $pid = shift @cmd; } else { $SIG{CHLD} = 'IGNORE'; $pid = fork; die "cannot fork" unless defined $pid; } if ( $pid == 0 ) { #child system(@cmd); exit; } else { #main my $time_point = 1; my @start_time; my @cpu_time; my $ppt = Proc::ProcessTable->new; say STDERR "tracking PID $pid"; my $log_fh; if ( $log_fn eq '-' ) { $log_fh = \*STDOUT; } else { open $log_fh, '>', $log_fn or die "Can't open filehandle: $!"; } print $log_fh join( "\t", qw/tp time pids rss vsz pcpu/ ), "\n"; while ( kill( 0, $pid ) ) { my $t = Time::HiRes::tv_interval($script_start_time); my $pt = parse_ppt( $ppt->table ); my @pids; my $sum_rss = 0; my $sum_vsz = 0; my $sum_cpu = 0; my $sum_start = 0; my %childs = map { $_ => 1 } subproc_ids( $pid, $pt ); $childs{$pid}++ if ( $opt{process_id} ); for my $p (@$pt) { #[0] pid #[1] ppid #[2] rss #[3] size #[4] time #[5] start if ( $childs{ $p->[0] } ) { $sum_rss += $p->[2]; $sum_vsz += $p->[3]; # utime + stime (cutime and cstime not needed, because we iterate through children $sum_cpu += $p->[4]; push @pids, $p->[0]; } } # calc pct cpu per interval: # we need seconds since #https://stackoverflow.com/questions/16726779/how-do-i-get-the-total-cpu-usage-of-an-application-from-proc-pid-stat #pctcpu = ( 100.0f * sum over all (prs->utime + prs->stime ) * 1/1e6 ) / (time(NULL) - prs->start_time); shift @cpu_time if ( @cpu_time > $num_steps ); push @cpu_time, $sum_cpu; shift @start_time if ( @start_time > $num_steps ); push @start_time, $t; my $ratio = 0; if ( @start_time >= $num_steps ) { my $diff_cpu = ( $cpu_time[-1] - $cpu_time[0] ) / 1e6; my $diff_start = ( $start_time[-1] - $start_time[0] ); $ratio = $diff_cpu / $diff_start if ( $diff_start > 0 ); } print $log_fh join( "\t", $time_point, $t, join( ",", @pids ), $sum_rss, $sum_vsz, $ratio ), "\n"; $log_fh->flush; Time::HiRes::usleep($poll_intervall); $time_point++; } $log_fh->close; } sub parse_ppt { my $ppt_table = shift; my @table = map { [ $_->pid, $_->ppid, $_->rss, $_->size, $_->time, $_->start ] } @$ppt_table; return \@table; } sub subproc_ids { my ( $pid, $procs ) = @_; #[ pid, parentid ] my @childs; for my $c ( grep { $_->[1] == $pid } @$procs ) { push @childs, $c->[0]; push @childs, subproc_ids( $c->[0], $procs ); } return @childs; } __END__ =head1 NAME ppt_profile_cmd.pl - track the cpu and memory usage of a command =head1 SYNOPSIS ppt_profile_cmd.pl [OPTIONS] [ ... ] =head1 DESCRIPTION =head1 OPTIONS =head1 SEE ALSO =head1 AUTHOR jw bargsten, C<< >> =cut Proc-ProcessTable-0.59/contrib/ppt_profile_plot.R0000755000175000017500000000440513501006311020224 0ustar jwbjwb#!/usr/bin/env Rscript ## created on 2013-08-30 scale_human <- function(m, info) { for(i in 1:nrow(info)) { cp <- prod(info[1:i,"factor"]) if(m/cp < 100) return( list(factor=cp,abbr=as.character(info[i,"abbr"]))) } return(list(factor=c(1), abbr=as.character(info[1, "abbr"]))) } args <- commandArgs(T) fin <- args[1] fout <- args[2] ## some basic checks if(is.na(fout)) fout <- paste0(fin,".pdf", collapse="") cat("INPUT:", fin, "\n", file=stderr()) cat("OUTPUT:", fout, "\n", file=stderr()) if(fin == fout) stop("input and output files are the same") if(file.info(fin)$size == 0) stop("input file empty") z <- read.table(fin, header=TRUE, sep="\t", fill=TRUE) ## get rid of incomplete columns (sometimes incomplete output while the profiling is running) z.incomplete.idx <- apply(z,c(1), function(x) { any(is.na(x)) }) z <- z[!z.incomplete.idx,] if(nrow(z) < 3) stop("at least 3 data points are needed") cat("data rows:", nrow(z), "\n", file=stderr()) z[!is.finite(z[,"pcpu"]),"pcpu"] <- 0 info.byte <- data.frame(factor=c(1,1024,1024,1024), abbr=c("b", "kb", "mb", "gb")) info.ts <- data.frame(factor=c(1, 60, 60, 24), abbr=c("sec", "min", "h", "d")) t.scale <- scale_human(max(z[,"time"]), info.ts) m.scale <- scale_human(median(z[,"rss"]), info.byte) k2 <- with(z, by(z, tp, function(x) { c( t=mean(x[,"time"])/t.scale[["factor"]], m=mean(x[,"rss"])/m.scale[["factor"]], pc=mean(x[,"pcpu"]) ) })) k <- as.data.frame(do.call(rbind,k2)) k$pc <- k$pc * 100 ## old method. Got rid of plyr dependency #library(plyr) #k <- ddply(z7, .(tp), summarise, t=mean(time)/t.scale[["factor"]], m=mean(rss)/m.scale[["factor"]], pc=mean(pcpu)) span <- 0.3 #if(nrow(k) > 300) #span <- 1/20 pdf(fout,width=13, height=6) plot( pc ~ t, data=k, xlab=paste0("time in ", t.scale[["abbr"]], collapse=" "), ylab="% cpu usage", cex=0.3, pch=16, col="grey20" ) with(k, lines(loess.smooth(t, pc, span=span), col = "brown", lwd=1.6)) plot( m ~ t, data=k, xlab=paste0("time in ", t.scale[["abbr"]], collapse=" "), ylab=paste0("mem in ", m.scale[["abbr"]], collapse=" "), cex=0.3, pch=16, col="grey20" ) with(k, lines(loess.smooth(t, m, span=span), col = "brown", lwd=1.6)) dev.off() Proc-ProcessTable-0.59/os/0000755000175000017500000000000013502757611013514 5ustar jwbjwbProc-ProcessTable-0.59/os/IRIX.c0000644000175000017500000000757513501006311014430 0ustar jwbjwb #include "os/IRIX.h" #include #include #define SWAP_BLKSIZE 512 /* better if we extract the block size from system call but I don't know how */ /* Make sure /proc is mounted */ char* OS_initialize(){ struct statvfs svfs; static char* no_proc = "/proc unavailable"; if( statvfs("/proc", &svfs) == -1 ){ return no_proc; } return NULL; } /* FIXME we should get minimum info like process ID and ownership from file stat-- does this work for IOCTL-proc? Does it for FS-proc? It does on linux... */ void OS_get_table(){ DIR *procdir; struct dirent *procdirp; int psdata; int pagesize; char pathbuf[MAXPATHLEN]; struct prpsinfo psbuf; struct rminfo rminfo; off_t tswap; /* total swap in blocks */ uint totswap; /* total swap size in pages */ /* variables to hold some values for bless_into_proc */ char state[20]; char pctcpu[7]; char pctmem[7]; if ( (pagesize = getpagesize()) == 0 ) return; if( (procdir = opendir( "/proc/pinfo" )) == NULL ) return; sysmp(MP_SAGET, MPSA_RMINFO, &rminfo, sizeof(rminfo)); swapctl(SC_GETSWAPTOT, &tswap); while( (procdirp = readdir(procdir)) != NULL ){ /* Only look at this file if it's a proc id; that is, all numbers */ if( strtok(procdirp->d_name, "0123456789") != NULL ){ continue; } /* Construct path of the form /proc/proc_number */ strcpy( pathbuf, "/proc/pinfo/"); strcat( pathbuf, procdirp->d_name ); if( (psdata = open( pathbuf, O_RDONLY )) == -1 ) continue; if( ioctl(psdata, PIOCPSINFO, &psbuf) == -1 ) continue; close(psdata); /* translate process state */ #if defined(sgi) && (IRIX_VERSION >= 0x006005) switch( psbuf.pr_sname ) { case 'S': strcpy(state, SLEEP); break; case '0': /* FALLTHROUGH */ case 'R': strcpy(state, RUN); break; case 'Z': strcpy(state, ZOMBIE); break; case 'T': strcpy(state, STOP); break; case 'X': strcpy(state, XBRK); break; } #else switch( psbuf.pr_state) { case SSLEEP: strcpy(state, SLEEP); break; case SRUN: strcpy(state, RUN); break; case SZOMB: strcpy(state, ZOMBIE); break; case SSTOP: strcpy(state, STOP); break; case SIDL: strcpy(state, IDLE); break; case SXBRK: strcpy(state, XBRK); break; } #endif /* These seem to be 2 bytes, 1st byte int part, 2nd byte fractional */ /* Perl can handle stringy numbers of the form 1.5 */ sprintf( pctcpu, "%3.2f", (float) ((psbuf.pr_time.tv_sec) * 100) / (( time(NULL) - psbuf.pr_start.tv_sec ) * 100)); totswap = tswap * SWAP_BLKSIZE / pagesize; sprintf( pctmem, "%5.2f", ((double)psbuf.pr_size)/(double)(rminfo.physmem+totswap)*100); bless_into_proc( Format, Fields, psbuf.pr_uid, /* uid */ psbuf.pr_gid, /* gid */ psbuf.pr_pid, /* pid */ psbuf.pr_ppid, /* ppid */ psbuf.pr_spid, /* spid */ psbuf.pr_pgrp, /* pgrp */ psbuf.pr_sid, /* sess */ psbuf.pr_sonproc, /* cpuid */ psbuf.pr_pri, /* priority */ psbuf.pr_ttydev, /* ttynum */ psbuf.pr_flag, /* flags */ psbuf.pr_time.tv_sec, /* time */ psbuf.pr_ctime.tv_sec, /* ctime */ psbuf.pr_qtime.tv_sec, /* qtime */ psbuf.pr_size * pagesize, /* size (bytes) */ psbuf.pr_rssize * pagesize, /* rss (bytes) */ psbuf.pr_wchan, /* wchan */ psbuf.pr_fname, /* fname */ psbuf.pr_start.tv_sec, /* start */ pctcpu, /* pctcpu */ state, /* state */ pctmem, /* pctmem */ psbuf.pr_psargs, /* cmndline */ psbuf.pr_clname /* clname */ ); } closedir(procdir); } Proc-ProcessTable-0.59/os/MSWin32.c0000644000175000017500000002137313501006311015007 0ustar jwbjwb/* Adapted from ps.cc by J Robert Ray ps.cc Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002 Red Hat, Inc. This file is part of Cygwin. This software is a copyrighted work licensed under the terms of the Cygwin license. Please consult the file "CYGWIN_LICENSE" for details. */ #include #include #include #include #include #include #ifdef USE_CYGWIN #include #include #include #include #else #include #endif #include "os/MSWin32.h" #ifdef USE_CYGWIN typedef DWORD (WINAPI *GETMODULEFILENAME)( HANDLE hProcess, HMODULE hModule, LPTSTR lpstrFileName, DWORD nSize ); #endif typedef HANDLE (WINAPI *CREATESNAPSHOT)( DWORD dwFlags, DWORD th32ProcessID ); typedef BOOL (WINAPI *PROCESSWALK)( HANDLE hSnapshot, LPPROCESSENTRY32 lppe ); #ifdef USE_CYGWIN typedef struct external_pinfo external_pinfo; GETMODULEFILENAME myGetModuleFileNameEx; #endif CREATESNAPSHOT myCreateToolhelp32Snapshot; PROCESSWALK myProcess32First; PROCESSWALK myProcess32Next; static int init_win_result = FALSE; extern void bless_into_proc(char* , char**, ...); #ifdef USE_CYGWIN // Win95 functions static DWORD WINAPI GetModuleFileNameEx95 ( HANDLE hProcess, HMODULE hModule, LPTSTR lpstrFileName, DWORD n ) { HANDLE h; DWORD pid = (DWORD) hModule; PROCESSENTRY32 proc; h = myCreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0); if (!h) return 0; proc.dwSize = sizeof (proc); if (myProcess32First(h, &proc)) do if (proc.th32ProcessID == pid) { CloseHandle (h); strcpy (lpstrFileName, proc.szExeFile); return 1; } while (myProcess32Next (h, &proc)); CloseHandle (h); return 0; } #endif int init_win () { HMODULE h; #ifdef USE_CYGWIN OSVERSIONINFO os_version_info; memset (&os_version_info, 0, sizeof os_version_info); os_version_info.dwOSVersionInfoSize = sizeof (OSVERSIONINFO); GetVersionEx (&os_version_info); if (os_version_info.dwPlatformId == VER_PLATFORM_WIN32_NT) { h = LoadLibrary ("psapi.dll"); if (!h) return 0; myGetModuleFileNameEx = (GETMODULEFILENAME) GetProcAddress (h, "GetModuleFileNameExA"); if (!myGetModuleFileNameEx) return 0; return 1; } #endif h = GetModuleHandle("KERNEL32.DLL"); myCreateToolhelp32Snapshot = (CREATESNAPSHOT)GetProcAddress (h, "CreateToolhelp32Snapshot"); myProcess32First = (PROCESSWALK)GetProcAddress (h, "Process32First"); myProcess32Next = (PROCESSWALK)GetProcAddress (h, "Process32Next"); if (!myCreateToolhelp32Snapshot || !myProcess32First || !myProcess32Next) return 0; #ifdef USE_CYGWIN myGetModuleFileNameEx = GetModuleFileNameEx95; #endif return 1; } #define FACTOR (0x19db1ded53ea710LL) #define NSPERSEC 10000000LL /* Convert a Win32 time to "UNIX" format. */ static long to_time_t (FILETIME *ptr) { /* A file time is the number of 100ns since jan 1 1601 stuffed into two long words. A time_t is the number of seconds since jan 1 1970. */ long rem; long long x = ((long long) ptr->dwHighDateTime << 32) + ((unsigned)ptr->dwLowDateTime); x -= FACTOR; /* number of 100ns between 1601 and 1970 */ rem = x % ((long long)NSPERSEC); rem += (NSPERSEC / 2); x /= (long long) NSPERSEC; /* number of 100ns in a second */ x += (long long) (rem / NSPERSEC); return x; } #ifdef USE_CYGWIN void OS_get_table() { external_pinfo *p; int uid; cygwin_getinfo_types query = CW_GETPINFO; char ch; int pid; char *pstate; char pname[MAX_PATH]; char uname[128]; char *fields; uid = getuid (); (void) cygwin_internal (CW_LOCK_PINFO, 1000); if (query == CW_GETPINFO && !init_win_result) query = CW_GETPINFO; for (pid = 0; (p = (external_pinfo *) cygwin_internal (query, pid | CW_NEXTPID)); pid = p->pid) { pstate = " "; if (p->process_state & PID_STOPPED) pstate = "stopped"; else if (p->process_state & PID_TTYIN) pstate = "ttyin"; else if (p->process_state & PID_TTYOU) pstate = "ttyout"; #ifdef PID_ORPHANED if (p->process_state & (PID_ORPHANED | PID_EXITED)) #else if (p->process_state & PID_EXITED) #endif strcpy (pname, ""); else if (p->ppid) { char *s; pname[0] = '\0'; cygwin_conv_path((CCP_RELATIVE|CCP_WIN_A_TO_POSIX), p->progname, pname, PATH_MAX); s = strchr (pname, '\0') - 4; if (s > pname && strcasecmp (s, ".exe") == 0) *s = '\0'; } else if (query == CW_GETPINFO) { FILETIME ct, et, kt, ut; HANDLE h = OpenProcess (PROCESS_QUERY_INFORMATION | PROCESS_VM_READ, FALSE, p->dwProcessId); if (!h) continue; if (!myGetModuleFileNameEx (h, myProcess32First ? p->dwProcessId : NULL, pname, MAX_PATH)) strcpy (pname, "*** unknown ***"); if (GetProcessTimes (h, &ct, &et, &kt, &ut)) p->start_time = to_time_t (&ct); CloseHandle (h); } { struct passwd *pw; if ((pw = getpwuid (p->version >= EXTERNAL_PINFO_VERSION_32_BIT ? p->uid32 : p->uid))) strcpy (uname, pw->pw_name); else sprintf (uname, "%u", (unsigned) (p->version >= EXTERNAL_PINFO_VERSION_32_BIT ? p->uid32 : p->uid)); } if (query == CW_GETPINFO) { fields = "iiiiisiis"; } else { fields = "iiiiisIis"; } bless_into_proc(fields, Fields, p->version >= EXTERNAL_PINFO_VERSION_32_BIT ? p->uid32 : p->uid, p->pid, p->ppid, p->pgid, p->dwProcessId, pname, p->start_time, p->ctty, pstate ); } (void) cygwin_internal (CW_UNLOCK_PINFO); } #else static void get_process_owner(HANDLE process, char string_sid[184], char user_name[256], char domain_name[255]) { HANDLE process_token; PTOKEN_USER token_user; DWORD token_user_size; char *string_sid_ptr; size_t string_sid_len; DWORD user_name_size; DWORD domain_name_size; SID_NAME_USE sid_type; string_sid[0] = 0; user_name[0] = 0; domain_name[0] = 0; if (!OpenProcessToken (process, TOKEN_QUERY, &process_token)) return; if (!GetTokenInformation (process_token, TokenUser, NULL, 0, &token_user_size) && GetLastError () != ERROR_INSUFFICIENT_BUFFER) { CloseHandle (process_token); return; } token_user = malloc (token_user_size); if (!token_user) { CloseHandle (process_token); return; } if (!GetTokenInformation (process_token, TokenUser, token_user, token_user_size, &token_user_size)) { free (token_user); CloseHandle (process_token); return; } if (ConvertSidToStringSidA (token_user->User.Sid, &string_sid_ptr)) { string_sid_len = strlen (string_sid_ptr); if (string_sid_len < 184) memcpy (string_sid, string_sid_ptr, string_sid_len+1); LocalFree (string_sid_ptr); } user_name_size = 256; domain_name_size = 256; if (!LookupAccountSidA (NULL, token_user->User.Sid, user_name, &user_name_size, domain_name, &domain_name_size, &sid_type) && GetLastError () == ERROR_NONE_MAPPED) { strcpy (user_name, "NONE_MAPPED"); strcpy (domain_name, "NONE_MAPPED"); } free (token_user); CloseHandle (process_token); } static unsigned long get_uid_from_string_sid(char *string_sid) { char *uid_ptr; char *ptr; uid_ptr = strrchr (string_sid, '-'); if (!uid_ptr) return 0; uid_ptr++; for (ptr = uid_ptr; *ptr; ptr++) if (*ptr < '0' || *ptr > '9') return 0; return strtoul (uid_ptr, NULL, 10); } void OS_get_table() { HANDLE proc; HANDLE snapshot; PROCESSENTRY32 proc_entry; FILETIME ct, et, kt, ut; char string_sid[184]; char user_name[256]; char domain_name[256]; unsigned long uid; long start_time; if (!init_win_result) return; snapshot = myCreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0); if (!snapshot) return; proc_entry.dwSize = sizeof (proc_entry); if (myProcess32First (snapshot, &proc_entry)) do { uid = 0; start_time = 0; proc = OpenProcess (PROCESS_QUERY_INFORMATION, FALSE, proc_entry.th32ProcessID); if (proc) { if (GetProcessTimes (proc, &ct, &et, &kt, &ut)) start_time = to_time_t (&ct); get_process_owner (proc, string_sid, user_name, domain_name); CloseHandle (proc); } uid = get_uid_from_string_sid (string_sid); bless_into_proc ("pppslsss", Fields, uid, proc_entry.th32ProcessID, proc_entry.th32ParentProcessID, proc_entry.szExeFile, start_time, string_sid, user_name, domain_name ); } while (myProcess32Next (snapshot, &proc_entry)); CloseHandle (snapshot); } #endif char* OS_initialize() { init_win_result = init_win(); return NULL; } Proc-ProcessTable-0.59/os/SunOS.c0000644000175000017500000000442413501006311014652 0ustar jwbjwb/* * Copyright (c) 2001 by Shawn A. Clifford * This file may be distributed under the same terms as Perl. * * Modification History: * * Who When Description * --- ---------- -------------------------------------------- * SAC 30July2001 Original code */ #include "os/SunOS.h" char* OS_initialize(void) { return NULL; } void OS_get_table(void) { struct proc *p; struct user *u; struct ucred cr; struct sess sess; char **arg; char **env; char cmdline[_POSIX_ARG_MAX]; char fname[_POSIX_PATH_MAX]; kvm_t *kd; int i, count; int ttynum; /* Open the kernel for reading */ if ((kd = kvm_open(NULL, NULL, NULL, O_RDONLY, NULL)) == NULL) { ppt_croak("kvm_open: can't open kernel"); } /* * Loop over all processes */ while ((p = kvm_nextproc(kd)) != NULL) { /* Get the u-area for this process or skip this process */ if ((u = kvm_getu(kd, p)) == NULL) continue; /* Get the command line arguments for this process or skip */ bzero(fname, sizeof(fname)); if (kvm_getcmd(kd, p, u, &arg, &env) < 0) { sprintf(fname, "%s", u->u_comm); sprintf(cmdline, "%s", u->u_comm); } else { sprintf(fname, "%s", arg[0]); bzero(cmdline, sizeof(cmdline)); i=0; while (arg[i] != NULL) { count = sizeof(cmdline) - strlen(cmdline) - 1; strncat(cmdline, arg[i++], count); if (arg[i] != NULL) strcat(cmdline, " "); } } /* Get the process credentials */ if (kvm_read(kd, p->p_cred, &cr, sizeof(struct ucred)) < 0) continue; /* Get the session info */ kvm_read(kd, p->p_sessp, &sess, sizeof(struct sess)); ttynum = minor(sess.s_ttyd); if (major(sess.s_ttyd) == 0) ttynum = -1; /* Send if off to Perl */ bless_into_proc( Format, Fields, cr.cr_ruid, cr.cr_rgid, cr.cr_uid, cr.cr_gid, p->p_pid, p->p_ppid, p->p_pgrp, p->p_pri, p->p_flag, (p->p_dsize+p->p_ssize)*4, p->p_rssize*4, p->p_nice, p->p_time, fname, cmdline, p->p_cpticks, p->p_pctcpu, States[(int)p->p_stat], sess.s_sid, sess.s_sid, ttynum ); } /* Close the kernel and exit */ kvm_close(kd); } Proc-ProcessTable-0.59/os/SunOS.h0000644000175000017500000000506113501006311014655 0ustar jwbjwb/* * Copyright (c) 2001 by Shawn A. Clifford * This file may be distributed under the same terms as Perl. * * Modification History: * * Who When Description * --- ---------- -------------------------------------------- * SAC 30July2001 Original code */ #include #include #include #include #include #include #include #include #include #include #include #include #ifndef perror void perror(char *); #endif #ifndef printf int printf(char *, ...); #endif #ifndef bzero void bzero(char *, int); #endif #ifndef strncat char *strncat(char *, char *, int); #endif #ifndef strcat char *strcat(char *, char*); #endif extern void bless_into_proc(char* format, char** fields, ...); static char *Format = "iiiiiiiiiiiiissllsiii"; static char *Fields[] = { "uid", /* real uid */ # define F_UID 0 "gid", /* real gid */ # define F_GID 1 "euid", /* effective uid */ # define F_EID 2 "egid", /* effective gid */ # define F_EGID 3 "pid", /* process id */ # define F_PID 4 "ppid", /* parent pid */ # define F_PPID 5 "pgrp", /* process group leader (pid) */ # define F_PGRP 6 "priority",/* priority, negative is high */ # define F_PRIORITY 7 "flags", /* process flags */ # define F_FLAGS 8 "size", /* data + stack (in KBytes) */ # define F_SIZE 9 "rss", /* resident set size (in KBytes) */ # define F_RSS 10 "nice", /* nice for cpu usage */ # define F_NICE 11 "time", /* seconds resident */ # define F_TIME 12 "fname", /* file name of running image */ # define F_FNAME 13 "cmndline",/* entire command line */ # define F_CMNDLINE 14 "cpticks",/* ticks of cpu time, for pctcpu */ # define F_CPTICKS 15 "pctcpu", /* (decayed) %cpu for this process */ # define F_PCTCPU 16 "state", /* current run state (eg. sleep, wait, ..) */ # define F_STATE 17 "sess", /* aka sid */ # define F_SESS 18 "sid", /* session id */ # define F_SID 19 "ttynum" /* minor device number for the tty */ # define F_TTYNUM 20 # define F_LASTFIELD 20 }; static char *States[] = { "", "sleep", "wait", "run", "idle", "zombie", "stop" }; Proc-ProcessTable-0.59/os/HPUX.c0000644000175000017500000001042613501006311014426 0ustar jwbjwb/*alan.martin@oracle.com * Copyright (c) 1998 by Mike Romberg ( romberg@fsl.noaa.gov ) * This file may be distributed under the same terms as Perl. * * This will probably only work under HPUX-10 or later. * * 8/26/99 Added "fname" field for consistency with other OS's - D. Urist * */ #define _PSTAT64 /* For David Good's 64-bit HPUX 11.0 patch */ #include #include #include #define BURST 30 /* How many pstat structs to get per syscall */ extern void bless_into_proc(char* format, char** fields, ...); static char *Format = "llllllllllllllllsllssllllsllslllllllllllllllllllllSSSllllSSSll"; static char *Fields[] = { "uid", "pid", "ppid", "dsize", "tsize", "ssize", "nice", "ttynum", /* */ "pgrp", "pri", "addr", "cpu", "utime", "stime", "start", "flag", "state", "wchan", "procnum", "cmndline", "fname", "time", "cpticks", "cptickstotal", "fss", "pctcpu", "rssize", "suid", "ucomm", /* char */ "shmsize", "mmsize", "usize", "iosize", "vtsize", "vdsize", "vssize", "vshmsize", "vmmsize", "vusize", "viosize", "minorfaults", /* ulong */ "majorfaults", /* ulong */ "nswap", /* ulong */ "nsignals", /* ulong */ "msgrcv", /* ulong */ "msgsnd", /* ulong */ "maxrss", "sid", "schedpolicy", "ticksleft", "rdir", /* */ "cdir", /* */ "text", /* */ "highestfd", "euid", "egid", "ioch", "usercycles", /* */ "systemcycles", /* */ "interruptcycles", /* */ "gid", "lwpid" }; static char *States[] = { "", "sleep", "run", "stop", "zombie", "uwait", "other" }; char* OS_initialize() { return NULL; } void OS_get_table() { struct pst_status pst[BURST]; int i, count; int idx = 0; char buff[256]; /* used to format %cpu which is the only float. */ while ((count = pstat_getproc(pst, sizeof(pst[0]), BURST, idx)) > 0) { for (i = 0; i < count; i++) { sprintf(buff, "%f", pst[i].pst_pctcpu * 100); bless_into_proc(Format, Fields, (long) pst[i].pst_uid, (long) pst[i].pst_pid, (long) pst[i].pst_ppid, (long) pst[i].pst_dsize, (long) pst[i].pst_tsize, (long) pst[i].pst_ssize, (long) pst[i].pst_nice, (long) makedev(pst[i].pst_term.psd_major, pst[i].pst_term.psd_minor), (long) pst[i].pst_pgrp, (long) pst[i].pst_pri, (long) pst[i].pst_addr, (long) pst[i].pst_cpu, (long) pst[i].pst_utime, (long) pst[i].pst_stime, (long) pst[i].pst_start, (long) pst[i].pst_flag, States[pst[i].pst_stat], (long) pst[i].pst_wchan, (long) pst[i].pst_procnum, pst[i].pst_cmd, pst[i].pst_ucomm, (long) pst[i].pst_cptickstotal/100, (long) pst[i].pst_cpticks, (long) pst[i].pst_cptickstotal, (long) pst[i].pst_fss, buff, (long) pst[i].pst_rssize, (long) pst[i].pst_suid, pst[i].pst_ucomm, (long) pst[i].pst_shmsize, (long) pst[i].pst_mmsize, (long) pst[i].pst_usize, (long) pst[i].pst_iosize, (long) pst[i].pst_vtsize, (long) pst[i].pst_vdsize, (long) pst[i].pst_vssize, (long) pst[i].pst_vshmsize, (long) pst[i].pst_vmmsize, (long) pst[i].pst_vusize, (long) pst[i].pst_viosize, (long) pst[i].pst_minorfaults, (long) pst[i].pst_majorfaults, (long) pst[i].pst_nswap, (long) pst[i].pst_nsignals, (long) pst[i].pst_msgrcv, (long) pst[i].pst_msgsnd, (long) pst[i].pst_maxrss, (long) pst[i].pst_sid, (long) pst[i].pst_schedpolicy, (long) pst[i].pst_ticksleft, "", "", "", (long) pst[i].pst_highestfd, (long) pst[i].pst_euid, (long) pst[i].pst_egid, (long) pst[i].pst_ioch, "", "", "", (long) pst[i].pst_gid, (long) pst[i].pst_lwpid); } idx = pst[count-1].pst_idx + 1; } } Proc-ProcessTable-0.59/os/UnixWare.h0000644000175000017500000000202513501006311015405 0ustar jwbjwb#include #include #include #include #include #include #include #include #include #include #include #include #include /****************************************/ /* Process state strings that we return */ /****************************************/ #define SLEEP "sleep" #define WAIT "wait" #define RUN "run" #define IDLE "idle" #define STOP "stop" #define ONPROC "onprocessor" /* Solaris is an all-or-nothing deal, all this stuff comes out of one structure, so we don't need to dick around with the format much */ static char Format[] = "iiiiiiiilllllllslsis"; /* Mapping of field to type */ static char* Fields[] = { "uid", "gid", "pid", "ppid", "pgrp", "sess", "priority", "nice", "ttynum", "flags", "time", "timensec", "size", "rss", "wchan", "fname", "start", "state", "onpro", "cmndline" }; Proc-ProcessTable-0.59/os/UnixWare.c0000644000175000017500000000503613501006311015405 0ustar jwbjwb #include "os/UnixWare.h" /* Make sure /proc is mounted */ char* OS_initialize(){ struct statvfs svfs; static char* no_proc = "/proc unavailable"; if( statvfs("/proc", &svfs) == -1 ){ return no_proc; } return NULL; } /* FIXME we should get minimum info like process ID and ownership from file stat-- does this work for IOCTL-proc? Does it for FS-proc? It does on linux... */ void OS_get_table(){ DIR *procdir; struct dirent *procdirp; int psdata; char pathbuf[MAXPATHLEN]; struct psinfo psbuf; lwpstat_t pr_state; /* variables to hold some values for bless_into_proc */ char state[20]; if( (procdir = opendir( "/proc" )) == NULL ) return; while( (procdirp = readdir(procdir)) != NULL ){ /* Only look at this file if it's a proc id; that is, all numbers */ if( strtok(procdirp->d_name, "0123456789") != NULL ){ continue; } /* Construct path of the form /proc/proc_number */ strcpy( pathbuf, "/proc/"); strcat( pathbuf, procdirp->d_name ); strcat( pathbuf, "/psinfo" ); if( (psdata = open( pathbuf, O_RDONLY )) == -1 ) continue; read(psdata, (void *) &psbuf, sizeof(struct psinfo) ); close(psdata); /* translate process state */ pr_state = psbuf.pr_lwp.pr_state; switch( pr_state ) { case SSLEEP: strcpy(state, SLEEP); break; case SRUN: strcpy(state, RUN); break; case SSTOP: strcpy(state, STOP); break; case SIDL: strcpy(state, IDLE); break; case SONPROC: strcpy(state, ONPROC); break; } bless_into_proc( Format, Fields, psbuf.pr_uid, /* uid */ psbuf.pr_gid, /* gid */ psbuf.pr_pid, /* pid */ psbuf.pr_ppid, /* ppid */ psbuf.pr_pgid, /* pgrp */ psbuf.pr_sid, /* sess */ psbuf.pr_lwp.pr_pri, /* priority */ psbuf.pr_lwp.pr_nice, /* nice */ psbuf.pr_ttydev, /* ttynum */ psbuf.pr_flag, /* flags */ psbuf.pr_time.tv_sec, /* time */ psbuf.pr_time.tv_nsec, /* time nanosec */ psbuf.pr_size * getpagesize(), /* size (bytes) */ psbuf.pr_rssize * getpagesize(), /* rss (bytes) */ psbuf.pr_lwp.pr_wchan, /* wchan */ psbuf.pr_fname, /* fname */ psbuf.pr_start.tv_sec, /* start */ state, /* state */ psbuf.pr_lwp.pr_onpro, /* on which processor */ psbuf.pr_psargs /* cmndline */ ); } closedir(procdir); } Proc-ProcessTable-0.59/os/IRIX.h0000644000175000017500000000231213501006311014415 0ustar jwbjwb#include #include #include #include #include #include #include #include /* needed for process state constants */ #include #include #include #if defined(PROC_FS) #include #else #include #endif #ifdef i386 #undef SP #define SP sp #endif /****************************************/ /* Process state strings that we return */ /****************************************/ #define SLEEP "sleep" #define WAIT "wait" #define RUN "run" #define IDLE "idle" #define ZOMBIE "defunct" #define STOP "stop" #define XBRK "xswapped" /* Solaris is an all-or-nothing deal, all this stuff comes out of one structure, so we don't need to dick around with the format much */ static char Format[] = "iiiiiiiilllllllllslsssss"; /* Mapping of field to type */ static char* Fields[] = { "uid", "gid", "pid", "ppid", "spid", "pgrp", "sess", "cpuid", "priority", "ttynum", "flags", "time", "ctime", "qtime", "size", "rss", "wchan", "fname", "start", "pctcpu", "state", "pctmem", "cmndline", "clname" }; Proc-ProcessTable-0.59/os/FreeBSD.h0000644000175000017500000000320713501006311015060 0ustar jwbjwb#include #include #include #include #include #include #include #include #include #include #include #include #if __FreeBSD_version >= 600000 /* in FreeBSD 6.x the format of /proc/$pid/status changed */ #define PROCFS_FREEBSD_6 #else #undef PROCFS_FREEBSD_6 #endif struct procstat { char comm[MAXCOMLEN+1]; int pid; int ppid; int pgid; int sid; #ifdef PROCFS_FREEBSD_6 char ttydev[SPECNAMELEN]; #else int tdev_maj; int tdev_min; #endif char flags[256]; /* XXX */ int start; int start_mic; int utime; int utime_mic; int stime; int stime_mic; char wchan[256]; /* XXX */ int euid; int ruid; int rgid; int egid; char groups[256]; /* XXX */ }; /* We need to pass in a cap for ignore, lower for store on object */ /* We can just lc these! */ static char Defaultformat[] = "iiiiiissssssiisssiSI"; /* Mapping of field to type */ static char* Fields[] = { "uid", #define F_UID 0 "gid", #define F_GID 1 "pid", #define F_PID 2 "ppid", #define F_PPID 3 "pgrp", #define F_PGRP 4 "sess", #define F_SESS 5 "flags", #define F_FLAGS 6 "utime", #define F_UTIME 7 "stime", #define F_STIME 8 "time", #define F_TIME 9 "wchan", #define F_WCHAN 10 "start", #define F_START 11 "euid", #define F_EUID 12 "egid", #define F_EGID 13 "fname", #define F_FNAME 14 "state", #define F_STATE 15 "ttydev", #define F_TTYDEV 16 "ttynum", #define F_TTYNUM 17 "cmndline", #define F_CMNDLINE 18 "priority" #define F_PRIORITY 19 #define F_LASTFIELD 19 }; Proc-ProcessTable-0.59/os/aix_getprocs.c0000644000175000017500000001652013501006311016332 0ustar jwbjwb/* * Copyright (c) 2002, Target Corporation. All Rights Reserved. * This file is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. * * Author: James FitzGibbon * * based on aix.c distributed with Proc::ProcessTable v0.35, which * is Copyright (c) 1998, David Paquet. * */ #include #include #include #include #include #include #include #include "EXTERN.h" #include "perl.h" #include "os/aix_getprocs.h" /* convert a struct timeval to seconds * * TVALU_* presumes that tv_usec is microseconds * TVALN_* presumes that tv_usec is nanoseconds (struct procsinfo64) */ #define TVALU_TO_SEC(x) (x.tv_sec + ((double)x.tv_usec / 1000000.0)) #define TVALN_TO_SEC(x) (x.tv_sec + ((double)x.tv_usec / 1000000000.0)) void bless_procs(struct procsinfo64 *, int); static unsigned long long memory; static int pagesize = 0; static long int ncpus = 0; static double now_time = 0.0; static char format[F_LASTFIELD+2]; char *OS_initialize() { struct CuAt* odm_object; int num_fetched; /* get the number of processors online */ ncpus = sysconf(_SC_NPROCESSORS_ONLN); if( ncpus == -1 ) { /* sysconf error */ ncpus = 1; } /* get the page size in bytes */ pagesize = getpagesize(); /* get the amount of physical memory */ if( 0 != odm_initialize() ) { /* fprintf(stderr, "cannot initialize ODM in Proc::ProcessTable::OS_initialize (AIX)!\n"); */ ppt_warn("cannot initialize ODM in Proc::ProcessTable::OS_initialize (AIX)!"); } else { odm_object = (struct CuAt*)getattr("sys0", "realmem", 0, &num_fetched); memory = strtoull(odm_object->value, 0, 10); odm_terminate(); } memory = memory * 1024; return NULL; } void OS_get_table() { struct procsinfo64 *procs = NULL; int index = 0; int fetched = 0; struct timeval now_tval; /* allocate memory to hold the procs */ /* procs = New(0, procs, PROCS_TO_FETCH, struct procsinfo64); */ procs = (struct procsinfo64 *)malloc(sizeof(struct procsinfo64) * PROCS_TO_FETCH); if(NULL == procs) { /* fprintf(stderr, "cannot allocate memory in Proc::ProcessTable::OS_get_table!\n"); */ ppt_warn("cannot allocate memory in Proc::ProcessTable::OS_get_table!"); return; } /* get current time of day */ gettimeofday(&now_tval, 0); now_time = TVALU_TO_SEC(now_tval); /* keep on grabbing chunks of processes until getprocs returns a smaller block than we asked for */ while( (fetched = getprocs(procs, sizeof(struct procsinfo64), NULL, 0, &index, PROCS_TO_FETCH)) >= PROCS_TO_FETCH) { bless_procs(procs, fetched); } /* bless the last block of procs */ bless_procs(procs, fetched); /* release the memory */ Safefree(procs); return; } void bless_procs(struct procsinfo64 *procs, int count) { int index; char cmndline[ARG_MAX]; char comm[ARG_MAX]; char pctmem[PCT_LENGTH]; char pctcpu[PCT_LENGTH]; char state[STATE_LENGTH]; char *c = NULL; struct procsinfo64 *curproc = NULL; struct procsinfo curproc_for_getargs; int zombie; int done; long utime, stime, cutime, cstime; /* initialize */ Zero(&curproc_for_getargs, 1, struct procsinfo); for( index = 0, curproc = procs; index < count; index++, curproc = procs+index ) { /* reset char fields */ memset(cmndline, 0, ARG_MAX); memset(comm, 0, ARG_MAX); memset(pctmem, 0, PCT_LENGTH); memset(pctcpu, 0, PCT_LENGTH); memset(state, 0, STATE_LENGTH); /* skip procs with a state of NONE */ if( curproc->pi_state == SNONE ) { continue; } /* copy the format into something we can use */ strcpy(format, Defaultformat); /* presume we are not a zombie */ zombie = 0; /* set a descriptive name for the process state */ switch( curproc->pi_state ) { case SSLEEP: strcpy(state, SLEEP); break; case SRUN: strcpy(state, RUN); break; case SIDL: strcpy(state, IDLE); break; case SZOMB: strcpy(state, ZOMBIE); zombie = 1; break; case SSTOP: strcpy(state, STOP); break; case SACTIVE: strcpy(state, ACTIVE); break; default: format[F_STAT] = 'S'; break; } /* calc utime, stime, cutime, cstime */ if( zombie ) { utime = curproc->pi_utime; stime = curproc->pi_stime; } else { utime = TVALN_TO_SEC(curproc->pi_ru.ru_utime); stime = TVALN_TO_SEC(curproc->pi_ru.ru_stime); cutime = TVALN_TO_SEC(curproc->pi_cru.ru_utime); cstime = TVALN_TO_SEC(curproc->pi_cru.ru_stime); } /* calc pctcpu */ sprintf(pctcpu, "%3.2f", ((utime + stime) * 100 / ( now_time - curproc->pi_start )) / ncpus ); /* calc pctmem */ if( memory == 0 ) { format[F_PCTMEM] = 'S'; } else { sprintf(pctmem, "%3.2f", (curproc->pi_drss + curproc->pi_trss) * pagesize * 100 / (float)memory); } /* determine comm & cmndline */ if( (curproc->pi_flags & SKPROC) == SKPROC ) { if( curproc->pi_pid == 0 ) { snprintf(comm, ARG_MAX, "kproc (swapper)"); snprintf(cmndline, ARG_MAX, "kproc (swapper)"); } else { snprintf(comm, ARG_MAX, "kproc (%s)", curproc->pi_comm); snprintf(cmndline, ARG_MAX, "kproc (%s)", curproc->pi_comm); } } else { snprintf(comm, ARG_MAX, "%s", curproc->pi_comm); curproc_for_getargs.pi_pid = curproc->pi_pid; if( getargs(&curproc_for_getargs, sizeof(struct procsinfo), cmndline, ARG_MAX) < 0 ) { snprintf(cmndline, ARG_MAX, "%s", curproc->pi_comm); } else { /* replace NUL characters in command line with spaces */ c = cmndline; done = 0; while( ! done ) { if( *c == '\0' ) { if( *(c+1) == '\0' ) { done = 1; } else { *c++ = ' '; } } else { c++; } } } } /* sanity check: bless_into_procs doesn't like negative ints */ if( curproc->pi_cred.cr_uid == -1 ) { format[F_EUID] = 'I'; curproc->pi_cred.cr_uid = 0; } if( curproc->pi_ttyd == -1 ) { format[F_TTYNUM] = 'I'; curproc->pi_ttyd = 0; } if( curproc->pi_ttympx == -1 ) { format[F_TTYMPX] = 'I'; curproc->pi_ttympx = 0; } /* give it to Perl */ bless_into_proc(format, Fields, curproc->pi_pid, /* pid */ curproc->pi_ppid, /* ppid */ curproc->pi_sid, /* sess */ curproc->pi_pgrp, /* pgrp */ curproc->pi_uid, /* uid */ curproc->pi_suid, /* suid */ curproc->pi_cred.cr_luid, /* luid */ curproc->pi_cred.cr_uid, /* euid */ curproc->pi_cred.cr_rgid, /* gid */ curproc->pi_cred.cr_gid, /* egid */ curproc->pi_pri, /* priority */ curproc->pi_nice, /* nice */ curproc->pi_thcount, /* thcount */ state, curproc->pi_flags, /* flags */ curproc->pi_flags2, /* flags2 */ curproc->pi_adspace, /* adspace */ curproc->pi_majflt, /* majflt */ curproc->pi_minflt, /* minflt */ (long)(utime * 100), /* utime */ (long)(stime * 100), /* stime */ (long)(cutime * 100), /* cutime */ (long)(cstime * 100), /* cstime */ curproc->pi_start, /* start */ curproc->pi_size, /* size */ curproc->pi_tsize, /* tsize */ curproc->pi_ttyp, /* ttyp */ curproc->pi_ttyd, /* ttynum */ curproc->pi_ttympx, /* ttympx */ curproc->pi_drss, /* drss */ curproc->pi_trss, /* trss */ curproc->pi_dvm, /* dvm */ pctmem, /* pctmem */ pctcpu, /* pctcpu */ comm, /* comm */ cmndline /* cmndline */ ); } } /* * EOF */ Proc-ProcessTable-0.59/os/NetBSD.c0000644000175000017500000000630613501006311014723 0ustar jwbjwb #include "os/NetBSD.h" /* Given a path to a /proc/XXX/status file and a pointer to a procstat struct, fill the struct */ struct procstat* get_procstat( char* path, struct procstat* prs){ FILE* fp; if( (fp = fopen( path, "r" )) != NULL ){ fscanf(fp, "%s %d %d %d %d %d,%d %s %d,%d %d,%d %d,%d %s %d %d %d,%d,%s", &prs->comm, &prs->pid, &prs->ppid, &prs->pgid, &prs->sid, &prs->tdev_maj, &prs->tdev_min, &prs->flags, &prs->start, &prs->start_mic, &prs->utime, &prs->utime_mic, &prs->stime, &prs->stime_mic, &prs->wchan, &prs->euid, &prs->ruid, &prs->rgid, &prs->egid, &prs->groups ); fclose(fp); return(prs); } else{ return(NULL); } } /* Make sure /proc is mounted and initialize some global vars */ char* OS_initialize(){ char cbuf[1024]; char bbuf[32]; struct statfs sfs; static char* no_proc = "/proc unavailable"; if( statfs("/proc", &sfs) == -1 ){ return no_proc; } return NULL; } void OS_get_table(){ DIR *procdir; struct dirent *procdirp; FILE *fp; char pathbuf[PATH_MAX]; /* for bless_into_proc */ struct procstat prs; static char format[F_LASTFIELD + 2]; char cmndline[ARG_MAX]; if( (procdir = opendir("/proc")) == NULL ){ return; } /* Iterate through all the process entries (numeric) under /proc */ while( (procdirp = readdir(procdir)) != NULL ){ /* Only look at this file if it's a proc id; that is, all numbers */ if( strtok(procdirp->d_name, "0123456789") == NULL ){ /* zero our format */ strcpy(format, Defaultformat); sprintf(pathbuf, "%s%s", "/proc/", procdirp->d_name); /* get stuff out of /proc/PROC_ID/status */ memset(&prs, 0, sizeof(prs)); strcat( pathbuf, "/status" ); if (get_procstat(pathbuf, &prs) != NULL) { int i; char utime[20]; double utime_f; char stime[20]; double stime_f; char time[20]; double time_f; char start[20]; double start_f; char *ttydev; int ttynum; utime_f = prs.utime + prs.utime_mic/1000000; stime_f = prs.stime + prs.stime_mic/1000000; time_f = utime_f + stime_f; start_f = prs.start + prs.start_mic/1000000; sprintf(utime, "%f", utime_f); sprintf(stime, "%f", stime_f); sprintf(time, "%f", time_f); sprintf(start, "%f", start_f); ttynum = makedev(prs.tdev_maj, prs.tdev_min); ttydev = devname(ttynum, S_IFCHR); if (ttydev == NULL) ttydev = "??"; /* get stuff out of /proc/PROC_ID/cmdline */ sprintf(pathbuf, "%s%s%s", "/proc/", procdirp->d_name, "/cmdline"); if( (fp = fopen( pathbuf, "r" )) != NULL ){ size_t got; if( (got = fread(cmndline, sizeof(char), ARG_MAX, fp)) > 0 ){ size_t i; for(i = 0; i < got; i++){ if( cmndline[i] == '\0' ) cmndline[i] = ' '; } cmndline[got] = '\0'; /* necessary? */ format[F_CMNDLINE] = tolower(format[F_CMNDLINE]); } fclose(fp); } bless_into_proc( format, Fields, prs.ruid, prs.rgid, prs.pid, prs.ppid, prs.pgid, prs.sid, prs.flags, utime, stime, time, prs.wchan, start, prs.euid, prs.egid, prs.comm, prs.wchan, ttydev, ttynum, cmndline ); } } } closedir(procdir); } Proc-ProcessTable-0.59/os/darwin.h0000644000175000017500000001465013501006311015136 0ustar jwbjwb/*- * This code relies heavily on the Darwin "ps" command, which is available * from Apple in the adv_cmds portion of the Darwin distribution. The portions * of this code which were included from that source are: * * Copyright (c) 1990, 1993, 1994 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. All advertising materials mentioning features or use of this software * must display the following acknowledgement: * This product includes software developed by the University of * California, Berkeley and its contributors. * 4. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. * * The portions of this code which were necessary to tie into the Perl * Proc::ProcessTable module are: * * Copyright (c) 2003 and 2008, Thomas R. Wyant, III * * and may be reused under the same terms as Perl itself. */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #ifndef KERN_PROCARGS2 /* Not defined in Jaguar (10.2); Defined in Panther (10.3) at least through Leopard (10.5). */ #include #endif #include /* these are in sys/sysctl.h */ #define KI_PROC(ki) (&(ki)->ki_p->kp_proc) #define KI_EPROC(ki) (&(ki)->ki_p->kp_eproc) #define STATE_MAX 7 typedef struct thread_values { struct thread_basic_info tb; /* struct policy_infos schedinfo; */ union { struct policy_timeshare_info tshare; struct policy_rr_info rr; struct policy_fifo_info fifo; } schedinfo; } thread_values_t; struct usave { struct timeval u_start; struct rusage u_ru; struct rusage u_cru; char u_acflag; char u_valid; }; typedef struct kinfo { struct kinfo_proc *ki_p; /* proc structure */ struct usave ki_u; /* interesting parts of user */ char *ki_args; /* exec args */ char *ki_env; /* environment */ task_port_t task; int state; int cpu_usage; int curpri; int basepri; int swapped; struct task_basic_info tasks_info; struct task_thread_times_info times; /* struct policy_infos schedinfo; */ union { struct policy_timeshare_info tshare; struct policy_rr_info rr; struct policy_fifo_info fifo; } schedinfo; int invalid_tinfo; #ifdef KERN_PROCARGS2 /* Defined in Panther (10.3) and up */ mach_msg_type_number_t thread_count; #else int thread_count; #endif thread_port_array_t thread_list; thread_values_t *thval; int invalid_thinfo; } KINFO; #define TIME_IN_MICROSECONDS 1 #ifdef TESTING /* Note that FREE_BUFFERS is to be defined appropriately before * DIE_HORRIBLY is used. */ #define DIE_HORRIBLY(s) {FREE_BUFFERS perror (s); exit (1);} #else /* def TESTING */ #define DIE_HORRIBLY(s) {FREE_BUFFERS perror (s); return;} extern void bless_into_proc(char* format, char** fields, ...); #ifdef TIME_IN_MICROSECONDS static char *Format = "iiiiiiiiiiiiiiijjjllslsssss"; #else /* def TIME_IN_MICROSECONDS */ static char *Format = "iiiiiiiiiiiiiiilllllslsssss"; #endif /* def TIME_IN_MICROSECONDS */ static char *Fields[] = { "pid", /* Process ID */ # define F_PID 0 "ppid", /* Parent pid */ # define F_PPID 1 "pgrp", /* Process group leader */ # define F_PGRP 2 "uid", /* real uid */ # define F_UID 3 "gid", /* real gid */ # define F_GID 4 "euid", /* effective uid */ # define F_EID 5 "egid", /* effective gid */ # define F_EGID 6 "suid", /* saved uid */ # define F_SUID 7 "sgid", /* saved gid */ # define F_SGID 8 "priority", /* proiority */ # define F_PRIORITY 9 "size", /* virtual size (Kbytes) */ # define F_SIZE 10 "rss", /* resident set size (Kbytes) */ # define F_RSS 11 "flags", /* process flags */ # define F_FLAGS 12 "nice", /* nice for CPU usage */ # define F_NICE 13 "sess", /* session pointer */ # define F_SESS 14 "time", /* total time (system + user, centi- or microseconds, depending) */ # define F_CPTICKS 15 "stime", /* system time (centi- or micrseconds, depending) */ # define F_STIME 16 "utime", /* user time (centi- or microseconds, depending) */ # define F_UTIME 17 "start", /* Start time in seconds since epoch */ # define F_START 18 "wchan", /* Wait channel (addr of system call) */ # define F_WCHAN 19 "ttydev", # define F_TTYDEV 20 "ttynum", /* device number for tty, or -1 */ # define F_TTYNUM 21 "pctcpu", /* Percent cpu as string representing float */ # define F_PCTCPU 22 "pctmem", /* Percent memory as string representing float */ # define F_PCTMEM 23 "state", /* current run state (e.g. sleep, wait ...) */ # define F_STATE 24 "cmndline", /* entire command line */ # define F_CMNDLINE 25 "fname", /* filename */ # define F_FNAME 26 # define F_LASTFIELD 26 }; #endif /* def TESTING */ static char *States[] = { "", "idle", "run", "sleep", "stop", "zombie" }; Proc-ProcessTable-0.59/os/Solaris.h0000644000175000017500000000255713501006311015271 0ustar jwbjwb#include #include #include #include #include #include #include #include /* needed for process state constants */ #include #include #if defined(PROC_FS) #include #else #include #endif #ifdef i386 #undef SP #define SP sp #endif /****************************************/ /* Process state strings that we return */ /****************************************/ #define SLEEP "sleep" #define WAIT "wait" #define RUN "run" #define IDLE "idle" #define ZOMBIE "defunct" #define STOP "stop" #define ONPROC "onprocessor" /* Solaris is an all-or-nothing deal, all this stuff comes out of one structure, so we don't need to dick around with the format much */ #if defined(PROC_FS) static char Format[] = "iiiiiiiilllllliilllslssissi"; #else static char Format[] = "iiiiiiiilllllllllslssssi"; #endif /* Mapping of field to type */ static char* Fields[] = { "uid", "gid", "euid", "egid", "pid", "ppid", "pgrp", "sess", "priority", "nice", "ttynum", "flags", "time", "ctime", #if defined(PROC_FS) "timensec", "ctimensec", #endif "size", "rss", "wchan", "fname", "start", "pctcpu", "state", #if defined(PROC_FS) "onpro", #endif "pctmem", "cmndline", "numthr" }; Proc-ProcessTable-0.59/os/aix.h0000644000175000017500000000560713501006311014435 0ustar jwbjwb/***************************************************************************/ /* Includes */ /***************************************************************************/ #include #include #include #include #include #include #include #include #include #include #include #include #include /***************************************************************************/ /* Defines */ /***************************************************************************/ /* * Process states * */ #define SLEEP "sleep" #define WAIT "wait" #define RUN "run" #define IDLE "idle" #define ZOMBIE "defunct" #define STOP "stop" #define UWAIT "uwait" #define ACTIVE "active" /*****************************************************************************/ /* Copyright (c) 1998, David Paquet. All rights reserved. */ /* This file is free software; you can redistribute it and/or modify it */ /* under the same terms as Perl itself. */ /*****************************************************************************/ /* * Arbitrary constants * */ /* Grab the maximum argument length */ #include #define MAX_PROCS 1024 /* Pretty overloaded isn't it ? */ #define MAXARGLN ARG_MAX /* * Some landmarks ... * */ #define F_STAT 9 #define F_TTY 27 #define F_PRM 32 #define F_COMM 33 #define F_FLAST 33 /***************************************************************************/ /* Globals */ /***************************************************************************/ static unsigned long long Sysmem; static int PageSize; static int ProcessNumber; static char Fullformat[] = "llllllllsslsllllllllllllllllllllsss"; static char Zombformat[] = "lllllllllslslllllll"; static char* ZombFields[] = { "pid", "ppid", "sess", "pgrp", "uid", "suid", "priority", "nice", "pctcpu", "stat", "flags", "wchan", "wtype", "adspace", "majflt", "minflt", "utime", "stime", "size" }; static char* FullFields[] = { "pid", "ppid", "sess", "pgrp", "uid", "suid", "priority", "nice", "pctcpu", "stat", "flags", "wchan", "wtype", "adspace", "majflt", "minflt", /* "utime", */ /* field valid for zombies only, see */ /* "stime", */ /* field valid for zombies only, see */ "size", "luid", "euid", "gid", "start", "utime", "stime", "cutime", "cstime", "tsize", "ttyp", "ttynum", "ttympx", "drss", "trss", "dvm", "pctmem", "comm", "cmndline" }; Proc-ProcessTable-0.59/os/DecOSF.h0000644000175000017500000000234513501006311014713 0ustar jwbjwb#include #include #include #include #include #include #include #include /* needed for process state constants */ #include /* needed for process state constants */ #include #include #include #ifdef i386 #undef SP #define SP sp #endif /* How many processes to get at once from table() */ #define PROCCNT 64 /****************************************/ /* Process state strings that we return */ /****************************************/ #define SLEEP "sleep" #define WAIT "wait" #define RUN "run" #define IDLE "idle" #define ZOMBIE "defunct" #define STOP "stop" #define ONPROC "onprocessor" /* Digital Unix is an all-or-nothing deal, all this stuff comes out of one structure, so we don't need to dick around with the format much */ static char Format[] = "iiiiiiViiiilllllllssss"; /* Mapping of field to type */ static char* Fields[] = { "uid", "gid", "euid", "egid", "suid", "sgid", "groups", "pid", "ppid", "pgrp", "sess", "priority", "ttynum", "flags", "time", "size", "rss", "start", "fname", "pctcpu", "state", "cmndline" }; Proc-ProcessTable-0.59/os/aix.c0000644000175000017500000001504313501006311014423 0ustar jwbjwb/*****************************************************************************/ /* Copyright (c) 1998, David Paquet. All rights reserved. */ /* This file is free software; you can redistribute it and/or modify it */ /* under the same terms as Perl itself. */ /*****************************************************************************/ #include "os/aix.h" char* OS_initialize() { struct CuAt* obj; int how_many; Sysmem = 0; /* * Get the real memory size via ODM * */ if (odm_initialize() == 0) { obj = (struct CuAt*)getattr ("sys0", "realmem", 0, &how_many); Sysmem = strtoull(obj->value, 0, 10); odm_terminate(); } else { printf("BIG PROLEM !\n"); } Sysmem = Sysmem * 1024; /* * Get The number of processors * */ ProcessNumber = sysconf(_SC_NPROCESSORS_ONLN); if ( ProcessNumber == -1 ) { ProcessNumber = 1; } /* * Get the page size in bytes * */ PageSize = getpagesize(); return NULL; } void OS_get_table() { int i, proc_nb; struct procinfo pr_buff[MAX_PROCS]; struct userinfo uinfo; char format[F_FLAST + 1]; char wchan[15], pctcpu[7], pctmem[7], state[10]; char Args[MAXARGLN+1], Arglist[MAXARGLN+1], Comm[MAXARGLN+1]; int argcount; struct timeval now_tval; double utime, stime, cutime, cstime, now; strcpy(format, Fullformat); proc_nb = getproc(pr_buff, MAX_PROCS, sizeof(struct procinfo)); gettimeofday(&now_tval, (void *)NULL); now = (double)now_tval.tv_sec + (double) now_tval.tv_usec / 1000000.0; for(i=0; i= 0; ++kp) { #endif struct extern_proc *p; struct eproc *e; /* Also, jlv pointed out that the original kinfo, * allocated to hold all process entries, was not * needed or efficiently used, and an automatic * kinfo big enough to hold a single process entry, * was all that was needed. His rt.cpan.org ticket * (24331) also reports the same off-by-one error * previously reported by Jan Ruzucka */ KINFO kinfo; memset(&kinfo, 0, sizeof(kinfo)); KINFO *ki = &kinfo; #ifdef TESTING char *ttname = NULL; #endif /* def TESTING */ time_value_t total_time, system_time, user_time; ki->ki_p = kp; get_task_info(ki); p = KI_PROC (ki); e = KI_EPROC (ki); state = p->p_stat == SZOMB ? SZOMB : ki->state; getproclline (ki, &command_name, &cmdlen, 0, 1); user_time = ki->tasks_info.user_time; time_value_add (&user_time, &ki->times.user_time); system_time = ki->tasks_info.system_time; time_value_add (&system_time, &ki->times.system_time); total_time = user_time; time_value_add (&total_time, &system_time); #ifndef TH_USAGE_SCALE #define TH_USAGE_SCALE 1000 #endif /* ndef TH_USAGE_SCALE */ #define usage_to_percent(u) ((u*100)/TH_USAGE_SCALE) #define usage_to_tenths(u) (((u*1000)/TH_USAGE_SCALE) % 10) sprintf (pctcpu, "%d.%01d", usage_to_percent (ki->cpu_usage), usage_to_tenths (ki->cpu_usage)); sprintf (pctmem, "%.1f", ((float) ki->tasks_info.resident_size) * 100 / mempages); #ifdef TIME_IN_MICROSECONDS #define time_value_to_ticks(x) 1000000LL * (x).seconds + (x).microseconds #else /* def TIME_IN_MICROSECONDS */ #define time_value_to_ticks(x) ((long) (x).seconds * 100 + \ ((long) (x).microseconds + 5000) / 10000) #endif /* def TIME_IN_MICROSECONDS */ #ifdef TESTING /* Since we're testing stand-alone, we'll provide a ttydev value * for the look of the thing. We don't have to do this when live, * since the .xs module does this automagically when it sees the * ttynum value. This means ttydev must be passed BEFORE * ttynum. */ if (e->e_tdev != NODEV) ttname = devname (e->e_tdev, S_IFCHR); if (ttname == NULL) ttname = ""; #ifdef DEBUGGING printf ("\nPid: %d; i:%d; kp: %p\n", p->p_pid, i, kp); #else /* def DEBUGGING */ printf ("\nPid: %d\n", p->p_pid); #endif /* def DEBUGGING */ printf (" ppid: %d\n", e->e_ppid); printf (" pgid: %d\n", e->e_pgid); printf (" uid: %d\n", e->e_pcred.p_ruid); printf (" gid: %d\n", e->e_pcred.p_rgid); printf (" euid: %d\n", e->e_ucred.cr_uid); printf (" egid: %d\n", e->e_ucred.cr_gid); printf (" suid: %d\n", e->e_pcred.p_svuid); printf (" sgid: %d\n", e->e_pcred.p_svgid); printf ("priority: %u\n", ki->curpri); printf (" size: %lu Kb\n", (u_long)ki->tasks_info.virtual_size/1024); printf (" rss: %lu Kb\n", (u_long)ki->tasks_info.resident_size/1024); printf (" flags: %#0x\n", p->p_flag); printf (" nice: %d\n", p->p_nice); printf (" session: %p\n", e->e_sess); #ifdef TIME_IN_MICROSECONDS printf (" time: %lld microseconds\n", time_value_to_ticks (total_time)); printf (" stime: %lld microseconds\n", time_value_to_ticks (system_time)); printf (" utime: %lld microseconds\n", time_value_to_ticks (user_time)); #else /* def TIME_IN_MICROSECONDS */ printf (" time: %ld centiseconds\n", time_value_to_ticks (total_time)); printf (" stime: %ld centiseconds\n", time_value_to_ticks (system_time)); printf (" utime: %ld centiseconds\n", time_value_to_ticks (user_time)); #endif /* def TIME_IN_MICROSECONDS */ printf (" start: %ld\n", (unsigned long) p->p_starttime.tv_sec); printf (" wchan: %p\n", p->p_wchan); printf (" ttydev: %s\n", ttname); printf (" ttynum: %ld\n", (long) e->e_tdev); printf (" %%cpu: %s\n", pctcpu); printf (" %%mem: %s\n", pctmem); printf (" state: %d (%s)\n", state, States[state]); printf (" cmd: %s\n", cmdlen ? command_name : " (none available)"); printf (" fname: %s\n", p->p_comm); #else /* def TESTING */ /* Send if off to Perl */ bless_into_proc (Format, Fields, p->p_pid, e->e_ppid, e->e_pgid, e->e_pcred.p_ruid, e->e_pcred.p_rgid, e->e_ucred.cr_uid, e->e_ucred.cr_gid, e->e_pcred.p_svuid, e->e_pcred.p_svgid, ki->curpri, ki->tasks_info.virtual_size/1024, ki->tasks_info.resident_size/1024, p->p_flag, p->p_nice, e->e_sess, time_value_to_ticks (total_time), time_value_to_ticks (system_time), time_value_to_ticks (user_time), p->p_starttime.tv_sec, p->p_wchan, "", /* The .xs code provides ttydev automagically */ e->e_tdev, pctcpu, pctmem, States[state], cmdlen ? command_name : "", p->p_comm ); #endif /* def TESTING */ if (command_name != NULL) free (command_name); } FREE_BUFFERS } /* We're done with this definition of FREE_BUFFERS. Get rid of it in * the hope that using it below (as a consequence of an inappropriate * use of DIE_HORRIBLY, for example) will generate a more obvious * error message. */ #undef FREE_BUFFERS /* * The interface used to fetch the command arguments changed * drastically between Jaguar (MacOS 10.2, Darwin 6.something) and * Panther (MacOS 10.3, Darwin version unknown to me at this time). * The corresponding module of the ps command changed likewise. * Unfortunately, we have to either keep both interfaces around, * or abandon Panther (stupid!), or abandon Jaguar (which I'm reluctant * to do, since I have a not-so-sneaking sympathy for those who upgrade * no software before its time). -- TRW */ #ifdef KERN_PROCARGS2 /* * The following is pretty much verbatim from module print.c of the * Panther version of the ps command. Specifically, it's from * adv_cmds-63. But the calling sequence has been modified for our * convenience. Specifically, the global variable eflg has been made * into an argument. -- TRW */ /* * Get command and arguments. * * If the global variable eflg is non-zero and the user has permission to view * the process's environment, the environment is included. */ static void getproclline(KINFO *k, char **command_name, int *cmdlen, int eflg, int show_args) { int mib[3], argmax, nargs, c = 0; size_t size; char *procargs, *sp, *np, *cp; /* Made into a command argument. -- TRW * extern int eflg; */ /* Get the maximum process arguments size. */ mib[0] = CTL_KERN; mib[1] = KERN_ARGMAX; size = sizeof(argmax); if (sysctl(mib, 2, &argmax, &size, NULL, 0) == -1) { goto ERROR_A; } /* Allocate space for the arguments. */ procargs = (char *)malloc(argmax); if (procargs == NULL) { goto ERROR_A; } /* * Make a sysctl() call to get the raw argument space of the process. * The layout is documented in start.s, which is part of the Csu * project. In summary, it looks like: * * /---------------\ 0x00000000 * : : * : : * |---------------| * | argc | * |---------------| * | arg[0] | * |---------------| * : : * : : * |---------------| * | arg[argc - 1] | * |---------------| * | 0 | * |---------------| * | env[0] | * |---------------| * : : * : : * |---------------| * | env[n] | * |---------------| * | 0 | * |---------------| <-- Beginning of data returned by sysctl() is here. * | argc | * |---------------| * | exec_path | * |:::::::::::::::| * | | * | String area. | * | | * |---------------| <-- Top of stack. * : : * : : * \---------------/ 0xffffffff */ mib[0] = CTL_KERN; mib[1] = KERN_PROCARGS2; mib[2] = KI_PROC(k)->p_pid; size = (size_t)argmax; if (sysctl(mib, 3, procargs, &size, NULL, 0) == -1) { goto ERROR_B; } memcpy(&nargs, procargs, sizeof(nargs)); cp = procargs + sizeof(nargs); /* Skip the saved exec_path. */ for (; cp < &procargs[size]; cp++) { if (*cp == '\0') { /* End of exec_path reached. */ break; } } if (cp == &procargs[size]) { goto ERROR_B; } /* Skip trailing '\0' characters. */ for (; cp < &procargs[size]; cp++) { if (*cp != '\0') { /* Beginning of first argument reached. */ break; } } if (cp == &procargs[size]) { goto ERROR_B; } /* Save where the argv[0] string starts. */ sp = cp; /* * Iterate through the '\0'-terminated strings and convert '\0' to ' ' * until a string is found that has a '=' character in it (or there are * no more strings in procargs). There is no way to deterministically * know where the command arguments end and the environment strings * start, which is why the '=' character is searched for as a heuristic. */ for (np = NULL; c < nargs && cp < &procargs[size]; cp++) { if (*cp == '\0') { c++; if (np != NULL) { /* Convert previous '\0'. */ *np = ' '; } /* Note location of current '\0'. */ np = cp; if (!show_args) { /* * Don't convert '\0' characters to ' '. * However, we needed to know that the * command name was terminated, which we * now know. */ break; } } } /* * If eflg is non-zero, continue converting '\0' characters to ' ' * characters until no more strings that look like environment settings * follow. */ if ( (eflg != 0) && ( (getuid() == 0) || (KI_EPROC(k)->e_pcred.p_ruid == getuid()) ) ) { for (; cp < &procargs[size]; cp++) { if (*cp == '\0') { if (np != NULL) { if (&np[1] == cp) { /* * Two '\0' characters in a row. * This should normally only * happen after all the strings * have been seen, but in any * case, stop parsing. */ break; } /* Convert previous '\0'. */ *np = ' '; } /* Note location of current '\0'. */ np = cp; } } } /* * sp points to the beginning of the arguments/environment string, and * np should point to the '\0' terminator for the string. */ if (np == NULL || np == sp) { /* Empty or unterminated string. */ goto ERROR_B; } /* Make a copy of the string. */ *cmdlen = asprintf(command_name, "%s", sp); /* Clean up. */ free(procargs); return; ERROR_B: free(procargs); ERROR_A: *cmdlen = asprintf(command_name, "(%s)", KI_PROC(k)->p_comm); } #else /* #ifdef KERN_PROCARGS2 */ /* * The following code is pretty much verbatim from module print.c of * the ps command. The version of print.c is unknown. It is identical * to, but certainly earlier than, the version in adv_cmds-46, which * is the most recent version that goes with Jaguar. The calling * sequence has been modified to pass eflg as an argument (rather than * a global variable), and to be the same as the Panther version. Also, * some band-aid code has been inserted late in the module to cover an * apparent bug. The Panther version of this subroutine was completely * rewritten, and uses a different sysctl funtion. -- TRW. */ static void getproclline (KINFO *k, char ** command_name, int *cmdlen, int eflg, int show_args) /* show_args = 1, display environment; 0 = don't. */ { /* * Get command and arguments. */ int command_length; char * cmdpath; volatile int *ip, *savedip; volatile char *cp; int nbad; char c; char *end_argc; int mib[4]; char * arguments; size_t arguments_size = 4096; int len=0; volatile unsigned int *valuep; unsigned int value; int blahlen=0, skiplen=0; /* A sysctl() is made to find out the full path that the command was called with. */ *command_name = NULL; *cmdlen = 0; mib[0] = CTL_KERN; mib[1] = KERN_PROCARGS; mib[2] = KI_PROC(k)->p_pid; mib[3] = 0; arguments = (char *) malloc(arguments_size); if (sysctl(mib, 3, arguments, &arguments_size, NULL, 0) < 0) { goto retucomm; } end_argc = &arguments[arguments_size]; ip = (int *)end_argc; ip -= 2; /* last arg word and .long 0 */ while (*--ip) if (ip == (int *)arguments) goto retucomm; savedip = ip; savedip++; cp = (char *)savedip; while (*--ip) if (ip == (int *)arguments) goto retucomm; ip++; valuep = (unsigned int *)ip; value = *valuep; if ((value & 0xbfff0000) == 0xbfff0000) { ip++;ip++; valuep = ip; blahlen = strlen((char *) ip); skiplen = (blahlen +3 ) /4 ; valuep += skiplen; cp = (char *)valuep; while (!*cp) { cp++; } savedip = (int *) cp; } nbad = 0; for (cp = (char *)savedip; cp < (end_argc-1); cp++) { c = *cp & 0177; if (c == 0) *cp = ' '; else if (c < ' ' || c > 0176) { if (++nbad >= 5*(eflg+1)) { *cp++ = ' '; break; } *cp = '?'; } else if (eflg == 0 && c == '=') { while (*--cp != ' ') if (cp <= (char *)ip) break; break; } } *cp = 0; #if 0 while (*--cp == ' ') *cp = 0; #endif cp = (char *)savedip; command_length = end_argc - cp; /* <= MAX_COMMAND_SIZE */ if (cp[0] == '-' || cp[0] == '?' || cp[0] <= ' ') { /* * Not enough information - add short command name */ /* * I have a report of this section of the code failing under * Panther because command_length < 0. When Jaguar hits this * code it typically has a largeish value of command_length * (200 bytes plus). Both are clearly bogus, though in the * case of Panther, the problem is benign. The problem is * that Jaguar uses a completely different sysctl call to * get the data, so I can't simply use that code. The * print.c module of the ps command from adv_cmds_43 (the * latest Jaguar version) is identical to the one I based * this code on originally. So no help there. Until I can * figure something better, we'll just have to rely on this * band-aid. A possible way to proceed, once I upgrade to * Panther myself, is to conditionalize on the existence of * KERN_PROCARGS2 to decide which version of this subroutine * to use. Sigh. -- TRW */ #ifdef DEBUGGING fprintf (stdout, "Debug - getproclline found short cmd; pid %d command_length %d\n", KI_PROC(k)->p_pid, command_length); #endif if (command_length > 0) { len = ((unsigned)command_length + MAXCOMLEN + 5); cmdpath = (char *)malloc(len); (void) strncpy(cmdpath, (const char *) cp, command_length); (void) strcat(cmdpath, " ("); (void) strncat(cmdpath, KI_PROC(k)->p_comm, MAXCOMLEN+1); (void) strcat(cmdpath, ")"); *command_name = cmdpath; *cmdlen = len; } else { cmdpath = (char *)malloc(2); strncpy (cmdpath, "", 2); *command_name = cmdpath; *cmdlen = 0; } free(arguments); return; } else { cmdpath = (char *)malloc((unsigned)command_length + 1); (void) strncpy(cmdpath, (const char *) cp, command_length); cmdpath[command_length] = '\0'; *command_name = cmdpath; *cmdlen = command_length; free(arguments); return; } retucomm: len = (MAXCOMLEN + 5); cmdpath = (char *)malloc(len); (void) strcpy(cmdpath, " ("); (void) strncat(cmdpath, KI_PROC(k)->p_comm, MAXCOMLEN+1); (void) strcat(cmdpath, ")"); *cmdlen = len; *command_name = cmdpath; free(arguments); return; } #endif /* #ifdef KERN_PROCARGS2 */ static int mach_state_order (int s, long sleep_time); static int thread_schedinfo (KINFO *ki, thread_port_t thread, policy_t pol, void * buf); static int get_task_info (KINFO *ki) { kern_return_t error; unsigned int info_count = TASK_BASIC_INFO_COUNT; unsigned int thread_info_count = THREAD_BASIC_INFO_COUNT; pid_t pid; int j, err = 0; pid = KI_PROC(ki)->p_pid; if (task_for_pid(mach_task_self(), pid, &ki->task) != KERN_SUCCESS) { return(1); } info_count = TASK_BASIC_INFO_COUNT; error = task_info(ki->task, TASK_BASIC_INFO, (task_info_t) &ki->tasks_info, &info_count); if (error != KERN_SUCCESS) { ki->invalid_tinfo=1; #ifdef DEBUG mach_error("Error calling task_info()", error); #endif return(1); } { vm_region_basic_info_data_64_t b_info; vm_address_t address = GLOBAL_SHARED_TEXT_SEGMENT; vm_size_t size; mach_port_t object_name; /* * try to determine if this task has the split libraries * mapped in... if so, adjust its virtual size down by * the 2 segments that are used for split libraries */ info_count = VM_REGION_BASIC_INFO_COUNT_64; error = vm_region_64(ki->task, &address, &size, VM_REGION_BASIC_INFO, (vm_region_info_t)&b_info, &info_count, &object_name); if (error == KERN_SUCCESS) { if (b_info.reserved && size == (SHARED_TEXT_REGION_SIZE) && ki->tasks_info.virtual_size > (SHARED_TEXT_REGION_SIZE + SHARED_DATA_REGION_SIZE)) ki->tasks_info.virtual_size -= (SHARED_TEXT_REGION_SIZE + SHARED_DATA_REGION_SIZE); } } info_count = TASK_THREAD_TIMES_INFO_COUNT; error = task_info(ki->task, TASK_THREAD_TIMES_INFO, (task_info_t) &ki->times, &info_count); if (error != KERN_SUCCESS) { ki->invalid_tinfo=1; #ifdef DEBUG mach_error("Error calling task_info()", error); #endif return(1); } switch(ki->tasks_info.policy) { case POLICY_TIMESHARE : info_count = POLICY_TIMESHARE_INFO_COUNT; error = task_info(ki->task, TASK_SCHED_TIMESHARE_INFO, (task_info_t) &ki->schedinfo.tshare, &info_count); if (error != KERN_SUCCESS) { ki->invalid_tinfo=1; #ifdef DEBUG mach_error("Error calling task_info()", error); #endif return(1); } ki->curpri = ki->schedinfo.tshare.cur_priority; ki->basepri = ki->schedinfo.tshare.base_priority; break; case POLICY_RR : info_count = POLICY_RR_INFO_COUNT; error = task_info(ki->task, TASK_SCHED_RR_INFO, (task_info_t) &ki->schedinfo.rr, &info_count); if (error != KERN_SUCCESS) { ki->invalid_tinfo=1; #ifdef DEBUG mach_error("Error calling task_info()", error); #endif return(1); } ki->curpri = ki->schedinfo.rr.base_priority; ki->basepri = ki->schedinfo.rr.base_priority; break; case POLICY_FIFO : info_count = POLICY_FIFO_INFO_COUNT; error = task_info(ki->task, TASK_SCHED_FIFO_INFO, (task_info_t) &ki->schedinfo.fifo, &info_count); if (error != KERN_SUCCESS) { ki->invalid_tinfo=1; #ifdef DEBUG mach_error("Error calling task_info()", error); #endif return(1); } ki->curpri = ki->schedinfo.fifo.base_priority; ki->basepri = ki->schedinfo.fifo.base_priority; break; } ki->invalid_tinfo=0; ki->cpu_usage=0; error = task_threads(ki->task, &ki->thread_list, &ki->thread_count); if (error != KERN_SUCCESS) { mach_port_deallocate(mach_task_self(),ki->task); #ifdef DEBUG mach_error("Call to task_threads() failed", error); #endif return(1); } err=0; ki->state = STATE_MAX; //ki->curpri = 255; //ki->basepri = 255; ki->swapped = 1; ki->thval = malloc(ki->thread_count * sizeof(struct thread_values)); if (ki->thval != NULL) { for (j = 0; j < ki->thread_count; j++) { int tstate; thread_info_count = THREAD_BASIC_INFO_COUNT; error = thread_info(ki->thread_list[j], THREAD_BASIC_INFO, (thread_info_t)&ki->thval[j].tb, &thread_info_count); if (error != KERN_SUCCESS) { #ifdef DEBUG mach_error("Call to thread_info() failed", error); #endif err=1; } error = thread_schedinfo(ki, ki->thread_list[j], ki->thval[j].tb.policy, &ki->thval[j].schedinfo); if (error != KERN_SUCCESS) { #ifdef DEBUG mach_error("Call to thread_info() failed", error); #endif err=1; } ki->cpu_usage += ki->thval[j].tb.cpu_usage; tstate = mach_state_order(ki->thval[j].tb.run_state, ki->thval[j].tb.sleep_time); if (tstate < ki->state) ki->state = tstate; if ((ki->thval[j].tb.flags & TH_FLAGS_SWAPPED ) == 0) ki->swapped = 0; mach_port_deallocate(mach_task_self(), ki->thread_list[j]); } free (ki->thval); ki->thval = NULL; } ki->invalid_thinfo = err; /* Deallocate the list of threads. */ error = vm_deallocate(mach_task_self(), (vm_address_t)(ki->thread_list), sizeof(thread_port_array_t) * ki->thread_count); if (error != KERN_SUCCESS) { #ifdef DEBUG mach_error("Trouble freeing thread_list", error); #endif } mach_port_deallocate(mach_task_self(),ki->task); return(0); } static int mach_state_order (int s, long sleep_time) { switch (s) { case TH_STATE_RUNNING: return(1); case TH_STATE_UNINTERRUPTIBLE: return(2); case TH_STATE_WAITING: return((sleep_time > 20) ? 4 : 3); case TH_STATE_STOPPED: return(5); case TH_STATE_HALTED: return(6); default: return(7); } } static int thread_schedinfo (KINFO *ki, thread_port_t thread, policy_t pol, void * buf) { unsigned int count; int ret = KERN_FAILURE; switch (pol) { case POLICY_TIMESHARE: count = POLICY_TIMESHARE_INFO_COUNT; ret = thread_info(thread, THREAD_SCHED_TIMESHARE_INFO, (thread_info_t)buf, &count); if((ret == KERN_SUCCESS) && (ki->curpri < (((struct policy_timeshare_info *)buf)->cur_priority))) ki->curpri = ((struct policy_timeshare_info *)buf)->cur_priority; break; case POLICY_FIFO: count = POLICY_FIFO_INFO_COUNT; ret = thread_info(thread, THREAD_SCHED_FIFO_INFO, buf, &count); if((ret == KERN_SUCCESS) && (ki->curpri < (((struct policy_fifo_info *)buf)->base_priority))) ki->curpri = ((struct policy_fifo_info *)buf)->base_priority; break; case POLICY_RR: count = POLICY_RR_INFO_COUNT; ret = thread_info(thread, THREAD_SCHED_RR_INFO, buf, &count); if((ret == KERN_SUCCESS) && (ki->curpri < (((struct policy_rr_info *)buf)->base_priority))) ki->curpri = ((struct policy_rr_info *)buf)->base_priority; break; } return(ret); }Proc-ProcessTable-0.59/os/FreeBSD.c0000644000175000017500000000742013501006311015054 0ustar jwbjwb #include "os/FreeBSD.h" /* Given a path to a /proc/XXX/status file and a pointer to a procstat struct, fill the struct */ struct procstat* get_procstat( char* path, struct procstat* prs){ FILE* fp; if( (fp = fopen( path, "r" )) != NULL ){ fscanf(fp, #ifdef PROCFS_FREEBSD_6 "%s %d %d %d %d %s %s %d,%d %d,%d %d,%d %s %d %d %d,%d,%s", #else "%s %d %d %d %d %d,%d %s %d,%d %d,%d %d,%d %s %d %d %d,%d,%s", #endif &prs->comm, &prs->pid, &prs->ppid, &prs->pgid, &prs->sid, #ifdef PROCFS_FREEBSD_6 &prs->ttydev, #else &prs->tdev_maj, &prs->tdev_min, #endif &prs->flags, &prs->start, &prs->start_mic, &prs->utime, &prs->utime_mic, &prs->stime, &prs->stime_mic, &prs->wchan, &prs->euid, &prs->ruid, &prs->rgid, &prs->egid, &prs->groups ); fclose(fp); return(prs); } else{ return(NULL); } } /* Make sure /proc is mounted and initialize some global vars */ char* OS_initialize(){ char cbuf[1024]; char bbuf[32]; struct statfs sfs; static char* no_proc = "/proc unavailable"; if( statfs("/proc", &sfs) == -1 ){ return no_proc; } return NULL; } void OS_get_table(){ DIR *procdir; struct dirent *procdirp; FILE *fp; char pathbuf[PATH_MAX]; /* for bless_into_proc */ struct procstat prs; static char format[F_LASTFIELD + 2]; char cmndline[ARG_MAX]; int priority; if( (procdir = opendir("/proc")) == NULL ){ return; } /* Iterate through all the process entries (numeric) under /proc */ while( (procdirp = readdir(procdir)) != NULL ){ /* Only look at this file if it's a proc id; that is, all numbers */ if( strtok(procdirp->d_name, "0123456789") == NULL ){ /* zero our format */ strcpy(format, Defaultformat); sprintf(pathbuf, "%s%s", "/proc/", procdirp->d_name); /* get stuff out of /proc/PROC_ID/status */ memset(&prs, 0, sizeof(prs)); strcat( pathbuf, "/status" ); if (get_procstat(pathbuf, &prs) != NULL) { int i; char utime[20]; double utime_f; char stime[20]; double stime_f; char time[20]; double time_f; char start[20]; double start_f; char *ttydev; int ttynum; #ifdef PROCFS_FREEBSD_6 struct stat tdev_stat; #endif utime_f = prs.utime + prs.utime_mic/1000000.0; stime_f = prs.stime + prs.stime_mic/1000000.0; time_f = utime_f + stime_f; start_f = prs.start + prs.start_mic/1000000.0; sprintf(utime, "%f", utime_f); sprintf(stime, "%f", stime_f); sprintf(time, "%f", time_f); sprintf(start, "%f", start_f); #ifdef PROCFS_FREEBSD_6 ttydev = prs.ttydev; sprintf(pathbuf, "/dev/%s", ttydev); if (stat(pathbuf, &tdev_stat) < 0){ ttynum = -1; } else { ttynum = tdev_stat.st_rdev; } #else ttynum = makedev(prs.tdev_maj, prs.tdev_min); ttydev = devname(ttynum, S_IFCHR); if (ttydev == NULL) ttydev = "??"; #endif /* get stuff out of /proc/PROC_ID/cmdline */ sprintf(pathbuf, "%s%s%s", "/proc/", procdirp->d_name, "/cmdline"); if( (fp = fopen( pathbuf, "r" )) != NULL ){ size_t got; if( (got = fread(cmndline, sizeof(char), ARG_MAX, fp)) > 0 ){ size_t i; for(i = 0; i < got; i++){ if( cmndline[i] == '\0' ) cmndline[i] = ' '; } cmndline[got] = '\0'; /* necessary? */ format[F_CMNDLINE] = tolower(format[F_CMNDLINE]); } fclose(fp); } // get priority errno = 0; priority = getpriority(PRIO_PROCESS, prs.pid); if (!errno) format[F_PRIORITY] = tolower(format[F_PRIORITY]); bless_into_proc( format, Fields, prs.ruid, prs.rgid, prs.pid, prs.ppid, prs.pgid, prs.sid, prs.flags, utime, stime, time, prs.wchan, start, prs.euid, prs.egid, prs.comm, prs.wchan, ttydev, ttynum, cmndline, priority ); } } } closedir(procdir); } Proc-ProcessTable-0.59/os/OpenBSD.c0000644000175000017500000000732213501006311015075 0ustar jwbjwb/* * Copyright (c) 2006, William Yodlowsky * This file is free software; it can be modified and/or * redistributed under the same terms as Perl itself */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include void ppt_croak(const char *pat, ...); /* No need for the procstat structure since we don't use /proc */ /* We need to pass in a cap for ignore, lower for store on object */ /* We can just lc these! */ static char Defaultformat[] = "liiiiiiiiiiiillssss"; /* Mapping of field to type */ static char* Fields[] = { "ttynum", "uid", "gid", "euid", "egid", "pid", "ppid", "pgrp", "sess", "time", "utime", "stime", "start", "size", "rss", "fname", "state", "ttydev", "cmndline" }; #define F_LASTFIELD 18 /* Set up simple bounds checking */ #define STRLCPY(num,targ,src) if (strlcpy(targ,src,sizeof(targ)) >= sizeof(targ)) \ ppt_croak("call:%d source string is too big to copy into buffer", num); #define STRLCAT(num,targ,src) if (strlcat(targ,src,sizeof(targ)) >= sizeof(targ)) \ ppt_croak("call:%d source string is too big to append to buffer", num); extern void bless_into_proc(char* format, char** fields, ...); char* OS_initialize() { return(NULL); } void OS_get_table() { kvm_t *kd; char errbuf[_POSIX2_LINE_MAX]; struct kinfo_proc *procs; int count; int i, argcount; int ttynum; long start; unsigned long vsize; unsigned long rss; char *ttydev; char cmndline[ARG_MAX+1]; char **pargv; /* for bless_into_proc */ static char format[F_LASTFIELD + 2]; char state[20]; /* open the kvm interface */ if ((kd = kvm_open(NULL, NULL, NULL, KVM_NO_FILES, errbuf)) == NULL) { ppt_croak("kvm_open: %s", errbuf); } /* get processes */ if ((procs = kvm_getprocs(kd, KERN_PROC_ALL, 0, sizeof(*procs), &count)) == NULL) { kvm_close(kd); ppt_croak("kvm_getprocs: %s", kvm_geterr(kd)); } /* bless_into_proc each process's information */ for (i=0; i < count; i++) { STRLCPY(1,format,Defaultformat); /* get ttydev */ ttynum=procs[i].p_tdev; ttydev=devname(ttynum, S_IFCHR); if (ttydev == NULL) ttydev = "??"; /* process state */ switch (procs[i].p_stat) { case SIDL: STRLCPY(2,state,"IDLE"); break; case SRUN: STRLCPY(3,state,"RUN"); break; case SSLEEP: STRLCPY(4,state,"SLEEP"); break; case SSTOP: STRLCPY(5,state,"STOP"); break; case SZOMB: STRLCPY(6,state,"ZOMBIE"); break; default: STRLCPY(7,state,"UNKNOWN"); break; } vsize = getpagesize() * (procs[i].p_vm_dsize + procs[i].p_vm_ssize + procs[i].p_vm_tsize); rss = getpagesize() * procs[i].p_vm_rssize; /* arguments */ cmndline[0] = '\0'; pargv = kvm_getargv(kd, (const struct kinfo_proc *) &(procs[i]), 0); if (pargv) { argcount = 0; while (pargv[argcount] && strlen(cmndline)+strlen(pargv[argcount])+1 <= ARG_MAX) { STRLCAT(1,cmndline,pargv[argcount]); if (pargv[argcount+1]) { STRLCAT(2,cmndline," "); } argcount++; } } /* everything else is straightforward, bless the lot */ bless_into_proc( format, Fields, ttynum, procs[i].p_ruid, procs[i].p_rgid, procs[i].p_uid, procs[i].p_gid, procs[i].p_pid, procs[i].p_ppid, procs[i].p__pgid, procs[i].p_sid, procs[i].p_rtime_sec, procs[i].p_uutime_sec, procs[i].p_ustime_sec, procs[i].p_ustart_sec, vsize, rss, procs[i].p_comm, state, ttydev, cmndline ); } if (kd) { kvm_close(kd); } } Proc-ProcessTable-0.59/os/Linux.h0000644000175000017500000001447113501006311014752 0ustar jwbjwb#define LENGTH_PCTCPU 10 /* Maximum percent cpu sufficient to hold 100000.00 or up to 1000 cpus */ /* Proc::ProcessTable functions */ void ppt_warn(const char*, ...); void bless_into_proc(char* , char**, ...); /* it also gets used by init_static_vars at the way top of the file, * I wanted init_static_vars to be at the way top close to the global vars */ static char *read_file(const char *path, const char *extra_path, off_t *len, struct obstack *mem_pool); struct procstat { /* user/group id of the user running it */ int uid; int gid; /* values scraped from /proc/{$pid}/stat */ pid_t pid; char comm[16]; /* limit in kernel, likewise in procps */ char state_c; int ppid; int pgrp; int sid; int tracer; int tty; unsigned flags; unsigned long minflt, cminflt, majflt, cmajflt; unsigned long long utime, stime; long long cutime, cstime; long priority; unsigned long long start_time; unsigned long vsize; long rss; unsigned long wchan; /* these are derived from above time values */ unsigned long long time, ctime; /* from above state_c but fixed up elsewhere */ const char *state; /* values scraped from /proc/{$pid}/status */ int euid, suid, fuid; int egid, sgid, fgid; /* cwd, cmdline & exec files; values allocated at the end of obstacks */ char *cwd; char *cmndline; char *cmdline; int cmdline_len; char *environ; int environ_len; char *exec; /* other values */ char pctcpu[LENGTH_PCTCPU]; /* precent cpu, without '%' char */ char pctmem[sizeof("100.00")]; /* precent memory, without '%' char */ }; enum state { SLEEP, WAIT, RUN, IDLE, DEFUNCT, STOP, UWAIT, DEAD, WAKEKILL, TRACINGSTOP, PARKED }; /* strings, to make sure they get placed in read only memory, * ditto for pointers to them and so we avoid relocations */ static const char strings[] = { /* process state */ "sleep\0" "wait\0" "run\0" "idle\0" "defunct\0" "stop\0" "uwait\0" "dead\0" "wakekill\0" "tracingstop\0" /* error messages */ "/proc unavailable\0" "intilization failed\0" /* fields */ "uid\0" "gid\0" "pid\0" "fname\0" "ppid\0" "pgrp\0" "sess\0" "ttynum\0" "flags\0" "minflt\0" "cminflt\0" "majflt\0" "cmajflt\0" "utime\0" "stime\0" "cutime\0" "cstime\0" "priority\0" "start\0" "size\0" "rss\0" "wchan\0" "time\0" "ctime\0" "state\0" "euid\0" "suid\0" "fuid\0" "egid\0" "sgid\0" "fgid\0" "pctcpu\0" "pctmem\0" "cmndline\0" "exec\0" "cwd\0" "cmdline\0" "environ\0" "tracer\0" /* format string */ "IIISIIIILLLLLJJJJIJPLLJJSIIIIIISSSSSAAI\0" }; /* I generated this array with a perl script processing the above char array, * and then performed cross string optimization (by hand) for: * pid, time, uid, gid, minflt, majflt, */ static const size_t strings_index[] = { /* process status strings */ 0, 6, 11, 15, 20, 28, 33, 39, 44, 53, /* error messages */ 65, 83, /* fields */ 103, 107, 111, 115, 121, 126, 131, 136, 143, 149, 156, 164, 171, 179, 185, 191, 198, 205, 214, 220, 225, 229, 235, 240, 246, 252, 257, 262, 267, 272, 277, 282, 289, 296, 305, 310, 314, 322, 330, /* default format string (pre lower casing) */ 337 }; enum string_name { /* NOTE: we start this enum at 10, so we can use still keep using the * state enum, and have those correspond to the static strings */ /* error messages */ STR_ERR_PROC_STATFS = 10, STR_ERR_INIT, /* fields */ STR_FIELD_UID, STR_FIELD_GID, STR_FIELD_PID, STR_FIELD_FNAME, STR_FIELD_PPID, STR_FIELD_PGRP, STR_FIELD_SESS, STR_FIELD_TTYNUM, STR_FIELD_FLAGS, STR_FIELD_MINFLT, STR_FIELD_CMINFLT, STR_FIELD_MAJFLT, STR_FIELD_CMAJFLT, STR_FIELD_UTIME, STR_FIELD_STIME, STR_FIELD_CUTIME, STR_FIELD_CSTIME, STR_FIELD_PRIORITY, STR_FIELD_START, STR_FIELD_SIZE, STR_FIELD_RSS, STR_FIELD_WCHAN, STR_FIELD_TIME, STR_FIELD_CTIME, STR_FIELD_STATE, STR_FIELD_EUID, STR_FIELD_SUID, STR_FIELD_FUID, STR_FIELD_EGID, STR_FIELD_SGID, STR_FIELD_FGID, STR_FIELD_PCTCPU, STR_FIELD_PCTMEM, STR_FIELD_CMNDLINE, STR_FIELD_EXEC, STR_FIELD_CWD, STR_FIELD_CMDLINE, STR_FIELD_ENIVORN, STR_FIELD_TRACER, /* format string */ STR_DEFAULT_FORMAT }; enum field { F_UID, F_GID, F_PID, F_FNAME, F_PPID, F_PGRP, F_SESS, F_TTYNUM, F_FLAGS, F_MINFLT, F_CMINFLT, F_MAJFLT, F_CMAJFLT, F_UTIME, F_STIME, F_CUTIME, F_CSTIME, F_PRIORITY, F_START, F_SIZE, F_RSS, F_WCHAN, F_TIME, F_CTIME, F_STATE, F_EUID, F_SUID, F_FUID, F_EGID, F_SGID, F_FGID, F_PCTCPU, F_PCTMEM, F_CMNDLINE, F_EXEC, F_CWD, F_CMDLINE, F_ENVIRON, F_TRACER }; static const char* const field_names[] = { strings + 103, strings + 107, strings + 111, strings + 115, strings + 121, strings + 126, strings + 131, strings + 136, strings + 143, strings + 149, strings + 156, strings + 164, strings + 171, strings + 179, strings + 185, strings + 191, strings + 198, strings + 205, strings + 214, strings + 220, strings + 225, strings + 229, strings + 235, strings + 240, strings + 246, strings + 252, strings + 257, strings + 262, strings + 267, strings + 272, strings + 277, strings + 282, strings + 289, strings + 296, strings + 305, strings + 310, strings + 314, strings + 322, strings + 330 }; Proc-ProcessTable-0.59/os/bsdi.c0000644000175000017500000001340213501006311014560 0ustar jwbjwb/**************************************************************/ /* Copyright (c) 1999, Magic Software Development, Inc. */ /* Author: Sean Ray Eskins. */ /* This file is free software; it can be modified and/or */ /* redistributed under the same terms as Perl itself. */ /**************************************************************/ #include "bsdi.h" extern void bless_into_proc(char* format, char** fields, ...); char* OS_initialize() { return(NULL); } void OS_get_table() { kvm_t *kd; char errbuf[_POSIX2_LINE_MAX]; struct kinfo_proc *procs; /* array of processes */ int count; /* returns number of processes */ int i, j; int seconds, minutes, secleft; /* for time[20] */ int milsec, shortmsec; /* for miliseconds of time[20] */ int ttynum; long start; char *ttydev; static time_t now; /* for started[20] */ struct tm *tp; /* for month/day/hour/min/AM/PM fields of started[20] */ int SECSPERHOUR = 3600; int SECSPERDAY = 24 * 3600; pid_t sesid; int length; char cmndline[MAXARGLN+1]; char ** argv; /* for bless_into_proc */ static char format[F_LASTFIELD + 2]; /* variables to hold some values for bless_into_proc */ char state[20]; char cputime[20]; char started[20]; char session[20]; char shortsess[20]; /* Open the kvm interface, get a descriptor */ if ((kd = kvm_open(NULL, NULL, NULL, 0, errbuf)) == NULL) { /* fprintf(stderr, "kvm_open: %s\n", errbuf); */ ppt_croak("kvm_open: ", errbuf); } /* Get the list of processes. */ if ((procs = kvm_getprocs(kd, KERN_PROC_ALL, 0, &count)) == NULL) { kvm_close(kd); /* fprintf(stderr, "kvm_getprocs: %s\n", kvm_geterr(kd)); */ ppt_croak("kvm_getprocs: ", kvm_geterr(kd)); } /* Iterate through the processes in kinfo_proc, sending proc info */ /* to bless_into_proc for each proc */ for (i=0; i < count; i++) { static struct pstats ps; static struct session seslead; strcpy(format, Defaultformat); /* get ttydev */ ttynum=procs[i].kp_eproc.e_tdev; ttydev=devname(ttynum, S_IFCHR); if (ttydev == NULL) ttydev = "??"; /* get the state of processes */ switch (procs[i].kp_proc.p_stat) { case SIDL: strcpy(state, IDLE); break; case SRUN: strcpy(state, RUN); break; case SSLEEP: strcpy(state, SLEEP); break; case SSTOP: strcpy(state, STOP); break; case SZOMB: strcpy(state, ZOMBIE); break; default: strcpy(state, UNKNOWN); break; } /* get the cpu time of processes */ seconds=procs[i].kp_proc.p_rtime.tv_sec; milsec=procs[i].kp_proc.p_rtime.tv_usec; shortmsec=roundit(milsec); if (seconds < 60) { if (seconds < 10) sprintf(cputime, "0:0%d.%d", seconds, shortmsec); else sprintf(cputime, "0:%d.%d", seconds, shortmsec); } else { minutes=seconds/60; secleft=seconds-(minutes * 60); if (secleft < 10) sprintf(cputime, "%d:0%d.%d", minutes, secleft, shortmsec); else sprintf(cputime, "%d:%d.%d", minutes, secleft, shortmsec); } /* get the start time of process (when started) */ /* fill the pstats struct using kvm_read */ if (kvm_read(kd, (u_long)procs[i].kp_proc.p_stats, (char *)&ps, sizeof(ps)) == sizeof(ps)) { start=ps.p_start.tv_sec; tp=localtime(&start); if (!now) (void)time(&now); if (now - ps.p_start.tv_sec < 24 * SECSPERHOUR) { static char fmt[] = __CONCAT("%l:%", "M%p"); (void)strftime(started, sizeof(started) - 1, fmt, tp); } else if (now - ps.p_start.tv_sec < 7 * SECSPERDAY) { static char fmt[] = __CONCAT("%a%", "I%p"); (void)strftime(started, sizeof(started) - 1, fmt, tp); } else (void)strftime(started, sizeof(started) - 1, "%e%b%y", tp); } /* get the session ID (ie: session pointer ID) */ sprintf(session, "%x", (u_long)procs[i].kp_eproc.e_sess); length=strlen(session); for (j=0; j < length; j++) { if (session[1] == '1') shortsess[j]=session[j+1]; else shortsess[j]=session[j+2]; } /* fill the session leader and proc struct using kvm_read */ if (kvm_read(kd, (u_long)procs[i].kp_eproc.e_sess, (char *)&seslead, sizeof(seslead)) == sizeof(seslead)) { static struct proc leader; if (kvm_read(kd, (u_long)seslead.s_leader, (char *)&leader, sizeof(leader)) == sizeof(leader)) { sesid=leader.p_pid; } } /* retrieve the arguments */ cmndline[0] = '\0'; argv = kvm_getargv(kd, (const struct kinfo_proc *) &(procs[i]) , 0); if (argv) { int j = 0; while (argv[j] && strlen(cmndline)+strlen(argv[j])+1 <= MAXARGLN) { strcat(cmndline, argv[j]); if (argv[j+1]) { strcat(cmndline, " "); } j++; } } /* access everything else directly from the kernel, send it */ /* into bless_into_proc */ bless_into_proc( format, Fields, procs[i].kp_eproc.e_pcred.p_ruid, procs[i].kp_eproc.e_pcred.p_rgid, procs[i].kp_proc.p_pid, procs[i].kp_eproc.e_ppid, procs[i].kp_eproc.e_pgid, procs[i].kp_proc.p_priority - PZERO, shortsess, sesid, cputime, procs[i].kp_eproc.e_wmesg, procs[i].kp_proc.p_comm, state, started, ttydev, ttynum, cmndline ); } if (kd) { kvm_close(kd); } } Proc-ProcessTable-0.59/os/DecOSF.c0000644000175000017500000001057413501006311014711 0ustar jwbjwb#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "os/DecOSF.h" /* Make sure /proc is mounted */ char* OS_initialize() { struct statvfs svfs; static char* no_proc = "/proc unavailable"; if( statvfs("/proc", &svfs) == -1 ) { return no_proc; } return NULL; } /* FIXME we should get minimum info like process ID and ownership from file stat-- does this work for IOCTL-proc? Does it for FS-proc? It does on linux... */ void OS_get_table() { int maxproc, procnum, procbase; int psdata; char pathbuf[MAXPATHLEN]; /* defined in */ struct tbl_procinfo pstbl[PROCCNT]; /* defined in */ struct prpsinfo psbuf; struct prcred pscredbuf; /* variables to hold some values for bless_into_proc */ char state[20]; char pctcpu[7]; char pctmem[7]; long pr_age, now; uid_t *psgroups; int i; AV *group_array; SV *group_ref; if( (maxproc = table( TBL_PROCINFO, 0, NULL, (unsigned int) -1, 0 )) == -1 ) return; /* loop over all processes */ procbase = -1; for( procnum = 0; procnum < maxproc; procnum ++) { /* Get the table entries */ if( (procbase < 0) || (procnum >= (procbase + PROCCNT)) ) { procbase = procnum; if( table( TBL_PROCINFO, procbase, pstbl, PROCCNT, sizeof (struct tbl_procinfo)) == -1 ) continue; } /* See if the process exists */ if( pstbl[procnum % PROCCNT].pi_status == PI_EMPTY ) continue; /* Construct path of the form /proc/proc_number */ sprintf( pathbuf, "/proc/%d", pstbl[procnum % PROCCNT].pi_pid ); if( (psdata = open( pathbuf, O_RDONLY )) == -1 ) continue; if( ioctl(psdata, PIOCPSINFO, &psbuf) == -1 ) continue; if( ioctl(psdata, PIOCCRED, &pscredbuf) == -1 ) continue; if( (psgroups = malloc(pscredbuf.pr_ngroups * sizeof (u_int))) == NULL ) continue; if( ioctl(psdata, PIOCGROUPS, psgroups) == -1 ) { free(psgroups); continue; } close(psdata); /* translate process state, makros defined in */ switch( psbuf.pr_state) { case SSLEEP: strcpy(state, SLEEP); break; case SWAIT: strcpy(state, WAIT); break; case SRUN: strcpy(state, RUN); break; case SZOMB: strcpy(state, ZOMBIE); break; case SSTOP: strcpy(state, STOP); break; case SIDL: strcpy(state, IDLE); break; } now = time(NULL); pr_age = now - psbuf.pr_start.tv_sec; if (pr_age < 1) { sprintf( pctcpu, "%3.2f", (float) 0.0); /* pr_time.tv_sec is 0 */ } else { sprintf( pctcpu, "%3.2f", (float) ((psbuf.pr_time.tv_sec * 100) / pr_age)); } /* create groups array */ group_array = newAV(); for (i = 0; i < pscredbuf.pr_ngroups; i++) { av_push(group_array, newSViv(psgroups[i])); } free(psgroups); group_ref = newRV_noinc((SV *) group_array); bless_into_proc( Format, Fields, psbuf.pr_uid, /* uid, uid_t is int */ psbuf.pr_gid, /* gid, gid_t is int */ pscredbuf.pr_euid, /* euid, uid_t is int */ pscredbuf.pr_egid, /* egid, uid_t is int */ pscredbuf.pr_suid, /* suid, uid_t is int */ pscredbuf.pr_sgid, /* sgid, uid_t is int */ group_ref, /* groups, perl ref to array */ psbuf.pr_pid, /* pid, pid_t is int */ psbuf.pr_ppid, /* ppid, pid_t is int */ psbuf.pr_pgrp, /* pgrp, pid_t is int */ psbuf.pr_sid, /* sess, pid_t is int */ psbuf.pr_pri, /* priority, long, */ psbuf.pr_ttydev, /* ttynum, dev_t is int */ psbuf.pr_flag, /* flags, u_long */ psbuf.pr_time.tv_sec, /* time, long */ psbuf.pr_size * getpagesize(), /* size (bytes) */ psbuf.pr_rssize * getpagesize(), /* rss (bytes) */ psbuf.pr_start.tv_sec, /* start */ psbuf.pr_fname, /* fname */ pctcpu, /* pctcpu */ state, /* state */ psbuf.pr_psargs /* cmndline */ ); } } Proc-ProcessTable-0.59/os/FreeBSD-kvm.h0000644000175000017500000000441713501006311015657 0ustar jwbjwb#include #include #include #include #include #include #include #include #include #include #include #include /* We need to pass in a cap for ignore, lower for store on object */ /* We can just lc these! */ static char Defaultformat[] = "iiiiiiiisssssssssssssissiiiuiiiiiiiiiiVV"; /* Mapping of field to type */ static char* Fields[] = { "pid", "ppid", "uid", "euid", "gid", "pgrp", "sess", "jid", "flags", "sflags", "start", "time", "utime", "stime", "ctime", "cutime", "cstime", "pctcpu", "wchan", "state", "ttydev", "ttynum", "fname", "cmndline", "priority", "nice", "vmsize", "size", "rssize", "rss", "tsize", "dsize", "ssize", "majflt", "minflt", "cmajflt", "cminflt", "numthr", "onpro", "groups" }; /* pid_t ki_pid; // Process identifier pid_t ki_ppid; // parent process id pid_t ki_pgid; // process group id udev_t ki_tdev; // controlling tty dev pid_t ki_sid; // Process session ID uid_t ki_uid; // effective user id uid_t ki_ruid; // Real user id gid_t ki_rgid; // Real group id vm_size_t ki_size; // virtual size segsz_t ki_rssize; // current resident set size in pages segsz_t ki_tsize; // text size (pages) XXX segsz_t ki_dsize; // data size (pages) XXX segsz_t ki_ssize; // stack size (pages) u_int64_t ki_runtime; // Real time in microsec struct timeval ki_start; // starting time long ki_sflag; // PS_* flags long ki_flag; // P_* flags char ki_stat; // S* process status char ki_wmesg[WMESGLEN+1]; // wchan message char ki_comm[COMMLEN+1]; // command name char ki_nice; // Process "nice" value struct priority ki_pri; // process priority */ Proc-ProcessTable-0.59/os/Solaris.c0000644000175000017500000001113513501006311015254 0ustar jwbjwb #include "os/Solaris.h" /* Make sure /proc is mounted */ char* OS_initialize(){ struct statvfs svfs; static char* no_proc = "/proc unavailable"; if( statvfs("/proc", &svfs) == -1 ){ return no_proc; } return NULL; } /* FIXME we should get minimum info like process ID and ownership from file stat-- does this work for IOCTL-proc? Does it for FS-proc? It does on linux... */ #include void OS_get_table(){ DIR *procdir; char p[sizeof(struct dirent) + 1024] ; struct dirent *procdirp = (struct dirent *)p; int psdata; char pathbuf[MAXPATHLEN]; DIR *procdirlwp; struct dirent *procdirlwpp; char pathbuflwp[MAXPATHLEN]; #if defined(PROC_FS) struct psinfo psbuf; #else struct prpsinfo psbuf; #endif /* variables to hold some values for bless_into_proc */ char state[20]; char pctcpu[7]; int numthr; char pctmem[7]; /* MR: quick hack for different readdir_r versions */ #if defined(_POSIX_PTHREAD_SEMANTICS) struct dirent *procdirp_r; #endif if( (procdir = opendir( "/proc" )) == NULL ) return; #if defined(_POSIX_PTHREAD_SEMANTICS) while( readdir_r(procdir, procdirp, &procdirp_r ) == 0 && procdirp_r != NULL ){ #else /* complile problems on solaris: this function gets picked wrongly */ while( readdir_r(procdir, procdirp ) != NULL ){ #endif /* Only look at this file if it's a proc id; that is, all numbers */ if( strtok(procdirp->d_name, "0123456789") != NULL ){ continue; } /* Construct path of the form /proc/proc_number */ strcpy( pathbuf, "/proc/"); strcat( pathbuf, procdirp->d_name ); strcpy( pathbuflwp, pathbuf); strcat( pathbuflwp, "/lwp/"); if( (procdirlwp = opendir( pathbuflwp )) != NULL ){ numthr = 0; while( (procdirlwpp = readdir(procdirlwp)) != NULL ){ numthr++; } closedir(procdirlwp); } numthr = numthr - 2; #if defined(PROC_FS) strcat( pathbuf, "/psinfo" ); /* Solaris 2.6 has process info here */ #endif if( (psdata = open( pathbuf, O_RDONLY )) == -1 ) continue; #if defined(PROC_FS) read(psdata, (void *) &psbuf, sizeof(struct psinfo) ); #else if( ioctl(psdata, PIOCPSINFO, &psbuf) == -1 ) continue; #endif close(psdata); /* translate process state */ #if defined(PROC_FS) switch( psbuf.pr_lwp.pr_state ) #else switch( psbuf.pr_state) #endif { case SSLEEP: strcpy(state, SLEEP); break; case SRUN: strcpy(state, RUN); break; case SZOMB: strcpy(state, ZOMBIE); break; case SSTOP: strcpy(state, STOP); break; case SIDL: strcpy(state, IDLE); break; case SONPROC: strcpy(state, ONPROC); break; } /* These seem to be 2 bytes, 1st byte int part, 2nd byte fractional */ /* Perl can handle stringy numbers of the form 1.5 */ sprintf( pctcpu, "%5.2f%", ((double)psbuf.pr_pctcpu)/0x8000*100 ); sprintf( pctmem, "%5.2f%", ((double)psbuf.pr_pctmem)/0x8000*100 ); bless_into_proc( Format, Fields, psbuf.pr_uid, /* uid */ psbuf.pr_gid, /* gid */ psbuf.pr_euid, /* euid */ psbuf.pr_egid, /* egid */ psbuf.pr_pid, /* pid */ psbuf.pr_ppid, /* ppid */ #if defined(PROC_FS) psbuf.pr_pgid, /* pgrp */ #else psbuf.pr_pgrp, /* pgrp */ #endif psbuf.pr_sid, /* sess */ #if defined(PROC_FS) psbuf.pr_lwp.pr_pri, /* priority */ psbuf.pr_lwp.pr_nice, /* nice */ #else psbuf.pr_pri, /* priority */ psbuf.pr_nice, /* nice */ #endif psbuf.pr_ttydev, /* ttynum */ psbuf.pr_flag, /* flags */ psbuf.pr_time.tv_sec, /* time */ psbuf.pr_ctime.tv_sec, /* ctime */ #if defined(PROC_FS) psbuf.pr_time.tv_nsec, /* time nanosec */ psbuf.pr_ctime.tv_nsec, /* ctime nanosec */ psbuf.pr_size * 1024, /* size (bytes) */ psbuf.pr_rssize * 1024, /* rss (bytes) */ psbuf.pr_lwp.pr_wchan, /* wchan */ #else psbuf.pr_bysize, /* size (bytes) */ psbuf.pr_byrssize, /* rss (bytes) */ psbuf.pr_wchan, /* wchan */ #endif psbuf.pr_fname, /* fname */ psbuf.pr_start.tv_sec, /* start */ pctcpu, /* pctcpu */ state, /* state */ #if defined(PROC_FS) psbuf.pr_lwp.pr_onpro, /* on which processor */ #endif pctmem, /* pctmem */ psbuf.pr_psargs, /* cmndline */ numthr /* numthr */ ); } closedir(procdir); } Proc-ProcessTable-0.59/os/NetBSD.h0000644000175000017500000000266413501006311014733 0ustar jwbjwb#include #include #if defined(__NetBSD__) && __NetBSD_Version__ > 299000900 #include #define statfs statvfs #else #include #endif #include #include #include #include #include #include struct procstat { char comm[MAXCOMLEN+1]; int pid; int ppid; int pgid; int sid; int tdev_maj; int tdev_min; char flags[256]; /* XXX */ int start; int start_mic; int utime; int utime_mic; int stime; int stime_mic; char wchan[256]; /* XXX */ int euid; int ruid; int rgid; int egid; char groups[256]; /* XXX */ }; /* We need to pass in a cap for ignore, lower for store on object */ /* We can just lc these! */ static char Defaultformat[] = "iiiiiissssssiisssis"; /* Mapping of field to type */ static char* Fields[] = { "uid", #define F_UID 0 "gid", #define F_GID 1 "pid", #define F_PID 2 "ppid", #define F_PPID 3 "pgrp", #define F_PGRP 4 "sess", #define F_SESS 5 "flags", #define F_FLAGS 6 "utime", #define F_UTIME 7 "stime", #define F_STIME 8 "time", #define F_TIME 9 "wchan", #define F_WCHAN 10 "start", #define F_START 11 "euid", #define F_EUID 12 "egid", #define F_EGID 13 "fname", #define F_FNAME 14 "state", #define F_STATE 15 "ttydev", #define F_TTYDEV 16 "ttynum", #define F_TTYNUM 17 "cmndline" #define F_CMNDLINE 18 #define F_LASTFIELD 18 }; Proc-ProcessTable-0.59/os/MSWin32.h0000644000175000017500000000034613501006311015011 0ustar jwbjwbstatic char *Fields[] = { "uid", "pid", "ppid", #ifdef USE_CYGWIN "pgid", "winpid", #endif "fname", "start", #ifdef USE_CYGWIN "ttynum", "state", #endif #ifndef USE_CYGWIN "sid", "user_name", "domain_name", #endif }; Proc-ProcessTable-0.59/os/bsdi.h0000644000175000017500000000642113501006311014570 0ustar jwbjwb#include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include /* Grab the maximum argument length */ #include #define MAXARGLN ARG_MAX /**********************************************************/ /* Copyright (c) 1999, Magic Software Development, Inc. */ /* Author: Sean Ray Eskins. */ /* This file is free software; it can be modified and/or */ /* redistributed under the same terms as Perl itself. */ /**********************************************************/ /**********************************/ /* Process state names we return */ /**********************************/ #define SLEEP "SLEEP" #define RUN "RUN" #define IDLE "IDLE" #define STOP "STOP" #define ZOMBIE "ZOMBIE" #define UNKNOWN "UNKNOWN" /* We are using kinfo_proc structure and kvm_getprocs to access */ /* processes from the kernel, so we don't need the procstat structure */ /* present in perl modules for other operating systems (ie: we */ /* are not accessing the processes from a proc directory) */ /* All processes are accessed straight from the kernel, so we don't */ /* need to mess around with the format much. */ /*******************************************************/ /* Some scripts needed to round off to top two digits */ /* of "miliseconds", so that only the first two digits */ /* are printed to the m:ss.[miliseconds] time field of */ /* Fields[] below. */ /*******************************************************/ /* power(int base, int pow) -- takes integer base to power pow. . . */ /* for use with roundit(int integer). */ int power(int base, int pow) { int count, result; count=1; result=1; while (count <= pow) { result=base*result; count++; } return(result); } /* roundit(int) -- rounds a 4-, 5-, or 6-digit number to its highest */ /* two places. */ int roundit(int integer) { char string[10]; int length; int newnum; int cutoff; int pow10; sprintf(string, "%d", integer); length=strlen(string); cutoff=length - 2; pow10=power(10, cutoff); newnum=integer/pow10; return(newnum); } /* We need to pass in a cap for ignore, lower for store on object */ /* We can just lc these! */ static char Defaultformat[] = "iiiiiisissssssls"; /* Mapping of field to type */ static char* Fields[] = { "uid", /* ruid from kernel */ #define F_UID 0 "gid", /* rgid from kernel */ #define F_GID 1 "pid", #define F_PID 2 "ppid", #define F_PPID 3 "pgrp", #define F_PGRP 4 "priority", #define F_PRIORITY 5 "sess", #define F_SESSION 6 "leader", #define F_LEADER 7 "time", #define F_TIME 8 "wchan", #define F_WCHAN 9 "fname", /* command name (without args) */ #define F_NAME 10 "state", #define F_STATE 11 "started", #define F_STARTED 12 "ttydev", #define F_TTYDEV 13 "ttynum", #define F_TTYNUM 14 "cmndline" #define F_CMNDLINE 15 #define F_LASTFIELD 15 }; Proc-ProcessTable-0.59/os/aix_getprocs.h0000644000175000017500000000556513501006311016346 0ustar jwbjwb/* * Copyright (c) 2002, Target Corporation. All Rights Reserved. * This file is free software; you can redistribute it and/or modify * it under the same terms as Perl itself. * * Author: James FitzGibbon * * based on aix.h distributed with Proc::ProcessTable v0.35, which * is Copyright (c) 1998, David Paquet. * */ /* Descriptive Process States */ #define SLEEP "sleep" #define WAIT "wait" #define RUN "run" #define IDLE "idle" #define ZOMBIE "defunct" #define STOP "stop" #define UWAIT "uwait" #define ACTIVE "active" /* How many processes to grab at a time * * internally, this module will need * sizeof(struct procsinfo64) * PROCS_TO_FETCH * memory while in ->table(), so you can change this constant * if you are tight for memory * */ #define PROCS_TO_FETCH 1000 /* Length of the various string fields */ #define PCT_LENGTH 7 #define STATE_LENGTH 10 /* Format string */ static char Defaultformat[] = "iiiiiiiiiiiiisiiijjlllljjjiiijjjssss"; /* Mapping of field to position in format string */ static char* Fields[] = { "pid", /* int */ #define F_PID 0 "ppid", /* int */ #define F_PPID 1 "sess", /* int */ #define F_SESS 2 "pgrp", /* int */ #define F_PGRP 3 "uid", /* int */ #define F_UID 4 "suid", /* int */ #define F_SUID 5 "luid", /* int */ #define F_LUID 6 "euid", /* int */ #define F_EUID 7 "gid", /* int */ #define F_GID 8 "egid", /* int */ #define F_EGID 9 "priority", /* int */ #define F_PRIORITY 10 "nice", /* int */ #define F_NICE 11 "thcount", /* int */ #define F_THCOUNT 12 "stat", /* int -> string */ #define F_STAT 13 "flags", /* int */ #define F_FLAGS 14 "flags2", /* int */ #define F_FLAGS2 15 "adspace", /* long */ #define F_ADSPACE 16 "majflt", /* long */ #define F_MAJFLT 17 "minflt", /* long */ #define F_MINFLT 18 "utime", /* long */ #define F_UTIME 19 "stime", /* long */ #define F_STIME 20 "cutime", /* long */ #define F_CUTIME 21 "cstime", /* long */ #define F_CSTIME 22 "start", /* long */ #define F_START 23 "size", /* long */ #define F_SIZE 24 "tsize", /* long */ #define F_TSIZE 25 "ttyp", /* int */ #define F_TTYP 26 "ttynum", /* int */ #define F_TTYNUM 27 "ttympx", /* int */ #define F_TTYMPX 28 "drss", /* long */ #define F_DRSS 29 "trss", /* long */ #define F_TRSS 30 "dvm", /* long */ #define F_DVM 31 "pctmem", /* float -> string */ #define F_PCTMEM 32 "pctcpu", /* float -> string */ #define F_PCTCPU 33 "comm", /* string */ #define F_COMM 34 "cmndline", /* string */ #define F_CMNDLINE 35 #define F_LASTFIELD 35 }; /* * EOF */ Proc-ProcessTable-0.59/os/FreeBSD-kvm.c0000644000175000017500000001465513501006311015657 0ustar jwbjwb/* perl's struct cv conflicts with the definition in sys/condvar.h (included by sys/proc.h) */ #define cv perl_cv #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #undef cv #include "os/FreeBSD-kvm.h" #include #include #include #include #include #include #include #include /* Make sure /proc is mounted and initialize some global vars */ char* OS_initialize(){ return NULL; } void OS_get_table(){ kvm_t *kd; char errbuf[2048]; struct kinfo_proc *procs; /* array of processes */ int count; /* returns number of processes */ int i, j; char ** argv; char state[20]; char start[20]; char time[20]; char utime[20]; char stime[20]; char ctime[20]; char cutime[20]; char cstime[20]; char flag[20]; char sflag[20]; char pctcpu[20]; static char format[128]; char cmndline[ARG_MAX]; int priority; int pagesize; AV *group_array; SV *group_ref; SV *oncpu; /* Open the kvm interface, get a descriptor */ if ((kd = kvm_openfiles(_PATH_DEVNULL, _PATH_DEVNULL, NULL, O_RDONLY, errbuf)) == NULL) { /*fprintf(stderr, "kvm_open: %s\n", errbuf);*/ ppt_croak("kvm_open: ", errbuf); } /* Get the list of processes. */ if ((procs = kvm_getprocs(kd, KERN_PROC_PROC, 0, &count)) == NULL) { kvm_close(kd); /*fprintf(stderr, "kvm_getprocs: %s\n", kvm_geterr(kd));*/ ppt_croak("kvm_getprocs: ", kvm_geterr(kd)); } pagesize = getpagesize(); /* Iterate through the processes in kinfo_proc, sending proc info */ /* to bless_into_proc for each proc */ for (i=0; i < count; i++) { static struct pstats ps; static struct session seslead; strcpy(format, Defaultformat); // retrieve the arguments cmndline[0] = '\0'; argv = kvm_getargv(kd, (const struct kinfo_proc *) &(procs[i]) , 0); if (argv) { int j = 0; while (argv[j] && strlen(cmndline)+strlen(argv[j])+1 <= ARG_MAX) { strcat(cmndline, argv[j]); if (argv[j+1]) { strcat(cmndline, " "); } j++; } } switch (procs[i].ki_stat) { case SSTOP: strcpy(state, "stop"); break; case SSLEEP: strcpy(state, "sleep"); break; case SRUN: strcpy(state, "run"); break; case SIDL: strcpy(state, "idle"); break; case SWAIT: strcpy(state, "wait"); break; case SLOCK: strcpy(state, "lock"); break; case SZOMB: strcpy(state, "zombie"); break; default: strcpy(state, "???"); break; } sprintf(start, "%d.%06d", procs[i].ki_start.tv_sec, procs[i].ki_start.tv_usec); sprintf(time, "%.6f", procs[i].ki_runtime/1000000.0); sprintf(utime, "%d.%06d", procs[i].ki_rusage.ru_utime.tv_sec, procs[i].ki_rusage.ru_utime.tv_usec); sprintf(stime, "%d.%06d", procs[i].ki_rusage.ru_stime.tv_sec, procs[i].ki_rusage.ru_stime.tv_usec); sprintf(ctime, "%d.%06d", procs[i].ki_childtime.tv_sec, procs[i].ki_childtime.tv_usec); sprintf(cutime, "%d.%06d", procs[i].ki_rusage_ch.ru_utime.tv_sec, procs[i].ki_rusage_ch.ru_utime.tv_usec); sprintf(cstime, "%d.%06d", procs[i].ki_rusage_ch.ru_stime.tv_sec, procs[i].ki_rusage_ch.ru_stime.tv_usec); sprintf(flag, "0x%04x", procs[i].ki_flag); sprintf(sflag, "0x%04x", procs[i].ki_sflag); /* create groups array */ group_array = newAV(); for (j = 0; j < procs[i].ki_ngroups; j++) { av_push(group_array, newSViv(procs[i].ki_groups[j])); } group_ref = newRV_noinc((SV *) group_array); oncpu = procs[i].ki_oncpu == 0xff ? &PL_sv_undef : newSViv(procs[i].ki_oncpu); /* get the current CPU percent usage for this process */ /* copied from FreeBSD sources bin/ps/ps.c and friends */ #define fxtofl(fixpt) ((double)(fixpt) / fscale) int fscale; size_t oldlen; fixpt_t ccpu; oldlen = sizeof(ccpu); if (sysctlbyname("kern.ccpu", &ccpu, &oldlen, NULL, 0) == -1) ppt_croak("cannot get kern.ccpu"); if (sysctlbyname("kern.fscale", &fscale, &oldlen, NULL, 0) == -1) ppt_croak("cannot get kern.fscale"); double pcpu; if (procs[i].ki_swtime == 0 || (procs[i].ki_flag & P_INMEM) == 0) pcpu = 0.0; else pcpu = (100.0 * fxtofl(procs[i].ki_pctcpu) / (1.0 - exp(procs[i].ki_swtime * log(fxtofl(ccpu))))); sprintf(pctcpu,"%.1f",pcpu); bless_into_proc( format, Fields, procs[i].ki_pid, procs[i].ki_ppid, procs[i].ki_ruid, procs[i].ki_uid, procs[i].ki_rgid, procs[i].ki_pgid, procs[i].ki_sid, procs[i].ki_jid, flag, sflag, start, time, utime, stime, ctime, cutime, cstime, pctcpu, procs[i].ki_wmesg, state, "??", // will be resolved automatically procs[i].ki_tdev, procs[i].ki_comm, cmndline, procs[i].ki_pri.pri_user, procs[i].ki_nice, procs[i].ki_size, // virtual size procs[i].ki_size, // alias procs[i].ki_rssize, // current resident set size in pages procs[i].ki_rssize*pagesize, // rss in bytes procs[i].ki_tsize, // text size (pages) XXX procs[i].ki_dsize, // data size (pages) XXX procs[i].ki_ssize, // stack size (pages) procs[i].ki_rusage.ru_majflt, procs[i].ki_rusage.ru_minflt, procs[i].ki_rusage_ch.ru_majflt, // XXX - most fields in ki_rusage_ch are not (yet) filled in procs[i].ki_rusage_ch.ru_minflt, // XXX - most fields in ki_rusage_ch are not (yet) filled in procs[i].ki_numthreads, oncpu, group_ref ); } if (kd) kvm_close(kd); } Proc-ProcessTable-0.59/os/Linux.c0000644000175000017500000005545013501006311014747 0ustar jwbjwb#ifndef _GNU_SOURCE #define _GNU_SOURCE /* for canonicalize_file_name */ #endif #include /* is_digit */ #include /* opendir, readdir_r */ #include #include /* BOOL */ #include /* *scanf family */ #include /* malloc family */ #include /* strchr */ #include /* time_t */ #include #include #include #include /* statfs */ /* glibc only goodness */ #include /* glibc's handy obstacks */ /* ptheads */ #include /* pthead_once */ #define obstack_chunk_alloc malloc #define obstack_chunk_free free #include "os/Linux.h" /* NOTE: Before this was actually milliseconds even though it said microseconds, now it is correct. */ #define JIFFIES_TO_MICROSECONDS(x) (((x)*1e6)/system_hertz) /* some static values that won't change, */ static pthread_once_t globals_init = PTHREAD_ONCE_INIT; static long long boot_time; static unsigned page_size; static unsigned long long system_memory; static unsigned system_hertz; static bool init_failed = false; /* get_string() * * Access strings in read only section * * @param elem String we want to retrive (look at enum strings) * @return Address of string */ inline static const char *get_string(int elem) { return strings + strings_index[elem]; } /* init_static_vars() * * Called by pthead_once to initlize global variables (system settings that don't change) */ static void init_static_vars() { struct obstack mem_pool; char *file_text, *file_off; off_t file_len; unsigned long long total_memory; boot_time = -1; system_memory = -1; page_size = getpagesize(); /* initilize our mem stack, tempoary memory */ obstack_init(&mem_pool); /* find hertz size, I'm hoping this is gotten from elf note AT_CLKTCK */ system_hertz = sysconf(_SC_CLK_TCK); /* find boot time */ /* read /proc/stat in */ if ((file_text = read_file("stat", NULL, &file_len, &mem_pool)) == NULL) goto fail; /* look for the line that starts with btime * NOTE: incrementing file_off after strchr is legal because file_text will * be null terminated, so worst case after '\n' there will be '\0' and * strncmp will fail or sscanf won't return 1 * Only increment on the first line */ for (file_off = file_text; file_off; file_off = strchr(file_off, '\n')) { if (file_off != file_text) file_off++; if (strncmp(file_off, "btime", 5) == 0) { if (sscanf(file_off, "btime %lld", &boot_time) == 1) break; } } obstack_free(&mem_pool, file_text); /* did we scrape the number of pages successfuly? */ if (boot_time == -1) goto fail; /* find total number of system pages */ /* read /proc/meminfo */ if ((file_text = read_file("meminfo", NULL, &file_len, &mem_pool)) == NULL) goto fail; /* look for the line that starts with: MemTotal */ for (file_off = file_text; file_off; file_off = strchr(file_off, '\n')) { if (file_off != file_text) file_off++; if (strncmp(file_off, "MemTotal:", 9) == 0) { if (sscanf(file_off, "MemTotal: %llu", &system_memory) == 1) { system_memory *= 1024; /* convert to bytes */ break; } } } obstack_free(&mem_pool, file_text); /* did we scrape the number of pages successfuly? */ if (total_memory == -1) goto fail; /* intilize system hertz value */ /* cleanup */ obstack_free(&mem_pool, NULL); return; /* mark failure and cleanup allocated resources */ fail: obstack_free(&mem_pool, NULL); init_failed = true; } /* OS_initlize() * * Called by XS parts whenever Proc::ProcessTable::new is called * * NOTE: There's a const char* -> char* conversion that's evil, but can't fix * this without breaking the Proc::ProcessTable XS API. */ char* OS_initialize() { struct statfs sfs; /* did we already try to initilize before and fail, if pthrad_once only * let us flag a failure from the init function; behavor of longjmp is * undefined, so that avaue is out out of the question */ if (init_failed) return (char *) get_string(STR_ERR_INIT); /* check if /proc is mounted, let this go before initlizing globals (below), * since the missing /proc message might me helpful */ if(statfs("/proc", &sfs) == -1) return (char *) get_string(STR_ERR_PROC_STATFS); /* one time initlization of some values that won't change */ pthread_once(&globals_init, init_static_vars); return NULL; } inline static void field_enable(char *format_str, enum field field) { format_str[field] = tolower(format_str[field]); } inline static void field_enable_range(char *format_str, enum field field1, enum field field2) { int i; for (i = field1; i <= field2; i++) format_str[i] = tolower(format_str[i]); } /* proc_pid_file() * * Build a path to the pid directory in proc '/proc/${pid}' with an optional * relative path at the end. Put the resultant path on top of the obstack. * * @return Address of the create path string. */ inline static char *proc_pid_file(const char *pid, const char *file, struct obstack *mem_pool) { /* path to dir */ obstack_printf(mem_pool, "/proc/%s", pid); /* additional path (not just the dir) */ if (file) obstack_printf(mem_pool, "/%s", file); obstack_1grow(mem_pool, '\0'); return (char *) obstack_finish(mem_pool); } /* read_file() * * Reads the contents of a file using an obstack for memory. It can read files like * /proc/stat or /proc/${pid}/stat. * * @param path String representing the part following /proc (usualy this is * the process pid number) * @param etxra_path Path to the file to read in (relative to /proc/${path}/) * @param len Pointer to the value where the length will be saved * * @return Pointer to a null terminate string allocated on the obstack, or * NULL when it fails (doesn't clean up the obstack). */ static char *read_file(const char *path, const char *extra_path, off_t *len, struct obstack *mem_pool) { int fd, result = -1; char *text, *file, *start; /* build the filename in our tempoary storage */ file = proc_pid_file(path, extra_path, mem_pool); fd = open(file, O_RDONLY); /* free tmp memory we allocated for the file contents, this way we are not * poluting the obstack and the only thing left on it is the file */ obstack_free(mem_pool, file); if (fd == -1) return NULL; /* read file into our buffer */ for (*len = 0; result; *len += result) { obstack_blank(mem_pool, 1024); start = obstack_base(mem_pool) + *len; if ((result = read(fd, start, 1024)) == -1) { obstack_free(mem_pool, obstack_finish(mem_pool)); close(fd); return NULL; } } start = obstack_base(mem_pool) + *len; *start = '\0'; /* finalize our text buffer */ text = obstack_finish(mem_pool); /* not bothering checking return value, because it's possible that the * process went away */ close(fd); return text; } /* get_user_info() * * Find the user/group id of the process * * @param pid String representing the pid * @param prs Data structure where to put the scraped values * @param mem_pool Obstack to use for temory storage */ static void get_user_info(char *pid, char *format_str, struct procstat* prs, struct obstack *mem_pool) { char *path_pid; struct stat stat_pid; int result; /* (temp) /proc/${pid} */ path_pid = proc_pid_file(pid, NULL, mem_pool); result = stat(path_pid, &stat_pid); obstack_free(mem_pool, path_pid); if (result == -1) return; prs->uid = stat_pid.st_uid; prs->gid = stat_pid.st_gid; field_enable(format_str, F_UID); field_enable(format_str, F_GID); } /* get_proc_stat() * * Reads a processes stat file in the proc filesystem '/proc/${pid}/stat' and * fills the procstat structure with the values. * * @param pid String representing the pid * @param prs Data structure where to put the scraped values * @param mem_pool Obstack to use for temory storage */ static bool get_proc_stat(char *pid, char *format_str, struct procstat* prs, struct obstack *mem_pool) { char *stat_text, *stat_cont, *paren; int result; off_t stat_len; long dummy_l; int dummy_i; bool read_ok = true; if ((stat_text = read_file(pid, "stat", &stat_len, mem_pool)) == NULL) return false; /* replace the first ')' with a '\0', the contents look like this: * pid (program_name) state ... * if we don't find ')' then it's incorrectly formated */ if ((paren = strrchr(stat_text, ')')) == NULL) { read_ok = false; goto done; } *paren = '\0'; /* scan in pid, and the command, in linux the command is a max of 15 chars * plus a terminating NULL byte; prs->comm will be NULL terminated since * that area of memory is all zerored out when prs is allocated */ if (sscanf(stat_text, "%d (%15c", &prs->pid, prs->comm) != 2) /* we might get an empty command name, so check for it: * do the open and close parenteses lie next to each other? * proceed if yes, finish otherwise */ if((strchr(stat_text,'(') + 1) != paren) goto done; /* address at which we pickup again, after the ')' * NOTE: we don't bother checking bounds since strchr didn't return NULL * thus the NULL terminator will be at least paren+1, which is ok */ stat_cont = paren + 1; /* scape the remaining values */ result = sscanf(stat_cont, " %c %d %d %d %d %d %u %lu %lu %lu %lu %llu" " %llu %llu %lld %ld %ld %ld %d %llu %lu %ld %ld %lu %lu %lu %lu %lu" " %lu %lu %lu %lu %lu", &prs->state_c, // %c &prs->ppid, &prs->pgrp, // %d %d &prs->sid, // %d &prs->tty, &dummy_i, /* tty, tty_pgid */ &prs->flags, // %u &prs->minflt, &prs->cminflt, &prs->majflt, &prs->cmajflt, // %lu %lu %lu %lu &prs->utime, &prs->stime, &prs->cutime, &prs->cstime, &prs->priority, &dummy_l, /* nice */ &dummy_l, /* num threads */ &dummy_i, /* timeout obsolete */ &prs->start_time, &prs->vsize, &prs->rss, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &dummy_l, &prs->wchan); /* 33 items in scanf's list... It's all or nothing baby */ if (result != 33) { read_ok = false; goto done; } /* enable fields; F_STATE is not the range */ field_enable_range(format_str, F_PID, F_WCHAN); done: obstack_free(mem_pool, stat_text); return read_ok; } static void eval_link(char *pid, char *link_rel, enum field field, char **ptr, char *format_str, struct obstack *mem_pool) { char *link_file, *link; /* path to the link file like. /proc/{pid}/{link_rel} */ link_file = proc_pid_file(pid, link_rel, mem_pool); /* It's okay to use canonicalize_file_name instead of readlink on linux * for the cwd symlink, since on linux the links we care about will never * be relative links (cwd, exec) * Doing this because readlink works on static buffers */ link = canonicalize_file_name(link_file); /* we no longer need need the path to the link file */ obstack_free(mem_pool, link_file); if (link == NULL) return; /* copy the path onto our obstack, set the value (somewhere in pts) * and free the results of canonicalize_file_name */ obstack_printf(mem_pool, "%s", link); obstack_1grow(mem_pool, '\0'); *ptr = (char *) obstack_finish(mem_pool); free(link); /* enable whatever field we successfuly retrived */ field_enable(format_str, field); } static void get_proc_cmndline(char *pid, char *format_str, struct procstat* prs, struct obstack *mem_pool) { char *cmndline_text, *cur; off_t cmndline_off; if ((cmndline_text = read_file(pid, "cmdline", &cmndline_off, mem_pool)) == NULL) return; /* replace all '\0' with spaces (except for the last one */ for (cur = cmndline_text; cur < cmndline_text + cmndline_off - 1; cur++) { if (*cur == '\0') *cur = ' '; } prs->cmndline = cmndline_text; field_enable(format_str, F_CMNDLINE); } static void get_proc_cmdline(char *pid, char *format_str, struct procstat* prs, struct obstack *mem_pool) { char *cmdline_text, *cur; off_t cmdline_off; if ((cmdline_text = read_file(pid, "cmdline", &cmdline_off, mem_pool)) == NULL) return; prs->cmdline = cmdline_text; prs->cmdline_len = cmdline_off; field_enable(format_str, F_CMDLINE); } static void get_proc_environ(char *pid, char *format_str, struct procstat* prs, struct obstack *mem_pool) { char *environ_text, *cur; off_t environ_off; if ((environ_text = read_file(pid, "environ", &environ_off, mem_pool)) == NULL) return; prs->environ = environ_text; prs->environ_len = environ_off; field_enable(format_str, F_ENVIRON); } static void get_proc_status(char *pid, char *format_str, struct procstat* prs, struct obstack *mem_pool) { char *status_text, *loc; off_t status_len; int dummy_i; if ((status_text = read_file(pid, "status", &status_len, mem_pool)) == NULL) return; loc = status_text; /* * get the euid, egid and so on out of /proc/$$/status * where the 2 lines in which we are interested in are: * [5] Uid: 500 500 500 500 * [6] Gid: 500 500 500 500 * added by scip */ for(loc = status_text; loc; loc = strchr(loc, '\n')) { /* skip past the \n character */ if (loc != status_text) loc++; if (strncmp(loc, "Uid:", 4) == 0) { sscanf(loc + 4, " %d %d %d %d", &dummy_i, &prs->euid, &prs->suid, &prs->fuid); field_enable_range(format_str, F_EUID, F_FUID); } else if (strncmp(loc, "Gid:", 4) == 0) { sscanf(loc + 4, " %d %d %d %d", &dummy_i, &prs->egid, &prs->sgid, &prs->fgid); field_enable_range(format_str, F_EGID, F_FGID); } else if (strncmp(loc, "TracerPid:", 10) == 0) { sscanf(loc + 10, " %d", &prs->tracer); field_enable(format_str, F_TRACER); } /* short circuit condition */ if (islower(format_str[F_EUID]) && islower(format_str[F_EGID]) && islower(format_str[F_TRACER])) goto done; } done: obstack_free(mem_pool, status_text); } /* fixup_stat_values() * * Correct, calculate, covert values to user expected values. * * @param format_str String containing field index types * @param prs Data structure to peform fixups on */ static void fixup_stat_values(char *format_str, struct procstat* prs) { /* set the state pointer to the right (const) string */ switch (prs->state_c) { case 'S': prs->state = get_string(SLEEP); break; case 'W': prs->state = get_string(WAIT); /*Waking state. Could be mapped to WAKING, but would break backward compatibility */ break; case 'R': prs->state = get_string(RUN); break; case 'I': prs->state = get_string(IDLE); break; case 'Z': prs->state = get_string(DEFUNCT); break; case 'D': prs->state = get_string(UWAIT); break; case 'T': prs->state = get_string(STOP); break; case 'x': prs->state = get_string(DEAD); break; case 'X': prs->state = get_string(DEAD); break; case 'K': prs->state = get_string(WAKEKILL); break; case 't': prs->state = get_string(TRACINGSTOP); break; case 'P': prs->state = get_string(PARKED); break; /* unknown state, state is already set to NULL */ default: ppt_warn("Ran into unknown state (hex char: %x)", (int) prs->state_c); goto skip_state_format; } field_enable(format_str, F_STATE); skip_state_format: prs->start_time = (prs->start_time / system_hertz) + boot_time; /* fix time */ prs->stime = JIFFIES_TO_MICROSECONDS(prs->stime); prs->utime = JIFFIES_TO_MICROSECONDS(prs->utime); prs->cstime = JIFFIES_TO_MICROSECONDS(prs->cstime); prs->cutime = JIFFIES_TO_MICROSECONDS(prs->cutime); /* derived time values */ prs->time = prs->utime + prs->stime; prs->ctime = prs->cutime + prs->cstime; field_enable_range(format_str, F_TIME, F_CTIME); /* fix rss to be in bytes (returned from kernel in pages) */ prs->rss *= page_size; } /* calc_prec() * * calculate the two cpu/memory precentage values */ static void calc_prec(char *format_str, struct procstat *prs, struct obstack *mem_pool) { int len; /* calculate pctcpu - NOTE: This assumes the cpu time is in microsecond units! multiplying by 1/1e6 puts all units back in seconds. Then multiply by 100.0f to get a percentage. */ float pctcpu = ( 100.0f * (prs->utime + prs->stime ) * 1/1e6 ) / (time(NULL) - prs->start_time); len = snprintf(prs->pctcpu, LENGTH_PCTCPU, "%6.2f", pctcpu); if( len >= LENGTH_PCTCPU ) { ppt_warn("percent cpu truncated from %d, set LENGTH_PCTCPU to at least: %d)", len, len + 1); } field_enable(format_str, F_PCTCPU); /* calculate pctmem */ if (system_memory > 0) { sprintf(prs->pctmem, "%3.2f", (float) prs->rss / system_memory * 100.f); field_enable(format_str, F_PCTMEM); } } /* is_pid() * * * @return Boolean value. */ inline static bool is_pid(const char* str) { for(; *str; str++) { if (!isdigit(*str)) return false; } return true; } inline static bool pid_exists(const char *str, struct obstack *mem_pool) { char *pid_dir_path = NULL; int result; obstack_printf(mem_pool, "/proc/%s", str); obstack_1grow(mem_pool, '\0'); pid_dir_path = obstack_finish(mem_pool); /* directory exists? */ result = (access(pid_dir_path, F_OK) != -1); obstack_free(mem_pool, pid_dir_path); return result; } void OS_get_table() { /* dir walker storage */ DIR *dir; struct dirent *dir_ent, *dir_result; /* all our storage is going to be here */ struct obstack mem_pool; /* container for scaped process values */ struct procstat *prs; /* string containing our local copy of format_str, elements will be * lower cased if we are able to figure them out */ char *format_str; /* initlize a small memory pool for this function */ obstack_init(&mem_pool); /* put the dirent on the obstack, since it's rather large */ dir_ent = obstack_alloc(&mem_pool, sizeof(struct dirent)); if ((dir = opendir("/proc")) == NULL) return; /* Iterate through all the process entries (numeric) under /proc */ while(readdir_r(dir, dir_ent, &dir_result) == 0 && dir_result) { /* Only look at this file if it's a proc id; that is, all numbers */ if(!is_pid(dir_result->d_name)) continue; /* allocate container for storing process values */ prs = obstack_alloc(&mem_pool, sizeof(struct procstat)); bzero(prs, sizeof(struct procstat)); /* intilize the format string */ obstack_printf(&mem_pool, "%s", get_string(STR_DEFAULT_FORMAT)); obstack_1grow(&mem_pool, '\0'); format_str = (char *) obstack_finish(&mem_pool); /* get process' uid/guid */ get_user_info(dir_result->d_name, format_str, prs, &mem_pool); /* scrape /proc/${pid}/stat */ if (get_proc_stat(dir_result->d_name, format_str, prs, &mem_pool) == false) { /* did the pid directory go away mid flight? */ if (pid_exists(dir_result->d_name, &mem_pool) == false) continue; } /* correct values (times) found in /proc/${pid}/stat */ fixup_stat_values(format_str, prs); /* get process' cmndline */ get_proc_cmndline(dir_result->d_name, format_str, prs, &mem_pool); /* get process' cmdline */ get_proc_cmdline(dir_result->d_name, format_str, prs, &mem_pool); /* get process' environ */ get_proc_environ(dir_result->d_name, format_str, prs, &mem_pool); /* get process' cwd & exec values from the symblink */ eval_link(dir_result->d_name, "cwd", F_CWD, &prs->cwd, format_str, &mem_pool); eval_link(dir_result->d_name, "exe", F_EXEC, &prs->exec, format_str, &mem_pool); /* scapre from /proc/{$pid}/status */ get_proc_status(dir_result->d_name, format_str, prs, &mem_pool); /* calculate precent cpu & mem values */ calc_prec(format_str, prs, &mem_pool); /* Go ahead and bless into a perl object */ /* Linux.h defines const char* const* Fiels, but we cast it away, as bless_into_proc only understands char** */ bless_into_proc(format_str, (char**) field_names, prs->uid, prs->gid, prs->pid, prs->comm, prs->ppid, prs->pgrp, prs->sid, prs->tty, prs->flags, prs->minflt, prs->cminflt, prs->majflt, prs->cmajflt, prs->utime, prs->stime, prs->cutime, prs->cstime, prs->priority, prs->start_time, prs->vsize, prs->rss, prs->wchan, prs->time, prs->ctime, prs->state, prs->euid, prs->suid, prs->fuid, prs->egid, prs->sgid, prs->fgid, prs->pctcpu, prs->pctmem, prs->cmndline, prs->exec, prs->cwd, prs->cmdline, prs->cmdline_len, prs->environ, prs->environ_len, prs->tracer ); /* we want a new prs, for the next itteration */ obstack_free(&mem_pool, prs); } closedir(dir); /* free all our tempoary memory */ obstack_free(&mem_pool, NULL); } Proc-ProcessTable-0.59/README.aix0000644000175000017500000000470313501006311014516 0ustar jwbjwbport of Proc::ProcessTable under AIX New files ========= os/aix.c os/aix.h hints/aix.pl README.aix Sample (low effort) application (please don't laugh ;) =============================== minitop.pl xminitop Blah ==== o Documentation under AIX is rather cryptic and incomplete. I managed to read the process table using undocumented calls : getproc, getuser, getargs. I've read C code from Vic Abell in lsof-4.36, Jussi Maki and Marcel J.E. Mol in monitor-2.1.2 as well as a usenet news posted by Michael Wojcik (Article: 63164 of comp.unix.aix, Date: 04/04/95) [lsof is a really nice tool and provides C examples to read low-level structures under nearly any UNIX system on earth. ] o my port was only tested under the following conditions : AIX 4.1.5 perl 5.005_02 o I am not a C programming terminator, so consider this as really ALPHA software. o I wanted this tool to be usable by a non root user. This is why I don't read /dev/kmem unlike Vic and Jussi. Bugs ==== o When mapping tty device numbers to names, I get a 'permission denied' message due to the /dev/.SRC-unix directory whose perms are as follows : drwxrwx--- 2 root system 512 Aug 12 11:26 .SRC-unix/ This dir contains only a few unix domain socket files used by IBM's System Resource Controller, so it is of no interest for getting ttynames. Maybe we should bind STDERR to /dev/null o I sometimes get : "Can't access `pctmem' field in class Proc::ProcessTable::Process" It comes from the AUTOLOAD function defined in Process.pm. How come we are able to access fields like "pctcpu" but not "pctmem" ? I am puzzled. We may chenge the 'croak' statement to a 'warn' but it'd be better if we knew where this error comes from. o Hidden ones ? I bet there is some ... Thanks ====== Daniel J. Urist Vic Abell Jussi Maki Cedric Le Goater Gregory Kurz COPYRIGHT ========= Copyright (c) 1998, Daniel J. Urist. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (c) 1998, David Paquet. All rights reserved. This package is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -- David Paquet david-paquet@usa.netProc-ProcessTable-0.59/Makefile.PL0000644000175000017500000000361713502757457015064 0ustar jwbjwbuse 5.006; use strict; use warnings; use ExtUtils::MakeMaker; sub MY::c_o { package MY; # so that "SUPER" works right my $inherited = shift->SUPER::c_o(@_); $inherited =~ s/\$\*\.c/\$\(C_FILES\)/; $inherited; } my %WriteMakefileArgs = ( NAME => 'Proc::ProcessTable', AUTHOR => q{Joachim Bargsten }, VERSION_FROM => 'lib/Proc/ProcessTable.pm', ABSTRACT_FROM => 'lib/Proc/ProcessTable.pm', LICENSE => 'artistic_2', 'LDFROM' => '$(O_FILES)', 'LIBS' => [''], 'OBJECT' => 'ProcessTable.o OS.o', MIN_PERL_VERSION => '5.006', CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => '0', }, TEST_REQUIRES => { 'Test::More' => '0', }, 'PREREQ_PM' => { 'File::Find' => 0, 'Storable' => 0 }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Proc-ProcessTable-* OS.c' }, 'META_MERGE' => { resources => { repository => 'https://github.com/jwbargsten/perl-proc-processtable', }, }, ); # Compatibility with old versions of ExtUtils::MakeMaker unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) { my $test_requires = delete $WriteMakefileArgs{TEST_REQUIRES} || {}; @{$WriteMakefileArgs{PREREQ_PM}}{keys %$test_requires} = values %$test_requires; } unless (eval { ExtUtils::MakeMaker->VERSION('6.55_03'); 1 }) { my $build_requires = delete $WriteMakefileArgs{BUILD_REQUIRES} || {}; @{$WriteMakefileArgs{PREREQ_PM}}{keys %$build_requires} = values %$build_requires; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 }; delete $WriteMakefileArgs{MIN_PERL_VERSION} unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 }; delete $WriteMakefileArgs{LICENSE} unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 }; WriteMakefile(%WriteMakefileArgs); Proc-ProcessTable-0.59/META.json0000644000175000017500000000233313502757612014516 0ustar jwbjwb{ "abstract" : "Perl extension to access the unix process table", "author" : [ "Joachim Bargsten " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Proc-ProcessTable", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Find" : "0", "Storable" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/jwbargsten/perl-proc-processtable" } }, "version" : "0.59", "x_serialization_backend" : "JSON::PP version 2.97001" } Proc-ProcessTable-0.59/META.yml0000644000175000017500000000131413502757612014344 0ustar jwbjwb--- abstract: 'Perl extension to access the unix process table' author: - 'Joachim Bargsten ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Proc-ProcessTable no_index: directory: - t - inc requires: File::Find: '0' Storable: '0' perl: '5.006' resources: repository: https://github.com/jwbargsten/perl-proc-processtable version: '0.59' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Proc-ProcessTable-0.59/README.openbsd0000644000175000017500000000134513501006311015366 0ustar jwbjwb SUPPORTED ATTRIBUTES ================================== uid UID of process gid GID of process euid effective UID of process egid effective GID of process pid process ID ppid parent process ID pgrp process group ID sess pointer to session time cpu time of process utime user time stime system time start time process started size virtual memory size (bytes) rss resident set size (bytes) fname command name state state of process ttydev path of process' tty ttynum tty number of process cmndline command line of process Proc-ProcessTable-0.59/README.sunos0000644000175000017500000000154613501006311015106 0ustar jwbjwb SUPPORTED ATTRIBUTES ====================================================== uid UID of process gid GID of process euid effective UID egid effective GID pid process ID ppid parent process ID pgrp process group ID priority priority of process flags process flags size size of process in KB (data + stack) rss resident set size in KB nice nice for cpu usage time cpu time of process fname command name cmndline entire command line for the process cpticks ticks of cpu time, for pctcpu pctcpu (decayed) %cpu for this process state state of process sess synonym for 'sid' sid session id ttynum tty number of process (-1 if no tty)