Mailman shortcut working

diff --git a/lib/domain.dtl b/lib/domain.dtl
index 8be8896..55ac254 100644 (file)
--- a/lib/domain.dtl
+++ b/lib/domain.dtl
@@ -84,4 +84,7 @@ extern val domain : your_domain -> Domain => [Root] {Aliases : [your_domain], DN
 
 extern type mail_node;
 {{A node offering SMTP services}}
-extern val mail_node_to_node : mail_node -> node;
\ No newline at end of file
+extern val mail_node_to_node : mail_node -> node;
+
+extern val domainHost : host -> [Domain] {} => { Hostname : domain };
+{{Appends the current domain onto a host.}}

diff --git a/lib/mailman.dtl b/lib/mailman.dtl
index 2cf0445..21e3b49 100644 (file)
--- a/lib/mailman.dtl
+++ b/lib/mailman.dtl
@@ -3,3 +3,33 @@
 extern val mailmanWebHost : domain -> [Domain];
 {{Set the hostname of the web site for administration of mailing lists for this
   domain.}}
+
+extern type mailman_web_node;
+{{Like <tt>web_node</tt>, but with the possibility of using some additional
+  nodes set by the admins.}}
+
+extern val mailman_web_node : mailman_web_node;
+{{The default location for Mailman web interfaces}}
+
+extern val mailman_web_node_to_node : mailman_web_node -> node;
+
+extern val mailmanVhost : host -> [Domain]
+       {MailmanWebNodes : [mailman_web_node],
+        SSL : ssl,
+        User : your_user};
+{{Create an Apache virtual host to serve as the web interface for some Mailman
+  lists.}}
+
+val mailman = \ host : (host) -> begin
+  dnsIP host (ip_of_node (mailman_web_node_to_node mailman_web_node));
+  domainHost host;
+  mwh <- Hostname;
+  mailmanWebHost mwh;
+  mailmanVhost host where
+    MailmanWebNodes = [mailman_web_node];
+    SSL = no_ssl
+  end;
+end;
+{{The most common Mailman config, for when you want to have a virtual host of your
+  domain dedicated to a Mailman interface.  Provide the name of that host (e.g.,
+  "lists") to this directive, and it will take care of the rest.}}

diff --git a/src/domain.sml b/src/domain.sml
index 3ecf883..ebd7a2b 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -907,4 +907,10 @@ val () = registerDescriber (considerAll [Filename {filename = "soa",
                                                   heading = "DNS SOA",
                                                   showEmpty = false}])
 
+val () = Env.registerAction ("domainHost",
+                            fn (env, [(EString host, _)]) =>
+                               SM.insert (env, "Hostname",
+                                          (EString (host ^ "." ^ currentDomain ()), dl))
+                             | (_, args) => Env.badArgs ("domainHost", args))
+
 end

diff --git a/src/plugins/apache.sig b/src/plugins/apache.sig
index 8baead3..fd8c166 100644 (file)
--- a/src/plugins/apache.sig
+++ b/src/plugins/apache.sig
@@ -26,6 +26,9 @@ signature APACHE = sig
     val registerPost : (unit -> unit) -> unit
     (* Register a callback for the end of a vhost block. *)
 
+    val doPre : {user : string, nodes : string list, id : string, hostname : string} -> unit
+    val doPost : unit -> unit
+
     val registerAliaser : (string -> unit) -> unit
     (* Register a callback for an alternate hostname that is configured. *)
 

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 62615af..f36bfa4 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -383,6 +383,9 @@ fun registerPost f =
        post := (fn () => (old (); f ()))
     end
 
+fun doPre x = !pre x
+fun doPost () = !post ()
+
 val aliaser = ref (fn _ : string => ())
 fun registerAliaser f =
     let

diff --git a/src/plugins/mailman.sml b/src/plugins/mailman.sml
index 5244682..12d92a0 100644 (file)
--- a/src/plugins/mailman.sml
+++ b/src/plugins/mailman.sml
@@ -28,6 +28,14 @@ val () = Env.type_one "mailman_web_node"
 
 val dl = ErrorMsg.dummyLoc
 
+val () = Env.registerFunction ("mailman_web_node",
+                              fn [] => SOME (EString Config.Mailman.node, dl)
+                               | _ => NONE)
+
+val () = Env.registerFunction ("mailman_web_node_to_node",
+                           fn [e] => SOME e
+                            | _ => NONE)
+
 val () = Defaults.registerDefault
             ("MailmanWebNodes",
              (TList (TBase "mailman_web_node", dl), dl),
@@ -118,9 +126,14 @@ val () = Env.actionV_one "mailmanVhost"
                             print "        Order allow,deny\n";
                             print "        Allow from all\n";
                             print "    </Directory>\n";
+
+                            Apache.doPre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
+
                             print "</VirtualHost>\n";
 
-                            TextIO.closeOut file
+                            TextIO.closeOut file;
+
+                            Apache.doPost ()
                         end) nodes
             end)
 

diff --git a/src/reduce.sml b/src/reduce.sml
index 5d7a1b9..525d713 100644 (file)
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -133,7 +133,12 @@ fun reduceExp G (eAll as (e, loc)) =
        end
       | EVar x =>
        (case lookupEquation G x of
-            NONE => eAll
+            NONE =>
+            (case function x of
+                 NONE => eAll
+               | SOME f => case f [] of
+                               NONE => eAll
+                             | SOME e' => reduceExp G e')
           | SOME e => reduceExp G e)
       | EApp (e1, e2) =>
        let