#!/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 (
) {

    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("");

}