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