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