408 lines
10 KiB
Perl
Executable File
408 lines
10 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# shared.pl -- 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("");
|
|
}
|