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