X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c17d0537db6e55a6b2bbd1a459542a5fbb44a68f..22eaa9503ea59b2fcfb94323f802977021027b0f:/src/plugins/apache.sml diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 4e07e4e..e81792a 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -22,17 +22,41 @@ 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" + andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin) + val _ = Env.type_one "web_node" Env.string - (fn node => - List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all - orelse (Domain.hasPriv "www" - andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)) + webNode val _ = Env.registerFunction ("web_node_to_node", fn [e] => SOME e | _ => NONE) +fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) = + SOME (node, Domain.nodeIp node) + | webPlace (EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _) = + SOME (node, ip) + | webPlace _ = NONE + +fun webPlaceDefault node = (EApp ((EVar "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) @@ -87,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))), @@ -156,6 +178,7 @@ val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC" val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI" | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC" | (EVar "indexes", _) => SOME "Indexes" + | (EVar "followSymLinks", _) => SOME "FollowSymLinks" | _ => NONE val autoindex_width = fn (EVar "autofit", _) => SOME "*" @@ -245,6 +268,13 @@ fun logDir {user, node, vhostId} = "/", vhostId] +fun realLogDir {user, node, vhostId} = + String.concat [Config.Apache.realLogDirOf user, + "/", + node, + "/", + vhostId] + val () = Slave.registerFileHandler (fn fs => let val spl = OS.Path.splitDirFile (#file fs) @@ -256,10 +286,12 @@ val () = Slave.registerFileHandler (fn fs => file = #file spl} val user = findVhostUser (#file fs) - val oldUser = findVhostUser realVhostFile + val oldUser = case #action fs of + Slave.Delete false => user + | _ => findVhostUser realVhostFile in if (oldUser = NONE andalso #action fs <> Slave.Add) - orelse (user = NONE andalso #action fs <> Slave.Delete) then + orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n") else let @@ -281,7 +313,7 @@ val () = Slave.registerFileHandler (fn fs => in vhostsChanged := true; case #action fs of - Slave.Delete => + Slave.Delete _ => let val ldir = realLogDir oldUser in @@ -379,6 +411,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 @@ -391,7 +426,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") @@ -410,7 +445,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} @@ -420,7 +455,7 @@ val () = Env.containerV_one "vhost" TextIO.output (file, "# Owner: "); TextIO.output (file, user); TextIO.output (file, "\n "443" @@ -468,7 +503,7 @@ val () = Env.containerV_one "vhost" (ld, file) end) - nodes; + places; write "\n\tDocumentRoot "; write docroot; write "\n\tServerAdmin "; @@ -479,7 +514,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 (); @@ -512,7 +547,7 @@ val () = Env.container_one "directory" fun checkRewrite () = if !inLocal then - if !rewriteEnabled orelse !localRewriteEnabled then + if !localRewriteEnabled then () else (write "\tRewriteEngine on\n"; @@ -626,12 +661,24 @@ val () = Env.action_two "scriptAlias" val () = Env.action_two "errorDocument" ("code", Env.string, "handler", Env.string) (fn (code, handler) => - (write "\tErrorDocument\t"; - write code; - write " "; - write handler; - write "\n")) + let + val hasSpaces = CharVector.exists Char.isSpace handler + fun maybeQuote () = + if hasSpaces then + write "\"" + else + () + in + write "\tErrorDocument\t"; + write code; + write " "; + maybeQuote (); + write handler; + maybeQuote (); + write "\n" + end) + val () = Env.action_one "options" ("options", Env.list apache_option) (fn opts => @@ -904,8 +951,8 @@ val () = Domain.registerResetLocal (fn () => val () = Domain.registerDescriber (Domain.considerAll [Domain.Extension {extension = "vhost", - heading = fn host => "Web vhost " ^ host}, + heading = fn host => "Web vhost " ^ host ^ ":"}, Domain.Extension {extension = "vhost_ssl", - heading = fn host => "SSL web vhost " ^ host}]) + heading = fn host => "SSL web vhost " ^ host ^ ":"}]) end