#!/usr/athena/bin/perl

require '/afs/sipb.mit.edu/project/www/bin/homelib.pl';

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

# Never use add-home or edithome on a Sparc5 because of AFS cache corruption:
#if (`machtype -c` =~/SPARC\/5/)
#{
#    print "DO NOT USE THIS PROGRAM ON A SPARC5!\n";
#    print "(AFS Cache Corruption) Thank you :-)\n";
#    exit 0;
#}

# web_people_dir should end with a slash.
$web_people_dir = "/afs/sipb/project/www/root/people/";
# web_afs_root should *not* end with a slash.
$web_afs_root   = "/afs/sipb/project/www/root";
if ($web_afs_root =~ /\/$/) { chop($web_afs_root)};
$alpha_dir      = "/afs/sipb/project/www/root/alpha/";
$homepage_file  = "/afs/sipb/project/www/root/home-pages.html";

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

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

$ls_bin      = '/bin/ls';
$ln_bin      = '/bin/ln';
$fs_bin      = '/bin/athena/fs';
$webfile_bin = '/afs/sipb/project/www/bin/webfile';

@finger_to_try = ('/usr/ucb/finger',
		  '/usr/bin/finger',
 		  '/usr/bsd/finger',
		  'finger');

$finger_bin = &pick_a_binary(@finger_to_try);

# while ($#finger_to_try > -1) {
#     $finger_bin = splice(@finger_to_try, 0, 1);
#     if ( -r $finger_bin ) {
# 	@finger_to_try = ();
#     }
# }

if (! ( -d '/mit/gnu' )) {
    print "GNU locker was not attached. Attaching it.\n";
    system('/bin/athena/attach -h -n -q gnu');
}

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

# 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);

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

    $username = &happy_username($username);
    $url      = &happy_url($url);
    $index    = &pick_an_index($name, "nope");

    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
	    &process_remote($url, $username, $name, $index);
	    return;
	}
    }
    # If we got here, it means that they gave us a filename.
    
    $url = &happy_file($url, $username);

    &process_local($url, $username, $name, $index);

}

sub process_local {
    local($file, $username, $name, $index) = @_;
    local($old, $new);

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

    if ((! -d $file) && (! &afs_file_listable($absolute_dir,$file))) {
	
	print "ERROR: The file $file is unlistable.\n";

        if (&afs_dir_readable($absolute_dir)) {
	    print "Here's an ls of $absolute_dir :\n";
	    print "-------------------------------------------------\n";
	    system $ls_bin, '-la', $absolute_dir;
	    print "-------------------------------------------------\n";
	} else {
	    print "Furthermore, $absolute_dir isn't readable.\n";
	}

	print "Can you specify a better filename?\n";
	print "*** ANSWER YES OR NO *** (not with the filename)\n";
	    
	if (&accept()) {
	    $fname = "ZZZZZ";
	    print "What is the absolute name of the file?\n";
	    until (open(FTEST, $fname)) {
		print ">>";
		$fname = (<STDIN>);
		chop($fname);
	    }
	    close FTEST;
	    $file = $fname;
	    $file =~ /^(\/afs\/[^\/]*\/user\/.\/.\/[^\/]*.*)\/[^\/]*$/;
	    $absolute_dir = $1;
	} # they can not do any better, so bail. The afs_readable will fail.

	# The flow control in this subroutine could certainly be
        # improved, but it's adequate now and I don't feel like thinking
        # about it hard enough to rearrange everything to be more
	# sensible.

    }


    # Use open() instead of -r because -r tests UFS bits, which
    # don't matter since we're in AFS....
    if (&afs_readable($file)) {
	
	if (-d $file) {
	    # It is a directory. Pick something.
	    $file = &pick_a_file($file);
	}
	($file, $old, $new) = &pick_symlink_for_file($file, "nope");
	
	&check_then_add($file, $username, $name, $index, $old, $new);

    } else {
	if((&afs_dir_readable($absolute_dir)) && 
	   (! &afs_file_listable($absolute_dir,$file))) {
	    print("Their home page is not actually there.\n");
	    &tell_user_not_there($username, $file);
	    exit;
	} else {
	    print "Cannot access file \"$file\".\nDid not add homepage.\n";
	    &tell_user_unreadable($username, $file);
	    exit;
	}
    } # end of &afs_readable()
}

