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