BSD-Process
view release on metacpan or search on metacpan
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = '0.07';
@ISA = qw(Exporter Class::Accessor);
@EXPORT_OK = (qw(process_info process_list P));
BEGIN {
my %alias = (
process_pid => 'pid',
parent_pid => 'ppid',
process_group_id => 'pgid',
tty_process_group_id => 'tpgid',
process_session_id => 'sid',
job_control_counter => 'jobc',
resident_set_size => 'rssize',
rssize_before_swap => 'swrss',
text_size => 'tsize',
exit_status => 'xstat',
accounting_flags => 'acflag',
percent_cpu => 'pctcpu',
estimated_cpu => 'estcpu',
sleep_time => 'slptime',
current_cpu => 'oncpu',
last_cpu => 'lastcpu',
wchan_message => 'wmesg',
setlogin_name => 'login',
command_name => 'comm',
process_args => 'args',
terminal_session_id => 'tsid',
effective_user_id => 'uid',
real_user_id => 'ruid',
saved_effective_user_id => 'svuid',
real_group_id => 'rgid',
saved_effective_group_id => 'svgid',
number_of_groups => 'ngroups',
group_list => 'groups',
virtual_size => 'size',
data_size => 'dsize',
stack_size => 'ssize',
start_time => 'start',
children_time => 'childtime',
posix_advisory_lock => 'advlock',
has_controlling_terminal => 'controlt',
is_kernel_thread => 'kthread',
no_loadavg_calc => 'noload',
parent_waiting => 'ppwait',
started_profiling => 'profil',
stopped_profiling => 'stopprof',
id_privs_set => 'sugid',
system_process => 'system',
single_exit_not_wait => 'single_exit',
traced_by_debugger => 'traced',
waited_on_by_other => 'waited',
working_on_exiting => 'wexit',
process_called_exec => 'exec',
kernel_session_flag => 'kiflag',
is_locked => 'locked',
controlling_tty_active => 'isctty',
is_session_leader => 'issleader',
elsif (exists $arg{ruid}) {
$request = 6;
$param = $arg{ruid};
$param =~ /\D/ and $param = scalar(getpwnam($param));
}
elsif (exists $arg{real_user_id}) {
$request = 6;
$param = $arg{real_user_id};
$param =~ /\D/ and $param = scalar(getpwnam($param));
}
elsif (exists $arg{gid}) {
$request = 11;
$param = $arg{gid};
$param =~ /\D/ and $param = scalar(getgrnam($param));
}
elsif (exists $arg{effective_group_id}) {
$request = 11;
$param = $arg{effective_group_id};
$param =~ /\D/ and $param = scalar(getgrnam($param));
}
elsif (exists $arg{rgid}) {
$request = 10;
$param = $arg{rgid};
$param =~ /\D/ and $param = scalar(getgrnam($param));
}
elsif (exists $arg{real_group_id}) {
$request = 10;
$param = $arg{real_group_id};
$param =~ /\D/ and $param = scalar(getgrnam($param));
}
elsif (exists $arg{pgid}) {
$request = 2;
$param = $arg{pgid};
}
elsif (exists $arg{process_group_id}) {
$request = 2;
$param = $arg{process_group_id};
}
elsif (exists $arg{sid}) {
$request = 2;
$param = $arg{sid};
}
elsif (exists $arg{process_session_id}) {
Creates a new C<BSD::Process> object. Takes an optional numeric
value to specify the pid of the target process, otherwise the
current process is assumed.
A second optional parameter, a reference to a hash, supplies
additional information governing the creation of the object.
Currently, one key is available:
B<resolve> - indicates whether uids and gids should be resolved to
their symbolic equivalents (for instance, 0 becomes "root").
Passing the hash reference as the only parameter works as may be
expected: the pid of the current process will be used implicitly.
my $init = BSD::Process->new(1); # get info about init
print "children of init have taken $init->{childtime} seconds\n";
# get process info of process's parent, resolving ids
my $parent = BSD::Process->new(
=over 4
=item uid, effective_user_id
Return the list of pids that are owned by the specified effective
user id. The uid may be specified in the symbolic or numeric form.
my @uid_pid = BSD::Process::list(uid => 1001);
my @root_pid = BSD::Process::list(uid => 'root');
=item pgid, process_group_id
Return the processes that belong to the specified process group.
my @pgid_pid = BSD::Process::list(process_group_id => 378);
=item sid, process_session_id
Return the processes that belong to the specified process session.
=back
=item all
Return a references to a hash of C<BSD::Process> objects representing the
last unless --$want;
}
This routine runs more slowly than C<list()>, since it has to
instantiate the process objects. It may help to think of C<all()>
as a meta-new constructor, since it creates many new BSD::Process
objects in one fell swoop.
This routine accepts the same parameters as C<list()>. Thus, one is
able to restrict the set of objects returned. In addition, it also
accepts the C<resolve> parameter, to indicate that uids and gids
should be represented as symbolic names rather than numeric values.
my @own = BSD::Process::all(uid => 1000);
my @session = BSD::Process::all(sid => 632, resolve => 1);
=item attr
Returns the list of available attributes of a C<BSD::Process>
object. You can use this to pretty-print an object:
The identifier that identifies a process in a unique manner. No two
process share the same pid (process id).
=item parent_pid, ppid
The pid of the parent process that spawned the current process.
Many processes may share the same parent pid. Processes whose parents
exit before they do are reparented to init (pid 1).
=item process_group_id, pgid
A number of processes may belong to the same group (for instance,
all the processes in a shell pipeline). In this case they share the
same pgid.
=item tty_process_group_id, tpgid
Similarly, a number of processes belong to the same tty process
group. This means that they were all originated from the same console
login session or terminal window. B<F5+>
=item process_session_id, sid
Processes also belong to a session, identified by the process session
id. B<F5+>
had the C<resolve> attribute set. B<F5+>
=item real_user_id, ruid
The user id of the user that launched the process. B<F5+>
=item saved_effective_user_id, svuid
The saved effective user id of the process. (purpose?) B<F5+>
=item real_group_id, rgid
The primary group id of the user that launched the process.
The symbolic name of the gid will be returned if the constructor
had the C<resolve> attribute set. B<F5+>
=item saved_effective_group_id, svgid
The saved effective group id of the process. (purpose?) B<F5+>
=item number_of_groups, ngroups
The number of groups to which the process belongs. B<F5+>
=item group_list, groups
A reference to an array of group ids (gids) to which the process belongs. B<F5+>
=item virtual_size, size
The size (in bytes) of virtual memory occupied by the process. B<F5+>
=item resident_set_size, rssize
The size (in kilobytes) of physical memory occupied by the process.
=item rssize_before_swap, swrss
=item stopped_profiling, stopprof
Flag indicating whether the process has a thread that has requesting
profiling to stop. B<F5+>
=item process_had_threads, hadthreads
Flag indicating whether the process has had thresds. B<F6+>
=item id_privs_set, sugid
Flag indicating whether the process has set id privileges since
last exec. B<F5+>
=item system_process, system
Flag indicating whether the process is a system process. B<F5+>
=item single_exit_not_wait, single_exit
if (!(pw = getpwuid(uid))) {
/* shouldn't ever happen... */
hv_store(h, field, flen, newSViv(uid), 0);
}
else {
len = strlen(pw->pw_name);
hv_store(h, field, flen, newSVpvn(pw->pw_name,len), 0);
}
}
void store_gid (HV *h, const char *field, gid_t gid) {
struct group *gr;
size_t flen;
size_t len;
flen = strlen(field);
if (!(gr = getgrgid(gid))) {
/* shouldn't ever happen... */
hv_store(h, field, flen, newSViv(gid), 0);
}
else {
len = strlen(gr->gr_name);
hv_store(h, field, flen, newSVpvn(gr->gr_name,len), 0);
}
}
#if __FreeBSD_version < 500000
#define ACFLAG_FIELD kp_proc.p_acflag
#define COMM_FIELD kp_proc.p_comm
#define ESTCPU_FIELD kp_proc.p_estcpu
#define FLAG_FIELD kp_eproc.e_jobc
#define JOBC_FIELD kp_eproc.e_flag
#define LASTCPU_FIELD kp_proc.p_lastcpu
#define LOCK_FIELD kp_proc.p_lock
#define LOGIN_FIELD kp_eproc.e_login
#define NICE_FIELD kp_proc.p_nice
#define ONCPU_FIELD kp_proc.p_oncpu
#define PCTCPU_FIELD kp_proc.p_pctcpu
#define PGID_FIELD kp_eproc.e_pgid
#define PID_FIELD kp_proc.p_pid
#define PPID_FIELD kp_eproc.e_ppid
#define RQINDEX_FIELD kp_proc.p_rqindex
#define RSSIZE_FIELD kp_eproc.e_xrssize
#define RUNTIME_FIELD kp_proc.p_runtime
#define SLPTIME_FIELD kp_proc.p_slptime
#define SWRSS_FIELD kp_eproc.e_xswrss
#define SWTIME_FIELD kp_proc.p_swtime
#define TPGID_FIELD kp_eproc.e_tpgid
#define TSIZE_FIELD kp_eproc.e_xsize
#define WMESG_FIELD kp_eproc.e_wmesg
#define XSTAT_FIELD kp_proc.p_xstat
#else
#define ACFLAG_FIELD ki_acflag
#define COMM_FIELD ki_comm
#define ESTCPU_FIELD ki_estcpu
#define FLAG_FIELD ki_flag
#define JOBC_FIELD ki_jobc
#define LASTCPU_FIELD ki_lastcpu
#define LOCK_FIELD ki_lock
#define LOGIN_FIELD ki_login
#define NICE_FIELD ki_nice
#define ONCPU_FIELD ki_oncpu
#define PCTCPU_FIELD ki_pctcpu
#define PGID_FIELD ki_pgid
#define PID_FIELD ki_pid
#define PPID_FIELD ki_ppid
#define RQINDEX_FIELD ki_rqindex
#define RSSIZE_FIELD ki_rssize
#define RUNTIME_FIELD ki_runtime
#define SLPTIME_FIELD ki_slptime
#define SWRSS_FIELD ki_swrss
#define SWTIME_FIELD ki_swtime
#define TPGID_FIELD ki_tpgid
#define TSIZE_FIELD ki_tsize
#define WMESG_FIELD ki_wmesg
#define XSTAT_FIELD ki_xstat
#endif
HV *_procinfo (struct kinfo_proc *kp, int resolve) {
HV *h;
const char *nlistf, *memf;
kvm_t *kd;
char errbuf[_POSIX2_LINE_MAX];
short g;
AV *grlist;
#if __FreeBSD_version >= 500000
struct rusage *rp;
#endif
h = (HV *)sv_2mortal((SV *)newHV());
hv_store(h, "pid", 3, newSViv(kp->PID_FIELD), 0);
hv_store(h, "ppid", 4, newSViv(kp->PPID_FIELD), 0);
hv_store(h, "pgid", 4, newSViv(kp->PGID_FIELD), 0);
hv_store(h, "tpgid", 5, newSViv(kp->TPGID_FIELD), 0);
hv_store(h, "jobc", 4, newSViv(kp->JOBC_FIELD), 0);
hv_store(h, "tsize", 5, newSViv(kp->TSIZE_FIELD), 0);
hv_store(h, "rssize", 6, newSViv(kp->RSSIZE_FIELD), 0);
hv_store(h, "swrss", 5, newSViv(kp->SWRSS_FIELD), 0);
hv_store(h, "acflag", 6, newSViv(kp->ACFLAG_FIELD), 0);
hv_store(h, "flag", 4, newSViv(kp->FLAG_FIELD), 0);
hv_store(h, "pctcpu", 6, newSViv(kp->PCTCPU_FIELD), 0);
hv_store(h, "estcpu", 6, newSViv(kp->ESTCPU_FIELD), 0);
hv_store(h, "xstat", 5, newSViv(kp->XSTAT_FIELD), 0);
hv_store(h, "slptime", 7, newSViv(kp->SLPTIME_FIELD), 0);
hv_store(h, "comm", 4, newSVpv(kp->COMM_FIELD, 0), 0);
hv_store(h, "sid", 3, newSViv(NO_FREEBSD_4x(kp->ki_sid)), 0);
hv_store(h, "tsid", 4, newSViv(NO_FREEBSD_4x(kp->ki_tsid)), 0);
if (!resolve) {
/* numeric user and group ids */
hv_store(h, "uid", 3, newSViv(NO_FREEBSD_4x(kp->ki_uid)), 0);
hv_store(h, "ruid", 4, newSViv(NO_FREEBSD_4x(kp->ki_ruid)), 0);
hv_store(h, "svuid", 5, newSViv(NO_FREEBSD_4x(kp->ki_svuid)), 0);
hv_store(h, "rgid", 4, newSViv(NO_FREEBSD_4x(kp->ki_rgid)), 0);
hv_store(h, "svgid", 5, newSViv(NO_FREEBSD_4x(kp->ki_svgid)), 0);
}
else {
NO_FREEBSD_4x(store_uid(h, "uid", kp->ki_uid));
NO_FREEBSD_4x(store_uid(h, "ruid", kp->ki_ruid));
NO_FREEBSD_4x(store_uid(h, "svuid", kp->ki_svuid));
NO_FREEBSD_4x(store_gid(h, "rgid", kp->ki_rgid));
NO_FREEBSD_4x(store_gid(h, "svgid", kp->ki_svgid));
}
grlist = (AV *)sv_2mortal((SV *)newAV());
#if __FreeBSD_version < 500000
/* not available in FreeBSD 4.x */
hv_store(h, "args", 4, newSViv(-1), 0);
#else
/* attributes available only in FreeBSD 5.x, 6.x */
nlistf = memf = PATH_DEV_NULL;
kd = kvm_openfiles(nlistf, memf, NULL, O_RDONLY, errbuf);
}
hv_store(h, "args", 4, argsv, 0);
if (kd) {
kvm_close(kd);
}
/* deal with groups array */
for (g = 0; g < kp->ki_ngroups; ++g) {
if (resolve && (gr = getgrgid(kp->ki_groups[g]))) {
av_push(grlist, newSVpvn(gr->gr_name, strlen(gr->gr_name)));
}
else {
av_push(grlist, newSViv(kp->ki_groups[g]));
}
}
#endif
hv_store(h, "groups", 6, newRV((SV *)grlist), 0);
hv_store(h, "ngroups", 7, newSViv(NO_FREEBSD_4x(kp->ki_ngroups)), 0);
hv_store(h, "advlock", 7, newSViv(NO_FREEBSD_4x(P_FLAG(P_ADVLOCK))), 0);
hv_store(h, "controlt", 8, newSViv(NO_FREEBSD_4x(P_FLAG(P_CONTROLT))), 0);
hv_store(h, "kthread", 7, newSViv(NO_FREEBSD_4x(P_FLAG(P_KTHREAD))), 0);
#if __FreeBSD_version < 802501
hv_store(h, "noload", 6, newSViv(NO_FREEBSD_4x(P_FLAG(P_NOLOAD))), 0);
#endif
hv_store(h, "ppwait", 6, newSViv(NO_FREEBSD_4x(P_FLAG(P_PPWAIT))), 0);
hv_store(h, "profil", 6, newSViv(NO_FREEBSD_4x(P_FLAG(P_PROFIL))), 0);
hv_store(h, "stopprof", 8, newSViv(NO_FREEBSD_4x(P_FLAG(P_STOPPROF))), 0);
hv_store(h, "sugid", 5, newSViv(NO_FREEBSD_4x(P_FLAG(P_SUGID))), 0);
hv_store(h, "system", 6, newSViv(NO_FREEBSD_4x(P_FLAG(P_SYSTEM))), 0);
hv_store(h, "single_exit", 11, newSViv(NO_FREEBSD_4x(P_FLAG(P_SINGLE_EXIT))), 0);
hv_store(h, "traced", 6, newSViv(NO_FREEBSD_4x(P_FLAG(P_TRACED))), 0);
hv_store(h, "waited", 6, newSViv(NO_FREEBSD_4x(P_FLAG(P_WAITED))), 0);
hv_store(h, "wexit", 5, newSViv(NO_FREEBSD_4x(P_FLAG(P_WEXIT))), 0);
hv_store(h, "exec", 4, newSViv(NO_FREEBSD_4x(P_FLAG(P_EXEC))), 0);
hv_store(h, "hadthreads", 10, newSViv(NO_FREEBSD_5x(P_FLAG(P_HADTHREADS))), 0);
hv_store(h, "kiflag", 6, newSViv(NO_FREEBSD_4x(kp->ki_kiflag)), 0);
hv_store(h, "locked", 6, newSViv(NO_FREEBSD_4x(KI_FLAG(KI_LOCKBLOCK))), 0);
eg/procinfo view on Meta::CPAN
print " (u=$proc->{utime} s=$proc->{stime})\n";
print "process has posix advisory lock\n" if $proc->advlock;
print "process has controlling terminal\n" if $proc->controlt;
print "process is a kernel thread\n" if $proc->kthread;
print "process has no loadavg calc\n" if $proc->noload;
print "process has parent waiting\n" if $proc->ppwait;
print "process has started profiling\n" if $proc->profil;
print "process has stopped profiling\n" if $proc->stopprof;
print "process has had threads\n" if !$RUNNING_ON_FREEBSD_5 and $proc->hadthreads;
print "process has set id privileges\n" if $proc->sugid;
print "process is a system process\n" if $proc->system;
print "threads should exit not wait\n" if $proc->single_exit;
print "process is traced by a debugger\n" if $proc->traced;
print "something is waiting for this process\n" if $proc->waited;
print "process is preparing to exit\n" if $proc->wexit;
print "process called exec\n" if $proc->exec;
print "process is locked\n" if $proc->locked;
print "controlling terminal active\n" if $proc->isctty;
print "process is session leader\n" if $proc->issleader;
print "\n" if @pid > 1;
eg/showprocattr view on Meta::CPAN
Non-zero. Only display the process if all requested attributes are non-zero.
When B<-a> is also active, will suppress attributes whose values are zero.
=item B<-q>
Query. Display all the reognised attribute names that may be examined.
=item B<-r>
Resolve. Display uids and gids as names, rather than their numerical
values.
=item B<-V>
Print the version of this program and exit.
=back
=head1 EXAMPLES
t/01-func.t view on Meta::CPAN
$_ = $Unchanged;
my $RUNNING_ON_FREEBSD_4 = $Config{osvers} =~ /^4/;
my $RUNNING_ON_FREEBSD_5 = $Config{osvers} =~ /^5/;
my $info = BSD::Process::info();
# remove all attributes from object, should be none left over
ok( defined( delete $info->{pid} ), 'attribute pid');
ok( defined( delete $info->{ppid} ), 'attribute ppid');
ok( defined( delete $info->{pgid} ), 'attribute pgid');
ok( defined( delete $info->{tpgid} ), 'attribute tpgid');
ok( defined( delete $info->{sid} ), 'attribute sid');
ok( defined( delete $info->{jobc} ), 'attribute jobc');
ok( defined( delete $info->{rssize} ), 'attribute rssize');
ok( defined( delete $info->{swrss} ), 'attribute swrss');
ok( defined( delete $info->{tsize} ), 'attribute tsize');
ok( defined( delete $info->{xstat} ), 'attribute xstat');
ok( defined( delete $info->{acflag} ), 'attribute acflag');
ok( defined( delete $info->{pctcpu} ), 'attribute pctcpu');
ok( defined( delete $info->{estcpu} ), 'attribute estcpu');
ok( defined( delete $info->{slptime} ), 'attribute slptime');
t/01-func.t view on Meta::CPAN
ok( defined( delete $info->{lastcpu} ), 'attribute lastcpu');
ok( defined( delete $info->{wmesg} ), 'attribute wmesg');
ok( defined( delete $info->{login} ), 'attribute login');
ok( defined( delete $info->{comm} ), 'attribute comm');
ok( defined( delete $info->{args} ), 'attribute args');
ok( defined( delete $info->{tsid} ), 'attribute tsid');
ok( defined( delete $info->{uid} ), 'attribute uid');
ok( defined( delete $info->{ruid} ), 'attribute ruid');
ok( defined( delete $info->{svuid} ), 'attribute svuid');
ok( defined( delete $info->{rgid} ), 'attribute rgid');
ok( defined( delete $info->{svgid} ), 'attribute svgid');
ok( defined( delete $info->{size} ), 'attribute size');
ok( defined( delete $info->{dsize} ), 'attribute dsize');
ok( defined( delete $info->{ssize} ), 'attribute ssize');
ok( defined( delete $info->{start} ), 'attribute start');
ok( defined( delete $info->{childtime} ), 'attribute childtime');
ok( defined( delete $info->{advlock} ), 'attribute advlock');
ok( defined( delete $info->{controlt} ), 'attribute controlt');
ok( defined( delete $info->{kthread} ), 'attribute kthread');
ok( defined( delete $info->{noload} ), 'attribute noload');
ok( defined( delete $info->{ppwait} ), 'attribute ppwait');
ok( defined( delete $info->{profil} ), 'attribute profil');
ok( defined( delete $info->{stopprof} ), 'attribute stopprof');
ok( defined( delete $info->{sugid} ), 'attribute sugid');
ok( defined( delete $info->{system} ), 'attribute system');
ok( defined( delete $info->{single_exit} ), 'attribute single_exit');
ok( defined( delete $info->{traced} ), 'attribute traced');
ok( defined( delete $info->{waited} ), 'attribute waited');
ok( defined( delete $info->{wexit} ), 'attribute wexit');
ok( defined( delete $info->{exec} ), 'attribute exec');
ok( defined( delete $info->{kiflag} ), 'attribute kiflag');
ok( defined( delete $info->{locked} ), 'attribute locked');
ok( defined( delete $info->{isctty} ), 'attribute isctty');
ok( defined( delete $info->{issleader} ), 'attribute issleader');
t/01-func.t view on Meta::CPAN
is ($total, $same_uid, "same number of processes for ruid $bigger" )
or do {
diag( "pid: $_ uid: $all_ruid->{$_}{uid}" )
for keys %$all_ruid;
};
is ($total, $blessed, "... and all blessed BSD::Process objects" );
}
SKIP: {
# processes owned by an effective gid
skip( "not supported on FreeBSD 4.x or 5.x", 6 )
if $RUNNING_ON_FREEBSD_4 or $RUNNING_ON_FREEBSD_5;
# count the processes owned by each effective gid
# kinfo_proc lacks a gid field, so we'll punt with a real gid
my %gid;
for my $pid (@all) {
my $proc = BSD::Process->new($pid);
$gid{$proc->{rgid}}++ if defined $proc->{rgid};
}
# now find the gids that own the most processes
my ($biggest, $bigger) = (sort {$gid{$b} <=> $gid{$a} || $a <=> $b} keys %gid )[0,1];
my @proc = BSD::Process::list( gid => $biggest );
cmp_ok( scalar(@proc), '<', $all_procs, "gid $biggest smaller than count of all processes" );
my $biggest_gid = @proc;
@proc = BSD::Process::list( effective_group_id => $bigger );
cmp_ok( scalar(@proc), '<', $all_procs, "gid $bigger smaller than count of all processes" );
cmp_ok( scalar(@proc), '<=', $biggest_gid, "gid $bigger smaller or equal to gid $biggest" );
# processes owned by a rgid
my %rgid;
for my $pid (@all) {
my $proc = BSD::Process->new($pid);
$rgid{$proc->{rgid}}++ if defined $proc->{rgid};
}
# now find the gids that own the most processes
($biggest, $bigger) = (sort {$rgid{$b} <=> $rgid{$a} || $a <=> $b} keys %rgid )[0,1];
@proc = BSD::Process::list( rgid => $biggest );
cmp_ok( scalar(@proc), '<', $all_procs, "rgid $biggest smaller than count of all processes" );
my $biggest_rgid = @proc;
@proc = BSD::Process::list( real_group_id => $bigger );
cmp_ok( scalar(@proc), '<', $all_procs, "rgid $bigger smaller than count of all processes" );
cmp_ok( scalar(@proc), '<=', $biggest_rgid, "rgid $bigger smaller or equal to rgid $biggest" );
}
# process groups
SKIP: {
skip( "not supported on FreeBSD 4.x", 6 )
if $RUNNING_ON_FREEBSD_4;
# count the processes in each process group
my %pgid;
for my $pid (@all) {
my $proc = BSD::Process->new($pid);
$pgid{$proc->{pgid}}++ if defined $proc->{pgid};
}
# now find the process groups with the most members
my ($biggest, $bigger) = (sort {$pgid{$b} <=> $pgid{$a} || $a <=> $b} keys %pgid )[0,1];
my @proc = BSD::Process::list( pgid => $biggest );
cmp_ok( scalar(@proc), '<', $all_procs, "pgid $biggest smaller than count of all processes" );
my $biggest_pgid = @proc;
@proc = BSD::Process::list( process_group_id => $bigger );
cmp_ok( scalar(@proc), '<', $all_procs, "pgid $bigger smaller than count of all processes" );
cmp_ok( scalar(@proc), '<=', $biggest_pgid, "pgid $bigger smaller or equal to pgid $biggest" );
# process sessions
# count the processes in each process session
my %sid;
for my $pid (@all) {
my $proc = BSD::Process->new($pid);
$sid{$proc->{sid}}++ if defined $proc->{sid};
}
# now find the process groups with the most members
t/01-func.t view on Meta::CPAN
$root = BSD::Process::all( real_user_id => 'root' );
$uid_root_count = 0;
$root->{$_}->ruid == 0 and ++$uid_root_count for keys %$root;
is( $uid_root_count, scalar(keys %$root), q{counted all real_user_id root's processes} );
}
SKIP: {
skip( "not supported on FreeBSD 4.x or 5.x", 2 )
if $RUNNING_ON_FREEBSD_4 or $RUNNING_ON_FREEBSD_5;
my $wheel_gid = getgrnam('wheel');
{
my $wheel = BSD::Process::all( gid => 'wheel' );
my $gid_wheel_count = 0;
for my $pid (keys %$wheel) {
my $proc = $wheel->{$pid};
if ($proc->rgid == $wheel_gid) {
++$gid_wheel_count;
}
else {
my $msg = "$proc->{comm}($proc->{pid}) has rgid $proc->{rgid} not $wheel_gid";
if ($proc->{comm} eq 'sshd') {
# sshd uses process separation, which throws this off
++$gid_wheel_count;
$msg .= " (pass)";
}
$ENV{PERL_AUTHOR_TESTING} and diag( $msg );
}
}
is( $gid_wheel_count, scalar(keys %$wheel), q{counted all gid wheel's processes} );
}
{
my $wheel = BSD::Process::all( effective_group_id => 'wheel' );
my $gid_wheel_count = 0;
for my $pid (keys %$wheel) {
my $proc = $wheel->{$pid};
if ($proc->rgid == $wheel_gid) {
++$gid_wheel_count;
}
else {
my $msg = "$proc->{comm}($proc->{pid}) has rgid $proc->{rgid} not $wheel_gid";
if ($proc->{comm} eq 'sshd') {
# sshd uses process separation, which throws this off
++$gid_wheel_count;
$msg .= " (pass)";
}
$ENV{PERL_AUTHOR_TESTING} and diag( $msg );
}
}
is( $gid_wheel_count, scalar(keys %$wheel), q{counted all effective_group_id wheel's processes} );
}
}
is($_, $Unchanged, $Unchanged);
t/02-method.t view on Meta::CPAN
{
my $pi = BSD::Process->new(); # implicit pid
my $pe = BSD::Process->new($$); # explicit pid
is( $pi->{pid}, $pe->{pid}, 'attribute pid' );
is( $pi->{sid}, $pe->{sid}, 'attribute sid' );
is( $pi->{tsid}, $pe->{tsid}, 'attribute tsid' );
is($pe->pid, delete $pe->{pid}, 'method pid' );
is($pe->ppid, delete $pe->{ppid}, 'method ppid');
is($pe->pgid, delete $pe->{pgid}, 'method pgid');
is($pe->tpgid, delete $pe->{tpgid}, 'method tpgid');
is($pe->sid, delete $pe->{sid}, 'method tpgid');
is($pe->jobc, delete $pe->{jobc}, 'method jobc');
is($pe->rssize, delete $pe->{rssize}, 'method rssize');
is($pe->swrss, delete $pe->{swrss}, 'method swrss');
is($pe->tsize, delete $pe->{tsize}, 'method tsize');
is($pe->xstat, delete $pe->{xstat}, 'method xstat');
is($pe->acflag, delete $pe->{acflag}, 'method acflag');
is($pe->pctcpu, delete $pe->{pctcpu}, 'method pctcpu');
is($pe->estcpu, delete $pe->{estcpu}, 'method estcpu');
is($pe->slptime, delete $pe->{slptime}, 'method slptime');
is($pe->swtime, delete $pe->{swtime}, 'method swtime');
t/02-method.t view on Meta::CPAN
is($pe->wmesg, delete $pe->{wmesg}, 'method wmesg');
is($pe->login, delete $pe->{login}, 'method login');
is($pe->comm, delete $pe->{comm}, 'method comm');
my $ngroups;
is($pe->args, delete $pe->{args}, 'method args' );
is($pe->tsid, delete $pe->{tsid}, 'method tsid');
is($pe->uid, delete $pe->{uid}, 'method uid');
is($pe->ruid, delete $pe->{ruid}, 'method ruid');
is($pe->svuid, delete $pe->{svuid}, 'method svuid');
is($pe->rgid, delete $pe->{rgid}, 'method rgid');
is($pe->svgid, delete $pe->{svgid}, 'method svgid');
is($pe->ngroups, $ngroups = delete $pe->{ngroups}, 'method ngroups');
is($pe->size, delete $pe->{size}, 'method size');
is($pe->dsize, delete $pe->{dsize}, 'method dsize');
is($pe->ssize, delete $pe->{ssize}, 'method ssize');
is($pe->start, delete $pe->{start}, 'method start');
is($pe->childtime, delete $pe->{childtime}, 'method childtime');
is($pe->advlock, delete $pe->{advlock}, 'method advlock');
is($pe->controlt, delete $pe->{controlt}, 'method controlt');
is($pe->kthread, delete $pe->{kthread}, 'method kthread');
is($pe->noload, delete $pe->{noload}, 'method noload');
is($pe->ppwait, delete $pe->{ppwait}, 'method ppwait');
is($pe->profil, delete $pe->{profil}, 'method profil');
is($pe->stopprof, delete $pe->{stopprof}, 'method stopprof');
is($pe->sugid, delete $pe->{sugid}, 'method sugid');
is($pe->system, delete $pe->{system}, 'method system');
is($pe->single_exit, delete $pe->{single_exit}, 'method single_exit');
is($pe->traced, delete $pe->{traced}, 'method traced');
is($pe->waited, delete $pe->{waited}, 'method waited');
is($pe->wexit, delete $pe->{wexit}, 'method wexit');
is($pe->exec, delete $pe->{exec}, 'method exec');
is($pe->kiflag, delete $pe->{kiflag}, 'method kiflag');
is($pe->locked, delete $pe->{locked}, 'method locked');
is($pe->isctty, delete $pe->{isctty}, 'method isctty');
is($pe->issleader, delete $pe->{issleader}, 'method issleader');
t/02-method.t view on Meta::CPAN
is($pe->nivcsw_ch, delete $pe->{nivcsw_ch}, 'method nivcsw_ch');
# check for typos in hv_store calls in Process.xs
is( scalar(grep {!/^_/} keys %$pe), 0, 'all methods have been accounted for' )
or diag( 'leftover: ' . join( ',', grep {!/^_/} keys %$pe ));
$pe->refresh;
# longhand method names
is($pe->process_pid, delete $pe->{pid}, 'alias process_pid' );
is($pe->parent_pid, delete $pe->{ppid}, 'alias parent_pid');
is($pe->process_group_id, delete $pe->{pgid}, 'alias process_group_id');
is($pe->tty_process_group_id, delete $pe->{tpgid}, 'alias tty_process_group_id');
is($pe->process_session_id, delete $pe->{sid}, 'alias tty_process_group_id');
is($pe->job_control_counter, delete $pe->{jobc}, 'alias job_control_counter');
is($pe->resident_set_size, delete $pe->{rssize}, 'alias resident_set_size');
is($pe->rssize_before_swap, delete $pe->{swrss}, 'alias rssize_before_swap');
is($pe->text_size, delete $pe->{tsize}, 'alias text_size');
is($pe->exit_status, delete $pe->{xstat}, 'alias exit_status');
is($pe->accounting_flags, delete $pe->{acflag}, 'alias accounting_flags');
is($pe->percent_cpu, delete $pe->{pctcpu}, 'alias percent_cpu');
is($pe->estimated_cpu, delete $pe->{estcpu}, 'alias estimated_cpu');
is($pe->sleep_time, delete $pe->{slptime}, 'alias sleep_time');
t/02-method.t view on Meta::CPAN
is($pe->last_cpu, delete $pe->{lastcpu}, 'alias last_cpu');
is($pe->wchan_message, delete $pe->{wmesg}, 'alias wchan_message');
is($pe->setlogin_name, delete $pe->{login}, 'alias setlogin_name');
is($pe->command_name, delete $pe->{comm}, 'alias command_name');
is($pe->process_args, delete $pe->{args}, 'alias process_args' );
is($pe->terminal_session_id, delete $pe->{tsid}, 'alias terminal_session_id');
is($pe->effective_user_id, delete $pe->{uid}, 'alias effective_user_id');
is($pe->real_user_id, delete $pe->{ruid}, 'alias real_user_id');
is($pe->saved_effective_user_id, delete $pe->{svuid}, 'alias saved_effective_user_id');
is($pe->real_group_id, delete $pe->{rgid}, 'alias real_group_id');
is($pe->saved_effective_group_id, delete $pe->{svgid}, 'alias saved_effective_group_id');
is($pe->number_of_groups, delete $pe->{ngroups}, 'alias number_of_groups');
is($pe->virtual_size, delete $pe->{size}, 'alias virtual_size');
is($pe->data_size, delete $pe->{dsize}, 'alias data_size');
is($pe->stack_size, delete $pe->{ssize}, 'alias stack_size');
is($pe->start_time, delete $pe->{start}, 'alias start_time');
is($pe->children_time, delete $pe->{childtime}, 'alias children_time');
is($pe->posix_advisory_lock, delete $pe->{advlock}, 'alias posix_advisory_lock');
is($pe->has_controlling_terminal, delete $pe->{controlt}, 'alias has_controlling_terminal');
is($pe->is_kernel_thread, delete $pe->{kthread}, 'alias is_kernel_thread');
is($pe->no_loadavg_calc, delete $pe->{noload}, 'alias no_loadavg_calc');
is($pe->parent_waiting, delete $pe->{ppwait}, 'alias parent_waiting');
is($pe->started_profiling, delete $pe->{profil}, 'alias started_profiling');
is($pe->stopped_profiling, delete $pe->{stopprof}, 'alias stopped_profiling');
is($pe->id_privs_set, delete $pe->{sugid}, 'alias id_privs_set');
is($pe->system_process, delete $pe->{system}, 'alias system_process');
is($pe->single_exit_not_wait, delete $pe->{single_exit}, 'alias single_exit_not_wait');
is($pe->traced_by_debugger, delete $pe->{traced}, 'alias traced_by_debugger');
is($pe->waited_on_by_other, delete $pe->{waited}, 'alias waited_on_by_other');
is($pe->working_on_exiting, delete $pe->{wexit}, 'alias working_on_exiting');
is($pe->process_called_exec, delete $pe->{exec}, 'alias process_called_exec');
is($pe->kernel_session_flag, delete $pe->{kiflag}, 'alias kernel_session_flag');
is($pe->is_locked, delete $pe->{locked}, 'alias is_locked');
is($pe->controlling_tty_active, delete $pe->{isctty}, 'alias controlling_tty_active');
is($pe->is_session_leader, delete $pe->{issleader}, 'alias is_session_leader');
t/02-method.t view on Meta::CPAN
my $time = $pi->runtime;
cmp_ok( $pi->refresh->runtime, '>', $time, 'refresh updates counters' );
$pe->refresh;
for my $method (sort {$a cmp $b} BSD::Process::attr_alias) {
ok($pe->can($method), "can $method");
}
}
{
# check symbolic uids and gids
my $num = BSD::Process->new();
my $sym_imp = BSD::Process->new( {resolve => 1} );
my $sym_exp = BSD::Process->new( $$, {resolve => 1} );
my $num_grouplist = $num->groups;
my $sym_grouplist = $sym_imp->group_list;
SKIP: {
skip( "not supported on FreeBSD 4.x", 13 )
if $RUNNING_ON_FREEBSD_4;
is( $num->uid, scalar(getpwnam($sym_imp->uid)), 'implicit pid resolve muid' );
is( $num->ruid, scalar(getpwnam($sym_imp->ruid)), 'implicit pid resolve ruid' );
is( $num->svuid, scalar(getpwnam($sym_imp->svuid)), 'implicit pid resolve svuid' );
is( $num->rgid, scalar(getgrnam($sym_imp->rgid)), 'implicit pid resolve rgid' );
is( $num->svgid, scalar(getgrnam($sym_imp->svgid)), 'implicit pid resolve svgid' );
is( $num->uid, scalar(getpwnam($sym_exp->uid)), 'explicit pid resolve uid' );
is( $num->ruid, scalar(getpwnam($sym_exp->ruid)), 'explicit pid resolve ruid' );
is( $num->svuid, scalar(getpwnam($sym_exp->svuid)), 'explicit pid resolve svuid' );
is( $num->rgid, scalar(getgrnam($sym_exp->rgid)), 'explicit pid resolve rgid' );
is( $num->svgid, scalar(getgrnam($sym_exp->svgid)), 'explicit pid resolve svgid' );
is( ref($num_grouplist), 'ARRAY', 'numeric grouplist is an ARRAY' );
is( ref($sym_grouplist), 'ARRAY', 'symbolic grouplist is an ARRAY' );
is( scalar(@$num_grouplist), scalar(@$sym_grouplist), 'groups counts' );
}
for my $gid (0..BSD::Process::max_kernel_groups) {
if ($gid < @$num_grouplist) {
is( $num_grouplist->[$gid], scalar(getgrnam($sym_grouplist->[$gid])), "resolve group $gid" );
}
else {
pass( "resolve group $gid (none on this platform)" );
}
}
}
( run in 2.681 seconds using v1.01-cache-2.11-cpan-5735350b133 )