Initial mailman vhost config
[hcoop/domtool2.git] / src / plugins / mailman.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19 (* Mailman mailing list handling *)
20
21 structure Mailman :> MAILMAN = struct
22
23 val files = ref ([] : TextIO.outstream list)
24 val write = ref (fn _ : string => ())
25
26 val () = Env.action_one "mailmanWebHost"
27 ("hostname", Env.string)
28 (fn host =>
29 let
30 val {write, writeDom, close} = Domain.domainsFile {node = Config.Mailman.node,
31 name = "mailman"}
32 in
33 write "\t'";
34 write host;
35 write "' : '";
36 writeDom ();
37 write "',\n";
38 close ()
39 end)
40
41 val () = Env.actionV_one "mailmanVhost"
42 ("host", Env.string)
43 (fn (env, host) =>
44 let
45 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
46
47 val ssl = Env.env Apache.ssl (env, "SSL")
48 val user = Env.env Env.string (env, "User")
49
50 val fullHost = host ^ "." ^ Domain.currentDomain ()
51 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
52 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
53 in
54 app (fn node =>
55 let
56 val file = Domain.domainFile {node = node,
57 name = confFile}
58 fun print s = TextIO.output (file, s)
59
60 val ld = Apache.logDir {user = user, node = node, vhostId = vhostId}
61 in
62 print "<VirtualHost ";
63 print (Domain.nodeIp node);
64 print ":";
65 print (case ssl of
66 SOME _ => "443"
67 | NONE => "80");
68 print "\n";
69 print " ServerName $LISTDOMAIN\n";
70 print " ServerAdmin ";
71 print user;
72 print "@hcoop.net\n";
73 print " SuexecUserGroup list list\n";
74 print "\n";
75 print " ErrorLog ";
76 print ld;
77 print "/error.log\n";
78 print " CustomLog ";
79 print ld;
80 print "/access.log combined\n";
81 print "\n";
82 print " RewriteEngine on\n";
83 print "\n";
84 print " # Default to showing listinfo page\n";
85 print " RewriteRule ^/$ http://";
86 print fullHost;
87 print "/listinfo/\n";
88 print "\n";
89 print " Alias /images/mailman /usr/share/images/mailman\n";
90 print " Alias /pipermail /var/lib/mailman/archives/public\n";
91 print "\n";
92 print " DocumentRoot /usr/lib/cgi-bin/mailman\n";
93 print " <Directory /usr/lib/cgi-bin/mailman>\n";
94 print " AllowOverride None\n";
95 print " Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch\n";
96 print " ForceType cgi-script\n";
97 print " Order allow,deny\n";
98 print " Allow from all\n";
99 print " </Directory>\n";
100 print "\n";
101 print " <Directory /usr/share/doc/mailman>\n";
102 print " Order allow,deny\n";
103 print " Allow from all\n";
104 print " </Directory>\n";
105 print "</VirtualHost>\n";
106
107 TextIO.closeOut file
108 end) nodes
109 end)
110
111 val mailmanChanged = ref false
112
113 val () = Slave.registerPreHandler (fn () => mailmanChanged := false)
114
115 val () = Slave.registerFileHandler (fn fs =>
116 let
117 val spl = OS.Path.splitDirFile (#file fs)
118 in
119 case #file spl of
120 "mailman" => mailmanChanged := true
121 | _ => ()
122 end)
123
124 val () = Slave.registerPostHandler (fn () =>
125 if !mailmanChanged then
126 (Slave.concatTo (fn s => s = "mailman")
127 Config.Mailman.mapFile;
128 Slave.enumerateTo (fn s => s = "mailman") ":"
129 Config.Mailman.handleDomains;
130 Slave.shellF ([Config.Mailman.reload],
131 fn cl => "Error reloading Mailman with " ^ cl))
132 else
133 ())
134
135 val () = Domain.registerDescriber (Domain.considerAll
136 [Domain.Filename {filename = "mailman",
137 heading = "Mailman web host mapping",
138 showEmpty = false}])
139
140 end