| #!/usr/local/bin/perl |
| # |
| # $Id: idrlogin.perl5,v 1.5 2001/11/18 12:20:46 abe Exp $ |
| # |
| # idrlogin.perl5 -- sample Perl 5 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 5 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 = $faddr = $tty = ""; # fd variables |
| $pidst = 0; # process state |
| $cmd = $login = $pgrp = $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 |
| |
| if (! -x "$LSOF") { die "Can't execute $LSOF\n"; } |
| open (P, "$LSOF -R -FcDfLpPRn0|") || die "Can't pipe from $LSOF\n"; |
| |
| # Process the lsof output a line at a time |
| |
| while (<P>) { |
| chop; |
| @F = split('\0', $_, 999); |
| if ($F[0] =~ /^p/) { |
| |
| # A process set begins with a PID field whose ID character is `p'. |
| |
| if ($pidst) { &save_proc } |
| foreach $i (0 .. ($#F - 1)) { |
| |
| PROC: { |
| if ($F[$i] =~ /^c(.*)/) { $cmd = $1; last PROC } |
| if ($F[$i] =~ /^p(.*)/) { $pid = $1; last PROC } |
| if ($F[$i] =~ /^R(.*)/) { $ppid = $1; last PROC } |
| if ($F[$i] =~ /^L(.*)/) { $login = $1; last PROC } |
| } |
| } |
| $pidst = 1; |
| next; |
| } |
| |
| # A file descriptor set begins with a file descriptor field whose ID |
| # character is `f'. |
| |
| if ($F[0] =~ /^f/) { |
| if ($faddr ne "") { next; } |
| $proto = $name = ""; |
| foreach $i (0 .. ($#F - 1)) { |
| |
| FD: { |
| if ($F[$i] =~ /^P(.*)/) { $proto = $1; last FD; } |
| if ($F[$i] =~ /^n(.*)/) { $name = $1; last FD; } |
| if ($F[$i] =~ /^D(.*)/) { $dev = $1; last FD; } |
| } |
| } |
| if ($proto eq "TCP" |
| && $faddr eq "" |
| && (($cmd =~ /rlogind/) || ($cmd =~ /sshd/) || ($cmd =~ /telnetd/))) { |
| if (($name =~ /[^:]*:[^-]*->([^:]*):.*/)) { |
| $faddr = $1; |
| } |
| } elsif ($tty eq "" && ($cmd =~ /.*sh$/)) { |
| 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); |
| } |
| } |
| next; |
| } |
| } |
| |
| # Flush any stored file or process output. |
| |
| if ($pidst) { &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 (!defined($Ppid{$pid})) { $Ppid{$pid} = $ppid; } |
| if ($faddr ne "") { |
| $raddr{$pid} = $faddr; |
| if (($cmd =~ /.*sh$/)) { |
| $shcmd{$pid} = $cmd; |
| $shlogin{$pid} = $login; |
| } else { $rcmd{$pid} = $cmd; } |
| } |
| if ($tty ne "") { |
| $shcmd{$pid} = $cmd; |
| $shtty{$pid} = $tty; |
| $shlogin{$pid} = $login; |
| } |
| |
| # Clear variables. |
| |
| $cmd = $dev = $faddr = $pgrp = $pid = $ppid = $tty = ""; |
| $pidst = 0; |
| } |
| |
| |
| ## 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(""); |
| } |