scripts/idrlogin.perl5

   1 #!/usr/local/bin/perl
   2 #
   3 # $Id: idrlogin.perl5,v 1.5 2001/11/18 12:20:46 abe Exp $
   4 #
   5 # idrlogin.perl5 -- sample Perl 5 script to identify the network source of a
   6 #                   network (remote) login via rlogind, sshd, or telnetd
   7
   8
   9 # IMPORTANT DEFINITIONS
  10 # =====================
  11 #
  12 # 1.  Set the interpreter line of this script to the local path of the
  13 #     Perl 5 executable.
  14
  15
  16 # Copyright 1997 Purdue Research Foundation, West Lafayette, Indiana
  17 # 47907.  All rights reserved.
  18 #
  19 # Written by Victor A. Abell
  20 #
  21 # This software is not subject to any license of the American Telephone
  22 # and Telegraph Company or the Regents of the University of California.
  23 #
  24 # Permission is granted to anyone to use this software for any purpose on
  25 # any computer system, and to alter it and redistribute it freely, subject
  26 # to the following restrictions:
  27 #
  28 # 1. Neither the authors nor Purdue University are responsible for any
  29 #    consequences of the use of this software.
  30 #
  31 # 2. The origin of this software must not be misrepresented, either by
  32 #    explicit claim or by omission.  Credit to the authors and Purdue
  33 #    University must appear in documentation and sources.
  34 #
  35 # 3. Altered versions must be plainly marked as such, and must not be
  36 #    misrepresented as being the original software.
  37 #
  38 # 4. This notice may not be removed or altered.
  39
  40 # Initialize variables.
  41
  42 $dev = $faddr = $tty = "";                                      # fd variables
  43 $pidst = 0;                                                     # process state
  44 $cmd = $login = $pgrp = $pid = $ppid = "";                      # process var.
  45
  46 # Set path to lsof.
  47
  48 if (($LSOF = &isexec("../lsof")) eq "") {       # Try .. first
  49     if (($LSOF = &isexec("lsof")) eq "") {      # Then try . and $PATH
  50         print "can't execute $LSOF\n"; exit 1
  51     }
  52 }
  53
  54 # Open a pipe from lsof
  55
  56 if (! -x "$LSOF") { die "Can't execute $LSOF\n"; }
  57 open (P, "$LSOF -R -FcDfLpPRn0|") || die "Can't pipe from $LSOF\n";
  58
  59 # Process the lsof output a line at a time
  60
  61 while (<P>) {
  62     chop;
  63     @F = split('\0', $_, 999);
  64     if ($F[0] =~ /^p/) {
  65
  66 # A process set begins with a PID field whose ID character is `p'.
  67
  68         if ($pidst) { &save_proc }
  69         foreach $i (0 .. ($#F - 1)) {
  70
  71             PROC: {
  72                 if ($F[$i] =~ /^c(.*)/) { $cmd = $1; last PROC }
  73                 if ($F[$i] =~ /^p(.*)/) { $pid = $1; last PROC }
  74                 if ($F[$i] =~ /^R(.*)/) { $ppid = $1; last PROC }
  75                 if ($F[$i] =~ /^L(.*)/) { $login = $1; last PROC }
  76             }
  77         }
  78         $pidst = 1;
  79         next;
  80     }
  81
  82 # A file descriptor set begins with a file descriptor field whose ID
  83 # character is `f'.
  84
  85     if ($F[0] =~ /^f/) {
  86         if ($faddr ne "") { next; }
  87         $proto = $name = "";
  88         foreach $i (0 .. ($#F - 1)) {
  89
  90             FD: {
  91                 if ($F[$i] =~ /^P(.*)/) { $proto = $1; last FD; }
  92                 if ($F[$i] =~ /^n(.*)/) { $name = $1; last FD; }
  93                 if ($F[$i] =~ /^D(.*)/) { $dev = $1; last FD; }
  94             }
  95         }
  96         if ($proto eq "TCP"
  97         &&  $faddr eq ""
  98         &&  (($cmd =~ /rlogind/) || ($cmd =~ /sshd/) || ($cmd =~ /telnetd/))) {
  99             if (($name =~ /[^:]*:[^-]*->([^:]*):.*/)) {
 100                 $faddr = $1;
 101             }
 102         } elsif ($tty eq "" && ($cmd =~ /.*sh$/)) {
 103             if (($name =~ m#/dev.*ty.*#)) {
 104                 ($tty) = ($name =~ m#/dev.*/(.*)#);
 105             } elsif (($name =~ m#/dev/(pts/\d+)#)) {
 106                 $tty = $1;
 107             } elsif (($name =~ m#/dev.*pts.*#)) {
 108                 $d = oct($dev);
 109                 $tty = sprintf("pts/%d", $d & 0xffff);
 110             }
 111         }
 112         next;
 113     }
 114 }
 115
 116 # Flush any stored file or process output.
 117
 118 if ($pidst) { &save_proc }
 119
 120 # List the shell processes that have rlogind/sshd/telnetd parents.
 121
 122 $hdr = 0;
 123 foreach $pid (sort keys(%shcmd)) {
 124     $p = $pid;
 125     if (!defined($raddr{$pid})) {
 126         for ($ff = 0; !$ff && defined($Ppid{$p}); ) {
 127             $p = $Ppid{$p};
 128             if ($p < 2 || defined($raddr{$p})) { $ff = 1; }
 129         }
 130     } else { $ff = 2; }
 131     if ($ff && defined($raddr{$p})) {
 132         if (!$hdr) {
 133             printf "%-8.8s %-8.8s %6s %-10.10s %6s %-10.10s %s\n",
 134                 "Login", "Shell", "PID", "Via", "PID", "TTY", "From";
 135             $hdr = 1;
 136         }
 137         printf "%-8.8s %-8.8s %6d %-10.10s %6s %-10.10s %s\n",
 138             $shlogin{$pid}, $shcmd{$pid}, $pid,
 139             ($ff == 2) ? "(direct)" : $rcmd{$p},
 140             ($ff == 2) ? "" : $p,
 141             ($shtty{$pid} eq "") ? "(unknown)" : $shtty{$pid},
 142             $raddr{$p};
 143     }
 144 }
 145 exit(0);
 146
 147
 148 # save_proc -- save process information
 149 #              Values are stored inelegantly in global variables.
 150
 151 sub save_proc {
 152     if (!defined($Ppid{$pid})) { $Ppid{$pid} = $ppid; }
 153     if ($faddr ne "") {
 154         $raddr{$pid} = $faddr;
 155         if (($cmd =~ /.*sh$/)) {
 156             $shcmd{$pid} = $cmd;
 157             $shlogin{$pid} = $login;
 158         } else { $rcmd{$pid} = $cmd; }
 159     }
 160     if ($tty ne "") {
 161         $shcmd{$pid} = $cmd;
 162         $shtty{$pid} = $tty;
 163         $shlogin{$pid} = $login;
 164     }
 165
 166 # Clear variables.
 167
 168     $cmd = $dev = $faddr = $pgrp = $pid = $ppid = $tty = "";
 169     $pidst = 0;
 170 }
 171
 172
 173 ## isexec($path) -- is $path executable
 174 #
 175 # $path   = absolute or relative path to file to test for executabiity.
 176 #           Paths that begin with neither '/' nor '.' that arent't found as
 177 #           simple references are also tested with the path prefixes of the
 178 #           PATH environment variable.
 179
 180 sub
 181 isexec {
 182     my ($path) = @_;
 183     my ($i, @P, $PATH);
 184
 185     $path =~ s/^\s+|\s+$//g;
 186     if ($path eq "") { return(""); }
 187     if (($path =~ m#^[\/\.]#)) {
 188         if (-x $path) { return($path); }
 189         return("");
 190     }
 191     $PATH = $ENV{PATH};
 192     @P = split(":", $PATH);
 193     for ($i = 0; $i <= $#P; $i++) {
 194         if (-x "$P[$i]/$path") { return("$P[$i]/$path"); }
 195     }
 196     return("");
 197 }