mailman: add MailmanForceSSL env var

[hcoop/domtool2.git] / src / plugins / mailman.sml

diff --git a/src/plugins/mailman.sml b/src/plugins/mailman.sml
index ef72993..a601155 100644 (file)
--- a/src/plugins/mailman.sml
+++ b/src/plugins/mailman.sml
@@ -37,21 +37,25 @@ val () = Env.registerFunction ("mailman_node_to_node",
                             | _ => NONE)
 
 fun mailmanPlace (EApp ((EVar "mailman_place_default", _), (EString node, _)), _) =
-    SOME (node, Domain.nodeIp node)
-  | mailmanPlace (EApp ((EApp ((EVar "mailman_place", _), (EString node, _)), _), (EString ip, _)), _) =
-    SOME (node, ip)
+    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)
+                             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)
+                             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)
+                             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)
@@ -79,6 +83,7 @@ val () = Env.actionV_one "mailmanVhost"
                 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")
 
@@ -86,7 +91,7 @@ val () = Env.actionV_one "mailmanVhost"
                 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) =>
+                app (fn (node, ip, ipv6) =>
                         let
                             val file = Domain.domainFile {node = node,
                                                           name = confFile}
@@ -98,11 +103,21 @@ val () = Env.actionV_one "mailmanVhost"
                             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;
@@ -112,7 +127,16 @@ val () = Env.actionV_one "mailmanVhost"
                             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";
                             *)
@@ -151,9 +175,16 @@ val () = Env.actionV_one "mailmanVhost"
                             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 "        Require all granted\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};