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