From: barnett@crd.ge.com (Bruce Barnett)
Newsgroups: comp.sources.misc
Subject: v43i038:  trojan.pl - Trojan Horse Checker rev 1.9, Part01/01
Date: 10 Jun 1994 11:02:16 -0500
Organization: Sterling Software
Sender: kent@sparky.sterling.com
Approved: kent@sparky.sterling.com
Message-ID: <2ta2q8$cuq@sparky.sterling.com>
X-Md4-Signature: 79222fdb85e64a6d11a1309bb2aced50

Submitted-by: barnett@crd.ge.com (Bruce Barnett)
Posting-number: Volume 43, Issue 38
Archive-name: trojan.pl/part01
Environment: UNIX, perl

Trojan.pl is a trojan horse checking program.  It examines your
searchpath and looks at all of the executables in your searchpath,
looking for people who can create a trojan hource you can execute.

usage: 
	perl trojan.pl

See the script for more informations on the various options.

For those who ask:

The difference between COPS and trojan.pl is this:

1) COPS is typically run by root. Trojan.pl should be executed by
anyone who wants to protect their own account. 

A trojan horse will often be created by someone who isn't root, to
either gain access to root, or to gain access to someone who can gain
access to root. If I can create a trojan horse that can break into a
staff account, I might be able to create a trojan to break into a root
account. Therefore all system administrators should run trojan.pl from
their own account. Why bother to have a secure root account, when the
system administration accounts are wide open?

2) trojan.pl only checks searchpaths, as they exist at the time of execution.
I have several searchpaths, and they change during the day.
You want to check the searchpath during "normal" conditions.
Therefore you don't want to check searchpaths in a cron job, but
in a window running a shell.

3) Trojan.pl checks symbolic (soft) links. If you have the the
directory /usr/local/bin in your searchpath, and the file
		/usr/local/bin/abc 
is linked to 
		/local/bin/abc 
which is linked to 
		/elsewhere/bin/abc

trojan.pl checks the following directories:

		/
		/usr
		/usr/local
		/usr/local/bin
		/local/bin
		/local
		/elsewhere/bin
		/elsewhere

	
Any of those directories might be group or world writable. Or the
owner may not be root. Trojan.pl tells you who can drop a trojan in
front of you and how. Symbolic links can be very messy to check into,
and I don't know of any other program that does this check.

and

4) trojan.pl gives you a numerical score of how good a job you are
doing. Hopefully you can improve your score
------
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  trojan.README trojan.pl
# Wrapped by barnett@grymoire on Thu May 26 11:45:15 1994
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f trojan.README -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"trojan.README\"
else
echo shar: Extracting \"trojan.README\" \(2585 characters\)
sed "s/^X//" >trojan.README <<'END_OF_trojan.README'
XREADME for trojan.pl
X
XCreated by Bruce Barnett <barnett@crd.ge.com>
X
XTrojan.pl is a trojan horse checking program.  It examines your
Xsearchpath and looks at all of the executables in your searchpath,
Xlooking for people who can create a trojan hource you can execute.
X
Xusage: 
X	perl trojan.pl
X
XSee the script for more informations on the various options.
X
XFor those who ask:
X
XThe difference between COPS and trojan.pl is this:
X
X1) COPS is typically run by root. Trojan.pl should be executed by
Xanyone who wants to protect their own account. 
X
XA trojan horse will often be created by someone who isn't root, to
Xeither gain access to root, or to gain access to someone who can gain
Xaccess to root. If I can create a trojan horse that can break into a
Xstaff account, I might be able to create a trojan to break into a root
Xaccount. Therefore all system administrators should run trojan.pl from
Xtheir own account. Why bother to have a secure root account, when the
Xsystem administration accounts are wide open?
X
X2) trojan.pl only checks searchpaths, as they exist at the time of execution.
XI have several searchpaths, and they change during the day.
XYou want to check the searchpath during "normal" conditions.
XTherefore you don't want to check searchpaths in a cron job, but
Xin a window running a shell.
X
X3) Trojan.pl checks symbolic (soft) links. If you have the the
Xdirectory /usr/local/bin in your searchpath, and the file
X		/usr/local/bin/abc 
Xis linked to 
X		/local/bin/abc 
Xwhich is linked to 
X		/elsewhere/bin/abc
X
Xtrojan.pl checks the following directories:
X
X		/
X		/usr
X		/usr/local
X		/usr/local/bin
X		/local/bin
X		/local
X		/elsewhere/bin
X		/elsewhere
X
X	
XAny of those directories might be group or world writable. Or the
Xowner may not be root. Trojan.pl tells you who can drop a trojan in
Xfront of you and how. Symbolic links can be very messy to check into,
Xand I don't know of any other program that does this check.
X
Xand
X
X4) trojan.pl gives you a numerical score of how good a job you are
Xdoing. Hopefully you can improve your score
X
X
X
XRevision History:
X
X	1.0 Sent to some individuals
X
X	1.3 Submitted to bugtraq mailing list
X	1.4 bug fix suggested by John P. Rouillard <rouilj@terminus.cs.umb.edu>
X	1.5 added -A option by request of Dave Sill <de5@de5.CTD.ORNL.GOV>
X	1.7 submitted to comp.unix.security and Firewalls
X	1.8 added a more robust testing mechanism for resolve problems
X	1.9 added a check for directories that end with "/", 
X		thanks to Chris Rouch
X
XTODO
X
XLists executables in directories, but doesn't list symbolic links.
XI have a directory that has all links.
X
X
X
X
X
END_OF_trojan.README
if test 2585 -ne `wc -c <trojan.README`; then
    echo shar: \"trojan.README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f trojan.pl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"trojan.pl\"
