Article 8077 of comp.lang.perl:
Xref: feenix.metronet.com alt.sources:2275 comp.lang.perl:8077
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!europa.eng.gtefsd.com!uunet!munnari.oz.au!goanna.cs.rmit.oz.au!yallara!lm
From: lm@yallara.cs.rmit.OZ.AU (Luke Mewburn)
Newsgroups: alt.sources,comp.lang.perl
Subject: checking rhost files for dodgy entries
Followup-To: comp.lang.perl
Date: 17 Nov 1993 23:43:25 GMT
Organization: Technical Support Group, Dept. of Computer Science, RMIT
Lines: 240
Message-ID: <2cecut$lal@goanna.cs.rmit.oz.au>
Reply-To: zak@rmit.edu.au
NNTP-Posting-Host: yallara.cs.rmit.oz.au
Keywords: perl, rhosts, security


Here's a script I whipped up to check the rhost entries of the users
on your machine for `dodgyness'. Looks for `+', `*' (umax v equiv
of `+'), differing usernames, unknown machine names, etc. Won't check
uid's < 100 or > 59998 (configurable), so you don't get complaints
about 'daemon' != 'root' :)

It has a `rewrite' option to `fix' the suspect lines, and has two
different output modes. Will check either every user on the system
(with the restrictions above), or only the users specified on the
command line.

Got some surprising results the first few times I ran it.

PS: if you don't have sys/socket.ph, just comment out the require - it
makes a pretty reasonable guess about what AF_INET should be anyway :)


Luke.

--- cut here --- file: ~/perl/chk_rhost
#!/usr/bin/perl
#
# chk_rhost -
#	checks the .rhosts files for every user for invalid entries
#
# This program is placed in the public domain, and may be freely used
# with the restriction that this header remains intact, and you do not
# try to claim you wrote this.
#
# Author:	Luke Mewburn <zak@rmit.edu.au>
# Date:		931107
#
# 931109, lm:	do (reverse & forward) name lookups on hosts, check for +
# 931110, lm:	cache even machines that failed. (e.g, goanna.oz)
# 931115, lm:	- use correct value for AF_INET from sys/socket.ph, and
#		make (min|max)uid constants instead of hardcoded values
#		- added -c & usage
# 931116, lm:	by default, it checks. Needs -r for rewrite. Added
#		-v (verbose) & -l (line mode). Added cmdline support.
#		check for `*' (UMAX V equiv of +)
#
#	TODO: add netgroup support
#

require 'getopts.pl';
require 'sys/socket.ph';	# get defn for AF_INET
$AF_INET = defined(&AF_INET) ? &AF_INET : 2;

$| = 1;				# unbuffer STDOUT
$min_uid = 100;			# don't check uids < $minuid
$max_uid = 59998;		# don't check uids > $maxuid
setpwent;			# rewind to start of passwd db

$progname = $0;			# get basename of what we're executed as
$progname =~ s/.*\/([^\/]+)/$1/;

&Getopts('rvl') || &usage;
$do_rewrite = $opt_r;
$verbose = $opt_v;
$linemode = $opt_l;

$frmargv = 1 if (@ARGV);

MAIN:						# get a user
while (@user=($frmargv ? getpwnam(shift(@ARGV)) : getpwent)) {
    ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) = @user;
    next MAIN if ($uid < $min_uid || $uid > $max_uid);
						# skip nobody && system users
    $rhfile = $dir . "/.rhosts";
    next MAIN if (! -e $rhfile || -z _);
    open(RH, $rhfile) || next MAIN;		# skip what I can't open
    select(STDOUT);
    print "Processing $name ($gcos), $rhfile\n" if ($verbose);
    $had_error = 0;
    if ($do_rewrite) {
	rename($rhfile, $rhfile . ".BAD");	# backup old file
	open(RHOUT, ">$rhfile");		# open new file, set perms
	chown($uid, $gid, $rhfile);
	chmod(0600, $rhfile);
	select(STDOUT);
    }
