vhostDefault

diff --git a/lib/apache.dtl b/lib/apache.dtl
index f176787..ed6f8b1 100644 (file)
--- a/lib/apache.dtl
+++ b/lib/apache.dtl
@@ -44,6 +44,17 @@ extern val vhost : host -> Vhost => [Domain]
   path to the static content root, and the e-mail address to which error pages
   should direct visitors.}}
 
   path to the static content root, and the e-mail address to which error pages
   should direct visitors.}}
 

+extern val vhostDefault : Vhost => [Domain]
+  {WebPlaces : [web_place],
+  SSL : ssl,
+  User : your_user,
+  Group : your_group,
+  DocumentRoot : your_path,
+  ServerAdmin : email,
+  SuExec : suexec_flag};
+{{Like <tt>vhost</tt>, but for, e.g., <tt>yourdomain.com</tt> instead of
+  <tt>www.yourdomain.com</tt>}}
+

 context Location;
 
 extern type location;
 context Location;
 
 extern type location;

diff --git a/src/env.sig b/src/env.sig
index 023813a..0a50620 100644 (file)
--- a/src/env.sig
+++ b/src/env.sig
@@ -59,6 +59,7 @@ signature ENV = sig
                -> string * 'a arg * string * 'b arg * string * 'c arg
                -> ('a * 'b * 'c -> unit) -> action
 
                -> string * 'a arg * string * 'b arg * string * 'c arg
                -> ('a * 'b * 'c -> unit) -> action
 

+    val noneV : string -> (env_vars -> unit) -> action

     val oneV : string -> string * 'a arg -> (env_vars * 'a -> unit) -> action
     val twoV : string -> string * 'a arg * string * 'b arg -> (env_vars * 'a * 'b -> unit) -> action
 
     val oneV : string -> string * 'a arg -> (env_vars * 'a -> unit) -> action
     val twoV : string -> string * 'a arg * string * 'b arg -> (env_vars * 'a * 'b -> unit) -> action
 


@@ -80,6 +81,7 @@ signature ENV = sig
     val container_none : string -> (unit -> unit) * (unit -> unit) -> unit
     val container_one : string -> string * 'a arg -> ('a -> unit) * (unit -> unit) -> unit
 
     val container_none : string -> (unit -> unit) * (unit -> unit) -> unit
     val container_one : string -> string * 'a arg -> ('a -> unit) * (unit -> unit) -> unit
 

+    val containerV_none : string -> (env_vars -> unit) * (unit -> unit) -> unit

     val containerV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) * (unit -> unit) -> unit
 
     val registerFunction : string * (Ast.exp list -> Ast.exp option) -> unit
     val containerV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) * (unit -> unit) -> unit
 
     val registerFunction : string * (Ast.exp list -> Ast.exp option) -> unit

diff --git a/src/env.sml b/src/env.sml
index edb1ffd..ef710c1 100644 (file)
--- a/src/env.sml
+++ b/src/env.sml
@@ -149,6 +149,10 @@ fun three func (name1, arg1, name2, arg2, name3, arg3) f (_, [e1, e2, e3]) =
                                         SM.empty))
   | three func _ _ (_, es) = badArgs (func, es)
 
                                         SM.empty))
   | three func _ _ (_, es) = badArgs (func, es)
 

