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
48if (($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
56if (! -x "$LSOF") { die "Can't execute $LSOF\n"; }
57open (P, "$LSOF -R -FcDfLpPRn0|") || die "Can't pipe from $LSOF\n";
58
59# Process the lsof output a line at a time
60
61while (<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
118if ($pidst) { &save_proc }
119
120# List the shell processes that have rlogind/sshd/telnetd parents.
121
122$hdr = 0;
123foreach $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}
145exit(0);
146
147
148# save_proc -- save process information
149#	       Values are stored inelegantly in global variables.
150
151sub 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
180sub
181isexec {
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}
198