home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume43 / trojan.pl / part01 next >
Internet Message Format  |  1994-06-10  |  38KB
  1. From: barnett@crd.ge.com (Bruce Barnett)
  2. Newsgroups: comp.sources.misc
  3. Subject: v43i038:  trojan.pl - Trojan Horse Checker rev 1.9, Part01/01
  4. Date: 10 Jun 1994 11:02:16 -0500
  5. Organization: Sterling Software
  6. Sender: kent@sparky.sterling.com
  7. Approved: kent@sparky.sterling.com
  8. Message-ID: <2ta2q8$cuq@sparky.sterling.com>
  9. X-Md4-Signature: 79222fdb85e64a6d11a1309bb2aced50
  10.  
  11. Submitted-by: barnett@crd.ge.com (Bruce Barnett)
  12. Posting-number: Volume 43, Issue 38
  13. Archive-name: trojan.pl/part01
  14. Environment: UNIX, perl
  15.  
  16. Trojan.pl is a trojan horse checking program.  It examines your
  17. searchpath and looks at all of the executables in your searchpath,
  18. looking for people who can create a trojan hource you can execute.
  19.  
  20. usage: 
  21.     perl trojan.pl
  22.  
  23. See the script for more informations on the various options.
  24.  
  25. For those who ask:
  26.  
  27. The difference between COPS and trojan.pl is this:
  28.  
  29. 1) COPS is typically run by root. Trojan.pl should be executed by
  30. anyone who wants to protect their own account. 
  31.  
  32. A trojan horse will often be created by someone who isn't root, to
  33. either gain access to root, or to gain access to someone who can gain
  34. access to root. If I can create a trojan horse that can break into a
  35. staff account, I might be able to create a trojan to break into a root
  36. account. Therefore all system administrators should run trojan.pl from
  37. their own account. Why bother to have a secure root account, when the
  38. system administration accounts are wide open?
  39.  
  40. 2) trojan.pl only checks searchpaths, as they exist at the time of execution.
  41. I have several searchpaths, and they change during the day.
  42. You want to check the searchpath during "normal" conditions.
  43. Therefore you don't want to check searchpaths in a cron job, but
  44. in a window running a shell.
  45.  
  46. 3) Trojan.pl checks symbolic (soft) links. If you have the the
  47. directory /usr/local/bin in your searchpath, and the file
  48.         /usr/local/bin/abc 
  49. is linked to 
  50.         /local/bin/abc 
  51. which is linked to 
  52.         /elsewhere/bin/abc
  53.  
  54. trojan.pl checks the following directories:
  55.  
  56.         /
  57.         /usr
  58.         /usr/local
  59.         /usr/local/bin
  60.         /local/bin
  61.         /local
  62.         /elsewhere/bin
  63.         /elsewhere
  64.  
  65.     
  66. Any of those directories might be group or world writable. Or the
  67. owner may not be root. Trojan.pl tells you who can drop a trojan in
  68. front of you and how. Symbolic links can be very messy to check into,
  69. and I don't know of any other program that does this check.
  70.  
  71. and
  72.  
  73. 4) trojan.pl gives you a numerical score of how good a job you are
  74. doing. Hopefully you can improve your score
  75. ------
  76. #! /bin/sh
  77. # This is a shell archive.  Remove anything before this line, then unpack
  78. # it by saving it into a file and typing "sh file".  To overwrite existing
  79. # files, type "sh file -c".  You can also feed this as standard input via
  80. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  81. # will see the following message at the end:
  82. #        "End of shell archive."
  83. # Contents:  trojan.README trojan.pl
  84. # Wrapped by barnett@grymoire on Thu May 26 11:45:15 1994
  85. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  86. if test -f trojan.README -a "${1}" != "-c" ; then 
  87.   echo shar: Will not over-write existing file \"trojan.README\"
  88. else
  89. echo shar: Extracting \"trojan.README\" \(2585 characters\)
  90. sed "s/^X//" >trojan.README <<'END_OF_trojan.README'
  91. XREADME for trojan.pl
  92. X
  93. XCreated by Bruce Barnett <barnett@crd.ge.com>
  94. X
  95. XTrojan.pl is a trojan horse checking program.  It examines your
  96. Xsearchpath and looks at all of the executables in your searchpath,
  97. Xlooking for people who can create a trojan hource you can execute.
  98. X
  99. Xusage: 
  100. X    perl trojan.pl
  101. X
  102. XSee the script for more informations on the various options.
  103. X
  104. XFor those who ask:
  105. X
  106. XThe difference between COPS and trojan.pl is this:
  107. X
  108. X1) COPS is typically run by root. Trojan.pl should be executed by
  109. Xanyone who wants to protect their own account. 
  110. X
  111. XA trojan horse will often be created by someone who isn't root, to
  112. Xeither gain access to root, or to gain access to someone who can gain
  113. Xaccess to root. If I can create a trojan horse that can break into a
  114. Xstaff account, I might be able to create a trojan to break into a root
  115. Xaccount. Therefore all system administrators should run trojan.pl from
  116. Xtheir own account. Why bother to have a secure root account, when the
  117. Xsystem administration accounts are wide open?
  118. X
  119. X2) trojan.pl only checks searchpaths, as they exist at the time of execution.
  120. XI have several searchpaths, and they change during the day.
  121. XYou want to check the searchpath during "normal" conditions.
  122. XTherefore you don't want to check searchpaths in a cron job, but
  123. Xin a window running a shell.
  124. X
  125. X3) Trojan.pl checks symbolic (soft) links. If you have the the
  126. Xdirectory /usr/local/bin in your searchpath, and the file
  127. X        /usr/local/bin/abc 
  128. Xis linked to 
  129. X        /local/bin/abc 
  130. Xwhich is linked to 
  131. X        /elsewhere/bin/abc
  132. X
  133. Xtrojan.pl checks the following directories:
  134. X
  135. X        /
  136. X        /usr
  137. X        /usr/local
  138. X        /usr/local/bin
  139. X        /local/bin
  140. X        /local
  141. X        /elsewhere/bin
  142. X        /elsewhere
  143. X
  144. X    
  145. XAny of those directories might be group or world writable. Or the
  146. Xowner may not be root. Trojan.pl tells you who can drop a trojan in
  147. Xfront of you and how. Symbolic links can be very messy to check into,
  148. Xand I don't know of any other program that does this check.
  149. X
  150. Xand
  151. X
  152. X4) trojan.pl gives you a numerical score of how good a job you are
  153. Xdoing. Hopefully you can improve your score
  154. X
  155. X
  156. X
  157. XRevision History:
  158. X
  159. X    1.0 Sent to some individuals
  160. X
  161. X    1.3 Submitted to bugtraq mailing list
  162. X    1.4 bug fix suggested by John P. Rouillard <rouilj@terminus.cs.umb.edu>
  163. X    1.5 added -A option by request of Dave Sill <de5@de5.CTD.ORNL.GOV>
  164. X    1.7 submitted to comp.unix.security and Firewalls
  165. X    1.8 added a more robust testing mechanism for resolve problems
  166. X    1.9 added a check for directories that end with "/", 
  167. X        thanks to Chris Rouch
  168. X
  169. XTODO
  170. X
  171. XLists executables in directories, but doesn't list symbolic links.
  172. XI have a directory that has all links.
  173. X
  174. X
  175. X
  176. X
  177. X
  178. END_OF_trojan.README
  179. if test 2585 -ne `wc -c <trojan.README`; then
  180.     echo shar: \"trojan.README\" unpacked with wrong size!
  181. fi
  182. # end of overwriting check
  183. fi
  184. if test -f trojan.pl -a "${1}" != "-c" ; then 
  185.   echo shar: Will not over-write existing file \"trojan.pl\"
  186. else
  187. echo shar: Extracting \"trojan.pl\" \(30278 characters\)
  188. sed "s/^X//" >trojan.pl <<'END_OF_trojan.pl'
  189. X##!/bin/sh --                     # wish I were -*-Perl-*-
  190. X#eval 'exec perl -S $0 ${1+"$@"}'
  191. X#    if !$$;
  192. X#!/bin/perl
  193. X
  194. X# Look for trojan horses...
  195. X
  196. X# A trojan horse looks like a regular program. 
  197. X# however, if you execute it, the program may set up a back door to 
  198. X# your account, or modify one of your files, etc.
  199. X#
  200. X# This script reports on the different ways someone can drop a trojan hourse
  201. X# in your searchpath.
  202. X#
  203. X# It does not check for set UID or GID programs on your file system, 
  204. X# and does not check NFS permissions of directories.
  205. X# It only checks for executables in your searchpath, and reports who and how
  206. X# someone can create a trojan horse. 
  207. X#
  208. X# This program also provides a measurement of how vunerable you are to a
  209. X# trojan horse. 
  210. X#
  211. X# Bruce Barnett <barnett@crd.ge.com>
  212. X# Copyright 1994 GE
  213. X# All commercial Rights reserved
  214. X# 
  215. X# @(#)trojan.pl    1.9 26 May 1994
  216. X#
  217. X# usage:
  218. X# 
  219. X#    perl trojan.pl [options]
  220. X#
  221. X#    where options are any combination of the following
  222. X#    -b    - brief report. Don't show reasons or executables
  223. X#    -a    - analyze all files. Normally when a file is world writable,
  224. X#            don't check for group or user writable
  225. X#            the -a means look at all problems, and not the first
  226. X#    -w    - just report on world writable problems (no group or user)
  227. X#    -g    - report on group writable problems ( sets -w, no user)
  228. X#    -u    - report on world, group and user writable problems (Default)
  229. X#    -A    - report all files that cause a problem with a group writable
  230. X#            permission, not just the first one
  231. X#
  232. X# for debugging purposes, and for more information, try the following options
  233. X#    -v    - verbose
  234. X#    -d    - debug
  235. X#
  236. X#    Examples
  237. X#    trojan.pl        - reports world, group and user problems
  238. X#              shows reasons for problem
  239. X#    trojan.pl -b        - reports world, group and user problems
  240. X#              Doesn't show reasons
  241. X#    trojan.pl -b -a    - reports world, group and user problems
  242. X#              Doesn't show reasons
  243. X#              reports on ALL  world, group and user 
  244. X#              writable problems
  245. X#    trojan.pl -b -a -A    - reports world, group and user problems
  246. X#              Doesn't show reasons
  247. X#              reports on ALL  world, group and user 
  248. X#              writable problems
  249. X#              Also reports all files that cause group write access
  250. X#
  251. X#
  252. X#    trojan.pl -w         - reports world writable problems and reasons
  253. X#    trojan.pl -g         - reports world + group writable problems and reasons
  254. X
  255. X#    you probably want to start with trojan.pl -b 
  256. X#    and fix some of those problems first
  257. X#    If you don't understand why it's a problem, omit the -b option
  258. X
  259. X#    A malicious cracker will often use your co-workers accounts
  260. X#     as a stepping stone to getting root (or bin, daemon, sys, etc.) 
  261. X#       access. Therefore you have to trust that none of the people who 
  262. X#    could drop a trojan horse in front of you have had their accounts 
  263. X#       compromised. If you don't trust them, then don't allow their 
  264. X#    binaries in your searchpath.
  265. X#
  266. X
  267. X$not_a_csh_script = 0;    # this is used in case someone tries
  268. X                # "csh trojan.pl"
  269. X# command line OPTIONS
  270. X$all = 0;            # print out a more detailed report, (all tests)
  271. X$report_all = 0;            # report all files, not just the first one
  272. X$do_world = 1;            # print out world writable items
  273. X$do_group = 1;            # print out group writable items
  274. X$do_user = 1;            # print out user specific info
  275. X$brief = 0;            # a short report
  276. X
  277. X$verbose=0;            # print more information
  278. X$debug = 0;            # 
  279. X
  280. X
  281. X
  282. X# VARIABLES
  283. X$dot = 0;    # have I seen the "." directory in the path yet?
  284. X$programsafterdot = 0;        # how many files were found after the dot?
  285. X$TotalFiles = 0;            # total programs or files found in the $PATH directories
  286. X$FilesAfterGroupWritable = 0;    # files found after a group writable directory found
  287. X$GroupWritableDirectoryFound = 0;    # boolean, true if a group writable diectory found
  288. X$FilesAfterWorldWritable = 0;    # files found after a world writable directory found
  289. X$WorldWritableDirectoryFound = 0;    # boolean, true if a world writable diectory found
  290. X$world_writable_programs = 0;
  291. X$group_writable_programs = 0;
  292. X$ProgramsInSomeDir = 0;
  293. X
  294. X
  295. X# constants
  296. X
  297. X$SEARCHPATH=1;
  298. X$NOSEARCHPATH=0;
  299. X# PERL variables
  300. X$| = 1;                # write to pipes immediately
  301. X
  302. X$revision = "1.9";        # SCCS fills 1.9 in
  303. X$program = "trojan.pl";        # SCCS fills trojan.pl in
  304. Xif ($program =~ /.M./) {    # does it match the trojan.pl SCCS string?
  305. X    $program = "Trojan";    # yes, fill in the name of the program
  306. X}
  307. Xif ($revision =~ /%/) {        # is '%' part of the revision
  308. X    $beta = 1;            # A beta version
  309. X} else {
  310. X    $beta = 0;
  311. X}
  312. X
  313. Xprintf("%s, %s, a study in trust...\n",
  314. X       $program, 
  315. X       $beta ? "Beta release" : "Revision $revision");
  316. X&getswitches();
  317. X&main();
  318. X&report();
  319. Xexit 0;
  320. X
  321. X# --- SUBROUTINES ---
  322. X
  323. Xsub getswitches {
  324. X    $FIRST = $[;
  325. X# parse command line arguments
  326. X    while ($ARGV[$FIRST] =~ /^-/) {
  327. X#    0 && printf("checkion option %s\n", $ARGV[$FIRST]);
  328. X# verbose
  329. X    $ARGV[$FIRST] =~ /^-v/ && ($verbose++,shift(@ARGV),next);
  330. X# debug  flag
  331. X    $ARGV[$FIRST] =~ /^-d/ && ($debug++,shift(@ARGV),next);
  332. X# all  flag
  333. X    $ARGV[$FIRST] =~ /^-a/ && ($all++,shift(@ARGV),next);
  334. X# report_all  flag
  335. X    $ARGV[$FIRST] =~ /^-A/ && ($report_all++,shift(@ARGV),next);
  336. X# brief  flag
  337. X    $ARGV[$FIRST] =~ /^-b/ && ($brief++,shift(@ARGV),next);
  338. X# -w flag
  339. X    $ARGV[$FIRST] =~ /^-w/ && ($do_world++,$do_group = 0, $do_user = 0,shift(@ARGV),next);
  340. X# -g flag
  341. X    $ARGV[$FIRST] =~ /^-g/ && ($do_world++,$do_group++, $do_user = 0,shift(@ARGV),next);
  342. X# -u flag
  343. X    $ARGV[$FIRST] =~ /^-u/ && ($do_world++,$do_group++, $do_user++,shift(@ARGV),next);
  344. X    last;
  345. X    
  346. X    }
  347. X}
  348. Xsub main {
  349. X    &getusers();
  350. X    &getgroups();
  351. X    &dotrojans();
  352. X}
  353. Xsub dotrojans {
  354. X    &checkrootdir();
  355. X    @dirs = split(/:/,$ENV{'PATH'});
  356. X    foreach $dir (@dirs) {
  357. X    $debug && $verbose && printf("%s: \n",$dir);
  358. X    $reason = "$dir is in your searchpath";
  359. X    if ($dir eq ".") {
  360. X        $dot++;
  361. X        $dir = `pwd`;
  362. X        chop $dir;
  363. X    }
  364. X    if ( -l $dir) {
  365. X        $link = readlink($dir);
  366. X        $debug && printf("$dir points to  $link\n");
  367. X        $reason .= " AND $dir -> $link";
  368. X        if ($link !~ /^\// ) {
  369. X        # a relative link
  370. X        $link = &resolve($dir,$link);
  371. X        $reason .= " ($link) ";
  372. X        }
  373. X        &checkupdir($link,$reason,$SEARCHPATH);
  374. X        while ( -l $link ) {
  375. X        $oldlink = $link;
  376. X        $link = readlink($oldlink); #
  377. X        if ($link !~ /^\// ) {
  378. X            # a relative link
  379. X            $newlink = &resolve($dir,$link);
  380. X            $reason .= " ($newlink) ";
  381. X        }
  382. X        $reason .= "$oldlink -> $link AND"; 
  383. X        &checkupdir($link,$reason,$SEARCHPATH);
  384. X        }
  385. X        if ( -d $link ) {
  386. X        &checkdir($link, $reason);
  387. X        &checkupdir($link,$reason,$SEARCHPATH);
  388. X        &checkexecsindir($link, $reason);
  389. X        
  390. X        
  391. X        }
  392. X    } elsif ( -d $dir ) {
  393. X        &checkdir($dir, $reason);
  394. X        &checkupdir($dir,$reason,$SEARCHPATH);
  395. X        &checkexecsindir($dir, $reason);
  396. X    }
  397. X    
  398. X    }
  399. X}
  400. Xsub checkdir {
  401. X    # check the directory itself - it was in the searchpath
  402. X    local($dir, $reason) = @_;
  403. X    # does the directory exist?
  404. X    if ( -l $dir ) {
  405. X    printf(STDERR "ERROR: I am testing $dir and it is a link.\n");
  406. X    } elsif ( -d $dir ) {
  407. X    &testdir($dir,$reason);
  408. X    } else {
  409. X    printf(STDERR "Missing Directory in searchpath : %s\n", $dir);
  410. X    }
  411. X}
  412. Xsub testdir {
  413. X    # check the directory itself
  414. X    local($dir,$reason) = @_;
  415. X    local($hit) = 0;
  416. X    # does the directory exist?
  417. X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
  418. X     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($dir);
  419. X    if ($mode & 002) {
  420. X    $hit = 1;
  421. X    $WorldWritableDirectoryFound = 1;
  422. X    &addworld_directory("$reason AND $dir is WORLD writable", $dir);
  423. X    }
  424. X    # if group writable AND (not world writable or all)
  425. X    if ((!$hit || $all) && ($mode & 020)) {
  426. X    $hit = 1;        
  427. X    $GroupWritableDirectoryFound = 1;
  428. X    &addgroup_directory($gid,"$reason AND directory $dir is group writable",
  429. X                $dir);
  430. X    }
  431. X    if (!$hit || $all) {
  432. X    &adduser($uid,"$reason AND directory $dir writable by owner"); # owner can write to directory
  433. X    }
  434. X}    
  435. Xsub checkexecsindir {
  436. X    # check each executable in the directory
  437. X    local($dir, $problem) = @_;
  438. X    local($hit);
  439. X    local($program);
  440. X    local($myproblem);
  441. X    $verbose && printf("check execs in dir $dir, reason: $problem\n");
  442. X    opendir(D, $dir) || return 0;
  443. X    while ($file = readdir(D)) {
  444. X    $myproblem = $problem;
  445. X    (($file eq ".") || ($file eq "..")) && next;
  446. X    $TotalFiles++;    # increase number of files found
  447. X    $GroupWritableDirectoryFound && $FilesAfterGroupWritable++;
  448. X    $WorldWritableDirectoryFound && $FilesAfterWorldWritable++;
  449. X    # this is either a file, a directory, or a symbolic link.
  450. X    # if a directory, then don't worry about it.
  451. X    $program = "$dir/$file";
  452. X    # if file, only worry about it if it's executable,
  453. X    
  454. X    if ( -l $program) {
  455. X        # this is a link. Does it point to a file or to a directory?
  456. X        # the file in the searchpath is a symbolic link
  457. X        # if it points to a directory, then check who owns the directory
  458. X        #   it is pointing to
  459. X        while ( -l $program ) {
  460. X        $link = readlink($program);    
  461. X        $myproblem .= " AND $program -> $link";
  462. X        if ($link !~ /^\// ) {
  463. X            # a relative link
  464. X            $link = &resolve($program,$link);
  465. X            $myproblem .= " ($link) ";
  466. X        }
  467. X        $debug && printf("Problem is now: %s, new program is %s\n", 
  468. X                 $myproblem, $link);
  469. X        $newdir = $link;
  470. X        $newdir =~ s,/[^/]+$,,;    # remove the executable from the path, and check the directory
  471. X        $debug && printf("YES: The directory to check now is %s\n",
  472. X                 $newdir);
  473. X        &ProgramUsesDir($newdir);
  474. X        &checkupdir($newdir, "$myproblem ", $NOSEARCHPATH);
  475. X        $program = $link;
  476. X        }
  477. X        # no longer a link, it might be a file of directory
  478. X        # get the stat on the final file
  479. X        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
  480. X         $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($link);
  481. X        if (!defined($dev)) {
  482. X        # find where it's pointing
  483. X        !$brief && printf("Warning: symbolic link %s/%s pointing to missing file: %s\n", 
  484. X                 $dir,$file, $link);
  485. X        &checkmissingdir($link,$program);
  486. X        } elsif ( -d $link ) {
  487. X        # a symbolic link points to a directory.
  488. X        # this is only a problem if the directory pointing to is inside
  489. X        # a directory that can be modified
  490. X        $verbose && printf("\n$dir/$file points to directory $link\n");
  491. X        $newdir = $link;
  492. X        $newdir =~ s,/[^/]+$,,;
  493. X        $verbose && printf("HEY: $link is a directory, and $newdir should be checked\n");
  494. X        &checkupdir($newdir, "$dir/$file -> $link AND ",$NOSEARCHPATH);
  495. X        } else {
  496. X#        printf("$program points to file $link\n");
  497. X        $hit = 0;
  498. X        
  499. X        if ($mode & 0111) { # is this file executable?
  500. X            ($hit = ($mode & 002)) && &addworld_file("$dir/$file -> $link AND $link is WORLD writable", "$dir/$file");
  501. X            ($hit = ($mode & 020)) && ($all || !$hit)  && &addgroup_file($gid,"file $dir/$file -> $link AND $link is group writable", "$dir/$file");
  502. X        }
  503. 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
  504. X        # also check by going up the tree of the executable
  505. X        $newdir = $link;
  506. X        $newdir =~ s,/[^/]+$,,;
  507. X        
  508. X        $debug && printf("YO: link: $link, newdir: $newdir, calling checkupdir\n");
  509. X        &ProgramUsesDir($newdir);
  510. X        &checkupdir($newdir, "$dir/$file -> $link AND ",$NOSEARCHPATH);    # did I do this twice?
  511. X        }
  512. X        #
  513. X        # if it is a file, check the permission of the file
  514. X        #
  515. X    } elsif ( -d "$dir/$file" ) { # Not a link, maybe a directory?
  516. X        # yes a directory in our search path. Does this mean anything?
  517. X        # I guess not. We already go up the directory path
  518. X        
  519. X    } else { # not a link or directory - a file
  520. X        # stat the file
  521. X
  522. X        &ProgramUsesDir($dir);
  523. X        &testfile("$dir/$file", "$dir/$file executable in path");
  524. X    }
  525. X    }
  526. X    close(D);
  527. X}
  528. X
  529. Xsub testfile {
  530. X    local($file,$reason) = @_;
  531. X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
  532. X     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
  533. X    $hit = 0;
  534. X    if ($mode & 0111) { # is this file executable?
  535. X#    printf("Executable $dir/$file seen\n");
  536. X    # increase the number of programs seen
  537. X    # if the "." directory has been seen, then
  538. X    # this program can be trojanized
  539. X    $dot && $programsafterdot++;
  540. X    
  541. X    if ($mode & 002) {
  542. X        # world writable
  543. X        $hit = 1;
  544. X        &addworld_file("$reason AND $file is WORLD writable", "$file");
  545. X    }
  546. X    # if group writable AND (not world writable or all)
  547. X    if ((!$hit || $all) && ($mode & 020)) {
  548. X        $hit = 1;        
  549. X        &addgroup_file($gid,"$reason AND file $file is group writable", "$file");
  550. X    }
  551. X    }
  552. X    # it doesn't matter if the file is executable or not, 
  553. X    # the owner can make it executable
  554. X    ($all || !$hit) && &adduser($uid,"$reason AND file $file modifiable by owner");
  555. X}
  556. X
  557. X
  558. Xsub adduser {
  559. X    local($user,$dir) = @_;
  560. X    if (defined($user{$user})) {
  561. X    if ($report_all) {
  562. X        ($user != "0" && $user != $< ) && printf("user %s can do it because of %s\n", $user, $dir);
  563. X    } else {
  564. X        $debug && $verbose && printf("user %s can do it because of %s\n", $user, $dir);
  565. X    }
  566. X
  567. X    # add it to the list
  568. X    $user{$user} .= "\n$dir";
  569. X    $usercount{$user}++;
  570. X    
  571. X    } else {
  572. X    $user{$user} = $dir;
  573. X    $usercount{$user} = 1;
  574. X    $verbose && printf("user %s can do it because of %s\n", $user, $dir);
  575. X    }
  576. X}
  577. Xsub addgroup_directory {
  578. X    local($gid,$reason,$dir) = @_;
  579. X#    $GroupWritableDirectoryFound = 1;
  580. X    if (!defined($group_writable{$dir})) {
  581. X    &addgroup($gid, $reason, $dir);
  582. X    $group_writable{$dir} = 1;
  583. X    } else {
  584. X    $group_writable{$dir}++ ;
  585. X    $verbose && printf("Directory '$dir' found again\n");
  586. X    }
  587. X}
  588. Xsub addgroup_file {
  589. X    local($gid, $reason,$file) = @_;
  590. X    $verbose && printf("Group Writable program, gid: %d, file: %s, reasons: %s\n",
  591. X               $gid, $file, $reason);
  592. X    $group_writable_programs++;
  593. X    &addgroup($gid, "File $reason", $file);
  594. X}
  595. Xsub addgroup {
  596. X    local($gid,$reason) = @_;
  597. X    
  598. X    if (defined($group{$gid})) {
  599. X    if ($report_all) {
  600. X        $all && printf("group %s can do it because of %s\n", $gid, $reason);
  601. X    } else {
  602. X        $all && $verbose && printf("group %s can do it because of %s\n", $gid, $reason);
  603. X
  604. X    }
  605. X    # add it to the list
  606. X    $group{$gid} .= "\n$reason";
  607. X    $groupcount{$gid}++;
  608. X    } else {
  609. X    $group{$gid} = $reason;
  610. X    $groupcount{$gid} = 1;
  611. X    $verbose && printf("group %s can do it because of %s\n", $gid, $reason);
  612. X    }
  613. X}
  614. Xsub addworld_directory {
  615. X    local($reason,$dir) = @_;
  616. X#    $WorldWritableDirectoryFound = 1;
  617. X    if (!defined($world_writable{$dir})) {
  618. X    &addworld($reason);
  619. X    $world_writable{$dir} = 1;
  620. X    } else {
  621. X    $world_writable{$dir}++ ;
  622. X    $verbose && printf("Directory '$dir' found again\n");
  623. X    }
  624. X}
  625. Xsub addworld_file {
  626. X    local($reason,$file) = @_;
  627. X    $world_writable_programs++;
  628. X    &addworld("File $reason");
  629. X}
  630. Xsub addworld {
  631. X    local($reason) = @_;
  632. X    $reason =~ s/-\>/\n\t\t->/g;
  633. X    $reason =~ s/AND/\n\t\tAND/g;
  634. X    # remember world writable directories
  635. X    
  636. X    !$brief && printf("ANYONE can do it because of %s\n", $reason);
  637. X}
  638. Xsub checkupdir {
  639. X    # check the paths leading to the directory
  640. X    local($dir, $reason,$onpath) = @_;
  641. X    # $onpath is true if this directory is on the searchpath, else false
  642. X    if (defined($did_checkup_dir{$dir})) {
  643. X    $debug && printf("already checked updir %s\n", $dir); 
  644. X    return 0;        # did it
  645. X    } else {
  646. X    $did_checkup_dir{$dir} = 1;
  647. X    }
  648. X    if ($dir eq "." ) {
  649. X    die " I should not see a dot in $dir while  in checkupdir";
  650. X    } elsif ( $dir =~ /^\.\// ) {
  651. X    die " I should not see a ./ in $dir while  in checkupdir";
  652. X    } elsif ( $dir =~ /\/\.\.\// ) {
  653. X    die " I should not see a /../ in $dir while  in checkupdir";
  654. X    } elsif ( $dir =~ /^\.\.\// ) {
  655. X    die " I should not see a ../ in $dir while  in checkupdir";
  656. X    }
  657. X    $verbose && printf("checking up dir %s, reason: %s\n",
  658. X               $dir, $reason);
  659. X    # $dir is the file we are checking, and $reason is why (i.e. "a/b -> /c and")
  660. X#    $origfile = $dir;
  661. X    while ($dir ne "") {
  662. X    #remove the last path
  663. X    1 && $verbose && printf("checkupdir: checking %s\n", $dir);
  664. X    if ( -d $dir ) {
  665. X        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
  666. X         $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$dir");
  667. X        $hit = 0;
  668. X        if ($hit = ($mode & 002)) {
  669. X        $onpath && ($WorldWritableDirectoryFound = 1);
  670. X        &addworld_directory("$reason AND $dir is WORLD writable", $dir);
  671. X        }
  672. X        if ($hit = ($mode & 020)) {
  673. X        $onpath && ($GroupWritableDirectoryFound = 1);
  674. X        ($all || !$hit) && &addgroup_directory($gid,"$reason $dir is group writable", $dir);
  675. X        }
  676. X        ($all || !$hit) && &adduser($uid,"$reason $dir is writable by owner");    # owner can write to directory
  677. X    } elsif ( ! -e $dir ) {
  678. X        !$brief && printf(STDERR "WARNING: non-existing directory used: $dir\n");
  679. X    } else {
  680. X        !$brief && printf(STDERR "WARNING: non-directory used: $dir\n");
  681. X    }
  682. X    $dir =~ s,/[^/]*$,,;    # remove last directory from path
  683. X    }
  684. X}
  685. Xsub checkrootdir {
  686. X    # check the paths leading to the directory
  687. X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
  688. X     $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("/");
  689. X    $hit = 0;
  690. X    ($hit = ($mode & 002)) && &addworld_directory("'/' is WORLD writable", "/");
  691. X    ($hit = ($mode & 020)) && ($all || !$hit) && &addgroup_directory($gid,"Directory '/' is group writable", "/");
  692. X    ($all || !$hit) && &adduser($uid,"Directory '/' is writable by owner");    # owner can write to directory
  693. X}
  694. Xsub checkmissingdir {
  695. X    # this argument is a file that is missing
  696. X    # check to see if each directory up the ladder
  697. X    # has permission problems.
  698. X    local($file, $where) = @_;
  699. X    $origfile = $file;
  700. X    while ($file =~ s,/[^/]*$,, && $file ne "") {
  701. X    #remove the last path
  702. X    $debug && $verbose && printf("checking %s\n", $file);
  703. X    if ( -d $file ) {
  704. X        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
  705. X         $size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$file");
  706. X        $hit = 0;
  707. X        ($hit = ($mode & 002)) && &addworld_directory("$where -> $origfile AND $file is WORLD writable", $file);
  708. X        ($hit = ($mode & 020)) && ($all || !$hit) && &addgroup_directory($gid,"$where -> $origfile AND $file is group writable", $file);
  709. X        ($all || !$hit) && &adduser($uid,"$where -> $origfile AND directory $file is writable by owner");    # owner can write to directory
  710. X    }
  711. X    }
  712. X}
  713. Xsub report {
  714. X# final report
  715. X    if ($debug || $verbose ) {
  716. X    printf("Options: ");
  717. X    $brief && printf("brief ");
  718. X    $all && printf("all  ");
  719. X    $do_world && printf("do_world ");
  720. X    $do_group && printf("do_group ");
  721. X    $do_user && printf("do_user ");
  722. X    $debug && printf("debug ");
  723. X    $verbose && printf("verbose ");
  724. X    printf("\n");
  725. X    }
  726. X    $WorldWritableProgramsByDirectory = 0;
  727. X    foreach $d (keys %world_writable) {
  728. X    printf("World writable directory %s makes %d files vulnerable\n",
  729. X           $d, $ProgramsInDir{$d});
  730. X    $WorldWritableProgramsByDirectory += $ProgramsInDir{$d};
  731. X    }
  732. X    # now for each group
  733. X    if ($do_group) {
  734. X    $GroupWritableProgramsByDirectory = 0;
  735. X    foreach $d (keys %group_writable) {
  736. X        printf("Group writable directory %s makes %d  files vulnerable\n",
  737. X           $d,  $ProgramsInDir{$d});
  738. X        $GroupWritableProgramsByDirectory += $ProgramsInDir{$d};
  739. X    }
  740. X    foreach $g (keys %group) {
  741. X        $members = $ingroup{$g};
  742. X        $name = $gid_to_name{$g};
  743. X        $files = $group{$g};
  744. X        $files =~ s/\n/\n\t/g;
  745. X        $files =~ s/AND/AND\n\t\t/g;
  746. X        # truncate all files but the first
  747. X        if (!$brief) {
  748. X            printf("\nGroup %s can do it %d ways: \n\t%s\n",
  749. X               $name, $groupcount{$g}, $files);
  750. X            if ($do_user) {
  751. X            if (defined($members)) {
  752. X            printf("\tmembers of this group are:\n");
  753. X            undef(%dummy);
  754. X            foreach $m (split(/ /,$members)) {
  755. X                if (!defined($dummy{$m})) {
  756. X                printf("\t\t%s\n", $m);        
  757. X                $dummy{$m}=1;
  758. X                }
  759. X            }
  760. X            }
  761. X        }
  762. X        }
  763. X    }
  764. X    }
  765. X# now look for each user
  766. X    if ($do_user) {
  767. X    $NumberOfProgramsOwnerByOtherUsers = 0;
  768. X    foreach $u (keys %user) {
  769. X        $name = $inuid{$u};
  770. X        $files = $user{$u};
  771. X        if (!defined($name)) {
  772. X        printf("UNKNOWN USER, UID = %d, ", $u);
  773. X        } else {
  774. X        if (defined($user_to_passwd{$name})) {
  775. X            printf("User %s, UID: %d, ",
  776. X               $name, $u);
  777. X        } elsif ($name =~ / /) {
  778. X            # more than one person has this UID...
  779. X            printf("Users %s, UID: %d, ",
  780. X               $name, $u);
  781. X        } else {
  782. X            printf("Users %s, UID: %d, ",
  783. X               $name, $u);
  784. X        }
  785. X        }
  786. X        if ($u == 0) {
  787. X        printf("owns %d file, but you should be able to trust root",
  788. X               $usercount{$u});
  789. X        } elsif ($u == $>) {
  790. X        printf("owns %d file, (but you should be able to trust yourself :-)",
  791. X               $usercount{$u});
  792. X        } else {
  793. X        # truncate all files but the first
  794. X        ($file) = split("\n", $files);
  795. X        printf("owns %d file%s",
  796. X               $usercount{$u}, 
  797. X               ($usercount{$u} == 1) ? "" : "s");
  798. X        !$brief && printf(", Example %s",
  799. X                  $file);
  800. X        $NumberOfProgramsOwnerByOtherUsers +=$usercount{$u};
  801. X        }
  802. X        printf("\n");
  803. X    }
  804. X    }
  805. X#    printf("Number of executable programs: %d\n", $programs);
  806. X    printf(" ---- Score (lower percentages are better) ----\n");
  807. X    
  808. X    $ProgramsInSomeDir = $TotalFiles;
  809. X    printf("Number of programs/files in searchpath: %d\n", $ProgramsInSomeDir);
  810. X    $do_user && printf("Number of programs writable by others (excluding root and self): %d (%4.2f%%)\n", 
  811. X               $NumberOfProgramsOwnerByOtherUsers,
  812. X               ( $NumberOfProgramsOwnerByOtherUsers/$ProgramsInSomeDir)*100 );
  813. X    if ($do_group) {
  814. X    printf("Number of group writable programs: %d (%4.2f%%)\n", 
  815. X           $group_writable_programs, 
  816. X           ($group_writable_programs/$ProgramsInSomeDir)*100 );
  817. X    $debug && printf("Number of executables in group writable directories: %d (%4.2f%%)\n", 
  818. X           $GroupWritableProgramsByDirectory,
  819. X           ( $GroupWritableProgramsByDirectory /$ProgramsInSomeDir)*100 );
  820. X    }
  821. X    printf("Number of world writable programs: %d (%4.2f%%)\n", 
  822. X       $world_writable_programs, 
  823. X       ($world_writable_programs/$ProgramsInSomeDir)*100 );
  824. X    $debug && printf("Number of executables in world writable directories: %d (%4.2f%%)\n", 
  825. X       $WorldWritableProgramsByDirectory,
  826. X       ( $WorldWritableProgramsByDirectory /$ProgramsInSomeDir)*100 );
  827. X    if ($dot) {
  828. X    printf("You have included '.' (current working directory) in your searchpath\n");
  829. X    if ($programsafterdot) {
  830. X        
  831. X        printf("%d files out of %d executable files (%4.2f%%) can be intercepted by a trojan horse depending on your current directory\n",
  832. X           $programsafterdot, $ProgramsInSomeDir, ($programsafterdot/$ProgramsInSomeDir)*100.0);
  833. X        printf("You are 100%% susceptible to a misspelled program in your current directory (e.g. 'mroe')\n");
  834. X    }
  835. X    }
  836. X    if ($WorldWritableDirectoryFound) {
  837. X    printf("%6.2f%% of your files (%d out of %d) may be intercepted because of world writable directories\n",
  838. X    ($FilesAfterWorldWritable/$TotalFiles)*100,
  839. X    $FilesAfterWorldWritable,
  840. X    $TotalFiles);
  841. X    }
  842. X    if ($GroupWritableDirectoryFound) {
  843. X    printf("%6.2f%% of your files (%d out of %d) may be intercepted because of group writable directories\n",
  844. X    ($FilesAfterGroupWritable/$TotalFiles)*100,
  845. X    $FilesAfterGroupWritable,
  846. X    $TotalFiles);
  847. X    }
  848. X    printf("----\n");
  849. X    printf("You may also want to check for set user or set group commands, using..\n");
  850. X    printf("\tfind / -type f -perm -4000 -print\n");
  851. X    printf("\tfind / -type f -perm -2000 -print\n");
  852. X    printf("... but this will take a while.\n");
  853. X    printf("You must also trust the systems that provide you with NFS directories\n");
  854. X       
  855. X
  856. X
  857. X    
  858. X}
  859. X
  860. X
  861. Xsub getusers {
  862. X    local($login,$passwd,$uid,$gid);
  863. X# learn about all of the users via the /etc/passwd file
  864. X    setpwent();            # # initialize the passwd scan
  865. X    while (@list = getpwent) {    # fetch the next entry
  866. X    ($login,$passwd,$uid,$gid) = @list[0,1,2,3]; #grab the first 4 fields
  867. X    if ($debug && (($uid == 2) || ($uid == 3) || ($gid == 2) || ($gid == 3))) {
  868. X        printf("User %s, UID: %d, GID: %d\n", $login, $uid, $gid);
  869. X    }
  870. X    &add_to_group($gid,$login);    # list of people who belong to the group
  871. X    &add_to_uid($uid,$login);    # list of accounts who have the same UID
  872. X    
  873. X    if (length($passwd) == 13) {
  874. X        $user_to_passwd{$login} = $passwd; # do they have a password?
  875. X    } else {
  876. X#        printf("user %s doesn't have a password\n", $login);
  877. X#        printf("length of password %s is %d\n", $passwd, length($passwd));
  878. X    }
  879. X    }
  880. X    endpwent();            # end the scan
  881. X}
  882. Xsub getgroups {
  883. X# learn about all of the groups via the /etc/group file
  884. X    local($login,$passwd,$uid,$members);
  885. X    setgrent();            # # initialize the group scan
  886. X    while (@list = getgrent()) {    # fetch the next entry
  887. X    ($login,$passwd,$gid,$members) = @list[0,1,2,3]; #grab the first 4 fields
  888. X    if ($debug && (($gid == 2) || ($gid == 3))) {
  889. X        printf("Group %s, GID: %d\n", $login, $gid);
  890. X    }
  891. X    if (!defined($gid_to_name{$gid})) {
  892. X        $gid_to_name{$gid} = $login;
  893. X    } else {
  894. X        # group already defined
  895. X        if ($gid_to_name{$gid} ne $login)  {
  896. X        $verbose && printf("Group ID #%d, name: %s, also called %s - ignoring new name\n",
  897. X               $gid, $gid_to_name{$gid}, $login);
  898. X        }
  899. X    }
  900. X
  901. X    # each of the members should be added to the group list
  902. X    foreach $m (split(/ /,$members)) {
  903. X        0 && $debug &&  printf("adding %s to group %s(%d)\n",
  904. X                $m, $login, $gid);
  905. X        &add_to_group($gid,$m);    # list of people who belong to the group
  906. X    }
  907. X    if (length($passwd) == 13) {
  908. X#        $group_to_passwd{$login} = $passwd; # do they have a password?
  909. X    } else {
  910. X#        printf("group %s doesn't have a password\n", $login);
  911. X#        printf("length of password %s is %d\n", $passwd, length($passwd));
  912. X    }
  913. X    }
  914. X    endgrent();            # end the scan
  915. X    
  916. X}
  917. Xsub add_to_group {
  918. X    local ($gid,$login) = @_;    # list of people who belong to the group
  919. X    # add user $login to group $gid
  920. X    if (defined($ingroup{$gid})) {
  921. X    $ingroup{$gid} .= " $login";
  922. X    } else {
  923. X    $ingroup{$gid} = "$login";
  924. X    }
  925. X}
  926. Xsub add_to_uid {
  927. X    local($uid,$login) = @_;    # list of accounts who have the same UID
  928. X# create map of UID -> USERS
  929. X    if (defined($inuid{$uid})) {
  930. X    # check to see if name is in the list
  931. X    $found = 0;
  932. X    foreach $u (split(/ /,$inuid{$uid})) {
  933. X        ($u eq $login) && $found++;
  934. X    }
  935. X    (!$found) && $inuid{$uid} .= " $login";
  936. X    } else {
  937. X    $inuid{$uid} = "$login";
  938. X    }
  939. X# check for map of user -<> UIDs.
  940. X#; if more than one, error
  941. X    if (defined($inuser{$login})) {
  942. X    if ($uid != $inuser{$login}) {
  943. X        
  944. X        $inuser{$login} .= " $uid";
  945. X        printf(STDERR " User %s (UID: %d) has duplicate UID's : %s\n", $login, $uid, $inuser{$login});
  946. X    } else {
  947. X        # saw this user twice, but the UID was the same
  948. X    }
  949. X    } else {
  950. X    $inuser{$login} = "$uid";
  951. X    }
  952. X    
  953. X}
  954. Xsub resolve {            # resolve symbolic/soft links
  955. X    local($current,$link) = @_;
  956. X    local($newlink,$newcurrent);
  957. X    # we are faces with a relative symbolic link
  958. X    # that is, the firct character of $link is NOT a '/'
  959. X    # the following table is in a spefcial format that will allow
  960. X    # testing of each case. This is why there are so many cases
  961. X    # I have a script that extracts these tests and 
  962. X    # verifies the input and output
  963. X# START TEST
  964. X    # Current    Link        Output
  965. X
  966. X# test variations of "/" as left
  967. X#;#    /    ../        /
  968. X#;#    /    ../../        /
  969. X#;#    /    ../x/y        /x/y
  970. X#;#    /    ../../x/y    /x/y
  971. X#;#    /    .        /
  972. X#;#    /    ./x        /x
  973. X#;#    /    ./x/y        /x/y
  974. X#;#    /./    .        /
  975. X#;#    /./    ./x        /x
  976. X#;#    /./    ./x/y        /x/y
  977. X
  978. X#;#    /a/b    x/y        /a/x/y
  979. X#;#    /a    x        /x
  980. X#;#    /a    x/y        /x/y
  981. X
  982. X#;#    /a/b/c    .        /a/b
  983. X#;#    /a/b/c    ./x        /a/b/x
  984. X#;#    /a/b/c    ../x        /a/x
  985. X#;#    /a/b/c    ./../x        /a/x
  986. X#;#    /a/b/c    ../../x        /x
  987. X
  988. X# END TEST
  989. X
  990. X    $newlink = "";
  991. X    if ($current =~ /^\.\.\// ) {
  992. X    die "ERROR : left side can't start with ../";
  993. X    } elsif ($current =~ /^\.\// ) {
  994. X    die "ERROR : left side can't start with ./";
  995. X    } elsif ($current =~ /^[^\/]/ ) {
  996. X    die "ERROR : left side can't start with non-/";
  997. X    }
  998. X
  999. X    if ($link =~ /^\.\.\//) {    # ../
  1000. X    #resolve relative link -> ../
  1001. X    
  1002. X    # remove last two items on current
  1003. X    $newcurrent = $current;
  1004. X    # change /a/b/c/d to /a/b
  1005. X    $newcurrent =~ s,[^\/]+\/[^\/]+$,,;
  1006. X
  1007. X    # remove ../ from ../xxxx
  1008. X    $newlink = $link;
  1009. X    $newlink =~ s,^\.\.\/,,;
  1010. X
  1011. X    # combine two pieces
  1012. X    $newlink = "$newcurrent$newlink";
  1013. X
  1014. X    # there may still be a ../ in there
  1015. X    # change x/v/../ to nothing
  1016. X    $newlink =~ s,[^\/]+\/\.\.,,g;
  1017. X
  1018. X    $debug && printf("RESOLVE: $current -> $link is now $newlink\n");
  1019. X    } elsif ($link eq "." ) { # 
  1020. X    #resolve relative link -> .
  1021. X    # remove last part of path
  1022. X    $newcurrent = $current;
  1023. X    # change /a/b/c/d to /a/b/c
  1024. X    $newcurrent =~ s,\/[^\/]+$,,; # /a/b/c -> /a/b
  1025. X
  1026. X    $newlink = "$newcurrent";
  1027. X    $debug && printf("RESOLVE: $current -> $link is now $newlink\n");
  1028. X    } elsif ($link =~ /^\.\//) { # starts with ./
  1029. X    #resolve relative link -> ./usr
  1030. X    # remove last part of path
  1031. X    $newcurrent = $current;
  1032. X    # change /a/b/c/d to /a/b/c
  1033. X    $newcurrent =~ s,\/[^\/]+$,,;
  1034. X
  1035. X    # remove ./ from ./xxxx
  1036. X    $newlink = $link;
  1037. X    $newlink =~ s,^\.\/,,;    # ./xyz -> xyz
  1038. X
  1039. X    # combine two pieces
  1040. X    $newlink = "$newcurrent/$newlink";
  1041. X
  1042. X    $debug && printf("RESOLVE: $current -> $link is now $newlink\n");
  1043. X    } elsif ($link =~ /^[^\/]/) { # starts with aaa/
  1044. X    #resolve relative link -> usr/
  1045. X    # remove last part of path
  1046. X    $newcurrent = $current;
  1047. X    # change /a/b/c/d to /a/b/c
  1048. X    $newcurrent =~ s,\/[^\/]+$,,; # /a/b/c -> /a/b
  1049. X
  1050. X    $newlink = $link;
  1051. X
  1052. X    # combine two pieces
  1053. X    $newlink = "$newcurrent/$newlink";
  1054. X    $debug && printf("RESOLVE: $current -> $link is now $newlink\n");
  1055. X    } else {
  1056. X    printf(STDERR "$current/$link becomes ?????\n");
  1057. X    }
  1058. X
  1059. X    $oldlink = "";
  1060. X    while ($newlink ne $oldlink) { # repeat until no change
  1061. X    $oldlink = $newlink;    #
  1062. X    $debug && printf("RESOLVE: looping to fix $current -> $link which is now $newlink\n");
  1063. X
  1064. X    # change /./ to /
  1065. X    # John P. Rouillard <rouilj@terminus.cs.umb.edu> 
  1066. X    $newlink =~ s,\/\.\/,\/,g;
  1067. X        
  1068. X    # change X//Y to X/Y
  1069. X    $newlink =~ s,\/\/,\/,g;
  1070. X
  1071. X    # change A/B/../X to A/X
  1072. X    $newlink =~ s,[^/]+\/\.\.,,g;
  1073. X
  1074. X    # change ^/../ to /
  1075. X    $newlink =~ s,^\/\.\.\/,\/,g;
  1076. X    
  1077. X
  1078. X    # change X/./Y to X/Y
  1079. X    $newlink =~ s,/\./,\/,g;    
  1080. X
  1081. X    }    
  1082. X
  1083. X    if ($newlink !~ /^\//) {
  1084. X    die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
  1085. X    } elsif ($newlink =~ /\/\.\.\//) {
  1086. X    die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
  1087. X    } elsif ($newlink =~ /\/\.\//) {
  1088. X    die "return value from RESOLVE ($newlink) invalid, input: ($current, $link)";
  1089. X    }
  1090. X    return $newlink;
  1091. X} # end resolve
  1092. Xsub ProgramUsesDir {
  1093. X# this procedure is called once for each program.
  1094. X# this input is a directory
  1095. X    local($dir) = @_;
  1096. X    if ( ! -d $dir ) {
  1097. X    if (! -e $dir ) {
  1098. X        # file doesn't exist
  1099. X        return;
  1100. X    } else {
  1101. X        die  "Directory $dir  NOT a directory, serious bug, aborting";
  1102. X    }
  1103. X    }
  1104. X    $ProgramsInSomeDir++;
  1105. X    if (defined($ProgramsInDir{$dir})) {
  1106. X    $ProgramsInDir{$dir}++; 
  1107. X    } else {
  1108. X    $ProgramsInDir{$dir} = 1;
  1109. X    }
  1110. X
  1111. X# now do the same thing with each step up the directory tree
  1112. X    while ($dir ne "/") {
  1113. X    $dir =~ s,\/[^\/]*$,,;    # Chris.Rouch@wg.estec.esa.nl found this bug
  1114. X    if ($dir eq "") {
  1115. X        $dir = "/";
  1116. X    }
  1117. X    if (defined($ProgramsInDir{$dir})) {
  1118. X        $ProgramsInDir{$dir}++; 
  1119. X    } else {
  1120. X        $ProgramsInDir{$dir} = 1;
  1121. X    }
  1122. X
  1123. X    }
  1124. X
  1125. X}
  1126. END_OF_trojan.pl
  1127. if test 30278 -ne `wc -c <trojan.pl`; then
  1128.     echo shar: \"trojan.pl\" unpacked with wrong size!
  1129. fi
  1130. # end of overwriting check
  1131. fi
  1132. echo shar: End of shell archive.
  1133. exit 0
  1134.  
  1135. exit 0 # Just in case...
  1136.