X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/5cab5a9811e767a649e57b4012fbc19635dae11e..1638d5a206cd79e9619f0d3334fed29eaddc6b51:/src/plugins/apache.sml diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index e5fe47b..765d696 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -1,5 +1,5 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) - * Copyright (c) 2006, Adam Chlipala + * Copyright (c) 2006-2007, Adam Chlipala * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -89,33 +89,29 @@ fun ssl e = case e of val dl = ErrorMsg.dummyLoc -val _ = Defaults.registerDefault ("WebNodes", - (TList (TBase "web_node", dl), dl), - (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))) - -val _ = Defaults.registerDefault ("SSL", - (TBase "ssl", dl), - (fn () => (EVar "no_ssl", dl))) - -val _ = Defaults.registerDefault ("User", - (TBase "your_user", dl), - (fn () => (EString (Domain.getUser ()), dl))) - -val _ = Defaults.registerDefault ("Group", - (TBase "your_group", dl), - (fn () => (EString (Domain.getUser ()), dl))) - -val _ = Defaults.registerDefault ("DocumentRoot", - (TBase "your_path", dl), - (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))) - -val _ = Defaults.registerDefault ("ServerAdmin", - (TBase "email", dl), - (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))) - -val _ = Defaults.registerDefault ("SuExec", - (TBase "suexec_flag", dl), - (fn () => (EVar "true", dl))) +val defaults = [("WebNodes", + (TList (TBase "web_node", dl), dl), + (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))), + ("SSL", + (TBase "ssl", dl), + (fn () => (EVar "no_ssl", dl))), + ("User", + (TBase "your_user", dl), + (fn () => (EString (Domain.getUser ()), dl))), + ("Group", + (TBase "your_group", dl), + (fn () => (EString "nogroup", dl))), + ("DocumentRoot", + (TBase "your_path", dl), + (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))), + ("ServerAdmin", + (TBase "email", dl), + (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))), + ("SuExec", + (TBase "suexec_flag", dl), + (fn () => (EVar "true", dl)))] + +val () = app Defaults.registerDefault defaults val redirect_code = fn (EVar "temp", _) => SOME "temp" | (EVar "permanent", _) => SOME "permanent" @@ -240,6 +236,7 @@ fun isWaklog node = 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 fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms fun logDir {user, node, vhostId} = String.concat [Config.Apache.logDirOf (isVersion1 node) user, @@ -262,7 +259,7 @@ val () = Slave.registerFileHandler (fn fs => val oldUser = 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 @@ -275,21 +272,31 @@ val () = Slave.registerFileHandler (fn fs => logDir {user = valOf user, node = Slave.hostname (), vhostId = vhostId} + + fun backupLogs () = + OS.Path.joinDirFile + {dir = Config.Apache.backupLogDirOf + (isVersion1 (Slave.hostname ())), + file = 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.Delete _ => + let + val ldir = realLogDir oldUser + in + if !logDeleted then + () + else + (ignore (OS.Process.system (down ())); + ignore (OS.Process.system (fixperms ())); + logDeleted := true); + ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ realVhostFile)); + Slave.moveDirCreate {from = ldir, + to = backupLogs ()} + end | Slave.Add => let val rld = realLogDir user @@ -302,7 +309,8 @@ val () = Slave.registerFileHandler (fn fs => if Posix.FileSys.access (rld, []) then () else - Slave.mkDirAll rld + Slave.moveDirCreate {from = backupLogs (), + to = rld} end | _ => @@ -353,6 +361,7 @@ val rewriteEnabled = ref false val localRewriteEnabled = ref false val currentVhost = ref "" val currentVhostId = ref "" +val sslEnabled = ref false val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ()) fun registerPre f = @@ -397,6 +406,7 @@ val () = Env.containerV_one "vhost" in currentVhost := fullHost; currentVhostId := vhostId; + sslEnabled := Option.isSome ssl; rewriteEnabled := false; localRewriteEnabled := false; @@ -429,6 +439,7 @@ val () = Env.containerV_one "vhost" TextIO.output (file, "."); TextIO.output (file, dom))) (Domain.currentAliasDomains ()); + if suexec then if isVersion1 node then (TextIO.output (file, "\n\tUser "); @@ -442,13 +453,19 @@ val () = Env.containerV_one "vhost" TextIO.output (file, group)) else (); + if isWaklog node then - (TextIO.output (file, "\n\tWaklogProtected on\n\tWaklogPrincipal "); + (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal "); TextIO.output (file, user); - TextIO.output (file, "/cgi@HCOOP.NET /etc/keytabs/cgi/"); + 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) nodes; @@ -570,6 +587,14 @@ val () = Env.action_three "rewriteCond" write "]"); write "\n")) +val () = Env.action_one "rewriteBase" + ("prefix", Env.string) + (fn prefix => + (checkRewrite (); + write "\tRewriteBase\t"; + write prefix; + write "\n")) + val () = Env.action_one "rewriteLogLevel" ("level", Env.int) (fn level => @@ -676,14 +701,25 @@ val () = Env.action_none "serverAliasDefault" val authType = fn (EVar "basic", _) => SOME "basic" | (EVar "digest", _) => SOME "digest" + | (EVar "kerberos", _) => SOME "kerberos" | _ => NONE +fun allowAuthType "kerberos" = !sslEnabled + | allowAuthType _ = true + val () = Env.action_one "authType" ("type", authType) (fn ty => - (write "\tAuthType "; - write ty; - write "\n")) + if allowAuthType ty then + (write "\tAuthType "; + write ty; + write "\n"; + case ty of + "kerberos" => + write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n" + | _ => ()) + else + print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n") val () = Env.action_one "authName" ("name", Env.string) @@ -791,6 +827,9 @@ val () = Env.action_one "authzSvnAccessFile" write path; write "\n"))*) +val () = Env.action_none "davFilesystem" + (fn path => write "\tDAV filesystem\n") + val () = Env.action_two "addDescription" ("description", Env.string, "patterns", Env.list Env.string) (fn (desc, pats) => @@ -851,7 +890,22 @@ val () = Env.action_one "readmeName" write name; write "\n")) +val () = Env.action_two "setEnv" + ("key", Env.string, "value", Env.string) + (fn (key, value) => (write "\tSetEnv \""; + write key; + write "\" \""; + write (String.translate (fn #"\"" => "\\\"" + | ch => str ch) value); + write "\"\n")) + val () = Domain.registerResetLocal (fn () => ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*"))) +val () = Domain.registerDescriber (Domain.considerAll + [Domain.Extension {extension = "vhost", + heading = fn host => "Web vhost " ^ host}, + Domain.Extension {extension = "vhost_ssl", + heading = fn host => "SSL web vhost " ^ host}]) + end