From 57e066bb6c8ab3b21df9d16d35f6877659bf868b Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Dec 2007 22:34:31 +0000 Subject: [PATCH] vhostDefault --- lib/apache.dtl | 11 +++ src/env.sig | 2 + src/env.sml | 5 ++ src/plugins/apache.sml | 194 +++++++++++++++++++++-------------------- 4 files changed, 118 insertions(+), 94 deletions(-) diff --git a/lib/apache.dtl b/lib/apache.dtl index f176787..ed6f8b1 100644 --- 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.}} +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 vhost, but for, e.g., yourdomain.com instead of + www.yourdomain.com}} + context Location; extern type location; diff --git a/src/env.sig b/src/env.sig index 023813a..0a50620 100644 --- 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 + 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 @@ -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 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 diff --git a/src/env.sml b/src/env.sml index edb1ffd..ef710c1 100644 --- 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) +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) @@ -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 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 diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index fda708e..7b8f68e 100644 --- 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 -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 "\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 "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, "\n "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, "/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 "\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 -- 2.20.1