Xref: utzoo comp.lang.perl:3071 alt.sources:2625
Path: utzoo!utgpu!cs.utexas.edu!usc!apple!sun-barr!newstop!texsun!convex!convex.com!tchrist
From: tchrist@convex.com (Tom Christiansen)
Newsgroups: comp.lang.perl,alt.sources
Subject: kernel monitoring, or interactively talking to a pipe
Message-ID: <109131@convex.convex.com>
Date: 21 Nov 90 22:51:00 GMT
Sender: news@convex.com
Reply-To: tchrist@convex.com (Tom Christiansen)
Followup-To: comp.lang.perl
Organization: Convex Computer Corp, Richardson, TX
Lines: 287

Here is a program that sits around a looks at kernel memory location to
record certain values.  It's like vmstat, but more generalized. It does
so by opening a pipe (ok, 2 of them) to adb and sending a it command,
then reading a line back, etc.

For example:

    % vmscan 
    usage: ./vmscan [-sleep] symbol ...
    Valid symbols are: "Context Sw (p)", "Context Sw (v)", "Disk Wait", "Free",
		       "Idle", "Idle 1", "Idle 2", "Idle 3", "Interrupts",
		       "Page Ins", "Page Outs", "Page Wait", "Pgin", "Pgout",
		       "Real", "Reclaims", "Runnable", "Sleeping", "Swapped",
		       "Sys.", "System", "System 1", "System 2", "System 3",
		       "System calls", "User", "User (n)", "User (n) 1", "User
		       (n) 2", "User (n) 3", "User 1", "User 2", "User 3",
		       "Virt.", "ccu0", "ccu1", "ccu2", "ccu3", "ccu4", "ccu5",
		       "ccu6", "ccu7"

    % vmscan -2 User System "User (n)"
    User            System          User (n)
    637             61316           46089
    637             61320           46108
    637             61336           46132
    637             61341           46166
    637             61346           46192
    ...


Things that you'll have to change to make it work on 
your system:

1) There is a table with commands like this:

    User                    cp_time+0/wt
    User (n)                cp_time+4/wt
    System                  cp_time+8/wt

    The precise syntax of the adb command (Convex's is bizarre), 
    and especially the mapping between symbols you recognize
    and the ones your kernel does will need changing.

2)  The number of initial garbage lines adb puts out when 
    talking on a pipe may vary.  It may be none.  You will
    find this in the code.

4)  I've hard-wired $TIOCGWINSZ instead of getting it from ioctl.p[lh]
    as a Careful Programmer should.

3)  You should really be running perl. :-)

4)  You may have to install this setgid kmem to read /dev/mem.


For true perl aficcionados:

1)  You will notice that I use a dynamic format based on window size.
    This is done by using an ioctl to get the window size.    That
    way the usage message is really cool and uses however many 
    columns your window has.

2)  There is a subroutine called &open2 which is like a regular
    open but you get both a read and a write handle.  This is ok
    in this case cause I know that adb reads a line at a time,
    then writes a line at a time.  You should be able to extract
    this and use as is in other programs.  In fact, this is the
    main reason I'm posting this.  If you don't have a recent
    perl patch, quote your filehandle arguments when passing them.

--tom


#!/usr/bin/perl
# 
# vmscan: read stuff out of the kernel like vmstat
# tom christiansen <tchrist@convex.com>


# look for any -sleep switch
#
if ($ARGV[0] =~ /^-(\d+)/) {
    $snooze = $1;
    shift;
} else {
    $snooze = 30; 
}

# set path so taintperl doesn't hate us if running suid
$ENV{'PATH'} = '/bin:/usr/bin:/usr/ucb:/usr/convex:/usr/local';

die "$0: can't read /dev/mem\n" unless -r '/dev/mem';
die "$0: can't read /vmunix\n"  unless -r '/vmunix';

# now be very careful to keep at least one
# tab between the LHS and the RHS, and that
# LHS have no trailing spaces.

