1#!/usr/local/bin/perl
2#
3# $Id: shared.perl5,v 1.4 2001/11/18 12:20:46 abe Exp $
4#
5# shared.perl5 -- sample Perl 5 script to list processes that share
6#		  file descriptors or files, using `lsof +ffn -F..."
7#		  output
8#
9# Usage:	shared [fd|file]
10#
11# where:	fd to list file descriptors (default)
12#
13#		file to list files
14#
15# This script has been tested under perl version 5.001e.
16
17
18# IMPORTANT DEFINITIONS
19# =====================
20#
21# 1.  Set the interpreter line of this script to the local path of the
22#     Perl5 executable.
23
24
25# Copyright 1998 Purdue Research Foundation, West Lafayette, Indiana
26# 47907.  All rights reserved.
27#
28# Written by Victor A. Abell <abe@purdue.edu>
29#
30# This software is not subject to any license of the American Telephone
31# and Telegraph Company or the Regents of the University of California.
32#
33# Permission is granted to anyone to use this software for any purpose on
34# any computer system, and to alter it and redistribute it freely, subject
35# to the following restrictions:
36#
37# 1. Neither the authors nor Purdue University are responsible for any
38#    consequences of the use of this software.
39#
40# 2. The origin of this software must not be misrepresented, either by
41#    explicit claim or by omission.  Credit to the authors and Purdue
42#    University must appear in documentation and sources.
43#
44# 3. Altered versions must be plainly marked as such, and must not be
45#    misrepresented as being the original software.
46#
47# 4. This notice may not be removed or altered.
48
49# Initialize variables.
50
51$Access = $Devch = $Devn = $Fd = $Fsa = $Inode = $Lock =	# file
52	  $Na = $Name = "";					# | descriptor
53$Cmd = $Login = $Pgrp = $Pid = $Ppid = $Uid = "";		# process var.
54$Fdst = 0;							# fd state
55$Hdr = 0;							# header state
56$Offset = $Proto = $Size = $State = $Stream = $Type = "";	# | variables
57$Pidst = 0;							# process state
58$Pn = "shared";
59
60# Set path to lsof.
61
62if (($LSOF = &isexec("../lsof")) eq "") {	# Try .. first
63    if (($LSOF = &isexec("lsof")) eq "") {	# Then try . and $PATH
64	print "can't execute $LSOF\n"; exit 1
65    }
66}
67
68# Define print field constants.
69
70$CmdTtl = "CMD";
71$CmdW = length($CmdTtl);
72$DevTtl = "DEVICE";
73$DevW = length($DevTtl);
74$FdTtl = "FD";
75$FdW = length($FdTtl);
76$InoTtl = "NODE";
77$InoW = length($InoTtl);
78$KeyTtl = "FILEADDR";
79$KeyW = length($KeyTtl);
80$PidTtl = "PID";
81$PidW = length($PidTtl);
82$PpidTtl = "PPID";
83$PpidW = length(PpidTtl);
84
85# Process one (optional) argument.
86
87if ($#ARGV >= 0) {
88    $err = 0;
89    if ($#ARGV > 1) { $err = 1; }
90    elsif ($ARGV[0] eq "fd") {
91	$KeyTtl = "FILEADDR";
92	$Shfd = 1;
93	$Shfile = 0;
94    } elsif ($ARGV[0] eq "file") {
95	$KeyTtl = "NODEID";
96	$Shfd = 0;
97	$Shfile = 1;
98    } else { $err = 1; }
99    if ($err) { die "$Pn: usage [fd|file]\n"; }
100    shift;
101} else { $Shfd = 1; $Shfile = 0; }
102$KeyW = length($KeyTtl);
103
104# Open a pipe from lsof.
105
106if (!open(LSOF_PIPE, "$LSOF -R +ffn -F0pcRDfFinN |")) {
107    die "$Pn: can't open pipe to: $LSOF\n";
108}
109
110# Process the lsof output a line at a time, gathering the variables for
111# processes and files.
112
113while (<LSOF_PIPE>) {
114    chop;
115    @F = split('\0', $_, 999);
116    if ($F[0] =~ /^p/) {
117
118# A process set begins with a PID field whose ID character is `p'.
119
120	if ($Fdst) { &End_fd }
121	if ($Pidst) { &End_proc }
122	foreach $i (0 .. ($#F - 1)) {
123
124	    PROC: {
125		if ($F[$i] =~ /^c(.*)/) { $Cmd = $1; last PROC }
126		if ($F[$i] =~ /^g(.*)/) { $Pgrp = $1; last PROC }
127		if ($F[$i] =~ /^p(.*)/) { $Pid = $1; last PROC }
128		if ($F[$i] =~ /^u(.*)/) { $Uid = $1; last PROC }
129		if ($F[$i] =~ /^L(.*)/) { $Login = $1; last PROC }
130		if ($F[$i] =~ /^R(.*)/) { $Ppid = $1; last PROC }
131		print "ERROR: unrecognized process field: \"$F[$i]\"\n";
132	    }
133	}
134	$Pidst = 1;
135	next;
136    }
137
138# A file descriptor set begins with a file descriptor field whose ID
139# character is `f'.
140
141    if ($F[0] =~ /^f/) {
142	if ($Fdst) { &End_fd }
143	foreach $i (0 .. ($#F - 1)) {
144
145	    FD: {
146		if ($F[$i] =~ /^a(.*)/) { $Access = $1; last FD; }
147		if ($F[$i] =~ /^f(.*)/) { $Fd = $1; last FD; }
148		if ($F[$i] =~ /^F(.*)/) { $Fsa = $1; last FD; }
149		if ($F[$i] =~ /^l(.*)/) { $Lock = $1; last FD; }
150		if ($F[$i] =~ /^t(.*)/) { $Type = $1; last FD; }
151		if ($F[$i] =~ /^d(.*)/) { $Devch = $1; last FD; }
152		if ($F[$i] =~ /^D(.*)/) { $Devn = $1; last FD; }
153		if ($F[$i] =~ /^s(.*)/) { $Size = $1; last FD; }
154		if ($F[$i] =~ /^o(.*)/) { $Offset = $1; last FD; }
155		if ($F[$i] =~ /^i(.*)/) { $Inode = $1; last FD; }
156		if ($F[$i] =~ /^P(.*)/) { $Proto = $1; last FD; }
157		if ($F[$i] =~ /^S(.*)/) { $Stream = $1; last FD; }
158		if ($F[$i] =~ /^T(.*)/) {
159		    if ($State eq "") { $State = "(" . $1; }
160		    else { $State = $State . " " . $1; }
161		    last FD;
162		}
163		if ($F[$i] =~ /^n(.*)/) { $Name = $1; last FD; }
164		if ($F[$i] =~ /^N(.*)/) { $Na = $1; last FD; }
165		print "ERROR: unrecognized file set field: \"$F[$i]\"\n";
166	    }
167	}
168	$Fdst = 1;
169	next;
170    }
171    print "ERROR: unrecognized: \"$_\"\n";
172}
173close(LSOF_PIPE);
174if ($Fdst) { &End_fd }
175if ($Pidst) { &End_proc }
176
177# List matching files or file descriptors.
178
179for ($pass = 0; $pass < 2; $pass++) {
180    foreach $key (sort keys(%Fds)) {
181	@Praw = split(' ', $Fds{$key}, 999);
182	if ($#Praw < 1) { next; }
183	if ($Shfd) { @P = sort Sort_by_FD_and_PID @Praw; }
184	else { @P = sort Sort_by_PID_and_FD @Praw; }
185
186    # Accumulate and print blocks of (key, PID, FD) triplets.
187
188	for ($i = 0; $i < $#P; $i++) {
189	    if ($Shfile) {
190		for ($n = 0; $n <= $#P; $n++) {
191		    ($pid, $fd) = split(",", $P[$n], 999);
192		    $PrtPid[$n] = $pid;
193		    $PrtFd[$n] = $fd;
194		}
195		$i = $n;
196	    } else {
197		($pid, $fd) = split(",", $P[$i], 999);
198		$PrtFd[0] = $fd;
199		$PrtPid[0] = $pid;
200		for ($n = 1; $i < $#P; $i++, $n++) {
201		    ($nxtpid, $nxtfd) = split(",", $P[$i + 1], 999);
202		    if ($fd ne $nxtfd) { last; }
203		    $PrtFd[$n] = $nxtfd;
204		    $PrtPid[$n] = $nxtpid;
205		}
206	    }
207	    if ($n > 1) { &Print_block($key, $n, $pass); }
208	}
209    }
210}
211exit(0);
212
213
214## End_fd() -- process end of file descriptor
215
216sub End_fd {
217
218    local ($key);
219
220    if ($Fdst && $Pidst && $Pid ne "") {
221	if ($Cmd ne "") { $Cmds{$Pid} = $Cmd; }
222	if ($Ppid ne "") { $Ppids{$Pid} = $Ppid; }
223	$key = $Shfd ? $Fsa : $Na;
224	if ($key ne "") {
225	    if (!defined($Fds{$key})) { $Fds{$key} = "$Pid,$Fd"; }
226	    else { $Fds{$key} .= " $Pid,$Fd"; }
227	    if ($Name ne "" && !defined($Name{$key})) { $Name{$key} = $Name }
228	    if ($Inode ne "" && !defined($Inodes{$key})) {
229		$Inodes{$key} = $Inode;
230	    }
231	    if ($Devn ne "" && !defined($Devns{$key})) {
232		$Devns{$key} = $Devn;
233	    }
234	}
235    }
236
237# Clear variables.
238
239    $Access = $Devch = $Devn = $Fd = $Fsa = $Inode = $Lock = "";
240    $Na = $Name = $Offset = $Proto = $Size = $State = $Stream = $Type = "";
241    $Fdst = 0;
242}
243
244
245## End_proc() -- process end of process
246
247sub End_proc {
248
249# Clear variables.
250
251    $Cmd = $Login = $Pgrp = $Pid = $Ppid = $Uid = "";
252    $Fdst = $Pidst = 0;
253}
254
255
256## Print_block() -- print a block of entries
257#
258# entry:
259#
260#	@_[0] = block's key
261#	@_[1] = number of entries in the block
262#	@_[2] = print pass status (1 == print)
263
264sub Print_block {
265
266    my ($key, $n, $pass) = @_;
267
268    local ($fd, $i, $pid, $t, $tW);
269
270    if ($pass) {
271	if (!$Hdr) {
272	    printf "%${KeyW}.${KeyW}s", $KeyTtl;
273	    printf " %${PidW}.${PidW}s", $PidTtl;
274	    printf " %${PpidW}.${PpidW}s", $PpidTtl;
275	    printf " %-${CmdW}.${CmdW}s", $CmdTtl;
276	    printf " %${FdW}.${FdW}s", $FdTtl;
277	    printf " %${DevW}.${DevW}s", $DevTtl;
278	    printf " %${InoW}.${InoW}s", $InoTtl;
279	    printf " NAME\n";
280	    $Hdr = 1;
281	} else { print "\n"; }
282    }
283
284# Loop through block.  During a non-print pass, caclulate maximum field widths.
285
286    for ($i = 0; $i < $n; $i++) {
287	$fd = $PrtFd[$i];
288	$pid = $PrtPid[$i];
289
290    # Process key.
291
292	if (!$pass) {
293	    $tW = length(sprintf("%s", $key));
294	    if ($tW > $KeyW) { $KeyW = $tW; }
295	} else { printf "%s", $key; }
296
297    # Process PID.
298
299	if (!$pass) {
300	    $tW = length(sprintf(" %s", $pid));
301	    if ($tW > $PidW) { $PidW = $tW; }
302	} else { printf " %${PidW}.${PidW}s", $pid; }
303
304    # Process parent PID.
305
306	$t = defined($Ppids{$pid}) ? $Ppids{$pid} : "";
307	if (!$pass) {
308	    $tW = length(sprintf(" %s", $t));
309	    if ($tW > $PpidW) { $PpidW = $tW; }
310	} else { printf " %${PpidW}.${PpidW}s", $t; }
311
312    # Process command name.
313
314	$t = defined($Cmds{$pid}) ? $Cmds{$pid} : "";
315	if (!$pass) {
316	    $tW = length(sprintf(" %s", $t));
317	    if ($tW > $CmdW) { $CmdW = $tW; }
318	} else { printf " %-${CmdW}.${CmdW}s", $t; }
319
320    # Process file descriptor.
321
322	if (!$pass) {
323	    $tW = length(sprintf(" %s", $fd));
324	    if ($tW > $FdW) { $FdW = $tW; }
325	} else { printf " %${FdW}.${FdW}s", $fd; }
326
327    # Process device number.
328
329	$t = defined($Devns{$key}) ? $Devns{$key} : "";
330	if (!$pass) {
331	    $tW = length(sprintf(" %s", $t));
332	    if ($tW > $DevW) { $DevW = $tW; }
333	} else { printf " %${DevW}.${DevW}s", $t; }
334
335    # Process node number.
336
337	$t = defined($Inodes{$key}) ? $Inodes{$key} : $t;
338	if (!$pass) {
339	    $tW = length(sprintf (" %s", $t));
340	    if ($tW > $InoW) { $InoW = $tW; }
341	} else { printf " %${InoW}.${InoW}s", $t; }
342
343    # Print name and line terminater, if this is a print pass.
344
345	if ($pass) {
346	    if (defined($Name{$key})) { print " $Name{$key}\n"; }
347	    else { print "\n"; }
348	}
349    }
350}
351
352
353## Sort_by_FD_and_PID() -- sort (PID,FD) doublets by FD first, then PID
354
355sub Sort_by_FD_and_PID {
356
357    local ($pida, $pidb, $fda, $fdj, $rv);
358
359    ($pida, $fda) = split(",", $a);
360    ($pidb, $fdb) = split(",", $b);
361    if ($fda < $fdb) { return(-1); }
362    if ($fda > $fdb) { return(1); }
363    if ($pida < $pidb) { return(-1); }
364    if ($pida > $pidb) { return(1); }
365    return(0);
366}
367
368
369## Sort_by_PID_and_FD() -- sort (PID,FD) doublets by PID first, then FD
370
371sub Sort_by_PID_and_FD {
372
373    local ($pida, $pidb, $fda, $fdj, $rv);
374
375    ($pida, $fda) = split(",", $a);
376    ($pidb, $fdb) = split(",", $b);
377    if ($pida < $pidb) { return(-1); }
378    if ($pida > $pidb) { return(1); }
379    if ($fda < $fdb) { return(-1); }
380    return(0);
381    if ($fda > $fdb) { return(1); }
382}
383
384
385## isexec($path) -- is $path executable
386#
387# $path   = absolute or relative path to file to test for executabiity.
388#	    Paths that begin with neither '/' nor '.' that arent't found as
389#	    simple references are also tested with the path prefixes of the
390#	    PATH environment variable.  
391
392sub
393isexec {
394    my ($path) = @_;
395    my ($i, @P, $PATH);
396
397    $path =~ s/^\s+|\s+$//g;
398    if ($path eq "") { return(""); }
399    if (($path =~ m#^[\/\.]#)) {
400	if (-x $path) { return($path); }
401	return("");
402    }
403    $PATH = $ENV{PATH};
404    @P = split(":", $PATH);
405    for ($i = 0; $i <= $#P; $i++) {
406	if (-x "$P[$i]/$path") { return("$P[$i]/$path"); }
407    }
408    return("");
409}
410