Sam Trenholme's webpage
This article was posted to the Usenet group alt.hackers in 1995; any technical information is probably outdated.

Worm Hack


Article: 7515 of alt.hackers
From: cpierce1@ed7590.pto.ford.com (Clinton Pierce (R))
Newsgroups: alt.hackers,comp.lang.perl
Subject: Worm Hack
Date: 13 Mar 1995 14:23:02 GMT
Organization: Ford Motor Co., Powertrain Systems
Lines: 433
Approved: Lev Tolstoi
Distribution: world
Message-ID: 3k1kg6$4l9@eccdb1.pms.ford.com
NNTP-Posting-Host: ed7590.pto.ford.com
Status: RO

NOTE: this is now crossposted to comp.lang.perl

I posted a reply to the "autodialer" thread and used a Perl worm
as an
ObHack.  Afterwards, I got a few requests for the worm, so here it is.
The code to plant the worm on a system, and propigate it elsewhere IS NOT
HERE, and it's not part of the hack.

We were looking for misconfigured systems, in our case, these were systems
which made direct references to our file servers instead of going through
an intermediate system.   We searched every file to find these references
because they could be compiled into a binary, in a .cshrc, in a config file,
or anywhere.  Oh yeah, we were looking for symlinks that were pointing to the
file servers directly too...

As mentioned earlier, I searched 400+ systems in 3.75 hours, using 107 hours
of clock time, 56 Hours of CPU time (39 User/17 Sys).  A total of 276 Gigs
of disk were searched (276x(2^30) bytes) in 8.8 Million files. I had 78,000
hits and 3900 files with 10+ hits.   The funny thing was...no-one noticed.