%code = split(/[\t\n]+/, <<EO_LIST);
User			cp_time+0/wt
User (n)		cp_time+4/wt
System			cp_time+8/wt
Idle			cp_time+0xc/wt
User 1			cp_time+10/wt
User (n) 1		cp_time+14/wt
System 1		cp_time+18/wt
Idle 1			cp_time+0x1c/wt
User 2			cp_time+20/wt
User (n) 2		cp_time+24/wt
System 2		cp_time+28/wt
Idle 2			cp_time+0x2c/wt
User 3			cp_time+30/wt
User (n) 3		cp_time+34/wt
System 3		cp_time+38/wt
Idle 3			cp_time+0x3c/wt
Runnable		total+0/h
Disk Wait		total+2/h
Page Wait		total+4/h
Swapped			total+8/h
Sleeping		total+6/h
Virt.			total+0xe/wt
Real			total+0x10/wt
Free			total+0x14/wt
Reclaims		cnt+0x38/wt
Page Ins		cnt+0x30/wt
Page Outs		cnt+0x34/wt
Pgin			cnt+0x38/wt
Pgout			cnt+0x3c/wt
Interrupts		cnt+0x10/wt
System calls		cnt+0xc/wt
Context Sw (p)		cnt+0/wt
Context Sw (v)		cnt+0x4/wt
Sys.			cnt+0xc/wt
ccu0			500/wt
ccu0			5b0/wt
ccu1			504/wt
ccu1			5b4/wt
ccu2			508/wt
ccu2			5b8/wt
ccu3			50c/wt
ccu3			5bc/wt
ccu4			510/wt
ccu4			5c0/wt
ccu5			514/wt
ccu5			5c4/wt
ccu6			518/wt
ccu6			5c8/wt
ccu7			51c/wt
ccu7			5cc/wt
EO_LIST

&usage if @ARGV <= 0;

for (@ARGV) { 
    next if defined $code{$_};
    warn "$0: \"$_\" is an undefined entry point\n";
    &usage;
}


# also helps for when we fork to keep the 
# stdout buffer empty in the kid
#
select(STDOUT);  $| = 1; # unbuffer

# print out symbol headers
for (@ARGV) {
    print $_, "\t";
    print "\t" if 8 > length;
}
print "\n";


# in case the worst happens
sub REAPER {
    wait;
    print STDERR "$0: kid died unexpectedly: status $?\n";
    exit 2;
} 
$SIG{'PIPE'} = $SIG{'CHLD'} = 'REAPER';

&open2(DAD_RDR, DAD_WTR, $cmd = 'adb -k /vmunix /dev/mem')
    || die "open2 of $cmd failed: $!";

# eat first three lines of adb noise
# fourth (and prompts) aren't printed in pipes
for $lines (1..3) {
    die "error reading adb pipe" unless defined($_ = <DAD_RDR>);
} 

# get all the code we need to feed the hungry adb
#
@commands = @code{@ARGV};  
#           ^^^^^^^^^^^^^^
# this means ($code{$ARGV[0],$code{$ARGV[1], ...})

while (1) {
    print DAD_WTR join("\n", @commands), "\n";
    for ($count = @commands; $count; $count--) {
	&REAPER() unless defined($_ = <DAD_RDR>);
	split;
	print $_[1], "\t\t";
    } 
    print "\n";
    sleep $snooze;
}

sub usage {
    $winsize = "\0" x 8;
    $TIOCGWINSZ = 0x40087468;  # should be require 'sys/ioctl.pl';

    if (ioctl(STDERR, $TIOCGWINSZ, $winsize)) { 
	($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize);
    } else {
	$col = 80;
    } 

    $arrows = ('<' x ($col - 25));

    eval "format STDERR = \nValid symbols are: ^" .
	    $arrows . 
	    "\n\$symbols\n~~                 ^" . 
	    $arrows . 
	    "\n\$symbols\n.\n";

    select(STDERR);


    @keys = sort keys %code;
    for (@keys) {
	s/^/"/;
	s/$/"/;
    } 
    $symbols = join(", ", @keys);

    print "usage: $0 [-sleep] symbol ...\n";
    write;
    exit 1;
} 

# &open2: tom christiasen, <tchrist@convex.com>
#
#
# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
#
# spawn the given $cmd and connect $rdr for
# reading and $wtr for writing.  return pid
# of child, or 0 on failure.  
# 
# WARNING: this is dangerous, as you may block forever
# unless you are very careful.  
# 
# $wtr is left unbuffered.
# 
# abort program if
#	rdr or wtr are null
# 	pipe or fork or exec fails

sub open2 {
    local($dad_rdr, $dad_wtr, $cmd) = @_;

    local($kid_rdr) = 'open2_fh00';
    local($kid_wtr) = 'open2_fh01';
    local($kidpid);

    $dad_rdr ne '' 		|| die "open2: rdr should not be null";
    $dad_wtr ne '' 		|| die "open2: wtr should not be null";
    pipe($dad_rdr, $kid_wtr) 	|| die "open2: pipe 1 failed: $!";
    pipe($kid_rdr, $dad_wtr) 	|| die "open2: pipe 2 failed: $!";

    if (($kidpid = fork) < 0) {
	die "open2: fork failed: $!";
    } elsif ($kidpid == 0) {
	close $dad_rdr; 
	close $dad_wtr;
	open(STDIN,  ">&$kid_rdr");
	open(STDOUT, ">&$kid_wtr");
	exec $cmd;
	die "open2: exec of $cmd failed";   
    } 

    close $kid_rdr; 
    close $kid_wtr;

    select((select($dad_wtr), $| = 1)[0]);

    $kidpid;
}