##!/bin/sh -- 					# wish I were -*-Perl-*-
#eval 'exec perl -S $0 ${1+"$@"}'
#    if !$$;
#!/bin/perl

# Look for trojan horses...

# A trojan horse looks like a regular program. 
# however, if you execute it, the program may set up a back door to 
# your account, or modify one of your files, etc.
#
# This script reports on the different ways someone can drop a trojan hourse
# in your searchpath.
#
# It does not check for set UID or GID programs on your file system, 
# and does not check NFS permissions of directories.
# It only checks for executables in your searchpath, and reports who and how
# someone can create a trojan horse. 
#
# This program also provides a measurement of how vunerable you are to a
# trojan horse. 
#
# Bruce Barnett <barnett@crd.ge.com>
# Copyright 1994 GE
# All commercial Rights reserved
# 
# @(#)trojan.pl	1.9 26 May 1994
#
# usage:
# 
#	perl trojan.pl [options]
#
#	where options are any combination of the following
#	-b	- brief report. Don't show reasons or executables
#	-a	- analyze all files. Normally when a file is world writable,
#			don't check for group or user writable
#			the -a means look at all problems, and not the first
#	-w	- just report on world writable problems (no group or user)
#	-g	- report on group writable problems ( sets -w, no user)
#	-u	- report on world, group and user writable problems (Default)
#	-A	- report all files that cause a problem with a group writable
#  		  permission, not just the first one
#
# for debugging purposes, and for more information, try the following options
#	-v	- verbose
#	-d	- debug
#
#	Examples
#	trojan.pl		- reports world, group and user problems
#			  shows reasons for problem
#	trojan.pl -b		- reports world, group and user problems
#			  Doesn't show reasons
#	trojan.pl -b -a	- reports world, group and user problems
#			  Doesn't show reasons
#			  reports on ALL  world, group and user 
#			  writable problems
#	trojan.pl -b -a -A	- reports world, group and user problems
#			  Doesn't show reasons
#			  reports on ALL  world, group and user 
#			  writable problems
#			  Also reports all files that cause group write access
#
#
#	trojan.pl -w 		- reports world writable problems and reasons
#	trojan.pl -g 		- reports world + group writable problems and reasons

#	you probably want to start with trojan.pl -b 
#	and fix some of those problems first
#	If you don't understand why it's a problem, omit the -b option

#	A malicious cracker will often use your co-workers accounts
# 	as a stepping stone to getting root (or bin, daemon, sys, etc.) 
#       access. Therefore you have to trust that none of the people who 
#	could drop a trojan horse in front of you have had their accounts 
#       compromised. If you don't trust them, then don't allow their 
#	binaries in your searchpath.
#

$not_a_csh_script = 0;	# this is used in case someone tries
				# "csh trojan.pl"
# command line OPTIONS
$all = 0;			# print out a more detailed report, (all tests)
$report_all = 0;			# report all files, not just the first one
$do_world = 1;			# print out world writable items
$do_group = 1;			# print out group writable items
$do_user = 1;			# print out user specific info
$brief = 0;			# a short report

$verbose=0;			# print more information
$debug = 0;			# 



# VARIABLES
$dot = 0;	# have I seen the "." directory in the path yet?
$programsafterdot = 0;		# how many files were found after the dot?
$TotalFiles = 0;			# total programs or files found in the $PATH directories
$FilesAfterGroupWritable = 0;	# files found after a group writable directory found
$GroupWritableDirectoryFound = 0;	# boolean, true if a group writable diectory found
$FilesAfterWorldWritable = 0;	# files found after a world writable directory found
$WorldWritableDirectoryFound = 0;	# boolean, true if a world writable diectory found
$world_writable_programs = 0;
$group_writable_programs = 0;
$ProgramsInSomeDir = 0;


# constants

$SEARCHPATH=1;
$NOSEARCHPATH=0;
# PERL variables
$| = 1;				# write to pipes immediately

$revision = "1.9";		# SCCS fills 1.9 in
$program = "trojan.pl";		# SCCS fills trojan.pl in
if ($program =~ /.M./) {	# does it match the trojan.pl SCCS string?
    $program = "Trojan";	# yes, fill in the name of the program
}
if ($revision =~ /%/) {		# is '%' part of the revision
    $beta = 1;			# A beta version
} else {
    $beta = 0;
}

