1#!/usr/local/bin/perl
2#
3# $Id: list_NULf.perl5,v 1.5 2000/07/14 17:03:37 abe Exp $
4#
5# list_NULf.perl5 -- sample Perl 5 script to list lsof NUL-terminated
6#		     full field output (i.e., -F0 output)
7#
8# This script has been tested under perl version 5.001e.
9#
10# Copyright 1994 Purdue Research Foundation, West Lafayette, Indiana
11# 47907.  All rights reserved.
12#
13# Written by Victor A. Abell
14#
15# This software is not subject to any license of the American Telephone
16# and Telegraph Company or the Regents of the University of California.
17#
18# Permission is granted to anyone to use this software for any purpose on
19# any computer system, and to alter it and redistribute it freely, subject
20# to the following restrictions:
21#
22# 1. Neither the authors nor Purdue University are responsible for any
23#    consequences of the use of this software.
24#
25# 2. The origin of this software must not be misrepresented, either by
26#    explicit claim or by omission.  Credit to the authors and Purdue
27#    University must appear in documentation and sources.
28#
29# 3. Altered versions must be plainly marked as such, and must not be
30#    misrepresented as being the original software.
31#
32# 4. This notice may not be removed or altered.
33
34# Initialize variables.
35
36$fhdr = 0;							# fd hdr. flag
37$fdst = 0;							# fd state
38$access = $devch = $devn = $fd = $inode = $lock = $name = "";	# | file descr.
39$offset = $proto = $size = $state = $stream = $type = "";	# | variables
40$pidst = 0;							# process state
41$cmd = $login = $pgrp = $pid = $ppid = $uid = "";		# process var.
42
43# Process the ``lsof -F'' output a line at a time, gathering
44# the variables for a process together before printing them;
45# then gathering the variables for each file descriptor
46# together before printing them.
47
48while (<>) {
49    chop;
50    @F = split('\0', $_, 999);
51    if ($F[0] =~ /^p/) {
52
53# A process set begins with a PID field whose ID character is `p'.
54
55	if ($pidst) { &list_proc }
56	if ($fdst) { &list_fd; $fdst = 0; }
57	foreach $i (0 .. ($#F - 1)) {
58
59	    PROC: {
60		if ($F[$i] =~ /^c(.*)/) { $cmd = $1; last PROC }
61		if ($F[$i] =~ /^g(.*)/) { $pgrp = $1; last PROC }
62		if ($F[$i] =~ /^p(.*)/) { $pid = $1; last PROC }
63		if ($F[$i] =~ /^u(.*)/) { $uid = $1; last PROC }
64		if ($F[$i] =~ /^L(.*)/) { $login = $1; last PROC }
65		if ($F[$i] =~ /^R(.*)/) { $ppid = $1; last PROC }
66		print "ERROR: unrecognized process field: \"$F[$i]\"\n";
67	    }
68	}
69	$pidst = 1;
70	next;
71    }
72
73# A file descriptor set begins with a file descriptor field whose ID
74# character is `f'.
75
76    if ($F[0] =~ /^f/) {
77	if ($pidst) { &list_proc }
78	if ($fdst) { &list_fd }
79	foreach $i (0 .. ($#F - 1)) {
80
81	    FD: {
82		if ($F[$i] =~ /^a(.*)/) { $access = $1; last FD; }
83		if ($F[$i] =~ /^C(.*)/) { last FD; }
84		if ($F[$i] =~ /^f(.*)/) { $fd = $1; last FD; }
85		if ($F[$i] =~ /^F(.*)/) { last FD; }
86		if ($F[$i] =~ /^d(.*)/) { $devch = $1; last FD; }
87		if ($F[$i] =~ /^D(.*)/) { $devn = $1; last FD; }
88		if ($F[$i] =~ /^G(.*)/) { last FD; }
89		if ($F[$i] =~ /^i(.*)/) { $inode = $1; last FD; }
90		if ($F[$i] =~ /^k(.*)/) { last FD; }
91		if ($F[$i] =~ /^l(.*)/) { $lock = $1; last FD; }
92		if ($F[$i] =~ /^N(.*)/) { last FD; }
93		if ($F[$i] =~ /^o(.*)/) { $offset = $1; last FD; }
94		if ($F[$i] =~ /^P(.*)/) { $proto = $1; last FD; }
95		if ($F[$i] =~ /^s(.*)/) { $size = $1; last FD; }
96		if ($F[$i] =~ /^S(.*)/) { $stream = $1; last FD; }
97		if ($F[$i] =~ /^t(.*)/) { $type = $1; last FD; }
98		if ($F[$i] =~ /^T(.*)/) {
99		    if ($state eq "") { $state = "(" . $1; }
100		    else { $state = $state . " " . $1; }
101		    last FD;
102		}
103		if ($F[$i] =~ /^n(.*)/) { $name = $1; last FD; }
104		print "ERROR: unrecognized file set field: \"$F[$i]\"\n";
105	    }
106	}
107	$fdst = 1;
108	next;
109    }
110    print "ERROR: unrecognized: \"$_\"\n";
111}
112
113# Flush any stored file or process output.
114
115if ($fdst) { &list_fd }
116if ($pidst) { &list_proc }
117exit(0);
118
119
120## list_fd -- list file descriptor information
121#	      Values are stored inelegantly in global variables.
122
123sub list_fd {
124    if ( ! $fhdr) {
125
126    # Print header once.
127
128	print "      FD   TYPE      DEVICE   SIZE/OFF      INODE  NAME\n";
129	$fhdr = 1;
130    }
131    printf "    %4s%1.1s%1.1s %4.4s", $fd, $access, $lock, $type;
132    $tmp = $devn; if ($devch ne "") { $tmp = $devch }
133    printf "  %10.10s", $tmp;
134    $tmp = $size; if ($offset ne "") { $tmp = $offset }
135    printf " %10.10s", $tmp;
136    $tmp = $inode; if ($proto ne "") { $tmp = $proto }
137    printf " %10.10s", $tmp;
138    $tmp = $stream; if ($name ne "") { $tmp = $name }
139    print "  ", $tmp;
140    if ($state ne "") { printf " %s)\n", $state; } else { print "\n"; }
141
142# Clear variables.
143
144    $access = $devch = $devn = $fd = $inode = $lock = "";
145    $name = $offset = $proto = $size = $state = $stream = $type = "";
146}
147
148
149# list_proc -- list process information
150#	       Values are stored inelegantly in global variables.
151
152sub list_proc {
153    print "COMMAND       PID    PGRP    PPID  USER\n";
154    $tmp = $uid; if ($login ne "") {$tmp = $login }
155    printf "%-9.9s  %6d  %6d  %6d  %s\n", $cmd, $pid, $pgrp, $ppid, $tmp;
156
157# Clear variables.
158
159    $cmd = $login = $pgrp = $pid = $uid = "";
160    $fhdr = $pidst = 0;
161}
162