sub pick_a_file {
    local($file) = @_;

    # This subroutine assumes that $file is a directory.

    if (&afs_readable(($file . "/home.html"))) {
	# This is a good guess, if it exists.
	$file =~ s/\/$//;
	$file = $file . "/home.html";
	print ("Yo: " . $file . "\n");
    } elsif (&afs_readable(($file . "/www/home.html"))) {
	# This is a good guess, if it exists.
	$file =~ s/\/$//;
	$file = $file . "/www/home.html";
    } elsif (&afs_readable(($file . "/index.html"))) {
	# this is okay to have as a URL. Do nothing.
    } else {
	print "-------------------------------------------------\n";
	print "The specified file \"$file\"\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', $file;
	    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, ($file . "/" . $fname))) {
		    print ">>";
		    $fname = (<STDIN>);
		    chop($fname);
		}
		close FTEST;
		$file = $file . "/" . $fname;
	    } # end if &accept() of okay files
	} # end if &accept() of picking file
    }
    return($file);
}

sub process_remote {
    local($url, $username, $name, $index) = @_;

    # 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 it's a http request, this trims off a port-specification of 80
    if ($url =~ /^(http:\/\/[^\/:]*):80(\/.*)$/) {
	$url = ($1 . $2);
    }

    &check_then_add($url, $username, $name, $index, "", "");
}

sub afs_readable {
    local($file) = @_;
    if (open(TEST, $file)) {
	close TEST;
	return 1;
    } else {
	return 0;
    }
}

sub afs_file_listable {
    local($dir,$file) =@_;
    if (opendir(DIR,$dir)) {
	@file_list=readdir(DIR);
	closedir DIR;
	$file =~ s/.*\/(.*)$/$1/;  # Get the file name in the context of
	                           # its parent directory
	if (grep (/^$file$/,@file_list)) {
	    return 1;  # the file is at least listable
	}
    }
    return 0;
}

sub afs_dir_readable {
    local($dir) = @_;
    if (opendir(DIR, $dir)) {
	closedir DIR;
	return 1;
    } else {
	return 0;
    }
}

