scripts/list_fields.perl

   1 #!/usr/local/bin/perl4
   2 #
   3 # $Id: list_fields.perl,v 1.5 2000/07/14 17:03:37 abe Exp $
   4 #
   5 # list_fields.perl -- sample Perl script to list lsof full field output
   6 #                     (i.e., -F output without -0)
   7 #
   8 # This script has been tested under perl versions 4.036 and 5.001e.
   9 #
  10 # Copyright 1994 Purdue Research Foundation, West Lafayette, Indiana
  11 # 47907.  All rights reserved.
  12 #
  13 # Written by Victor A. Abell
  14 #
  15 # This software is not subject to any license of the American Telephone
  16 # and Telegraph Company or the Regents of the University of California.
  17 #
  18 # Permission is granted to anyone to use this software for any purpose on
  19 # any computer system, and to alter it and redistribute it freely, subject
  20 # to the following restrictions:
  21 #
  22 # 1. Neither the authors nor Purdue University are responsible for any
  23 #    consequences of the use of this software.
  24 #
  25 # 2. The origin of this software must not be misrepresented, either by
  26 #    explicit claim or by omission.  Credit to the authors and Purdue
  27 #    University must appear in documentation and sources.
  28 #
  29 # 3. Altered versions must be plainly marked as such, and must not be
  30 #    misrepresented as being the original software.
  31 #
  32 # 4. This notice may not be removed or altered.
  33
  34 # Initialize variables.
  35
  36 $fhdr = 0;                                                      # fd hdr. flag
  37 $fdst = 0;                                                      # fd state
  38 $access = $devch = $devn = $fd = $inode = $lock = $name = "";   # | file descr.
  39 $offset = $proto = $size = $state = $stream = $type = "";       # | variables
  40 $pidst = 0;                                                     # process state
  41 $cmd = $login = $pgrp = $pid = $ppid = $uid = "";               # process var.
  42
  43 # Process the ``lsof -F'' output a line at a time, gathering
  44 # the variables for a process together before printing them;
  45 # then gathering the variables for each file descriptor
  46 # together before printing them.
  47
  48 while (<>) {
  49     chop;
  50     if (/^p(.*)/) {
  51
  52 # A process set begins with a PID field whose ID character is `p'.
  53
  54         $tpid = $1;
  55         if ($pidst) { &list_proc }
  56         $pidst = 1;
  57         $pid = $tpid;
  58         if ($fdst) { &list_fd; $fdst = 0; }
  59         next;
  60     }
  61
  62 # Save process-related values.
  63
  64     if (/^g(.*)/) { $pgrp = $1; next; }
  65     if (/^c(.*)/) { $cmd = $1; next; }
  66     if (/^u(.*)/) { $uid = $1; next; }
  67     if (/^L(.*)/) { $login = $1; next; }
  68     if (/^R(.*)/) { $ppid = $1; next; }
  69
  70 # A file descriptor set begins with a file descriptor field whose ID
  71 # character is `f'.
  72
  73     if (/^f(.*)/) {
  74         $tfd = $1;
  75         if ($pidst) { &list_proc }
  76         if ($fdst) { &list_fd }
  77         $fd = $tfd;
  78         $fdst = 1;
  79         next;
  80     }
  81
  82 # Save file set information.
  83
  84     if (/^a(.*)/) { $access = $1; next; }
  85     if (/^C(.*)/) { next; }
  86     if (/^d(.*)/) { $devch = $1; next; }
  87     if (/^D(.*)/) { $devn = $1; next; }
  88     if (/^F(.*)/) { next; }
  89     if (/^G(.*)/) { next; }
  90     if (/^i(.*)/) { $inode = $1; next; }
  91     if (/^k(.*)/) { next; }
  92     if (/^l(.*)/) { $lock = $1; next; }
  93     if (/^N(.*)/) { next; }
  94     if (/^o(.*)/) { $offset = $1; next; }
  95     if (/^P(.*)/) { $proto = $1; next; }
  96     if (/^s(.*)/) { $size = $1; next; }
  97     if (/^S(.*)/) { $stream = $1; next; }
  98     if (/^t(.*)/) { $type = $1; next; }
  99     if (/^T(.*)/) {
 100         if ($state eq "") { $state = "(" . $1; }
 101         else { $state = $state . " " . $1; }
 102         next;
 103     }
 104     if (/^n(.*)/) { $name = $1; next; }
 105     print "ERROR: unrecognized: \"$_\"\n";
 106 }
 107
 108 # Flush any stored file or process output.
 109
 110 if ($fdst) { &list_fd }
 111 if ($pidst) { &list_proc }
 112 exit(0);
 113
 114
 115 ## list_fd -- list file descriptor information
 116 #             Values are stored inelegantly in global variables.
 117
 118 sub list_fd {
 119     if ( ! $fhdr) {
 120
 121     # Print header once.
 122
 123         print "      FD   TYPE      DEVICE   SIZE/OFF      INODE  NAME\n";
 124         $fhdr = 1;
 125     }
 126     printf "    %4s%1.1s%1.1s %4.4s", $fd, $access, $lock, $type;
 127     $tmp = $devn; if ($devch ne "") { $tmp = $devch }
 128     printf "  %10.10s", $tmp;
 129     $tmp = $size; if ($offset ne "") { $tmp = $offset }
 130     printf " %10.10s", $tmp;
 131     $tmp = $inode; if ($proto ne "") { $tmp = $proto }
 132     printf " %10.10s", $tmp;
 133     $tmp = $stream; if ($name ne "") { $tmp = $name }
 134     print "  ", $tmp;
 135     if ($state ne "") { printf " %s)\n", $state; } else { print "\n"; }
 136
 137 # Clear variables.
 138
 139     $access = $devch = $devn = $fd = $inode = $lock = $name = "";
 140     $offset = $proto = $size = $state = $stream = $type = "";
 141 }
 142
 143
 144 # list_proc -- list process information
 145 #              Values are stored inelegantly in global variables.
 146
 147 sub list_proc {
 148     print "COMMAND       PID    PGRP    PPID  USER\n";
 149     $tmp = $uid; if ($login ne "") {$tmp = $login }
 150     printf "%-9.9s  %6d  %6d  %6d  %s\n", $cmd, $pid, $pgrp, $ppid, $tmp;
 151
 152 # Clear variables.
 153
 154     $cmd = $login = $pgrp = $pid = $uid = "";
 155     $fhdr = $pidst = 0;
 156 }