Allow IP address specification for Apache, though no way yet to do anything but defau...

diff --git a/lib/apache.dtl b/lib/apache.dtl
index db30398..db9dc37 100644 (file)
--- a/lib/apache.dtl
+++ b/lib/apache.dtl
@@ -5,6 +5,16 @@ extern type web_node;
 
 extern val web_node_to_node : web_node -> node;
 
+extern type web_place;
+extern val web_place_default : web_node -> web_place;
+extern val web_place : web_node -> your_ip -> web_place;
+extern val web_place_to_web_node : web_place -> web_node;
+extern val web_place_to_node : web_place -> node;
+extern val web_place_to_ip : web_place -> ip;
+{{Web places are combinations of web nodes (servers on which you are allowed to
+  run web sites) and IP addresses on which those servers should listen for
+  requests.}}
+
 context Vhost;
 {{A WWW virtual host}}
 
@@ -21,7 +31,7 @@ extern val no_ssl : ssl;
 extern val use_cert : ssl_cert_path -> ssl;
 
 extern val vhost : host -> Vhost => [Domain]
-       {WebNodes : [web_node],
+       {WebPlaces : [web_place],
         SSL : ssl,
         User : your_user,
         Group : your_group,

diff --git a/lib/domain.dtl b/lib/domain.dtl
index 55ac254..8946633 100644 (file)
--- a/lib/domain.dtl
+++ b/lib/domain.dtl
@@ -9,6 +9,9 @@ extern type no_newlines;
 extern type ip;
 {{An IP address}}
 
+extern type your_ip;
+{{An IP address that you're authorized to use; e.g., for an SSL web host}}
+
 extern type host;
 {{A hostname; that is, (more or less) an alphanumeric string}}
 

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index f36bfa4..2d42a98 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -22,6 +22,8 @@ structure Apache :> APACHE = struct
 
 open Ast
 
+val dl = ErrorMsg.dummyLoc
+
 fun webNode node =
     List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
     orelse (Domain.hasPriv "www"
@@ -35,6 +37,26 @@ val _ = Env.registerFunction ("web_node_to_node",
                              fn [e] => SOME e
                               | _ => NONE)
 
+fun webPlace (EApp ((EString "web_place_default", _), (EString node, _)), _) =
+    SOME (node, Domain.nodeIp node)
+  | webPlace (EApp ((EApp ((EString "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
+    SOME (node, ip)
+  | webPlace _ = NONE
+
+fun webPlaceDefault node = (EApp ((EString "web_place_default", dl), (EString node, dl)), dl)
+
+val _ = Env.registerFunction ("web_place_to_web_node",
+                             fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+                              | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_node",
+                             fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+                              | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_ip",
+                             fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (webPlace e)
+                              | _ => NONE)
+
 val _ = Env.type_one "proxy_port"
        Env.int
        (fn n => n > 1024)
@@ -89,11 +111,9 @@ fun ssl e = case e of
              | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
              | _ => NONE
 
-val dl = ErrorMsg.dummyLoc
-
-val defaults = [("WebNodes",
-                (TList (TBase "web_node", dl), dl),
-                (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))),
+val defaults = [("WebPlaces",
+                (TList (TBase "web_place", dl), dl),
+                (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
                ("SSL",
                 (TBase "ssl", dl),
                 (fn () => (EVar "no_ssl", dl))),
@@ -398,7 +418,7 @@ val () = Env.containerV_one "vhost"
         ("host", Env.string)
         (fn (env, host) =>
             let
-                val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
+                val places = Env.env (Env.list webPlace) (env, "WebPlaces")
 
                 val ssl = Env.env ssl (env, "SSL")
                 val user = Env.env Env.string (env, "User")
@@ -417,7 +437,7 @@ val () = Env.containerV_one "vhost"
 
                 rewriteEnabled := false;
                 localRewriteEnabled := false;
-                vhostFiles := map (fn node =>
+                vhostFiles := map (fn (node, ip) =>
                                       let
                                           val file = Domain.domainFile {node = node,
                                                                         name = confFile}
@@ -427,7 +447,7 @@ val () = Env.containerV_one "vhost"
                                           TextIO.output (file, "# Owner: ");
                                           TextIO.output (file, user);
                                           TextIO.output (file, "\n<VirtualHost ");
-                                          TextIO.output (file, Domain.nodeIp node);
+                                          TextIO.output (file, ip);
                                           TextIO.output (file, ":");
                                           TextIO.output (file, case ssl of
                                                                    SOME _ => "443"
@@ -475,7 +495,7 @@ val () = Env.containerV_one "vhost"
 
                                           (ld, file)
                                       end)
-                                  nodes;
+                                  places;
                 write "\n\tDocumentRoot ";
                 write docroot;
                 write "\n\tServerAdmin ";
@@ -486,7 +506,7 @@ val () = Env.containerV_one "vhost"
                      write cert)
                   | NONE => ();
                 write "\n";
-                !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
+                !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
                 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
             end,
          fn () => (!post ();