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 | ||
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 | |
85095959 AC |
30 | val {write, writeDom, close} = Domain.domainsFile {node = Config.Mailman.node, |
31 | name = "mailman"} | |
325285ab | 32 | in |
85095959 AC |
33 | write "\t'"; |
34 | write host; | |
35 | write "' : '"; | |
36 | writeDom (); | |
37 | write "',\n"; | |
38 | close () | |
325285ab AC |
39 | end) |
40 | ||
1c9b5e20 AC |
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 | ||
325285ab AC |
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; | |
5543e924 AC |
128 | Slave.enumerateTo (fn s => s = "mailman") ":" |
129 | Config.Mailman.handleDomains; | |
130 | Slave.shellF ([Config.Mailman.reload], | |
325285ab AC |
131 | fn cl => "Error reloading Mailman with " ^ cl)) |
132 | else | |
133 | ()) | |
134 | ||
d300166d AC |
135 | val () = Domain.registerDescriber (Domain.considerAll |
136 | [Domain.Filename {filename = "mailman", | |
137 | heading = "Mailman web host mapping", | |
138 | showEmpty = false}]) | |
139 | ||
325285ab | 140 | end |