Mailman shortcut working
[hcoop/domtool2.git] / src / plugins / mailman.sml
CommitLineData
325285ab
AC
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
21structure Mailman :> MAILMAN = struct
22
de5351c7
AC
23open Ast
24
25val () = Env.type_one "mailman_web_node"
26 Env.string
27 (fn node => Apache.webNode node orelse node = Config.Mailman.node)
28
29val dl = ErrorMsg.dummyLoc
30
e9f528ab
AC
31val () = Env.registerFunction ("mailman_web_node",
32 fn [] => SOME (EString Config.Mailman.node, dl)
33 | _ => NONE)
34
35val () = Env.registerFunction ("mailman_web_node_to_node",
36 fn [e] => SOME e
37 | _ => NONE)
38
de5351c7
AC
39val () = Defaults.registerDefault
40 ("MailmanWebNodes",
41 (TList (TBase "mailman_web_node", dl), dl),
42 (fn () => (EList [(EString Config.Mailman.node, dl)], dl)))
43
325285ab
AC
44val files = ref ([] : TextIO.outstream list)
45val write = ref (fn _ : string => ())
46
47val () = Env.action_one "mailmanWebHost"
48 ("hostname", Env.string)
49 (fn host =>
50 let
85095959
AC
51 val {write, writeDom, close} = Domain.domainsFile {node = Config.Mailman.node,
52 name = "mailman"}
325285ab 53 in
85095959
AC
54 write "\t'";
55 write host;
56 write "' : '";
57 writeDom ();
58 write "',\n";
59 close ()
325285ab
AC
60 end)
61
1c9b5e20
AC
62val () = Env.actionV_one "mailmanVhost"
63 ("host", Env.string)
64 (fn (env, host) =>
65 let
de5351c7 66 val nodes = Env.env (Env.list Env.string) (env, "MailmanWebNodes")
1c9b5e20
AC
67
68 val ssl = Env.env Apache.ssl (env, "SSL")
69 val user = Env.env Env.string (env, "User")
70
71 val fullHost = host ^ "." ^ Domain.currentDomain ()
72 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
73 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
74 in
75 app (fn node =>
76 let
77 val file = Domain.domainFile {node = node,
78 name = confFile}
79 fun print s = TextIO.output (file, s)
80
81 val ld = Apache.logDir {user = user, node = node, vhostId = vhostId}
82 in
954e17ad
AC
83 print "# Owner: ";
84 print user;
85 print "\n";
1c9b5e20
AC
86 print "<VirtualHost ";
87 print (Domain.nodeIp node);
88 print ":";
89 print (case ssl of
90 SOME _ => "443"
91 | NONE => "80");
de5351c7 92 print ">\n";
1c9b5e20
AC
93 print " ServerName $LISTDOMAIN\n";
94 print " ServerAdmin ";
95 print user;
96 print "@hcoop.net\n";
97 print " SuexecUserGroup list list\n";
98 print "\n";
99 print " ErrorLog ";
100 print ld;
101 print "/error.log\n";
102 print " CustomLog ";
103 print ld;
104 print "/access.log combined\n";
105 print "\n";
106 print " RewriteEngine on\n";
107 print "\n";
108 print " # Default to showing listinfo page\n";
109 print " RewriteRule ^/$ http://";
110 print fullHost;
111 print "/listinfo/\n";
112 print "\n";
113 print " Alias /images/mailman /usr/share/images/mailman\n";
114 print " Alias /pipermail /var/lib/mailman/archives/public\n";
115 print "\n";
116 print " DocumentRoot /usr/lib/cgi-bin/mailman\n";
117 print " <Directory /usr/lib/cgi-bin/mailman>\n";
118 print " AllowOverride None\n";
119 print " Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch\n";
120 print " ForceType cgi-script\n";
121 print " Order allow,deny\n";
122 print " Allow from all\n";
123 print " </Directory>\n";
124 print "\n";
125 print " <Directory /usr/share/doc/mailman>\n";
126 print " Order allow,deny\n";
127 print " Allow from all\n";
128 print " </Directory>\n";
e9f528ab
AC
129
130 Apache.doPre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
131
1c9b5e20
AC
132 print "</VirtualHost>\n";
133
e9f528ab
AC
134 TextIO.closeOut file;
135
136 Apache.doPost ()
1c9b5e20
AC
137 end) nodes
138 end)
139
325285ab
AC
140val mailmanChanged = ref false
141
142val () = Slave.registerPreHandler (fn () => mailmanChanged := false)
143
144val () = Slave.registerFileHandler (fn fs =>
145 let
146 val spl = OS.Path.splitDirFile (#file fs)
147 in
148 case #file spl of
149 "mailman" => mailmanChanged := true
150 | _ => ()
151 end)
152
153val () = Slave.registerPostHandler (fn () =>
154 if !mailmanChanged then
155 (Slave.concatTo (fn s => s = "mailman")
156 Config.Mailman.mapFile;
5543e924
AC
157 Slave.enumerateTo (fn s => s = "mailman") ":"
158 Config.Mailman.handleDomains;
159 Slave.shellF ([Config.Mailman.reload],
325285ab
AC
160 fn cl => "Error reloading Mailman with " ^ cl))
161 else
162 ())
163
d300166d
AC
164val () = Domain.registerDescriber (Domain.considerAll
165 [Domain.Filename {filename = "mailman",
166 heading = "Mailman web host mapping",
167 showEmpty = false}])
168
325285ab 169end