#!/afs/athena/contrib/perl/p

###############################################################################
##                                                                           ##
## This is where I define a lot of random constants for simple modification. ##
##                                                                           ##
###############################################################################

# web_people_dir should end with a slash.
$web_people_dir = "/var/local/httpd/root/people/";
# $web_people_dir = "/afs/sipb/project/www/bin/people/";

$homepage_file =  "/var/local/httpd/root/home-pages.html";
#$homepage_file = "/afs/sipb/project/www/bin/test-home-pages.html";

$server_script = "/afs/sipb/project/www/bin/server-add-home.pl";

$temp_file   = "/usr/tmp/editing_home-pages.html." . time() . "." . $$;

$rcs_binary_dir = "/afs/athena.mit.edu/contrib/watchmaker/bin";

@rsh_cmd = ('/usr/athena/bin/rsh', 'www');

$ls_bin = '/bin/ls';
$mail_cmd = '/bin/mail';
$fs_bin = '/bin/athena/fs';

$ucb_finger_bin = '/usr/ucb/finger';
$linux_finger_bin = '/usr/bin/finger';

#############################################################################
#############################################################################

# if (@ARGV) { &explain_usage(); }

# ($url, $username, $name) = &get_homepage_entry();
# &add_homepage($homepage_file, $url, $username, $name);

# This line should be uncommented.
($url, $username, $realname) = &parse_mail($ARGV[0]);
&add_homepage($url, $username, $realname, $homepage_file);

