diff options
Diffstat (limited to 'scripts/shared.perl5')
-rwxr-xr-x | scripts/shared.perl5 | 409 |
1 files changed, 409 insertions, 0 deletions
diff --git a/scripts/shared.perl5 b/scripts/shared.perl5 new file mode 100755 index 0000000..2721413 --- /dev/null +++ b/scripts/shared.perl5 @@ -0,0 +1,409 @@ +#!/usr/local/bin/perl +# +# $Id: shared.perl5,v 1.4 2001/11/18 12:20:46 abe Exp $ +# +# shared.perl5 -- sample Perl 5 script to list processes that share +# file descriptors or files, using `lsof +ffn -F..." +# output +# +# Usage: shared [fd|file] +# +# where: fd to list file descriptors (default) +# +# file to list files +# +# This script has been tested under perl version 5.001e. + + +# IMPORTANT DEFINITIONS +# ===================== +# +# 1. Set the interpreter line of this script to the local path of the +# Perl5 executable. + + +# Copyright 1998 Purdue Research Foundation, West Lafayette, Indiana +# 47907. All rights reserved. +# +# Written by Victor A. Abell <abe@purdue.edu> +# +# This software is not subject to any license of the American Telephone +# and Telegraph Company or the Regents of the University of California. +# +# Permission is granted to anyone to use this software for any purpose on +# any computer system, and to alter it and redistribute it freely, subject +# to the following restrictions: +# +# 1. Neither the authors nor Purdue University are responsible for any +# consequences of the use of this software. +# +# 2. The origin of this software must not be misrepresented, either by +# explicit claim or by omission. Credit to the authors and Purdue +# University must appear in documentation and sources. +# +# 3. Altered versions must be plainly marked as such, and must not be +# misrepresented as being the original software. +# +# 4. This notice may not be removed or altered. + +# Initialize variables. + +$Access = $Devch = $Devn = $Fd = $Fsa = $Inode = $Lock = # file + $Na = $Name = ""; # | descriptor +$Cmd = $Login = $Pgrp = $Pid = $Ppid = $Uid = ""; # process var. +$Fdst = 0; # fd state +$Hdr = 0; # header state +$Offset = $Proto = $Size = $State = $Stream = $Type = ""; # | variables +$Pidst = 0; # process state +$Pn = "shared"; + +# Set path to lsof. + +if (($LSOF = &isexec("../lsof")) eq "") { # Try .. first + if (($LSOF = &isexec("lsof")) eq "") { # Then try . and $PATH + print "can't execute $LSOF\n"; exit 1 + } +} + +# Define print field constants. + +$CmdTtl = "CMD"; +$CmdW = length($CmdTtl); +$DevTtl = "DEVICE"; +$DevW = length($DevTtl); +$FdTtl = "FD"; +$FdW = length($FdTtl); +$InoTtl = "NODE"; +$InoW = length($InoTtl); +$KeyTtl = "FILEADDR"; +$KeyW = length($KeyTtl); +$PidTtl = "PID"; +$PidW = length($PidTtl); +$PpidTtl = "PPID"; +$PpidW = length(PpidTtl); + +# Process one (optional) argument. + +if ($#ARGV >= 0) { + $err = 0; + if ($#ARGV > 1) { $err = 1; } + elsif ($ARGV[0] eq "fd") { + $KeyTtl = "FILEADDR"; + $Shfd = 1; + $Shfile = 0; + } elsif ($ARGV[0] eq "file") { + $KeyTtl = "NODEID"; + $Shfd = 0; + $Shfile = 1; + } else { $err = 1; } + if ($err) { die "$Pn: usage [fd|file]\n"; } + shift; +} else { $Shfd = 1; $Shfile = 0; } +$KeyW = length($KeyTtl); + +# Open a pipe from lsof. + +if (!open(LSOF_PIPE, "$LSOF -R +ffn -F0pcRDfFinN |")) { + die "$Pn: can't open pipe to: $LSOF\n"; +} + +# Process the lsof output a line at a time, gathering the variables for +# processes and files. + +while (<LSOF_PIPE>) { + chop; + @F = split('\0', $_, 999); + if ($F[0] =~ /^p/) { + +# A process set begins with a PID field whose ID character is `p'. + + if ($Fdst) { &End_fd } + if ($Pidst) { &End_proc } + foreach $i (0 .. ($#F - 1)) { + + PROC: { + if ($F[$i] =~ /^c(.*)/) { $Cmd = $1; last PROC } + if ($F[$i] =~ /^g(.*)/) { $Pgrp = $1; last PROC } + if ($F[$i] =~ /^p(.*)/) { $Pid = $1; last PROC } + if ($F[$i] =~ /^u(.*)/) { $Uid = $1; last PROC } + if ($F[$i] =~ /^L(.*)/) { $Login = $1; last PROC } + if ($F[$i] =~ /^R(.*)/) { $Ppid = $1; last PROC } + print "ERROR: unrecognized process field: \"$F[$i]\"\n"; + } + } + $Pidst = 1; + next; + } + +# A file descriptor set begins with a file descriptor field whose ID +# character is `f'. + + if ($F[0] =~ /^f/) { + if ($Fdst) { &End_fd } + foreach $i (0 .. ($#F - 1)) { + + FD: { + if ($F[$i] =~ /^a(.*)/) { $Access = $1; last FD; } + if ($F[$i] =~ /^f(.*)/) { $Fd = $1; last FD; } + if ($F[$i] =~ /^F(.*)/) { $Fsa = $1; last FD; } + if ($F[$i] =~ /^l(.*)/) { $Lock = $1; last FD; } + if ($F[$i] =~ /^t(.*)/) { $Type = $1; last FD; } + if ($F[$i] =~ /^d(.*)/) { $Devch = $1; last FD; } + if ($F[$i] =~ /^D(.*)/) { $Devn = $1; last FD; } + if ($F[$i] =~ /^s(.*)/) { $Size = $1; last FD; } + if ($F[$i] =~ /^o(.*)/) { $Offset = $1; last FD; } + if ($F[$i] =~ /^i(.*)/) { $Inode = $1; last FD; } + if ($F[$i] =~ /^P(.*)/) { $Proto = $1; last FD; } + if ($F[$i] =~ /^S(.*)/) { $Stream = $1; last FD; } + if ($F[$i] =~ /^T(.*)/) { + if ($State eq "") { $State = "(" . $1; } + else { $State = $State . " " . $1; } + last FD; + } + if ($F[$i] =~ /^n(.*)/) { $Name = $1; last FD; } + if ($F[$i] =~ /^N(.*)/) { $Na = $1; last FD; } + print "ERROR: unrecognized file set field: \"$F[$i]\"\n"; + } + } + $Fdst = 1; + next; + } + print "ERROR: unrecognized: \"$_\"\n"; +} +close(LSOF_PIPE); +if ($Fdst) { &End_fd } +if ($Pidst) { &End_proc } + +# List matching files or file descriptors. + +for ($pass = 0; $pass < 2; $pass++) { + foreach $key (sort keys(%Fds)) { + @Praw = split(' ', $Fds{$key}, 999); + if ($#Praw < 1) { next; } + if ($Shfd) { @P = sort Sort_by_FD_and_PID @Praw; } + else { @P = sort Sort_by_PID_and_FD @Praw; } + + # Accumulate and print blocks of (key, PID, FD) triplets. + + for ($i = 0; $i < $#P; $i++) { + if ($Shfile) { + for ($n = 0; $n <= $#P; $n++) { + ($pid, $fd) = split(",", $P[$n], 999); + $PrtPid[$n] = $pid; + $PrtFd[$n] = $fd; + } + $i = $n; + } else { + ($pid, $fd) = split(",", $P[$i], 999); + $PrtFd[0] = $fd; + $PrtPid[0] = $pid; + for ($n = 1; $i < $#P; $i++, $n++) { + ($nxtpid, $nxtfd) = split(",", $P[$i + 1], 999); + if ($fd ne $nxtfd) { last; } + $PrtFd[$n] = $nxtfd; + $PrtPid[$n] = $nxtpid; + } + } + if ($n > 1) { &Print_block($key, $n, $pass); } + } + } +} +exit(0); + + +## End_fd() -- process end of file descriptor + +sub End_fd { + + local ($key); + + if ($Fdst && $Pidst && $Pid ne "") { + if ($Cmd ne "") { $Cmds{$Pid} = $Cmd; } + if ($Ppid ne "") { $Ppids{$Pid} = $Ppid; } + $key = $Shfd ? $Fsa : $Na; + if ($key ne "") { + if (!defined($Fds{$key})) { $Fds{$key} = "$Pid,$Fd"; } + else { $Fds{$key} .= " $Pid,$Fd"; } + if ($Name ne "" && !defined($Name{$key})) { $Name{$key} = $Name } + if ($Inode ne "" && !defined($Inodes{$key})) { + $Inodes{$key} = $Inode; + } + if ($Devn ne "" && !defined($Devns{$key})) { + $Devns{$key} = $Devn; + } + } + } + +# Clear variables. + + $Access = $Devch = $Devn = $Fd = $Fsa = $Inode = $Lock = ""; + $Na = $Name = $Offset = $Proto = $Size = $State = $Stream = $Type = ""; + $Fdst = 0; +} + + +## End_proc() -- process end of process + +sub End_proc { + +# Clear variables. + + $Cmd = $Login = $Pgrp = $Pid = $Ppid = $Uid = ""; + $Fdst = $Pidst = 0; +} + + +## Print_block() -- print a block of entries +# +# entry: +# +# @_[0] = block's key +# @_[1] = number of entries in the block +# @_[2] = print pass status (1 == print) + +sub Print_block { + + my ($key, $n, $pass) = @_; + + local ($fd, $i, $pid, $t, $tW); + + if ($pass) { + if (!$Hdr) { + printf "%${KeyW}.${KeyW}s", $KeyTtl; + printf " %${PidW}.${PidW}s", $PidTtl; + printf " %${PpidW}.${PpidW}s", $PpidTtl; + printf " %-${CmdW}.${CmdW}s", $CmdTtl; + printf " %${FdW}.${FdW}s", $FdTtl; + printf " %${DevW}.${DevW}s", $DevTtl; + printf " %${InoW}.${InoW}s", $InoTtl; + printf " NAME\n"; + $Hdr = 1; + } else { print "\n"; } + } + +# Loop through block. During a non-print pass, caclulate maximum field widths. + + for ($i = 0; $i < $n; $i++) { + $fd = $PrtFd[$i]; + $pid = $PrtPid[$i]; + + # Process key. + + if (!$pass) { + $tW = length(sprintf("%s", $key)); + if ($tW > $KeyW) { $KeyW = $tW; } + } else { printf "%s", $key; } + + # Process PID. + + if (!$pass) { + $tW = length(sprintf(" %s", $pid)); + if ($tW > $PidW) { $PidW = $tW; } + } else { printf " %${PidW}.${PidW}s", $pid; } + + # Process parent PID. + + $t = defined($Ppids{$pid}) ? $Ppids{$pid} : ""; + if (!$pass) { + $tW = length(sprintf(" %s", $t)); + if ($tW > $PpidW) { $PpidW = $tW; } + } else { printf " %${PpidW}.${PpidW}s", $t; } + + # Process command name. + + $t = defined($Cmds{$pid}) ? $Cmds{$pid} : ""; + if (!$pass) { + $tW = length(sprintf(" %s", $t)); + if ($tW > $CmdW) { $CmdW = $tW; } + } else { printf " %-${CmdW}.${CmdW}s", $t; } + + # Process file descriptor. + + if (!$pass) { + $tW = length(sprintf(" %s", $fd)); + if ($tW > $FdW) { $FdW = $tW; } + } else { printf " %${FdW}.${FdW}s", $fd; } + + # Process device number. + + $t = defined($Devns{$key}) ? $Devns{$key} : ""; + if (!$pass) { + $tW = length(sprintf(" %s", $t)); + if ($tW > $DevW) { $DevW = $tW; } + } else { printf " %${DevW}.${DevW}s", $t; } + + # Process node number. + + $t = defined($Inodes{$key}) ? $Inodes{$key} : $t; + if (!$pass) { + $tW = length(sprintf (" %s", $t)); + if ($tW > $InoW) { $InoW = $tW; } + } else { printf " %${InoW}.${InoW}s", $t; } + + # Print name and line terminater, if this is a print pass. + + if ($pass) { + if (defined($Name{$key})) { print " $Name{$key}\n"; } + else { print "\n"; } + } + } +} + + +## Sort_by_FD_and_PID() -- sort (PID,FD) doublets by FD first, then PID + +sub Sort_by_FD_and_PID { + + local ($pida, $pidb, $fda, $fdj, $rv); + + ($pida, $fda) = split(",", $a); + ($pidb, $fdb) = split(",", $b); + if ($fda < $fdb) { return(-1); } + if ($fda > $fdb) { return(1); } + if ($pida < $pidb) { return(-1); } + if ($pida > $pidb) { return(1); } + return(0); +} + + +## Sort_by_PID_and_FD() -- sort (PID,FD) doublets by PID first, then FD + +sub Sort_by_PID_and_FD { + + local ($pida, $pidb, $fda, $fdj, $rv); + + ($pida, $fda) = split(",", $a); + ($pidb, $fdb) = split(",", $b); + if ($pida < $pidb) { return(-1); } + if ($pida > $pidb) { return(1); } + if ($fda < $fdb) { return(-1); } + return(0); + if ($fda > $fdb) { return(1); } +} + + +## isexec($path) -- is $path executable +# +# $path = absolute or relative path to file to test for executabiity. +# Paths that begin with neither '/' nor '.' that arent't found as +# simple references are also tested with the path prefixes of the +# PATH environment variable. + +sub +isexec { + my ($path) = @_; + my ($i, @P, $PATH); + + $path =~ s/^\s+|\s+$//g; + if ($path eq "") { return(""); } + if (($path =~ m#^[\/\.]#)) { + if (-x $path) { return($path); } + return(""); + } + $PATH = $ENV{PATH}; + @P = split(":", $PATH); + for ($i = 0; $i <= $#P; $i++) { + if (-x "$P[$i]/$path") { return("$P[$i]/$path"); } + } + return(""); +} |