X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/7f012ffdbae5dbee9642fee030647d558b25c8c4..7f75d83853b6dfe8b63ff78130b7107ce8af21a8:/src/plugins/apache.sml diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 23f8dd3..3550166 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -131,6 +131,42 @@ val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI" | (EVar "indexes", _) => SOME "Indexes" | _ => NONE +val autoindex_width = fn (EVar "autofit", _) => SOME "*" + | (EApp ((EVar "characters", _), n), _) => + Option.map Int.toString (Env.int n) + | _ => NONE + +val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) => + Option.map (fn w => ("DescriptionWidth", SOME w)) + (autoindex_width w) + | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE) + | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE) + | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE) + | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE) + | (EApp ((EVar "iconHeight", _), n), _) => + Option.map (fn w => ("IconHeight", SOME (Int.toString w))) + (Env.int n) + | (EApp ((EVar "iconWidth", _), n), _) => + Option.map (fn w => ("IconWidth", SOME (Int.toString w))) + (Env.int n) + | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE) + | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE) + | (EApp ((EVar "nameWidth", _), w), _) => + Option.map (fn w => ("NameWidth", SOME w)) + (autoindex_width w) + | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE) + | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE) + | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE) + | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE) + | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE) + | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE) + | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE) + | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE) + | (EVar "trackModified", _) => SOME ("TrackModified", NONE) + | (EVar "versionSort", _) => SOME ("VersionSort", NONE) + | (EVar "xhtml", _) => SOME ("XHTML", NONE) + + | _ => NONE val vhostsChanged = ref false @@ -146,11 +182,18 @@ val () = Slave.registerFileHandler (fn fs => (vhostsChanged := true; case #action fs of Slave.Delete => - ignore (OS.Process.system (Config.rm - ^ " -rf " - ^ Config.Apache.confDir - ^ "/" - ^ #file spl)) + (ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ Config.Apache.confDir + ^ "/" + ^ #file spl)); + ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ Config.Apache.logDir + ^ "/" + ^ #base (OS.Path.splitBaseExt + (#file spl))))) + | _ => ignore (OS.Process.system (Config.cp ^ " " @@ -175,6 +218,32 @@ val vhostFiles : TextIO.outstream list ref = ref [] fun write s = app (fn file => TextIO.output (file, s)) (!vhostFiles) val rewriteEnabled = ref false +val currentVhost = ref "" +val currentVhostId = ref "" + +val pre = ref (fn _ : {nodes : string list, id : string, hostname : string} => ()) +fun registerPre f = + let + val old = !pre + in + pre := (fn x => (old x; f x)) + end + +val post = ref (fn () => ()) +fun registerPost f = + let + val old = !post + in + post := (fn () => (old (); f ())) + end + +val aliaser = ref (fn _ : string => ()) +fun registerAliaser f = + let + val old = !aliaser + in + aliaser := (fn x => (old x; f x)) + end val () = Env.containerV_one "vhost" ("host", Env.string) @@ -189,8 +258,12 @@ val () = Env.containerV_one "vhost" val sadmin = Env.env Env.string (env, "ServerAdmin") val fullHost = host ^ "." ^ Domain.currentDomain () + val vhostId = fullHost ^ (if ssl then ".ssl" else "") val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost") in + currentVhost := fullHost; + currentVhostId := vhostId; + rewriteEnabled := false; vhostFiles := map (fn node => let @@ -218,9 +291,19 @@ val () = Env.containerV_one "vhost" write docroot; write "\n\tServerAdmin "; write sadmin; - write "\n" + write "\n\tErrorLog "; + write Config.Apache.logDir; + write "/"; + write vhostId; + write "/error.log\n\tCustomLog "; + write Config.Apache.logDir; + write "/"; + write vhostId; + write "/access.log combined\n"; + !pre {nodes = nodes, id = vhostId, hostname = fullHost} end, - fn () => (write "\n"; + fn () => (!post (); + write "\n"; app TextIO.closeOut (!vhostFiles))) val () = Env.container_one "location" @@ -310,6 +393,18 @@ val () = Env.action_three "rewriteCond" write "]"); write "\n")) +val () = Env.action_one "rewriteLogLevel" + ("level", Env.int) + (fn level => + (checkRewrite (); + write "\tRewriteLog "; + write Config.Apache.logDir; + write "/"; + write (!currentVhostId); + write "/rewrite.log\n\tRewriteLogLevel "; + write (Int.toString level); + write "\n")) + val () = Env.action_two "alias" ("from", Env.string, "to", Env.string) (fn (from, to) => @@ -376,7 +471,8 @@ val () = Env.action_one "serverAlias" (fn host => (write "\tServerAlias "; write host; - write "\n")) + write "\n"; + !aliaser host)) val authType = fn (EVar "basic", _) => SOME "basic" | (EVar "digest", _) => SOME "digest" @@ -483,4 +579,76 @@ val () = Env.action_one "addDefaultCharset" write ty; write "\n")) +val () = Env.action_one "davSvn" + ("path", Env.string) + (fn path => (write "\tDAV svn\n\tSVNPath "; + write path; + write "\n")) + +val () = Env.action_one "authzSvnAccessFile" + ("path", Env.string) + (fn path => (write "\tAuthzSVNAccessFile "; + write path; + write "\n")) + +val () = Env.action_two "addDescription" + ("description", Env.string, "patterns", Env.list Env.string) + (fn (desc, pats) => + case pats of + [] => () + | _ => (write "\tAddDescription \""; + write (String.toString desc); + write "\""; + app (fn pat => (write " "; write pat)) pats; + write "\n")) + +val () = Env.action_one "indexOptions" + ("options", Env.list autoindex_option) + (fn opts => + case opts of + [] => () + | _ => (write "\tIndexOptions"; + app (fn (opt, arg) => + (write " "; + write opt; + Option.app (fn arg => + (write "="; write arg)) arg)) opts; + write "\n")) + +val () = Env.action_one "set_indexOptions" + ("options", Env.list autoindex_option) + (fn opts => + case opts of + [] => () + | _ => (write "\tIndexOptions"; + app (fn (opt, arg) => + (write " +"; + write opt; + Option.app (fn arg => + (write "="; write arg)) arg)) opts; + write "\n")) + +val () = Env.action_one "unset_indexOptions" + ("options", Env.list autoindex_option) + (fn opts => + case opts of + [] => () + | _ => (write "\tIndexOptions"; + app (fn (opt, _) => + (write " -"; + write opt)) opts; + write "\n")) + +val () = Env.action_one "headerName" + ("name", Env.string) + (fn name => (write "\tHeaderName "; + write name; + write "\n")) + +val () = Env.action_one "readmeName" + ("name", Env.string) + (fn name => (write "\tReadmeName "; + write name; + write "\n")) + end