#!/bin/sh -- # A comment mentioning perl
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

use File::Basename;

############################################################################
# Path to your vmware .cfg file:
$VMWARE_CONFIG = "/home/runge/vmware/sandbox_win95/win95.cfg";

# Path to your vmware .dsk virtual disk file:
$VMWARE_DISK = "/home/runge/vmware/sandbox_win95/win95.dsk";
#
#$VMWARE_DISK = $VMWARE_CONFIG;
#$VMWARE_DISK =~ s/\.cfg/.dsk/;
#

# Path to your .tar.gz vmware virtual disk file backup tarball:
$VMWARE_BACKUP = "/home/runge/vmware/sandbox_win95.tar.gz";
#
#$VMWARE_BACKUP = dirname($VMWARE_CONFIG) . ".tar.gz";
#
$howto_make_backup = <<"END";
	To make your virtual disk backup file do the following. If your
	vmware cfg file is, say, /home/me/vmware/winfoo/win95.cfg, then
	run these commands:

	    % cd /home/me/vmware
	    % tar -czvf winfoo.tar.gz winfoo
END
############################################################################
$Incoming_Dir = 'incoming';
$Extract_Attachments = 1;
$Check_nbd = 1;
$Check_networking = 1;
$Do_Restoration = 1;
$Prompt_For_Restoration = 0;
$Verbose = 0;
$Stdin = 0;
############################################################################


$Program = basename($0);

$Usage = <<"END";

$Program: Take files and copy them to a VMware sandbox and then boot it.
	v0.1 Copyright (c) 2001 by Karl J. Runge <runge\@karlrunge.com> 

Usage: $Program <options> <files>

Options:
	-c <file>	Path to VM dsk file.
	-d <file>	Path to VM cfg file.
	-b <file>	Path to VM backup tarball.
		        (these 3 paths may be set at the top of this script)

	-n		Do not attempt to extract attachments from <files>.
	-p		Prompt whether to restore with the backup tarball.
	-have-nbd	indicate that the kernel has nbd support.

Notes:
	To avoid negative effects from viruses, worms, trojan horses, etc,
	the following are important:

	   - You MUST have networking turned off in the VM.

	   - You SHOULD have the VMware virtual disk restored
	     from backup every time this script is run.

	If you use Linux + VMware to propagate Windows viruses and trojans
	it is all your responsibility!

$howto_make_backup

	vmware-mount.pl requires that the Network Block Device (nbd)
	be compiled into your kernel. (kernel option CONFIG_BLK_DEV_NBD)
	http://www.vmware.com/support/reference/linux/loopback_linux.html

	vmware-mount.pl must be run as root, so su(1) will be used
	to prompt for the root passwd and run vmware-mount.pl.

	Files that are detected to be mail files (e.g. via "From" in
	the header) are extracted by metamail(1). If this messes up use -n
	to skip metamail and copy the file directly to the virtual disk.

END

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

