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