sub add_homepage {
    local($url, $username, $name, $filename, $old_symfile, $new_symfile) = @_;
    $old_symfile = "";
    $new_symfile = "";

    $username = &happy_username($username);

    $url = &happy_url($url);

    if ($url =~ /^[Hh][Tt][Tt][Pp]:/) {
	if ($url =~ /^http:\/\/?www\.mit\.edu:?(8001)?/) {
	    $url = $';
	} elsif ($url =~ /web\.mit\.edu(\/afs)/) {
	    $url = $1 . $';
	} else {
	    # This will be executed if they gave us a URL at another web
	    # server

	    # This fixes the number of preceding slashes.
	    $url =~ s/^(http:)\/*([^\/].*)$/\1\/\/\2/;

	    # This adds a trailing slash if one is needed.
	    if ($url =~ /^http:\/\/[^\/]*$/) {
		$url = $url . "/";
	    }

	    if (&home_accept($name, $username, $url)) {
		&add_to_homepage_file($filename, $url, $username, $name,
				      $temp_file, "", "");
		return;
	    } else {
		exit;
	    }
	}
    }
    # If we got here, it means that they gave us a filename.
	    
    $url = &happier_url($url, $username);

    if (&home_accept($name, $username, $url)) {
	# Use open() instead of -r because -r tests UFS bits, which
	# don't matter since we're in AFS....
	if (open(TEST, $url)) {
	    close TEST;
	    if (-d $url) {
		if (open(FTEST, ($url . "/home.html"))) {
		    close FTEST;
		    $url = $url . "/home.html";
		} else {
		    
		    print "-------------------------------------------------\n";
		    print "The specified file \"$url\"\n";
		    print "is a directory. Do you want to ls the directory\n";
		    print "to try to pick out the homepage file?\n>>";
		    if (&accept()) {
			print "------------------------------------------------\n";
			system $ls_bin, '-la', $url;
			print "------------------------------------------------\n";
			print "Is there a file there you want to use?\n";
			print "*** ANSWER YES OR NO *** (not with the filename)\n";
			print ">>";
			if (&accept()) {
			    $fname = "ZZZZZ";
			    print "What is the name of the file?\n";
			    until (open(FTEST, ($url . "/" . $fname))) {
				print ">>";
				$fname = (<STDIN>);
				chop($fname);
			    }
			    close FTEST;
			    $url = $url . "/" . $fname;
			} else {
			    exit;
			} # end if &accept() of okay files
		    } else {
			exit;
		    } # end if &accept() of picking files
		} # end of if open $url . "/home.html"
	    } # end of -d $url
	
	    ($url, $old_symfile, $new_symfile) = &pick_symlink_for_file($url);
	    &add_to_homepage_file($filename, $url, $username, $name,
				  $temp_file, $old_symfile, $new_symfile);
	} else {
	    print "Cannot access file \"$url\".\nDid not add homepage.\n";
	    &tell_user_unreadable($username, $url);
	    exit;
	} # end of open TEST
    } else {
	exit;
    }
}

sub pick_symlink_for_file {
    local($path, $username, $rest, $old, $new) = @_;
    $old = "";
    $new = "";


    if ($path !~ /^\/afs\/(sipb|athena)\.mit\.edu\/user\//) {
	print "The path ($path) is nonstandard. I'm aborting.\n";
	exit;
    }

    $path =~ /^(\/afs\/(sipb|athena)\.mit\.edu\/user\/.*\/)(.*)$/;

    $userdir = $1;
    $userfile = $3;

#     print "$userdir\n$userfile\n";

    if ($path =~ /^\/afs\/athena\.mit\.edu\/user\/\S\/\S\/([^\/]*)\//) {
	$username = $1;
    } elsif ($path =~ /^\/afs\/sipb\.mit\.edu\/user\/([^\/]*)\//) {
	$username = $1;
    }

    if (-d $userdir) {
	print "Should I add a symlink from people/$username to\n";
	print "\"$userdir\" ?\n >>";
	if(&accept()) {
	    $relative_url_for_homepage =
		("/people/" . $username . "/" . $userfile);
	    # second returned value is symlink_old
	    # third  returned value is symlink_new
	    return ($relative_url_for_homepage, $userdir,
		    $web_people_dir . $username);
	} else {
	    exit;
	}
    } else {
	print "$userdir is not a directory. I don't know what to do.\n";
	exit;
    }
}

sub home_accept {
    local($name, $username, $url) = @_;
    
    print "----------------------------------------------------------\n";
    print "Real name: $name\n";
    print " Username: $username\n";
    print "      URL: $url\n";
    print "-----------------------------\n";
    print "Do you want to add this entry to the homepage list?\n";
    print ">>";
    return &accept();
}

sub accept {
    local($input);

    $input = (<STDIN>);
    chop($input);
    if ($input =~ /^[yY][eE]?[sS]?$/) {return 1;}
    return 0;
}

sub parse_mail {
    local($filename) = @_;

    # This will be an array of candidates for the person's real name
    local(@realname);
    $mail = "";

    open(FHAND, $filename);
    while (<FHAND>) {$mail .= $_;}
    close FHAND;

    $mail =~ s/^[^\n]*\n//;
    
    $mail =~ /\n?\s*[fF]rom:\s*(.*)\n?/;
    $from_line = $1;

    # If there's a Reply-to: line, then use it instead of the from line
    if ($mail =~ /\n\s*[Rr]eply\-?[Tt]o:\s*(.*)\n?/) {
	$from_line = $1;
    }

    # From: lines can be in a variety of formats, unfortunately.
    # These 3 lines should pick out the email address from *most* of them.
    #

    $address = $from_line;

    # This line handles the format 'email@foo.bar.com (Joe Smith)'
    if ($address =~ /(\S+)\s*\((.*)\).*/) {
	$address = $1;
	$realname[$#realname + 1] = $2;
    }
    
    # This line handles the format '"Joe Smith" email@foo.bar.com'
    if ($address =~ /.*\"(.*)\"\s*(\S+)\s*/) {
	$realname[$#realname + 1] = $1;
	$address = $2;
    }

    #
    # This line handles the format 'Joe Smith <email@foo.bar.com>'
    if ($address =~ /(.*)<\s*(\S+)\s*>.*/) {
	$realname[$#realname + 1] = $1;
	$address = $2;
    }

    # To avoid unnecessary confusion, delete boring lines from the mail.
    # There's probably a better way to do this than resetting $1... but ...
    # I don't know how.
    $1 = "";
    $mail =~ s/Received: from[^\n]*\n//g;
    $1 = "";
    $mail =~ s/Date: [^\n]*\n//g;
    $mail =~ s/X-Webclient: [^\n]*\n//g;
    $mail =~ s/X-Mailer: [^\n]*\n//g;

    # This keeps us from getting confused about references to our web page
    $mail =~ s/http:\/\/www\.mit\.edu:8001\/home-pages\.html//g;
    $mail =~ s/http:\/\/www\.mit\.edu:8001\/(doc\/)?how-to-hp\.html//g;

    # This should pick out a path or URL. Yay. Basically characters with
    # no spaces or slashes.

    # This would have a longer variable name except it would be gross.
    # It's basically the regexp for text that I think is valid for a URL.
    # Basically any non-space character besides parentheses and semicolon,
    # at the moment.

    # seems like the easiest way to keep from mis-recognizing this as
    # a homepage request....

    $mail =~ s/home\-pages\.html//g;

    $u = '[^\,\s\<\>\(\);\@\"\'\`]';
    $url = "";

    if ($mail =~ /\s*([a-zA-Z~\/]$u*\.html)\s*/) {
	$url = $1;
    } elsif ($mail =~ /\s*([a-zA-Z\.~\/]$u*\/$u*\/$u*)\s*/) {
	$url = $1;
    } elsif ($mail =~ /\s*([a-zA-Z~\/]$u*\/$u*)\s*/) {
	$url = $1;
    } elsif ($mail =~ /\s*([a-zA-Z~\/][Ww][Ww][Ww]$u*)\s*/) {
	print "Warning. This is quite possibly a totally useless URL.\n";
	$url = $1;
    } elsif ($mail =~ /\s*([a-zA-Z~\/]$u*)\s*/) {
	print "Warning. This is quite possibly a totally useless URL.\n";
	$url = $1;
    }

    # This trims off a trailing period, in case someone says something
    # like "My homepage is /mit/foo/www/foo.html."
    $url =~ s/\.$//;

    # This trims off a trailing "?" as long as the URL ends in ".html"
    $url =~ s/\.html\?$/\.html/;

    $m = $mail;

    # This matches two or three proper names in sequence. Due to
    # limitations in regexps, it also matches two capitalized words
    # separated by a noncapitalized word.
    while ($m =~ /\s*([A-Z][a-z]+ ?[A-Z]?[a-z]* [A-Z][a-z]+)\s*/) {
	$candidate = $1;
	$m = $';

	# This will filter out "Word word Word" and "Home Page"
	if (($candidate !~ / [a-z]* /) && ($candidate !~ /Home /)){
	    # Add it to the list of possible names
	    $realname[$#realname + 1] = $candidate;
	}
    }

    # Filter out leading/trailing spaces
    for ($i = 0; $i <= $#realname; $i++) {
	$realname[$i] =~ /^\s*(\S.*\S)\s*$/;
	$realname[$i] = $1;
    }

    # Sort array
    @realname = sort @realname;
    
    # Filter out duplicates
    for ($i = 0; defined($realname[$i]);) {
	if ($realname[$i] eq $realname[($i-1)]) {
	    splice (@realname, $i, 1);
	} else {
	    $i++;
	}
    }
    
#     print "URL is \"$url\"\n";
#     print "Username is \"$address\"\n";

    print $mail . "----------------------------------------------------\n";
    $picked_name = &pick_a_name($address, $url, $mail, @realname);
    return($url, $address, $picked_name);
}

sub pick_a_name {
    local($address, $url, $mail, @realname, $athena, $username) = @_;
    
    $athena = 0;

    $address =~ tr/A-Z/a-z/;
    if ($address =~ /\@mit\.edu$/) {
	$foo = &finger_thang($address);
	if ($foo) {
	    return ($foo);
	}

	# If we reach this point, it generally means "finger @mit.edu"
	# was unhelpful. This is a flag for use later, just to save
	# a bit of pattern-matching work.
	$athena = 1;

	# This saves us some work later too.
	$address =~ /^(.*)\@mit.edu$/;
	$username = $1;
    }

    $ok = 0;
    while(!$ok) {
	print "Candidates for first name are:\n";
	print " (0)  Display mail message\n";
	print " (1)  run command \'finger $address\'...\n";
	if ($athena) {
	    print " (2)  run command \'finger $username@athena.mit.edu\'...\n";
	}

	for ($i = 0; $i <= $#realname; $i++) {
	    # the "+ $athena" causes the numbers to be offset appropriately
	    # if option 2 was presented above.
	    print " (" . ($i + 2 + $athena) . ")  \"" . $realname[$i] . "\"\n";
	}
	
	# print " (".($#realname + 2).")  run command \'finger $address\'...\n";
    
	$input = "";
	print("select one >>");
	$input = (<STDIN>);
	chop($input);
    
	# depending on $athena, we want it to be more than either "1" or "2".
	# note that these are strings, not numbers.
	if (($input gt ($athena?"2":"1"))
	    && ($input lt ($#realname + 3 + $athena))) {
	    $ok = 1;}
	if      ($input eq "0") {
	    print $mail;
	} elsif ($input eq "1") {
	    $foo = &finger_thang($address);
	    if ($foo) {
		$realname[($#realname + 1)] = $foo;
	    }
	} elsif ($athena && ($input eq "2")) {
	    $foo = &finger_thang(($username . "@athena.mit.edu"));
	    if ($foo) {
		$realname[($#realname + 1)] = $foo;
	    }
	}
    }
    print $input
    return($realname[($input - 2 - $athena)]);
}

sub finger_thang {
    local($adr, $ok, $input) = @_;
    
    # If there are any possibly sneaky characters here, then
    # don't run the finger command.
    if ($adr =~ /[^a-zA-Z0-9\@\_\-\+\.]/) { 
	print "No finger performed. The specified address looks fishy.\n\n";
	return (());
    }
    
    $adr =~ tr/A-Z/a-z/;

    $finger_bin = $ucb_finger_bin;
    if (! (-r $ucb_finger_bin)) {
	$finger_bin = $linux_finger_bin;
    }

    print "\nFingering $adr\n";
    print "------------------------------------------------------------\n";
    if ($adr !~ /\@(mit\.)?mit\.edu/) {
	print `$finger_bin $adr`;
    } else {
	$fing_info = `$finger_bin $adr`;
	# This filters out all but the line that says "name:"
	if ($fing_info =~ /([^\n]*name:\s*(\S.*)\n)/ ) {
	    $fing_info = $1;
	    print "This is their name according to \"finger $adr \":\n";
	    $fing_info =~ /name:\s+(\S.*)\s*$/;
	    $name = $1;
	    if ($name =~ /^(\w*),\s*(\w*)(\s+\w*)*$/) {
		$name_candidate = $2 . " " . $1;
		print $fing_info;
		print "-----------------------------------------------------";
		print "-------\n";
		print "\nIs their name \"$name_candidate\"?\n>>";
		if ( &accept()) {
		    return ($name_candidate);
		}
	    }
	} else {
	    print $fing_info;
	}
    }
    $ok = 0;
    while (!$ok) {
	print "------------------------------------------------------------\n";
	print "What is this person's name?\n";
	print "(If you cannot tell, type a '.' and hit the Enter key.)\n>>";
	$input = (<STDIN>);
	chop ($input);
	if ($input) {$ok = 1}
    }

    if ($input eq ".") {
	$input = "";
    }
    return ($input);
}

sub add_to_homepage_file {
    local($filename, $url, $username, $name, $temp_file, $old, $new) = @_;

    # The quotes are necessary around $name so it doesn't turn into two
    # arguments... :-)

    print "(rshing to www.mit.edu now)\n";

    # This tests for success of the rsh command.
    if (system(@rsh_cmd, $server_script,
	       $filename, $url, $username , "\'" . $name . "\'",
	       $temp_file, $old, $new) == 0) {
	&send_user_mail($username);
    } else {
	print "------------------------------------------\n";
	print "Rsh command failed. Reason unknown.\n";
	print "Homepage was not added; mail was not sent.\n";
    }
}

sub send_user_mail {
    local($username) = @_;

    $whole_mail_cmd = "|" . $mail_cmd . " " . $username .
	" webm.discuss@charon.mit.edu";

    open(MAIL, $whole_mail_cmd);
    print MAIL "To: $username\n";
    print MAIL "bcc: webm.discuss@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-to: webmaster@mit.edu\n";
    print MAIL "Subject: Your homepage\n\n";
    print MAIL "Your homepage has been added to the list of homepages on\n";
    print MAIL "MIT SIPB WWW server.\n\n";
    print MAIL "If there are any problems with your homepage, feel free to\n";
    print MAIL "send mail about it to webmaster@mit.edu .\n\n";
    print MAIL "  -- The MIT SIPB Webmasters\n";

    close MAIL;

    print "Mail was sent to $username\n";
    print "confirming that their homepage was added.\n";
    
    # system @mail_cmd, $username, $temp_file;
}

sub tell_user_unreadable {
    local($username, $file) = @_;

    $whole_mail_cmd = "|" . $mail_cmd . " " . $username .
	" webm.discuss@charon.mit.edu";

    $file =~ /^(\/afs\/[^\/]*\/user\/.\/.\/[^\/]*\/.*)\/[^\/]*$/;
    $absolute_dir = $1;

    if (! open(FTEST, $absolute_dir)) {
	&tell_user_fascist($whole_mail_command, $username, $absolute_dir, $file);
	exit;
    }

    $file =~ /^\/afs\/[^\/]*\/user\/.\/.\/[^\/]*(\/.*)\/[^\/]*$/;
    $directory = "~" . $1;
    $command = "fs sa $directory system:anyuser read";

    print "----------------------------------------------------------------\n";
    print "Here are the AFS permissions for the directory they specified:\n\n";
    print "> fs la $absolute_dir\n";
    print `$fs_bin la $absolute_dir`;
    print "\nI think the command they need to run is:\n";
    print "  \"$command\"\n";
    print "Is this right? I'll send them mail if you respond in the ";
    print "affirmative.\n>>";
    if (! &accept()) {
	print "Mail was not sent. You should send them mail yourself.\n";
	return;
    }
    open(MAIL, $whole_mail_cmd);
    print MAIL "To: $username\n";
    print MAIL "bcc: webm.discuss@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-to: webmaster@mit.edu\n";
    print MAIL "Subject: Your homepage\n\n";
    print MAIL "You asked us to add this file as your homepage:\n";
    print MAIL "   $file\n\n";
    print MAIL "We were unable to add your homepage as requested, because\n";
    print MAIL "we are unable to read the file you specified.\n\n";
    print MAIL "It appears that your AFS permissions on this directory are\n";
    print MAIL "not correctly set such that we could read it, which means\n";
    print MAIL "that it cannot be read by our web server.\n\n";
    print MAIL "It is likely that this command will fix this problem:\n\n";
    print MAIL "$command\n\n";
    print MAIL "If you have difficulties with this, feel free to\n";
    print MAIL "send mail about it to webmaster@mit.edu .\n\n";
    print MAIL "  -- The MIT SIPB Webmasters\n";

    close MAIL;

    print "Mail was sent to $username\n";
    print "telling them how to fix their AFS permissions.\n";
    
    # system @mail_cmd, $username, $temp_file;
}    

sub tell_user_fascist {
    local($mail_command, $username, $abs_dir, $file) = @_;

    $file =~ /^(\/afs\/[^\/]*\/user\/.\/.\/[^\/]*)\/.*\/[^\/]*$/;
    $homedir = $1;
    
    $command = "fs sa ~ system:anyuser l";

    print "----------------------------------------------------------------\n";
    print "Here are the AFS permissions for the directory they specified:\n\n";
    print "> fs la $abs_dir\n";
    print `$fs_bin la $absolute_dir`;
    print "Here are the AFS permissions for their homedir:\n\n";
    print "> fs la $homedir\n";
    print `$fs_bin la $homedir`;
    print "\nI think the command they need to run is:\n";
    print "  \"$command\"\n";
    print "Is this right? I'll send them mail if you respond in the ";
    print "affirmative.\n>>";
    if (! &accept()) {
	print "Mail was not sent. You should send them mail yourself.\n";
	return;
    }
    open(MAIL, $whole_mail_cmd);
    print MAIL "To: $username\n";
    print MAIL "bcc: webm.discuss@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-to: webmaster@mit.edu\n";
    print MAIL "Subject: Your homepage\n\n";
    print MAIL "You asked us to add this file as your homepage:\n";
    print MAIL "   $file\n\n";
    print MAIL "We were unable to add your homepage as requested, because\n";
    print MAIL "we are unable to read the directory you specified.\n\n";
    print MAIL "It appears that your AFS permissions on some parent\n";
    print MAIL "directory of this directory are not correctly set such\n";
    print MAIL "that we could read the directory in which your homepage is\n";
    print MAIL "located, which means our web server cannot read your\n";
    print MAIL "homepage.\n\n";
    print MAIL "It is likely that this command will fix this problem:\n\n";
    print MAIL "$command\n\n";
    print MAIL "If you have difficulties with this, feel free to\n";
    print MAIL "send mail about it to webmaster@mit.edu .\n\n";
    print MAIL "  -- The MIT SIPB Webmasters\n";

    close MAIL;

    print "Mail was sent to $username\n";
    print "telling them how to fix their AFS permissions.\n";
    
    # system @mail_cmd, $username, $temp_file;
}    


sub partial_absolute_homedir {
    local($username) = @_;

    $username =~ /^(.)(.)(.*)$/;
    return("/afs/athena.mit.edu/user/${1}/${2}/");
}

sub explain_usage {
    print STDERR <<EOU;
Usage: $0

Tweedleday.
This should tell people something useful.
I'll write it later.

EOU
    exit;
}

sub happy_username {
    local($username) = @_;

    # Downcase
    $username =~ tr/A-Z/a-z/;

    # strip off @mit.edu and @athena.mit.edu
    if ($username =~ /^(.*)\@mit\.edu$/) {
	$username = $1;
    }
    if ($username =~ /^(.*)\@athena\.mit\.edu$/) {
	$username = $1;
    }
    $username;
}

sub happy_url {
    local($url) = @_;

    if ($url =~ /^file:\/\/localhost/) {
	$url = $';
    }

    if ($url =~ /^file:\/\/?/) {
	$url = $';
    }

    if ($url =~ /web\.mit\.edu(\/afs)/) {
	$url = $1 . $';
    }

    if (($url =~ /www\.mit\.edu/) && ($url !~ /^[Hh][Tt][Tt][Pp]/)) {
	$url =~ s/.*www\.mit\.edu/http:\/\/www\.mit\.edu/; 
    }
    $url;
}

sub happier_url {
    local($url, $username) = @_;
    # catch stupidity like afs/athena...
    if ($url =~ /^afs\/athena/) {
	$url = "/" . $url;
    }

    # catch stupidity like afs/user...
    if ($url =~ /^\/afs\/user/) {
	print "FOOOOOOO.\n";
	$url = "/afs/athena.mit.edu/user" . $';
    }


    # catch stupidity like (/)athena.mit.edu/user...
    if ($url =~ /^\/?(athena\.mit\.edu\/user.*)$/) {
	$url = "/afs/" . $1;
    }

    $url =~ s%^/afs/athena/%/afs/athena\.mit\.edu/%;

    # If they just gave us a filename, assume that it's
    # in /mit/username/www ...
    if ($url =~ /^[\w\.]*$/) {
	$url = "/mit/" . $username . "/www/" . $url;
    }

    # catch stupidity like (((/)user)/)u/s/username/directory
    if ($url =~ /^((\/?user)?\/)?.\/.\/($username\/.*)/) {
	$url = &partial_absolute_homedir($username) . $3;
    }

    # catch stupidity like (/)username/directory
    if ($url =~ /^\~?\/?($username\/.*)/) {
	$url = &partial_absolute_homedir($username) . $1;
    }

    # This parses ~username/foo to /mit/username/foo ...
    if ($url =~ /^\~($username\/.*)$/) { $url = "/mit/" . $1; }

    # This deals with ~/foo
    if ($url =~ /^\~\/?([^\/].*)/) {
	$url = $1;
	if ($username !~ /\@/) {
	    $url = "/mit/" . $username . "/" . $url;
	} else {
	    print "The username is \"$username\", and the URL is \"$url\" .\n";
	    print "I can't figure it out. Add it yourself. :-)\n";
	    exit;
	}
    }

    # This changes "/mit/foo" to "/afs/athena/user/f/o/foo"
    if ($url =~ /^\/mit\/(.*)\//) {
	$url = &partial_absolute_homedir($1) . $1 . "/" . $';
    }

    $url =~ s%//%/%g;

    # catch stupidity like /afs/athena/f/o/foo
    if ($url =~ /^\/afs\/athena\.mit\.edu\/(.\/.\/$username.*)$/) {
	$url = "/afs/athena.mit.edu/user/" . $1;
    }

    # catch stupidity like /afs/athena/user/fo/foobar
    if ($url =~ /^\/afs\/athena\.mit\.edu\/user\/(.)(.\/$username.*)$/) {
	$url = "/afs/athena.mit.edu/user/" . $1 . "/" . $2;
    }

    # catch stupidity like /afs/athena/user/foo
    if ($url =~ /^\/afs\/athena\.mit\.edu\/user\/($username.*)$/) {
	$url = $1;
	$url =~ s/^(.)(.)(.*)$/\1\/\2\/\1\2\3/;
	$url = "/afs/athena.mit.edu/user/" . $url;
    }

    # catch stupidity where they gave us (/)www/foo ... where nothing previous
    # caught the stupidity...
    if (($url !~ /^\/afs\/athena/) && ($url !~ /^\/afs\/sipb/)){
	if ($url !~ /^\//) {
	    $url = "/" . $url;
	}
	$url = &partial_absolute_homedir($username) . $username . $url;
    }
    $url;
}