apache: correct setEnvIfNoCase
[hcoop/domtool2.git] / src / plugins / apache.sml
CommitLineData
8a7c40fa 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
fb09779a 2 * Copyright (c) 2006-2009, Adam Chlipala
c6923cdb 3 * Copyright (c) 2013 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
42782c79 476 | _ => NONE
e7482df3 477
57e066bb
AC
478fun vhostBody (env, makeFullHost) =
479 let
480 val places = Env.env (Env.list webPlace) (env, "WebPlaces")
481
482 val ssl = Env.env ssl (env, "SSL")
483 val user = Env.env Env.string (env, "User")
484 val group = Env.env Env.string (env, "Group")
485 val docroot = Env.env Env.string (env, "DocumentRoot")
486 val sadmin = Env.env Env.string (env, "ServerAdmin")
487 val suexec = Env.env Env.bool (env, "SuExec")
e7482df3 488 val php = Env.env php_version (env, "PhpVersion")
57e066bb
AC
489
490 val fullHost = makeFullHost (Domain.currentDomain ())
491 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
492 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
493 in
494 currentVhost := fullHost;
495 currentVhostId := vhostId;
496 sslEnabled := Option.isSome ssl;
497
498 rewriteEnabled := false;
499 localRewriteEnabled := false;
fb09779a
AC
500 expiresEnabled := false;
501 localExpiresEnabled := false;
f924c1cf 502 vhostFiles := map (fn (node, ip, ipv6) =>
57e066bb
AC
503 let
504 val file = Domain.domainFile {node = node,
505 name = confFile}
506
507 val ld = logDir {user = user, node = node, vhostId = vhostId}
508 in
509 TextIO.output (file, "# Owner: ");
510 TextIO.output (file, user);
511 TextIO.output (file, "\n<VirtualHost ");
f924c1cf 512
57e066bb
AC
513 TextIO.output (file, ip);
514 TextIO.output (file, ":");
515 TextIO.output (file, case ssl of
516 SOME _ => "443"
517 | NONE => "80");
f924c1cf
CE
518
519 TextIO.output (file, " [");
520 TextIO.output (file, ipv6);
521 TextIO.output (file, "]");
522 TextIO.output (file, ":");
523 TextIO.output (file, case ssl of
524 SOME _ => "443"
525 | NONE => "80");
526
57e066bb
AC
527 TextIO.output (file, ">\n");
528 TextIO.output (file, "\tErrorLog ");
529 TextIO.output (file, ld);
530 TextIO.output (file, "/error.log\n\tCustomLog ");
531 TextIO.output (file, ld);
532 TextIO.output (file, "/access.log combined\n");
533 TextIO.output (file, "\tServerName ");
534 TextIO.output (file, fullHost);
535 app
536 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
537 TextIO.output (file, makeFullHost dom)))
538 (Domain.currentAliasDomains ());
539
540 if suexec then
541 if isVersion1 node then
542 (TextIO.output (file, "\n\tUser ");
00a13ad8 543 TextIO.output (file, user);
57e066bb
AC
544 TextIO.output (file, "\n\tGroup ");
545 TextIO.output (file, group))
546 else
547 (TextIO.output (file, "\n\tSuexecUserGroup ");
d5601036
AC
548 TextIO.output (file, user);
549 TextIO.output (file, " ");
95798203 550 TextIO.output (file, group))
57e066bb
AC
551 else
552 ();
553
554 if isWaklog node then
555 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
556 TextIO.output (file, user);
557 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
558 TextIO.output (file, user))
559 else
560 ();
561
562 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
563 TextIO.output (file, user);
564 TextIO.output (file, "/DAVLock");
565
4648ee8a
CE
566 TextIO.output (file, "\n\tAddHandler fcgid-script .php .phtml");
567 map (fn ext => (TextIO.output (file, "\n\tFcgidWrapper \"");
568 (* kerberos wrapper, simulates waklog+mod_cgi *)
569 if isWaklog node then
570 (TextIO.output (file, Config.Apache.fastCgiWrapperOf user);
571 TextIO.output (file, " "))
572 else
573 ();
574 TextIO.output (file, Config.Apache.phpFastCgiWrapper php);
575 TextIO.output (file, "\" ");
576 TextIO.output (file, ext)))
577 [".php", ".phtml"];
42782c79 578 (ld, file)
57e066bb
AC
579 end)
580 places;
581 write "\n\tDocumentRoot ";
582 write docroot;
583 write "\n\tServerAdmin ";
584 write sadmin;
585 case ssl of
586 SOME cert =>
587 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
588 write cert)
589 | NONE => ();
590 write "\n";
591 !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
592 app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
f924c1cf 593 end
3f84c976 594
57e066bb
AC
595val () = Env.containerV_one "vhost"
596 ("host", Env.string)
597 (fn (env, host) => vhostBody (env, fn dom => host ^ "." ^ dom),
598 vhostPost)
599
600val () = Env.containerV_none "vhostDefault"
601 (fn env => vhostBody (env, fn dom => dom),
602 vhostPost)
8a7c40fa 603
ce01b51a
AC
604val inLocal = ref false
605
2882ee37
AC
606val () = Env.container_one "location"
607 ("prefix", Env.string)
608 (fn prefix =>
609 (write "\t<Location ";
610 write prefix;
ce01b51a
AC
611 write ">\n";
612 inLocal := true),
613 fn () => (write "\t</Location>\n";
614 inLocal := false;
fb09779a
AC
615 localRewriteEnabled := false;
616 localExpiresEnabled := false))
2882ee37
AC
617
618val () = Env.container_one "directory"
619 ("directory", Env.string)
620 (fn directory =>
621 (write "\t<Directory ";
622 write directory;
ce01b51a
AC
623 write ">\n";
624 inLocal := true),
625 fn () => (write "\t</Directory>\n";
626 inLocal := false;
fb09779a
AC
627 localRewriteEnabled := false;
628 localExpiresEnabled := false))
2882ee37 629
767fe695
AC
630val () = Env.container_one "filesMatch"
631 ("regexp", Env.string)
632 (fn prefix =>
633 (write "\t<FilesMatch \"";
634 write prefix;
635 write "\">\n"),
636 fn () => (write "\t</FilesMatch>\n";
fb09779a
AC
637 localRewriteEnabled := false;
638 localExpiresEnabled := false))
767fe695 639
f8dfbbcc 640fun checkRewrite () =
ce01b51a 641 if !inLocal then
cf283351 642 if !localRewriteEnabled then
ce01b51a
AC
643 ()
644 else
645 (write "\tRewriteEngine on\n";
646 localRewriteEnabled := true)
647 else if !rewriteEnabled then
f8dfbbcc
AC
648 ()
649 else
650 (write "\tRewriteEngine on\n";
651 rewriteEnabled := true)
652
fb09779a
AC
653fun checkExpires () =
654 if !inLocal then
655 if !localExpiresEnabled then
656 ()
657 else
658 (write "\tExpiresActive on\n";
659 localExpiresEnabled := true)
660 else if !expiresEnabled then
661 ()
662 else
663 (write "\tExpiresActive on\n";
664 expiresEnabled := true)
665
f8dfbbcc
AC
666val () = Env.action_three "localProxyRewrite"
667 ("from", Env.string, "to", Env.string, "port", Env.int)
668 (fn (from, to, port) =>
669 (checkRewrite ();
06bd8215 670 write "\tRewriteRule\t\"";
f8dfbbcc 671 write from;
06bd8215 672 write "\"\thttp://localhost:";
f8dfbbcc
AC
673 write (Int.toString port);
674 write "/";
675 write to;
676 write " [P]\n"))
677
fb09779a
AC
678val () = Env.action_four "expiresByType"
679 ("mime", Env.string, "base", interval_base, "num", Env.int, "inter", interval)
680 (fn (mime, base, num, inter) =>
681 (checkExpires ();
682 write "\tExpiresByType\t\"";
683 write mime;
684 write "\"\t\"";
685 write base;
686 write " plus ";
687 if num < 0 then
688 (write "-";
689 write (Int.toString (~num)))
690 else
691 write (Int.toString num);
692 write " ";
693 write inter;
694 write "\"\n"))
695
e95a129e
AC
696val () = Env.action_two "proxyPass"
697 ("from", Env.string, "to", Env.string)
698 (fn (from, to) =>
699 (write "\tProxyPass\t";
700 write from;
701 write "\t";
702 write to;
36c7edfa 703 write "\tretry=0\n"))
e95a129e
AC
704
705val () = Env.action_two "proxyPassReverse"
706 ("from", Env.string, "to", Env.string)
707 (fn (from, to) =>
708 (write "\tProxyPassReverse\t";
709 write from;
710 write "\t";
711 write to;
712 write "\n"))
f8dfbbcc 713
93d62353
CE
714val () = Env.action_one "proxyPreserveHost"
715 ("enable", Env.bool)
716 (fn (enable) =>
717 (write "\tProxyPreserveHost\t";
718 if enable then write "On" else write "Off";
719 write "\n"))
720
f8dfbbcc
AC
721val () = Env.action_three "rewriteRule"
722 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
723 (fn (from, to, flags) =>
724 (checkRewrite ();
06bd8215 725 write "\tRewriteRule\t\"";
f8dfbbcc 726 write from;
06bd8215 727 write "\"\t\"";
f8dfbbcc 728 write to;
06bd8215 729 write "\"";
f8dfbbcc
AC
730 case flags of
731 [] => ()
732 | flag::rest => (write " [";
733 write flag;
734 app (fn flag => (write ",";
735 write flag)) rest;
736 write "]");
737 write "\n"))
738
e95a129e
AC
739val () = Env.action_three "rewriteCond"
740 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
741 (fn (from, to, flags) =>
742 (checkRewrite ();
06bd8215 743 write "\tRewriteCond\t\"";
e95a129e 744 write from;
06bd8215 745 write "\"\t\"";
e95a129e 746 write to;
06bd8215 747 write "\"";
e95a129e
AC
748 case flags of
749 [] => ()
750 | flag::rest => (write " [";
751 write flag;
752 app (fn flag => (write ",";
753 write flag)) rest;
754 write "]");
755 write "\n"))
756
94b7b11a
AC
757val () = Env.action_one "rewriteBase"
758 ("prefix", Env.string)
759 (fn prefix =>
760 (checkRewrite ();
06bd8215 761 write "\tRewriteBase\t\"";
94b7b11a 762 write prefix;
06bd8215 763 write "\"\n"))
94b7b11a 764
c98b57cf
AC
765val () = Env.action_one "rewriteLogLevel"
766 ("level", Env.int)
767 (fn level =>
768 (checkRewrite ();
769 write "\tRewriteLog ";
7a2b27f0 770 write' (fn x => x);
c98b57cf
AC
771 write "/rewrite.log\n\tRewriteLogLevel ";
772 write (Int.toString level);
773 write "\n"))
774
d5754b53
AC
775val () = Env.action_two "alias"
776 ("from", Env.string, "to", Env.string)
777 (fn (from, to) =>
778 (write "\tAlias\t";
779 write from;
780 write " ";
781 write to;
782 write "\n"))
783
784val () = Env.action_two "scriptAlias"
785 ("from", Env.string, "to", Env.string)
786 (fn (from, to) =>
787 (write "\tScriptAlias\t";
788 write from;
789 write " ";
790 write to;
791 write "\n"))
792
8c1de2ae
CE
793val () = Env.action_two "fastScriptAlias"
794 ("from", Env.string, "to", Env.string)
795 (fn (from, to) =>
66d70ba2
CE
796 let
797 (* mod_fcgid + kerberos limit this to working with
798 individual fcgi programs. assume the target path is a
799 file and any trailing `/' is just aliasing
800 syntax. Directory+File on the script is used to
801 activate fcgid instead of Location on the alias to
802 limit effects (alias+location also match in inverse
803 order causing pernicious side-effects *)
804 val fcgi_path = if String.sub (to, size to - 1) = #"/"
805 then
806 String.substring (to, 0, size to - 1)
807 else
808 to
809 val fcgi_dir = OS.Path.dir fcgi_path
810 val fcgi_file = OS.Path.file fcgi_path
811 in
812 write "\tAlias\t"; write from; write " "; write to; write "\n";
8c1de2ae 813
66d70ba2
CE
814 write "\t<Directory "; write fcgi_dir; write ">\n";
815 write "\t<Files "; write fcgi_file; write ">\n";
816 write "\tSetHandler fcgid-script\n";
817
818 (* FIXME: only set kerberos wrapper of waklog is on *)
95798203 819 (* won't be trivial, since we don't have access to node here *)
66d70ba2
CE
820 write "\tFcgidWrapper \"";
821 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
822 write " ";
823 write fcgi_path;
824 write "\"\n";
825
826 write "\t</Files>\n\t</Directory>\n"
827 end)
8c1de2ae 828
d5754b53
AC
829val () = Env.action_two "errorDocument"
830 ("code", Env.string, "handler", Env.string)
831 (fn (code, handler) =>
989965b1
AC
832 let
833 val hasSpaces = CharVector.exists Char.isSpace handler
d5754b53 834
989965b1
AC
835 fun maybeQuote () =
836 if hasSpaces then
837 write "\""
838 else
839 ()
840 in
841 write "\tErrorDocument\t";
842 write code;
843 write " ";
844 maybeQuote ();
845 write handler;
846 maybeQuote ();
847 write "\n"
848 end)
f924c1cf 849
d441e69f
AC
850val () = Env.action_one "options"
851 ("options", Env.list apache_option)
852 (fn opts =>
853 case opts of
854 [] => ()
855 | _ => (write "\tOptions";
856 app (fn opt => (write " "; write opt)) opts;
857 write "\n"))
858
859val () = Env.action_one "set_options"
860 ("options", Env.list apache_option)
861 (fn opts =>
862 case opts of
863 [] => ()
864 | _ => (write "\tOptions";
865 app (fn opt => (write " +"; write opt)) opts;
866 write "\n"))
867
868val () = Env.action_one "unset_options"
869 ("options", Env.list apache_option)
870 (fn opts =>
871 case opts of
872 [] => ()
873 | _ => (write "\tOptions";
874 app (fn opt => (write " -"; write opt)) opts;
875 write "\n"))
d5754b53 876
781ebc11
AC
877val () = Env.action_one "cgiExtension"
878 ("extension", Env.string)
879 (fn ext => (write "\tAddHandler cgi-script ";
880 write ext;
881 write "\n"))
882
edd38024
AC
883val () = Env.action_one "directoryIndex"
884 ("filenames", Env.list Env.string)
885 (fn opts =>
886 (write "\tDirectoryIndex";
887 app (fn opt => (write " "; write opt)) opts;
888 write "\n"))
889
e519d696 890val () = Env.action_one "serverAliasHost"
edd38024
AC
891 ("host", Env.string)
892 (fn host =>
893 (write "\tServerAlias ";
894 write host;
7f75d838
AC
895 write "\n";
896 !aliaser host))
edd38024 897
e519d696
AC
898val () = Env.action_one "serverAlias"
899 ("host", Env.string)
900 (fn host =>
901 (app
902 (fn dom =>
903 let
904 val full = host ^ "." ^ dom
905 in
906 write "\tServerAlias ";
907 write full;
908 write "\n";
909 !aliaser full
910 end)
911 (Domain.currentDomains ())))
912
913val () = Env.action_none "serverAliasDefault"
914 (fn () =>
915 (app
916 (fn dom =>
917 (write "\tServerAlias ";
918 write dom;
919 write "\n";
920 !aliaser dom))
921 (Domain.currentDomains ())))
922
2aeb9eec
AC
923val authType = fn (EVar "basic", _) => SOME "basic"
924 | (EVar "digest", _) => SOME "digest"
35dc7746 925 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC
926 | _ => NONE
927
8a5b34c9
AC
928fun allowAuthType "kerberos" = !sslEnabled
929 | allowAuthType _ = true
930
2aeb9eec
AC
931val () = Env.action_one "authType"
932 ("type", authType)
933 (fn ty =>
8a5b34c9
AC
934 if allowAuthType ty then
935 (write "\tAuthType ";
936 write ty;
937 write "\n";
938 case ty of
f924c1cf 939 "kerberos" =>
417edb97 940 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
941 | _ => ())
942 else
943 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC
944
945val () = Env.action_one "authName"
946 ("name", Env.string)
947 (fn name =>
948 (write "\tAuthName \"";
949 write name;
950 write "\"\n"))
951
952val () = Env.action_one "authUserFile"
953 ("file", Env.string)
954 (fn name =>
955 (write "\tAuthUserFile ";
956 write name;
957 write "\n"))
958
58f4ce3b
CE
959val () = Env.action_one "authGroupFile"
960 ("file", Env.string)
961 (fn name =>
962 (write "\tAuthGroupFile ";
963 write name;
964 write "\n"))
965
2aeb9eec
AC
966val () = Env.action_none "requireValidUser"
967 (fn () => write "\tRequire valid-user\n")
968
969val () = Env.action_one "requireUser"
970 ("users", Env.list Env.string)
971 (fn names =>
972 case names of
973 [] => ()
974 | _ => (write "\tRequire user";
975 app (fn name => (write " "; write name)) names;
976 write "\n"))
977
978val () = Env.action_one "requireGroup"
979 ("groups", Env.list Env.string)
980 (fn names =>
981 case names of
982 [] => ()
983 | _ => (write "\tRequire group";
984 app (fn name => (write " "; write name)) names;
985 write "\n"))
986
987val () = Env.action_none "orderAllowDeny"
988 (fn () => write "\tOrder allow,deny\n")
989
990val () = Env.action_none "orderDenyAllow"
991 (fn () => write "\tOrder deny,allow\n")
992
993val () = Env.action_none "allowFromAll"
994 (fn () => write "\tAllow from all\n")
995
996val () = Env.action_one "allowFrom"
997 ("entries", Env.list Env.string)
998 (fn names =>
999 case names of
1000 [] => ()
1001 | _ => (write "\tAllow from";
1002 app (fn name => (write " "; write name)) names;
1003 write "\n"))
1004
1005val () = Env.action_none "denyFromAll"
1006 (fn () => write "\tDeny from all\n")
1007
1008val () = Env.action_one "denyFrom"
1009 ("entries", Env.list Env.string)
1010 (fn names =>
1011 case names of
1012 [] => ()
1013 | _ => (write "\tDeny from";
1014 app (fn name => (write " "; write name)) names;
1015 write "\n"))
1016
1017val () = Env.action_none "satisfyAll"
1018 (fn () => write "\tSatisfy all\n")
1019
1020val () = Env.action_none "satisfyAny"
1021 (fn () => write "\tSatisfy any\n")
1022
7f012ffd
AC
1023val () = Env.action_one "forceType"
1024 ("type", Env.string)
1025 (fn ty => (write "\tForceType ";
1026 write ty;
1027 write "\n"))
1028
1029val () = Env.action_none "forceTypeOff"
1030 (fn () => write "\tForceType None\n")
1031
1032val () = Env.action_two "action"
1033 ("what", Env.string, "how", Env.string)
1034 (fn (what, how) => (write "\tAction ";
1035 write what;
1036 write " ";
1037 write how;
1038 write "\n"))
1039
1040val () = Env.action_one "addDefaultCharset"
1041 ("charset", Env.string)
1042 (fn ty => (write "\tAddDefaultCharset ";
1043 write ty;
1044 write "\n"))
1045
64e85bae 1046(*val () = Env.action_one "davSvn"
c8505e59
AC
1047 ("path", Env.string)
1048 (fn path => (write "\tDAV svn\n\tSVNPath ";
1049 write path;
1050 write "\n"))
1051
1052val () = Env.action_one "authzSvnAccessFile"
1053 ("path", Env.string)
1054 (fn path => (write "\tAuthzSVNAccessFile ";
1055 write path;
64e85bae 1056 write "\n"))*)
c8505e59 1057
0aed4302
AC
1058val () = Env.action_none "davFilesystem"
1059 (fn path => write "\tDAV filesystem\n")
1060
9d7fa346
AC
1061val () = Env.action_two "addDescription"
1062 ("description", Env.string, "patterns", Env.list Env.string)
1063 (fn (desc, pats) =>
1064 case pats of
1065 [] => ()
1066 | _ => (write "\tAddDescription \"";
1067 write (String.toString desc);
1068 write "\"";
1069 app (fn pat => (write " "; write pat)) pats;
1070 write "\n"))
1071
1817ed97
AC
1072val () = Env.action_two "addIcon"
1073 ("icon", Env.string, "patterns", Env.list Env.string)
1074 (fn (icon, pats) =>
1075 case pats of
1076 [] => ()
1077 | _ => (write "\tAddIcon \"";
1078 write icon;
1079 write "\"";
1080 app (fn pat => (write " "; write pat)) pats;
1081 write "\n"))
1082
9d7fa346
AC
1083val () = Env.action_one "indexOptions"
1084 ("options", Env.list autoindex_option)
1085 (fn opts =>
1086 case opts of
1087 [] => ()
1088 | _ => (write "\tIndexOptions";
1089 app (fn (opt, arg) =>
1090 (write " ";
1091 write opt;
1092 Option.app (fn arg =>
1093 (write "="; write arg)) arg)) opts;
1094 write "\n"))
1095
1817ed97
AC
1096val () = Env.action_one "indexIgnore"
1097 ("patterns", Env.list Env.string)
1098 (fn pats =>
1099 case pats of
1100 [] => ()
1101 | _ => (write "\tIndexIgnore";
1102 app (fn pat => (write " "; write pat)) pats;
1103 write "\n"))
1104
9d7fa346
AC
1105val () = Env.action_one "set_indexOptions"
1106 ("options", Env.list autoindex_option)
1107 (fn opts =>
1108 case opts of
1109 [] => ()
1110 | _ => (write "\tIndexOptions";
1111 app (fn (opt, arg) =>
1112 (write " +";
1113 write opt;
1114 Option.app (fn arg =>
1115 (write "="; write arg)) arg)) opts;
1116 write "\n"))
1117
1118val () = Env.action_one "unset_indexOptions"
1119 ("options", Env.list autoindex_option)
1120 (fn opts =>
1121 case opts of
1122 [] => ()
1123 | _ => (write "\tIndexOptions";
1124 app (fn (opt, _) =>
1125 (write " -";
1126 write opt)) opts;
1127 write "\n"))
1128
1129val () = Env.action_one "headerName"
1130 ("name", Env.string)
1131 (fn name => (write "\tHeaderName ";
1132 write name;
1133 write "\n"))
1134
1135val () = Env.action_one "readmeName"
1136 ("name", Env.string)
1137 (fn name => (write "\tReadmeName ";
1138 write name;
1139 write "\n"))
1140
eda33894
AC
1141val () = Env.action_two "setEnv"
1142 ("key", Env.string, "value", Env.string)
1143 (fn (key, value) => (write "\tSetEnv \"";
1144 write key;
1145 write "\" \"";
ca6ffb3f
AC
1146 write (String.translate (fn #"\"" => "\\\""
1147 | ch => str ch) value);
eda33894
AC
1148 write "\"\n"))
1149
42233a46
CE
1150val () = Env.action_three "setEnvIf"
1151 ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
1152 (fn (attribute, match, envs) =>
1153 case envs of
1154 [] => (print "WARNING: Skipped setEnvIf, no environment variables provided.\n")
1155 | envs =>
1156 (write "\tSetEnvIf\t\"";
1157 write attribute;
1158 write "\"\t\"";
1159 write match;
1160 write "\"";
1161 app (fn env => (write "\t"; write env)) envs;
1162 write "\n"))
1163
1164val () = Env.action_three "setEnvIfNoCase"
1165 ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
1166 (fn (attribute, match, envs) =>
1167 case envs of
1168 [] => (print "WARNING: Skipped setEnvIfNoCase, no environment variables provided.\n")
1169 | envs =>
24709d5a 1170 (write "\tSetEnvIfNoCase\t\"";
42233a46
CE
1171 write attribute;
1172 write "\"\t\"";
1173 write match;
1174 write "\"";
1175 app (fn env => (write "\t"; write env)) envs;
1176 write "\n"))
1177
f0062360
AC
1178val () = Env.action_one "diskCache"
1179 ("path", Env.string)
1180 (fn path => (write "\tCacheEnable disk \"";
1181 write path;
1182 write "\"\n"))
83bc6c45 1183
83bc6c45
AC
1184val () = Env.action_one "phpVersion"
1185 ("version", php_version)
4648ee8a 1186 (fn version => (write "\tAddHandler fcgid-script .php .phtml\n";
313442ed 1187 (* FIXME: only set kerberos wrapper of waklog is on *)
95798203 1188 (* won't be trivial, since we don't have access to node here *)
313442ed
CE
1189 write "\n\tFcgidWrapper \"";
1190 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
1191 write " ";
4648ee8a
CE
1192 write (Config.Apache.phpFastCgiWrapper version);
1193 write "\" .php .phtml\n"))
83bc6c45 1194
bcf547ec
AC
1195val () = Env.action_two "addType"
1196 ("mime type", Env.string, "extension", Env.string)
1197 (fn (mt, ext) => (write "\tAddType ";
1198 write mt;
1199 write " ";
1200 write ext;
1201 write "\n"))
1202
1203val filter = fn (EVar "includes", _) => SOME "INCLUDES"
1204 | (EVar "deflate", _) => SOME "DEFLATE"
1205 | _ => NONE
1206
1207val () = Env.action_two "addOutputFilter"
1208 ("filters", Env.list filter, "extensions", Env.list Env.string)
1209 (fn (f :: fs, exts as (_ :: _)) =>
1210 (write "\tAddOutputFilter ";
1211 write f;
1212 app (fn f => (write ";"; write f)) fs;
1213 app (fn ext => (write " "; write ext)) exts;
1214 write "\n")
1215 | _ => ())
1216
ef5ad69a
CE
1217val () = Env.action_one "sslCertificateChainFile"
1218 ("ssl_cacert_path", Env.string)
1219 (fn cacert =>
1220 if !sslEnabled then
1221 (write "\tSSLCertificateChainFile \"";
1222 write cacert;
1223 write "\"\n")
1224 else
1225 print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
1226
71420f8b 1227val () = Domain.registerResetLocal (fn () =>
7ad80c20 1228 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
71420f8b 1229
41c58daf
AC
1230val () = Domain.registerDescriber (Domain.considerAll
1231 [Domain.Extension {extension = "vhost",
d936cf4d 1232 heading = fn host => "Web vhost " ^ host ^ ":"},
41c58daf 1233 Domain.Extension {extension = "vhost_ssl",
d936cf4d 1234 heading = fn host => "SSL web vhost " ^ host ^ ":"}])
41c58daf 1235
e2166ae8
CE
1236val () = Env.action_one "allowEncodedSlashes"
1237 ("enable", Env.bool)
1238 (fn enable => (write "\tAllowEncodedSlashes ";
1239 write (if enable then "NoDecode" else "Off");
1240 write "\n"))
ecc307a0
AC
1241val () = Env.action_none "testNoHtaccess"
1242 (fn path => write "\tAllowOverride None\n")
1243
563e7792
AC
1244fun writeWaklogUserFile () =
1245 let
1246 val users = Acl.users ()
1247 val outf = TextIO.openOut Config.Apache.waklogUserFile
1248 in
1249 app (fn user => if String.isSuffix "_admin" user then
1250 ()
1251 else
1252 (TextIO.output (outf, "<Location /~");
1253 TextIO.output (outf, user);
1254 TextIO.output (outf, ">\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
1255 TextIO.output (outf, user);
1256 TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
1257 TextIO.output (outf, user);
1258 TextIO.output (outf, "\n</Location>\n\n"))) users;
1259 TextIO.closeOut outf
1260 end
1261
1262val () = Domain.registerOnUsersChange writeWaklogUserFile
1263
8a7c40fa 1264end