sub check_then_add {
    local($url, $username, $name, $index, $old, $new) = @_;
    # if $symlink is not specified, it is set to ""

    local($done, $input, $data, $shortsym, $regtmp);

    $regtmp = &escape_regexp($web_afs_root);
    if ($new =~ /^$regtmp(\/people\/.*)$/) {
	$shortsym = $1;
    } else {
	$shortsym = "";
    }

    $done = 0;
    while(! $done) {
	$data = "";
	print "----------------------------------------------\n";
	print "(1)     Username : $username\n";
	print "(2)          URL : $url\n";
	print "(3)         Name : $name\n";
	print "(4)   Sort Index : $index\n";
	if ($old ne "") {
	    print "(5)   Symlink to : $old\n";
	    print "(6) Symlink name : $shortsym\n";
	}
	print "\n(y) I'm done. Add this person to the database.\n";
	print "(n) Nevermind. Abort.\n\n";
	print "Please enter 1-" . (($old eq "")?4:6) . ", y, or n.\n>>";

	$input = "";
	$input = (<STDIN>);
	chop($input);
	$input = substr($input, 0, 1);

	if ($input eq "y") {
	    $done = 1;
	} elsif ($input eq "n") {
	    exit;
	} elsif (($input > 0) && ($input < 7)) {
	    print "What would you like to change it to?\n>>";
	    $data = "";
	    $data = (<STDIN>);
	    chop($data);
	}
	if ($data ne "") {
	    if ($input == 1) {
		$username = $data;
		print "Alter symlink name to reflect this change?\n>>";
		if (&accept()) {
		    $new = $web_people_dir . $username;
		}
	    } elsif ($input == 2) {
		$url = $data;
		if ($url =~ /^\/afs/) {
		    $url =~ s/^(\/afs\/athena)\//$1\.mit\.edu\//;
		    $url =~ s/^(\/afs\/sipb)\//$1\.mit\.edu\//;
		}
		print "Alter object of symlink to reflect this change?\n>>";
		if (&accept()) {
		    $old = (&pick_symlink_for_file($url, "nope"))[1];
		}
	    } elsif ($input == 3) {
		$name = $data;
		print "Alter sort index to reflect this change?\n>>";
		if (&accept()) {
		    $index = &pick_an_index($name, "nope");
		}
	    } elsif ($input == 4) {
		$index = $data;
	    } elsif ($input == 5) {
		$old = $data;
	    } elsif ($input == 6) {
		if ($data !~ /^\//) {
		    $data = "/" . $data;
		}
		$shortsym = $data;
		$new = ("/afs/sipb/project/www/root" . $shortsym);
	    }
	} # end of if ($data ne "")
    } # end of while (! $done)
    
    # At this point, we're happy with the data. Put it in the database.
    &add_to_database($url, $username, $name, $index, $old, $new);


}

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;

    $mail =~ /\n?\s*[sS]ubject:\s([^\n]*)\n/;
    $subject_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+)\s*\((.*)\).*/) {
	$address = $1;
	$realname[$#realname + 1] = $2;
    }
    
    # This line handles the format '"Joe Smith" email@foo.bar.com'
    if ($address =~ /.*\"(.*)\"\s*(\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+)\s*>.*/) {
	$realname[$#realname + 1] = $1;
	$address = $2;
    }

    # To avoid unnecessary confusion, delete boring lines from the mail.
    $mail =~ s/Received: from[^\n]*\n//g;
    $mail =~ s/Date: [^\n]*\n//g;
    $mail =~ s/X-Webclient: [^\n]*\n//g;
    $mail =~ s/X-Mailer: [^\n]*\n//g;


    # People can neither type nor spell.
    $mail =~ s/\.hmtl/\.html/g;
    $mail =~ s/(athena(\.mit\.edu)?\/user)s/$1/g;

    # This keeps us from getting confused about references to our web page
    $mail =~ s/http:\/\/(www)|(stuff)\.mit\.edu(:8001)?\/home-pages\.html//g;
    $mail =~ s/http:\/\/(www)|(stuff)\.mit\.edu(:8001)?\/webmasters\.html//g;
    $mail =~ s/http:\/\/(www)|(stuff)\.mit\.edu(:8001)?\/(doc\/)?how-to-hp\.html//g;
    $mail =~ s/http:\/\/(www)|(stuff)\.mit\.edu(:8001)?\/comment(\.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 = "";

    # filenames, mostly
    if ($subject_line =~ /\s*([a-zA-Z~\/]$u*\.html)\s*/) {
	$url = $1;
    } elsif ($subject_line =~ /\s*(http:\/$u*\/$u*)\s*/) {
	# This gets http: stuff
	$url = $1;
    } elsif ($subject_line =~ /\s*([a-zA-Z\.~\/]$u*\/$u*\/$u*)\s*/) {
	# This gets non-html filenames.
	$url = $1;
    } elsif ($subject_line =~ /\s*([a-zA-Z~\/]$u*\/$u*)\s*/) {
	$url = $1;
    } elsif ($subject_line =~ /\s*([a-zA-Z~\/][Ww][Ww][Ww]$u*)\s*/) {
	print "Warning. This is quite possibly a totally useless URL.\n";
	$url = $1;
    } elsif ($subject_line =~ /\s*([a-zA-Z~\/]$u*)\s*/) {
	print "Warning. This is quite possibly a totally useless URL.\n";
	$url = $1;
    }
    $url =~ s/^http:\/\/(www|stuff)\.mit\.edu(:8001)?\/\~(.*)\/?/\~$3\/www\//;
    print STDERR "Got URL as $url\n";

    # 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]* (Mc)?(De)?[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 $mail . "----------------------------------------------------\n";
    $picked_name = &pick_a_name($address, $url, $mail, @realname);

    print "----------------------------------------------------\n";
    # $picked_index = &pick_an_index($picked_name);

    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)  Enter name manually\n";
	print " (2)  run command \'finger $address\'...\n";
	if ($athena) {
	    print " (3)  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 + 3 + $athena) . ")  \"" . $realname[$i] . "\"\n";
	}
	
	$input = "";
	print("select one >>");
	$input = (<STDIN>);
	chop($input);
    
	# depending on $athena, we want it to be more than either "1" or "2".
	if (($input > ($athena?3:2)) &&
	    ($input < ($#realname + 4 + $athena))) {
	    $ok = 1;
	} elsif ($input eq "0") {
	    print $mail;
	} elsif ($input eq "1") {
	    print "Enter name:\n>>";
	    $foo = <STDIN>;
	    chop($foo);
	    # assume that if they picked this one, they meant it.
	    return($foo);
	} elsif ($input eq "2") {
	    $foo = &finger_thang($address);
	    if ($foo) {
		$realname[($#realname + 1)] = $foo;
	    }
	} elsif ($athena && ($input eq "3")) {
	    $foo = &finger_thang(($username . "\@athena.mit.edu"));
	    if ($foo) {
		$realname[($#realname + 1)] = $foo;
	    }
	}
    }
    return($realname[($input - 3 - $athena)]);
}

sub finger_thang {
    local($adr, $ok, $input) = @_;
    local(@namelist);
    
    # 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/;

    print "\nFingering $adr\n";
    print "------------------------------------------------------------\n";
    if ($adr !~ /\@(mit\.)?mit\.edu/) {
	print `$finger_bin $adr`;
    } else {
	$fing_info = `$finger_bin $adr`;

	@namelist = &grab_names($fing_info);
	
	if (($fing_info =~ /No matches to your query/)
	    && ($#namelist < 0)) {
	    print "! MITdir had no information on this person.\n";
	    print "--------------------------------------------------------\n";
	    return "";
	}

	# This filters out all but the line that says "name:"
	if ($#namelist == 0) {
	    $name = $namelist[0];
	    print "This is their name according to \"finger $adr \":\n";
	    print "      name: " . $name . "\n";

	    if ($name =~ /^(\w.*\w)\W*,\s*(\w*)(\s+\w*)*$/) {
		$name_candidate = &deflate_ego($2, $1);
		print "-----------------------------------------------------";
		print "-------\n";
		print "\nIs their name \"$name_candidate\"?\n>>";
		if ( &accept()) {
		    return ($name_candidate);
		}
	    }
	} else {
	    print "Fingering $adr returned these names:\n    ";
	    print (join("\n    ", @namelist) . "\n");
	}
    }
    $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 tell_user_unreadable {
    local($username, $file) = @_;

    my $user_email = make_user_email($username);
    
    $whole_mail_cmd = "|" . $mail_cmd . " -t";

    $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: $user_email\n";
    print MAIL "Bcc: webm-mtg\@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-To: stuffmaster\@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 "read http://stuff.mit.edu/doc/how-to-hp.html or send\n";
    print MAIL "informative mail to stuffmaster\@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";
}    

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

    my $user_email = make_user_email($username);    
    $whole_mail_cmd = "|" . $mail_cmd . " -t";

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

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

    print "----------------------------------------------------------------\n";
    print "Here is a listing for the directory they specified:\n\n";
    print "> ls -la $absolute_dir\n";
    print `$ls_bin -la $absolute_dir`;
    print "\nI think the file doesn't exist.\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: $user_email\n";
    print MAIL "Bcc: webm-mtg\@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-To: stuffmaster\@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 "the file you specified does not exist.\n\n";
    print MAIL "Please resubmit your request to be added once the page\n";
    print MAIL "exists.  For more information on creating your own home\n";
    print MAIL "page, please see http://stuff.mit.edu/doc/how-to-hp.html\n";
    print MAIL "\n";
    print MAIL "If you have difficulties with this, feel free to\n";
    print MAIL "send mail about it to stuffmaster\@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 create a homepage.\n";
}    


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;
    }
    my $user_email = make_user_email($username);    
    open(MAIL, $whole_mail_cmd);
    print MAIL "To: $user_email\n";
    print MAIL "Bcc: webm-mtg\@charon.mit.edu\n";
    print MAIL "From: $ENV{'USER'}\n";
    print MAIL "Reply-To: stuffmaster\@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 stuffmaster\@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";
}    

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;
    }

    # Maybe they misconfigured their WS mail so that
    # mail comes from user@machinename.mit.edu rather than
    # user@mit.edu.
    if ($username=~ /^(.*)\@(.*)\.mit\.edu$/) {
	print "I think the username \"$username\" is really $1\@mit.edu.\n";
	print "Should I try this (cutting out \"$2\")? (Y/N) >>";
	if (&accept()) {
	    print "\nUsing username $1.\n";
	    $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 =~ /web\.mit\.edu\/([^\/]+)(\/.*)$/) {
	$url = &primary_filsys($1) . $2;
    }

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

sub happy_file {
    local($url, $username) = @_;
    
    # This maps "/people/$username/foo" to ~$username/www/foo" ...
    # This seems like the most reasonable assumption.
    if ($url =~ /^\/?people\/$username\/(.*)$/) {
	# We'll guess on this one. Hope they're not total morons.
	$url = &primary_filsys($username) . "/www/" . $1;
    }

    # catch stupidity like afs/athena...
    if ($url =~ /^afs\/athena/) {
	$url = "/" . $url;
    }

    # catch stupidity like afs/user...
    if ($url =~ /^\/afs\/user(\/athena\.mit\.edu)?/) {
	$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 = &primary_filsys($username) . $3;
    }

    # catch stupidity like (/)username/directory
    if ($url =~ /^\~?\/?$username(\/.*)$/) {
	$url = &primary_filsys($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 = &primary_filsys($1) . $2;
    }

    $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 like /afs/athena/user/f/foo
    if ($url =~ /^\/afs\/athena\.mit\.edu\/user\/.\/$username(.*)$/) {
	$url = $1;
	if ($url !~ /^\//) {
	    $url = "/" . $url;
	}
	$url = &primary_filsys($username) . $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 = &primary_filsys($username) . $url;
    }

    # Catch some really old filsys entries that are /afs/sipb/user
    if  ($url =~ /\/afs\/sipb\//)  {
	$url = '/afs/sipb.mit.edu/' . $';
    }

    $url;
}

sub copy_to_web_server {
    system($webfile_bin, @_);
}

sub grab_names {
    local($text) = @_;
    local($subtext, $name);
    
    if ($text =~ s/([^\n]*name:\s*(\S.*)\n)// ) {
	$name = $2;
	return ($name, &grab_names($text));
    } else {
	return ();
    }
}
	
sub deflate_ego {
    local($first, $last) = @_;
    
    if ($last =~ /\s/) {
	$last =~ s/\s+[XVI]*$//;
	$last =~ s/\s+[Jj]r\.?$//;
    }
    return ($first . " " . $last);
}

sub escape_regexp {
    local($s) = @_;
    $s =~ s/(\W)/\\$1/g;
    return $s;
}

1;