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