HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
apache: update rewriteLogLevel for Apache 2.4
[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
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
9180bde0
CE		 765val _ = Env.type_one "mod_rewrite_trace_level"
766 Env.int
767 (fn n => n > 0 andalso n <= 8)
768
c98b57cf
AC		 769val () = Env.action_one "rewriteLogLevel"
770 ("level", Env.int)
9180bde0 771 (fn 0 =>
c98b57cf 772 (checkRewrite ();
9180bde0
CE		 773 write "\tLogLevel rewrite:warn\n")
774 | level =>
775 (checkRewrite ();
776 write "\tLogLevel rewrite:trace";
777 write (Int.toString level);
778 write "\n"))
c98b57cf 779
d5754b53
AC		 780val () = Env.action_two "alias"
781 ("from", Env.string, "to", Env.string)
782 (fn (from, to) =>
783 (write "\tAlias\t";
784 write from;
785 write " ";
786 write to;
787 write "\n"))
788
789val () = Env.action_two "scriptAlias"
790 ("from", Env.string, "to", Env.string)
791 (fn (from, to) =>
792 (write "\tScriptAlias\t";
793 write from;
794 write " ";
795 write to;
796 write "\n"))
797
8c1de2ae
CE		 798val () = Env.action_two "fastScriptAlias"
799 ("from", Env.string, "to", Env.string)
800 (fn (from, to) =>
66d70ba2
CE		 801 let
802 (* mod_fcgid + kerberos limit this to working with
803 individual fcgi programs. assume the target path is a
804 file and any trailing `/' is just aliasing
805 syntax. Directory+File on the script is used to
806 activate fcgid instead of Location on the alias to
807 limit effects (alias+location also match in inverse
808 order causing pernicious side-effects *)
809 val fcgi_path = if String.sub (to, size to - 1) = #"/"
810 then
811 String.substring (to, 0, size to - 1)
812 else
813 to
814 val fcgi_dir = OS.Path.dir fcgi_path
815 val fcgi_file = OS.Path.file fcgi_path
816 in
817 write "\tAlias\t"; write from; write " "; write to; write "\n";
8c1de2ae 818
66d70ba2
CE		 819 write "\t<Directory "; write fcgi_dir; write ">\n";
820 write "\t<Files "; write fcgi_file; write ">\n";
821 write "\tSetHandler fcgid-script\n";
822
823 (* FIXME: only set kerberos wrapper of waklog is on *)
95798203 824 (* won't be trivial, since we don't have access to node here *)
66d70ba2
CE		 825 write "\tFcgidWrapper \"";
826 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
827 write " ";
828 write fcgi_path;
829 write "\"\n";
830
831 write "\t</Files>\n\t</Directory>\n"
832 end)
8c1de2ae 833
d5754b53
AC		 834val () = Env.action_two "errorDocument"
835 ("code", Env.string, "handler", Env.string)
836 (fn (code, handler) =>
989965b1
AC		 837 let
838 val hasSpaces = CharVector.exists Char.isSpace handler
d5754b53 839
989965b1
AC		 840 fun maybeQuote () =
841 if hasSpaces then
842 write "\""
843 else
844 ()
845 in
846 write "\tErrorDocument\t";
847 write code;
848 write " ";
849 maybeQuote ();
850 write handler;
851 maybeQuote ();
852 write "\n"
853 end)
f924c1cf 854
d441e69f
AC		 855val () = Env.action_one "options"
856 ("options", Env.list apache_option)
857 (fn opts =>
858 case opts of
859 [] => ()
860 | _ => (write "\tOptions";
861 app (fn opt => (write " "; write opt)) opts;
862 write "\n"))
863
864val () = Env.action_one "set_options"
865 ("options", Env.list apache_option)
866 (fn opts =>
867 case opts of
868 [] => ()
869 | _ => (write "\tOptions";
870 app (fn opt => (write " +"; write opt)) opts;
871 write "\n"))
872
873val () = Env.action_one "unset_options"
874 ("options", Env.list apache_option)
875 (fn opts =>
876 case opts of
877 [] => ()
878 | _ => (write "\tOptions";
879 app (fn opt => (write " -"; write opt)) opts;
880 write "\n"))
d5754b53 881
781ebc11
AC		 882val () = Env.action_one "cgiExtension"
883 ("extension", Env.string)
884 (fn ext => (write "\tAddHandler cgi-script ";
885 write ext;
886 write "\n"))
887
edd38024
AC		 888val () = Env.action_one "directoryIndex"
889 ("filenames", Env.list Env.string)
890 (fn opts =>
891 (write "\tDirectoryIndex";
892 app (fn opt => (write " "; write opt)) opts;
893 write "\n"))
894
129d3b57
CE		 895val () = Env.action_one "directorySlash"
896 ("enable", Env.bool)
897 (fn enable =>
898 (write "\tDirectorySlash ";
899 if enable then write "On" else write "Off";
900 write "\n"))
901
e519d696 902val () = Env.action_one "serverAliasHost"
edd38024
AC		 903 ("host", Env.string)
904 (fn host =>
905 (write "\tServerAlias ";
906 write host;
7f75d838
AC		 907 write "\n";
908 !aliaser host))
edd38024 909
e519d696
AC		 910val () = Env.action_one "serverAlias"
911 ("host", Env.string)
912 (fn host =>
913 (app
914 (fn dom =>
915 let
916 val full = host ^ "." ^ dom
917 in
918 write "\tServerAlias ";
919 write full;
920 write "\n";
921 !aliaser full
922 end)
923 (Domain.currentDomains ())))
924
925val () = Env.action_none "serverAliasDefault"
926 (fn () =>
927 (app
928 (fn dom =>
929 (write "\tServerAlias ";
930 write dom;
931 write "\n";
932 !aliaser dom))
933 (Domain.currentDomains ())))
934
2aeb9eec
AC		 935val authType = fn (EVar "basic", _) => SOME "basic"
936 | (EVar "digest", _) => SOME "digest"
35dc7746 937 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 938 | _ => NONE
939
8a5b34c9
AC		 940fun allowAuthType "kerberos" = !sslEnabled
941 | allowAuthType _ = true
942
2aeb9eec
AC		 943val () = Env.action_one "authType"
944 ("type", authType)
945 (fn ty =>
8a5b34c9
AC		 946 if allowAuthType ty then
947 (write "\tAuthType ";
948 write ty;
949 write "\n";
950 case ty of
f924c1cf 951 "kerberos" =>
417edb97 952 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		 953 | _ => ())
954 else
955 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 956
957val () = Env.action_one "authName"
958 ("name", Env.string)
959 (fn name =>
960 (write "\tAuthName \"";
961 write name;
962 write "\"\n"))
963
964val () = Env.action_one "authUserFile"
965 ("file", Env.string)
966 (fn name =>
967 (write "\tAuthUserFile ";
968 write name;
969 write "\n"))
970
58f4ce3b
CE		 971val () = Env.action_one "authGroupFile"
972 ("file", Env.string)
973 (fn name =>
974 (write "\tAuthGroupFile ";
975 write name;
976 write "\n"))
977
2aeb9eec
AC		 978val () = Env.action_none "requireValidUser"
979 (fn () => write "\tRequire valid-user\n")
980
981val () = Env.action_one "requireUser"
982 ("users", Env.list Env.string)
983 (fn names =>
984 case names of
985 [] => ()
986 | _ => (write "\tRequire user";
987 app (fn name => (write " "; write name)) names;
988 write "\n"))
989
990val () = Env.action_one "requireGroup"
991 ("groups", Env.list Env.string)
992 (fn names =>
993 case names of
994 [] => ()
995 | _ => (write "\tRequire group";
996 app (fn name => (write " "; write name)) names;
997 write "\n"))
998
999val () = Env.action_none "orderAllowDeny"
1000 (fn () => write "\tOrder allow,deny\n")
1001
1002val () = Env.action_none "orderDenyAllow"
1003 (fn () => write "\tOrder deny,allow\n")
1004
1005val () = Env.action_none "allowFromAll"
1006 (fn () => write "\tAllow from all\n")
1007
1008val () = Env.action_one "allowFrom"
1009 ("entries", Env.list Env.string)
1010 (fn names =>
1011 case names of
1012 [] => ()
1013 | _ => (write "\tAllow from";
1014 app (fn name => (write " "; write name)) names;
1015 write "\n"))
1016
1017val () = Env.action_none "denyFromAll"
1018 (fn () => write "\tDeny from all\n")
1019
1020val () = Env.action_one "denyFrom"
1021 ("entries", Env.list Env.string)
1022 (fn names =>
1023 case names of
1024 [] => ()
1025 | _ => (write "\tDeny from";
1026 app (fn name => (write " "; write name)) names;
1027 write "\n"))
1028
1029val () = Env.action_none "satisfyAll"
1030 (fn () => write "\tSatisfy all\n")
1031
1032val () = Env.action_none "satisfyAny"
1033 (fn () => write "\tSatisfy any\n")
1034
7f012ffd
AC		 1035val () = Env.action_one "forceType"
1036 ("type", Env.string)
1037 (fn ty => (write "\tForceType ";
1038 write ty;
1039 write "\n"))
1040
1041val () = Env.action_none "forceTypeOff"
1042 (fn () => write "\tForceType None\n")
1043
1044val () = Env.action_two "action"
1045 ("what", Env.string, "how", Env.string)
1046 (fn (what, how) => (write "\tAction ";
1047 write what;
1048 write " ";
1049 write how;
1050 write "\n"))
1051
1052val () = Env.action_one "addDefaultCharset"
1053 ("charset", Env.string)
1054 (fn ty => (write "\tAddDefaultCharset ";
1055 write ty;
1056 write "\n"))
1057
64e85bae 1058(*val () = Env.action_one "davSvn"
c8505e59
AC		 1059 ("path", Env.string)
1060 (fn path => (write "\tDAV svn\n\tSVNPath ";
1061 write path;
1062 write "\n"))
1063
1064val () = Env.action_one "authzSvnAccessFile"
1065 ("path", Env.string)
1066 (fn path => (write "\tAuthzSVNAccessFile ";
1067 write path;
64e85bae 1068 write "\n"))*)
c8505e59 1069
0aed4302
AC		 1070val () = Env.action_none "davFilesystem"
1071 (fn path => write "\tDAV filesystem\n")
1072
9d7fa346
AC		 1073val () = Env.action_two "addDescription"
1074 ("description", Env.string, "patterns", Env.list Env.string)
1075 (fn (desc, pats) =>
1076 case pats of
1077 [] => ()
1078 | _ => (write "\tAddDescription \"";
1079 write (String.toString desc);
1080 write "\"";
1081 app (fn pat => (write " "; write pat)) pats;
1082 write "\n"))
1083
1817ed97
AC		 1084val () = Env.action_two "addIcon"
1085 ("icon", Env.string, "patterns", Env.list Env.string)
1086 (fn (icon, pats) =>
1087 case pats of
1088 [] => ()
1089 | _ => (write "\tAddIcon \"";
1090 write icon;
1091 write "\"";
1092 app (fn pat => (write " "; write pat)) pats;
1093 write "\n"))
1094
9d7fa346
AC		 1095val () = Env.action_one "indexOptions"
1096 ("options", Env.list autoindex_option)
1097 (fn opts =>
1098 case opts of
1099 [] => ()
1100 | _ => (write "\tIndexOptions";
1101 app (fn (opt, arg) =>
1102 (write " ";
1103 write opt;
1104 Option.app (fn arg =>
1105 (write "="; write arg)) arg)) opts;
1106 write "\n"))
1107
1817ed97
AC		 1108val () = Env.action_one "indexIgnore"
1109 ("patterns", Env.list Env.string)
1110 (fn pats =>
1111 case pats of
1112 [] => ()
1113 | _ => (write "\tIndexIgnore";
1114 app (fn pat => (write " "; write pat)) pats;
1115 write "\n"))
1116
9d7fa346
AC		 1117val () = Env.action_one "set_indexOptions"
1118 ("options", Env.list autoindex_option)
1119 (fn opts =>
1120 case opts of
1121 [] => ()
1122 | _ => (write "\tIndexOptions";
1123 app (fn (opt, arg) =>
1124 (write " +";
1125 write opt;
1126 Option.app (fn arg =>
1127 (write "="; write arg)) arg)) opts;
1128 write "\n"))
1129
1130val () = Env.action_one "unset_indexOptions"
1131 ("options", Env.list autoindex_option)
1132 (fn opts =>
1133 case opts of
1134 [] => ()
1135 | _ => (write "\tIndexOptions";
1136 app (fn (opt, _) =>
1137 (write " -";
1138 write opt)) opts;
1139 write "\n"))
1140
1141val () = Env.action_one "headerName"
1142 ("name", Env.string)
1143 (fn name => (write "\tHeaderName ";
1144 write name;
1145 write "\n"))
1146
1147val () = Env.action_one "readmeName"
1148 ("name", Env.string)
1149 (fn name => (write "\tReadmeName ";
1150 write name;
1151 write "\n"))
1152
eda33894
AC		 1153val () = Env.action_two "setEnv"
1154 ("key", Env.string, "value", Env.string)
1155 (fn (key, value) => (write "\tSetEnv \"";
1156 write key;
1157 write "\" \"";
ca6ffb3f
AC		 1158 write (String.translate (fn #"\"" => "\\\""
1159 | ch => str ch) value);
eda33894
AC		 1160 write "\"\n"))
1161
42233a46
CE		 1162val () = Env.action_three "setEnvIf"
1163 ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
1164 (fn (attribute, match, envs) =>
1165 case envs of
1166 [] => (print "WARNING: Skipped setEnvIf, no environment variables provided.\n")
1167 | envs =>
1168 (write "\tSetEnvIf\t\"";
1169 write attribute;
1170 write "\"\t\"";
1171 write match;
1172 write "\"";
1173 app (fn env => (write "\t"; write env)) envs;
1174 write "\n"))
1175
1176val () = Env.action_three "setEnvIfNoCase"
1177 ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
1178 (fn (attribute, match, envs) =>
1179 case envs of
1180 [] => (print "WARNING: Skipped setEnvIfNoCase, no environment variables provided.\n")
1181 | envs =>
24709d5a 1182 (write "\tSetEnvIfNoCase\t\"";
42233a46
CE		 1183 write attribute;
1184 write "\"\t\"";
1185 write match;
1186 write "\"";
1187 app (fn env => (write "\t"; write env)) envs;
1188 write "\n"))
1189
f0062360
AC		 1190val () = Env.action_one "diskCache"
1191 ("path", Env.string)
1192 (fn path => (write "\tCacheEnable disk \"";
1193 write path;
1194 write "\"\n"))
83bc6c45 1195
83bc6c45
AC		 1196val () = Env.action_one "phpVersion"
1197 ("version", php_version)
4648ee8a 1198 (fn version => (write "\tAddHandler fcgid-script .php .phtml\n";
313442ed 1199 (* FIXME: only set kerberos wrapper of waklog is on *)
95798203 1200 (* won't be trivial, since we don't have access to node here *)
313442ed
CE		 1201 write "\n\tFcgidWrapper \"";
1202 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
1203 write " ";
4648ee8a
CE		 1204 write (Config.Apache.phpFastCgiWrapper version);
1205 write "\" .php .phtml\n"))
83bc6c45 1206
bcf547ec
AC		 1207val () = Env.action_two "addType"
1208 ("mime type", Env.string, "extension", Env.string)
1209 (fn (mt, ext) => (write "\tAddType ";
1210 write mt;
1211 write " ";
1212 write ext;
1213 write "\n"))
1214
1215val filter = fn (EVar "includes", _) => SOME "INCLUDES"
1216 | (EVar "deflate", _) => SOME "DEFLATE"
1217 | _ => NONE
1218
1219val () = Env.action_two "addOutputFilter"
1220 ("filters", Env.list filter, "extensions", Env.list Env.string)
1221 (fn (f :: fs, exts as (_ :: _)) =>
1222 (write "\tAddOutputFilter ";
1223 write f;
1224 app (fn f => (write ";"; write f)) fs;
1225 app (fn ext => (write " "; write ext)) exts;
1226 write "\n")
1227 | _ => ())
1228
ef5ad69a
CE		 1229val () = Env.action_one "sslCertificateChainFile"
1230 ("ssl_cacert_path", Env.string)
1231 (fn cacert =>
1232 if !sslEnabled then
1233 (write "\tSSLCertificateChainFile \"";
1234 write cacert;
1235 write "\"\n")
1236 else
1237 print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
1238
71420f8b 1239val () = Domain.registerResetLocal (fn () =>
7ad80c20 1240 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
71420f8b 1241
41c58daf
AC		 1242val () = Domain.registerDescriber (Domain.considerAll
1243 [Domain.Extension {extension = "vhost",
d936cf4d 1244 heading = fn host => "Web vhost " ^ host ^ ":"},
41c58daf 1245 Domain.Extension {extension = "vhost_ssl",
d936cf4d 1246 heading = fn host => "SSL web vhost " ^ host ^ ":"}])
41c58daf 1247
e2166ae8
CE		 1248val () = Env.action_one "allowEncodedSlashes"
1249 ("enable", Env.bool)
1250 (fn enable => (write "\tAllowEncodedSlashes ";
1251 write (if enable then "NoDecode" else "Off");
1252 write "\n"))
ecc307a0
AC		 1253val () = Env.action_none "testNoHtaccess"
1254 (fn path => write "\tAllowOverride None\n")
1255
563e7792
AC		 1256fun writeWaklogUserFile () =
1257 let
1258 val users = Acl.users ()
1259 val outf = TextIO.openOut Config.Apache.waklogUserFile
1260 in
1261 app (fn user => if String.isSuffix "_admin" user then
1262 ()
1263 else
1264 (TextIO.output (outf, "<Location /~");
1265 TextIO.output (outf, user);
1266 TextIO.output (outf, ">\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
1267 TextIO.output (outf, user);
1268 TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
1269 TextIO.output (outf, user);
1270 TextIO.output (outf, "\n</Location>\n\n"))) users;
1271 TextIO.closeOut outf
1272 end
1273
1274val () = Domain.registerOnUsersChange writeWaklogUserFile
1275
8a7c40fa 1276end
Unnamed repository; edit this file to name it for gitweb.