X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/3af11fe69bf5f83cf12f5a37855faa8c81025b34..0b86cc7b4c6d4268654e8c460d4cbe1b0cbc549e:/src/plugins/mailman.sml

diff --git a/src/plugins/mailman.sml b/src/plugins/mailman.sml
index b716cbd..4a2bfeb 100644
--- a/src/plugins/mailman.sml
+++ b/src/plugins/mailman.sml
@@ -37,29 +37,26 @@ 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
 
-fun mailmanPlaceDefault node = (EApp ((EVar "mailman_place_default", dl), (EString node, dl)), dl)
-
 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 () = Defaults.registerDefault
-	     ("MailmanPlaces",
-	      (TList (TBase "mailman_place", dl), dl),
-	      (fn () => (EList [mailmanPlaceDefault Config.Mailman.node], dl)))
+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 => ())
@@ -69,7 +66,7 @@ val () = Env.action_one "mailmanWebHost"
 			(fn host =>
 			    let
 				val {write, writeDom, close} = Domain.domainsFile {node = Config.Mailman.node,
-										   name = "mailman"}
+										   name = "mailman.conf"}
 			    in
 				write "\t'";
 				write host;
@@ -87,12 +84,13 @@ val () = Env.actionV_one "mailmanVhost"
 
 		 val ssl = Env.env Apache.ssl (env, "SSL")
 		 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) =>
+		 app (fn (node, ip, ipv6) =>
 			 let
 			     val file = Domain.domainFile {node = node,
 							   name = confFile}
@@ -104,11 +102,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;
@@ -116,10 +124,12 @@ val () = Env.actionV_one "mailmanVhost"
 			     print (Domain.currentDomain ());
 			     print "\n";
 			     print "    ServerAdmin ";
-			     print user;
-			     print "@hcoop.net\n";
-			     print "    SuexecUserGroup list list\n";
+			     print sadmin;
 			     print "\n";
+			     (*
+                             print "    SuexecUserGroup list list\n";
+			     print "\n";
+			     *)
 			     print "    ErrorLog ";
 			     print ld;
 			     print "/error.log\n";
@@ -130,7 +140,11 @@ val () = Env.actionV_one "mailmanVhost"
 			     print "    RewriteEngine on\n";
 			     print "\n";
 			     print "    # Default to showing listinfo page\n";
-			     print "    RewriteRule ^/$ http://";
+			     print "    RewriteRule ^/$ http";
+			     case ssl of
+				 NONE => ()
+			       | SOME _ => print "s";
+			     print "://";
 			     print fullHost;
 			     print "/listinfo/\n";
 			     print "\n";
@@ -150,6 +164,18 @@ val () = Env.actionV_one "mailmanVhost"
 			     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};
 
@@ -170,15 +196,15 @@ val () = Slave.registerFileHandler (fn fs =>
 					   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.enumerateTo (fn s => s = "mailman") ":"
+				            Slave.enumerateTo (fn s => s = "mailman.conf") ":"
 							      Config.Mailman.handleDomains;
 							      Slave.shellF ([Config.Mailman.reload],
 						       fn cl => "Error reloading Mailman with " ^ cl))
@@ -186,8 +212,8 @@ val () = Slave.registerPostHandler (fn () =>
 					   ())
 
 val () = Domain.registerDescriber (Domain.considerAll
-				   [Domain.Filename {filename = "mailman",
-						     heading = "Mailman web host mapping",
+				   [Domain.Filename {filename = "mailman.conf",
+						     heading = "Mailman web host mapping:",
 						     showEmpty = false}])
 
 end