1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, Adam Chlipala
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
.
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
.
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
.
19 (* Mailman mailing list handling
*)
21 structure Mailman
:> MAILMAN
= struct
23 val files
= ref ([] : TextIO.outstream list
)
24 val write
= ref (fn _
: string => ())
26 val () = Env
.action_one
"mailmanWebHost"
27 ("hostname", Env
.string)
30 val {write
, writeDom
, close
} = Domain
.domainsFile
{node
= Config
.Mailman
.node
,
41 val () = Env
.actionV_one
"mailmanVhost"
45 val nodes
= Env
.env (Env
.list Env
.string) (env
, "WebNodes")
47 val ssl
= Env
.env Apache
.ssl (env
, "SSL")
48 val user
= Env
.env Env
.string (env
, "User")
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")
56 val file
= Domain
.domainFile
{node
= node
,
58 fun print s
= TextIO.output (file
, s
)
60 val ld
= Apache
.logDir
{user
= user
, node
= node
, vhostId
= vhostId
}
62 print
"<VirtualHost ";
63 print (Domain
.nodeIp node
);
69 print
" ServerName $LISTDOMAIN\n";
70 print
" ServerAdmin ";
73 print
" SuexecUserGroup list list\n";
80 print
"/access.log combined\n";
82 print
" RewriteEngine on\n";
84 print
" # Default to showing listinfo page\n";
85 print
" RewriteRule ^/$ http://";
89 print
" Alias /images/mailman /usr/share/images/mailman\n";
90 print
" Alias /pipermail /var/lib/mailman/archives/public\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";
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";
111 val mailmanChanged
= ref
false
113 val () = Slave
.registerPreHandler (fn () => mailmanChanged
:= false)
115 val () = Slave
.registerFileHandler (fn fs
=>
117 val spl
= OS
.Path
.splitDirFile (#file fs
)
120 "mailman" => mailmanChanged
:= true
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
))
135 val () = Domain
.registerDescriber (Domain
.considerAll
136 [Domain
.Filename
{filename
= "mailman",
137 heading
= "Mailman web host mapping",