HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
mysql: revoke permissions when dropping database
[hcoop/domtool2.git] / src / plugins / apache.sml
CommitLineData
8a7c40fa 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
fb09779a 2 * Copyright (c) 2006-2009, Adam Chlipala
129d3b57 3 * Copyright (c) 2013,2014,2015,2017,2018,2019 Clinton Ebadi
8a7c40fa
AC		 4 *
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License
7 * as published by the Free Software Foundation; either version 2
8 * of the License, or (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 *)
19
20(* Apache HTTPD handling *)
21
22structure Apache :> APACHE = struct
23
24open Ast
25
128e7b0b
AC		 26val dl = ErrorMsg.dummyLoc
27
de5351c7
AC		 28fun webNode node =
29 List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
30 orelse (Domain.hasPriv "www"
31 andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)
32
60695e99
AC		 33val _ = Env.type_one "web_node"
34 Env.string
de5351c7 35 webNode
60695e99 36
ce01b51a
AC		 37val _ = Env.registerFunction ("web_node_to_node",
38 fn [e] => SOME e
39 | _ => NONE)
40
b5f2d506 41fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
f924c1cf
CE		 42 SOME (node, Domain.nodeIp node, Domain.nodeIpv6 node)
43 | webPlace (EApp ((EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _), (EString ipv6, _)), _) =
44 SOME (node, ip, ipv6)
128e7b0b
AC		 45 | webPlace _ = NONE
46
b5f2d506 47fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
128e7b0b
AC		 48
49val _ = Env.registerFunction ("web_place_to_web_node",
f924c1cf 50 fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
128e7b0b
AC		 51 | _ => NONE)
52
53val _ = Env.registerFunction ("web_place_to_node",
f924c1cf 54 fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
128e7b0b
AC		 55 | _ => NONE)
56
57val _ = Env.registerFunction ("web_place_to_ip",
f924c1cf
CE		 58 fn [e] => Option.map (fn (_, ip, _) => (EString ip, dl)) (webPlace e)
59 | _ => NONE)
60
61val _ = Env.registerFunction ("web_place_to_ipv6",
62 fn [e] => Option.map (fn (_, _, ipv6) => (EString ipv6, dl)) (webPlace e)
63 | _ => NONE)
128e7b0b 64
f8dfbbcc
AC		 65val _ = Env.type_one "proxy_port"
66 Env.int
e95a129e
AC		 67 (fn n => n > 1024)
68
621629dc
CE		 69fun validProxyTarget default s =
70 case String.fields (fn ch => ch = #":") s of
71 "http" :: host :: rest =>
72 let
73 val rest = String.concatWith ":" rest
74 in
75 if List.exists (fn h' => host = h') (map (fn h => String.concat ["//", h]) Config.Apache.proxyHosts)
76 then
77 CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
78 andalso ch <> #"\"" andalso ch <> #"'") rest
79 andalso case String.fields (fn ch => ch = #"/") rest of
80 port :: _ =>
81 (case Int.fromString port of
82 NONE => default s
83 | SOME n => n > 1024 orelse default s)
84 | _ => default s
85 else
86 default s
87 end
88 | _ => default s
89
e95a129e
AC		 90val _ = Env.type_one "proxy_target"
91 Env.string
621629dc
CE		 92 (validProxyTarget (fn s => List.exists (fn s' => s = s') (Config.Apache.proxyTargets @ ["!"])))
93
94val _ = Env.type_one "proxy_reverse_target"
95 Env.string
96 (validProxyTarget (fn s => List.exists (fn s' => s = s') Config.Apache.proxyTargets))
f8dfbbcc
AC		 97
98val _ = Env.type_one "rewrite_arg"
99 Env.string
066b8ca7
CE		 100 (* #":" is permitted here, but really ought to be disallowed or escaped for E=VAR:VAL *)
101 (CharVector.all (fn ch => (Char.isGraph ch) andalso not (List.exists (fn c => ch = c) [ #"[", #"]", #",", #"\"", #"'", #"=", #"\\" ])))
f8dfbbcc 102
00a13ad8
AC		 103val _ = Env.type_one "suexec_flag"
104 Env.bool
105 (fn b => b orelse Domain.hasPriv "www")
106
931aae14
AC		 107val _ = Env.type_one "regexp"
108 Env.string
109 Pcre.validRegexp
110
2882ee37
AC		 111fun validLocation s =
112 size s > 0 andalso size s < 1000 andalso CharVector.all
113 (fn ch => Char.isAlphaNum ch
114 orelse ch = #"-"
115 orelse ch = #"_"
116 orelse ch = #"."
666ed674
AC		 117 orelse ch = #"/"
118 orelse ch = #"~") s
2882ee37
AC		 119
120val _ = Env.type_one "location"
121 Env.string
122 validLocation
123
434a7b1f
AC		 124fun validCert s = Acl.query {user = Domain.getUser (),
125 class = "cert",
126 value = s}
127
ef5ad69a
CE		 128fun validCaCert s = Acl.query {user = Domain.getUser (),
129 class = "cacert",
130 value = s}
131
434a7b1f
AC		 132val _ = Env.type_one "ssl_cert_path"
133 Env.string
134 validCert
135
ef5ad69a
CE		 136val _ = Env.type_one "ssl_cacert_path"
137 Env.string
138 validCaCert
139
434a7b1f
AC		 140fun ssl e = case e of
141 (EVar "no_ssl", _) => SOME NONE
142 | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
143 | _ => NONE
144
781ebc11
AC		 145fun validExtension s =
146 size s > 0
147 andalso size s < 20
148 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") s
149
150val _ = Env.type_one "file_extension"
151 Env.string
152 validExtension
153
d08b9cf2
CE		 154val _ = Env.registerFunction ("defaultServerAdmin",
155 fn [] => SOME (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)
156 | _ => NONE)
f8dfbbcc
AC		 157
158val redirect_code = fn (EVar "temp", _) => SOME "temp"
159 | (EVar "permanent", _) => SOME "permanent"
160 | (EVar "seeother", _) => SOME "seeother"
161 | (EVar "redir300", _) => SOME "300"
162 | (EVar "redir301", _) => SOME "301"
163 | (EVar "redir302", _) => SOME "302"
164 | (EVar "redir303", _) => SOME "303"
165 | (EVar "redir304", _) => SOME "304"
166 | (EVar "redir305", _) => SOME "305"
167 | (EVar "redir307", _) => SOME "307"
7e588778 168 | (EVar "notfound", _) => SOME "404"
f8dfbbcc
AC		 169 | _ => NONE
170
171val flag = fn (EVar "redirect", _) => SOME "R"
172 | (EVar "forbidden", _) => SOME "F"
173 | (EVar "gone", _) => SOME "G"
174 | (EVar "last", _) => SOME "L"
175 | (EVar "chain", _) => SOME "C"
176 | (EVar "nosubreq", _) => SOME "NS"
177 | (EVar "nocase", _) => SOME "NC"
178 | (EVar "qsappend", _) => SOME "QSA"
179 | (EVar "noescape", _) => SOME "NE"
180 | (EVar "passthrough", _) => SOME "PT"
181 | (EApp ((EVar "mimeType", _), e), _) =>
182 Option.map (fn s => "T=" ^ s) (Env.string e)
183 | (EApp ((EVar "redirectWith", _), e), _) =>
184 Option.map (fn s => "R=" ^ s) (redirect_code e)
185 | (EApp ((EVar "skip", _), e), _) =>
186 Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
187 | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
188 (case Env.string e1 of
189 NONE => NONE
190 | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
191 (Env.string e2))
192
193 | _ => NONE
194
e95a129e
AC		 195val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
196 | (EVar "ornext", _) => SOME "OR"
197 | _ => NONE
198
d441e69f
AC		 199val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
200 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
201 | (EVar "indexes", _) => SOME "Indexes"
22eaa950 202 | (EVar "followSymLinks", _) => SOME "FollowSymLinks"
c6923cdb 203 | (EVar "multiViews", _) => SOME "MultiViews"
d441e69f
AC		 204 | _ => NONE
205
9d7fa346
AC		 206val autoindex_width = fn (EVar "autofit", _) => SOME "*"
207 | (EApp ((EVar "characters", _), n), _) =>
208 Option.map Int.toString (Env.int n)
209 | _ => NONE
210
211val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
212 Option.map (fn w => ("DescriptionWidth", SOME w))
213 (autoindex_width w)
214 | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE)
215 | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE)
216 | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE)
217 | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE)
218 | (EApp ((EVar "iconHeight", _), n), _) =>
219 Option.map (fn w => ("IconHeight", SOME (Int.toString w)))
220 (Env.int n)
221 | (EApp ((EVar "iconWidth", _), n), _) =>
222 Option.map (fn w => ("IconWidth", SOME (Int.toString w)))
223 (Env.int n)
224 | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE)
225 | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE)
226 | (EApp ((EVar "nameWidth", _), w), _) =>
227 Option.map (fn w => ("NameWidth", SOME w))
228 (autoindex_width w)
229 | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE)
230 | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE)
231 | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE)
232 | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE)
233 | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE)
234 | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE)
235 | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE)
236 | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE)
237 | (EVar "trackModified", _) => SOME ("TrackModified", NONE)
238 | (EVar "versionSort", _) => SOME ("VersionSort", NONE)
239 | (EVar "xhtml", _) => SOME ("XHTML", NONE)
240
241 | _ => NONE
f8dfbbcc 242
fb09779a
AC		 243val interval_base = fn (EVar "access", _) => SOME "access"
244 | (EVar "modification", _) => SOME "modification"
245 | _ => NONE
246
247val interval = fn (EVar "years", _) => SOME "years"
248 | (EVar "months", _) => SOME "months"
249 | (EVar "weeks", _) => SOME "weeks"
250 | (EVar "days", _) => SOME "days"
251 | (EVar "hours", _) => SOME "hours"
252 | (EVar "minutes", _) => SOME "minutes"
253 | (EVar "seconds", _) => SOME "seconds"
254 | _ => NONE
255
8a7c40fa 256val vhostsChanged = ref false
8e965b2d 257val logDeleted = ref false
ffd50ec7 258val delayedLogMoves = ref (fn () => ())
8a7c40fa
AC		 259
260val () = Slave.registerPreHandler
8e965b2d 261 (fn () => (vhostsChanged := false;
ffd50ec7
AC		 262 logDeleted := false;
263 delayedLogMoves := (fn () => print "Executing delayed log moves/deletes.\n")))
8a7c40fa 264
7db53a0b
AC		 265fun findVhostUser fname =
266 let
267 val inf = TextIO.openIn fname
268
269 fun loop () =
270 case TextIO.inputLine inf of
271 NONE => NONE
272 | SOME line =>
00a13ad8
AC		 273 if String.isPrefix "# Owner: " line then
274 case String.tokens Char.isSpace line of
275 [_, _, user] => SOME user
276 | _ => NONE
277 else
278 loop ()
7db53a0b
AC		 279 in
280 loop ()
281 before TextIO.closeIn inf
3a941c29 282 end handle _ => NONE
7db53a0b 283
55d4a268
AC		 284val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
285
286fun isVersion1 node =
f8ef6c20
AC		 287 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
288 | _ => false) webNodes_full
55d4a268
AC		 289
290fun imVersion1 () = isVersion1 (Slave.hostname ())
291
f8ef6c20
AC		 292fun isWaklog node =
293 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
294 | _ => false) webNodes_full
295
55d4a268
AC		 296fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
297fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
298fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
c17d0537 299fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
55d4a268 300
b59d9074 301fun logDir {user, node, vhostId} =
2a7d2818 302 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
409542d7 303 "/",
b59d9074
AC		 304 node,
305 "/",
306 vhostId]
307
f086616f
AC		 308fun realLogDir {user, node, vhostId} =
309 String.concat [Config.Apache.realLogDirOf user,
310 "/",
311 node,
312 "/",
313 vhostId]
314
8a7c40fa 315val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 316 let
317 val spl = OS.Path.splitDirFile (#file fs)
318 in
319 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 320 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
321 val realVhostFile = OS.Path.joinDirFile
322 {dir = Config.Apache.confDir,
323 file = #file spl}
324
325 val user = findVhostUser (#file fs)
19026493
AC		 326 val oldUser = case #action fs of
327 Slave.Delete false => user
328 | _ => findVhostUser realVhostFile
3a941c29
AC		 329 in
330 if (oldUser = NONE andalso #action fs <> Slave.Add)
1638d5a2 331 orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
3a941c29
AC		 332 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
333 else
334 let
5b07cebd 335 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
b59d9074
AC		 336 OS.Path.base (#file spl) ^ ".ssl"
337 else
338 OS.Path.base (#file spl)
339
3a941c29 340 fun realLogDir user =
b59d9074
AC		 341 logDir {user = valOf user,
342 node = Slave.hostname (),
343 vhostId = vhostId}
c17d0537
AC		 344
345 fun backupLogs () =
346 OS.Path.joinDirFile
347 {dir = Config.Apache.backupLogDirOf
348 (isVersion1 (Slave.hostname ())),
349 file = vhostId}
3a941c29
AC		 350 in
351 vhostsChanged := true;
352 case #action fs of
1638d5a2 353 Slave.Delete _ =>
31b50af0
AC		 354 let
355 val ldir = realLogDir oldUser
ffd50ec7 356 val dlm = !delayedLogMoves
31b50af0
AC		 357 in
358 if !logDeleted then
359 ()
360 else
ffd50ec7 361 ((*ignore (OS.Process.system (down ()));*)
c17d0537 362 ignore (OS.Process.system (fixperms ()));
31b50af0
AC		 363 logDeleted := true);
364 ignore (OS.Process.system (Config.rm
365 ^ " -rf "
366 ^ realVhostFile));
ffd50ec7
AC		 367 delayedLogMoves := (fn () => (dlm ();
368 Slave.moveDirCreate {from = ldir,
369 to = backupLogs ()}))
31b50af0 370 end
3a941c29
AC		 371 | Slave.Add =>
372 let
373 val rld = realLogDir user
374 in
375 ignore (OS.Process.system (Config.cp
376 ^ " "
377 ^ #file fs
378 ^ " "
379 ^ realVhostFile));
380 if Posix.FileSys.access (rld, []) then
381 ()
382 else
c17d0537 383 Slave.moveDirCreate {from = backupLogs (),
31b50af0 384 to = rld}
3a941c29 385 end
f924c1cf 386
3a941c29
AC		 387 | _ =>
388 (ignore (OS.Process.system (Config.cp
389 ^ " "
390 ^ #file fs
391 ^ " "
392 ^ realVhostFile));
393 if user <> oldUser then
394 let
395 val old = realLogDir oldUser
396 val rld = realLogDir user
ffd50ec7
AC		 397
398 val dlm = !delayedLogMoves
3a941c29
AC		 399 in
400 if !logDeleted then
401 ()
402 else
ffd50ec7 403 ((*ignore (OS.Process.system (down ()));*)
3a941c29 404 logDeleted := true);
ffd50ec7
AC		 405 delayedLogMoves := (fn () => (dlm ();
406 ignore (OS.Process.system (Config.rm
407 ^ " -rf "
408 ^ realLogDir oldUser))));
3a941c29
AC		 409 if Posix.FileSys.access (rld, []) then
410 ()
411 else
409542d7 412 Slave.mkDirAll rld
3a941c29
AC		 413 end
414 else
415 ())
416 end
417 end
7a2b27f0
AC		 418 else
419 ()
420 end)
8a7c40fa
AC		 421
422val () = Slave.registerPostHandler
423 (fn () =>
424 (if !vhostsChanged then
ffd50ec7
AC		 425 (Slave.shellF ([reload ()],
426 fn cl => "Error reloading Apache with " ^ cl);
427 if !logDeleted then !delayedLogMoves () else ())
8a7c40fa
AC		 428 else
429 ()))
430
7a2b27f0
AC		 431val vhostFiles : (string * TextIO.outstream) list ref = ref []
432fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
433fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 434
f8dfbbcc 435val rewriteEnabled = ref false
ce01b51a 436val localRewriteEnabled = ref false
fb09779a
AC		 437val expiresEnabled = ref false
438val localExpiresEnabled = ref false
c98b57cf
AC		 439val currentVhost = ref ""
440val currentVhostId = ref ""
8a5b34c9 441val sslEnabled = ref false
f8dfbbcc 442
7a2b27f0 443val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 444fun registerPre f =
445 let
446 val old = !pre
447 in
448 pre := (fn x => (old x; f x))
449 end
450
451val post = ref (fn () => ())
452fun registerPost f =
453 let
454 val old = !post
455 in
456 post := (fn () => (old (); f ()))
457 end
458
e9f528ab
AC		 459fun doPre x = !pre x
460fun doPost () = !post ()
461
7f75d838
AC		 462val aliaser = ref (fn _ : string => ())
463fun registerAliaser f =
464 let
465 val old = !aliaser
466 in
467 aliaser := (fn x => (old x; f x))
468 end
469
57e066bb
AC		 470fun vhostPost () = (!post ();
471 write "</VirtualHost>\n";
472 app (TextIO.closeOut o #2) (!vhostFiles))
2a7d2818 473
4648ee8a
CE		 474val php_version = fn (EVar "php56", _) => SOME 56
475 | (EVar "php72", _) => SOME 72
0440f954 476 | (EVar "php73", _) => SOME 73
58807e68 477 | (EVar "php74", _) => SOME 74
c6ef8d4e 478 | (EVar "php80", _) => SOME 80
0440f954 479 | _ => NONE
e7482df3 480
57e066bb
AC		 481fun vhostBody (env, makeFullHost) =
482 let
483 val places = Env.env (Env.list webPlace) (env, "WebPlaces")
484
485 val ssl = Env.env ssl (env, "SSL")
486 val user = Env.env Env.string (env, "User")
487 val group = Env.env Env.string (env, "Group")
488 val docroot = Env.env Env.string (env, "DocumentRoot")
489 val sadmin = Env.env Env.string (env, "ServerAdmin")
490 val suexec = Env.env Env.bool (env, "SuExec")
e7482df3 491 val php = Env.env php_version (env, "PhpVersion")
57e066bb
AC		 492
493 val fullHost = makeFullHost (Domain.currentDomain ())
494 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
495 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
496 in
497 currentVhost := fullHost;
498 currentVhostId := vhostId;
499 sslEnabled := Option.isSome ssl;
500
501 rewriteEnabled := false;
502 localRewriteEnabled := false;
fb09779a
AC		 503 expiresEnabled := false;
504 localExpiresEnabled := false;
f924c1cf 505 vhostFiles := map (fn (node, ip, ipv6) =>
57e066bb
AC		 506 let
507 val file = Domain.domainFile {node = node,
508 name = confFile}
509
510 val ld = logDir {user = user, node = node, vhostId = vhostId}
511 in
512 TextIO.output (file, "# Owner: ");
513 TextIO.output (file, user);
514 TextIO.output (file, "\n<VirtualHost ");
f924c1cf 515
57e066bb
AC		 516 TextIO.output (file, ip);
517 TextIO.output (file, ":");
518 TextIO.output (file, case ssl of
519 SOME _ => "443"
520 | NONE => "80");
f924c1cf
CE		 521
522 TextIO.output (file, " [");
523 TextIO.output (file, ipv6);
524 TextIO.output (file, "]");
525 TextIO.output (file, ":");
526 TextIO.output (file, case ssl of
527 SOME _ => "443"
528 | NONE => "80");
529
57e066bb
AC		 530 TextIO.output (file, ">\n");
531 TextIO.output (file, "\tErrorLog ");
532 TextIO.output (file, ld);
533 TextIO.output (file, "/error.log\n\tCustomLog ");
534 TextIO.output (file, ld);
535 TextIO.output (file, "/access.log combined\n");
536 TextIO.output (file, "\tServerName ");
537 TextIO.output (file, fullHost);
538 app
539 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
540 TextIO.output (file, makeFullHost dom)))
541 (Domain.currentAliasDomains ());
542
543 if suexec then
544 if isVersion1 node then
545 (TextIO.output (file, "\n\tUser ");
00a13ad8 546 TextIO.output (file, user);
57e066bb
AC		 547 TextIO.output (file, "\n\tGroup ");
548 TextIO.output (file, group))
549 else
550 (TextIO.output (file, "\n\tSuexecUserGroup ");
d5601036
AC		 551 TextIO.output (file, user);
552 TextIO.output (file, " ");
95798203 553 TextIO.output (file, group))
57e066bb
AC		 554 else
555 ();
556
557 if isWaklog node then
558 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
559 TextIO.output (file, user);
560 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
561 TextIO.output (file, user))
562 else
563 ();
564
f0732b22 565 TextIO.output (file, "\n\tDAVLockDB /var/local/domtool/apache2/dav/");
57e066bb
AC		 566 TextIO.output (file, user);
567 TextIO.output (file, "/DAVLock");
568
4648ee8a
CE		 569 TextIO.output (file, "\n\tAddHandler fcgid-script .php .phtml");
570 map (fn ext => (TextIO.output (file, "\n\tFcgidWrapper \"");
571 (* kerberos wrapper, simulates waklog+mod_cgi *)
572 if isWaklog node then
573 (TextIO.output (file, Config.Apache.fastCgiWrapperOf user);
574 TextIO.output (file, " "))
575 else
576 ();
577 TextIO.output (file, Config.Apache.phpFastCgiWrapper php);
578 TextIO.output (file, "\" ");
579 TextIO.output (file, ext)))
580 [".php", ".phtml"];
42782c79 581 (ld, file)
57e066bb
AC		 582 end)
583 places;
584 write "\n\tDocumentRoot ";
585 write docroot;
586 write "\n\tServerAdmin ";
587 write sadmin;
588 case ssl of
589 SOME cert =>
590 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
591 write cert)
592 | NONE => ();
593 write "\n";
594 !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
595 app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
f924c1cf 596 end
3f84c976 597
57e066bb
AC		 598val () = Env.containerV_one "vhost"
599 ("host", Env.string)
600 (fn (env, host) => vhostBody (env, fn dom => host ^ "." ^ dom),
601 vhostPost)
602
603val () = Env.containerV_none "vhostDefault"
604 (fn env => vhostBody (env, fn dom => dom),
605 vhostPost)
8a7c40fa 606
ce01b51a
AC		 607val inLocal = ref false
608
2882ee37
AC		 609val () = Env.container_one "location"
610 ("prefix", Env.string)
611 (fn prefix =>
612 (write "\t<Location ";
613 write prefix;
ce01b51a
AC		 614 write ">\n";
615 inLocal := true),
616 fn () => (write "\t</Location>\n";
617 inLocal := false;
fb09779a
AC		 618 localRewriteEnabled := false;
619 localExpiresEnabled := false))
2882ee37
AC		 620
621val () = Env.container_one "directory"
622 ("directory", Env.string)
623 (fn directory =>
624 (write "\t<Directory ";
625 write directory;
ce01b51a
AC		 626 write ">\n";
627 inLocal := true),
628 fn () => (write "\t</Directory>\n";
629 inLocal := false;
fb09779a
AC		 630 localRewriteEnabled := false;
631 localExpiresEnabled := false))
2882ee37 632
767fe695
AC		 633val () = Env.container_one "filesMatch"
634 ("regexp", Env.string)
635 (fn prefix =>
636 (write "\t<FilesMatch \"";
637 write prefix;
638 write "\">\n"),
639 fn () => (write "\t</FilesMatch>\n";
fb09779a
AC		 640 localRewriteEnabled := false;
641 localExpiresEnabled := false))
767fe695 642
f8dfbbcc 643fun checkRewrite () =
ce01b51a 644 if !inLocal then
cf283351 645 if !localRewriteEnabled then
ce01b51a
AC		 646 ()
647 else
648 (write "\tRewriteEngine on\n";
649 localRewriteEnabled := true)
650 else if !rewriteEnabled then
f8dfbbcc
AC		 651 ()
652 else
653 (write "\tRewriteEngine on\n";
654 rewriteEnabled := true)
655
fb09779a
AC		 656fun checkExpires () =
657 if !inLocal then
658 if !localExpiresEnabled then
659 ()
660 else
661 (write "\tExpiresActive on\n";
662 localExpiresEnabled := true)
663 else if !expiresEnabled then
664 ()
665 else
666 (write "\tExpiresActive on\n";
667 expiresEnabled := true)
668
6804ff6b 669val () = Env.action_four "proxyRewrite"
8ac607ea
CE		 670 ("from", Env.string, "to", Env.string, "tohost", Env.string, "flags", Env.list flag)
671 (fn (from, to, tohost, flags) =>
f8dfbbcc 672 (checkRewrite ();
06bd8215 673 write "\tRewriteRule\t\"";
f8dfbbcc 674 write from;
6804ff6b
CE		 675 write "\"\t\"";
676 write tohost;
677 write "/"; (* ensure rewrite rule can't change port *)
f8dfbbcc 678 write to;
6804ff6b
CE		 679 write "\"";
680 write " [P";
681 case flags of
682 [] => ()
683 | flag::rest => (write ",";
684 write flag;
685 app (fn flag => (write ",";
686 write flag)) rest);
687
688 write "]\n"))
f8dfbbcc 689
fb09779a
AC		 690val () = Env.action_four "expiresByType"
691 ("mime", Env.string, "base", interval_base, "num", Env.int, "inter", interval)
692 (fn (mime, base, num, inter) =>
693 (checkExpires ();
694 write "\tExpiresByType\t\"";
695 write mime;
696 write "\"\t\"";
697 write base;
698 write " plus ";
699 if num < 0 then
700 (write "-";
701 write (Int.toString (~num)))
702 else
703 write (Int.toString num);
704 write " ";
705 write inter;
706 write "\"\n"))
707
e95a129e
AC		 708val () = Env.action_two "proxyPass"
709 ("from", Env.string, "to", Env.string)
710 (fn (from, to) =>
711 (write "\tProxyPass\t";
712 write from;
713 write "\t";
714 write to;
36c7edfa 715 write "\tretry=0\n"))
e95a129e
AC		 716
717val () = Env.action_two "proxyPassReverse"
718 ("from", Env.string, "to", Env.string)
719 (fn (from, to) =>
720 (write "\tProxyPassReverse\t";
721 write from;
722 write "\t";
723 write to;
724 write "\n"))
f8dfbbcc 725
93d62353
CE		 726val () = Env.action_one "proxyPreserveHost"
727 ("enable", Env.bool)
728 (fn (enable) =>
729 (write "\tProxyPreserveHost\t";
730 if enable then write "On" else write "Off";
731 write "\n"))
732
f8dfbbcc
AC		 733val () = Env.action_three "rewriteRule"
734 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
735 (fn (from, to, flags) =>
736 (checkRewrite ();
06bd8215 737 write "\tRewriteRule\t\"";
f8dfbbcc 738 write from;
06bd8215 739 write "\"\t\"";
f8dfbbcc 740 write to;
06bd8215 741 write "\"";
f8dfbbcc
AC		 742 case flags of
743 [] => ()
744 | flag::rest => (write " [";
745 write flag;
746 app (fn flag => (write ",";
747 write flag)) rest;
748 write "]");
749 write "\n"))
750
e95a129e
AC		 751val () = Env.action_three "rewriteCond"
752 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
753 (fn (from, to, flags) =>
754 (checkRewrite ();
06bd8215 755 write "\tRewriteCond\t\"";
e95a129e 756 write from;
06bd8215 757 write "\"\t\"";
e95a129e 758 write to;
06bd8215 759 write "\"";
e95a129e
AC		 760 case flags of
761 [] => ()
762 | flag::rest => (write " [";
763 write flag;
764 app (fn flag => (write ",";
765 write flag)) rest;
766 write "]");
767 write "\n"))
768
94b7b11a
AC		 769val () = Env.action_one "rewriteBase"
770 ("prefix", Env.string)
771 (fn prefix =>
772 (checkRewrite ();
06bd8215 773 write "\tRewriteBase\t\"";
94b7b11a 774 write prefix;
06bd8215 775 write "\"\n"))
94b7b11a 776
9180bde0
CE		 777val _ = Env.type_one "mod_rewrite_trace_level"
778 Env.int
779 (fn n => n > 0 andalso n <= 8)
780
c98b57cf
AC		 781val () = Env.action_one "rewriteLogLevel"
782 ("level", Env.int)
9180bde0 783 (fn 0 =>
c98b57cf 784 (checkRewrite ();
9180bde0
CE		 785 write "\tLogLevel rewrite:warn\n")
786 | level =>
787 (checkRewrite ();
788 write "\tLogLevel rewrite:trace";
789 write (Int.toString level);
790 write "\n"))
c98b57cf 791
d5754b53
AC		 792val () = Env.action_two "alias"
793 ("from", Env.string, "to", Env.string)
794 (fn (from, to) =>
795 (write "\tAlias\t";
796 write from;
797 write " ";
798 write to;
799 write "\n"))
800
801val () = Env.action_two "scriptAlias"
802 ("from", Env.string, "to", Env.string)
803 (fn (from, to) =>
804 (write "\tScriptAlias\t";
805 write from;
806 write " ";
807 write to;
808 write "\n"))
809
8c1de2ae
CE		 810val () = Env.action_two "fastScriptAlias"
811 ("from", Env.string, "to", Env.string)
812 (fn (from, to) =>
66d70ba2
CE		 813 let
814 (* mod_fcgid + kerberos limit this to working with
815 individual fcgi programs. assume the target path is a
816 file and any trailing `/' is just aliasing
817 syntax. Directory+File on the script is used to
818 activate fcgid instead of Location on the alias to
819 limit effects (alias+location also match in inverse
820 order causing pernicious side-effects *)
821 val fcgi_path = if String.sub (to, size to - 1) = #"/"
822 then
823 String.substring (to, 0, size to - 1)
824 else
825 to
826 val fcgi_dir = OS.Path.dir fcgi_path
827 val fcgi_file = OS.Path.file fcgi_path
828 in
829 write "\tAlias\t"; write from; write " "; write to; write "\n";
8c1de2ae 830
66d70ba2
CE		 831 write "\t<Directory "; write fcgi_dir; write ">\n";
832 write "\t<Files "; write fcgi_file; write ">\n";
833 write "\tSetHandler fcgid-script\n";
834
835 (* FIXME: only set kerberos wrapper of waklog is on *)
95798203 836 (* won't be trivial, since we don't have access to node here *)
66d70ba2
CE		 837 write "\tFcgidWrapper \"";
838 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
839 write " ";
840 write fcgi_path;
841 write "\"\n";
842
843 write "\t</Files>\n\t</Directory>\n"
844 end)
8c1de2ae 845
d5754b53
AC		 846val () = Env.action_two "errorDocument"
847 ("code", Env.string, "handler", Env.string)
848 (fn (code, handler) =>
989965b1
AC		 849 let
850 val hasSpaces = CharVector.exists Char.isSpace handler
d5754b53 851
989965b1
AC		 852 fun maybeQuote () =
853 if hasSpaces then
854 write "\""
855 else
856 ()
857 in
858 write "\tErrorDocument\t";
859 write code;
860 write " ";
861 maybeQuote ();
862 write handler;
863 maybeQuote ();
864 write "\n"
865 end)
f924c1cf 866
d441e69f
AC		 867val () = Env.action_one "options"
868 ("options", Env.list apache_option)
869 (fn opts =>
870 case opts of
871 [] => ()
872 | _ => (write "\tOptions";
873 app (fn opt => (write " "; write opt)) opts;
874 write "\n"))
875
876val () = Env.action_one "set_options"
877 ("options", Env.list apache_option)
878 (fn opts =>
879 case opts of
880 [] => ()
881 | _ => (write "\tOptions";
882 app (fn opt => (write " +"; write opt)) opts;
883 write "\n"))
884
885val () = Env.action_one "unset_options"
886 ("options", Env.list apache_option)
887 (fn opts =>
888 case opts of
889 [] => ()
890 | _ => (write "\tOptions";
891 app (fn opt => (write " -"; write opt)) opts;
892 write "\n"))
d5754b53 893
781ebc11
AC		 894val () = Env.action_one "cgiExtension"
895 ("extension", Env.string)
896 (fn ext => (write "\tAddHandler cgi-script ";
897 write ext;
898 write "\n"))
899
edd38024
AC		 900val () = Env.action_one "directoryIndex"
901 ("filenames", Env.list Env.string)
902 (fn opts =>
903 (write "\tDirectoryIndex";
904 app (fn opt => (write " "; write opt)) opts;
905 write "\n"))
906
129d3b57
CE		 907val () = Env.action_one "directorySlash"
908 ("enable", Env.bool)
909 (fn enable =>
910 (write "\tDirectorySlash ";
911 if enable then write "On" else write "Off";
912 write "\n"))
913
e519d696 914val () = Env.action_one "serverAliasHost"
edd38024
AC		 915 ("host", Env.string)
916 (fn host =>
917 (write "\tServerAlias ";
918 write host;
7f75d838
AC		 919 write "\n";
920 !aliaser host))
edd38024 921
e519d696
AC		 922val () = Env.action_one "serverAlias"
923 ("host", Env.string)
924 (fn host =>
925 (app
926 (fn dom =>
927 let
928 val full = host ^ "." ^ dom
929 in
930 write "\tServerAlias ";
931 write full;
932 write "\n";
933 !aliaser full
934 end)
935 (Domain.currentDomains ())))
936
937val () = Env.action_none "serverAliasDefault"
938 (fn () =>
939 (app
940 (fn dom =>
941 (write "\tServerAlias ";
942 write dom;
943 write "\n";
944 !aliaser dom))
945 (Domain.currentDomains ())))
946
2aeb9eec
AC		 947val authType = fn (EVar "basic", _) => SOME "basic"
948 | (EVar "digest", _) => SOME "digest"
35dc7746 949 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 950 | _ => NONE
951
8a5b34c9
AC		 952fun allowAuthType "kerberos" = !sslEnabled
953 | allowAuthType _ = true
954
2aeb9eec
AC		 955val () = Env.action_one "authType"
956 ("type", authType)
957 (fn ty =>
8a5b34c9
AC		 958 if allowAuthType ty then
959 (write "\tAuthType ";
960 write ty;
961 write "\n";
962 case ty of
f924c1cf 963 "kerberos" =>
417edb97 964 write "\tKrbServiceName HTTP\n\tKrb5Keytab /etc/keytabs/service/apache\n\tKrbMethodNegotiate on\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC on\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
8a5b34c9
AC		 965 | _ => ())
966 else
967 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 968
969val () = Env.action_one "authName"
970 ("name", Env.string)
971 (fn name =>
972 (write "\tAuthName \"";
973 write name;
974 write "\"\n"))
975
976val () = Env.action_one "authUserFile"
977 ("file", Env.string)
978 (fn name =>
979 (write "\tAuthUserFile ";
980 write name;
981 write "\n"))
982
58f4ce3b
CE		 983val () = Env.action_one "authGroupFile"
984 ("file", Env.string)
985 (fn name =>
986 (write "\tAuthGroupFile ";
987 write name;
988 write "\n"))
989
2aeb9eec
AC		 990val () = Env.action_none "requireValidUser"
991 (fn () => write "\tRequire valid-user\n")
992
993val () = Env.action_one "requireUser"
994 ("users", Env.list Env.string)
995 (fn names =>
996 case names of
997 [] => ()
998 | _ => (write "\tRequire user";
999 app (fn name => (write " "; write name)) names;
1000 write "\n"))
1001
1002val () = Env.action_one "requireGroup"
1003 ("groups", Env.list Env.string)
1004 (fn names =>
1005 case names of
1006 [] => ()
1007 | _ => (write "\tRequire group";
1008 app (fn name => (write " "; write name)) names;
1009 write "\n"))
1010
1011val () = Env.action_none "orderAllowDeny"
1012 (fn () => write "\tOrder allow,deny\n")
1013
1014val () = Env.action_none "orderDenyAllow"
1015 (fn () => write "\tOrder deny,allow\n")
1016
1017val () = Env.action_none "allowFromAll"
1018 (fn () => write "\tAllow from all\n")
1019
1020val () = Env.action_one "allowFrom"
1021 ("entries", Env.list Env.string)
1022 (fn names =>
1023 case names of
1024 [] => ()
1025 | _ => (write "\tAllow from";
1026 app (fn name => (write " "; write name)) names;
1027 write "\n"))
1028
1029val () = Env.action_none "denyFromAll"
1030 (fn () => write "\tDeny from all\n")
1031
1032val () = Env.action_one "denyFrom"
1033 ("entries", Env.list Env.string)
1034 (fn names =>
1035 case names of
1036 [] => ()
1037 | _ => (write "\tDeny from";
1038 app (fn name => (write " "; write name)) names;
1039 write "\n"))
1040
1041val () = Env.action_none "satisfyAll"
1042 (fn () => write "\tSatisfy all\n")
1043
1044val () = Env.action_none "satisfyAny"
1045 (fn () => write "\tSatisfy any\n")
1046
7f012ffd
AC		 1047val () = Env.action_one "forceType"
1048 ("type", Env.string)
1049 (fn ty => (write "\tForceType ";
1050 write ty;
1051 write "\n"))
1052
1053val () = Env.action_none "forceTypeOff"
1054 (fn () => write "\tForceType None\n")
1055
1056val () = Env.action_two "action"
1057 ("what", Env.string, "how", Env.string)
1058 (fn (what, how) => (write "\tAction ";
1059 write what;
1060 write " ";
1061 write how;
1062 write "\n"))
1063
1064val () = Env.action_one "addDefaultCharset"
1065 ("charset", Env.string)
1066 (fn ty => (write "\tAddDefaultCharset ";
1067 write ty;
1068 write "\n"))
1069
64e85bae 1070(*val () = Env.action_one "davSvn"
c8505e59
AC		 1071 ("path", Env.string)
1072 (fn path => (write "\tDAV svn\n\tSVNPath ";
1073 write path;
1074 write "\n"))
1075
1076val () = Env.action_one "authzSvnAccessFile"
1077 ("path", Env.string)
1078 (fn path => (write "\tAuthzSVNAccessFile ";
1079 write path;
64e85bae 1080 write "\n"))*)
c8505e59 1081
0aed4302
AC		 1082val () = Env.action_none "davFilesystem"
1083 (fn path => write "\tDAV filesystem\n")
1084
9d7fa346
AC		 1085val () = Env.action_two "addDescription"
1086 ("description", Env.string, "patterns", Env.list Env.string)
1087 (fn (desc, pats) =>
1088 case pats of
1089 [] => ()
1090 | _ => (write "\tAddDescription \"";
1091 write (String.toString desc);
1092 write "\"";
1093 app (fn pat => (write " "; write pat)) pats;
1094 write "\n"))
1095
1817ed97
AC		 1096val () = Env.action_two "addIcon"
1097 ("icon", Env.string, "patterns", Env.list Env.string)
1098 (fn (icon, pats) =>
1099 case pats of
1100 [] => ()
1101 | _ => (write "\tAddIcon \"";
1102 write icon;
1103 write "\"";
1104 app (fn pat => (write " "; write pat)) pats;
1105 write "\n"))
1106
9d7fa346
AC		 1107val () = Env.action_one "indexOptions"
1108 ("options", Env.list autoindex_option)
1109 (fn opts =>
1110 case opts of
1111 [] => ()
1112 | _ => (write "\tIndexOptions";
1113 app (fn (opt, arg) =>
1114 (write " ";
1115 write opt;
1116 Option.app (fn arg =>
1117 (write "="; write arg)) arg)) opts;
1118 write "\n"))
1119
1817ed97
AC		 1120val () = Env.action_one "indexIgnore"
1121 ("patterns", Env.list Env.string)
1122 (fn pats =>
1123 case pats of
1124 [] => ()
1125 | _ => (write "\tIndexIgnore";
1126 app (fn pat => (write " "; write pat)) pats;
1127 write "\n"))
1128
9d7fa346
AC		 1129val () = Env.action_one "set_indexOptions"
1130 ("options", Env.list autoindex_option)
1131 (fn opts =>
1132 case opts of
1133 [] => ()
1134 | _ => (write "\tIndexOptions";
1135 app (fn (opt, arg) =>
1136 (write " +";
1137 write opt;
1138 Option.app (fn arg =>
1139 (write "="; write arg)) arg)) opts;
1140 write "\n"))
1141
1142val () = Env.action_one "unset_indexOptions"
1143 ("options", Env.list autoindex_option)
1144 (fn opts =>
1145 case opts of
1146 [] => ()
1147 | _ => (write "\tIndexOptions";
1148 app (fn (opt, _) =>
1149 (write " -";
1150 write opt)) opts;
1151 write "\n"))
1152
1153val () = Env.action_one "headerName"
1154 ("name", Env.string)
1155 (fn name => (write "\tHeaderName ";
1156 write name;
1157 write "\n"))
1158
1159val () = Env.action_one "readmeName"
1160 ("name", Env.string)
1161 (fn name => (write "\tReadmeName ";
1162 write name;
1163 write "\n"))
1164
eda33894
AC		 1165val () = Env.action_two "setEnv"
1166 ("key", Env.string, "value", Env.string)
1167 (fn (key, value) => (write "\tSetEnv \"";
1168 write key;
1169 write "\" \"";
ca6ffb3f
AC		 1170 write (String.translate (fn #"\"" => "\\\""
1171 | ch => str ch) value);
eda33894
AC		 1172 write "\"\n"))
1173
42233a46
CE		 1174val () = Env.action_three "setEnvIf"
1175 ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
1176 (fn (attribute, match, envs) =>
1177 case envs of
1178 [] => (print "WARNING: Skipped setEnvIf, no environment variables provided.\n")
1179 | envs =>
1180 (write "\tSetEnvIf\t\"";
1181 write attribute;
1182 write "\"\t\"";
1183 write match;
1184 write "\"";
1185 app (fn env => (write "\t"; write env)) envs;
1186 write "\n"))
1187
1188val () = Env.action_three "setEnvIfNoCase"
1189 ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
1190 (fn (attribute, match, envs) =>
1191 case envs of
1192 [] => (print "WARNING: Skipped setEnvIfNoCase, no environment variables provided.\n")
1193 | envs =>
24709d5a 1194 (write "\tSetEnvIfNoCase\t\"";
42233a46
CE		 1195 write attribute;
1196 write "\"\t\"";
1197 write match;
1198 write "\"";
1199 app (fn env => (write "\t"; write env)) envs;
1200 write "\n"))
1201
f0062360
AC		 1202val () = Env.action_one "diskCache"
1203 ("path", Env.string)
1204 (fn path => (write "\tCacheEnable disk \"";
1205 write path;
1206 write "\"\n"))
83bc6c45 1207
83bc6c45
AC		 1208val () = Env.action_one "phpVersion"
1209 ("version", php_version)
4648ee8a 1210 (fn version => (write "\tAddHandler fcgid-script .php .phtml\n";
c6ef8d4e
CE		 1211 (* FIXME: only set kerberos wrapper of waklog is on *)
1212 (* won't be trivial, since we don't have access to node here *)
1213 app (fn ext => (write "\n\tFcgidWrapper \"";
1214 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
1215 write " ";
1216 write (Config.Apache.phpFastCgiWrapper version);
1217 write "\" ";
1218 write ext;
1219 write "\n"))
1220 [".php", ".phtml"]))
83bc6c45 1221
bcf547ec
AC		 1222val () = Env.action_two "addType"
1223 ("mime type", Env.string, "extension", Env.string)
1224 (fn (mt, ext) => (write "\tAddType ";
1225 write mt;
1226 write " ";
1227 write ext;
1228 write "\n"))
1229
1230val filter = fn (EVar "includes", _) => SOME "INCLUDES"
1231 | (EVar "deflate", _) => SOME "DEFLATE"
1232 | _ => NONE
1233
1234val () = Env.action_two "addOutputFilter"
1235 ("filters", Env.list filter, "extensions", Env.list Env.string)
1236 (fn (f :: fs, exts as (_ :: _)) =>
1237 (write "\tAddOutputFilter ";
1238 write f;
1239 app (fn f => (write ";"; write f)) fs;
1240 app (fn ext => (write " "; write ext)) exts;
1241 write "\n")
1242 | _ => ())
1243
ef5ad69a
CE		 1244val () = Env.action_one "sslCertificateChainFile"
1245 ("ssl_cacert_path", Env.string)
1246 (fn cacert =>
1247 if !sslEnabled then
1248 (write "\tSSLCertificateChainFile \"";
1249 write cacert;
1250 write "\"\n")
1251 else
1252 print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
1253
71420f8b 1254val () = Domain.registerResetLocal (fn () =>
7ad80c20 1255 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
71420f8b 1256
41c58daf
AC		 1257val () = Domain.registerDescriber (Domain.considerAll
1258 [Domain.Extension {extension = "vhost",
d936cf4d 1259 heading = fn host => "Web vhost " ^ host ^ ":"},
41c58daf 1260 Domain.Extension {extension = "vhost_ssl",
d936cf4d 1261 heading = fn host => "SSL web vhost " ^ host ^ ":"}])
41c58daf 1262
e2166ae8
CE		 1263val () = Env.action_one "allowEncodedSlashes"
1264 ("enable", Env.bool)
1265 (fn enable => (write "\tAllowEncodedSlashes ";
1266 write (if enable then "NoDecode" else "Off");
1267 write "\n"))
ecc307a0
AC		 1268val () = Env.action_none "testNoHtaccess"
1269 (fn path => write "\tAllowOverride None\n")
1270
563e7792
AC		 1271fun writeWaklogUserFile () =
1272 let
1273 val users = Acl.users ()
1274 val outf = TextIO.openOut Config.Apache.waklogUserFile
1275 in
1276 app (fn user => if String.isSuffix "_admin" user then
1277 ()
1278 else
1279 (TextIO.output (outf, "<Location /~");
1280 TextIO.output (outf, user);
1281 TextIO.output (outf, ">\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
1282 TextIO.output (outf, user);
1283 TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
1284 TextIO.output (outf, user);
1285 TextIO.output (outf, "\n</Location>\n\n"))) users;
1286 TextIO.closeOut outf
1287 end
1288
1289val () = Domain.registerOnUsersChange writeWaklogUserFile
1290
8a7c40fa 1291end
Unnamed repository; edit this file to name it for gitweb.