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