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