source: trunk/debathena/debathena/evolution-wrapper/evolution.debathena @ 23985

Revision 23985, 5.9 KB checked in by rbasch, 15 years ago (diff)
In debathena-evolution-wrapper: * Always create a new folder state file after initializing the account in gconf.
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl
2
3# Evolution wrapper script for Athena
4
5# Performs the following Evolution customizations:
6#   * Ensures $HOME/.evolution is private when created.
7#   * Performs Hesiod lookup of user inbox.
8#   * Pre-configures Evolution for MIT mail on first invocation.
9
10use strict;
11use Gnome2::GConf;
12use File::Basename;
13use File::Path;
14
15sub edit_state_file();
16sub create_initial_state_file();
17
18# Ensure $HOME/.evolution is private when created.
19my $homedir = $ENV{"HOME"};
20if ($homedir && ! -e "$homedir/.evolution") {
21    if (mkdir("$homedir/.evolution")) {
22        system("fs sa $homedir/.evolution system:anyuser none 2>/dev/null");
23    }
24}
25
26# Look up user inbox in Hesiod.
27my $user = $ENV{"ATHENA_USER"} || $ENV{"USER"} || getpwuid($<);
28my $result = `hesinfo $user pobox`;
29my @fields = split(' ', $result);
30my $server = $fields[1];
31
32unless ($server) {
33    warn "Could not obtain Hesiod POBOX information for $user\n";
34    exec("/usr/bin/evolution.debathena-orig", @ARGV);
35}
36
37# Determine the authentication method to use for the IMAP server.
38# For a Cyrus PO server account we use krb4, if the installed package
39# supports it.
40# For an Exchange account (or anything else), use password for now.
41# (Ideally some day we will use GSSAPI everywhere).
42my $auth = "";
43if ($server =~ /po\d+\.mit\.edu/i) {
44    my $provides = `dpkg-query -Wf '\${Provides}' 'libcamel*'`;
45    if ($provides =~ /debathena-libcamel-krb4/) {
46        $auth = ";auth=KERBEROS_V4";
47    }
48}
49
50# Regular expression for the server names we recognize when updating
51# the IMAP account setting.  We also convert Athena 9.4-style Hesiod
52# specifications (although it should be unusual to see one due to
53# debathena-gconf2-config).
54my $serverRE = '(po\d+\.mit\.edu)|((imap\.)?exchange\.mit\.edu)|(_hesiod)';
55my $old_server = "";
56
57my $client = Gnome2::GConf::Client->get_default;
58my $accounts = $client->get_list("/apps/evolution/mail/accounts");
59
60if ($accounts && @$accounts) {
61    # Update the server with the value from Hesiod.
62    my $change = 0;
63    foreach (@$accounts) {
64        my $old = $_;
65        if (/name="MIT mail"/) {
66            # Remember the old server name.
67            if (m%imap://$user(?:;[^\@]*)?\@([^/]+)/%i) {
68                $old_server = $1;
69            }
70
71            # Update the server name (and corresponding auth method).
72            s%(imap://$user)(\;[^\@]*)?\@($serverRE)%$1$auth\@$server%i;
73
74            # Make sure we always use SSL.
75            unless (m%imap://[^/]*/[^<]*;use_ssl=always[^<]*%i) {
76                # First clear any other SSL setting.
77                s%(imap://[^/]*/[^<]*);use_ssl=[^;<]*([^<]*)%$1$2%i;
78                s%(imap://[^/]*/)([^<]*)%$1;use_ssl=always$2%i;
79            }
80        }
81        $change = 1 if ($_ ne $old);
82    }
83
84    if ($change) {
85        # We need to update the account settings.
86        $client->set_list("/apps/evolution/mail/accounts", "string",
87                          $accounts);
88        if ($old_server ne $server) {
89            # Edit the folder state file -- the URI of the saved
90            # selected folder may point at the old server.
91            edit_state_file();
92        }
93    }
94} else {
95    # Pre-configuration.
96    $client->set_string("/apps/evolution/calendar/display/timezone",
97                        "America/New_York");
98
99    ($_, $_, $_, $_, $_, $_, my $gecos) = getpwuid($<);
100    my @fields = split(",", $gecos);
101    my $name = $fields[0];
102    my $home = $ENV{"HOME"};
103    my $local = "mbox:$home/.evolution/mail/local";
104    my $a = '<?xml version="1.0"?>' . "\n";
105    $a .= '<account name="MIT mail" uid="mitinitial" enabled="true">';
106    $a .= '<identity>';
107    $a .= "<name>$name</name>";
108    $a .= "<addr-spec>$user\@mit.edu</addr-spec>";
109    $a .= '</identity>';
110    $a .= '<source save-passwd="false">';
111    $a .= "<url>imap://$user$auth\@$server/;use_ssl=always</url>";
112    $a .= '</source>';
113    $a .= '<transport save-passwd="false">';
114    $a .= "<url>smtp://$user;auth=GSSAPI\@outgoing.mit.edu/;use_ssl=always";
115    $a .= '</url>';
116    $a .= '</transport>';
117    $a .= "<drafts-folder>$local#Drafts</drafts-folder>";
118    $a .= "<sent-folder>$local#Sent</sent-folder>";
119    $a .= '</account>' . "\n";
120    $accounts = [ $a ];
121    $client->set_list("/apps/evolution/mail/accounts", "string", $accounts);
122    $client->set_string("/apps/evolution/mail/default_account", "mitinitial");
123    create_initial_state_file();
124}
125
126exec("/usr/bin/evolution.debathena-orig", @ARGV);
127
128# Edit the existing folder tree state file, to update any URI referring to
129# the old server.
130sub edit_state_file() {
131    return unless $old_server;
132    my $file = "$homedir/.evolution/mail/config/folder-tree-expand-state.xml";
133    open(OLD, "<$file") or return;
134    my $newfile = $file . ".debathena-new";
135    unless (open(NEW, ">$newfile")) {
136        warn "Cannot open $newfile: $!\n";
137        close OLD;
138        return;
139    }
140    my $changed = 0;
141    # Loop to copy and edit the file, replacing the old IMAP server
142    # name with the new.
143    while (<OLD>) {
144        my $old = $_;
145        s%(imap://$user)(;[^\@]*)?\@($old_server)%$1\@$server%i;
146        print NEW;
147        $changed = 1 if ($_ ne $old);
148    }
149    close NEW;
150    close OLD;
151    # If we have changed the file, move the new one into place.
152    # Otherwise, just delete the copy.
153    if ($changed) {
154        unless (rename($newfile, $file)) {
155            warn "Cannot rename $newfile to $file: $!\n";
156            # Nuke the old file to be safe.
157            unlink $file;
158        }
159    } else {
160        unlink $newfile;
161    }
162}
163
164# Create the initial folder tree state file, to expand and select the
165# MIT INBOX.
166sub create_initial_state_file() {
167    my $file = "$homedir/.evolution/mail/config/folder-tree-expand-state.xml";
168
169    mkpath(dirname($file), 0, 0700);
170    unless (open(OUT, ">$file")) {
171        warn "Cannot open $file: $!\n";
172        return;
173    }
174    print OUT "<?xml version=\"1.0\"?>\n";
175    print OUT "<tree-state>\n";
176    print OUT "  <node name=\"local\" expand=\"true\"/>\n";
177    print OUT "  <node name=\"vfolder\" expand=\"false\"/>\n";
178    print OUT "  <node name=\"mitinitial\" expand=\"true\">\n";
179    print OUT "    <node name=\"INBOX\" expand=\"true\"/>\n";
180    print OUT "  </node>\n";
181    print OUT "  <selected uri=\"imap://$user\@$server/INBOX\"/>\n";
182    print OUT "</tree-state>\n";
183    close OUT;
184}
Note: See TracBrowser for help on using the repository browser.