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