# Parse cmd line args:
LOOP:	
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-c$/ && ($VMWARE_CONFIG = shift, last CASE);
	/^-d$/ && ($VMWARE_DISK = shift, last CASE);
	/^-b$/ && ($VMWARE_BACKUP = shift, last CASE);
	/^-n$/ && ($Extract_Attachments = 0, last CASE);
	/^-p$/ && ($Prompt_For_Restoration = 1, last CASE);
	/^-have.nbd$/ && ($Check_nbd = 0, last CASE);
	/^-v$/ && ($Verbose = 1, last CASE);
	/^-D$/ && ($Debug = 1, last CASE);
	/^-$/ &&  ($Stdin = 1, last CASE);
	/^--$/ && (last LOOP);	# -- means end of switches
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-h|-help)$/ && ((print STDERR $Usage), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		local($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((print STDERR "Invalid arg: $_\n$Usage"), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

# check for utilities, existence of files, nbd kernel support...
check_for_stuff();

# all work is done in a 700 dir dir like /tmp/vmview.12345/
make_tmpdir();

# copy files to a staging area with possible metamail(1) extraction.
extract_attachments();

# copy the items to c:\incoming in the VMware virtual disk.
copy_files();

# run the emulator:
run_vmware();

# overwrite the "tainted" virtual disk and config files with 
# backup copies:
restore_backup();

# clean out the tmp dir:
cleanup();

exit 0;

############################################################################
sub check_for_stuff {
	
	# check for VM .cfg and .dsk
	if ( ! -f $VMWARE_CONFIG ) {
		warn "$VMWARE_CONFIG: $!\n";
		die "cannot find the VMware config file.\n";
	}
	if ( ! -f $VMWARE_DISK ) {
		warn "$VMWARE_DISK: $!\n";
		die "cannot find VMware virtual disk file.\n";
	}

	# check for vmware utilities:
	# (FIXME: this "type" test will get a false positive from directories)
	foreach my $utility (qw(vmware vmware-mount.pl)) {
		system("type '$utility' 1>/dev/null 2>&1");
		if ( $? != 0 ) {
			die "cannot locate utility program: $utility\n";
		}
	}

	# check for metamail
	if ( $Extract_Attachments ) {
		system("type metamail 1>/dev/null 2>&1");
		if ( $? != 0 ) {
			warn "\ncannot locate utility program: metamail\n";
			warn "attachments will not be extracted.\n";
			$Extract_Attachments = 0;
		}
	}

	# check for nbd device in kernel (required by vmware-mount.pl).
	my $found_nbd = 0;	
	#
	# FIXME: There is a problem here for automatically loaded nbd modules.
	# Could do (as root): open(NBD, "</dev/nb0"); close(NBD); to load it.
	# User will have to use -have-nbd to get around this check.
	#
	if ( open(DEVICES, "</proc/devices") ) {
		while (<DEVICES>) {
			chomp;
			$found_nbd = 1 if /^\s*\d+\s+nbd$/;
		}
		close(DEVICES);
	}
	$found_nbd = 1 unless $Check_nbd;
	if ( ! $found_nbd ) {
		warn "\ncould not determine from /proc/devices if the Network Block Device (nbd)\n";
		warn "is supported in the current kernel. (kernel option: CONFIG_BLK_DEV_NBD)\n";
		warn "vmware-mount.pl requires the nbd service.  For more info see:\n";
		warn "http://www.vmware.com/support/reference/linux/loopback_linux.html\n";
		exit 1;
	}

	# check for nbd special file (we must have this):
	if ( ! -e "/dev/nb0" ) {
		warn "\nno network block device file: /dev/nb0: $!\n";
		warn "run this command as root:  mknod /dev/nb0 b 43 0\n"; 
		exit 1;
	}

	# check for existence of backup tarball:
	if ( $Do_Restoration && ! -f $VMWARE_BACKUP ) {
		warn "\n$VMWARE_BACKUP: $!\n";
		warn "cannot find VMware virtual disk backup tarball.\n";
		print STDERR "the VMware disk will not be restored upon completion.  Continue? y/[n] ";

		# use /dev/tty since STDIN may contain data.
		my $reply = `head -1 /dev/tty`;
		if ( $reply !~ /y/i )  {
			exit 0;
		}
	}

	# check if VM has networking turned on (a bad idea IMHO).
	if ( $Check_networking ) {
		my $networking = ''; 
		if ( open(CFG, "<$VMWARE_CONFIG") ) {
			while (<CFG>) {
				chomp;
				next if /^\s*#/;
				if ( /^\s*ethernet.*\.present.*TRUE/ ) {
					$networking = $_;
				}
			}
			close(CFG);
		} else {
			warn "$VMWARE_CONFIG: $!\n";
			die "\ncannot open the VMware config file.\n";
		}
		if ( $networking ne '' ) {
			warn "\n$VMWARE_CONFIG\n";
			warn "indicates that networking is turned on: $networking\n";
			print STDERR "This is a very bad idea if the .EXE file is not trusted.  Continue? y/[n] ";

			# use /dev/tty since STDIN may contain data.
			my $reply = `head -1 /dev/tty`;
			if ( $reply !~ /y/i )  {
				exit 0;
			}
		}
	}
}

sub make_tmpdir {
	$TmpDir = "/tmp/$Program.$$";

	if ( ! mkdir $TmpDir, 0700 ) {
		die "cannot create tmp directory: $!\n";
	}

	# mydie() will clean out the tmp dir:
	$SIG{INT}  = 'mydie';
	$SIG{TERM} = 'mydie';
}

sub mydie {
	my ($msg, $n) = @_;
	$n = 1 if ! defined $n;
	print STDERR $msg;
	cleanup();
	exit $n;
}

sub cleanup {
	if ( -d $TmpDir && $TmpDir !~ m,^/+$, ) {
		print STDERR "\nRemoving tmpdir: rm -r $TmpDir ...\n";
		sleep 1;
		system 'rm', '-r', $TmpDir;
	}
}

sub extract_attachments {
	# copies files on the command line to $TmpDir/files/
	# if a file appears to be a mailfile, attachments are extracted.
	
	$Dir = "$TmpDir/files";
	mkdir $Dir, 0700 || &mydie("$TmpDir/files: $!\n");

	my $pwd = `pwd`;
	chomp($pwd);

	my($file, $base, @list);

	if ( $Stdin || ! @ARGV ) {
		my $outfile = "$Dir/stdin";
		open(OUT, ">$outfile") || &mydie("$outfile: $!\n");
		while (<STDIN>) {
			print OUT $_;
		}
		close(OUT);
		@list = ("$outfile");
		# reopen STDIN for su(1) password later.
		open(STDIN, "</dev/tty");
	} else {
		@list = @ARGV;
	}

	warn "\n$Program: processing files:\n\n\t", join("\n\t", @list), "\n\n";

	foreach $file (@list) {
		if ( ! -r $file ) {
			warn "cannot read: $file: $!\n";
			next;
		}

		$base = basename($file);
		# scrub it a bit
		$base =~ s/[`'&;*\$]//g;
		$base =~ s/\s+/_/g;

		if ( ! $Extract_Attachments || ! -T $file ) {
			# Binary file, just copy it.
			next if $file eq "$Dir/$base"; # stdin case
			system 'cp', $file, "$Dir/$base";
			if ( ! -f "$Dir/$base" ) {
				&mydie("could not create: $Dir/$base: $!");
			}
			next;
		}

		# It is a text file:
		if (! open(TEXT, "<$file") ) {
			warn "cannot read: $file: $!\n";
			next;
		}

		my $i = 0;
		my $hdr = 1;
		my $is_email = 0;

		# Scan header or 1st 30 lines for From and From: ... lines:
		while (<TEXT>) {
			last if $i++ > 30;
			$hdr = 0 if /^\s*$/;
			last unless $hdr;
			if ( /^(From |From: |To: |Subject: )/ )  {
				$is_email = 1;
				last;
			}
		}
		close(TEXT);

		if ( ! $is_email ) {
			# evidently not an email file, just copy it.
			next if $file eq "$Dir/$base"; # stdin case
			system 'cp', $file, "$Dir/$base";
			if ( ! -f "$Dir/$base" ) {
				&mydie("could not create: $Dir/$base: $!");
			}
			next;
		}

		# run metamail on the source:
		#
		# even though -x should prevent metamail from prompting, 
		# we do not redir the output to /dev/null just to be sure.
		#
		if (fork) {
			wait;
			print STDERR "\nFinished metamail of \"$file\"\n";
			print STDERR '-' x 72, "\n";
		} else {
			if ( $file !~ m,^/, ) {
				# make it an absolute path:
				if ( -f "$pwd/$file" ) {
					$file = "$pwd/$file";
				}
			}
			$ENV{METAMAIL_TMPDIR} = $Dir;
			chdir $Dir;
			print STDERR "\n", '-' x 72, "\n";
			print STDERR "Running: metamail -q -w -x $file ...\n";
			sleep 1;
			exec 'metamail', '-q', '-w', '-x', $file;
			exit 1;
		}
		#
		# should check if metamail created anything new.
		# user will have to notice the problem and use -n.
		#
		# also, note that metamail could have created some
		# files with meta characters. 
	}
}

sub copy_files {
	# This sub will mount the vmware virtual disk and then
	# copy the files to c:\incoming.

	my $script = "$TmpDir/mnt.sh";
	my $mntdir = "$TmpDir/mnt";

	mkdir $mntdir, 0700 || &mydie("could not create: $mntdir: $!");

	open(SCRIPT, ">$script") || &mydie("could not create: $script: $!");

	my $flag_file = "$TmpDir/flag";

	# this kludgy script with a background process and flag file is used
	# to do all of the root stuff so only one su(1) is required.
	# It is likely fragile, and needs to be rethought.

	print SCRIPT <<"END";

	copywatch () {
		cnt=0
		while [ "\$cnt" -lt 100 ]
		do
			sleep 1
			cnt=\`expr \$cnt + 1\`
			#`
			if [ -f "$flag_file" ]; then
				sleep 1
				if [ ! -d "$mntdir/$Incoming_Dir" ]; then
					mkdir -p "$mntdir/$Incoming_Dir"
				fi
				for file in $Dir/*
				do
					# sleep here due to nbd kernel driver
					# deficiencies that hang the system!
					sleep 2
					cp "\$file" "$mntdir/$Incoming_Dir"
				done
				break
			fi
		done
		sleep 1
		ls -l "$mntdir/$Incoming_Dir" > "$TmpDir/list"
		rm -f "$flag_file"
		kill -INT \$parent 
		# vmware-mount.pl does not appear to clean this out:
		rm -f "/tmp/vmware-mount.pl.\$parent"
		rm -f "$script"
		exit 0
	}

	parent=\$\$
	copywatch &

	exec vmware-mount.pl "\$\@"

END
	close(SCRIPT);
	system("cat $script; sleep 5") if $Debug;
	
	# prepare forked process to exec the su(1) command.
	$vmware_mount_pid = open(VMWARE_MOUNT, "-|");
	&mydie("could not fork to run vmware-mount.pl: $!\n") unless defined $vmware_mount_pid;

	# to set ownership of the lising file to us so we can remove it later
	system 'touch', "$TmpDir/list";

	if ( ! $vmware_mount_pid ) {
		# child here. 
		sleep 1;
		# following assumes clean strings in $VMWARE_DISK and $mntdir
		exec 'su', '-c', "sh $script '$VMWARE_DISK' 1 -t vfat '$mntdir'";
		exit 1;
	}

	print STDERR "\n\n";
	print STDERR "Enter the root password when prompted to run vmware-mount.pl\n";
	print STDERR "and copy the files to c:\\$Incoming_Dir as root.\n\n";

	sub finish_mount {
		kill INT, $vmware_mount_pid;
		close(VMWARE_MOUNT);
		print STDERR "\nYIPPIE! it appears we closed the vmware-mount.pl process OK.\n";
	}

	my $checks = 0;
	my $output = '';
	my $mounts;

	# Examine the vmware-mount.pl output to see if all is OK:
	while (<VMWARE_MOUNT>) {
		print STDERR "\n" if ! $output;
		print STDERR "vmware-mount sez: $_" if $Verbose;
		$output .= $_;
		if ( /Please re-run this script as the super user/ ) {
			&mydie("$_\n");
		}
		$checks++ if /Network Block Device driver detected/;
		$checks++ if /Using another terminal, you can now browse/;
		if ( /Hit Control-C in this terminal when done/ ) {
			$checks++;
			sleep 3;
			last;
		}
	}

	# Indicate to the root subprocess it is OK to copy the files now:
	system 'touch', $flag_file;

	if ( $checks != 3 ) {
		kill INT, $vmware_mount_pid;
		&mydie("\nSomething bad happened when running vmware-mount.pl:\n$output\n"); 
	}

	# Check mounts for the vmware partition:
	$mounts = `mount`;
	if ( $mounts !~ m,/dev/nb\d+\s+.*\bon\b.*\btype\s+(msdos|vfat)\b, ) {
		sleep 4;
		kill INT, $vmware_mount_pid;
		&mydie("\nnot mounted:\n$mounts\n\n$output\n"); 
	} else {
		print STDERR "\nmounted: ", `mount | grep '/dev/nb'`;
	}

	# Now wait for the root subprocess to remove the flag file:
	my $got_it = 0;
	foreach my $i (1..100) {
		sleep 1;
		if ( ! -f $flag_file ) {
			$got_it = 1;
			if ( -s "$TmpDir/list" ) {
				print STDERR "\nCreated in c:\\$Incoming_Dir:\n";
				system "cat '$TmpDir/list' 2>/dev/null";
				print STDERR "\n";
			}
			last;
		} else {
			system("ls -l $flag_file $mntdir/incoming") if $Debug;
		}
	}
	&finish_mount();
	&mydie("") unless $got_it;
}

sub run_vmware {
	warn "\nRunning: vmware -x $VMWARE_CONFIG ...\n";
	system 'vmware', '-x', $VMWARE_CONFIG;
}

sub restore_backup {

	if ( ! $Do_Restoration ) {
		warn "\nSkipping restoration of VMware virtual disk file.\n";
		return;
	}
	if ( ! -f $VMWARE_BACKUP ) {
		warn "\n$VMWARE_BACKUP: $!\n";
		warn "Skipping restoration of VMware virtual disk file.\n";
		return;
	}

	my $dir = dirname($VMWARE_BACKUP);

	my $pwd = `pwd`;
	chomp($pwd);

	if ( $Prompt_For_Restoration ) {
		warn "\nBackup is: $VMWARE_BACKUP\n";
		warn "Restore VMware virtual disk and config files? [y]/n ";
		my $reply = `head -1 /dev/tty`;
		if ( $reply =~ /n/i ) {
			return;
		}
	} else {
		warn "\nRestoring virtual disk and config files:\n";
	}

	if ( chdir $dir ) {
		system 'tar', '-xzvvf', $VMWARE_BACKUP;
	}
	chdir $pwd;
}