blob: d244dc7cb3218b35cf21e620287a0486fa645300 [file] [log] [blame]
#!/usr/local/bin/perl
#
# $Id: idrlogin.perl,v 1.5 2001/11/18 12:20:46 abe Exp $
#
# idrlogin.perl -- sample Perl script to identify the network source of a
# network (remote) login via rlogind, sshd, or telnetd
# IMPORTANT DEFINITIONS
# =====================
#
# 1. Set the interpreter line of this script to the local path of the
# Perl executable.
#
# Copyright 1997 Purdue Research Foundation, West Lafayette, Indiana
# 47907. All rights reserved.
#
# Written by Victor A. Abell
#
# 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.
$dev = $name = $proto = ""; # fd variables
$fdst = 0; # fd state
$pidst = 0; # process state
$cmd = $login = $pid = $ppid = ""; # process var.
# 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
}
}
# Open a pipe from lsof.
open(P, "$LSOF -R -FcDfLpPRn|") || die "Can't pipe from $LSOF\n";
# Process the ``lsof -FcDfLpPRn'' output a line at a time
while (<P>) {
chop;
if (/^p(.*)/) {
# A process set begins with a PID field whose ID character is `p'.
$tpid = $1;
if ($pidst && $fdst) { &save_proc }
$pidst = 1;
$pid = $tpid;
$cmd = $login = $ppid = "";
$fdst = 0;
$dev = $name = $proto = "";
next;
}
# Save process-related values.
if (/^c(.*)/) { $cmd = $1; next; }
if (/^L(.*)/) { $login = $1; next; }
if (/^R(.*)/) { $ppid = $1; next; }
# A file set begins with a file descriptor field.
if (/^f/) {
if ($pidst && $fdst) { &save_proc }
$fdst = 0;
$dev = $name = $proto = "";
next;
}
# Accumulate file information.
if (/^D(.*)/) { $dev = $1; next; }
if (/^P(.*)/) { $proto = $1; next; }
if (/^n(.*)/) { $name = $1; $fdst = 1; next; }
}
# Flush any stored file or process output.
if ($pidst && $fdst) { &save_proc }
# List the shell processes that have rlogind/sshd//telnetd parents.
$hdr = 0;
foreach $pid (sort keys(%shcmd)) {
$p = $pid;
if (!defined($raddr{$pid})) {
for ($ff = 0; !$ff && defined($Ppid{$p}); ) {
$p = $Ppid{$p};
if ($p < 2 || defined($raddr{$p})) { $ff = 1; }
}
} else { $ff = 2; }
if ($ff && defined($raddr{$p})) {
if (!$hdr) {
printf "%-8.8s %-8.8s %6s %-10.10s %6s %-10.10s %s\n",
"Login", "Shell", "PID", "Via", "PID", "TTY", "From";
$hdr = 1;
}
printf "%-8.8s %-8.8s %6d %-10.10s %6s %-10.10s %s\n",
$shlogin{$pid}, $shcmd{$pid}, $pid,
($ff == 2) ? "(direct)" : $rcmd{$p},
($ff == 2) ? "" : $p,
($shtty{$pid} eq "") ? "(unknown)" : $shtty{$pid},
$raddr{$p};
}
}
exit(0);
# save_proc -- save process information
# Values are stored inelegantly in global variables.
sub save_proc {
if ($cmd eq ""
|| $login eq ""
|| $ppid eq ""
|| $pid eq ""
|| $name eq ""
) { return; }
if (!defined($Ppid{$pid})) { $Ppid{$pid} = $ppid; }
if ($proto eq "TCP"
&& (($cmd =~ /rlogind/) || ($cmd =~ /sshd/) || ($cmd =~ /telnetd/))) {
if (defined($raddr{$pid})) { return; }
if (($name =~ /[^:]*:[^-]*->([^:]*):.*/)) {
$raddr{$pid} = $1;
$rcmd{$pid} = $cmd;
return;
}
}
if (($cmd =~ /.*sh$/)) {
if (defined($shcmd{$pid})) { return; }
if ($proto eq "TCP") {
if (defined($raddr{$pid})) { return; }
if (($name =~ /[^:]*:[^-]*->([^:]*):.*/)) {
$raddr{$pid} = $1;
$shcmd{$pid} = $cmd;
$shlogin{$pid} = $login;
}
}
if (($name =~ m#/dev.*ty.*#)) {
($tty) = ($name =~ m#/dev.*/(.*)#);
} elsif (($name =~ m#/dev/(pts/\d+)#)) {
$tty = $1;
} elsif (($name =~ m#/dev.*pts.*#)) {
$d = oct($dev);
$tty = sprintf("pts/%d", $d & 0xffff);
} else { return; }
} else { return; }
$shcmd{$pid} = $cmd;
$shtty{$pid} = $tty;
$shlogin{$pid} = $login;
}
## 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("");
}