structure Mailman :> MAILMAN = struct
+open Ast
+
+val () = Env.type_one "mailman_node"
+ Env.string
+ (fn node => Apache.webNode node orelse node = Config.Mailman.node)
+
+val dl = ErrorMsg.dummyLoc
+
+val () = Env.registerFunction ("mailman_node",
+ fn [] => SOME (EString Config.Mailman.node, dl)
+ | _ => NONE)
+
+val () = Env.registerFunction ("mailman_node_to_node",
+ fn [e] => SOME e
+ | _ => NONE)
+
+fun mailmanPlace (EApp ((EVar "mailman_place_default", _), (EString node, _)), _) =
+ SOME (node, Domain.nodeIp node, Domain.nodeIpv6 node)
+ | mailmanPlace (EApp ((EApp ((EApp ((EVar "mailman_place", _), (EString node, _)), _), (EString ip, _)), _), (EString ipv6, _)), _) =
+ SOME (node, ip, ipv6)
+ | mailmanPlace _ = NONE
+
+val _ = Env.registerFunction ("mailman_place_to_web_node",
+ fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (mailmanPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("mailman_place_to_node",
+ fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (mailmanPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("mailman_place_to_ip",
+ fn [e] => Option.map (fn (_, ip, _) => (EString ip, dl)) (mailmanPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("mailman_place_to_ip",
+ fn [e] => Option.map (fn (_, _, ipv6) => (EString ipv6, dl)) (mailmanPlace e)
+ | _ => NONE)
+
val files = ref ([] : TextIO.outstream list)
val write = ref (fn _ : string => ())
("hostname", Env.string)
(fn host =>
let
- val outf = Domain.domainFile {node = Config.Mailman.node,
- name = "mailman"}
+ val {write, writeDom, close} = Domain.domainsFile {node = Config.Mailman.node,
+ name = "mailman.conf"}
in
- TextIO.output (outf, "\t'");
- TextIO.output (outf, host);
- TextIO.output (outf, "' : '");
- TextIO.output (outf, Domain.currentDomain ());
- TextIO.output (outf, "',\n");
- TextIO.closeOut outf
+ write "\t'";
+ write host;
+ write "' : '";
+ writeDom ();
+ write "',\n";
+ close ()
end)
+val () = Env.actionV_one "mailmanVhost"
+ ("host", Env.string)
+ (fn (env, host) =>
+ let
+ val places = Env.env (Env.list mailmanPlace) (env, "MailmanPlaces")
+
+ val ssl = Env.env Apache.ssl (env, "SSL")
+ val forcessl = Env.env Env.bool (env, "MailmanForceSSL")
+ val user = Env.env Env.string (env, "User")
+ val sadmin = Env.env Env.string (env, "ServerAdmin")
+
+ val fullHost = host ^ "." ^ Domain.currentDomain ()
+ val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
+ val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
+ in
+ app (fn (node, ip, ipv6) =>
+ let
+ val file = Domain.domainFile {node = node,
+ name = confFile}
+ fun print s = TextIO.output (file, s)
+
+ val ld = Apache.logDir {user = user, node = node, vhostId = vhostId}
+ in
+ print "# Owner: ";
+ print user;
+ print "\n";
+ print "<VirtualHost ";
+
+ print ip;
+ print ":";
+ print (case ssl of
+ SOME _ => "443"
+ | NONE => "80");
+
+ print " [";
+ print ipv6;
+ print "]";
+ print ":";
+ print (case ssl of
+ SOME _ => "443"
+ | NONE => "80");
+
+ print ">\n";
+ print " ServerName ";
+ print host;
+ print ".";
+ print (Domain.currentDomain ());
+ print "\n";
+ print " ServerAdmin ";
+ print sadmin;
+ print "\n";
+ case ssl of
+ SOME cert =>
+ (print "\n\tSSLEngine on\n\tSSLCertificateFile ";
+ print cert;
+ print "\n")
+ | NONE => if forcessl then
+ (print "RewriteRule ^(.*)$ https://%{HTTP_HOST}$1 [R,L]")
+ else
+ ();
+ (*
+ print " SuexecUserGroup list list\n";
+ print "\n";
+ *)
+ print " ErrorLog ";
+ print ld;
+ print "/error.log\n";
+ print " CustomLog ";
+ print ld;
+ print "/access.log combined\n";
+ print "\n";
+ print " RewriteEngine on\n";
+ print "\n";
+ print " # Default to showing listinfo page\n";
+ print " RewriteRule ^/$ http";
+ case ssl of
+ NONE => ()
+ | SOME _ => print "s";
+ print "://";
+ print fullHost;
+ print "/listinfo/\n";
+ print "\n";
+ print " Alias /images/mailman /usr/share/images/mailman\n";
+ print " Alias /pipermail /var/lib/mailman/archives/public\n";
+ print "\n";
+ print " DocumentRoot /usr/lib/cgi-bin/mailman\n";
+ print " <Directory /usr/lib/cgi-bin/mailman>\n";
+ print " AllowOverride None\n";
+ print " Options +ExecCGI -MultiViews +SymLinksIfOwnerMatch\n";
+ print " ForceType cgi-script\n";
+ print " Order allow,deny\n";
+ print " Allow from all\n";
+ print " </Directory>\n";
+ print "\n";
+ print " <Directory /usr/share/doc/mailman>\n";
+ print " Order allow,deny\n";
+ print " Allow from all\n";
+ print " </Directory>\n";
+ print "\n";
+ print "\n";
+ print " <Directory /usr/share/images/mailman>\n";
+ print " Order allow,deny\n";
+ print " Allow from all\n";
+ print " </Directory>\n";
+ print "\n";
+ print " <Directory /var/lib/mailman/archives/public/>\n";
+ print " Options +SymlinksIfOwnerMatch -ExecCGI +Indexes\n";
+ print " Order allow,deny\n";
+ print " Allow from all\n";
+ print " </Directory>\n";
+
+ Apache.doPre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
+
+ print "</VirtualHost>\n";
+
+ TextIO.closeOut file;
+
+ Apache.doPost ()
+ end) places
+ end)
+
val mailmanChanged = ref false
val () = Slave.registerPreHandler (fn () => mailmanChanged := false)
val spl = OS.Path.splitDirFile (#file fs)
in
case #file spl of
- "mailman" => mailmanChanged := true
+ "mailman.conf" => mailmanChanged := true
| _ => ()
end)
val () = Slave.registerPostHandler (fn () =>
if !mailmanChanged then
- (Slave.concatTo (fn s => s = "mailman")
+ (Slave.concatTo (fn s => s = "mailman.conf")
Config.Mailman.mapFile;
- Slave.shellF ([Config.Mailman.reload],
+ Slave.enumerateTo (fn s => s = "mailman.conf") ":"
+ Config.Mailman.handleDomains;
+ Slave.shellF ([Config.Mailman.reload],
fn cl => "Error reloading Mailman with " ^ cl))
else
())
+val () = Domain.registerDescriber (Domain.considerAll
+ [Domain.Filename {filename = "mailman.conf",
+ heading = "Mailman web host mapping:",
+ showEmpty = false}])
+
end
HCoop / hcoop / domtool2.git / blobdiff