HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
apache: add ipv6 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
c6923cdb 3 * Copyright (c) 2013 Clinton Ebadi
8a7c40fa
AC		 4 *
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License
7 * as published by the Free Software Foundation; either version 2
8 * of the License, or (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 *)
19
20(* Apache HTTPD handling *)
21
22structure Apache :> APACHE = struct
23
24open Ast
25
128e7b0b
AC		 26val dl = ErrorMsg.dummyLoc
27
de5351c7
AC		 28fun webNode node =
29 List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
30 orelse (Domain.hasPriv "www"
31 andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)
32
60695e99
AC		 33val _ = Env.type_one "web_node"
34 Env.string
de5351c7 35 webNode
60695e99 36
ce01b51a
AC		 37val _ = Env.registerFunction ("web_node_to_node",
38 fn [e] => SOME e
39 | _ => NONE)
40
b5f2d506 41fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
f924c1cf
CE		 42 SOME (node, Domain.nodeIp node, Domain.nodeIpv6 node)
43 | webPlace (EApp ((EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _), (EString ipv6, _)), _) =
44 SOME (node, ip, ipv6)
128e7b0b
AC		 45 | webPlace _ = NONE
46
b5f2d506 47fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
128e7b0b
AC		 48
49val _ = Env.registerFunction ("web_place_to_web_node",
f924c1cf 50 fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
128e7b0b
AC		 51 | _ => NONE)
52
53val _ = Env.registerFunction ("web_place_to_node",
f924c1cf 54 fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
128e7b0b
AC		 55 | _ => NONE)
56
57val _ = Env.registerFunction ("web_place_to_ip",
f924c1cf
CE		 58 fn [e] => Option.map (fn (_, ip, _) => (EString ip, dl)) (webPlace e)
59 | _ => NONE)
60
61val _ = Env.registerFunction ("web_place_to_ipv6",
62 fn [e] => Option.map (fn (_, _, ipv6) => (EString ipv6, dl)) (webPlace e)
63 | _ => NONE)
128e7b0b 64
f8dfbbcc
AC		 65val _ = Env.type_one "proxy_port"
66 Env.int
e95a129e
AC		 67 (fn n => n > 1024)
68
621629dc
CE		 69fun validProxyTarget default s =
70 case String.fields (fn ch => ch = #":") s of
71 "http" :: host :: rest =>
72 let
73 val rest = String.concatWith ":" rest
74 in
75 if List.exists (fn h' => host = h') (map (fn h => String.concat ["//", h]) Config.Apache.proxyHosts)
76 then
77 CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
78 andalso ch <> #"\"" andalso ch <> #"'") rest
79 andalso case String.fields (fn ch => ch = #"/") rest of
80 port :: _ =>
81 (case Int.fromString port of
82 NONE => default s
83 | SOME n => n > 1024 orelse default s)
84 | _ => default s
85 else
86 default s
87 end
88 | _ => default s
89
e95a129e
AC		 90val _ = Env.type_one "proxy_target"
91 Env.string
621629dc
CE		 92 (validProxyTarget (fn s => List.exists (fn s' => s = s') (Config.Apache.proxyTargets @ ["!"])))
93
94val _ = Env.type_one "proxy_reverse_target"
95 Env.string
96 (validProxyTarget (fn s => List.exists (fn s' => s = s') Config.Apache.proxyTargets))
f8dfbbcc
AC		 97
98val _ = Env.type_one "rewrite_arg"
99 Env.string
100 (CharVector.all Char.isAlphaNum)
101
00a13ad8
AC		 102val _ = Env.type_one "suexec_flag"
103 Env.bool
104 (fn b => b orelse Domain.hasPriv "www")
105
931aae14
AC		 106val _ = Env.type_one "regexp"
107 Env.string
108 Pcre.validRegexp
109
2882ee37
AC		 110fun validLocation s =
111 size s > 0 andalso size s < 1000 andalso CharVector.all
112 (fn ch => Char.isAlphaNum ch
113 orelse ch = #"-"
114 orelse ch = #"_"
115 orelse ch = #"."
666ed674
AC		 116 orelse ch = #"/"
117 orelse ch = #"~") s
2882ee37
AC		 118
119val _ = Env.type_one "location"
120 Env.string
121 validLocation
122
434a7b1f
AC		 123fun validCert s = Acl.query {user = Domain.getUser (),
124 class = "cert",
125 value = s}
126
ef5ad69a
CE		 127fun validCaCert s = Acl.query {user = Domain.getUser (),
128 class = "cacert",
129 value = s}
130
434a7b1f
AC		 131val _ = Env.type_one "ssl_cert_path"
132 Env.string
133 validCert
134
ef5ad69a
CE		 135val _ = Env.type_one "ssl_cacert_path"
136 Env.string
137 validCaCert
138
434a7b1f
AC		 139fun ssl e = case e of
140 (EVar "no_ssl", _) => SOME NONE
141 | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
142 | _ => NONE
143
781ebc11
AC		 144fun validExtension s =
145 size s > 0
146 andalso size s < 20
147 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") s
148
149val _ = Env.type_one "file_extension"
150 Env.string
151 validExtension
152
d08b9cf2
CE		 153val _ = Env.registerFunction ("defaultServerAdmin",
154 fn [] => SOME (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)
155 | _ => NONE)
f8dfbbcc
AC		 156
157val redirect_code = fn (EVar "temp", _) => SOME "temp"
158 | (EVar "permanent", _) => SOME "permanent"
159 | (EVar "seeother", _) => SOME "seeother"
160 | (EVar "redir300", _) => SOME "300"
161 | (EVar "redir301", _) => SOME "301"
162 | (EVar "redir302", _) => SOME "302"
163 | (EVar "redir303", _) => SOME "303"
164 | (EVar "redir304", _) => SOME "304"
165 | (EVar "redir305", _) => SOME "305"
166 | (EVar "redir307", _) => SOME "307"
7e588778 167 | (EVar "notfound", _) => SOME "404"
f8dfbbcc
AC		 168 | _ => NONE
169
170val flag = fn (EVar "redirect", _) => SOME "R"
171 | (EVar "forbidden", _) => SOME "F"
172 | (EVar "gone", _) => SOME "G"
173 | (EVar "last", _) => SOME "L"
174 | (EVar "chain", _) => SOME "C"
175 | (EVar "nosubreq", _) => SOME "NS"
176 | (EVar "nocase", _) => SOME "NC"
177 | (EVar "qsappend", _) => SOME "QSA"
178 | (EVar "noescape", _) => SOME "NE"
179 | (EVar "passthrough", _) => SOME "PT"
180 | (EApp ((EVar "mimeType", _), e), _) =>
181 Option.map (fn s => "T=" ^ s) (Env.string e)
182 | (EApp ((EVar "redirectWith", _), e), _) =>
183 Option.map (fn s => "R=" ^ s) (redirect_code e)
184 | (EApp ((EVar "skip", _), e), _) =>
185 Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
186 | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
187 (case Env.string e1 of
188 NONE => NONE
189 | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
190 (Env.string e2))
191
192 | _ => NONE
193
e95a129e
AC		 194val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
195 | (EVar "ornext", _) => SOME "OR"
196 | _ => NONE
197
d441e69f
AC		 198val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
199 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
200 | (EVar "indexes", _) => SOME "Indexes"
22eaa950 201 | (EVar "followSymLinks", _) => SOME "FollowSymLinks"
c6923cdb 202 | (EVar "multiViews", _) => SOME "MultiViews"
d441e69f
AC		 203 | _ => NONE
204
9d7fa346
AC		 205val autoindex_width = fn (EVar "autofit", _) => SOME "*"
206 | (EApp ((EVar "characters", _), n), _) =>
207 Option.map Int.toString (Env.int n)
208 | _ => NONE
209
210val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
211 Option.map (fn w => ("DescriptionWidth", SOME w))
212 (autoindex_width w)
213 | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE)
214 | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE)
215 | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE)
216 | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE)
217 | (EApp ((EVar "iconHeight", _), n), _) =>
218 Option.map (fn w => ("IconHeight", SOME (Int.toString w)))
219 (Env.int n)
220 | (EApp ((EVar "iconWidth", _), n), _) =>
221 Option.map (fn w => ("IconWidth", SOME (Int.toString w)))
222 (Env.int n)
223 | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE)
224 | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE)
225 | (EApp ((EVar "nameWidth", _), w), _) =>
226 Option.map (fn w => ("NameWidth", SOME w))
227 (autoindex_width w)
228 | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE)
229 | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE)
230 | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE)
231 | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE)
232 | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE)
233 | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE)
234 | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE)
235 | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE)
236 | (EVar "trackModified", _) => SOME ("TrackModified", NONE)
237 | (EVar "versionSort", _) => SOME ("VersionSort", NONE)
238 | (EVar "xhtml", _) => SOME ("XHTML", NONE)
239
240 | _ => NONE
f8dfbbcc 241
fb09779a
AC		 242val interval_base = fn (EVar "access", _) => SOME "access"
243 | (EVar "modification", _) => SOME "modification"
244 | _ => NONE
245
246val interval = fn (EVar "years", _) => SOME "years"
247 | (EVar "months", _) => SOME "months"
248 | (EVar "weeks", _) => SOME "weeks"
249 | (EVar "days", _) => SOME "days"
250 | (EVar "hours", _) => SOME "hours"
251 | (EVar "minutes", _) => SOME "minutes"
252 | (EVar "seconds", _) => SOME "seconds"
253 | _ => NONE
254
8a7c40fa 255val vhostsChanged = ref false
8e965b2d 256val logDeleted = ref false
ffd50ec7 257val delayedLogMoves = ref (fn () => ())
8a7c40fa
AC		 258
259val () = Slave.registerPreHandler
8e965b2d 260 (fn () => (vhostsChanged := false;
ffd50ec7
AC		 261 logDeleted := false;
262 delayedLogMoves := (fn () => print "Executing delayed log moves/deletes.\n")))
8a7c40fa 263
7db53a0b
AC		 264fun findVhostUser fname =
265 let
266 val inf = TextIO.openIn fname
267
268 fun loop () =
269 case TextIO.inputLine inf of
270 NONE => NONE
271 | SOME line =>
00a13ad8
AC		 272 if String.isPrefix "# Owner: " line then
273 case String.tokens Char.isSpace line of
274 [_, _, user] => SOME user
275 | _ => NONE
276 else
277 loop ()
7db53a0b
AC		 278 in
279 loop ()
280 before TextIO.closeIn inf
3a941c29 281 end handle _ => NONE
7db53a0b 282
55d4a268
AC		 283val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
284
285fun isVersion1 node =
f8ef6c20
AC		 286 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
287 | _ => false) webNodes_full
55d4a268
AC		 288
289fun imVersion1 () = isVersion1 (Slave.hostname ())
290
f8ef6c20
AC		 291fun isWaklog node =
292 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
293 | _ => false) webNodes_full
294
55d4a268
AC		 295fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
296fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
297fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
c17d0537 298fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
55d4a268 299
b59d9074 300fun logDir {user, node, vhostId} =
2a7d2818 301 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
409542d7 302 "/",
b59d9074
AC		 303 node,
304 "/",
305 vhostId]
306
f086616f
AC		 307fun realLogDir {user, node, vhostId} =
308 String.concat [Config.Apache.realLogDirOf user,
309 "/",
310 node,
311 "/",
312 vhostId]
313
8a7c40fa 314val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 315 let
316 val spl = OS.Path.splitDirFile (#file fs)
317 in
318 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 319 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
320 val realVhostFile = OS.Path.joinDirFile
321 {dir = Config.Apache.confDir,
322 file = #file spl}
323
324 val user = findVhostUser (#file fs)
19026493
AC		 325 val oldUser = case #action fs of
326 Slave.Delete false => user
327 | _ => findVhostUser realVhostFile
3a941c29
AC		 328 in
329 if (oldUser = NONE andalso #action fs <> Slave.Add)
1638d5a2 330 orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
3a941c29
AC		 331 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
332 else
333 let
5b07cebd 334 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
b59d9074
AC		 335 OS.Path.base (#file spl) ^ ".ssl"
336 else
337 OS.Path.base (#file spl)
338
3a941c29 339 fun realLogDir user =
b59d9074
AC		 340 logDir {user = valOf user,
341 node = Slave.hostname (),
342 vhostId = vhostId}
c17d0537
AC		 343
344 fun backupLogs () =
345 OS.Path.joinDirFile
346 {dir = Config.Apache.backupLogDirOf
347 (isVersion1 (Slave.hostname ())),
348 file = vhostId}
3a941c29
AC		 349 in
350 vhostsChanged := true;
351 case #action fs of
1638d5a2 352 Slave.Delete _ =>
31b50af0
AC		 353 let
354 val ldir = realLogDir oldUser
ffd50ec7 355 val dlm = !delayedLogMoves
31b50af0
AC		 356 in
357 if !logDeleted then
358 ()
359 else
ffd50ec7 360 ((*ignore (OS.Process.system (down ()));*)
c17d0537 361 ignore (OS.Process.system (fixperms ()));
31b50af0
AC		 362 logDeleted := true);
363 ignore (OS.Process.system (Config.rm
364 ^ " -rf "
365 ^ realVhostFile));
ffd50ec7
AC		 366 delayedLogMoves := (fn () => (dlm ();
367 Slave.moveDirCreate {from = ldir,
368 to = backupLogs ()}))
31b50af0 369 end
3a941c29
AC		 370 | Slave.Add =>
371 let
372 val rld = realLogDir user
373 in
374 ignore (OS.Process.system (Config.cp
375 ^ " "
376 ^ #file fs
377 ^ " "
378 ^ realVhostFile));
379 if Posix.FileSys.access (rld, []) then
380 ()
381 else
c17d0537 382 Slave.moveDirCreate {from = backupLogs (),
31b50af0 383 to = rld}
3a941c29 384 end
f924c1cf 385
3a941c29
AC		 386 | _ =>
387 (ignore (OS.Process.system (Config.cp
388 ^ " "
389 ^ #file fs
390 ^ " "
391 ^ realVhostFile));
392 if user <> oldUser then
393 let
394 val old = realLogDir oldUser
395 val rld = realLogDir user
ffd50ec7
AC		 396
397 val dlm = !delayedLogMoves
3a941c29
AC		 398 in
399 if !logDeleted then
400 ()
401 else
ffd50ec7 402 ((*ignore (OS.Process.system (down ()));*)
3a941c29 403 logDeleted := true);
ffd50ec7
AC		 404 delayedLogMoves := (fn () => (dlm ();
405 ignore (OS.Process.system (Config.rm
406 ^ " -rf "
407 ^ realLogDir oldUser))));
3a941c29
AC		 408 if Posix.FileSys.access (rld, []) then
409 ()
410 else
409542d7 411 Slave.mkDirAll rld
3a941c29
AC		 412 end
413 else
414 ())
415 end
416 end
7a2b27f0
AC		 417 else
418 ()
419 end)
8a7c40fa
AC		 420
421val () = Slave.registerPostHandler
422 (fn () =>
423 (if !vhostsChanged then
ffd50ec7
AC		 424 (Slave.shellF ([reload ()],
425 fn cl => "Error reloading Apache with " ^ cl);
426 if !logDeleted then !delayedLogMoves () else ())
8a7c40fa
AC		 427 else
428 ()))
429
7a2b27f0
AC		 430val vhostFiles : (string * TextIO.outstream) list ref = ref []
431fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
432fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 433
f8dfbbcc 434val rewriteEnabled = ref false
ce01b51a 435val localRewriteEnabled = ref false
fb09779a
AC		 436val expiresEnabled = ref false
437val localExpiresEnabled = ref false
c98b57cf
AC		 438val currentVhost = ref ""
439val currentVhostId = ref ""
8a5b34c9 440val sslEnabled = ref false
f8dfbbcc 441
7a2b27f0 442val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 443fun registerPre f =
444 let
445 val old = !pre
446 in
447 pre := (fn x => (old x; f x))
448 end
449
450val post = ref (fn () => ())
451fun registerPost f =
452 let
453 val old = !post
454 in
455 post := (fn () => (old (); f ()))
456 end
457
e9f528ab
AC		 458fun doPre x = !pre x
459fun doPost () = !post ()
460
7f75d838
AC		 461val aliaser = ref (fn _ : string => ())
462fun registerAliaser f =
463 let
464 val old = !aliaser
465 in
466 aliaser := (fn x => (old x; f x))
467 end
468
57e066bb
AC		 469fun vhostPost () = (!post ();
470 write "</VirtualHost>\n";
471 app (TextIO.closeOut o #2) (!vhostFiles))
2a7d2818 472
95798203 473val php_version = fn (EVar "fast_php", _) => SOME 6
42782c79 474 | _ => NONE
e7482df3 475
57e066bb
AC		 476fun vhostBody (env, makeFullHost) =
477 let
478 val places = Env.env (Env.list webPlace) (env, "WebPlaces")
479
480 val ssl = Env.env ssl (env, "SSL")
481 val user = Env.env Env.string (env, "User")
482 val group = Env.env Env.string (env, "Group")
483 val docroot = Env.env Env.string (env, "DocumentRoot")
484 val sadmin = Env.env Env.string (env, "ServerAdmin")
485 val suexec = Env.env Env.bool (env, "SuExec")
e7482df3 486 val php = Env.env php_version (env, "PhpVersion")
57e066bb
AC		 487
488 val fullHost = makeFullHost (Domain.currentDomain ())
489 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
490 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
491 in
492 currentVhost := fullHost;
493 currentVhostId := vhostId;
494 sslEnabled := Option.isSome ssl;
495
496 rewriteEnabled := false;
497 localRewriteEnabled := false;
fb09779a
AC		 498 expiresEnabled := false;
499 localExpiresEnabled := false;
f924c1cf 500 vhostFiles := map (fn (node, ip, ipv6) =>
57e066bb
AC		 501 let
502 val file = Domain.domainFile {node = node,
503 name = confFile}
504
505 val ld = logDir {user = user, node = node, vhostId = vhostId}
506 in
507 TextIO.output (file, "# Owner: ");
508 TextIO.output (file, user);
509 TextIO.output (file, "\n<VirtualHost ");
f924c1cf 510
57e066bb
AC		 511 TextIO.output (file, ip);
512 TextIO.output (file, ":");
513 TextIO.output (file, case ssl of
514 SOME _ => "443"
515 | NONE => "80");
f924c1cf
CE		 516
517 TextIO.output (file, " [");
518 TextIO.output (file, ipv6);
519 TextIO.output (file, "]");
520 TextIO.output (file, ":");
521 TextIO.output (file, case ssl of
522 SOME _ => "443"
523 | NONE => "80");
524
57e066bb
AC		 525 TextIO.output (file, ">\n");
526 TextIO.output (file, "\tErrorLog ");
527 TextIO.output (file, ld);
528 TextIO.output (file, "/error.log\n\tCustomLog ");
529 TextIO.output (file, ld);
530 TextIO.output (file, "/access.log combined\n");
531 TextIO.output (file, "\tServerName ");
532 TextIO.output (file, fullHost);
533 app
534 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
535 TextIO.output (file, makeFullHost dom)))
536 (Domain.currentAliasDomains ());
537
538 if suexec then
539 if isVersion1 node then
540 (TextIO.output (file, "\n\tUser ");
00a13ad8 541 TextIO.output (file, user);
57e066bb
AC		 542 TextIO.output (file, "\n\tGroup ");
543 TextIO.output (file, group))
544 else
545 (TextIO.output (file, "\n\tSuexecUserGroup ");
d5601036
AC		 546 TextIO.output (file, user);
547 TextIO.output (file, " ");
95798203 548 TextIO.output (file, group))
57e066bb
AC		 549 else
550 ();
551
552 if isWaklog node then
553 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
554 TextIO.output (file, user);
555 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
556 TextIO.output (file, user))
557 else
558 ();
559
560 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
561 TextIO.output (file, user);
562 TextIO.output (file, "/DAVLock");
563
95798203 564 if php = 6
42782c79 565 then
95798203 566 (* fastcgi php 5.6, using version 6 since php6 doesn't exist *)
42782c79 567 (TextIO.output (file, "\n\tAddHandler fcgid-script .php .phtml");
313442ed 568 map (fn ext => (TextIO.output (file, "\n\tFcgidWrapper \"");
95798203
CE		 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 ();
313442ed
CE		 575 TextIO.output (file, Config.Apache.phpFastCgiWrapper);
576 TextIO.output (file, "\" ");
577 TextIO.output (file, ext)))
578 [".php", ".phtml"];
579 ())
42782c79 580 else
e7482df3
AC		 581 (TextIO.output (file, "\n\tAddHandler x-httpd-php");
582 TextIO.output (file, Int.toString php);
42782c79
CE		 583 TextIO.output (file, " .php .phtml"));
584 (ld, file)
57e066bb
AC		 585 end)
586 places;
587 write "\n\tDocumentRoot ";
588 write docroot;
589 write "\n\tServerAdmin ";
590 write sadmin;
591 case ssl of
592 SOME cert =>
593 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
594 write cert)
595 | NONE => ();
596 write "\n";
597 !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
598 app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
f924c1cf 599 end
3f84c976 600
57e066bb
AC		 601val () = Env.containerV_one "vhost"
602 ("host", Env.string)
603 (fn (env, host) => vhostBody (env, fn dom => host ^ "." ^ dom),
604 vhostPost)
605
606val () = Env.containerV_none "vhostDefault"
607 (fn env => vhostBody (env, fn dom => dom),
608 vhostPost)
8a7c40fa 609
ce01b51a
AC		 610val inLocal = ref false
611
2882ee37
AC		 612val () = Env.container_one "location"
613 ("prefix", Env.string)
614 (fn prefix =>
615 (write "\t<Location ";
616 write prefix;
ce01b51a
AC		 617 write ">\n";
618 inLocal := true),
619 fn () => (write "\t</Location>\n";
620 inLocal := false;
fb09779a
AC		 621 localRewriteEnabled := false;
622 localExpiresEnabled := false))
2882ee37
AC		 623
624val () = Env.container_one "directory"
625 ("directory", Env.string)
626 (fn directory =>
627 (write "\t<Directory ";
628 write directory;
ce01b51a
AC		 629 write ">\n";
630 inLocal := true),
631 fn () => (write "\t</Directory>\n";
632 inLocal := false;
fb09779a
AC		 633 localRewriteEnabled := false;
634 localExpiresEnabled := false))
2882ee37 635
767fe695
AC		 636val () = Env.container_one "filesMatch"
637 ("regexp", Env.string)
638 (fn prefix =>
639 (write "\t<FilesMatch \"";
640 write prefix;
641 write "\">\n"),
642 fn () => (write "\t</FilesMatch>\n";
fb09779a
AC		 643 localRewriteEnabled := false;
644 localExpiresEnabled := false))
767fe695 645
f8dfbbcc 646fun checkRewrite () =
ce01b51a 647 if !inLocal then
cf283351 648 if !localRewriteEnabled then
ce01b51a
AC		 649 ()
650 else
651 (write "\tRewriteEngine on\n";
652 localRewriteEnabled := true)
653 else if !rewriteEnabled then
f8dfbbcc
AC		 654 ()
655 else
656 (write "\tRewriteEngine on\n";
657 rewriteEnabled := true)
658
fb09779a
AC		 659fun checkExpires () =
660 if !inLocal then
661 if !localExpiresEnabled then
662 ()
663 else
664 (write "\tExpiresActive on\n";
665 localExpiresEnabled := true)
666 else if !expiresEnabled then
667 ()
668 else
669 (write "\tExpiresActive on\n";
670 expiresEnabled := true)
671
f8dfbbcc
AC		 672val () = Env.action_three "localProxyRewrite"
673 ("from", Env.string, "to", Env.string, "port", Env.int)
674 (fn (from, to, port) =>
675 (checkRewrite ();
06bd8215 676 write "\tRewriteRule\t\"";
f8dfbbcc 677 write from;
06bd8215 678 write "\"\thttp://localhost:";
f8dfbbcc
AC		 679 write (Int.toString port);
680 write "/";
681 write to;
682 write " [P]\n"))
683
fb09779a
AC		 684val () = Env.action_four "expiresByType"
685 ("mime", Env.string, "base", interval_base, "num", Env.int, "inter", interval)
686 (fn (mime, base, num, inter) =>
687 (checkExpires ();
688 write "\tExpiresByType\t\"";
689 write mime;
690 write "\"\t\"";
691 write base;
692 write " plus ";
693 if num < 0 then
694 (write "-";
695 write (Int.toString (~num)))
696 else
697 write (Int.toString num);
698 write " ";
699 write inter;
700 write "\"\n"))
701
e95a129e
AC		 702val () = Env.action_two "proxyPass"
703 ("from", Env.string, "to", Env.string)
704 (fn (from, to) =>
705 (write "\tProxyPass\t";
706 write from;
707 write "\t";
708 write to;
36c7edfa 709 write "\tretry=0\n"))
e95a129e
AC		 710
711val () = Env.action_two "proxyPassReverse"
712 ("from", Env.string, "to", Env.string)
713 (fn (from, to) =>
714 (write "\tProxyPassReverse\t";
715 write from;
716 write "\t";
717 write to;
718 write "\n"))
f8dfbbcc 719
93d62353
CE		 720val () = Env.action_one "proxyPreserveHost"
721 ("enable", Env.bool)
722 (fn (enable) =>
723 (write "\tProxyPreserveHost\t";
724 if enable then write "On" else write "Off";
725 write "\n"))
726
f8dfbbcc
AC		 727val () = Env.action_three "rewriteRule"
728 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
729 (fn (from, to, flags) =>
730 (checkRewrite ();
06bd8215 731 write "\tRewriteRule\t\"";
f8dfbbcc 732 write from;
06bd8215 733 write "\"\t\"";
f8dfbbcc 734 write to;
06bd8215 735 write "\"";
f8dfbbcc
AC		 736 case flags of
737 [] => ()
738 | flag::rest => (write " [";
739 write flag;
740 app (fn flag => (write ",";
741 write flag)) rest;
742 write "]");
743 write "\n"))
744
e95a129e
AC		 745val () = Env.action_three "rewriteCond"
746 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
747 (fn (from, to, flags) =>
748 (checkRewrite ();
06bd8215 749 write "\tRewriteCond\t\"";
e95a129e 750 write from;
06bd8215 751 write "\"\t\"";
e95a129e 752 write to;
06bd8215 753 write "\"";
e95a129e
AC		 754 case flags of
755 [] => ()
756 | flag::rest => (write " [";
757 write flag;
758 app (fn flag => (write ",";
759 write flag)) rest;
760 write "]");
761 write "\n"))
762
94b7b11a
AC		 763val () = Env.action_one "rewriteBase"
764 ("prefix", Env.string)
765 (fn prefix =>
766 (checkRewrite ();
06bd8215 767 write "\tRewriteBase\t\"";
94b7b11a 768 write prefix;
06bd8215 769 write "\"\n"))
94b7b11a 770
c98b57cf
AC		 771val () = Env.action_one "rewriteLogLevel"
772 ("level", Env.int)
773 (fn level =>
774 (checkRewrite ();
775 write "\tRewriteLog ";
7a2b27f0 776 write' (fn x => x);
c98b57cf
AC		 777 write "/rewrite.log\n\tRewriteLogLevel ";
778 write (Int.toString level);
779 write "\n"))
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
e519d696 896val () = Env.action_one "serverAliasHost"
edd38024
AC		 897 ("host", Env.string)
898 (fn host =>
899 (write "\tServerAlias ";
900 write host;
7f75d838
AC		 901 write "\n";
902 !aliaser host))
edd38024 903
e519d696
AC		 904val () = Env.action_one "serverAlias"
905 ("host", Env.string)
906 (fn host =>
907 (app
908 (fn dom =>
909 let
910 val full = host ^ "." ^ dom
911 in
912 write "\tServerAlias ";
913 write full;
914 write "\n";
915 !aliaser full
916 end)
917 (Domain.currentDomains ())))
918
919val () = Env.action_none "serverAliasDefault"
920 (fn () =>
921 (app
922 (fn dom =>
923 (write "\tServerAlias ";
924 write dom;
925 write "\n";
926 !aliaser dom))
927 (Domain.currentDomains ())))
928
2aeb9eec
AC		 929val authType = fn (EVar "basic", _) => SOME "basic"
930 | (EVar "digest", _) => SOME "digest"
35dc7746 931 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 932 | _ => NONE
933
8a5b34c9
AC		 934fun allowAuthType "kerberos" = !sslEnabled
935 | allowAuthType _ = true
936
2aeb9eec
AC		 937val () = Env.action_one "authType"
938 ("type", authType)
939 (fn ty =>
8a5b34c9
AC		 940 if allowAuthType ty then
941 (write "\tAuthType ";
942 write ty;
943 write "\n";
944 case ty of
f924c1cf 945 "kerberos" =>
417edb97 946 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		 947 | _ => ())
948 else
949 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 950
951val () = Env.action_one "authName"
952 ("name", Env.string)
953 (fn name =>
954 (write "\tAuthName \"";
955 write name;
956 write "\"\n"))
957
958val () = Env.action_one "authUserFile"
959 ("file", Env.string)
960 (fn name =>
961 (write "\tAuthUserFile ";
962 write name;
963 write "\n"))
964
58f4ce3b
CE		 965val () = Env.action_one "authGroupFile"
966 ("file", Env.string)
967 (fn name =>
968 (write "\tAuthGroupFile ";
969 write name;
970 write "\n"))
971
2aeb9eec
AC		 972val () = Env.action_none "requireValidUser"
973 (fn () => write "\tRequire valid-user\n")
974
975val () = Env.action_one "requireUser"
976 ("users", Env.list Env.string)
977 (fn names =>
978 case names of
979 [] => ()
980 | _ => (write "\tRequire user";
981 app (fn name => (write " "; write name)) names;
982 write "\n"))
983
984val () = Env.action_one "requireGroup"
985 ("groups", Env.list Env.string)
986 (fn names =>
987 case names of
988 [] => ()
989 | _ => (write "\tRequire group";
990 app (fn name => (write " "; write name)) names;
991 write "\n"))
992
993val () = Env.action_none "orderAllowDeny"
994 (fn () => write "\tOrder allow,deny\n")
995
996val () = Env.action_none "orderDenyAllow"
997 (fn () => write "\tOrder deny,allow\n")
998
999val () = Env.action_none "allowFromAll"
1000 (fn () => write "\tAllow from all\n")
1001
1002val () = Env.action_one "allowFrom"
1003 ("entries", Env.list Env.string)
1004 (fn names =>
1005 case names of
1006 [] => ()
1007 | _ => (write "\tAllow from";
1008 app (fn name => (write " "; write name)) names;
1009 write "\n"))
1010
1011val () = Env.action_none "denyFromAll"
1012 (fn () => write "\tDeny from all\n")
1013
1014val () = Env.action_one "denyFrom"
1015 ("entries", Env.list Env.string)
1016 (fn names =>
1017 case names of
1018 [] => ()
1019 | _ => (write "\tDeny from";
1020 app (fn name => (write " "; write name)) names;
1021 write "\n"))
1022
1023val () = Env.action_none "satisfyAll"
1024 (fn () => write "\tSatisfy all\n")
1025
1026val () = Env.action_none "satisfyAny"
1027 (fn () => write "\tSatisfy any\n")
1028
7f012ffd
AC		 1029val () = Env.action_one "forceType"
1030 ("type", Env.string)
1031 (fn ty => (write "\tForceType ";
1032 write ty;
1033 write "\n"))
1034
1035val () = Env.action_none "forceTypeOff"
1036 (fn () => write "\tForceType None\n")
1037
1038val () = Env.action_two "action"
1039 ("what", Env.string, "how", Env.string)
1040 (fn (what, how) => (write "\tAction ";
1041 write what;
1042 write " ";
1043 write how;
1044 write "\n"))
1045
1046val () = Env.action_one "addDefaultCharset"
1047 ("charset", Env.string)
1048 (fn ty => (write "\tAddDefaultCharset ";
1049 write ty;
1050 write "\n"))
1051
64e85bae 1052(*val () = Env.action_one "davSvn"
c8505e59
AC		 1053 ("path", Env.string)
1054 (fn path => (write "\tDAV svn\n\tSVNPath ";
1055 write path;
1056 write "\n"))
1057
1058val () = Env.action_one "authzSvnAccessFile"
1059 ("path", Env.string)
1060 (fn path => (write "\tAuthzSVNAccessFile ";
1061 write path;
64e85bae 1062 write "\n"))*)
c8505e59 1063
0aed4302
AC		 1064val () = Env.action_none "davFilesystem"
1065 (fn path => write "\tDAV filesystem\n")
1066
9d7fa346
AC		 1067val () = Env.action_two "addDescription"
1068 ("description", Env.string, "patterns", Env.list Env.string)
1069 (fn (desc, pats) =>
1070 case pats of
1071 [] => ()
1072 | _ => (write "\tAddDescription \"";
1073 write (String.toString desc);
1074 write "\"";
1075 app (fn pat => (write " "; write pat)) pats;
1076 write "\n"))
1077
1817ed97
AC		 1078val () = Env.action_two "addIcon"
1079 ("icon", Env.string, "patterns", Env.list Env.string)
1080 (fn (icon, pats) =>
1081 case pats of
1082 [] => ()
1083 | _ => (write "\tAddIcon \"";
1084 write icon;
1085 write "\"";
1086 app (fn pat => (write " "; write pat)) pats;
1087 write "\n"))
1088
9d7fa346
AC		 1089val () = Env.action_one "indexOptions"
1090 ("options", Env.list autoindex_option)
1091 (fn opts =>
1092 case opts of
1093 [] => ()
1094 | _ => (write "\tIndexOptions";
1095 app (fn (opt, arg) =>
1096 (write " ";
1097 write opt;
1098 Option.app (fn arg =>
1099 (write "="; write arg)) arg)) opts;
1100 write "\n"))
1101
1817ed97
AC		 1102val () = Env.action_one "indexIgnore"
1103 ("patterns", Env.list Env.string)
1104 (fn pats =>
1105 case pats of
1106 [] => ()
1107 | _ => (write "\tIndexIgnore";
1108 app (fn pat => (write " "; write pat)) pats;
1109 write "\n"))
1110
9d7fa346
AC		 1111val () = Env.action_one "set_indexOptions"
1112 ("options", Env.list autoindex_option)
1113 (fn opts =>
1114 case opts of
1115 [] => ()
1116 | _ => (write "\tIndexOptions";
1117 app (fn (opt, arg) =>
1118 (write " +";
1119 write opt;
1120 Option.app (fn arg =>
1121 (write "="; write arg)) arg)) opts;
1122 write "\n"))
1123
1124val () = Env.action_one "unset_indexOptions"
1125 ("options", Env.list autoindex_option)
1126 (fn opts =>
1127 case opts of
1128 [] => ()
1129 | _ => (write "\tIndexOptions";
1130 app (fn (opt, _) =>
1131 (write " -";
1132 write opt)) opts;
1133 write "\n"))
1134
1135val () = Env.action_one "headerName"
1136 ("name", Env.string)
1137 (fn name => (write "\tHeaderName ";
1138 write name;
1139 write "\n"))
1140
1141val () = Env.action_one "readmeName"
1142 ("name", Env.string)
1143 (fn name => (write "\tReadmeName ";
1144 write name;
1145 write "\n"))
1146
eda33894
AC		 1147val () = Env.action_two "setEnv"
1148 ("key", Env.string, "value", Env.string)
1149 (fn (key, value) => (write "\tSetEnv \"";
1150 write key;
1151 write "\" \"";
ca6ffb3f
AC		 1152 write (String.translate (fn #"\"" => "\\\""
1153 | ch => str ch) value);
eda33894
AC		 1154 write "\"\n"))
1155
f0062360
AC		 1156val () = Env.action_one "diskCache"
1157 ("path", Env.string)
1158 (fn path => (write "\tCacheEnable disk \"";
1159 write path;
1160 write "\"\n"))
83bc6c45 1161
83bc6c45
AC		 1162val () = Env.action_one "phpVersion"
1163 ("version", php_version)
313442ed
CE		 1164 (fn version => (if version = 6
1165 then
1166 (* fastcgi php 5.6 since 6 doesn't exist *)
1167 (write "\tAddHandler fcgid-script .php .phtml\n";
1168 (* FIXME: only set kerberos wrapper of waklog is on *)
95798203 1169 (* won't be trivial, since we don't have access to node here *)
313442ed
CE		 1170 write "\n\tFcgidWrapper \"";
1171 write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
1172 write " ";
1173 write Config.Apache.phpFastCgiWrapper;
1174 write "\" .php .phtml\n")
1175 else
1176 (write "\tAddHandler x-httpd-php";
1177 write (Int.toString version);
1178 write " .php .phtml\n")))
83bc6c45 1179
bcf547ec
AC		 1180val () = Env.action_two "addType"
1181 ("mime type", Env.string, "extension", Env.string)
1182 (fn (mt, ext) => (write "\tAddType ";
1183 write mt;
1184 write " ";
1185 write ext;
1186 write "\n"))
1187
1188val filter = fn (EVar "includes", _) => SOME "INCLUDES"
1189 | (EVar "deflate", _) => SOME "DEFLATE"
1190 | _ => NONE
1191
1192val () = Env.action_two "addOutputFilter"
1193 ("filters", Env.list filter, "extensions", Env.list Env.string)
1194 (fn (f :: fs, exts as (_ :: _)) =>
1195 (write "\tAddOutputFilter ";
1196 write f;
1197 app (fn f => (write ";"; write f)) fs;
1198 app (fn ext => (write " "; write ext)) exts;
1199 write "\n")
1200 | _ => ())
1201
ef5ad69a
CE		 1202val () = Env.action_one "sslCertificateChainFile"
1203 ("ssl_cacert_path", Env.string)
1204 (fn cacert =>
1205 if !sslEnabled then
1206 (write "\tSSLCertificateChainFile \"";
1207 write cacert;
1208 write "\"\n")
1209 else
1210 print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
1211
71420f8b 1212val () = Domain.registerResetLocal (fn () =>
7ad80c20 1213 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
71420f8b 1214
41c58daf
AC		 1215val () = Domain.registerDescriber (Domain.considerAll
1216 [Domain.Extension {extension = "vhost",
d936cf4d 1217 heading = fn host => "Web vhost " ^ host ^ ":"},
41c58daf 1218 Domain.Extension {extension = "vhost_ssl",
d936cf4d 1219 heading = fn host => "SSL web vhost " ^ host ^ ":"}])
41c58daf 1220
e2166ae8
CE		 1221val () = Env.action_one "allowEncodedSlashes"
1222 ("enable", Env.bool)
1223 (fn enable => (write "\tAllowEncodedSlashes ";
1224 write (if enable then "NoDecode" else "Off");
1225 write "\n"))
ecc307a0
AC		 1226val () = Env.action_none "testNoHtaccess"
1227 (fn path => write "\tAllowOverride None\n")
1228
563e7792
AC		 1229fun writeWaklogUserFile () =
1230 let
1231 val users = Acl.users ()
1232 val outf = TextIO.openOut Config.Apache.waklogUserFile
1233 in
1234 app (fn user => if String.isSuffix "_admin" user then
1235 ()
1236 else
1237 (TextIO.output (outf, "<Location /~");
1238 TextIO.output (outf, user);
1239 TextIO.output (outf, ">\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
1240 TextIO.output (outf, user);
1241 TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
1242 TextIO.output (outf, user);
1243 TextIO.output (outf, "\n</Location>\n\n"))) users;
1244 TextIO.closeOut outf
1245 end
1246
1247val () = Domain.registerOnUsersChange writeWaklogUserFile
1248
8a7c40fa 1249end
Unnamed repository; edit this file to name it for gitweb.