X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/00a13ad8579e0ee0d950d3b944429551de3bf532..2a7d28185935059fcde6640765e6e35fc0368c1f:/src/plugins/apache.sml diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 3d7c199..1bb622b 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -25,9 +25,9 @@ open Ast val _ = Env.type_one "web_node" Env.string (fn node => - List.exists (fn x => x = node) Config.Apache.webNodes_all + 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)) + andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)) val _ = Env.registerFunction ("web_node_to_node", fn [e] => SOME e @@ -74,6 +74,19 @@ val _ = Env.type_one "location" Env.string validLocation +fun validCert s = Acl.query {user = Domain.getUser (), + class = "cert", + value = s} + +val _ = Env.type_one "ssl_cert_path" + Env.string + validCert + +fun ssl e = case e of + (EVar "no_ssl", _) => SOME NONE + | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s) + | _ => NONE + val dl = ErrorMsg.dummyLoc val _ = Defaults.registerDefault ("WebNodes", @@ -81,8 +94,8 @@ val _ = Defaults.registerDefault ("WebNodes", (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))) val _ = Defaults.registerDefault ("SSL", - (TBase "bool", dl), - (fn () => (EVar "false", dl))) + (TBase "ssl", dl), + (fn () => (EVar "no_ssl", dl))) val _ = Defaults.registerDefault ("User", (TBase "your_user", dl), @@ -94,7 +107,7 @@ val _ = Defaults.registerDefault ("Group", val _ = Defaults.registerDefault ("DocumentRoot", (TBase "your_path", dl), - (fn () => (EString (Config.homeBase ^ "/" ^ Domain.getUser () ^ "/" ^ Config.Apache.public_html), dl))) + (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))) val _ = Defaults.registerDefault ("ServerAdmin", (TBase "email", dl), @@ -102,8 +115,7 @@ val _ = Defaults.registerDefault ("ServerAdmin", val _ = Defaults.registerDefault ("SuExec", (TBase "suexec_flag", dl), - (fn () => (EApp ((EVar "suexec_flag", dl), - (EVar "true", dl)), dl))) + (fn () => (EVar "true", dl))) val redirect_code = fn (EVar "temp", _) => SOME "temp" | (EVar "permanent", _) => SOME "permanent" @@ -211,71 +223,116 @@ fun findVhostUser fname = in loop () before TextIO.closeIn inf - end + end handle _ => NONE + +val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin + +fun isVersion1 node = + List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node + | _ => false) webNodes_full + +fun imVersion1 () = isVersion1 (Slave.hostname ()) + +fun isWaklog node = + List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node + | _ => false) webNodes_full + +fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down +fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown +fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload + +fun logDir {user, node, vhostId} = + String.concat [Config.Apache.logDirOf (isVersion1 node) user, + "/", + node, + "/", + vhostId] val () = Slave.registerFileHandler (fn fs => let val spl = OS.Path.splitDirFile (#file fs) in if String.isSuffix ".vhost" (#file spl) - orelse String.isSuffix ".vhost_ssl" (#file spl) then - case findVhostUser (#file fs) of - NONE => print ("Can't find user in " ^ #file fs ^ "! Taking no action.\n") - | SOME user => - let - val realVhostFile = OS.Path.joinDirFile - {dir = Config.Apache.confDir, - file = #file spl} - - val realLogDir = OS.Path.joinDirFile - {dir = Config.homeBase, - file = user} - val realLogDir = OS.Path.joinDirFile - {dir = realLogDir, - file = "apache"} - val realLogDir = OS.Path.joinDirFile - {dir = realLogDir, - file = "log"} - val realLogDir = OS.Path.joinDirFile - {dir = realLogDir, - file = Slave.hostname ()} - val {base, ...} = OS.Path.splitBaseExt (#file spl) - val realLogDir = OS.Path.joinDirFile - {dir = realLogDir, - file = base} - in - vhostsChanged := true; - case #action fs of - Slave.Delete => - (if !logDeleted then - () - else - (ignore (OS.Process.system Config.Apache.down); - logDeleted := true); - ignore (OS.Process.system (Config.rm - ^ " -rf " - ^ realVhostFile)); - ignore (OS.Process.system (Config.rm - ^ " -rf " - ^ realLogDir))) - | Slave.Add => - (ignore (OS.Process.system (Config.cp - ^ " " - ^ #file fs - ^ " " - ^ realVhostFile)); - if Posix.FileSys.access (realLogDir, []) then - () - else - OS.FileSys.mkDir realLogDir) - - | _ => - ignore (OS.Process.system (Config.cp - ^ " " - ^ #file fs - ^ " " - ^ realVhostFile)) - end + orelse String.isSuffix ".vhost_ssl" (#file spl) then let + val realVhostFile = OS.Path.joinDirFile + {dir = Config.Apache.confDir, + file = #file spl} + + val user = findVhostUser (#file fs) + val oldUser = findVhostUser realVhostFile + in + if (oldUser = NONE andalso #action fs <> Slave.Add) + orelse (user = NONE andalso #action fs <> Slave.Delete) then + print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n") + else + let + val vhostId = if OS.Path.ext (#file spl) = SOME ".vhost_ssl" then + OS.Path.base (#file spl) ^ ".ssl" + else + OS.Path.base (#file spl) + + fun realLogDir user = + logDir {user = valOf user, + node = Slave.hostname (), + vhostId = vhostId} + in + vhostsChanged := true; + case #action fs of + Slave.Delete => + (if !logDeleted then + () + else + (ignore (OS.Process.system (down ())); + logDeleted := true); + ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ realVhostFile)); + ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ realLogDir oldUser))) + | Slave.Add => + let + val rld = realLogDir user + in + ignore (OS.Process.system (Config.cp + ^ " " + ^ #file fs + ^ " " + ^ realVhostFile)); + if Posix.FileSys.access (rld, []) then + () + else + Slave.mkDirAll rld + end + + | _ => + (ignore (OS.Process.system (Config.cp + ^ " " + ^ #file fs + ^ " " + ^ realVhostFile)); + if user <> oldUser then + let + val old = realLogDir oldUser + val rld = realLogDir user + in + if !logDeleted then + () + else + (ignore (OS.Process.system (down ())); + logDeleted := true); + ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ realLogDir oldUser)); + if Posix.FileSys.access (rld, []) then + () + else + Slave.mkDirAll rld + end + else + ()) + end + end else () end) @@ -283,7 +340,7 @@ val () = Slave.registerFileHandler (fn fs => val () = Slave.registerPostHandler (fn () => (if !vhostsChanged then - Slave.shellF ([if !logDeleted then Config.Apache.undown else Config.Apache.reload], + Slave.shellF ([if !logDeleted then undown () else reload ()], fn cl => "Error reloading Apache with " ^ cl) else ())) @@ -321,25 +378,22 @@ fun registerAliaser f = aliaser := (fn x => (old x; f x)) end -fun suexec_flag (EApp ((EVar "suexec_flag", _), e), _) = Env.bool e - | suexec_flag _ = NONE - val () = Env.containerV_one "vhost" ("host", Env.string) (fn (env, host) => let val nodes = Env.env (Env.list Env.string) (env, "WebNodes") - val ssl = Env.env Env.bool (env, "SSL") + 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 suexec_flag (env, "SuExec") + val suexec = Env.env Env.bool (env, "SuExec") val fullHost = host ^ "." ^ Domain.currentDomain () - val vhostId = fullHost ^ (if ssl then ".ssl" else "") - val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost") + 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; @@ -350,51 +404,57 @@ val () = Env.containerV_one "vhost" 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, Config.homeBase); - TextIO.output (file, "/"); - TextIO.output (file, user); - TextIO.output (file, "/apache/log/"); - TextIO.output (file, node); - TextIO.output (file, "/"); - TextIO.output (file, vhostId); + TextIO.output (file, ld); TextIO.output (file, "/error.log\n\tCustomLog "); - TextIO.output (file, Config.homeBase); - TextIO.output (file, "/"); - TextIO.output (file, user); - TextIO.output (file, "/apache/log/"); - TextIO.output (file, node); - TextIO.output (file, "/"); - TextIO.output (file, vhostId); + TextIO.output (file, ld); TextIO.output (file, "/access.log combined\n"); - (Config.homeBase ^ "/" ^ user ^ "/apache/log/" - ^ node ^ "/" ^ vhostId, file) + TextIO.output (file, "\tServerName "); + TextIO.output (file, fullHost); + 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\tWaklogProtected on\n\tWaklogPrincipal "); + TextIO.output (file, user); + TextIO.output (file, "/cgi@HCOOP.NET /etc/keytabs/cgi/"); + TextIO.output (file, user)) + else + (); + (ld, file) end) nodes; - write "\tServerName "; - write fullHost; - if suexec then - (write "\n\tSuexecUserGroup "; - write user; - write " "; - write group) - else - (); 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 = nodes, id = vhostId, hostname = fullHost} end,