printf("%s, %s, a study in trust...\n",
       $program, 
       $beta ? "Beta release" : "Revision $revision");
&getswitches();
&main();
&report();
exit 0;

# --- SUBROUTINES ---

sub getswitches {
    $FIRST = $[;
# parse command line arguments
    while ($ARGV[$FIRST] =~ /^-/) {
#	0 && printf("checkion option %s\n", $ARGV[$FIRST]);
# verbose
	$ARGV[$FIRST] =~ /^-v/ && ($verbose++,shift(@ARGV),next);
# debug  flag
	$ARGV[$FIRST] =~ /^-d/ && ($debug++,shift(@ARGV),next);
# all  flag
	$ARGV[$FIRST] =~ /^-a/ && ($all++,shift(@ARGV),next);
# report_all  flag
	$ARGV[$FIRST] =~ /^-A/ && ($report_all++,shift(@ARGV),next);
# brief  flag
	$ARGV[$FIRST] =~ /^-b/ && ($brief++,shift(@ARGV),next);
# -w flag
	$ARGV[$FIRST] =~ /^-w/ && ($do_world++,$do_group = 0, $do_user = 0,shift(@ARGV),next);
# -g flag
	$ARGV[$FIRST] =~ /^-g/ && ($do_world++,$do_group++, $do_user = 0,shift(@ARGV),next);
# -u flag
	$ARGV[$FIRST] =~ /^-u/ && ($do_world++,$do_group++, $do_user++,shift(@ARGV),next);
	last;
	
    }
}
sub main {
    &getusers();
    &getgroups();
    &dotrojans();
}
sub dotrojans {
    &checkrootdir();
    @dirs = split(/:/,$ENV{'PATH'});
    foreach $dir (@dirs) {
	$debug && $verbose && printf("%s: \n",$dir);
	$reason = "$dir is in your searchpath";
	if ($dir eq ".") {
	    $dot++;
	    $dir = `pwd`;
	    chop $dir;
	}
	if ( -l $dir) {
	    $link = readlink($dir);
	    $debug && printf("$dir points to  $link\n");
	    $reason .= " AND $dir -> $link";
	    if ($link !~ /^\// ) {
		# a relative link
		$link = &resolve($dir,$link);
		$reason .= " ($link) ";
	    }
	    &checkupdir($link,$reason,$SEARCHPATH);
	    while ( -l $link ) {
		$oldlink = $link;
		$link = readlink($oldlink); #
		if ($link !~ /^\// ) {
		    # a relative link
		    $newlink = &resolve($dir,$link);
		    $reason .= " ($newlink) ";
		}
		$reason .= "$oldlink -> $link AND"; 
		&checkupdir($link,$reason,$SEARCHPATH);
	    }
	    if ( -d $link ) {
		&checkdir($link, $reason);
		&checkupdir($link,$reason,$SEARCHPATH);
		&checkexecsindir($link, $reason);
		
		
	    }
	} elsif ( -d $dir ) {
	    &checkdir($dir, $reason);
	    &checkupdir($dir,$reason,$SEARCHPATH);
	    &checkexecsindir($dir, $reason);
	}
	
    }
}
sub checkdir {
    # check the directory itself - it was in the searchpath
    local($dir, $reason) = @_;
    # does the directory exist?
    if ( -l $dir ) {
	printf(STDERR "ERROR: I am testing $dir and it is a link.\n");
    } elsif ( -d $dir ) {
	&testdir($dir,$reason);
    } else {
	printf(STDERR "Missing Directory in searchpath : %s\n", $dir);
    }
}
sub testdir {
    # check the directory itself
    local($dir,$reason) = @_;
    local($hit) = 0;
    # does the directory exist?
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($dir);
    if ($mode & 002) {
	$hit = 1;
	$WorldWritableDirectoryFound = 1;
	&addworld_directory("$reason AND $dir is WORLD writable", $dir);
    }
    # if group writable AND (not world writable or all)
    if ((!$hit || $all) && ($mode & 020)) {
	$hit = 1;	    
	$GroupWritableDirectoryFound = 1;
	&addgroup_directory($gid,"$reason AND directory $dir is group writable",
			    $dir);
    }
    if (!$hit || $all) {
	&adduser($uid,"$reason AND directory $dir writable by owner"); # owner can write to directory
    }
}	
sub checkexecsindir {
    # check each executable in the directory
    local($dir, $problem) = @_;
    local($hit);
    local($program);
    local($myproblem);
    $verbose && printf("check execs in dir $dir, reason: $problem\n");
    opendir(D, $dir) || return 0;
    while ($file = readdir(D)) {
	$myproblem = $problem;
	(($file eq ".") || ($file eq "..")) && next;
	$TotalFiles++;	# increase number of files found
	$GroupWritableDirectoryFound && $FilesAfterGroupWritable++;
	$WorldWritableDirectoryFound && $FilesAfterWorldWritable++;
	# this is either a file, a directory, or a symbolic link.
	# if a directory, then don't worry about it.
	$program = "$dir/$file";
	# if file, only worry about it if it's executable,
	
	if ( -l $program) {
	    # this is a link. Does it point to a file or to a directory?
	    # the file in the searchpath is a symbolic link
	    # if it points to a directory, then check who owns the directory
	    #   it is pointing to
	    while ( -l $program ) {
		$link = readlink($program);	
		$myproblem .= " AND $program -> $link";
		if ($link !~ /^\// ) {
		    # a relative link
		    $link = &resolve($program,$link);
		    $myproblem .= " ($link) ";
		}
		$debug && printf("Problem is now: %s, new program is %s\n", 
				 $myproblem, $link);
		$newdir = $link;
		$newdir =~ s,/[^/]+$,,;	# remove the executable from the path, and check the directory
		$debug && printf("YES: The directory to check now is %s\n",
				 $newdir);
		&ProgramUsesDir($newdir);
		&checkupdir($newdir, "$myproblem ", $NOSEARCHPATH);
		$program = $link;
	    }
	    # no longer a link, it might be a file of directory
	    # get the stat on the final file
	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
	     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($link);
	    if (!defined($dev)) {
		# find where it's pointing
		!$brief && printf("Warning: symbolic link %s/%s pointing to missing file: %s\n", 
				 $dir,$file, $link);
		&checkmissingdir($link,$program);
	    } elsif ( -d $link ) {
		# a symbolic link points to a directory.
		# this is only a problem if the directory pointing to is inside
		# a directory that can be modified
		$verbose && printf("\n$dir/$file points to directory $link\n");
		$newdir = $link;
		$newdir =~ s,/[^/]+$,,;
		$verbose && printf("HEY: $link is a directory, and $newdir should be checked\n");
		&checkupdir($newdir, "$dir/$file -> $link AND ",$NOSEARCHPATH);
	    } else {
#		printf("$program points to file $link\n");
		$hit = 0;
		
		if ($mode & 0111) { # is this file executable?
		    ($hit = ($mode & 002)) && &addworld_file("$dir/$file -> $link AND $link is WORLD writable", "$dir/$file");
		    ($hit = ($mode & 020)) && ($all || !$hit)  && &addgroup_file($gid,"file $dir/$file -> $link AND $link is group writable", "$dir/$file");
		}
		($all || !$hit) && &adduser($uid,"file $dir/$file -> $link modifiable by owner");	# owner can modify the target file, and make it executable if it isn't
		# also check by going up the tree of the executable
		$newdir = $link;
		$newdir =~ s,/[^/]+$,,;
		
		$debug && printf("YO: link: $link, newdir: $newdir, calling checkupdir\n");
		&ProgramUsesDir($newdir);
		&checkupdir($newdir, "$dir/$file -> $link AND ",$NOSEARCHPATH);	# did I do this twice?
	    }
	    #
	    # if it is a file, check the permission of the file
	    #
	} elsif ( -d "$dir/$file" ) { # Not a link, maybe a directory?
	    # yes a directory in our search path. Does this mean anything?
	    # I guess not. We already go up the directory path
	    
	} else { # not a link or directory - a file
	    # stat the file

	    &ProgramUsesDir($dir);
	    &testfile("$dir/$file", "$dir/$file executable in path");
	}
    }
    close(D);
}

sub testfile {
    local($file,$reason) = @_;
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
    $hit = 0;
    if ($mode & 0111) { # is this file executable?
#	printf("Executable $dir/$file seen\n");
	# increase the number of programs seen
	# if the "." directory has been seen, then
	# this program can be trojanized
	$dot && $programsafterdot++;
	
	if ($mode & 002) {
	    # world writable
	    $hit = 1;
	    &addworld_file("$reason AND $file is WORLD writable", "$file");
	}
	# if group writable AND (not world writable or all)
	if ((!$hit || $all) && ($mode & 020)) {
	    $hit = 1;	    
	    &addgroup_file($gid,"$reason AND file $file is group writable", "$file");
	}
    }
    # it doesn't matter if the file is executable or not, 
    # the owner can make it executable
    ($all || !$hit) && &adduser($uid,"$reason AND file $file modifiable by owner");
}


sub adduser {
    local($user,$dir) = @_;
    if (defined($user{$user})) {
	if ($report_all) {
	    ($user != "0" && $user != $< ) && printf("user %s can do it because of %s\n", $user, $dir);
	} else {
	    $debug && $verbose && printf("user %s can do it because of %s\n", $user, $dir);
	}

	# add it to the list
	$user{$user} .= "\n$dir";
	$usercount{$user}++;
	
    } else {
	$user{$user} = $dir;
	$usercount{$user} = 1;
	$verbose && printf("user %s can do it because of %s\n", $user, $dir);
    }
}
sub addgroup_directory {
    local($gid,$reason,$dir) = @_;
#    $GroupWritableDirectoryFound = 1;
    if (!defined($group_writable{$dir})) {
	&addgroup($gid, $reason, $dir);
	$group_writable{$dir} = 1;
    } else {
	$group_writable{$dir}++ ;
	$verbose && printf("Directory '$dir' found again\n");
    }
}
sub addgroup_file {
    local($gid, $reason,$file) = @_;
    $verbose && printf("Group Writable program, gid: %d, file: %s, reasons: %s\n",
		       $gid, $file, $reason);
    $group_writable_programs++;
    &addgroup($gid, "File $reason", $file);
}
sub addgroup {
    local($gid,$reason) = @_;
    
    if (defined($group{$gid})) {
	if ($report_all) {
	    $all && printf("group %s can do it because of %s\n", $gid, $reason);
	} else {
	    $all && $verbose && printf("group %s can do it because of %s\n", $gid, $reason);

	}
	# add it to the list
	$group{$gid} .= "\n$reason";
	$groupcount{$gid}++;
    } else {
	$group{$gid} = $reason;
	$groupcount{$gid} = 1;
	$verbose && printf("group %s can do it because of %s\n", $gid, $reason);
    }
}
sub addworld_directory {
    local($reason,$dir) = @_;
#    $WorldWritableDirectoryFound = 1;
    if (!defined($world_writable{$dir})) {
	&addworld($reason);
	$world_writable{$dir} = 1;
    } else {
	$world_writable{$dir}++ ;
	$verbose && printf("Directory '$dir' found again\n");
    }
}
sub addworld_file {
    local($reason,$file) = @_;
    $world_writable_programs++;
    &addworld("File $reason");
}
sub addworld {
    local($reason) = @_;
    $reason =~ s/-\>/\n\t\t->/g;
    $reason =~ s/AND/\n\t\tAND/g;
    # remember world writable directories
    
    !$brief && printf("ANYONE can do it because of %s\n", $reason);
}
sub checkupdir {
    # check the paths leading to the directory
    local($dir, $reason,$onpath) = @_;
    # $onpath is true if this directory is on the searchpath, else false
    if (defined($did_checkup_dir{$dir})) {
	$debug && printf("already checked updir %s\n", $dir); 
	return 0;		# did it
    } else {
	$did_checkup_dir{$dir} = 1;
    }
    if ($dir eq "." ) {
	die " I should not see a dot in $dir while  in checkupdir";
    } elsif ( $dir =~ /^\.\// ) {
	die " I should not see a ./ in $dir while  in checkupdir";
    } elsif ( $dir =~ /\/\.\.\// ) {
	die " I should not see a /../ in $dir while  in checkupdir";
    } elsif ( $dir =~ /^\.\.\// ) {
	die " I should not see a ../ in $dir while  in checkupdir";
    }
    $verbose && printf("checking up dir %s, reason: %s\n",
		       $dir, $reason);
    # $dir is the file we are checking, and $reason is why (i.e. "a/b -> /c and")
#    $origfile = $dir;
    while ($dir ne "") {
	#remove the last path
	1 && $verbose && printf("checkupdir: checking %s\n", $dir);
	if ( -d $dir ) {
	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
	     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$dir");
	    $hit = 0;
	    if ($hit = ($mode & 002)) {
		$onpath && ($WorldWritableDirectoryFound = 1);
		&addworld_directory("$reason AND $dir is WORLD writable", $dir);
	    }
	    if ($hit = ($mode & 020)) {
		$onpath && ($GroupWritableDirectoryFound = 1);
		($all || !$hit) && &addgroup_directory($gid,"$reason $dir is group writable", $dir);
	    }
	    ($all || !$hit) && &adduser($uid,"$reason $dir is writable by owner");	# owner can write to directory
	} elsif ( ! -e $dir ) {
	    !$brief && printf(STDERR "WARNING: non-existing directory used: $dir\n");
	} else {
	    !$brief && printf(STDERR "WARNING: non-directory used: $dir\n");
	}
	$dir =~ s,/[^/]*$,,;	# remove last directory from path
    }
}
sub checkrootdir {
    # check the paths leading to the directory
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("/");
    $hit = 0;
    ($hit = ($mode & 002)) && &addworld_directory("'/' is WORLD writable", "/");
    ($hit = ($mode & 020)) && ($all || !$hit) && &addgroup_directory($gid,"Directory '/' is group writable", "/");
    ($all || !$hit) && &adduser($uid,"Directory '/' is writable by owner");	# owner can write to directory
}
sub checkmissingdir {
    # this argument is a file that is missing
    # check to see if each directory up the ladder
    # has permission problems.
    local($file, $where) = @_;
    $origfile = $file;
    while ($file =~ s,/[^/]*$,, && $file ne "") {
	#remove the last path
	$debug && $verbose && printf("checking %s\n", $file);
	if ( -d $file ) {
	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
	     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$file");
	    $hit = 0;
	    ($hit = ($mode & 002)) && &addworld_directory("$where -> $origfile AND $file is WORLD writable", $file);
	    ($hit = ($mode & 020)) && ($all || !$hit) && &addgroup_directory($gid,"$where -> $origfile AND $file is group writable", $file);
	    ($all || !$hit) && &adduser($uid,"$where -> $origfile AND directory $file is writable by owner");	# owner can write to directory
	}
    }
}
sub report {
# final report
    if ($debug || $verbose ) {
	printf("Options: ");
	$brief && printf("brief ");
	$all && printf("all  ");
	$do_world && printf("do_world ");
	$do_group && printf("do_group ");
	$do_user && printf("do_user ");
	$debug && printf("debug ");
	$verbose && printf("verbose ");
	printf("\n");
    }
    $WorldWritableProgramsByDirectory = 0;
    foreach $d (keys %world_writable) {
	printf("World writable directory %s makes %d files vulnerable\n",
	       $d, $ProgramsInDir{$d});
	$WorldWritableProgramsByDirectory += $ProgramsInDir{$d};
    }
    # now for each group
    if ($do_group) {
	$GroupWritableProgramsByDirectory = 0;
	foreach $d (keys %group_writable) {
	    printf("Group writable directory %s makes %d  files vulnerable\n",
		   $d,  $ProgramsInDir{$d});
	    $GroupWritableProgramsByDirectory += $ProgramsInDir{$d};
	}
	foreach $g (keys %group) {
	    $members = $ingroup{$g};
	    $name = $gid_to_name{$g};
	    $files = $group{$g};
	    $files =~ s/\n/\n\t/g;
	    $files =~ s/AND/AND\n\t\t/g;
	    # truncate all files but the first
	    if (!$brief) {
	    	printf("\nGroup %s can do it %d ways: \n\t%s\n",
		       $name, $groupcount{$g}, $files);
	    	if ($do_user) {
		    if (defined($members)) {
			printf("\tmembers of this group are:\n");
			undef(%dummy);
			foreach $m (split(/ /,$members)) {
			    if (!defined($dummy{$m})) {
				printf("\t\t%s\n", $m);	    
				$dummy{$m}=1;
			    }
			}
		    }
		}
	    }
	}
    }
# now look for each user
    if ($do_user) {
	$NumberOfProgramsOwnerByOtherUsers = 0;
	foreach $u (keys %user) {
	    $name = $inuid{$u};
	    $files = $user{$u};
	    if (!defined($name)) {
		printf("UNKNOWN USER, UID = %d, ", $u);
	    } else {
		if (defined($user_to_passwd{$name})) {
		    printf("User %s, UID: %d, ",
			   $name, $u);
		} elsif ($name =~ / /) {
		    # more than one person has this UID...
		    printf("Users %s, UID: %d, ",
			   $name, $u);
		} else {
		    printf("Users %s, UID: %d, ",
			   $name, $u);
		}
	    }
	    if ($u == 0) {
		printf("owns %d file, but you should be able to trust root",
		       $usercount{$u});
	    } elsif ($u == $>) {
		printf("owns %d file, (but you should be able to trust yourself :-)",
		       $usercount{$u});
	    } else {
		# truncate all files but the first
		($file) = split("\n", $files);
		printf("owns %d file%s",
		       $usercount{$u}, 
		       ($usercount{$u} == 1) ? "" : "s");
		!$brief && printf(", Example %s",
				  $file);
		$NumberOfProgramsOwnerByOtherUsers +=$usercount{$u};
	    }
	    printf("\n");
	}
    }
#    printf("Number of executable programs: %d\n", $programs);
    printf(" ---- Score (lower percentages are better) ----\n");
    
    $ProgramsInSomeDir = $TotalFiles;
    printf("Number of programs/files in searchpath: %d\n", $ProgramsInSomeDir);
    $do_user && printf("Number of programs writable by others (excluding root and self): %d (%4.2f%%)\n", 
		       $NumberOfProgramsOwnerByOtherUsers,
		       ( $NumberOfProgramsOwnerByOtherUsers/$ProgramsInSomeDir)*100 );
    if ($do_group) {
	printf("Number of group writable programs: %d (%4.2f%%)\n", 
	       $group_writable_programs, 
	       ($group_writable_programs/$ProgramsInSomeDir)*100 );
	$debug && printf("Number of executables in group writable directories: %d (%4.2f%%)\n", 
	       $GroupWritableProgramsByDirectory,
	       ( $GroupWritableProgramsByDirectory /$ProgramsInSomeDir)*100 );
    }
    printf("Number of world writable programs: %d (%4.2f%%)\n", 
	   $world_writable_programs, 
	   ($world_writable_programs/$ProgramsInSomeDir)*100 );
    $debug && printf("Number of executables in world writable directories: %d (%4.2f%%)\n", 
	   $WorldWritableProgramsByDirectory,
	   ( $WorldWritableProgramsByDirectory /$ProgramsInSomeDir)*100 );
    if ($dot) {
	printf("You have included '.' (current working directory) in your searchpath\n");
	if ($programsafterdot) {
	    
	    printf("%d files out of %d executable files (%4.2f%%) can be intercepted by a trojan horse depending on your current directory\n",
		   $programsafterdot, $ProgramsInSomeDir, ($programsafterdot/$ProgramsInSomeDir)*100.0);
	    printf("You are 100%% susceptible to a misspelled program in your current directory (e.g. 'mroe')\n");
	}
    }
    if ($WorldWritableDirectoryFound) {
	printf("%6.2f%% of your files (%d out of %d) may be intercepted because of world writable directories\n",
	($FilesAfterWorldWritable/$TotalFiles)*100,
	$FilesAfterWorldWritable,
	$TotalFiles);
    }
    if ($GroupWritableDirectoryFound) {
	printf("%6.2f%% of your files (%d out of %d) may be intercepted because of group writable directories\n",
	($FilesAfterGroupWritable/$TotalFiles)*100,
	$FilesAfterGroupWritable,
	$TotalFiles);
    }
    printf("----\n");
    printf("You may also want to check for set user or set group commands, using..\n");
    printf("\tfind / -type f -perm -4000 -print\n");
    printf("\tfind / -type f -perm -2000 -print\n");
    printf("... but this will take a while.\n");
    printf("You must also trust the systems that provide you with NFS directories\n");
	   


    
}


sub getusers {
    local($login,$passwd,$uid,$gid);
# learn about all of the users via the /etc/passwd file
    setpwent();			# # initialize the passwd scan
    while (@list = getpwent) {	# fetch the next entry
	($login,$passwd,$uid,$gid) = @list[0,1,2,3]; #grab the first 4 fields
	if ($debug && (($uid == 2) || ($uid == 3) || ($gid == 2) || ($gid == 3))) {
	    printf("User %s, UID: %d, GID: %d\n", $login, $uid, $gid);
	}
	&add_to_group($gid,$login);	# list of people who belong to the group
	&add_to_uid($uid,$login);	# list of accounts who have the same UID
	
	if (length($passwd) == 13) {
	    $user_to_passwd{$login} = $passwd; # do they have a password?
	} else {
#	    printf("user %s doesn't have a password\n", $login);
#	    printf("length of password %s is %d\n", $passwd, length($passwd));
	}
    }
    endpwent();			# end the scan
}
sub getgroups {
# learn about all of the groups via the /etc/group file
    local($login,$passwd,$uid,$members);
    setgrent();			# # initialize the group scan
    while (@list = getgrent()) {	# fetch the next entry
	($login,$passwd,$gid,$members) = @list[0,1,2,3]; #grab the first 4 fields
	if ($debug && (($gid == 2) || ($gid == 3))) {
	    printf("Group %s, GID: %d\n", $login, $gid);
	}
	if (!defined($gid_to_name{$gid})) {
	    $gid_to_name{$gid} = $login;
	} else {
	    # group already defined
	    if ($gid_to_name{$gid} ne $login)  {
		$verbose && printf("Group ID #%d, name: %s, also called %s - ignoring new name\n",
		       $gid, $gid_to_name{$gid}, $login);
	    }
	}

	# each of the members should be added to the group list
	foreach $m (split(/ /,$members)) {
	    0 && $debug &&  printf("adding %s to group %s(%d)\n",
				$m, $login, $gid);
	    &add_to_group($gid,$m);	# list of people who belong to the group
	}
	if (length($passwd) == 13) {
#	    $group_to_passwd{$login} = $passwd; # do they have a password?
	} else {
#	    printf("group %s doesn't have a password\n", $login);
#	    printf("length of password %s is %d\n", $passwd, length($passwd));
	}
    }
    endgrent();			# end the scan
    
}
sub add_to_group {
    local ($gid,$login) = @_;	# list of people who belong to the group
    # add user $login to group $gid
    if (defined($ingroup{$gid})) {
	$ingroup{$gid} .= " $login";
    } else {
	$ingroup{$gid} = "$login";
    }
}
sub add_to_uid {
    local($uid,$login) = @_;	# list of accounts who have the same UID
# create map of UID -> USERS
    if (defined($inuid{$uid})) {
	# check to see if name is in the list
	$found = 0;
	foreach $u (split(/ /,$inuid{$uid})) {
	    ($u eq $login) && $found++;
	}
	(!$found) && $inuid{$uid} .= " $login";
    } else {
	$inuid{$uid} = "$login";
    }
# check for map of user -<> UIDs.
#; if more than one, error
    if (defined($inuser{$login})) {
	if ($uid != $inuser{$login}) {
	    
	    $inuser{$login} .= " $uid";
	    printf(STDERR " User %s (UID: %d) has duplicate UID's : %s\n", $login, $uid, $inuser{$login});
	} else {
	    # saw this user twice, but the UID was the same
	}
    } else {
	$inuser{$login} = "$uid";
    }
    
}
sub resolve {			# resolve symbolic/soft links
    local($current,$link) = @_;
    local($newlink,$newcurrent);
    # we are faces with a relative symbolic link
    # that is, the firct character of $link is NOT a '/'
    # the following table is in a spefcial format that will allow
    # testing of each case. This is why there are so many cases
    # I have a script that extracts these tests and 
    # verifies the input and output
# START TEST
    # Current	Link		Output

# test variations of "/" as left
#;#	/	../		/
#;#	/	../../		/
#;#	/	../x/y		/x/y
#;#	/	../../x/y	/x/y
#;#	/	.		/
#;#	/	./x		/x
#;#	/	./x/y		/x/y
#;#	/./	.		/
#;#	/./	./x		/x
#;#	/./	./x/y		/x/y

#;#	/a/b	x/y		/a/x/y
#;#	/a	x		/x
#;#	/a	x/y		/x/y

#;#	/a/b/c	.		/a/b
#;#	/a/b/c	./x		/a/b/x
#;#	/a/b/c	../x		/a/x
#;#	/a/b/c	./../x		/a/x
#;#	/a/b/c	../../x		/x

# END TEST

    $newlink = "";
    if ($current =~ /^\.\.\// ) {
	die "ERROR : left side can't start with ../";
    } elsif ($current =~ /^\.\// ) {
	die "ERROR : left side can't start with ./";
    } elsif ($current =~ /^[^\/]/ ) {
	die "ERROR : left side can't start with non-/";
    }

    if ($link =~ /^\.\.\//) {	# ../
	#resolve relative link -> ../
	
	# remove last two items on current
	$newcurrent = $current;
	# change /a/b/c/d to /a/b
	$newcurrent =~ s,[^\/]+\/[^\/]+$,,;

	# remove ../ from ../xxxx
	$newlink = $link;
	$newlink =~ s,^\.\.\/,,;

	# combine two pieces
	$newlink = "$newcurrent$newlink";

	# there may still be a ../ in there
	# change x/v/../ to nothing
	$newlink =~ s,[^\/]+\/\.\.,,g;

	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
    } elsif ($link eq "." ) { # 
	#resolve relative link -> .
	# remove last part of path
	$newcurrent = $current;
	# change /a/b/c/d to /a/b/c
	$newcurrent =~ s,\/[^\/]+$,,; # /a/b/c -> /a/b

	$newlink = "$newcurrent";
	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
    } elsif ($link =~ /^\.\//) { # starts with ./
	#resolve relative link -> ./usr
	# remove last part of path
	$newcurrent = $current;
	# change /a/b/c/d to /a/b/c
	$newcurrent =~ s,\/[^\/]+$,,;

	# remove ./ from ./xxxx
	$newlink = $link;
	$newlink =~ s,^\.\/,,;	# ./xyz -> xyz

	# combine two pieces
	$newlink = "$newcurrent/$newlink";

	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
    } elsif ($link =~ /^[^\/]/) { # starts with aaa/
	#resolve relative link -> usr/
	# remove last part of path
	$newcurrent = $current;
	# change /a/b/c/d to /a/b/c
	$newcurrent =~ s,\/[^\/]+$,,; # /a/b/c -> /a/b

	$newlink = $link;

	# combine two pieces
	$newlink = "$newcurrent/$newlink";
	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
    } else {
	printf(STDERR "$current/$link becomes ?????\n");
    }

    $oldlink = "";
    while ($newlink ne $oldlink) { # repeat until no change
	$oldlink = $newlink;	#
	$debug && printf("RESOLVE: looping to fix $current -> $link which is now $newlink\n");

	# change /./ to /
	# John P. Rouillard <rouilj@terminus.cs.umb.edu> 
	$newlink =~ s,\/\.\/,\/,g;
	    
	# change X//Y to X/Y
	$newlink =~ s,\/\/,\/,g;

	# change A/B/../X to A/X
	$newlink =~ s,[^/]+\/\.\.,,g;

	# change ^/../ to /
	$newlink =~ s,^\/\.\.\/,\/,g;
	

	# change X/./Y to X/Y
	$newlink =~ s,/\./,\/,g;	

    }    

    if ($newlink !~ /^\//) {
	die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
    } elsif ($newlink =~ /\/\.\.\//) {
	die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
    } elsif ($newlink =~ /\/\.\//) {
	die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
    }
    return $newlink;
} # end resolve
sub ProgramUsesDir {
# this procedure is called once for each program.
# this input is a directory
    local($dir) = @_;
    if ( ! -d $dir ) {
	if (! -e $dir ) {
	    # file doesn't exist
	    return;
	} else {
	    die  "Directory $dir  NOT a directory, serious bug, aborting";
	}
    }
    $ProgramsInSomeDir++;
    if (defined($ProgramsInDir{$dir})) {
	$ProgramsInDir{$dir}++; 
    } else {
	$ProgramsInDir{$dir} = 1;
    }

# now do the same thing with each step up the directory tree
    while ($dir ne "/") {
	$dir =~ s,\/[^\/]*$,,;	# Chris.Rouch@wg.estec.esa.nl found this bug
	if ($dir eq "") {
	    $dir = "/";
	}
	if (defined($ProgramsInDir{$dir})) {
	    $ProgramsInDir{$dir}++; 
	} else {
	    $ProgramsInDir{$dir} = 1;
	}

    }

}