RHLINE:
    while ($line = <RH>) {				# for each line
	local($minushost, $minususer);
	chop ($line);
	if ($line eq "") {				# empty lines
	    &mesg("null entry");
	    next RHLINE;
	}
	if ($line =~ /\+/o) {				# lines with a `+'
	    &mesg("+ entry");
	    next RHLINE;
	}
	if ($line =~ /\*/o) {				# lines with a `*'
	    &mesg("* entry");
	    next RHLINE;
	}

	($host, $user, $rest) = split(/[\t ]+/o, $line);
	$host =~ tr/[A-Z]/[a-z]/;
	if ($rest) {				# lines with > 2 lines
	    &mesg("entry has too many fields");
	    next RHLINE;
	}
	if ($host =~ /^-(.*)/o) {		# host prefixed with `-'
	    $minushost = '-';
	    $host = $1;
#print "-host $host\n";
	}
	$user = $name if (! $user);		# if no user, assume it's us.
	if ($user =~ /^-(.*)/o) {		# username prefixed with `-'
	    $minususer = '-';
	    $user = $1;
#print "- user $user\n";
	}

	if ($user ne $name) {			# different usernames
	    &mesg("user '$user' != '$name'");
	    next RHLINE;
	}
						# validate host
	if ($host =~ /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/o) {
						# have IP # only..
	    $ipaddr = pack('C4', $1, $2, $3, $4);
	} else {				# have name, resolv to IP #
	    $ipaddr = &gethostaddr($host);
	    if (! $ipaddr) {
		&mesg("IP name '$host' couldn't be resolved");
		next RHLINE;
	    }
	}
	$resolvhost = &gethostname($ipaddr);	# convert hostip -> name
	if (! $resolvhost) {
	    &mesg("IP " . &addr2asc($ipaddr) . " couldn't be resolved");
	    next RHLINE;
	}

#	if ($host !~ /$resolvhost/i) {
#	    &mesg("hostnames not equivalent");
#	    next RHLINE;
#	}

						# write new entry
	print RHOUT "$minushost$resolvhost\t$minususer$user\n" if ($do_rewrite);
    } # while (<RH>)
    print "\n" if ($had_error && $verbose);
    close(RH);
    close(RHOUT) if ($do_rewrite);
} # while
endpwent;


exit 0;						# Justin Case

#
# mesg -
#	just dump an error message about the appropriate line
#
sub mesg {
    local($mesg) = @_;
    if ($linemode) {
	print "$name, $.: $line\n";
    } else {
	print "ERROR: line $., $rhfile\t$mesg\n";
    }
    $had_error = 1;				# flag message to print \n
} # mesg


#
# gethostname -
#	check the addrcache and return the value if we have one,
#	otherwise actually attempt to resolv.
# Args: addr
# Returns: name, or 0 if failed
#
sub gethostname {
    local($addr) = @_;

    return $addrcache{$addr} if (defined($addrcache{$addr}));
    print &addr2asc($addr), " not cached... resolving\n" if ($verbose);
    local($hname, $halias, $haddrtype, $hlength, @haddrs) =
	    gethostbyaddr($addr, $AF_INET);
    $hname = 0 if (!defined($hname));
    return ($addrcache{$addr} = $hname);
} # gethostname


#
# gethostaddr -
#	check the namecache and return the value if we have one,
#	otherwise actually attempt to resolv.
# Args: $name
# Returns: addr, or 0 if failed
#
sub gethostaddr {
    local($name) = @_;

    return $namecache{$name} if (defined($namecache{$name}));
    print "$name not cached... resolving\n" if ($verbose);
    local($hname, $halias, $haddrtype, $hlength, @haddrs) =
	    gethostbyname($name);
    $haddrs[0] = 0 if (!defined($haddrs[0]));
    return ($namecache{$name} = $haddrs[0]);
} # gethostaddr


#
# addr2asc -
#	converts a 4 byte number to the dotted decimal notation string.
#
sub addr2asc {
    local($addr) = @_;
    local($a, $b, $c, $d) = unpack('C4', $addr);
    return join(".", $a, $b, $c, $d);
} # addr2asc


#
# usage-
#	print a usage
#
sub usage {
    print <<USAGE;
Usage: $progname [-r] [-v] [-l] [user [user...]]
		Checks for invalid .rhost files for the specified users,
		or everyone on the system if no-one is given.
Options:
	-r	rewrite files, removing invalid entries
	-v	more verbose
	-l	line mode
USAGE
    exit 1;
} # usage
--- cut here ---

--
Luke Mewburn			Programmer, Technical Support Group,
Email: <zak@rmit.edu.au>	Department of Computer Science, RMIT