#!/usr/bin/perl
# $Id: Install,v 1.1 92/08/05 07:54:06 cap Exp $
# This program installs in one program a series of "hacks", where a
# hack is a new routine that gets called by intercepting control from
# the original program.
# 
# There is a per-hack array, which indices defined as follows:
$PATCH_ADDR	= 0;	# address of source to patch
$RETURN_ADDR	= 1;	# address where control should return
$RETURN_STR	= 2;	# a string to give to each routine, which
			# it uses in some way to get back
$ROUTINE_NAME	= 3;	# name of the new routine *and* the file
			# containing it
$ROUTINE_ADDR	= 4;	# final address of the new routine
$BRANCH_TYPE	= 5;	# how to get to $ROUTINE_ADDR. Presently
			# the options are "bsr" and "jmp"

## Determine the source and target Workspace images
$preference=`sh -c "dread loginwindow Workspace 2>/dev/null"`;
if ($preference) {		# user already has her own Workspace
    $personal_workspace="$1" if $preference =~ /.* .* (.*)/;
    $source_name="$personal_workspace.orig";
    $target_name=$personal_workspace;
    print "I see that you already have a custom workspace:\n";
    print "$personal_workspace.\n";
    print "I'll use that as the basis for my changes, and I'll save the original as\n";
    print "$source_name.\n";
    &version_config($target_name);
    $command="mv $personal_workspace $source_name";
    print "$command\n";
    system($command);
} else {			# user is using system standard Workspace
    $personal_workspace_dir = sprintf("%s/Apps/Workspace.app", $ENV{"HOME"});
    $sysdir="/usr/lib/NextStep/Workspace.app";
    $source_name="$sysdir/Workspace";
    $target_name="$personal_workspace_dir/Workspace";
    print "I see that you're using the standard system workspace.\n";
    print "I'll make my changes from that and install them as\n";
    print "$target_name\n";
    &version_config($source_name);
    $command="mkdirs $personal_workspace_dir";
    print "$command\n";
    system($command);
    # make links to other Workspace files
    while (<$sysdir/*>) {
	$basename = $1 if /\/([^\/]*)$/;
	if ($basename ne "Workspace") {
	    $from = "$sysdir/$basename";
	    $to = "$personal_workspace_dir/$basename";
	    if (!(-e $to)) {
		$command="ln -s $from $to";
		print "$command\n";
		system($command);
	    }
	}
    }
}

## find out where things will go in target
print "Examining $source_name\n";
eval(`./last_section $source_name`);
$target_seg = $segname;		# name of segment into which we place the 
				# new code
$target_sect = $sectname;	# section of above segment where code goes
$source_endaddr = $endaddr;	# end of address space, and start address of
				# our new code

## compile each hack
&compile_hack(@my_main[$ROUTINE_NAME], @my_main[$RETURN_STR]);
&compile_hack(@playsound[$ROUTINE_NAME], @playsound[$RETURN_STR]);

## link the hacks into an executable
$carcass="/tmp/carcass$$";
$command = sprintf("ld -segalign 4 -segaddr __TEXT 0x%x -U __NXArgc -U __NXArgv -U __environ -U _main -o %s %s.o %s.o -lNeXT_s -lsys_s",
		   $source_endaddr,
		   $carcass,
		   @my_main[$ROUTINE_NAME],
		   @playsound[$ROUTINE_NAME]);
print "$command\n";
system($command);

# pull the text segment from the carcass
$ctext="/tmp/carcass_text$$";	# the __TEXT segment of the carcass
$wsect="/tmp/wsect$$";		# the last section of $source_name
$command="./extract_segment $carcass __TEXT $ctext";
print "$command\n";
system($command);
# pull the last section of $source_name, which we assume is
# the last part of its address space
$command="segedit $source_name -extract $target_seg $target_sect $wsect";
print "$command\n";
system($command);
# append carcass's text segment to this last section
$command="cat $ctext >> $wsect";
print "$command\n";
system($command);
# create $target_name by putting the enlarged segment back into
# the (copy of) $source_name
print "unlink $target_name\n";
unlink $target_name;
$command="segedit $source_name -replace $target_seg $target_sect $wsect -output $target_name";
print "$command\n";
system($command);
# make the segment we replaced readable, writable, and executable
# and mark it as being non-relocatable
$command="./segopts -segname $target_seg -maxprot 7 -initprot 7 -flags 0 $target_name";
print "$command\n";
system($command);
# patch the jump instructions into the new target
&insert_hook(@my_main);
&insert_hook(@playsound);

# write the defaults data base
$command="dwrite loginwindow Workspace $target_name";
print "$command\n";
system($command);

## clean up
print "unlink $carcass, $carcass.o, $carcass.s, $ctext, $wsect\n";
unlink $carcass, "$carcass.o", "$carcass.s", "$ctext", "$wsect";

sub compile_hack {
    local($name, $return) = @_;
    local($command);

    $command="cc -S -DRETURN=\"$return\" $name.c";
    print "$command\n";
    system $command;
    &massage_asm("$name.s");
    $command="cc -c $name.s";
    print "$command\n";
    system $command;
    print "unlink $name.s\n";
    unlink "$name.s";
}

sub insert_hook {
    local(@hack) = @_;

    $command="nm $carcass | grep _@hack[$ROUTINE_NAME]";
    print "$command\n";
    @hack[$ROUTINE_ADDR]=`$command`;
    @hack[$ROUTINE_ADDR] = hex($1) if @hack[$ROUTINE_ADDR] =~ /([^ ]+) /;
    $command=sprintf("./insert_hook -%s %s 0x%x 0x%x",
		     @hack[$BRANCH_TYPE],
		     $target_name,
		     @hack[$PATCH_ADDR],
		     @hack[$ROUTINE_ADDR]);
    print "$command\n";
    system($command);
}

sub massage_asm {
    local($name) = @_;

    $command="sed 's/^\\.[^ ]*\$/.text/' < $name > $name.$$";
    print "$command\n";
    system($command);
    $command="mv $name.$$ $name";
    print "$command\n";
    system($command);
}

#
# Configure for a particular version of Workspace.
# As a side effect, the file $config_file should set
# @my_main and @playsound. If we find no configuration 
# file for the version of Workspace denoted by the first
# argument, we print an error and die.
#
sub version_config{
    print "Let's see what version of Workspace you have . . .\n";
    $command = "/usr/ucb/what @_[0] | grep PROGRAM";
    print "$command\n";
    $version_string = `$command`;
    ($version) = $version_string =~ /PROJECT:workspace-([^ \t]*)[ \t]/;
    
    $config_file = "config.$version";
    if (-f $config_file) {
	print "Loading configuration file $config_file\n";
	require $config_file;
    } else {
	print "
I don't have any configuration information for your version of Workspace.
Read the file PORTING.rtf for simple instructions on how to create
a configuration file for your Workspace. In the mean time, I'd like to
send the following mail message to the author so that he can keep track
of versions that still need configuration information.\n\n";
	$mail_message = "To: Chris Paris <cap+@cmu.edu>
Subject: Unconfigured Workspace

I found a version of Workspace called
${version_string}and I have no configuration for it.\n";
	print "-----\n$mail_message-----\n";
	print "May I send this message? ";
	$answer = getc;
	if ($answer == 'y' || $answer == 'Y') {
	    print "Off it goes then . . .\n";
	    $command = "/usr/lib/sendmail cap+@cmu.edu";
	    print "$command\n";
	    open(SENDMAIL, "|$command") || die "Cannot pipe to sendmail.\n";
	    print SENDMAIL $mail_message;
	    close(SENDMAIL);
	} else {
	    print "Okay then, I won't send anything. If you'd like to send your own message,
it would be very helpful to send the author the above message I offered
to send for you. Just clip it into a send window. Remember, read PORTING.rtf
and you'll be up and running in ten minutes!\n";
	}
	exit(1);
    }
}