+fun noneV func f (evs, []) = (f evs;
+                             SM.empty)
+  | noneV func _ (_, es) = badArgs (func, es)
+

 fun oneV func (name, arg) f (evs, [e]) =
     (case arg e of
         NONE => badArg (func, name, e)
 fun oneV func (name, arg) f (evs, [e]) =
     (case arg e of
         NONE => badArg (func, name, e)


@@ -193,6 +197,7 @@ fun actionV_two name args f = registerAction (name, twoV name args f)
 fun container_none name (f, g) = registerContainer (name, none name f, g)
 fun container_one name args (f, g) = registerContainer (name, one name args f, g)
 
 fun container_none name (f, g) = registerContainer (name, none name f, g)
 fun container_one name args (f, g) = registerContainer (name, one name args f, g)
 

+fun containerV_none name (f, g) = registerContainer (name, noneV name f, g)

 fun containerV_one name args (f, g) = registerContainer (name, oneV name args f, g)
 
 type env = SS.set * (typ * exp option) SM.map * SS.set
 fun containerV_one name args (f, g) = registerContainer (name, oneV name args f, g)
 
 type env = SS.set * (typ * exp option) SM.map * SS.set

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index fda708e..7b8f68e 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -435,104 +435,110 @@ fun registerAliaser f =
        aliaser := (fn x => (old x; f x))
     end
 
        aliaser := (fn x => (old x; f x))
     end
 

-val () = Env.containerV_one "vhost"
-        ("host", Env.string)
-        (fn (env, host) =>
-            let
-                val places = Env.env (Env.list webPlace) (env, "WebPlaces")
-
-                val ssl = Env.env ssl (env, "SSL")
-                val user = Env.env Env.string (env, "User")
-                val group = Env.env Env.string (env, "Group")
-                val docroot = Env.env Env.string (env, "DocumentRoot")
-                val sadmin = Env.env Env.string (env, "ServerAdmin")
-                val suexec = Env.env Env.bool (env, "SuExec")
-
-                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
-                currentVhost := fullHost;
-                currentVhostId := vhostId;
-                sslEnabled := Option.isSome ssl;
-
-                rewriteEnabled := false;
-                localRewriteEnabled := false;
-                vhostFiles := map (fn (node, ip) =>
-                                      let
-                                          val file = Domain.domainFile {node = node,
-                                                                        name = confFile}
+fun vhostPost () = (!post ();
+                   write "</VirtualHost>\n";
+                   app (TextIO.closeOut o #2) (!vhostFiles))

 
 

-                                          val ld = logDir {user = user, node = node, vhostId = vhostId}
-                                      in
-                                          TextIO.output (file, "# Owner: ");
+fun vhostBody (env, makeFullHost) =
+    let
+       val places = Env.env (Env.list webPlace) (env, "WebPlaces")
+
+       val ssl = Env.env ssl (env, "SSL")
+       val user = Env.env Env.string (env, "User")
+       val group = Env.env Env.string (env, "Group")
+       val docroot = Env.env Env.string (env, "DocumentRoot")
+       val sadmin = Env.env Env.string (env, "ServerAdmin")
+       val suexec = Env.env Env.bool (env, "SuExec")
+
+       val fullHost = makeFullHost (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
+       currentVhost := fullHost;
+       currentVhostId := vhostId;
+       sslEnabled := Option.isSome ssl;
+
+       rewriteEnabled := false;
+       localRewriteEnabled := false;
+       vhostFiles := map (fn (node, ip) =>
+                             let
+                                 val file = Domain.domainFile {node = node,
+                                                               name = confFile}
+
+                                 val ld = logDir {user = user, node = node, vhostId = vhostId}
+                             in
+                                 TextIO.output (file, "# Owner: ");
+                                 TextIO.output (file, user);
+                                 TextIO.output (file, "\n<VirtualHost ");
+                                 TextIO.output (file, ip);
+                                 TextIO.output (file, ":");
+                                 TextIO.output (file, case ssl of
+                                                          SOME _ => "443"
+                                                        | NONE => "80");
+                                 TextIO.output (file, ">\n");
+                                 TextIO.output (file, "\tErrorLog ");
+                                 TextIO.output (file, ld);
+                                 TextIO.output (file, "/error.log\n\tCustomLog ");
+                                 TextIO.output (file, ld);
+                                 TextIO.output (file, "/access.log combined\n");
+                                 TextIO.output (file, "\tServerName ");
+                                 TextIO.output (file, fullHost);
+                                 app
+                                     (fn dom => (TextIO.output (file, "\n\tServerAlias ");
+                                                 TextIO.output (file, makeFullHost dom)))
+                                     (Domain.currentAliasDomains ());
+
+                                 if suexec then
+                                     if isVersion1 node then
+                                         (TextIO.output (file, "\n\tUser ");

                                           TextIO.output (file, user);
                                           TextIO.output (file, user);

-                                          TextIO.output (file, "\n<VirtualHost ");
-                                          TextIO.output (file, ip);
-                                          TextIO.output (file, ":");
-                                          TextIO.output (file, case ssl of
-                                                                   SOME _ => "443"
-                                                                 | NONE => "80");
-                                          TextIO.output (file, ">\n");
-                                          TextIO.output (file, "\tErrorLog ");
-                                          TextIO.output (file, ld);
-                                          TextIO.output (file, "/error.log\n\tCustomLog ");
-                                          TextIO.output (file, ld);
-                                          TextIO.output (file, "/access.log combined\n");
-                                          TextIO.output (file, "\tServerName ");
-                                          TextIO.output (file, fullHost);
-                                          app
-                                              (fn dom => (TextIO.output (file, "\n\tServerAlias ");
-                                                          TextIO.output (file, host);
-                                                          TextIO.output (file, ".");
-                                                          TextIO.output (file, dom)))
-                                              (Domain.currentAliasDomains ());
-
-                                          if suexec then
-                                              if isVersion1 node then
-                                                  (TextIO.output (file, "\n\tUser ");
-                                                   TextIO.output (file, user);
-                                                   TextIO.output (file, "\n\tGroup ");
-                                                   TextIO.output (file, group))
-                                              else
-                                                  (TextIO.output (file, "\n\tSuexecUserGroup ");
-                                                   TextIO.output (file, user);
-                                                   TextIO.output (file, " ");
-                                                   TextIO.output (file, group))
-                                          else
-                                              ();
-
-                                          if isWaklog node then
-                                              (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
-                                               TextIO.output (file, user);
-                                               TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
-                                               TextIO.output (file, user))
-                                          else
-                                              ();
-
-                                          TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
+                                          TextIO.output (file, "\n\tGroup ");
+                                          TextIO.output (file, group))
+                                     else
+                                         (TextIO.output (file, "\n\tSuexecUserGroup ");

                                           TextIO.output (file, user);
                                           TextIO.output (file, user);

-                                          TextIO.output (file, "/DAVLock");
+                                          TextIO.output (file, " ");
+                                          TextIO.output (file, group))
+                                 else
+                                     ();
+
+                                 if isWaklog node then
+                                     (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
+                                      TextIO.output (file, user);
+                                      TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
+                                      TextIO.output (file, user))
+                                 else
+                                     ();
+
+                                 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
+                                 TextIO.output (file, user);
+                                 TextIO.output (file, "/DAVLock");
+
+                                 (ld, file)
+                             end)
+                         places;
+       write "\n\tDocumentRoot ";
+       write docroot;
+       write "\n\tServerAdmin ";
+       write sadmin;
+       case ssl of
+           SOME cert =>
+           (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
+            write cert)
+         | NONE => ();
+       write "\n";
+       !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
+       app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
+    end    

 
 

-                                          (ld, file)
-                                      end)
-                                  places;
-                write "\n\tDocumentRoot ";
-                write docroot;
-                write "\n\tServerAdmin ";
-                write sadmin;
-                case ssl of
-                    SOME cert =>
-                    (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
-                     write cert)
-                  | NONE => ();
-                write "\n";
-                !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
-                app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
-            end,
-         fn () => (!post ();
-                   write "</VirtualHost>\n";
-                   app (TextIO.closeOut o #2) (!vhostFiles)))
+val () = Env.containerV_one "vhost"
+        ("host", Env.string)
+        (fn (env, host) => vhostBody (env, fn dom => host ^ "." ^ dom),
+         vhostPost)
+
+val () = Env.containerV_none "vhostDefault"
+        (fn env => vhostBody (env, fn dom => dom),
+         vhostPost)

 
 val inLocal = ref false
 
 
 val inLocal = ref false