X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/bcf547ec38a7ed4b80ac1b657b812d01a5b4ba6c..ffd50ec73c2d9582ef782bae84aa38af5c8a514a:/src/plugins/apache.sml diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 97bfc69..ec41103 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -68,13 +68,19 @@ val _ = Env.type_one "proxy_target" fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets in case String.fields (fn ch => ch = #":") s of - ["http", "//localhost", rest] => - (case String.fields (fn ch => ch = #"/") rest of - port :: _ => - (case Int.fromString port of - NONE => default () - | SOME n => n > 1024 orelse default ()) - | _ => default ()) + "http" :: "//localhost" :: rest => + let + val rest = String.concatWith ":" rest + in + CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch) + andalso ch <> #"\"" andalso ch <> #"'") rest + andalso case String.fields (fn ch => ch = #"/") rest of + port :: _ => + (case Int.fromString port of + NONE => default () + | SOME n => n > 1024 orelse default ()) + | _ => default () + end | _ => default () end) @@ -145,7 +151,10 @@ val defaults = [("WebPlaces", (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))), ("SuExec", (TBase "suexec_flag", dl), - (fn () => (EVar "true", dl)))] + (fn () => (EVar "true", dl))), + ("PhpVersion", + (TBase "php_version", dl), + (fn () => (EVar "php4", dl)))] val () = app Defaults.registerDefault defaults @@ -234,10 +243,12 @@ val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) => val vhostsChanged = ref false val logDeleted = ref false +val delayedLogMoves = ref (fn () => ()) val () = Slave.registerPreHandler (fn () => (vhostsChanged := false; - logDeleted := false)) + logDeleted := false; + delayedLogMoves := (fn () => print "Executing delayed log moves/deletes.\n"))) fun findVhostUser fname = let @@ -330,18 +341,20 @@ val () = Slave.registerFileHandler (fn fs => Slave.Delete _ => let val ldir = realLogDir oldUser + val dlm = !delayedLogMoves in if !logDeleted then () else - (ignore (OS.Process.system (down ())); + ((*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 ()} + delayedLogMoves := (fn () => (dlm (); + Slave.moveDirCreate {from = ldir, + to = backupLogs ()})) end | Slave.Add => let @@ -369,15 +382,18 @@ val () = Slave.registerFileHandler (fn fs => let val old = realLogDir oldUser val rld = realLogDir user + + val dlm = !delayedLogMoves in if !logDeleted then () else - (ignore (OS.Process.system (down ())); + ((*ignore (OS.Process.system (down ()));*) logDeleted := true); - ignore (OS.Process.system (Config.rm - ^ " -rf " - ^ realLogDir oldUser)); + delayedLogMoves := (fn () => (dlm (); + ignore (OS.Process.system (Config.rm + ^ " -rf " + ^ realLogDir oldUser)))); if Posix.FileSys.access (rld, []) then () else @@ -394,8 +410,9 @@ val () = Slave.registerFileHandler (fn fs => val () = Slave.registerPostHandler (fn () => (if !vhostsChanged then - Slave.shellF ([if !logDeleted then undown () else reload ()], - fn cl => "Error reloading Apache with " ^ cl) + (Slave.shellF ([reload ()], + fn cl => "Error reloading Apache with " ^ cl); + if !logDeleted then !delayedLogMoves () else ()) else ())) @@ -440,6 +457,10 @@ fun vhostPost () = (!post (); write "\n"; app (TextIO.closeOut o #2) (!vhostFiles)) +val php_version = fn (EVar "php4", _) => SOME 4 + | (EVar "php5", _) => SOME 5 + | _ => NONE + fun vhostBody (env, makeFullHost) = let val places = Env.env (Env.list webPlace) (env, "WebPlaces") @@ -450,6 +471,7 @@ fun vhostBody (env, makeFullHost) = 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 php = Env.env php_version (env, "PhpVersion") val fullHost = makeFullHost (Domain.currentDomain ()) val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "") @@ -515,6 +537,13 @@ fun vhostBody (env, makeFullHost) = TextIO.output (file, user); TextIO.output (file, "/DAVLock"); + if php <> Config.Apache.defaultPhpVersion then + (TextIO.output (file, "\n\tAddHandler x-httpd-php"); + TextIO.output (file, Int.toString php); + TextIO.output (file, " .php .phtml")) + else + (); + (ld, file) end) places; @@ -582,9 +611,9 @@ val () = Env.action_three "localProxyRewrite" ("from", Env.string, "to", Env.string, "port", Env.int) (fn (from, to, port) => (checkRewrite (); - write "\tRewriteRule\t"; + write "\tRewriteRule\t\""; write from; - write "\thttp://localhost:"; + write "\"\thttp://localhost:"; write (Int.toString port); write "/"; write to; @@ -612,10 +641,11 @@ val () = Env.action_three "rewriteRule" ("from", Env.string, "to", Env.string, "flags", Env.list flag) (fn (from, to, flags) => (checkRewrite (); - write "\tRewriteRule\t"; + write "\tRewriteRule\t\""; write from; - write "\t"; + write "\"\t\""; write to; + write "\""; case flags of [] => () | flag::rest => (write " ["; @@ -629,10 +659,11 @@ val () = Env.action_three "rewriteCond" ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag) (fn (from, to, flags) => (checkRewrite (); - write "\tRewriteCond\t"; + write "\tRewriteCond\t\""; write from; - write "\t"; + write "\"\t\""; write to; + write "\""; case flags of [] => () | flag::rest => (write " ["; @@ -646,9 +677,9 @@ val () = Env.action_one "rewriteBase" ("prefix", Env.string) (fn prefix => (checkRewrite (); - write "\tRewriteBase\t"; + write "\tRewriteBase\t\""; write prefix; - write "\n")) + write "\"\n")) val () = Env.action_one "rewriteLogLevel" ("level", Env.int) @@ -914,6 +945,17 @@ val () = Env.action_two "addDescription" app (fn pat => (write " "; write pat)) pats; write "\n")) +val () = Env.action_two "addIcon" + ("icon", Env.string, "patterns", Env.list Env.string) + (fn (icon, pats) => + case pats of + [] => () + | _ => (write "\tAddIcon \""; + write icon; + write "\""; + app (fn pat => (write " "; write pat)) pats; + write "\n")) + val () = Env.action_one "indexOptions" ("options", Env.list autoindex_option) (fn opts => @@ -927,6 +969,15 @@ val () = Env.action_one "indexOptions" (write "="; write arg)) arg)) opts; write "\n")) +val () = Env.action_one "indexIgnore" + ("patterns", Env.list Env.string) + (fn pats => + case pats of + [] => () + | _ => (write "\tIndexIgnore"; + app (fn pat => (write " "; write pat)) pats; + write "\n")) + val () = Env.action_one "set_indexOptions" ("options", Env.list autoindex_option) (fn opts => @@ -978,10 +1029,6 @@ val () = Env.action_one "diskCache" write path; write "\"\n")) -val php_version = fn (EVar "php4", _) => SOME 4 - | (EVar "php5", _) => SOME 5 - | _ => NONE - val () = Env.action_one "phpVersion" ("version", php_version) (fn version => (write "\tAddHandler x-httpd-php"; @@ -1019,4 +1066,7 @@ val () = Domain.registerDescriber (Domain.considerAll Domain.Extension {extension = "vhost_ssl", heading = fn host => "SSL web vhost " ^ host ^ ":"}]) +val () = Env.action_none "testNoHtaccess" + (fn path => write "\tAllowOverride None\n") + end