scripts/shared.perl5

   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
  62 if (($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
  87 if ($#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
 106 if (!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
 113 while (<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 }
 173 close(LSOF_PIPE);
 174 if ($Fdst) { &End_fd }
 175 if ($Pidst) { &End_proc }
 176
 177 # List matching files or file descriptors.
 178
 179 for ($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 }
 211 exit(0);
 212
 213
 214 ## End_fd() -- process end of file descriptor
 215
 216 sub 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
 247 sub 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
 264 sub 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
 355 sub 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
 371 sub 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
 392 sub
 393 isexec {
 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 }