else
echo shar: Extracting \"trojan.pl\" \(30278 characters\)
sed "s/^X//" >trojan.pl <<'END_OF_trojan.pl'
X##!/bin/sh -- 					# wish I were -*-Perl-*-
X#eval 'exec perl -S $0 ${1+"$@"}'
X#    if !$$;
X#!/bin/perl
X
X# Look for trojan horses...
X
X# A trojan horse looks like a regular program. 
X# however, if you execute it, the program may set up a back door to 
X# your account, or modify one of your files, etc.
X#
X# This script reports on the different ways someone can drop a trojan hourse
X# in your searchpath.
X#
X# It does not check for set UID or GID programs on your file system, 
X# and does not check NFS permissions of directories.
X# It only checks for executables in your searchpath, and reports who and how
X# someone can create a trojan horse. 
X#
X# This program also provides a measurement of how vunerable you are to a
X# trojan horse. 
X#
X# Bruce Barnett <barnett@crd.ge.com>
X# Copyright 1994 GE
X# All commercial Rights reserved
X# 
X# @(#)trojan.pl	1.9 26 May 1994
X#
X# usage:
X# 
X#	perl trojan.pl [options]
X#
X#	where options are any combination of the following
X#	-b	- brief report. Don't show reasons or executables
X#	-a	- analyze all files. Normally when a file is world writable,
X#			don't check for group or user writable
X#			the -a means look at all problems, and not the first
X#	-w	- just report on world writable problems (no group or user)
X#	-g	- report on group writable problems ( sets -w, no user)
X#	-u	- report on world, group and user writable problems (Default)
X#	-A	- report all files that cause a problem with a group writable
X#  		  permission, not just the first one
X#
X# for debugging purposes, and for more information, try the following options
X#	-v	- verbose
X#	-d	- debug
X#
X#	Examples
X#	trojan.pl		- reports world, group and user problems
X#			  shows reasons for problem
X#	trojan.pl -b		- reports world, group and user problems
X#			  Doesn't show reasons
X#	trojan.pl -b -a	- reports world, group and user problems
X#			  Doesn't show reasons
X#			  reports on ALL  world, group and user 
X#			  writable problems
X#	trojan.pl -b -a -A	- reports world, group and user problems
X#			  Doesn't show reasons
X#			  reports on ALL  world, group and user 
X#			  writable problems
X#			  Also reports all files that cause group write access
X#
X#
X#	trojan.pl -w 		- reports world writable problems and reasons
X#	trojan.pl -g 		- reports world + group writable problems and reasons
X
X#	you probably want to start with trojan.pl -b 
X#	and fix some of those problems first
X#	If you don't understand why it's a problem, omit the -b option
X
X#	A malicious cracker will often use your co-workers accounts
X# 	as a stepping stone to getting root (or bin, daemon, sys, etc.) 
X#       access. Therefore you have to trust that none of the people who 
X#	could drop a trojan horse in front of you have had their accounts 
X#       compromised. If you don't trust them, then don't allow their 
X#	binaries in your searchpath.
X#
X
X$not_a_csh_script = 0;	# this is used in case someone tries
X				# "csh trojan.pl"
X# command line OPTIONS
X$all = 0;			# print out a more detailed report, (all tests)
X$report_all = 0;			# report all files, not just the first one
X$do_world = 1;			# print out world writable items
X$do_group = 1;			# print out group writable items
X$do_user = 1;			# print out user specific info
X$brief = 0;			# a short report
X
X$verbose=0;			# print more information
X$debug = 0;			# 
X
X
X
X# VARIABLES
X$dot = 0;	# have I seen the "." directory in the path yet?
X$programsafterdot = 0;		# how many files were found after the dot?
X$TotalFiles = 0;			# total programs or files found in the $PATH directories
X$FilesAfterGroupWritable = 0;	# files found after a group writable directory found
X$GroupWritableDirectoryFound = 0;	# boolean, true if a group writable diectory found
X$FilesAfterWorldWritable = 0;	# files found after a world writable directory found
X$WorldWritableDirectoryFound = 0;	# boolean, true if a world writable diectory found
X$world_writable_programs = 0;
X$group_writable_programs = 0;
X$ProgramsInSomeDir = 0;
X
X
X# constants
X
X$SEARCHPATH=1;
X$NOSEARCHPATH=0;
X# PERL variables
X$| = 1;				# write to pipes immediately
X
X$revision = "1.9";		# SCCS fills 1.9 in
X$program = "trojan.pl";		# SCCS fills trojan.pl in
Xif ($program =~ /.M./) {	# does it match the trojan.pl SCCS string?
X    $program = "Trojan";	# yes, fill in the name of the program
X}
Xif ($revision =~ /%/) {		# is '%' part of the revision
X    $beta = 1;			# A beta version
X} else {
X    $beta = 0;
X}
X
Xprintf("%s, %s, a study in trust...\n",
X       $program, 
X       $beta ? "Beta release" : "Revision $revision");
X&getswitches();
X&main();
X&report();
Xexit 0;
X
X# --- SUBROUTINES ---
X
Xsub getswitches {
X    $FIRST = $[;
X# parse command line arguments
X    while ($ARGV[$FIRST] =~ /^-/) {
X#	0 && printf("checkion option %s\n", $ARGV[$FIRST]);
X# verbose
X	$ARGV[$FIRST] =~ /^-v/ && ($verbose++,shift(@ARGV),next);
X# debug  flag
X	$ARGV[$FIRST] =~ /^-d/ && ($debug++,shift(@ARGV),next);
X# all  flag
X	$ARGV[$FIRST] =~ /^-a/ && ($all++,shift(@ARGV),next);
X# report_all  flag
X	$ARGV[$FIRST] =~ /^-A/ && ($report_all++,shift(@ARGV),next);
X# brief  flag
X	$ARGV[$FIRST] =~ /^-b/ && ($brief++,shift(@ARGV),next);
X# -w flag
X	$ARGV[$FIRST] =~ /^-w/ && ($do_world++,$do_group = 0, $do_user = 0,shift(@ARGV),next);
X# -g flag
X	$ARGV[$FIRST] =~ /^-g/ && ($do_world++,$do_group++, $do_user = 0,shift(@ARGV),next);
X# -u flag
X	$ARGV[$FIRST] =~ /^-u/ && ($do_world++,$do_group++, $do_user++,shift(@ARGV),next);
X	last;
X	
X    }
X}
Xsub main {
X    &getusers();
X    &getgroups();
X    &dotrojans();
X}
Xsub dotrojans {
X    &checkrootdir();
X    @dirs = split(/:/,$ENV{'PATH'});
X    foreach $dir (@dirs) {
X	$debug && $verbose && printf("%s: \n",$dir);
X	$reason = "$dir is in your searchpath";
X	if ($dir eq ".") {
X	    $dot++;
X	    $dir = `pwd`;
X	    chop $dir;
X	}
X	if ( -l $dir) {
X	    $link = readlink($dir);
X	    $debug && printf("$dir points to  $link\n");
X	    $reason .= " AND $dir -> $link";
X	    if ($link !~ /^\// ) {
X		# a relative link
X		$link = &resolve($dir,$link);
X		$reason .= " ($link) ";
X	    }
X	    &checkupdir($link,$reason,$SEARCHPATH);
X	    while ( -l $link ) {
X		$oldlink = $link;
X		$link = readlink($oldlink); #
X		if ($link !~ /^\// ) {
X		    # a relative link
X		    $newlink = &resolve($dir,$link);
X		    $reason .= " ($newlink) ";
X		}
X		$reason .= "$oldlink -> $link AND"; 
X		&checkupdir($link,$reason,$SEARCHPATH);
X	    }
X	    if ( -d $link ) {
X		&checkdir($link, $reason);
X		&checkupdir($link,$reason,$SEARCHPATH);
X		&checkexecsindir($link, $reason);
X		
X		
X	    }
X	} elsif ( -d $dir ) {
X	    &checkdir($dir, $reason);
X	    &checkupdir($dir,$reason,$SEARCHPATH);
X	    &checkexecsindir($dir, $reason);
X	}
X	
X    }
X}
Xsub checkdir {
X    # check the directory itself - it was in the searchpath
X    local($dir, $reason) = @_;
X    # does the directory exist?
X    if ( -l $dir ) {
X	printf(STDERR "ERROR: I am testing $dir and it is a link.\n");
X    } elsif ( -d $dir ) {
X	&testdir($dir,$reason);
X    } else {
X	printf(STDERR "Missing Directory in searchpath : %s\n", $dir);
X    }
X}
Xsub testdir {
X    # check the directory itself
X    local($dir,$reason) = @_;
X    local($hit) = 0;
X    # does the directory exist?
X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
X     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($dir);
X    if ($mode & 002) {
X	$hit = 1;
X	$WorldWritableDirectoryFound = 1;
X	&addworld_directory("$reason AND $dir is WORLD writable", $dir);
X    }
X    # if group writable AND (not world writable or all)
X    if ((!$hit || $all) && ($mode & 020)) {
X	$hit = 1;	    
X	$GroupWritableDirectoryFound = 1;
X	&addgroup_directory($gid,"$reason AND directory $dir is group writable",
X			    $dir);
X    }
X    if (!$hit || $all) {
X	&adduser($uid,"$reason AND directory $dir writable by owner"); # owner can write to directory
X    }
X}	
Xsub checkexecsindir {
X    # check each executable in the directory
X    local($dir, $problem) = @_;
X    local($hit);
X    local($program);
X    local($myproblem);
X    $verbose && printf("check execs in dir $dir, reason: $problem\n");
X    opendir(D, $dir) || return 0;
X    while ($file = readdir(D)) {
X	$myproblem = $problem;
X	(($file eq ".") || ($file eq "..")) && next;
X	$TotalFiles++;	# increase number of files found
X	$GroupWritableDirectoryFound && $FilesAfterGroupWritable++;
X	$WorldWritableDirectoryFound && $FilesAfterWorldWritable++;
X	# this is either a file, a directory, or a symbolic link.
X	# if a directory, then don't worry about it.
X	$program = "$dir/$file";
X	# if file, only worry about it if it's executable,
X	
X	if ( -l $program) {
X	    # this is a link. Does it point to a file or to a directory?
X	    # the file in the searchpath is a symbolic link
X	    # if it points to a directory, then check who owns the directory
X	    #   it is pointing to
X	    while ( -l $program ) {
X		$link = readlink($program);	
X		$myproblem .= " AND $program -> $link";
X		if ($link !~ /^\// ) {
X		    # a relative link
X		    $link = &resolve($program,$link);
X		    $myproblem .= " ($link) ";
X		}
X		$debug && printf("Problem is now: %s, new program is %s\n", 
X				 $myproblem, $link);
X		$newdir = $link;
X		$newdir =~ s,/[^/]+$,,;	# remove the executable from the path, and check the directory
X		$debug && printf("YES: The directory to check now is %s\n",
X				 $newdir);
X		&ProgramUsesDir($newdir);
X		&checkupdir($newdir, "$myproblem ", $NOSEARCHPATH);
X		$program = $link;
X	    }
X	    # no longer a link, it might be a file of directory
X	    # get the stat on the final file
X	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
X	     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($link);
X	    if (!defined($dev)) {
X		# find where it's pointing
X		!$brief && printf("Warning: symbolic link %s/%s pointing to missing file: %s\n", 
X				 $dir,$file, $link);
X		&checkmissingdir($link,$program);
X	    } elsif ( -d $link ) {
X		# a symbolic link points to a directory.
X		# this is only a problem if the directory pointing to is inside
X		# a directory that can be modified
X		$verbose && printf("\n$dir/$file points to directory $link\n");
X		$newdir = $link;
X		$newdir =~ s,/[^/]+$,,;
X		$verbose && printf("HEY: $link is a directory, and $newdir should be checked\n");
X		&checkupdir($newdir, "$dir/$file -> $link AND ",$NOSEARCHPATH);
X	    } else {
X#		printf("$program points to file $link\n");
X		$hit = 0;
X		
X		if ($mode & 0111) { # is this file executable?
X		    ($hit = ($mode & 002)) && &addworld_file("$dir/$file -> $link AND $link is WORLD writable", "$dir/$file");
X		    ($hit = ($mode & 020)) && ($all || !$hit)  && &addgroup_file($gid,"file $dir/$file -> $link AND $link is group writable", "$dir/$file");
X		}
X		($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
X		# also check by going up the tree of the executable
X		$newdir = $link;
X		$newdir =~ s,/[^/]+$,,;
X		
X		$debug && printf("YO: link: $link, newdir: $newdir, calling checkupdir\n");
X		&ProgramUsesDir($newdir);
X		&checkupdir($newdir, "$dir/$file -> $link AND ",$NOSEARCHPATH);	# did I do this twice?
X	    }
X	    #
X	    # if it is a file, check the permission of the file
X	    #
X	} elsif ( -d "$dir/$file" ) { # Not a link, maybe a directory?
X	    # yes a directory in our search path. Does this mean anything?
X	    # I guess not. We already go up the directory path
X	    
X	} else { # not a link or directory - a file
X	    # stat the file
X
X	    &ProgramUsesDir($dir);
X	    &testfile("$dir/$file", "$dir/$file executable in path");
X	}
X    }
X    close(D);
X}
X
Xsub testfile {
X    local($file,$reason) = @_;
X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
X     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
X    $hit = 0;
X    if ($mode & 0111) { # is this file executable?
X#	printf("Executable $dir/$file seen\n");
X	# increase the number of programs seen
X	# if the "." directory has been seen, then
X	# this program can be trojanized
X	$dot && $programsafterdot++;
X	
X	if ($mode & 002) {
X	    # world writable
X	    $hit = 1;
X	    &addworld_file("$reason AND $file is WORLD writable", "$file");
X	}
X	# if group writable AND (not world writable or all)
X	if ((!$hit || $all) && ($mode & 020)) {
X	    $hit = 1;	    
X	    &addgroup_file($gid,"$reason AND file $file is group writable", "$file");
X	}
X    }
X    # it doesn't matter if the file is executable or not, 
X    # the owner can make it executable
X    ($all || !$hit) && &adduser($uid,"$reason AND file $file modifiable by owner");
X}
X
X
Xsub adduser {
X    local($user,$dir) = @_;
X    if (defined($user{$user})) {
X	if ($report_all) {
X	    ($user != "0" && $user != $< ) && printf("user %s can do it because of %s\n", $user, $dir);
X	} else {
X	    $debug && $verbose && printf("user %s can do it because of %s\n", $user, $dir);
X	}
X
X	# add it to the list
X	$user{$user} .= "\n$dir";
X	$usercount{$user}++;
X	
X    } else {
X	$user{$user} = $dir;
X	$usercount{$user} = 1;
X	$verbose && printf("user %s can do it because of %s\n", $user, $dir);
X    }
X}
Xsub addgroup_directory {
X    local($gid,$reason,$dir) = @_;
X#    $GroupWritableDirectoryFound = 1;
X    if (!defined($group_writable{$dir})) {
X	&addgroup($gid, $reason, $dir);
X	$group_writable{$dir} = 1;
X    } else {
X	$group_writable{$dir}++ ;
X	$verbose && printf("Directory '$dir' found again\n");
X    }
X}
Xsub addgroup_file {
X    local($gid, $reason,$file) = @_;
X    $verbose && printf("Group Writable program, gid: %d, file: %s, reasons: %s\n",
X		       $gid, $file, $reason);
X    $group_writable_programs++;
X    &addgroup($gid, "File $reason", $file);
X}
Xsub addgroup {
X    local($gid,$reason) = @_;
X    
X    if (defined($group{$gid})) {
X	if ($report_all) {
X	    $all && printf("group %s can do it because of %s\n", $gid, $reason);
X	} else {
X	    $all && $verbose && printf("group %s can do it because of %s\n", $gid, $reason);
X
X	}
X	# add it to the list
X	$group{$gid} .= "\n$reason";
X	$groupcount{$gid}++;
X    } else {
X	$group{$gid} = $reason;
X	$groupcount{$gid} = 1;
X	$verbose && printf("group %s can do it because of %s\n", $gid, $reason);
X    }
X}
Xsub addworld_directory {
X    local($reason,$dir) = @_;
X#    $WorldWritableDirectoryFound = 1;
X    if (!defined($world_writable{$dir})) {
X	&addworld($reason);
X	$world_writable{$dir} = 1;
X    } else {
X	$world_writable{$dir}++ ;
X	$verbose && printf("Directory '$dir' found again\n");
X    }
X}
Xsub addworld_file {
X    local($reason,$file) = @_;
X    $world_writable_programs++;
X    &addworld("File $reason");
X}
Xsub addworld {
X    local($reason) = @_;
X    $reason =~ s/-\>/\n\t\t->/g;
X    $reason =~ s/AND/\n\t\tAND/g;
X    # remember world writable directories
X    
X    !$brief && printf("ANYONE can do it because of %s\n", $reason);
X}
Xsub checkupdir {
X    # check the paths leading to the directory
X    local($dir, $reason,$onpath) = @_;
X    # $onpath is true if this directory is on the searchpath, else false
X    if (defined($did_checkup_dir{$dir})) {
X	$debug && printf("already checked updir %s\n", $dir); 
X	return 0;		# did it
X    } else {
X	$did_checkup_dir{$dir} = 1;
X    }
X    if ($dir eq "." ) {
X	die " I should not see a dot in $dir while  in checkupdir";
X    } elsif ( $dir =~ /^\.\// ) {
X	die " I should not see a ./ in $dir while  in checkupdir";
X    } elsif ( $dir =~ /\/\.\.\// ) {
X	die " I should not see a /../ in $dir while  in checkupdir";
X    } elsif ( $dir =~ /^\.\.\// ) {
X	die " I should not see a ../ in $dir while  in checkupdir";
X    }
X    $verbose && printf("checking up dir %s, reason: %s\n",
X		       $dir, $reason);
X    # $dir is the file we are checking, and $reason is why (i.e. "a/b -> /c and")
X#    $origfile = $dir;
X    while ($dir ne "") {
X	#remove the last path
X	1 && $verbose && printf("checkupdir: checking %s\n", $dir);
X	if ( -d $dir ) {
X	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
X	     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$dir");
X	    $hit = 0;
X	    if ($hit = ($mode & 002)) {
X		$onpath && ($WorldWritableDirectoryFound = 1);
X		&addworld_directory("$reason AND $dir is WORLD writable", $dir);
X	    }
X	    if ($hit = ($mode & 020)) {
X		$onpath && ($GroupWritableDirectoryFound = 1);
X		($all || !$hit) && &addgroup_directory($gid,"$reason $dir is group writable", $dir);
X	    }
X	    ($all || !$hit) && &adduser($uid,"$reason $dir is writable by owner");	# owner can write to directory
X	} elsif ( ! -e $dir ) {
X	    !$brief && printf(STDERR "WARNING: non-existing directory used: $dir\n");
X	} else {
X	    !$brief && printf(STDERR "WARNING: non-directory used: $dir\n");
X	}
X	$dir =~ s,/[^/]*$,,;	# remove last directory from path
X    }
X}
Xsub checkrootdir {
X    # check the paths leading to the directory
X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
X     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("/");
X    $hit = 0;
X    ($hit = ($mode & 002)) && &addworld_directory("'/' is WORLD writable", "/");
X    ($hit = ($mode & 020)) && ($all || !$hit) && &addgroup_directory($gid,"Directory '/' is group writable", "/");
X    ($all || !$hit) && &adduser($uid,"Directory '/' is writable by owner");	# owner can write to directory
X}
Xsub checkmissingdir {
X    # this argument is a file that is missing
X    # check to see if each directory up the ladder
X    # has permission problems.
X    local($file, $where) = @_;
X    $origfile = $file;
X    while ($file =~ s,/[^/]*$,, && $file ne "") {
X	#remove the last path
X	$debug && $verbose && printf("checking %s\n", $file);
X	if ( -d $file ) {
X	    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
X	     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$file");
X	    $hit = 0;
X	    ($hit = ($mode & 002)) && &addworld_directory("$where -> $origfile AND $file is WORLD writable", $file);
X	    ($hit = ($mode & 020)) && ($all || !$hit) && &addgroup_directory($gid,"$where -> $origfile AND $file is group writable", $file);
X	    ($all || !$hit) && &adduser($uid,"$where -> $origfile AND directory $file is writable by owner");	# owner can write to directory
X	}
X    }
X}
Xsub report {
X# final report
X    if ($debug || $verbose ) {
X	printf("Options: ");
X	$brief && printf("brief ");
X	$all && printf("all  ");
X	$do_world && printf("do_world ");
X	$do_group && printf("do_group ");
X	$do_user && printf("do_user ");
X	$debug && printf("debug ");
X	$verbose && printf("verbose ");
X	printf("\n");
X    }
X    $WorldWritableProgramsByDirectory = 0;
X    foreach $d (keys %world_writable) {
X	printf("World writable directory %s makes %d files vulnerable\n",
X	       $d, $ProgramsInDir{$d});
X	$WorldWritableProgramsByDirectory += $ProgramsInDir{$d};
X    }
X    # now for each group
X    if ($do_group) {
X	$GroupWritableProgramsByDirectory = 0;
X	foreach $d (keys %group_writable) {
X	    printf("Group writable directory %s makes %d  files vulnerable\n",
X		   $d,  $ProgramsInDir{$d});
X	    $GroupWritableProgramsByDirectory += $ProgramsInDir{$d};
X	}
X	foreach $g (keys %group) {
X	    $members = $ingroup{$g};
X	    $name = $gid_to_name{$g};
X	    $files = $group{$g};
X	    $files =~ s/\n/\n\t/g;
X	    $files =~ s/AND/AND\n\t\t/g;
X	    # truncate all files but the first
X	    if (!$brief) {
X	    	printf("\nGroup %s can do it %d ways: \n\t%s\n",
X		       $name, $groupcount{$g}, $files);
X	    	if ($do_user) {
X		    if (defined($members)) {
X			printf("\tmembers of this group are:\n");
X			undef(%dummy);
X			foreach $m (split(/ /,$members)) {
X			    if (!defined($dummy{$m})) {
X				printf("\t\t%s\n", $m);	    
X				$dummy{$m}=1;
X			    }
X			}
X		    }
X		}
X	    }
X	}
X    }
X# now look for each user
X    if ($do_user) {
X	$NumberOfProgramsOwnerByOtherUsers = 0;
X	foreach $u (keys %user) {
X	    $name = $inuid{$u};
X	    $files = $user{$u};
X	    if (!defined($name)) {
X		printf("UNKNOWN USER, UID = %d, ", $u);
X	    } else {
X		if (defined($user_to_passwd{$name})) {
X		    printf("User %s, UID: %d, ",
X			   $name, $u);
X		} elsif ($name =~ / /) {
X		    # more than one person has this UID...
X		    printf("Users %s, UID: %d, ",
X			   $name, $u);
X		} else {
X		    printf("Users %s, UID: %d, ",
X			   $name, $u);
X		}
X	    }
X	    if ($u == 0) {
X		printf("owns %d file, but you should be able to trust root",
X		       $usercount{$u});
X	    } elsif ($u == $>) {
X		printf("owns %d file, (but you should be able to trust yourself :-)",
X		       $usercount{$u});
X	    } else {
X		# truncate all files but the first
X		($file) = split("\n", $files);
X		printf("owns %d file%s",
X		       $usercount{$u}, 
X		       ($usercount{$u} == 1) ? "" : "s");
X		!$brief && printf(", Example %s",
X				  $file);
X		$NumberOfProgramsOwnerByOtherUsers +=$usercount{$u};
X	    }
X	    printf("\n");
X	}
X    }
X#    printf("Number of executable programs: %d\n", $programs);
X    printf(" ---- Score (lower percentages are better) ----\n");
X    
X    $ProgramsInSomeDir = $TotalFiles;
X    printf("Number of programs/files in searchpath: %d\n", $ProgramsInSomeDir);
X    $do_user && printf("Number of programs writable by others (excluding root and self): %d (%4.2f%%)\n", 
X		       $NumberOfProgramsOwnerByOtherUsers,
X		       ( $NumberOfProgramsOwnerByOtherUsers/$ProgramsInSomeDir)*100 );
X    if ($do_group) {
X	printf("Number of group writable programs: %d (%4.2f%%)\n", 
X	       $group_writable_programs, 
X	       ($group_writable_programs/$ProgramsInSomeDir)*100 );
X	$debug && printf("Number of executables in group writable directories: %d (%4.2f%%)\n", 
X	       $GroupWritableProgramsByDirectory,
X	       ( $GroupWritableProgramsByDirectory /$ProgramsInSomeDir)*100 );
X    }
X    printf("Number of world writable programs: %d (%4.2f%%)\n", 
X	   $world_writable_programs, 
X	   ($world_writable_programs/$ProgramsInSomeDir)*100 );
X    $debug && printf("Number of executables in world writable directories: %d (%4.2f%%)\n", 
X	   $WorldWritableProgramsByDirectory,
X	   ( $WorldWritableProgramsByDirectory /$ProgramsInSomeDir)*100 );
X    if ($dot) {
X	printf("You have included '.' (current working directory) in your searchpath\n");
X	if ($programsafterdot) {
X	    
X	    printf("%d files out of %d executable files (%4.2f%%) can be intercepted by a trojan horse depending on your current directory\n",
X		   $programsafterdot, $ProgramsInSomeDir, ($programsafterdot/$ProgramsInSomeDir)*100.0);
X	    printf("You are 100%% susceptible to a misspelled program in your current directory (e.g. 'mroe')\n");
X	}
X    }
X    if ($WorldWritableDirectoryFound) {
X	printf("%6.2f%% of your files (%d out of %d) may be intercepted because of world writable directories\n",
X	($FilesAfterWorldWritable/$TotalFiles)*100,
X	$FilesAfterWorldWritable,
X	$TotalFiles);
X    }
X    if ($GroupWritableDirectoryFound) {
X	printf("%6.2f%% of your files (%d out of %d) may be intercepted because of group writable directories\n",
X	($FilesAfterGroupWritable/$TotalFiles)*100,
X	$FilesAfterGroupWritable,
X	$TotalFiles);
X    }
X    printf("----\n");
X    printf("You may also want to check for set user or set group commands, using..\n");
X    printf("\tfind / -type f -perm -4000 -print\n");
X    printf("\tfind / -type f -perm -2000 -print\n");
X    printf("... but this will take a while.\n");
X    printf("You must also trust the systems that provide you with NFS directories\n");
X	   
X
X
X    
X}
X
X
Xsub getusers {
X    local($login,$passwd,$uid,$gid);
X# learn about all of the users via the /etc/passwd file
X    setpwent();			# # initialize the passwd scan
X    while (@list = getpwent) {	# fetch the next entry
X	($login,$passwd,$uid,$gid) = @list[0,1,2,3]; #grab the first 4 fields
X	if ($debug && (($uid == 2) || ($uid == 3) || ($gid == 2) || ($gid == 3))) {
X	    printf("User %s, UID: %d, GID: %d\n", $login, $uid, $gid);
X	}
X	&add_to_group($gid,$login);	# list of people who belong to the group
X	&add_to_uid($uid,$login);	# list of accounts who have the same UID
X	
X	if (length($passwd) == 13) {
X	    $user_to_passwd{$login} = $passwd; # do they have a password?
X	} else {
X#	    printf("user %s doesn't have a password\n", $login);
X#	    printf("length of password %s is %d\n", $passwd, length($passwd));
X	}
X    }
X    endpwent();			# end the scan
X}
Xsub getgroups {
X# learn about all of the groups via the /etc/group file
X    local($login,$passwd,$uid,$members);
X    setgrent();			# # initialize the group scan
X    while (@list = getgrent()) {	# fetch the next entry
X	($login,$passwd,$gid,$members) = @list[0,1,2,3]; #grab the first 4 fields
X	if ($debug && (($gid == 2) || ($gid == 3))) {
X	    printf("Group %s, GID: %d\n", $login, $gid);
X	}
X	if (!defined($gid_to_name{$gid})) {
X	    $gid_to_name{$gid} = $login;
X	} else {
X	    # group already defined
X	    if ($gid_to_name{$gid} ne $login)  {
X		$verbose && printf("Group ID #%d, name: %s, also called %s - ignoring new name\n",
X		       $gid, $gid_to_name{$gid}, $login);
X	    }
X	}
X
X	# each of the members should be added to the group list
X	foreach $m (split(/ /,$members)) {
X	    0 && $debug &&  printf("adding %s to group %s(%d)\n",
X				$m, $login, $gid);
X	    &add_to_group($gid,$m);	# list of people who belong to the group
X	}
X	if (length($passwd) == 13) {
X#	    $group_to_passwd{$login} = $passwd; # do they have a password?
X	} else {
X#	    printf("group %s doesn't have a password\n", $login);
X#	    printf("length of password %s is %d\n", $passwd, length($passwd));
X	}
X    }
X    endgrent();			# end the scan
X    
X}
Xsub add_to_group {
X    local ($gid,$login) = @_;	# list of people who belong to the group
X    # add user $login to group $gid
X    if (defined($ingroup{$gid})) {
X	$ingroup{$gid} .= " $login";
X    } else {
X	$ingroup{$gid} = "$login";
X    }
X}
Xsub add_to_uid {
X    local($uid,$login) = @_;	# list of accounts who have the same UID
X# create map of UID -> USERS
X    if (defined($inuid{$uid})) {
X	# check to see if name is in the list
X	$found = 0;
X	foreach $u (split(/ /,$inuid{$uid})) {
X	    ($u eq $login) && $found++;
X	}
X	(!$found) && $inuid{$uid} .= " $login";
X    } else {
X	$inuid{$uid} = "$login";
X    }
X# check for map of user -<> UIDs.
X#; if more than one, error
X    if (defined($inuser{$login})) {
X	if ($uid != $inuser{$login}) {
X	    
X	    $inuser{$login} .= " $uid";
X	    printf(STDERR " User %s (UID: %d) has duplicate UID's : %s\n", $login, $uid, $inuser{$login});
X	} else {
X	    # saw this user twice, but the UID was the same
X	}
X    } else {
X	$inuser{$login} = "$uid";
X    }
X    
X}
Xsub resolve {			# resolve symbolic/soft links
X    local($current,$link) = @_;
X    local($newlink,$newcurrent);
X    # we are faces with a relative symbolic link
X    # that is, the firct character of $link is NOT a '/'
X    # the following table is in a spefcial format that will allow
X    # testing of each case. This is why there are so many cases
X    # I have a script that extracts these tests and 
X    # verifies the input and output
X# START TEST
X    # Current	Link		Output
X
X# test variations of "/" as left
X#;#	/	../		/
X#;#	/	../../		/
X#;#	/	../x/y		/x/y
X#;#	/	../../x/y	/x/y
X#;#	/	.		/
X#;#	/	./x		/x
X#;#	/	./x/y		/x/y
X#;#	/./	.		/
X#;#	/./	./x		/x
X#;#	/./	./x/y		/x/y
X
X#;#	/a/b	x/y		/a/x/y
X#;#	/a	x		/x
X#;#	/a	x/y		/x/y
X
X#;#	/a/b/c	.		/a/b
X#;#	/a/b/c	./x		/a/b/x
X#;#	/a/b/c	../x		/a/x
X#;#	/a/b/c	./../x		/a/x
X#;#	/a/b/c	../../x		/x
X
X# END TEST
X
X    $newlink = "";
X    if ($current =~ /^\.\.\// ) {
X	die "ERROR : left side can't start with ../";
X    } elsif ($current =~ /^\.\// ) {
X	die "ERROR : left side can't start with ./";
X    } elsif ($current =~ /^[^\/]/ ) {
X	die "ERROR : left side can't start with non-/";
X    }
X
X    if ($link =~ /^\.\.\//) {	# ../
X	#resolve relative link -> ../
X	
X	# remove last two items on current
X	$newcurrent = $current;
X	# change /a/b/c/d to /a/b
X	$newcurrent =~ s,[^\/]+\/[^\/]+$,,;
X
X	# remove ../ from ../xxxx
X	$newlink = $link;
X	$newlink =~ s,^\.\.\/,,;
X
X	# combine two pieces
X	$newlink = "$newcurrent$newlink";
X
X	# there may still be a ../ in there
X	# change x/v/../ to nothing
X	$newlink =~ s,[^\/]+\/\.\.,,g;
X
X	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
X    } elsif ($link eq "." ) { # 
X	#resolve relative link -> .
X	# remove last part of path
X	$newcurrent = $current;
X	# change /a/b/c/d to /a/b/c
X	$newcurrent =~ s,\/[^\/]+$,,; # /a/b/c -> /a/b
X
X	$newlink = "$newcurrent";
X	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
X    } elsif ($link =~ /^\.\//) { # starts with ./
X	#resolve relative link -> ./usr
X	# remove last part of path
X	$newcurrent = $current;
X	# change /a/b/c/d to /a/b/c
X	$newcurrent =~ s,\/[^\/]+$,,;
X
X	# remove ./ from ./xxxx
X	$newlink = $link;
X	$newlink =~ s,^\.\/,,;	# ./xyz -> xyz
X
X	# combine two pieces
X	$newlink = "$newcurrent/$newlink";
X
X	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
X    } elsif ($link =~ /^[^\/]/) { # starts with aaa/
X	#resolve relative link -> usr/
X	# remove last part of path
X	$newcurrent = $current;
X	# change /a/b/c/d to /a/b/c
X	$newcurrent =~ s,\/[^\/]+$,,; # /a/b/c -> /a/b
X
X	$newlink = $link;
X
X	# combine two pieces
X	$newlink = "$newcurrent/$newlink";
X	$debug && printf("RESOLVE: $current -> $link is now $newlink\n");
X    } else {
X	printf(STDERR "$current/$link becomes ?????\n");
X    }
X
X    $oldlink = "";
X    while ($newlink ne $oldlink) { # repeat until no change
X	$oldlink = $newlink;	#
X	$debug && printf("RESOLVE: looping to fix $current -> $link which is now $newlink\n");
X
X	# change /./ to /
X	# John P. Rouillard <rouilj@terminus.cs.umb.edu> 
X	$newlink =~ s,\/\.\/,\/,g;
X	    
X	# change X//Y to X/Y
X	$newlink =~ s,\/\/,\/,g;
X
X	# change A/B/../X to A/X
X	$newlink =~ s,[^/]+\/\.\.,,g;
X
X	# change ^/../ to /
X	$newlink =~ s,^\/\.\.\/,\/,g;
X	
X
X	# change X/./Y to X/Y
X	$newlink =~ s,/\./,\/,g;	
X
X    }    
X
X    if ($newlink !~ /^\//) {
X	die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
X    } elsif ($newlink =~ /\/\.\.\//) {
X	die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
X    } elsif ($newlink =~ /\/\.\//) {
X	die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
X    }
X    return $newlink;
X} # end resolve
Xsub ProgramUsesDir {
X# this procedure is called once for each program.
X# this input is a directory
X    local($dir) = @_;
X    if ( ! -d $dir ) {
X	if (! -e $dir ) {
X	    # file doesn't exist
X	    return;
X	} else {
X	    die  "Directory $dir  NOT a directory, serious bug, aborting";
X	}
X    }
X    $ProgramsInSomeDir++;
X    if (defined($ProgramsInDir{$dir})) {
X	$ProgramsInDir{$dir}++; 
X    } else {
X	$ProgramsInDir{$dir} = 1;
X    }
X
X# now do the same thing with each step up the directory tree
X    while ($dir ne "/") {
X	$dir =~ s,\/[^\/]*$,,;	# Chris.Rouch@wg.estec.esa.nl found this bug
X	if ($dir eq "") {
X	    $dir = "/";
X	}
X	if (defined($ProgramsInDir{$dir})) {
X	    $ProgramsInDir{$dir}++; 
X	} else {
X	    $ProgramsInDir{$dir} = 1;
X	}
X
X    }
X
X}
END_OF_trojan.pl
if test 30278 -ne `wc -c <trojan.pl`; then
    echo shar: \"trojan.pl\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0

exit 0 # Just in case...