#!/usr/bin/perl

# Evolution wrapper script for Athena

# Performs the following Evolution customizations:
#   * Ensures $HOME/.evolution is private when created.
#   * Performs Hesiod lookup of user inbox.
#   * Pre-configures Evolution for MIT mail on first invocation.

use strict;
use Gnome2::GConf;
use File::Basename;
use File::Path;

sub edit_state_file();
sub create_initial_state_file();

# Ensure $HOME/.evolution is private when created.
my $homedir = $ENV{"HOME"};
if ($homedir && ! -e "$homedir/.evolution") {
    if (mkdir("$homedir/.evolution")) {
	system("fs sa $homedir/.evolution system:anyuser none 2>/dev/null");
    }
}

# Pick server to use
my $user = $ENV{"ATHENA_USER"} || $ENV{"USER"} || getpwuid($<);
my $server = "$user.mail.mit.edu";

# Determine the authentication method to use for the IMAP server.
# For a Cyrus PO server account we use GSSAPI.
# For an Exchange account (or anything else), use password for now.
# (Ideally some day we will use GSSAPI everywhere).
my $auth = "";
my ($real_server) = gethostbyname($server);
if ($real_server =~ /po\d+\.mail\.mit\.edu/i) {
    $auth = ";auth=GSSAPI";
}

# Regular expression for the server names we recognize when updating
# the IMAP account setting.  We also convert Athena 9.4-style Hesiod
# specifications (although it should be unusual to see one due to
# debathena-gconf2-config).
my $serverRE = "($user" . '\.mail\.mit\.edu)|(po\d+\.mit\.edu)|((imap\.)?exchange\.mit\.edu)|(_hesiod)';
my $old_server = "";

my $client = Gnome2::GConf::Client->get_default;
my $accounts = $client->get_list("/apps/evolution/mail/accounts");

if ($accounts && @$accounts) {
    # Update the server with the value from Hesiod.
    my $change = 0;
    foreach (@$accounts) {
	my $old = $_;
	if (/name="MIT mail"/) {
	    # Remember the old server name.
	    if (m%imap://$user(?:;[^\@]*)?\@([^/]+)/%i) {
		$old_server = $1;
	    }

	    # Update the server name (and corresponding auth method).
	    s%(imap://$user)(\;[^\@]*)?\@($serverRE)%$1$auth\@$server%i;

	    # Make sure we always use SSL.
	    unless (m%imap://[^/]*/[^<]*;use_ssl=always[^<]*%i) {
		# First clear any other SSL setting.
		s%(imap://[^/]*/[^<]*);use_ssl=[^;<]*([^<]*)%$1$2%i;
		s%(imap://[^/]*/)([^<]*)%$1;use_ssl=always$2%i;
	    }
	}
	$change = 1 if ($_ ne $old);
    }

    if ($change) {
	# We need to update the account settings.
	$client->set_list("/apps/evolution/mail/accounts", "string",
			  $accounts);
	if ($old_server ne $server) {
	    # Edit the folder state file -- the URI of the saved
	    # selected folder may point at the old server.
	    edit_state_file();
	}
    }
} else {
    # Pre-configuration.
    $client->set_string("/apps/evolution/calendar/display/timezone",
			"America/New_York");

    ($_, $_, $_, $_, $_, $_, my $gecos) = getpwuid($<);
    my @fields = split(",", $gecos);
    my $name = $fields[0];
    my $home = $ENV{"HOME"};
    my $local = "mbox:$home/.evolution/mail/local";
    my $a = '<?xml version="1.0"?>' . "\n";
    $a .= '<account name="MIT mail" uid="mitinitial" enabled="true">';
    $a .= '<identity>';
    $a .= "<name>$name</name>";
    $a .= "<addr-spec>$user\@mit.edu</addr-spec>";
    $a .= '</identity>';
    $a .= '<source save-passwd="false">';
    $a .= "<url>imap://$user$auth\@$server/;use_ssl=always</url>";
    $a .= '</source>';
    $a .= '<transport save-passwd="false">';
    $a .= "<url>smtp://$user;auth=GSSAPI\@outgoing.mit.edu/;use_ssl=always";
    $a .= '</url>';
    $a .= '</transport>';
    $a .= "<drafts-folder>$local#Drafts</drafts-folder>";
    $a .= "<sent-folder>$local#Sent</sent-folder>";
    $a .= '</account>' . "\n";
    $accounts = [ $a ];
    $client->set_list("/apps/evolution/mail/accounts", "string", $accounts);
    $client->set_string("/apps/evolution/mail/default_account", "mitinitial");
    create_initial_state_file();
}

exec("/usr/bin/evolution.debathena-orig", @ARGV);

# Edit the existing folder tree state file, to update any URI referring to
# the old server.
sub edit_state_file() {
    return unless $old_server;
    my $file = "$homedir/.evolution/mail/config/folder-tree-expand-state.xml";
    open(OLD, "<$file") or return;
    my $newfile = $file . ".debathena-new";
    unless (open(NEW, ">$newfile")) {
	warn "Cannot open $newfile: $!\n";
	close OLD;
	return;
    }
    my $changed = 0;
    # Loop to copy and edit the file, replacing the old IMAP server
    # name with the new.
    while (<OLD>) {
	my $old = $_;
	s%(imap://$user)(;[^\@]*)?\@($old_server)%$1\@$server%i;
	print NEW;
	$changed = 1 if ($_ ne $old);
    }
    close NEW;
    close OLD;
    # If we have changed the file, move the new one into place.
    # Otherwise, just delete the copy.
    if ($changed) {
	unless (rename($newfile, $file)) {
	    warn "Cannot rename $newfile to $file: $!\n";
	    # Nuke the old file to be safe.
	    unlink $file;
	}
    } else {
	unlink $newfile;
    }
}

# Create the initial folder tree state file, to expand and select the
# MIT INBOX.
sub create_initial_state_file() {
    my $file = "$homedir/.evolution/mail/config/folder-tree-expand-state.xml";

    mkpath(dirname($file), 0, 0700);
    unless (open(OUT, ">$file")) {
	warn "Cannot open $file: $!\n";
	return;
    }
    print OUT "<?xml version=\"1.0\"?>\n";
    print OUT "<tree-state>\n";
    print OUT "  <node name=\"local\" expand=\"true\"/>\n";
    print OUT "  <node name=\"vfolder\" expand=\"false\"/>\n";
    print OUT "  <node name=\"mitinitial\" expand=\"true\">\n";
    print OUT "    <node name=\"INBOX\" expand=\"true\"/>\n";
    print OUT "  </node>\n";
    print OUT "  <selected uri=\"imap://$user\@$server/INBOX\"/>\n";
    print OUT "</tree-state>\n";
    close OUT;
}