ObHack:
The following is a Perl script to search a system for regular expressions.
On the system are placed three nuggets: a file containing pathnames that we
really don't need to explore (invalid_paths), a file containing the strings
we need to find (look_strings) and the script.  This script must be run from
the top of the mountpoints that you want searched (usually /) and should be
run as root (it's worthless otherwise).

Some interesting things in the script:
  * a method of ALMOST portably finding out whether a file is mounted from
    a local disk or from NFS (automount & otherwise...)  Damned Sun
    systems...

I'm looking for:
  1. A way to shorten the regular expressions in the pretty_print subroutine
  2. Any speed optimizations.
  3. Constructive code critisism


#!/ford/bin/perl

#
# Send this script SIGUSR1 to start dumping the current filenames to
# /tmp/walker.curr.  Send SIGUSR2 to stop the dump.
#
$monitor=0;		# Monitor.
$monfile=">/tmp/walker.cur";
$SIG{"USR1"}="start_mon";
$SIG{"USR2"}="end_mon";

sub start_mon {
	$monitor=1;
	$SIG{"USR1"}="start_mon";
}
sub end_mon {
	$monitor=-1;
	$SIG{"USR2"}="end_mon";
}
#
# Change the following LINE if this is a test.
#
$testing=0;  # Change to "1" to make stdout the place to be...
if ($testing) {
	$monitor=1;
	$monfile="cat |";
}


#
# Maximum hits per file.
# current number of hits for this file.
# over the maximum flag.
#
$maxhits=11;
$current_hits=0;
$overmax=0;

#
##################
#  SUBROUTINES	 #
##################
#
# Print a bogo-match..
#
sub pretty_print {
	$pre=$_[0];
	$match=$_[1];
	$post=$_[2];
	$file=$_[3];


	$current_hits++;
	if ( $current_hits > $maxhits ) {   # This shouldn't happen
	w/$overmax
		return(0);
	}
	if ( $current_hits == $maxhits ) {
		printf(OUTPUT "Number of hits (%d) exceeded for file
		%s...\n", $maxhits, $file);
		$overmax=1;
		return(0);
	}
	#
	# Regexp's match anything printable.
	#
	$pre =~ /[\d\w\t
	\f\-[\]\\\/=()\*\&!@#\$%^_+{};:"'|<>,.?`~]*$/;
	$realpre=$&;

	$post =~ /^[\d\w\t
	\f\-[\]\\\/=()\*\&!@#\$%^_+{};:"'|<>,.?`~]*/;
	$realpost=$&;

	printf(OUTPUT "(%s) %s \"%s\"\n", $match, $file,
	sprintf("%s%s%s", $realpre, $match, $realpost));

}
#
# Search a file for a string on the hitlist.  Now, this is using
# perl's regexp matching against all kinds of files...
#
sub check_file {
	$file=$_[0];

	$beg="";
	$end="";

	#
	# Check requests from the monitor, open up necessary files,
	# Close necessary files, and print output...
	#
	if ($monitor==1) {
		$monitor++;
		open(MONITOR, $monfile) || ( $monitor=0 ) ;
		if ($monitor) {
			# Turn off buffering...
			select((select(MONITOR), $|=1)[0]);
		}

	}
	if ($monitor==2) {
		printf(MONITOR "%s\n", $file);
	}
	if ($monitor==-1) {
		close(MONITOR);
		$monitor=0;
	}

	#
	# This piece may cause portability problems eventually...
	# WE're testing if a file is "regular".
	#
	$s_ifmt=0xf000;
	$s_ifreg=0x8000;

	# Ok get the info..
	($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size)=stat($file);

	if (! ((($mode) & $s_ifmt) == $s_ifreg)) {
		return(0);			# Sorry, not regular, bail.
	}
	$current_hits=0;
	$overmax=0;
	$numbytes=$numbytes+$size;  # Accumulate # of bytes searched.

	open(STRING, "$file") || die "Opening $file: $!\n";
	#
	# Read "records" from the file
	# Bzzzzt.  Try reading the file 1MB at a time.
	# NOTE: Potential bug: we COULD miss a string that's broken
	# Over the 1MB boundary--but I doubt it.
	#
#	 FILEPROC: while(<STRING>) {
#		 $blob=$_;
	FILEPROC: while( read(STRING, $blob, 1024*1024) ){
		if ($blob eq "undef") {
			last FILEPROC;
		}
		#
		# Check each "record" for the list of bogus strings.
		#
		foreach(@LOOK_STRINGS) {
			if ( $blob =~ /$_/ ) {	 # We have a match!
				$match=$_;
				if ($monitor==2) {
					printf(MONITOR "Hit!\n");
				}
				#
				# Kinky!  Tokenize the binary using the match.
				#
				@PARTS=split(/$match/, $blob);
				$num=$#PARTS;
				$i=0;
				#
				# loop through each match, and display it nice.
				#
				foreach(@PARTS) {
					$beg=$end;
					$end=$_;
					if ($i == 0 ) {
						$i++;
						next;
					}
					&pretty_print($beg, $match,
					$end, $file);
					#
					# Optimization.  Drop out of
					# big loop if too many matches.
					#
					if ($overmax) {
						last FILEPROC;
					}
				}
			}
		}
	}
	close(STRING);
}
#
# Let's get started.  Traverse the tree...
# (This is Larry Wall's code from pg 58, Llama book.  With mods)
#
sub dodir {
	local($dir, $nlink) = @_;
	local($dev,$ino,$mode,$subcount);

	# At the top level, we need to find nlink ourselves

	($dev,$ino,$mode,$nlink)=lstat('.') unless $nlink;

	# Get the list of files in the current directory

	opendir(DIR, '.') || die "Can't open $dir: $!\n";
	local(@filenames)=readdir(DIR);
	closedir(DIR);

	if ($nlink==2) {	# This dir has subdirs
		for(@filenames) {
			next if $_ eq '.';
			next if $_ eq '..';
			$name="$dir/$_";
			&disp($name);
		}
	}
	else {
		$subcount=$nlink-2;
		for (@filenames) {
			next if $_ eq '.';
			next if $_ eq '..';
			$name = "$dir/$_";
			&disp($name);
		    next if $subcount == 0;

			# Get link count and check out for directories

			($dev,$ino,$mode,$nlink) = lstat($_);

			next unless -d _;

			#
			# Check the current pathname against the
			# "I REALLY wouldn't go there if I were
			you..." list.
			#
			undef $cantgo;
			foreach (@BADPATHS) {
				if ($name =~ /^$_/) {
					$cantgo=$_;
				}
			}
			#
			# Check the $dev field against @DEVLIST to see if
			# the directory is local or not...
			#
			undef $localdir;
			foreach(@DEVLIST) {
				if ($_ eq $dev) {
					$localdir=$_;
				}
			}
			#
			# Is it really a dir?  If so, do recusively
			# If there's no problems...
			#
			if (defined($localdir) && (!defined($cantgo)))
			{
				chdir $_ || die "Can't cd to $name:
				$!\n";

				&dodir($name, $nlink);
				chdir '..';
			}
			--$subcount;
		}
	}
}
#
# Analyize the output from the tree walk.
# Is the symlink ok?  Is the file's contents kosher?
#
sub disp {

	$where=$cwd . substr($_[0], 1);

	($dev, $ino, $mode)=lstat($where);
	undef $target;
	$target=readlink($where);
	$numfiles=$numfiles+1;
	if (defined($target)) {
		&check_link($where, $target);
	} else {
		&check_file($where);
	}
}
#
# Is this a symlink to somewhere evil?
#
sub check_link {

	$file=$_[0];
	$link=$_[1];

	foreach(@LOOK_STRINGS) {
		if ( $link =~ /$_/ ) {
			printf(OUTPUT "(%s) %s --> %s\n", $_,
			$file, $link);
		}
	}
}
#
#############
# Main Body #
#############
#
#
# Close some things up
#
if (! $testing) {
	close(STDIN);
	close(STDOUT);
	close(STDERR);
	if (fork) {
		exit(0);
	}
}
#
# Get the data of pathnames to avoid... (/ford/server, /dev, etc...)
#
open(FORBID, "/tmp/invalid_paths") || die "Reading
invalid_paths: $!\n";
@BADPATHS=<FORBID>;
close(FORBID);
foreach(@BADPATHS) {
	chop $_;
}

#
# Get the list of things we are looking for... (server1, server2, etc...)
#
open(LOOKFOR, "/tmp/look_strings") || die "Reading look_strings:
$!\n";
@LOOK_STRINGS=<LOOKFOR>;
close(LOOKFOR);
foreach(@LOOK_STRINGS) {
	chop $_;
}

#
# Get our output channel.
#
if ($testing) {
	open(OUTPUT, "|cat");
} else {
	open(OUTPUT, "| mail cache@ed7590.pto.ford.com") || die
	"Can't open output stream: $!\n";
}

#
# Let's figure out what archtype we are.
#
open(TEMP, "/ford/bin/arch |");
$arch=<TEMP>;
close(TEMP);
chop($arch);

#
# Now, collect the appropriate "df" output, depending on archtype.
# (This IS a portability problem.  Each pipe below returns output which
# is as self-similar as possible.  Still not perfect.  Columns don't align.)
#
if ( $arch eq "aix" ) {
	$dfcmd="df | grep -v : | grep -v Filesystem |";
	$field=6;
} elsif ( $arch eq "solaris" ) {
	$dfcmd="/ford/server/loc/GNU/bin/gdf -x nfs | grep -v Filesystem
	| grep -v auto_direct |";
	$field=5;
} elsif ( $arch eq "sun4" ) {
	$dfcmd="/ford/server/loc/GNU/bin/gdf -x nfs | grep -v Filesystem
	| grep -v auto_direct |";
	$field=5;
} elsif ($arch eq "sgimips" ) {
	$dfcmd="df | grep -v : | grep -v Filesystem |";
	$field=6;
}

open(DFINP, $dfcmd);
@DF=<DFINP>;
close(DFINP);

#
# For each LOCAL filesystem, build an array with the "st_dev"
field in it..
#
foreach (@DF) {
	@FIELDS=split;
	($dev)=stat($FIELDS[$field]);
	@DEVLIST=(@DEVLIST, $dev);
}
open(TMP, "pwd |");
$cwd=<TMP>;
close(TMP);
chop $cwd;

open(DATE, "date |");
$date=<DATE>;
close(DATE);
chop $date;
printf(OUTPUT "EEE System Walker started $date\n");

$numfiles=0;
$numbytes=0;
&dodir('.');

open(DATE, "date |");
$date=<DATE>;
close(DATE);
chop $date;
($user, $sys)=times;
printf(OUTPUT "EEE System Walker finished $date\n");
printf(OUTPUT "CPU: %.2f %.2f FILESYS: $numfiles files ($numbytes
bytes).\n", $user, $sys);

close(OUTPUT);

--
----------------------------------------------------------------------o------
    Clinton A. Pierce	    |	 "If you rush a Miracle Man     |	\ / \ /
cpierce1@ed7590.pto.ford.com|	   you get rotten miracles."    |	 \ G /
 DCI, Inc. on loan to Ford. | --Miracle Max, The Princess Bride |  / \ / \
------------------------------------------------------------------Freemason--



Back to index