summaryrefslogtreecommitdiff
path: root/scripts/shared.perl5
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/shared.perl5')
-rwxr-xr-xscripts/shared.perl5409
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("");
+}