#! /usr/local/perl/perl
#==============================================================================
# checkXusers
# ===========
#
# This script checks for people logged on to this machine from insecure
# X servers. It is intended for systems administrators to check up on whether
# users are exposing themselves (and hence the system) to unacceptable risks.
# Like many commands (e.g. finger(1)), it could potentially be used for less
# honourable purposes; naturally I disapprove of this.
#
# It should be run from an ordinary user account, not root (it should work for
# root, but I haven't tried and it uses kill which is pretty dangerous for a
# superuser).
#
# It assumes that the netstat command is somewhere in the PATH.
#
# usage: checkXusers [-v] [timeout]
#   e.g. checkXusers 3
#
# the timeout is the number of seconds xhost is allowed to run (default 2).
# -v causes extra verbosity
#
# Author:   Bob Vickers, University of London Computer Centre
#   	    R.Vickers@ulcc.ac.uk

# $Log:	checkXusers,v $
# Revision 1.2  94/10/24  15:59:50  czis303
# Be more flexible about netstat formats understood. The old version did not
# work on Convex OS11 .
# 
# Revision 1.1  94/09/02  16:40:04  czis303
# Initial revision
# 
# 
#==============================================================================
$verbose=0; 	    # set verbosity level (0 means quiet, 1 means noisy)
if ("$ARGV[0]" eq "-v") {
    $verbose=1;
    shift;
}
$numargs=$#ARGV + 1;
if ( $numargs == 1 ) {$timeout=$ARGV[0];}
elsif ( $numargs == 0 ) {$timeout=2;}
else {die("usage: checkXusers [timeout]\n");}

$| = 1;	# make sure buffers get flushed
print "checkXusers run:", `date`;

# Get a list of remote IP addresses from netstat; this will include the 
# addresses of logged on X users. Stick them in an associative array so as
# to skip duplicates.
#
# Unfortunately there are at least 2 versions of netstat formatting around.
# Convex OS11 has fewer fields than various other versions. We try to
# recognise both.

open (NETSTAT, "netstat -n |");
while (<NETSTAT>){
    if (/^tcp/) {
    	chop;
    	$numfields = split;
    	if ( $numfields == 6 ) { 
    	    # works on Convex OS10, IRIX 4.0.5, SUNOS 4.1.3 etc
            ($proto, $RQ, $SQ, $locaddr, $remaddr, $state) = @_ ;
    	}
    	elsif ( $numfields == 4 ) {
    	    # works on Convex OS11
            ($proto, $locaddr, $remaddr, $state) = @_ ;
    	}
    	else {print STDERR "Unknown netstat format:\n @_";}

    	if ( split(/\./, "$remaddr") == 5) {
    	    $IPaddr="$_[0].$_[1].$_[2].$_[3]";
    	    $addresses{"$IPaddr"} = "$IPaddr";
    	}
    	else {print STDERR "Bad IP address $remaddr\n" if $verbose;}
    }
}
close (NETSTAT);
foreach (sort keys %addresses) {
    &impatient($timeout, "&checkaddr(\"$_\")");
}

exit;

# impatient
# =========
#
# This routine executes a perl command impatiently. If the command does not
# complete within a specified period then it is killed by an alarm signal.
#
#
# usage: status = &impatient(limit,command)
#
# the time limit is in seconds.

sub impatient {
    local($lim, $command) = @_ ;
    local ($pid, $rc);

#   fork a sub-process to execute the command.

    if ($pid = fork) {
	# we are the parent.

	# get the child's status.
	waitpid($pid,0);
	return $?;
    }
    elsif (defined $pid) {
        # We are the child.
    	$| = 1;	# make sure buffers get flushed
    	# start a new process group so that we can clean up later.
    	setpgrp(0,$$);
    	# set up signal handler
    	$SIG{'ALRM'}='cleanup';    	
    	# set the alarm call
    	alarm($lim);
    	# Execute the command.
	$rc=eval $command;

	exit $rc;
    }
    else {die "Can't fork:$!\n";}
}

sub cleanup {
    # kill our process group.

    # WARNING: I have seen very nasty things when root processes kill
    # process groups. I believe this code should work, but I haven't tried
    # it as root.
    kill(-1,$$) unless ($$ <= 1);
    # don't expect to survive the above line!
}

# checkaddr
# =========
#
# check the display variable associated with an internet address (or name)
# for insecurity.
#
# usage: &checkaddr (internet-name)
sub checkaddr {
    local($addr) = @_ ;
    local ($disp) = "${addr}:0.0" ;
    local ($msg,$fullname, $IPname);
    print ("checking display $disp\n") if $verbose;
    $ENV{'DISPLAY'} = $disp;

    # temporarily discard STDERR
    open(SAVEERR, ">&STDERR");
    open(STDERR, ">/dev/null");

    $_ =  `xhost`;  # call xhost
    open(STDERR, ">&SAVEERR");	# reopen STDERR

    if ($_) {
    	# if address is numeric then work out name.
    	if ( "$addr" =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/ ) {
    	    $IPname=&IPname("$addr");
    	    $fullname="$addr($IPname)";
    	}
    	else {$fullname="$addr";}

    	if ( /disabled/ ) { print "Server $fullname is WIDE OPEN\n  ";}
    	else {print "Server $fullname :\n  ";}
    	print "$_";
    }
}

# IPname
# ======
#
# Convert IP address to primary name. See ch7/numtoname in perl examples.
#
# usage: &IPname (internet-addr)
sub IPname {
    local($_) = @_ ;
    local($AF_INET) =2;
    local($name, $aliases, $addrtype, $length, @addrs) =
    	 gethostbyaddr(pack('C4', split(/\./)), $AF_INET);
    return "$name";
}

# ----------------------EMACS stuff to assist editing ------------------------
# Local Variables:
# mode:text
# tab-stop-list:(4 8 12 16 20 24 28 32 36 40 44 48 52 56 60 64 68 72 76)
# End: