YAPT: yet another process-tree printer
Tom Christiansen
Submitter: Tom Christiansen <tch...@convex.com>
Version: 1.1
It's hard to believe how broken many (most?) vendors' ps programs seem to
be. So I've introduced innumerable disgusting hacks to try to demangle
their ps output. If your vendor has columns running together in their ps
output, send them bug reports until they fix it! This is sure one of my
candidates for going on SAGE's hit list of vendor problems. Don't people
know that this programs need to be able to parse this stuff?
I've tried this on the following systems:
68k running Version 7
Convex BSD4.3
4_51 UMIPS mips (under both SysV and BSD environments)
SunOS 4.1.1 2 sun3
Ultrix Worksystem V2.2 (Rev. 15) System #1
I have reports that it should work on AIX and BSD4.4, but my testers
have gone on vacation before I could get final confirmation from them.
This really was supposed to be a little program. Sigh. Anyway,
it comes with a man page, makefile, and files to configure, test,
and install it. Just unshar and type 'make test'. Type 'make
install' if that all works. Even if it doesn't work, it
should be entertaining. :-)
--tom
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# pt
# This archive created: Thu Jul 2 12:54:41 1992
export PATH; PATH=/bin:/usr/bin:$PATH
if test ! -d 'pt'
then
echo shar: "creating directory 'pt'"
mkdir 'pt'
fi
echo shar: "entering directory 'pt'"
cd 'pt'
echo shar: "extracting 'Makefile'" '(504 characters)'
if test -f 'Makefile'
then
echo shar: "will not over-write existing file 'Makefile'"
else
sed 's/^ X//' << \SHAR_EOF > 'Makefile'
XBIN=/usr/local/bin
XMAN=/usr/local/man/man1
XPROG=pt
X
X# it's really rude, but if i don't say this, it
X# assumes your current shell on some systems.
X# how brain dead can you get?
XSHELL=/bin/sh
X
X${PROG}: ${PROG}.pl Configure
X @perl Configure < ${PROG}.pl > test${PROG}
X @mv test${PROG} ${PROG}
X @chmod +x ${PROG}
X
Xtest: ${PROG}
X @perl Test
X
Xinstall: test
X perl Install ${MAN} ${BIN}
X
Xclean:
X rm -f ${PROG} core test getwin.c a.out
X
Xshar:
X shar pt.pl pt.1 README Makefile Configure Test Install > pt.shar
SHAR_EOF
if test 504 -ne "`wc -c < 'Makefile'`"
then
echo shar: "error transmitting 'Makefile'" '(should have been 504 characters)'
fi
chmod 664 'Makefile'
fi
echo shar: "extracting 'Configure'" '(4310 characters)'
if test -f 'Configure'
then
echo shar: "will not over-write existing file 'Configure'"
else
sed 's/^ X//' << \SHAR_EOF > 'Configure'
X
X$STD_PERL = '/usr/bin/perl';
X
Xselect(STDERR);
X
Xprint "Configuring pt...\n\n";
X
Xsub findpath {
X local($path);
X local($arg) = shift;
X for $dir (split(/:/,$ENV{'PATH'})) {
X if (-x "$dir/$arg" && -f _) {
X $path = "$dir/$arg";
X last;
X }
X }
X $path;
X}
X
X&getperl();
X
Xif ($path = &findpath('ps')) {
X $PS = $path;
X print "Your ps lives in $path.\n";
X} else {
X die "You don't have a ps on this system, bailing out";
X}
X
X$DEATH_STAR = 0;
X$FLAG_WIDTH = 0;
X
X$_ = `$PS l1 2>/dev/null`;
Xif ($?) {
X # maybe system V
X $_ = `$PS -ef -p 1 2>/dev/null`;
X if ($? == 0) {
X $DEATH_STAR = 1;
X print "You have a SysV-style ps; this may be boring.\n";
X } else {
X print "Your ps doesn't like either BSD or SysV syntax!\n";
X }
X} else {
X print "Congratulations, your ps groks BSD syntax.\n";
X
X if (/^\s*F/) {
X if (!/\n(\s*[a-f\d]+)/) {
X print "No flag width -- assuming 7\n";
X $FLAG_WIDTH = 7;
X } else {
X $FLAG_WIDTH = length($1);
X print "Your ps flags width appears to be $FLAG_WIDTH.\n";
X if (/F\s+S\s+UID/) {
X print "Your ps interposes STAT between FLAGS and UID\n";
X $early_stat++;
X }
X }
X } else {
X # bsd 4.4?
X print <<EOF;
XBut you have no ps flags; don't worry, you're
Xproabably better off that way.
XEOF
X }
X}
X
X$FIRST_SPLIT = $DEATH_STAR # cursed be
X ? '^\s*([\da-fA-F]+)\s+\S+\s+([\-\d]+)\s+(\d+)\s+(\d+)'
X : $FLAG_WIDTH
X ? $early_stat
X ? '^(\s*[\da-fA-F]+)\s*\w+\s*([\-\d]+)\s+(\d+)\s+(\d+)'
X : '^(\s*[\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)'
X : '^(\s*)([\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)';
X
Xprint "\n";
X
X$PROG = 'getwin.c';
X
Xopen(PROG, ">$PROG") || die "can't creat $PROG: $!";
Xprint PROG <<'EOF';
X#include <sys/ioctl.h>
Xmain() { printf("0x%08x\n", TIOCGWINSZ); }
XEOF
Xclose(PROG) || die "can't close $PROG: $!";
X
Xunless ($CC_PATH = &findpath('cc')) {
X print "No C compiler found, trying gcc\n";
X if ($CC_PATH = &getpath('gcc')) {
X print "What luck -- you have a gcc\n";
X } else {
X print "SNAFU: No C compiler -- guessing TIOCGWINSZ is 0x40087468\n";
X $TIOCGWINSZ = 0x40087468;
X if (ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
X ($rows, $cols) = unpack('S4', $winsize);
X if ($cols > 20 && $cols < 200) {
X print "Ok, TIOCGWINSZ seems ok as 0x40087468\n";
X $TIOCGWINSZ = '0x40087468';
X } else {
X print "TIOCGWINSZ doesn't seem to work, will grope environment\n";
X }
X }
X }
X} else {
X print "Your C compiler lives in $CC_PATH.\n";
X
X print "Testing for window-size awareness...";
X if (system("$CC_PATH getwin.c >/dev/null 2>&1") == 0) {
X print "done.\n";
X chop($TIOCGWINSZ = `./a.out`);
X print "Great -- your TIOCGWINSZ is $TIOCGWINSZ.\n";;
X } else {
X print "oops!\n";
X print "Bummer -- you have no TIOCGWINSZ!\n";
X $TIOCGWINSZ = 0;
X }
X
X unlink('a.out', $PROG);
X}
X
Xselect(STDOUT);
X
Xwhile (<>) {
X if (s/#\$\$#\s*//) {
X s/TIOCGWINSZ\s*=[^;]*/TIOCGWINSZ = $TIOCGWINSZ/o
X ||
X s/PS\s*=\s*\"[^"]*"/PS = "$PS"/o
X ||
X s/DEATH_STAR\s*=[^;]*/DEATH_STAR = $DEATH_STAR/o
X ||
X s/FLAG_WIDTH\s*=[^;]*/FLAG_WIDTH = $FLAG_WIDTH/o
X ||
X s/FIRST_SPLIT\s*=[^;]*/FIRST_SPLIT = '$FIRST_SPLIT'/o
X ;
X }
X print;
X}
Xclose(STDOUT) || die "can't close STDOUT: $!";
X
X
X
X
Xprint STDERR "\nDone with Configure.\n\n";
Xexit;
X
Xsub getperl {
X if (-e $STD_PERL && -f _ && -x _) { # stat, !lstat
X print <<EOF;
XGood, I see that perl lives in the standard place ($STD_PERL)
XEOF
X print "How 'bout I use that one, ok? [y] ";
X open(TTY, "</dev/tty") || die "can't open /dev/tty: $!";
X if (<TTY> !~ /^\s*n/i) {
X print STDOUT "#!$STD_PERL\n";
X print "\n";
X return;
X }
X print "Ok, fine, let's grope about your system then...\n";
X } else {
X $whine++;
X }
X
X if ($path = &findpath('perl')) {
X print "Your perl lives in $path.\n";
X print STDOUT "#!$path\n";
X $whine && print <<EOF;
X
XYou know, life would be easier if you just made $STD_PERL
Xa symlink to where it where it really lives.
XEOF
X } else {
X print <<EOF;
X
XWhat, no perl on your system? Then just who is running this script?
XOk, we'll configure up your script so it tries to find whatever perl is
Xin the user's path, something you don't seem to have.
X
XEOF
X print STDOUT <<'EOF';
X#!/bin/sh -- # wish we had a perl
Xeval "exec perl -S $0 $*"
X if $running_under_some_shell;
X
XEOF
X }
X print "\n";
X}
X
SHAR_EOF
if test 4310 -ne "`wc -c < 'Configure'`"
then
echo shar: "error transmitting 'Configure'" '(should have been 4310 characters)'
fi
chmod 664 'Configure'
fi
echo shar: "extracting 'pt.pl'" '(6202 characters)'
if test -f 'pt.pl'
then
echo shar: "will not over-write existing file 'pt.pl'"
else
sed 's/^ X//' << \SHAR_EOF > 'pt.pl'
X#
X# pt -- print process tree
X# Tom Christiansen <tch...@convex.com>
X# version 1.0, Tuesday Jun 30 18:29:49 CDT 1992
X#
X# Modification History
X# version 1.1, Wed Jul 1 14:58:54 CDT 1992
X# Chop long lines to winsize unless -w supplied
X# Add -a for all procs irrespective of platform
X# Changed parse bailout to warning
X# Added Configure script
X# Numerous hacks to deal with various braindead
X# vendors garbled ps output
X#
X#
X# run ps and display process hierarchy indented
X# under parents.
X#
X# Options:
X# [-l level] limits level of children printed
X# [-i indent] change indent level from default
X# [-w] allow lines to be as long as you want.
X#
X#
X
X
X# don't use require so that it runs on ancient versions of perl
X # require 'getopts.pl';
X $file = 'getopts.pl';
X $return = do $file;
X die "couldn't parse $file: $@" if $@;
X die "couldn't do $file: $!" unless defined $return;
X die "couldn't run $file" unless $return;
X
X$VERSION = '1.1';
X$AUTHOR = 'tch...@convex.com';
X
X$| = 1;
X
X#$$# $PS = "ps"; # a path to ps, usually /bin
X#$$# $TIOCGWINSZ = 0x40087468; # should be require sys/ioctl.ph
X#$$# $DEATH_STAR = 0; # ARGS: ps -el, not ps wwaxl
X#$$# $FLAG_WIDTH = 7;
X#$$# $FIRST_SPLIT = '^(\s*[\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)';
X
Xdie "Didn't you run Configure?"
X unless 4 == grep(defined,$PS,$TIOCGWINSZ,$DEATH_STAR,$FLAG_WIDTH);
X
X$indent = 2; # reset via -i switch
X
X$debug = 0;
X
X
X########################################################
X
Xif ($DEATH_STAR) {
X $PS_ARGS = "-l";
X $EVERYBODY = "e";
X} else {
X $PS_ARGS = "xlww";
X $EVERYBODY = "a";
X}
X
X########################################################
X
X$maxlevel = 10_000_000; # reset via -l switch
X
Xsub usage {
X local($msg) = shift;
X print STDERR "$0: $msg\n" if $msg;
X die <<EOF;
Xusage: $0 [-a] [-d] [-w] [ps args] [pid list]
X (version: $VERSION author: $AUTHOR)
X
X -w wide output (don't trunc at winsize)
X -a all processes, not just mine
X -d print out debugging information
XEOF
X}
X
X&Getopts('dl:i:wa') || &usage();
X
X$maxlevel = $opt_l if $opt_l;
X$indent = $opt_i if $opt_i;
X$wide = $opt_w;
X$debug = $opt_d;
X
Xwhile (defined($_ = shift)) { # curse pid 0
X if (/^(\d+)$/) {
X $pids{$1}++;
X $pids++; # needed for ancient perl, who can't do if %pids
X } else {
X $PS_ARGS .= "$_ ";
X }
X}
X
X$wide || &getwin;
X
X$PS_ARGS =~ s/^(-?)/${1}${EVERYBODY}/ if $pids || $opt_a;
X
X$ps = "$PS $PS_ARGS";
X
Xprint "opening pipe to $ps\n" if $debug;
X
Xopen(PS, "$ps |") || die "can't fork: $!";
X<PS>; # header
X
Xprintf("%-8s %5s %8s %7s %s\n", 'USER', "PID", "TTY", "TIME","COMMAND");
X
Xwhile (<PS>) {
X ($flags, $uid, $pid, $ppid) = /$FIRST_SPLIT/o;
X ($tty, $time, $secs, $command) = /(\S+)\s*(\d+:\d+(\.\d\d)?)\s+(.*)/;
X
X unless (grep(defined,$uid,$pid,$ppid,$tty,$time,$command) == 6) {
X warn "skipping unparsable line from ps:\n$_";
X $oops++;
X next;
X }
X
X if ($debug) {
X print <<EOF;
Xflags are <$flags>, uid is <$uid>, pid is <$pid>, ppid is <$ppid>
Xtty is <$tty>, time is <$time>, command is <$command>
X
XEOF
X }
X
X # incredibly disgusting hack should FLAGS and UID collide
X # why oh why must vendors be so damn sysadmin-hostile?
X # don't they understand we have to parse this stuff??
X # maybe should try $flags =~ /^\s/ here as well?
X # i give no guarantees that this works.
X if (!$DEATH_STAR && length($flags) > $FLAG_WIDTH &&
X (($ppid == 0 && $pid > 10 && $uid)
X ||
X length($flags) > 2+$FLAG_WIDTH))
X {
X print "hack 1\n" if $debug;
X $ppid = $pid;
X $pid = $uid;
X $uid = substr($flags,
X $FLAG_WIDTH + 1 - (substr($flags,0,1) eq ' ' ||
X length($flags > $FLAG_WIDTH + 2)),
X 10);
X substr($flags, -length($uid), 10) = '';
X
X # hold on to your lunch, folks...
X if (!defined $id{$uid}) {
X $extra = substr($flags,-1,1);
X $uid = $extra . $uid if defined $id{$extra.$uid};
X }
X }
X
X # stupid hack should PPID and CP collide
X if ($ppid > 32_000 && $pid < 32_000) {
X print "hack 2\n" if $debug;
X $ppid = substr($ppid,0,length($pid));
X }
X
X # stupid hack should TT and TIME collide
X if (length($tty) > 2 && $tty =~ /:/) {
X print "hack 3\n" if $debug;
X $time = substr($tty, 2, 10) . $time;
X $tty = substr($tty,0,2);
X }
X
X $lines{$pid} = sprintf("%-8s %5d %8s %7s#%s\n",
X &id($uid), $pid, $tty, $time, $command);
X unless ($pid == $ppid) {
X $parent{$pid} = $ppid;
X $children{$ppid} .= "$pid ";
X }
X}
Xif (!close(PS)) {
X warn "\"$ps\" exited badly!\n";
X $oops++;
X}
X
X@pids = keys %pids;
Xif (@pids) {
X foreach $pid (@pids) {
X &save_the_children($pid);
X &save_our_parent($pid);
X }
X %lines = %nlines;
X}
X
Xsub bynum { $a - $b; }
X
X# find the heads of the chains...
X@pids = grep(!defined $lines{$parent{$_}},keys %lines);
X
Xfor $pid (sort bynum @pids) {
X &children($pid);
X}
X
Xexit($oops != 0);
X
Xsub children {
X local($pid) = $_[0];
X local($_) = $lines{$pid};
X substr($_, index($_, '#'), 1) = ' ' x (1+ $indent * $level);
X if (!$wide && length() > $cols) {
X substr($_, $cols, 10_000) = "\n";
X }
X print;
X if ($level++ < $maxlevel) {
X local(@kids) = split(' ',$children{$pid});
X for $pid (@kids) {
X &children($pid);
X }
X }
X $level--;
X}
X
Xsub id {
X local($id) = shift;
X $id{$id} = (getpwuid($id))[0] || "($id)" unless defined $id{$id};
X $id{$id};
X}
X
Xsub save_the_children {
X local($parent) = shift;
X foreach $kid (split(' ',$children{$parent})) {
X &save_the_children($kid);
X }
X &keepline($parent);
X}
X
Xsub save_our_parent {
X local($kid) = shift;
X local($dad) = $parent{$kid};
X
X &keepline($kid);
X
X if ($dad || $dad eq '0') { # beware $dad == 0
X &save_our_parent($dad);
X }
X}
X
Xsub keepline {
X $nlines{$_[0]} = $lines{$_[0]}
X unless defined $nlines{$_[0]};
X}
X
X
Xsub getwin {
X local($winsize);
X # is someone can get SS_DC_TIOCSWINSZ on MIPS working, tell me
X if ($TIOCGWINSZ && ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
X ($rows, $cols) = unpack('S4', $winsize);
X } else {
X $cols = $ENV{'COLUMNS'} || ($ENV{'TERMCAP'} =~ /:co#(\d+):/)[0];
X }
X $cols = 80 unless $cols;
X print "cols are $cols\n" if $debug;
X}
SHAR_EOF
if test 6202 -ne "`wc -c < 'pt.pl'`"
then
echo shar: "error transmitting 'pt.pl'" '(should have been 6202 characters)'
fi
chmod 664 'pt.pl'
fi
echo shar: "extracting 'Test'" '(1838 characters)'
if test -f 'Test'
then
echo shar: "will not over-write existing file 'Test'"
else
sed 's/^ X//' << \SHAR_EOF > 'Test'
X
X$user = (getpwuid($>))[0];
X
X$PT = './pt';
X
X$| = 1;
X
Xprint <<EOF;
XRunning tests for pt..
X
XShould anything fail, this make will abort.
Xif it doesn't look right, just hit ^C.
X
XEOF
X
X&cr;
X
Xprint "First, I'll run pt on just your processes:\n\n";
X
X&run($PT);
Xwhile(<PT>) {
X print;
X &test1;
X}
X&ran;
X&result1;
X&cr;
X
Xprint <<EOF;
XOk, next test: run pt on just this process, tracing back to the root:
X
XEOF
X
X&run ("$PT $$");
X
Xwhile (<PT>) {
X print;
X &test2;
X}
X&ran;
X
X&result2;
X
X&cr;
X
Xprint "\nNow for all processes:\n\n";
X
X&run("$PT -a");
X
X$init = $sawme = $warned = $sawpt = 0;
X
Xwhile (<PT>) {
X print;
X &test3;
X}
X&ran;
X&result3;
X
X
Xsystem("touch ./test") && die "can't touch \"test\" semaphore file: $!";
X
Xprint "\nLooks good, now go for the install!\n";
X
Xsub run {
X $Args = shift;
X print "$ $Args\n";
X open(PT, "$Args |") || die "couldn't fork: $!";
X}
X
Xsub ran {
X die "\"$Args\" exited badly: $!" unless close(PT);
X}
X
Xsub cr {
X print "\nHit <CR> to continue, ^C to abort: ";
X <STDIN>;
X print "\n";
X}
X
Xsub more {
X print "$_[0]; continue? [n] ";
X exit 1 unless <STDIN> =~ /^\s*y/i;
X}
X
Xsub test1 {
X $sawpt += /pt/;
X $sawme += /\b$user\b/i;
X if (/^\(\d+\)/ && !$warned++) {
X @pw = getpwuid($1);
X if ($pw[0]) {
X &more("Hmmm, uid $1 didn't convert to $pw[0]");
X } else {
X print "Oops, you don't have a uid $1 here\n";
X &more("Maybe the ps line is mangled;");
X }
X }
X}
X
Xsub test2 {
X $init += /^\w+\s+1\b.+\binit\b/;
X}
X
Xsub result1 {
X &more("Your uid should have appeared here") unless $sawme;
X &more("The pt program should have appeared here") unless $sawpt;
X}
X
Xsub result2 {
X &more("Didn't see init (process 1)") unless $init;
X &more("Saw init $init times") if $init > 1;
X}
X
Xsub test3 {
X &test1;
X &test2;
X}
X
Xsub result3 {
X &result1;
X &result2;
X}
SHAR_EOF
if test 1838 -ne "`wc -c < 'Test'`"
then
echo shar: "error transmitting 'Test'" '(should have been 1838 characters)'
fi
chmod 664 'Test'
fi
echo shar: "extracting 'pt.shar'" '(20659 characters)'
if test -f 'pt.shar'
then
echo shar: "will not over-write existing file 'pt.shar'"
else
sed 's/^ X//' << \SHAR_EOF > 'pt.shar'
X#! /bin/sh
X# This is a shell archive, meaning:
X# 1. Remove everything above the #! /bin/sh line.
X# 2. Save the resulting text in a file.
X# 3. Execute the file with /bin/sh (not csh) to create:
X# pt.pl
X# pt.1
X# README
X# Makefile
X# Configure
X# Test
X# Install
X# This archive created: Thu Jul 2 12:44:40 1992
Xexport PATH; PATH=/bin:/usr/bin:$PATH
Xif test -f 'pt.pl'
Xthen
X echo shar: "will not over-write existing file 'pt.pl'"
Xelse
Xcat << \SHAR_EOF > 'pt.pl'
X#
X# pt -- print process tree
X# Tom Christiansen <tch...@convex.com>
X# version 1.0, Tuesday Jun 30 18:29:49 CDT 1992
X#
X# Modification History
X# version 1.1, Wed Jul 1 14:58:54 CDT 1992
X# Chop long lines to winsize unless -w supplied
X# Add -a for all procs irrespective of platform
X# Changed parse bailout to warning
X# Added Configure script
X# Numerous hacks to deal with various braindead
X# vendors garbled ps output
X#
X#
X# run ps and display process hierarchy indented
X# under parents.
X#
X# Options:
X# [-l level] limits level of children printed
X# [-i indent] change indent level from default
X# [-w] allow lines to be as long as you want.
X#
X#
X
X
X# don't use require so that it runs on ancient versions of perl
X # require 'getopts.pl';
X $file = 'getopts.pl';
X $return = do $file;
X die "couldn't parse $file: $@" if $@;
X die "couldn't do $file: $!" unless defined $return;
X die "couldn't run $file" unless $return;
X
X$VERSION = '1.1';
X$AUTHOR = 'tch...@convex.com';
X
X$| = 1;
X
X#$$# $PS = "ps"; # a path to ps, usually /bin
X#$$# $TIOCGWINSZ = 0x40087468; # should be require sys/ioctl.ph
X#$$# $DEATH_STAR = 0; # ARGS: ps -el, not ps wwaxl
X#$$# $FLAG_WIDTH = 7;
X#$$# $FIRST_SPLIT = '^(\s*[\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)';
X
Xdie "Didn't you run Configure?"
X unless 4 == grep(defined,$PS,$TIOCGWINSZ,$DEATH_STAR,$FLAG_WIDTH);
X
X$indent = 2; # reset via -i switch
X
X$debug = 0;
X
X
X########################################################
X
Xif ($DEATH_STAR) {
X $PS_ARGS = "-l";
X $EVERYBODY = "e";
X} else {
X $PS_ARGS = "xlww";
X $EVERYBODY = "a";
X}
X
X########################################################
X
X$maxlevel = 10_000_000; # reset via -l switch
X
Xsub usage {
X local($msg) = shift;
X print STDERR "$0: $msg\n" if $msg;
X die <<EOF;
Xusage: $0 [-a] [-d] [-w] [ps args] [pid list]
X (version: $VERSION author: $AUTHOR)
X
X -w wide output (don't trunc at winsize)
X -a all processes, not just mine
X -d print out debugging information
XEOF
X}
X
X&Getopts('dl:i:wa') || &usage();
X
X$maxlevel = $opt_l if $opt_l;
X$indent = $opt_i if $opt_i;
X$wide = $opt_w;
X$debug = $opt_d;
X
Xwhile (defined($_ = shift)) { # curse pid 0
X if (/^(\d+)$/) {
X $pids{$1}++;
X $pids++; # needed for ancient perl, who can't do if %pids
X } else {
X $PS_ARGS .= "$_ ";
X }
X}
X
X$wide || &getwin;
X
X$PS_ARGS =~ s/^(-?)/${1}${EVERYBODY}/ if $pids || $opt_a;
X
X$ps = "$PS $PS_ARGS";
X
Xprint "opening pipe to $ps\n" if $debug;
X
Xopen(PS, "$ps |") || die "can't fork: $!";
X<PS>; # header
X
Xprintf("%-8s %5s %8s %7s %s\n", 'USER', "PID", "TTY", "TIME","COMMAND");
X
Xwhile (<PS>) {
X ($flags, $uid, $pid, $ppid) = /$FIRST_SPLIT/o;
X ($tty, $time, $secs, $command) = /(\S+)\s*(\d+:\d+(\.\d\d)?)\s+(.*)/;
X
X unless (grep(defined,$uid,$pid,$ppid,$tty,$time,$command) == 6) {
X warn "skipping unparsable line from ps:\n$_";
X $oops++;
X next;
X }
X
X if ($debug) {
X print <<EOF;
Xflags are <$flags>, uid is <$uid>, pid is <$pid>, ppid is <$ppid>
Xtty is <$tty>, time is <$time>, command is <$command>
X
XEOF
X }
X
X # incredibly disgusting hack should FLAGS and UID collide
X # why oh why must vendors be so damn sysadmin-hostile?
X # don't they understand we have to parse this stuff??
X # maybe should try $flags =~ /^\s/ here as well?
X # i give no guarantees that this works.
X if (!$DEATH_STAR && length($flags) > $FLAG_WIDTH &&
X (($ppid == 0 && $pid > 10 && $uid)
X ||
X length($flags) > 2+$FLAG_WIDTH))
X {
X print "hack 1\n" if $debug;
X $ppid = $pid;
X $pid = $uid;
X $uid = substr($flags,
X $FLAG_WIDTH + 1 - (substr($flags,0,1) eq ' ' ||
X length($flags > $FLAG_WIDTH + 2)),
X 10);
X substr($flags, -length($uid), 10) = '';
X
X # hold on to your lunch, folks...
X if (!defined $id{$uid}) {
X $extra = substr($flags,-1,1);
X $uid = $extra . $uid if defined $id{$extra.$uid};
X }
X }
X
X # stupid hack should PPID and CP collide
X if ($ppid > 32_000 && $pid < 32_000) {
X print "hack 2\n" if $debug;
X $ppid = substr($ppid,0,length($pid));
X }
X
X # stupid hack should TT and TIME collide
X if (length($tty) > 2 && $tty =~ /:/) {
X print "hack 3\n" if $debug;
X $time = substr($tty, 2, 10) . $time;
X $tty = substr($tty,0,2);
X }
X
X $lines{$pid} = sprintf("%-8s %5d %8s %7s#%s\n",
X &id($uid), $pid, $tty, $time, $command);
X unless ($pid == $ppid) {
X $parent{$pid} = $ppid;
X $children{$ppid} .= "$pid ";
X }
X}
Xif (!close(PS)) {
X warn "\"$ps\" exited badly!\n";
X $oops++;
X}
X
X@pids = keys %pids;
Xif (@pids) {
X foreach $pid (@pids) {
X &save_the_children($pid);
X &save_our_parent($pid);
X }
X %lines = %nlines;
X}
X
Xsub bynum { $a - $b; }
X
X# find the heads of the chains...
X@pids = grep(!defined $lines{$parent{$_}},keys %lines);
X
Xfor $pid (sort bynum @pids) {
X &children($pid);
X}
X
Xexit($oops != 0);
X
Xsub children {
X local($pid) = $_[0];
X local($_) = $lines{$pid};
X substr($_, index($_, '#'), 1) = ' ' x (1+ $indent * $level);
X if (!$wide && length() > $cols) {
X substr($_, $cols, 10_000) = "\n";
X }
X print;
X if ($level++ < $maxlevel) {
X local(@kids) = split(' ',$children{$pid});
X for $pid (@kids) {
X &children($pid);
X }
X }
X $level--;
X}
X
Xsub id {
X local($id) = shift;
X $id{$id} = (getpwuid($id))[0] || "($id)" unless defined $id{$id};
X $id{$id};
X}
X
Xsub save_the_children {
X local($parent) = shift;
X foreach $kid (split(' ',$children{$parent})) {
X &save_the_children($kid);
X }
X &keepline($parent);
X}
X
Xsub save_our_parent {
X local($kid) = shift;
X local($dad) = $parent{$kid};
X
X &keepline($kid);
X
X if ($dad || $dad eq '0') { # beware $dad == 0
X &save_our_parent($dad);
X }
X}
X
Xsub keepline {
X $nlines{$_[0]} = $lines{$_[0]}
X unless defined $nlines{$_[0]};
X}
X
X
Xsub getwin {
X local($winsize);
X # is someone can get SS_DC_TIOCSWINSZ on MIPS working, tell me
X if ($TIOCGWINSZ && ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
X ($rows, $cols) = unpack('S4', $winsize);
X } else {
X $cols = $ENV{'COLUMNS'} || ($ENV{'TERMCAP'} =~ /:co#(\d+):/)[0];
X }
X $cols = 80 unless $cols;
X print "cols are $cols\n" if $debug;
X}
XSHAR_EOF
Xfi
Xif test -f 'pt.1'
Xthen
X echo shar: "will not over-write existing file 'pt.1'"
Xelse
Xcat << \SHAR_EOF > 'pt.1'
X.TH PT 1L local
X.de M \" man page reference
X\\fI\\$1\\fR\\|(\\$2\)\\$3
X..
X.de T \" switch to typewriter font
X.ft TA \" probably want CW if you don't have TA font
X..
X.\"
X.de TY \" put $1 in typewriter font
X.if t .T
X.if n ``\c
X\\$1\c
X.if t .ft P
X.if n \&''\c
X\\$2
X..
X.SH NAME
Xpt \- postprocess ps output into hierarchical form
X.SH SYNOPSIS
X.B pt
X[
X.B \-a
X]
X[
X.B \-w
X]
X[
X.I "ps args"
X]
X[
X.I "pid list"
X]
X.SH "DESCRIPTION"
XThe
X.I pt
Xprogram is a
X.I perl
Xfront end to
X.I ps
Xthat
Xdisplays a
X.I ps
Xlisting with processes arranged in a tree format. That is,
Xprocesses are listed under their parents, indented to the right.
X.PP
XFor example:
X.sp
X.nf
X.na
XUSER PID TTY TIME COMMAND
Xtchrist 9341 p3 1:02 -tcsh
Xtchrist 10423 p3 0:11 vi pt.pl
Xtchrist 27045 p3 0:00 vi pt
Xtchrist 28371 p3 0:04 trn
Xtchrist 29366 p3 0:00 /bin/sh -c Pnews -h /mnt/tchris
Xtchrist 29367 p3 0:00 sh /usr/local/bin/Pnews -h /m
Xtchrist 29394 p3 0:00 perl sigspell
Xtchrist 29395 p3 0:00 vi /mnt/tchrist/.article
Xtchrist 29080 p3 0:01 vi pt.1
Xtchrist 29831 p3 0:00 sh -c ./pt
Xtchrist 29833 p3 0:00 perl ./pt
Xtchrist 29834 p3 0:00 /bin/ps xlww
Xtchrist 9361 p3 0:08 monthd -i5
Xtchrist 9500 pb 0:30 -tcsh
Xtchrist 23345 pb 0:18 perl plum
Xtchrist 29726 pb 0:00 perl now-what
Xtchrist 29729 pb 0:00 perl sigspell
Xtchrist 29734 pb 0:00 vi /mnt/tchrist/Mail/drafts
Xtchrist 9522 p3 23:59 perl newsclip 07/02/92 09:15
Xtchrist 9527 p3 0:07 perl pmeter
Xtchrist 19660 q9 0:47 perl sigrand
X.fi
X.ad
X.PP
XThe first listed process is the shell, and all those
Xindented under it are its direct children.
XThus
X.I
XPnews is a child of
X.IR trn ,
Xwhich itself has several children of its own.
X.PP
XNormally,
X.I pt
Xwill truncate at the width of your screen. The
X.B \-w
Xoption will allow output as wide as
X.I ps
Xreturns.
X.PP
XTo list all processes, use the
X.B \-a
Xoption, even if your system expects to pass
X.I ps
Xsomething other than an
X.B a
Xflag;
X.I pt
Xshould know to pass the appropriate flag to ps.
X.PP
XYou can also pass
X.I pt
Xa list of pids to restrict output to those process
Xtrees contains those pids. Any processes below the named
Xpids will be listed in full. Those above will be listed
Xonly if they are direct ancestors. For example (reading
Xthis output in from the editor):
X.sp
X.nf
X.na
X:r!pt $$
XUSER PID TTY TIME COMMAND
Xroot 0 ? 0:00 swapout
Xroot 1 ? 1:53 init
Xroot 9339 ? 8:26 xterm -display 130.168.190.14:0
Xtchrist 9341 p3 1:02 -tcsh
Xtchrist 29080 p3 0:05 vi pt.1
Xtchrist 731 p3 0:00 sh -c ./pt $$
Xtchrist 732 p3 0:00 perl ./pt 731
Xtchrist 733 p3 0:02 /bin/ps axlww
X.fi
X.ad
X.sp
XThis allows you to trace both parents and children of a given process.
X.SH "RETURN VALUE"
X.I pt
Xwill exit with a value of 1
Xif it encounteres difficulty parsing the output of
X.I ps
Xor if
X.I ps
Xshould itself exit non-zero.
X.SH ENVIRONMENT
XIn order to truncate at your current window size,
X.I pt
Xwill use the
X.B TIOCGWINSZ
X.I ioctl(2)
Xif supported on your system. Otherwise, it consults
Xyour environment for either a
X.B COLUMNS
Xvariable, or else checks your current
X.B TERMCAP
Xvariable for a
X.B ":co:"
Xentry.
X.SH "FILES"
Xgetopts.pl\h'|2i'perl getopts library
X.SH "SEE ALSO"
X.M ps 1 ,
X.M pstat 1 ,
X.M perl 1 .
X.SH NOTES
XThe
X.I pt
Xdistribution
Xcomes with a
X.I Makefile
Xand a
X.I Configure
Xscript that should be used to properly select what
Xform of
X.I ps
Xyou're using, paths, etc.
X.SH DIAGNOSTICS
X.TY "skipping unparsable line from ps:\en%s"
X.in +5n
X.br
XThis means that
X.I ps
Xoutput a line which
X.I pt
Xcouldn't make heads or tails of (probably tails).
X.in -5n
X.sp
X.TY "ps exited badly!"
X.in +5n
X.I ps
Xreturned a non-zero exit status.
X.in -5n
X.sp
X.TY "couldn't parse getopts.pl: %s"
X.br
X.TY "couldn't do getopts.pl: %s"
X.br
X.TY "couldn't run getopts.pl: %s"
X.br
X.in +5n
XAll these mean the getopts library couldn't be loaded.
XAn appropriate message should be printed.
X.sp
X.in -5n
X.TY "Didn't you run Configure?"
X.in +5n
XYou are running a raw version of
X.I pt
Xthat hasn't been configured yet.
X.sp
X.in -5n
X.TY "can't fork: %s at line %d of pt"
X.in +5n
X.I pt
Xwas unable to fork a child of itself
Xto run
X.I ps
Xwith.
X.br
X.in -5n
X.SH BUGS
X.I pt
Xis at the mercy of your
X.I ps
Xcommand, and it would appear that very few vendors
Xmake any effort to produce output that can be parsed
Xby humans or computers.
X.I pt
Xtherefore undergoes numerous convolutions to try to
Xdemangle braindead
X.I ps
Xoutput.
XIt is not always successful. File a bug report with
Xyour vendor is your
X.I ps
Xfields ever run together \(em it's a real pain.
X.PP
XThe
X.B \-d
Xoption prints out debugging information which may
Xhelp you diagnose difficulties you may be encountering.
X.SH AUTHOR
XTom Christiansen <tch...@convex.com>,
XJuly 2nd, 1992.
XSHAR_EOF
Xfi
Xif test -f 'README'
Xthen
X echo shar: "will not over-write existing file 'README'"
Xelse
Xcat << \SHAR_EOF > 'README'
XThis really ought to work right out of the box now.
XUnshar, type 'make test' and watch. If that works,
Xgo for 'make install'.
X
XThe Configure script should be smarter now, but I've
Xintroduced a lot of gratuitous hacks because most
Xvendors, especially the ones with the workstations on
Xour desks.
X
XIf this DOESN'T work for you, please tell me the
Xfollowing things:
X
X type of hardware
X operating system version
X perl version
X ps axlww or ps -aefl output
X
X
X--tom
XSHAR_EOF
Xfi
Xif test -f 'Makefile'
Xthen
X echo shar: "will not over-write existing file 'Makefile'"
Xelse
Xcat << \SHAR_EOF > 'Makefile'
XBIN=/usr/local/bin
XMAN=/usr/local/man/man1
XPROG=pt
X
X# it's really rude, but if i don't say this, it
X# assumes your current shell on some systems.
X# how brain dead can you get?
XSHELL=/bin/sh
X
X${PROG}: ${PROG}.pl Configure
X @perl Configure < ${PROG}.pl > test${PROG}
X @mv test${PROG} ${PROG}
X @chmod +x ${PROG}
X
Xtest: ${PROG}
X @perl Test
X
Xinstall: test
X perl Install ${MAN} ${BIN}
X
Xclean:
X rm -f ${PROG} core test getwin.c a.out
X
Xshar:
X shar pt.pl pt.1 README Makefile Configure Test Install > pt.shar
XSHAR_EOF
Xfi
Xif test -f 'Configure'
Xthen
X echo shar: "will not over-write existing file 'Configure'"
Xelse
Xcat << \SHAR_EOF > 'Configure'
X
X$STD_PERL = '/usr/bin/perl';
X
Xselect(STDERR);
X
Xprint "Configuring pt...\n\n";
X
Xsub findpath {
X local($path);
X local($arg) = shift;
X for $dir (split(/:/,$ENV{'PATH'})) {
X if (-x "$dir/$arg" && -f _) {
X $path = "$dir/$arg";
X last;
X }
X }
X $path;
X}
X
X&getperl();
X
Xif ($path = &findpath('ps')) {
X $PS = $path;
X print "Your ps lives in $path.\n";
X} else {
X die "You don't have a ps on this system, bailing out";
X}
X
X$DEATH_STAR = 0;
X$FLAG_WIDTH = 0;
X
X$_ = `$PS l1 2>/dev/null`;
Xif ($?) {
X # maybe system V
X $_ = `$PS -ef -p 1 2>/dev/null`;
X if ($? == 0) {
X $DEATH_STAR = 1;
X print "You have a SysV-style ps; this may be boring.\n";
X } else {
X print "Your ps doesn't like either BSD or SysV syntax!\n";
X }
X} else {
X print "Congratulations, your ps groks BSD syntax.\n";
X
X if (/^\s*F/) {
X if (!/\n(\s*[a-f\d]+)/) {
X print "No flag width -- assuming 7\n";
X $FLAG_WIDTH = 7;
X } else {
X $FLAG_WIDTH = length($1);
X print "Your ps flags width appears to be $FLAG_WIDTH.\n";
X if (/F\s+S\s+UID/) {
X print "Your ps interposes STAT between FLAGS and UID\n";
X $early_stat++;
X }
X }
X } else {
X # bsd 4.4?
X print <<EOF;
XBut you have no ps flags; don't worry, you're
Xproabably better off that way.
XEOF
X }
X}
X
X$FIRST_SPLIT = $DEATH_STAR # cursed be
X ? '^\s*([\da-fA-F]+)\s+\S+\s+([\-\d]+)\s+(\d+)\s+(\d+)'
X : $FLAG_WIDTH
X ? $early_stat
X ? '^(\s*[\da-fA-F]+)\s*\w+\s*([\-\d]+)\s+(\d+)\s+(\d+)'
X : '^(\s*[\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)'
X : '^(\s*)([\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)';
X
Xprint "\n";
X
X$PROG = 'getwin.c';
X
Xopen(PROG, ">$PROG") || die "can't creat $PROG: $!";
Xprint PROG <<'EOF';
X#include <sys/ioctl.h>
Xmain() { printf("0x%08x\n", TIOCGWINSZ); }
XEOF
Xclose(PROG) || die "can't close $PROG: $!";
X
Xunless ($CC_PATH = &findpath('cc')) {
X print "No C compiler found, trying gcc\n";
X if ($CC_PATH = &getpath('gcc')) {
X print "What luck -- you have a gcc\n";
X } else {
X print "SNAFU: No C compiler -- guessing TIOCGWINSZ is 0x40087468\n";
X $TIOCGWINSZ = 0x40087468;
X if (ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
X ($rows, $cols) = unpack('S4', $winsize);
X if ($cols > 20 && $cols < 200) {
X print "Ok, TIOCGWINSZ seems ok as 0x40087468\n";
X $TIOCGWINSZ = '0x40087468';
X } else {
X print "TIOCGWINSZ doesn't seem to work, will grope environment\n";
X }
X }
X }
X} else {
X print "Your C compiler lives in $CC_PATH.\n";
X
X print "Testing for window-size awareness...";
X if (system("$CC_PATH getwin.c >/dev/null 2>&1") == 0) {
X print "done.\n";
X chop($TIOCGWINSZ = `./a.out`);
X print "Great -- your TIOCGWINSZ is $TIOCGWINSZ.\n";;
X } else {
X print "oops!\n";
X print "Bummer -- you have no TIOCGWINSZ!\n";
X $TIOCGWINSZ = 0;
X }
X
X unlink('a.out', $PROG);
X}
X
Xselect(STDOUT);
X
Xwhile (<>) {
X if (s/#\$\$#\s*//) {
X s/TIOCGWINSZ\s*=[^;]*/TIOCGWINSZ = $TIOCGWINSZ/o
X ||
X s/PS\s*=\s*\"[^"]*"/PS = "$PS"/o
X ||
X s/DEATH_STAR\s*=[^;]*/DEATH_STAR = $DEATH_STAR/o
X ||
X s/FLAG_WIDTH\s*=[^;]*/FLAG_WIDTH = $FLAG_WIDTH/o
X ||
X s/FIRST_SPLIT\s*=[^;]*/FIRST_SPLIT = '$FIRST_SPLIT'/o
X ;
X }
X print;
X}
Xclose(STDOUT) || die "can't close STDOUT: $!";
X
X
X
X
Xprint STDERR "\nDone with Configure.\n\n";
Xexit;
X
Xsub getperl {
X if (-e $STD_PERL && -f _ && -x _) { # stat, !lstat
X print <<EOF;
XGood, I see that perl lives in the standard place ($STD_PERL)
XEOF
X print "How 'bout I use that one, ok? [y] ";
X open(TTY, "</dev/tty") || die "can't open /dev/tty: $!";
X if (<TTY> !~ /^\s*n/i) {
X print STDOUT "#!$STD_PERL\n";
X print "\n";
X return;
X }
X print "Ok, fine, let's grope about your system then...\n";
X } else {
X $whine++;
X }
X
X if ($path = &findpath('perl')) {
X print "Your perl lives in $path.\n";
X print STDOUT "#!$path\n";
X $whine && print <<EOF;
X
XYou know, life would be easier if you just made $STD_PERL
Xa symlink to where it where it really lives.
XEOF
X } else {
X print <<EOF;
X
XWhat, no perl on your system? Then just who is running this script?
XOk, we'll configure up your script so it tries to find whatever perl is
Xin the user's path, something you don't seem to have.
X
XEOF
X print STDOUT <<'EOF';
X#!/bin/sh -- # wish we had a perl
Xeval "exec perl -S $0 $*"
X if $running_under_some_shell;
X
XEOF
X }
X print "\n";
X}
X
XSHAR_EOF
Xfi
Xif test -f 'Test'
Xthen
X echo shar: "will not over-write existing file 'Test'"
Xelse
Xcat << \SHAR_EOF > 'Test'
X
X$user = (getpwuid($>))[0];
X
X$PT = './pt';
X
X$| = 1;
X
Xprint <<EOF;
XRunning tests for pt..
X
XShould anything fail, this make will abort.
Xif it doesn't look right, just hit ^C.
X
XEOF
X
X&cr;
X
Xprint "First, I'll run pt on just your processes:\n\n";
X
X&run($PT);
Xwhile(<PT>) {
X print;
X &test1;
X}
X&ran;
X&result1;
X&cr;
X
Xprint <<EOF;
XOk, next test: run pt on just this process, tracing back to the root:
X
XEOF
X
X&run ("$PT $$");
X
Xwhile (<PT>) {
X print;
X &test2;
X}
X&ran;
X
X&result2;
X
X&cr;
X
Xprint "\nNow for all processes:\n\n";
X
X&run("$PT -a");
X
X$init = $sawme = $warned = $sawpt = 0;
X
Xwhile (<PT>) {
X print;
X &test3;
X}
X&ran;
X&result3;
X
X
Xsystem("touch ./test") && die "can't touch \"test\" semaphore file: $!";
X
Xprint "\nLooks good, now go for the install!\n";
X
Xsub run {
X $Args = shift;
X print "$ $Args\n";
X open(PT, "$Args |") || die "couldn't fork: $!";
X}
X
Xsub ran {
X die "\"$Args\" exited badly: $!" unless close(PT);
X}
X
Xsub cr {
X print "\nHit <CR> to continue, ^C to abort: ";
X <STDIN>;
X print "\n";
X}
X
Xsub more {
X print "$_[0]; continue? [n] ";
X exit 1 unless <STDIN> =~ /^\s*y/i;
X}
X
Xsub test1 {
X $sawpt += /pt/;
X $sawme += /\b$user\b/i;
X if (/^\(\d+\)/ && !$warned++) {
X @pw = getpwuid($1);
X if ($pw[0]) {
X &more("Hmmm, uid $1 didn't convert to $pw[0]");
X } else {
X print "Oops, you don't have a uid $1 here\n";
X &more("Maybe the ps line is mangled;");
X }
X }
X}
X
Xsub test2 {
X $init += /^\w+\s+1\b.+\binit\b/;
X}
X
Xsub result1 {
X &more("Your uid should have appeared here") unless $sawme;
X &more("The pt program should have appeared here") unless $sawpt;
X}
X
Xsub result2 {
X &more("Didn't see init (process 1)") unless $init;
X &more("Saw init $init times") if $init > 1;
X}
X
Xsub test3 {
X &test1;
X &test2;
X}
X
Xsub result3 {
X &result1;
X &result2;
X}
XSHAR_EOF
Xfi
Xif test -f 'Install'
Xthen
X echo shar: "will not over-write existing file 'Install'"
Xelse
Xcat << \SHAR_EOF > 'Install'
X($defman, $defbin) = @ARGV;
X
X$mdir = &finddir($defman,
X '/usr/local/man/man1', '/usr/man/local/man1',
X '/usr/man/man.L', '/usr/man/manl',
X '/usr/man/mann', '/usr/man/u_man/man1', '/usr/man/man1'
X );
X
Xprint "\nWhat directory would you like your man page in?\n\t[$mdir] ";
X
Xchop($dir = <STDIN>);
X$dir = $mdir if $dir =~ /^\s*$/;
Xif (-d $dir) {
X ($suffix) = ($dir =~ m#man([^/]+$)#);
X $mpage = "$dir/pt.$suffix";
X} else {
X die "$dir: not a directory";
X}
X
X&run("cp pt.1 $mpage");
X
X$bin = &finddir($defbin, '/usr/local/scripts', '/usr/local/bin',
X split(':', $ENV{'PATH'}));
X
Xprint "\nWhat directory would you like your script in?\n\t[$bin] ";
X
Xchop($hisbin = <STDIN>);
X
X$bin = $hisbin unless $hisbin eq '';
X
Xchmod (0755, 'pt');
X&run("cp pt $bin");
X
Xsub finddir {
X for $dir (@_) {
X next if $dir eq '';
X return $dir if -d $dir;
X }
X '';
X}
X
Xsub run {
X local($cmd) = shift;
X print "\n$ $cmd\n";
X system($cmd) && die;
X}
XSHAR_EOF
Xfi
Xexit 0
X# End of shell archive
SHAR_EOF
if test 20659 -ne "`wc -c < 'pt.shar'`"
then
echo shar: "error transmitting 'pt.shar'" '(should have been 20659 characters)'
fi
chmod 664 'pt.shar'
fi
echo shar: "extracting 'README'" '(477 characters)'
if test -f 'README'
then
echo shar: "will not over-write existing file 'README'"
else
sed 's/^ X//' << \SHAR_EOF > 'README'
XThis really ought to work right out of the box now.
XUnshar, type 'make test' and watch. If that works,
Xgo for 'make install'.
X
XThe Configure script should be smarter now, but I've
Xintroduced a lot of gratuitous hacks because most
Xvendors, especially the ones with the workstations on
Xour desks.
X
XIf this DOESN'T work for you, please tell me the
Xfollowing things:
X
X type of hardware
X operating system version
X perl version
X ps axlww or ps -aefl output
X
X
X--tom
SHAR_EOF
if test 477 -ne "`wc -c < 'README'`"
then
echo shar: "error transmitting 'README'" '(should have been 477 characters)'
fi
chmod 664 'README'
fi
echo shar: "extracting 'pt.1'" '(5097 characters)'
if test -f 'pt.1'
then
echo shar: "will not over-write existing file 'pt.1'"
else
sed 's/^ X//' << \SHAR_EOF > 'pt.1'
X.TH PT 1L local
X.de M \" man page reference
X\\fI\\$1\\fR\\|(\\$2\)\\$3
X..
X.de T \" switch to typewriter font
X.ft TA \" probably want CW if you don't have TA font
X..
X.\"
X.de TY \" put $1 in typewriter font
X.if t .T
X.if n ``\c
X\\$1\c
X.if t .ft P
X.if n \&''\c
X\\$2
X..
X.SH NAME
Xpt \- postprocess ps output into hierarchical form
X.SH SYNOPSIS
X.B pt
X[
X.B \-a
X]
X[
X.B \-w
X]
X[
X.I "ps args"
X]
X[
X.I "pid list"
X]
X.SH "DESCRIPTION"
XThe
X.I pt
Xprogram is a
X.I perl
Xfront end to
X.I ps
Xthat
Xdisplays a
X.I ps
Xlisting with processes arranged in a tree format. That is,
Xprocesses are listed under their parents, indented to the right.
X.PP
XFor example:
X.sp
X.nf
X.na
XUSER PID TTY TIME COMMAND
Xtchrist 9341 p3 1:02 -tcsh
Xtchrist 10423 p3 0:11 vi pt.pl
Xtchrist 27045 p3 0:00 vi pt
Xtchrist 28371 p3 0:04 trn
Xtchrist 29366 p3 0:00 /bin/sh -c Pnews -h /mnt/tchris
Xtchrist 29367 p3 0:00 sh /usr/local/bin/Pnews -h /m
Xtchrist 29394 p3 0:00 perl sigspell
Xtchrist 29395 p3 0:00 vi /mnt/tchrist/.article
Xtchrist 29080 p3 0:01 vi pt.1
Xtchrist 29831 p3 0:00 sh -c ./pt
Xtchrist 29833 p3 0:00 perl ./pt
Xtchrist 29834 p3 0:00 /bin/ps xlww
Xtchrist 9361 p3 0:08 monthd -i5
Xtchrist 9500 pb 0:30 -tcsh
Xtchrist 23345 pb 0:18 perl plum
Xtchrist 29726 pb 0:00 perl now-what
Xtchrist 29729 pb 0:00 perl sigspell
Xtchrist 29734 pb 0:00 vi /mnt/tchrist/Mail/drafts
Xtchrist 9522 p3 23:59 perl newsclip 07/02/92 09:15
Xtchrist 9527 p3 0:07 perl pmeter
Xtchrist 19660 q9 0:47 perl sigrand
X.fi
X.ad
X.PP
XThe first listed process is the shell, and all those
Xindented under it are its direct children.
XThus
X.I
XPnews is a child of
X.IR trn ,
Xwhich itself has several children of its own.
X.PP
XNormally,
X.I pt
Xwill truncate at the width of your screen. The
X.B \-w
Xoption will allow output as wide as
X.I ps
Xreturns.
X.PP
XTo list all processes, use the
X.B \-a
Xoption, even if your system expects to pass
X.I ps
Xsomething other than an
X.B a
Xflag;
X.I pt
Xshould know to pass the appropriate flag to ps.
X.PP
XYou can also pass
X.I pt
Xa list of pids to restrict output to those process
Xtrees contains those pids. Any processes below the named
Xpids will be listed in full. Those above will be listed
Xonly if they are direct ancestors. For example (reading
Xthis output in from the editor):
X.sp
X.nf
X.na
X:r!pt $$
XUSER PID TTY TIME COMMAND
Xroot 0 ? 0:00 swapout
Xroot 1 ? 1:53 init
Xroot 9339 ? 8:26 xterm -display 130.168.190.14:0
Xtchrist 9341 p3 1:02 -tcsh
Xtchrist 29080 p3 0:05 vi pt.1
Xtchrist 731 p3 0:00 sh -c ./pt $$
Xtchrist 732 p3 0:00 perl ./pt 731
Xtchrist 733 p3 0:02 /bin/ps axlww
X.fi
X.ad
X.sp
XThis allows you to trace both parents and children of a given process.
X.SH "RETURN VALUE"
X.I pt
Xwill exit with a value of 1
Xif it encounteres difficulty parsing the output of
X.I ps
Xor if
X.I ps
Xshould itself exit non-zero.
X.SH ENVIRONMENT
XIn order to truncate at your current window size,
X.I pt
Xwill use the
X.B TIOCGWINSZ
X.I ioctl(2)
Xif supported on your system. Otherwise, it consults
Xyour environment for either a
X.B COLUMNS
Xvariable, or else checks your current
X.B TERMCAP
Xvariable for a
X.B ":co:"
Xentry.
X.SH "FILES"
Xgetopts.pl\h'|2i'perl getopts library
X.SH "SEE ALSO"
X.M ps 1 ,
X.M pstat 1 ,
X.M perl 1 .
X.SH NOTES
XThe
X.I pt
Xdistribution
Xcomes with a
X.I Makefile
Xand a
X.I Configure
Xscript that should be used to properly select what
Xform of
X.I ps
Xyou're using, paths, etc.
X.SH DIAGNOSTICS
X.TY "skipping unparsable line from ps:\en%s"
X.in +5n
X.br
XThis means that
X.I ps
Xoutput a line which
X.I pt
Xcouldn't make heads or tails of (probably tails).
X.in -5n
X.sp
X.TY "ps exited badly!"
X.in +5n
X.I ps
Xreturned a non-zero exit status.
X.in -5n
X.sp
X.TY "couldn't parse getopts.pl: %s"
X.br
X.TY "couldn't do getopts.pl: %s"
X.br
X.TY "couldn't run getopts.pl: %s"
X.br
X.in +5n
XAll these mean the getopts library couldn't be loaded.
XAn appropriate message should be printed.
X.sp
X.in -5n
X.TY "Didn't you run Configure?"
X.in +5n
XYou are running a raw version of
X.I pt
Xthat hasn't been configured yet.
X.sp
X.in -5n
X.TY "can't fork: %s at line %d of pt"
X.in +5n
X.I pt
Xwas unable to fork a child of itself
Xto run
X.I ps
Xwith.
X.br
X.in -5n
X.SH BUGS
X.I pt
Xis at the mercy of your
X.I ps
Xcommand, and it would appear that very few vendors
Xmake any effort to produce output that can be parsed
Xby humans or computers.
X.I pt
Xtherefore undergoes numerous convolutions to try to
Xdemangle braindead
X.I ps
Xoutput.
XIt is not always successful. File a bug report with
Xyour vendor is your
X.I ps
Xfields ever run together \(em it's a real pain.
X.PP
XThe
X.B \-d
Xoption prints out debugging information which may
Xhelp you diagnose difficulties you may be encountering.
X.SH AUTHOR
XTom Christiansen <tch...@convex.com>,
XJuly 2nd, 1992.
SHAR_EOF
if test 5097 -ne "`wc -c < 'pt.1'`"
then
echo shar: "error transmitting 'pt.1'" '(should have been 5097 characters)'
fi
chmod 644 'pt.1'
fi
echo shar: "extracting 'Install'" '(965 characters)'
if test -f 'Install'
then
echo shar: "will not over-write existing file 'Install'"
else
sed 's/^ X//' << \SHAR_EOF > 'Install'
X($defman, $defbin) = @ARGV;
X
X$mdir = &finddir($defman,
X '/usr/local/man/man1', '/usr/man/local/man1',
X '/usr/man/man.L', '/usr/man/manl',
X '/usr/man/mann', '/usr/man/u_man/man1', '/usr/man/man1'
X );
X
Xprint "\nWhat directory would you like your man page in?\n\t[$mdir] ";
X
Xchop($dir = <STDIN>);
X$dir = $mdir if $dir =~ /^\s*$/;
Xif (-d $dir) {
X ($suffix) = ($dir =~ m#man([^/]+$)#);
X $mpage = "$dir/pt.$suffix";
X} else {
X die "$dir: not a directory";
X}
X
X&run("cp pt.1 $mpage");
X
X$bin = &finddir($defbin, '/usr/local/scripts', '/usr/local/bin',
X split(':', $ENV{'PATH'}));
X
Xprint "\nWhat directory would you like your script in?\n\t[$bin] ";
X
Xchop($hisbin = <STDIN>);
X
X$bin = $hisbin unless $hisbin eq '';
X
Xchmod (0755, 'pt');
X&run("cp pt $bin");
X
Xsub finddir {
X for $dir (@_) {
X next if $dir eq '';
X return $dir if -d $dir;
X }
X '';
X}
X
Xsub run {
X local($cmd) = shift;
X print "\n$ $cmd\n";
X system($cmd) && die;
X}
SHAR_EOF
if test 965 -ne "`wc -c < 'Install'`"
then
echo shar: "error transmitting 'Install'" '(should have been 965 characters)'
fi
chmod 664 'Install'
fi
chmod 775 .
echo shar: "done with directory 'pt'"
cd ..
exit 0
# End of shell archive
--
Tom Christiansen tch...@convex.com convex!tchrist
In general, they do what you want, unless you want consistency.
--Larry Wall in the perl man page