Commit | Line | Data |
---|---|---|
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 | ||
21 | structure Mailman :> MAILMAN = struct | |
22 | ||
de5351c7 AC |
23 | open Ast |
24 | ||
b5f2d506 | 25 | val () = Env.type_one "mailman_node" |
de5351c7 AC |
26 | Env.string |
27 | (fn node => Apache.webNode node orelse node = Config.Mailman.node) | |
28 | ||
29 | val dl = ErrorMsg.dummyLoc | |
30 | ||
b5f2d506 | 31 | val () = Env.registerFunction ("mailman_node", |
e9f528ab AC |
32 | fn [] => SOME (EString Config.Mailman.node, dl) |
33 | | _ => NONE) | |
34 | ||
b5f2d506 | 35 | val () = Env.registerFunction ("mailman_node_to_node", |
e9f528ab AC |
36 | fn [e] => SOME e |
37 | | _ => NONE) | |
38 | ||
b5f2d506 | 39 | fun mailmanPlace (EApp ((EVar "mailman_place_default", _), (EString node, _)), _) = |
f924c1cf CE |
40 | SOME (node, Domain.nodeIp node, Domain.nodeIpv6 node) |
41 | | mailmanPlace (EApp ((EApp ((EApp ((EVar "mailman_place", _), (EString node, _)), _), (EString ip, _)), _), (EString ipv6, _)), _) = | |
42 | SOME (node, ip, ipv6) | |
b5f2d506 AC |
43 | | mailmanPlace _ = NONE |
44 | ||
b5f2d506 | 45 | val _ = Env.registerFunction ("mailman_place_to_web_node", |
f924c1cf | 46 | fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (mailmanPlace e) |
b5f2d506 AC |
47 | | _ => NONE) |
48 | ||
49 | val _ = Env.registerFunction ("mailman_place_to_node", | |
f924c1cf | 50 | fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (mailmanPlace e) |
b5f2d506 AC |
51 | | _ => NONE) |
52 | ||
53 | val _ = Env.registerFunction ("mailman_place_to_ip", | |
f924c1cf CE |
54 | fn [e] => Option.map (fn (_, ip, _) => (EString ip, dl)) (mailmanPlace e) |
55 | | _ => NONE) | |
56 | ||
57 | val _ = Env.registerFunction ("mailman_place_to_ip", | |
58 | fn [e] => Option.map (fn (_, _, ipv6) => (EString ipv6, dl)) (mailmanPlace e) | |
b5f2d506 AC |
59 | | _ => NONE) |
60 | ||
325285ab AC |
61 | val files = ref ([] : TextIO.outstream list) |
62 | val write = ref (fn _ : string => ()) | |
63 | ||
64 | val () = Env.action_one "mailmanWebHost" | |
65 | ("hostname", Env.string) | |
66 | (fn host => | |
67 | let | |
85095959 | 68 | val {write, writeDom, close} = Domain.domainsFile {node = Config.Mailman.node, |
3ae703b6 | 69 | name = "mailman.conf"} |
325285ab | 70 | in |
85095959 AC |
71 | write "\t'"; |
72 | write host; | |
73 | write "' : '"; | |
74 | writeDom (); | |
75 | write "',\n"; | |
76 | close () | |
325285ab AC |
77 | end) |
78 | ||
1c9b5e20 AC |
79 | val () = Env.actionV_one "mailmanVhost" |
80 | ("host", Env.string) | |
81 | (fn (env, host) => | |
82 | let | |
b5f2d506 | 83 | val places = Env.env (Env.list mailmanPlace) (env, "MailmanPlaces") |
1c9b5e20 AC |
84 | |
85 | val ssl = Env.env Apache.ssl (env, "SSL") | |
bd8614c8 | 86 | val forcessl = Env.env Env.bool (env, "MailmanForceSSL") |
1c9b5e20 | 87 | val user = Env.env Env.string (env, "User") |
e322749a | 88 | val sadmin = Env.env Env.string (env, "ServerAdmin") |
1c9b5e20 AC |
89 | |
90 | val fullHost = host ^ "." ^ Domain.currentDomain () | |
91 | val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "") | |
92 | val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost") | |
93 | in | |
f924c1cf | 94 | app (fn (node, ip, ipv6) => |
1c9b5e20 AC |
95 | let |
96 | val file = Domain.domainFile {node = node, | |
97 | name = confFile} | |
98 | fun print s = TextIO.output (file, s) | |
99 | ||
100 | val ld = Apache.logDir {user = user, node = node, vhostId = vhostId} | |
101 | in | |
954e17ad AC |
102 | print "# Owner: "; |
103 | print user; | |
104 | print "\n"; | |
1c9b5e20 | 105 | print "<VirtualHost "; |
f924c1cf | 106 | |
b5f2d506 | 107 | print ip; |
1c9b5e20 AC |
108 | print ":"; |
109 | print (case ssl of | |
110 | SOME _ => "443" | |
111 | | NONE => "80"); | |
f924c1cf CE |
112 | |
113 | print " ["; | |
114 | print ipv6; | |
115 | print "]"; | |
116 | print ":"; | |
117 | print (case ssl of | |
118 | SOME _ => "443" | |
119 | | NONE => "80"); | |
120 | ||
de5351c7 | 121 | print ">\n"; |
3af11fe6 AC |
122 | print " ServerName "; |
123 | print host; | |
124 | print "."; | |
125 | print (Domain.currentDomain ()); | |
126 | print "\n"; | |
1c9b5e20 | 127 | print " ServerAdmin "; |
e322749a AC |
128 | print sadmin; |
129 | print "\n"; | |
4c792c1b CE |
130 | case ssl of |
131 | SOME cert => | |
132 | (print "\n\tSSLEngine on\n\tSSLCertificateFile "; | |
133 | print cert; | |
134 | print "\n") | |
bd8614c8 | 135 | | NONE => if forcessl then |
06ba9276 | 136 | (print "\tRewriteRule ^(.*)$ https://%{HTTP_HOST}$1 [R,L]\n") |
bd8614c8 CE |
137 | else |
138 | (); | |
f924c1cf | 139 | (* |
28b75d66 | 140 | print " SuexecUserGroup list list\n"; |
1c9b5e20 | 141 | print "\n"; |
28b75d66 | 142 | *) |
1c9b5e20 AC |
143 | print " ErrorLog "; |
144 | print ld; | |
145 | print "/error.log\n"; | |
146 | print " CustomLog "; | |
147 | print ld; | |
148 | print "/access.log combined\n"; | |
149 | print "\n"; | |
150 | print " RewriteEngine on\n"; | |
151 | print "\n"; | |
152 | print " # Default to showing listinfo page\n"; | |
4a824a5f AC |
153 | print " RewriteRule ^/$ http"; |
154 | case ssl of | |
155 | NONE => () | |
156 | | SOME _ => print "s"; | |
157 | print "://"; | |
1c9b5e20 AC |
158 | print fullHost; |
159 | print "/listinfo/\n"; | |
160 | print "\n"; | |
161 | print " Alias /images/mailman /usr/share/images/mailman\n"; | |
162 | print " Alias /pipermail /var/lib/mailman/archives/public\n"; | |
163 | print "\n"; | |
164 | print " DocumentRoot /usr/lib/cgi-bin/mailman\n"; | |
165 | print " <Directory /usr/lib/cgi-bin/mailman>\n"; | |
166 | print " AllowOverride None\n"; | |
167 | print " Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch\n"; | |
168 | print " ForceType cgi-script\n"; | |
169 | print " Order allow,deny\n"; | |
170 | print " Allow from all\n"; | |
171 | print " </Directory>\n"; | |
172 | print "\n"; | |
173 | print " <Directory /usr/share/doc/mailman>\n"; | |
174 | print " Order allow,deny\n"; | |
175 | print " Allow from all\n"; | |
176 | print " </Directory>\n"; | |
28b75d66 | 177 | print "\n"; |
984a831b CE |
178 | print "\n"; |
179 | print " <Directory /usr/share/images/mailman>\n"; | |
180 | print " Order allow,deny\n"; | |
181 | print " Allow from all\n"; | |
182 | print " </Directory>\n"; | |
183 | print "\n"; | |
28b75d66 CE |
184 | print " <Directory /var/lib/mailman/archives/public/>\n"; |
185 | print " Options +SymlinksIfOwnerMatch -ExecCGI +Indexes\n"; | |
984a831b CE |
186 | print " Order allow,deny\n"; |
187 | print " Allow from all\n"; | |
28b75d66 | 188 | print " </Directory>\n"; |
e9f528ab | 189 | |
b5f2d506 | 190 | Apache.doPre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost}; |
e9f528ab | 191 | |
1c9b5e20 AC |
192 | print "</VirtualHost>\n"; |
193 | ||
e9f528ab AC |
194 | TextIO.closeOut file; |
195 | ||
196 | Apache.doPost () | |
b5f2d506 | 197 | end) places |
1c9b5e20 AC |
198 | end) |
199 | ||
325285ab AC |
200 | val mailmanChanged = ref false |
201 | ||
202 | val () = Slave.registerPreHandler (fn () => mailmanChanged := false) | |
203 | ||
204 | val () = Slave.registerFileHandler (fn fs => | |
205 | let | |
206 | val spl = OS.Path.splitDirFile (#file fs) | |
207 | in | |
208 | case #file spl of | |
3ae703b6 | 209 | "mailman.conf" => mailmanChanged := true |
325285ab AC |
210 | | _ => () |
211 | end) | |
212 | ||
213 | val () = Slave.registerPostHandler (fn () => | |
214 | if !mailmanChanged then | |
3ae703b6 | 215 | (Slave.concatTo (fn s => s = "mailman.conf") |
325285ab | 216 | Config.Mailman.mapFile; |
3ae703b6 | 217 | Slave.enumerateTo (fn s => s = "mailman.conf") ":" |
5543e924 AC |
218 | Config.Mailman.handleDomains; |
219 | Slave.shellF ([Config.Mailman.reload], | |
325285ab AC |
220 | fn cl => "Error reloading Mailman with " ^ cl)) |
221 | else | |
222 | ()) | |
223 | ||
d300166d | 224 | val () = Domain.registerDescriber (Domain.considerAll |
3ae703b6 | 225 | [Domain.Filename {filename = "mailman.conf", |
d936cf4d | 226 | heading = "Mailman web host mapping:", |
d300166d AC |
227 | showEmpty = false}]) |
228 | ||
325285ab | 229 | end |