HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add dnsWildcardIP
[hcoop/domtool2.git] / src / plugins / apache.sml
CommitLineData
8a7c40fa 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
8a5b34c9 2 * Copyright (c) 2006-2007, Adam Chlipala
8a7c40fa
AC		 3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19(* Apache HTTPD handling *)
20
21structure Apache :> APACHE = struct
22
23open Ast
24
128e7b0b
AC		 25val dl = ErrorMsg.dummyLoc
26
de5351c7
AC		 27fun webNode node =
28 List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
29 orelse (Domain.hasPriv "www"
30 andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)
31
60695e99
AC		 32val _ = Env.type_one "web_node"
33 Env.string
de5351c7 34 webNode
60695e99 35
ce01b51a
AC		 36val _ = Env.registerFunction ("web_node_to_node",
37 fn [e] => SOME e
38 | _ => NONE)
39
b5f2d506 40fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
128e7b0b 41 SOME (node, Domain.nodeIp node)
b5f2d506 42 | webPlace (EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
128e7b0b
AC		 43 SOME (node, ip)
44 | webPlace _ = NONE
45
b5f2d506 46fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
128e7b0b
AC		 47
48val _ = Env.registerFunction ("web_place_to_web_node",
49 fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
50 | _ => NONE)
51
52val _ = Env.registerFunction ("web_place_to_node",
53 fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
54 | _ => NONE)
55
56val _ = Env.registerFunction ("web_place_to_ip",
57 fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (webPlace e)
58 | _ => NONE)
59
f8dfbbcc
AC		 60val _ = Env.type_one "proxy_port"
61 Env.int
e95a129e
AC		 62 (fn n => n > 1024)
63
64val _ = Env.type_one "proxy_target"
65 Env.string
66 (fn s =>
67 let
68 fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets
69 in
70 case String.fields (fn ch => ch = #":") s of
71 ["http", "//localhost", rest] =>
72 (case String.fields (fn ch => ch = #"/") rest of
73 port :: _ =>
74 (case Int.fromString port of
75 NONE => default ()
76 | SOME n => n > 1024 orelse default ())
77 | _ => default ())
78 | _ => default ()
79 end)
f8dfbbcc
AC		 80
81val _ = Env.type_one "rewrite_arg"
82 Env.string
83 (CharVector.all Char.isAlphaNum)
84
00a13ad8
AC		 85val _ = Env.type_one "suexec_flag"
86 Env.bool
87 (fn b => b orelse Domain.hasPriv "www")
88
931aae14
AC		 89val _ = Env.type_one "regexp"
90 Env.string
91 Pcre.validRegexp
92
2882ee37
AC		 93fun validLocation s =
94 size s > 0 andalso size s < 1000 andalso CharVector.all
95 (fn ch => Char.isAlphaNum ch
96 orelse ch = #"-"
97 orelse ch = #"_"
98 orelse ch = #"."
666ed674
AC		 99 orelse ch = #"/"
100 orelse ch = #"~") s
2882ee37
AC		 101
102val _ = Env.type_one "location"
103 Env.string
104 validLocation
105
434a7b1f
AC		 106fun validCert s = Acl.query {user = Domain.getUser (),
107 class = "cert",
108 value = s}
109
110val _ = Env.type_one "ssl_cert_path"
111 Env.string
112 validCert
113
114fun ssl e = case e of
115 (EVar "no_ssl", _) => SOME NONE
116 | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
117 | _ => NONE
118
781ebc11
AC		 119fun validExtension s =
120 size s > 0
121 andalso size s < 20
122 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") s
123
124val _ = Env.type_one "file_extension"
125 Env.string
126 validExtension
127
128e7b0b
AC		 128val defaults = [("WebPlaces",
129 (TList (TBase "web_place", dl), dl),
130 (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
8cbb9632
AC		 131 ("SSL",
132 (TBase "ssl", dl),
133 (fn () => (EVar "no_ssl", dl))),
134 ("User",
135 (TBase "your_user", dl),
136 (fn () => (EString (Domain.getUser ()), dl))),
137 ("Group",
138 (TBase "your_group", dl),
139 (fn () => (EString "nogroup", dl))),
140 ("DocumentRoot",
141 (TBase "your_path", dl),
142 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
143 ("ServerAdmin",
144 (TBase "email", dl),
145 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
146 ("SuExec",
147 (TBase "suexec_flag", dl),
e7482df3
AC		 148 (fn () => (EVar "true", dl))),
149 ("PhpVersion",
150 (TBase "php_version", dl),
151 (fn () => (EVar "php4", dl)))]
8cbb9632
AC		 152
153val () = app Defaults.registerDefault defaults
f8dfbbcc
AC		 154
155val redirect_code = fn (EVar "temp", _) => SOME "temp"
156 | (EVar "permanent", _) => SOME "permanent"
157 | (EVar "seeother", _) => SOME "seeother"
158 | (EVar "redir300", _) => SOME "300"
159 | (EVar "redir301", _) => SOME "301"
160 | (EVar "redir302", _) => SOME "302"
161 | (EVar "redir303", _) => SOME "303"
162 | (EVar "redir304", _) => SOME "304"
163 | (EVar "redir305", _) => SOME "305"
164 | (EVar "redir307", _) => SOME "307"
165 | _ => NONE
166
167val flag = fn (EVar "redirect", _) => SOME "R"
168 | (EVar "forbidden", _) => SOME "F"
169 | (EVar "gone", _) => SOME "G"
170 | (EVar "last", _) => SOME "L"
171 | (EVar "chain", _) => SOME "C"
172 | (EVar "nosubreq", _) => SOME "NS"
173 | (EVar "nocase", _) => SOME "NC"
174 | (EVar "qsappend", _) => SOME "QSA"
175 | (EVar "noescape", _) => SOME "NE"
176 | (EVar "passthrough", _) => SOME "PT"
177 | (EApp ((EVar "mimeType", _), e), _) =>
178 Option.map (fn s => "T=" ^ s) (Env.string e)
179 | (EApp ((EVar "redirectWith", _), e), _) =>
180 Option.map (fn s => "R=" ^ s) (redirect_code e)
181 | (EApp ((EVar "skip", _), e), _) =>
182 Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
183 | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
184 (case Env.string e1 of
185 NONE => NONE
186 | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
187 (Env.string e2))
188
189 | _ => NONE
190
e95a129e
AC		 191val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
192 | (EVar "ornext", _) => SOME "OR"
193 | _ => NONE
194
d441e69f
AC		 195val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
196 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
197 | (EVar "indexes", _) => SOME "Indexes"
22eaa950 198 | (EVar "followSymLinks", _) => SOME "FollowSymLinks"
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
8a7c40fa 238val vhostsChanged = ref false
8e965b2d 239val logDeleted = ref false
8a7c40fa
AC		 240
241val () = Slave.registerPreHandler
8e965b2d
AC		 242 (fn () => (vhostsChanged := false;
243 logDeleted := false))
8a7c40fa 244
7db53a0b
AC		 245fun findVhostUser fname =
246 let
247 val inf = TextIO.openIn fname
248
249 fun loop () =
250 case TextIO.inputLine inf of
251 NONE => NONE
252 | SOME line =>
00a13ad8
AC		 253 if String.isPrefix "# Owner: " line then
254 case String.tokens Char.isSpace line of
255 [_, _, user] => SOME user
256 | _ => NONE
257 else
258 loop ()
7db53a0b
AC		 259 in
260 loop ()
261 before TextIO.closeIn inf
3a941c29 262 end handle _ => NONE
7db53a0b 263
55d4a268
AC		 264val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
265
266fun isVersion1 node =
f8ef6c20
AC		 267 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
268 | _ => false) webNodes_full
55d4a268
AC		 269
270fun imVersion1 () = isVersion1 (Slave.hostname ())
271
f8ef6c20
AC		 272fun isWaklog node =
273 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
274 | _ => false) webNodes_full
275
55d4a268
AC		 276fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
277fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
278fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
c17d0537 279fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
55d4a268 280
b59d9074 281fun logDir {user, node, vhostId} =
2a7d2818 282 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
409542d7 283 "/",
b59d9074
AC		 284 node,
285 "/",
286 vhostId]
287
f086616f
AC		 288fun realLogDir {user, node, vhostId} =
289 String.concat [Config.Apache.realLogDirOf user,
290 "/",
291 node,
292 "/",
293 vhostId]
294
8a7c40fa 295val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 296 let
297 val spl = OS.Path.splitDirFile (#file fs)
298 in
299 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 300 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
301 val realVhostFile = OS.Path.joinDirFile
302 {dir = Config.Apache.confDir,
303 file = #file spl}
304
305 val user = findVhostUser (#file fs)
19026493
AC		 306 val oldUser = case #action fs of
307 Slave.Delete false => user
308 | _ => findVhostUser realVhostFile
3a941c29
AC		 309 in
310 if (oldUser = NONE andalso #action fs <> Slave.Add)
1638d5a2 311 orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
3a941c29
AC		 312 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
313 else
314 let
5b07cebd 315 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
b59d9074
AC		 316 OS.Path.base (#file spl) ^ ".ssl"
317 else
318 OS.Path.base (#file spl)
319
3a941c29 320 fun realLogDir user =
b59d9074
AC		 321 logDir {user = valOf user,
322 node = Slave.hostname (),
323 vhostId = vhostId}
c17d0537
AC		 324
325 fun backupLogs () =
326 OS.Path.joinDirFile
327 {dir = Config.Apache.backupLogDirOf
328 (isVersion1 (Slave.hostname ())),
329 file = vhostId}
3a941c29
AC		 330 in
331 vhostsChanged := true;
332 case #action fs of
1638d5a2 333 Slave.Delete _ =>
31b50af0
AC		 334 let
335 val ldir = realLogDir oldUser
336 in
337 if !logDeleted then
338 ()
339 else
340 (ignore (OS.Process.system (down ()));
c17d0537 341 ignore (OS.Process.system (fixperms ()));
31b50af0
AC		 342 logDeleted := true);
343 ignore (OS.Process.system (Config.rm
344 ^ " -rf "
345 ^ realVhostFile));
346 Slave.moveDirCreate {from = ldir,
c17d0537 347 to = backupLogs ()}
31b50af0 348 end
3a941c29
AC		 349 | Slave.Add =>
350 let
351 val rld = realLogDir user
352 in
353 ignore (OS.Process.system (Config.cp
354 ^ " "
355 ^ #file fs
356 ^ " "
357 ^ realVhostFile));
358 if Posix.FileSys.access (rld, []) then
359 ()
360 else
c17d0537 361 Slave.moveDirCreate {from = backupLogs (),
31b50af0 362 to = rld}
3a941c29
AC		 363 end
364
365 | _ =>
366 (ignore (OS.Process.system (Config.cp
367 ^ " "
368 ^ #file fs
369 ^ " "
370 ^ realVhostFile));
371 if user <> oldUser then
372 let
373 val old = realLogDir oldUser
374 val rld = realLogDir user
375 in
376 if !logDeleted then
377 ()
378 else
55d4a268 379 (ignore (OS.Process.system (down ()));
3a941c29
AC		 380 logDeleted := true);
381 ignore (OS.Process.system (Config.rm
382 ^ " -rf "
383 ^ realLogDir oldUser));
384 if Posix.FileSys.access (rld, []) then
385 ()
386 else
409542d7 387 Slave.mkDirAll rld
3a941c29
AC		 388 end
389 else
390 ())
391 end
392 end
7a2b27f0
AC		 393 else
394 ()
395 end)
8a7c40fa
AC		 396
397val () = Slave.registerPostHandler
398 (fn () =>
399 (if !vhostsChanged then
55d4a268 400 Slave.shellF ([if !logDeleted then undown () else reload ()],
8a7c40fa
AC		 401 fn cl => "Error reloading Apache with " ^ cl)
402 else
403 ()))
404
7a2b27f0
AC		 405val vhostFiles : (string * TextIO.outstream) list ref = ref []
406fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
407fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 408
f8dfbbcc 409val rewriteEnabled = ref false
ce01b51a 410val localRewriteEnabled = ref false
c98b57cf
AC		 411val currentVhost = ref ""
412val currentVhostId = ref ""
8a5b34c9 413val sslEnabled = ref false
f8dfbbcc 414
7a2b27f0 415val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 416fun registerPre f =
417 let
418 val old = !pre
419 in
420 pre := (fn x => (old x; f x))
421 end
422
423val post = ref (fn () => ())
424fun registerPost f =
425 let
426 val old = !post
427 in
428 post := (fn () => (old (); f ()))
429 end
430
e9f528ab
AC		 431fun doPre x = !pre x
432fun doPost () = !post ()
433
7f75d838
AC		 434val aliaser = ref (fn _ : string => ())
435fun registerAliaser f =
436 let
437 val old = !aliaser
438 in
439 aliaser := (fn x => (old x; f x))
440 end
441
57e066bb
AC		 442fun vhostPost () = (!post ();
443 write "</VirtualHost>\n";
444 app (TextIO.closeOut o #2) (!vhostFiles))
2a7d2818 445
e7482df3
AC		 446val php_version = fn (EVar "php4", _) => SOME 4
447 | (EVar "php5", _) => SOME 5
448 | _ => NONE
449
57e066bb
AC		 450fun vhostBody (env, makeFullHost) =
451 let
452 val places = Env.env (Env.list webPlace) (env, "WebPlaces")
453
454 val ssl = Env.env ssl (env, "SSL")
455 val user = Env.env Env.string (env, "User")
456 val group = Env.env Env.string (env, "Group")
457 val docroot = Env.env Env.string (env, "DocumentRoot")
458 val sadmin = Env.env Env.string (env, "ServerAdmin")
459 val suexec = Env.env Env.bool (env, "SuExec")
e7482df3 460 val php = Env.env php_version (env, "PhpVersion")
57e066bb
AC		 461
462 val fullHost = makeFullHost (Domain.currentDomain ())
463 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
464 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
465 in
466 currentVhost := fullHost;
467 currentVhostId := vhostId;
468 sslEnabled := Option.isSome ssl;
469
470 rewriteEnabled := false;
471 localRewriteEnabled := false;
472 vhostFiles := map (fn (node, ip) =>
473 let
474 val file = Domain.domainFile {node = node,
475 name = confFile}
476
477 val ld = logDir {user = user, node = node, vhostId = vhostId}
478 in
479 TextIO.output (file, "# Owner: ");
480 TextIO.output (file, user);
481 TextIO.output (file, "\n<VirtualHost ");
482 TextIO.output (file, ip);
483 TextIO.output (file, ":");
484 TextIO.output (file, case ssl of
485 SOME _ => "443"
486 | NONE => "80");
487 TextIO.output (file, ">\n");
488 TextIO.output (file, "\tErrorLog ");
489 TextIO.output (file, ld);
490 TextIO.output (file, "/error.log\n\tCustomLog ");
491 TextIO.output (file, ld);
492 TextIO.output (file, "/access.log combined\n");
493 TextIO.output (file, "\tServerName ");
494 TextIO.output (file, fullHost);
495 app
496 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
497 TextIO.output (file, makeFullHost dom)))
498 (Domain.currentAliasDomains ());
499
500 if suexec then
501 if isVersion1 node then
502 (TextIO.output (file, "\n\tUser ");
00a13ad8 503 TextIO.output (file, user);
57e066bb
AC		 504 TextIO.output (file, "\n\tGroup ");
505 TextIO.output (file, group))
506 else
507 (TextIO.output (file, "\n\tSuexecUserGroup ");
3f84c976 508 TextIO.output (file, user);
57e066bb
AC		 509 TextIO.output (file, " ");
510 TextIO.output (file, group))
511 else
512 ();
513
514 if isWaklog node then
515 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
516 TextIO.output (file, user);
517 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
518 TextIO.output (file, user))
519 else
520 ();
521
522 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
523 TextIO.output (file, user);
524 TextIO.output (file, "/DAVLock");
525
e7482df3
AC		 526 if php <> Config.Apache.defaultPhpVersion then
527 (TextIO.output (file, "\n\tAddHandler x-httpd-php");
528 TextIO.output (file, Int.toString php);
529 TextIO.output (file, " .php .phtml"))
530 else
531 ();
532
57e066bb
AC		 533 (ld, file)
534 end)
535 places;
536 write "\n\tDocumentRoot ";
537 write docroot;
538 write "\n\tServerAdmin ";
539 write sadmin;
540 case ssl of
541 SOME cert =>
542 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
543 write cert)
544 | NONE => ();
545 write "\n";
546 !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
547 app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
548 end
3f84c976 549
57e066bb
AC		 550val () = Env.containerV_one "vhost"
551 ("host", Env.string)
552 (fn (env, host) => vhostBody (env, fn dom => host ^ "." ^ dom),
553 vhostPost)
554
555val () = Env.containerV_none "vhostDefault"
556 (fn env => vhostBody (env, fn dom => dom),
557 vhostPost)
8a7c40fa 558
ce01b51a
AC		 559val inLocal = ref false
560
2882ee37
AC		 561val () = Env.container_one "location"
562 ("prefix", Env.string)
563 (fn prefix =>
564 (write "\t<Location ";
565 write prefix;
ce01b51a
AC		 566 write ">\n";
567 inLocal := true),
568 fn () => (write "\t</Location>\n";
569 inLocal := false;
570 localRewriteEnabled := false))
2882ee37
AC		 571
572val () = Env.container_one "directory"
573 ("directory", Env.string)
574 (fn directory =>
575 (write "\t<Directory ";
576 write directory;
ce01b51a
AC		 577 write ">\n";
578 inLocal := true),
579 fn () => (write "\t</Directory>\n";
580 inLocal := false;
581 localRewriteEnabled := false))
2882ee37 582
f8dfbbcc 583fun checkRewrite () =
ce01b51a 584 if !inLocal then
cf283351 585 if !localRewriteEnabled then
ce01b51a
AC		 586 ()
587 else
588 (write "\tRewriteEngine on\n";
589 localRewriteEnabled := true)
590 else if !rewriteEnabled then
f8dfbbcc
AC		 591 ()
592 else
593 (write "\tRewriteEngine on\n";
594 rewriteEnabled := true)
595
596val () = Env.action_three "localProxyRewrite"
597 ("from", Env.string, "to", Env.string, "port", Env.int)
598 (fn (from, to, port) =>
599 (checkRewrite ();
06bd8215 600 write "\tRewriteRule\t\"";
f8dfbbcc 601 write from;
06bd8215 602 write "\"\thttp://localhost:";
f8dfbbcc
AC		 603 write (Int.toString port);
604 write "/";
605 write to;
606 write " [P]\n"))
607
e95a129e
AC		 608val () = Env.action_two "proxyPass"
609 ("from", Env.string, "to", Env.string)
610 (fn (from, to) =>
611 (write "\tProxyPass\t";
612 write from;
613 write "\t";
614 write to;
615 write "\n"))
616
617val () = Env.action_two "proxyPassReverse"
618 ("from", Env.string, "to", Env.string)
619 (fn (from, to) =>
620 (write "\tProxyPassReverse\t";
621 write from;
622 write "\t";
623 write to;
624 write "\n"))
f8dfbbcc
AC		 625
626val () = Env.action_three "rewriteRule"
627 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
628 (fn (from, to, flags) =>
629 (checkRewrite ();
06bd8215 630 write "\tRewriteRule\t\"";
f8dfbbcc 631 write from;
06bd8215 632 write "\"\t\"";
f8dfbbcc 633 write to;
06bd8215 634 write "\"";
f8dfbbcc
AC		 635 case flags of
636 [] => ()
637 | flag::rest => (write " [";
638 write flag;
639 app (fn flag => (write ",";
640 write flag)) rest;
641 write "]");
642 write "\n"))
643
e95a129e
AC		 644val () = Env.action_three "rewriteCond"
645 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
646 (fn (from, to, flags) =>
647 (checkRewrite ();
06bd8215 648 write "\tRewriteCond\t\"";
e95a129e 649 write from;
06bd8215 650 write "\"\t\"";
e95a129e 651 write to;
06bd8215 652 write "\"";
e95a129e
AC		 653 case flags of
654 [] => ()
655 | flag::rest => (write " [";
656 write flag;
657 app (fn flag => (write ",";
658 write flag)) rest;
659 write "]");
660 write "\n"))
661
94b7b11a
AC		 662val () = Env.action_one "rewriteBase"
663 ("prefix", Env.string)
664 (fn prefix =>
665 (checkRewrite ();
06bd8215 666 write "\tRewriteBase\t\"";
94b7b11a 667 write prefix;
06bd8215 668 write "\"\n"))
94b7b11a 669
c98b57cf
AC		 670val () = Env.action_one "rewriteLogLevel"
671 ("level", Env.int)
672 (fn level =>
673 (checkRewrite ();
674 write "\tRewriteLog ";
7a2b27f0 675 write' (fn x => x);
c98b57cf
AC		 676 write "/rewrite.log\n\tRewriteLogLevel ";
677 write (Int.toString level);
678 write "\n"))
679
d5754b53
AC		 680val () = Env.action_two "alias"
681 ("from", Env.string, "to", Env.string)
682 (fn (from, to) =>
683 (write "\tAlias\t";
684 write from;
685 write " ";
686 write to;
687 write "\n"))
688
689val () = Env.action_two "scriptAlias"
690 ("from", Env.string, "to", Env.string)
691 (fn (from, to) =>
692 (write "\tScriptAlias\t";
693 write from;
694 write " ";
695 write to;
696 write "\n"))
697
698val () = Env.action_two "errorDocument"
699 ("code", Env.string, "handler", Env.string)
700 (fn (code, handler) =>
989965b1
AC		 701 let
702 val hasSpaces = CharVector.exists Char.isSpace handler
d5754b53 703
989965b1
AC		 704 fun maybeQuote () =
705 if hasSpaces then
706 write "\""
707 else
708 ()
709 in
710 write "\tErrorDocument\t";
711 write code;
712 write " ";
713 maybeQuote ();
714 write handler;
715 maybeQuote ();
716 write "\n"
717 end)
718
d441e69f
AC		 719val () = Env.action_one "options"
720 ("options", Env.list apache_option)
721 (fn opts =>
722 case opts of
723 [] => ()
724 | _ => (write "\tOptions";
725 app (fn opt => (write " "; write opt)) opts;
726 write "\n"))
727
728val () = Env.action_one "set_options"
729 ("options", Env.list apache_option)
730 (fn opts =>
731 case opts of
732 [] => ()
733 | _ => (write "\tOptions";
734 app (fn opt => (write " +"; write opt)) opts;
735 write "\n"))
736
737val () = Env.action_one "unset_options"
738 ("options", Env.list apache_option)
739 (fn opts =>
740 case opts of
741 [] => ()
742 | _ => (write "\tOptions";
743 app (fn opt => (write " -"; write opt)) opts;
744 write "\n"))
d5754b53 745
781ebc11
AC		 746val () = Env.action_one "cgiExtension"
747 ("extension", Env.string)
748 (fn ext => (write "\tAddHandler cgi-script ";
749 write ext;
750 write "\n"))
751
edd38024
AC		 752val () = Env.action_one "directoryIndex"
753 ("filenames", Env.list Env.string)
754 (fn opts =>
755 (write "\tDirectoryIndex";
756 app (fn opt => (write " "; write opt)) opts;
757 write "\n"))
758
e519d696 759val () = Env.action_one "serverAliasHost"
edd38024
AC		 760 ("host", Env.string)
761 (fn host =>
762 (write "\tServerAlias ";
763 write host;
7f75d838
AC		 764 write "\n";
765 !aliaser host))
edd38024 766
e519d696
AC		 767val () = Env.action_one "serverAlias"
768 ("host", Env.string)
769 (fn host =>
770 (app
771 (fn dom =>
772 let
773 val full = host ^ "." ^ dom
774 in
775 write "\tServerAlias ";
776 write full;
777 write "\n";
778 !aliaser full
779 end)
780 (Domain.currentDomains ())))
781
782val () = Env.action_none "serverAliasDefault"
783 (fn () =>
784 (app
785 (fn dom =>
786 (write "\tServerAlias ";
787 write dom;
788 write "\n";
789 !aliaser dom))
790 (Domain.currentDomains ())))
791
2aeb9eec
AC		 792val authType = fn (EVar "basic", _) => SOME "basic"
793 | (EVar "digest", _) => SOME "digest"
35dc7746 794 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 795 | _ => NONE
796
8a5b34c9
AC		 797fun allowAuthType "kerberos" = !sslEnabled
798 | allowAuthType _ = true
799
2aeb9eec
AC		 800val () = Env.action_one "authType"
801 ("type", authType)
802 (fn ty =>
8a5b34c9
AC		 803 if allowAuthType ty then
804 (write "\tAuthType ";
805 write ty;
806 write "\n";
807 case ty of
808 "kerberos" =>
809 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
810 | _ => ())
811 else
812 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 813
814val () = Env.action_one "authName"
815 ("name", Env.string)
816 (fn name =>
817 (write "\tAuthName \"";
818 write name;
819 write "\"\n"))
820
821val () = Env.action_one "authUserFile"
822 ("file", Env.string)
823 (fn name =>
824 (write "\tAuthUserFile ";
825 write name;
826 write "\n"))
827
828val () = Env.action_none "requireValidUser"
829 (fn () => write "\tRequire valid-user\n")
830
831val () = Env.action_one "requireUser"
832 ("users", Env.list Env.string)
833 (fn names =>
834 case names of
835 [] => ()
836 | _ => (write "\tRequire user";
837 app (fn name => (write " "; write name)) names;
838 write "\n"))
839
840val () = Env.action_one "requireGroup"
841 ("groups", Env.list Env.string)
842 (fn names =>
843 case names of
844 [] => ()
845 | _ => (write "\tRequire group";
846 app (fn name => (write " "; write name)) names;
847 write "\n"))
848
849val () = Env.action_none "orderAllowDeny"
850 (fn () => write "\tOrder allow,deny\n")
851
852val () = Env.action_none "orderDenyAllow"
853 (fn () => write "\tOrder deny,allow\n")
854
855val () = Env.action_none "allowFromAll"
856 (fn () => write "\tAllow from all\n")
857
858val () = Env.action_one "allowFrom"
859 ("entries", Env.list Env.string)
860 (fn names =>
861 case names of
862 [] => ()
863 | _ => (write "\tAllow from";
864 app (fn name => (write " "; write name)) names;
865 write "\n"))
866
867val () = Env.action_none "denyFromAll"
868 (fn () => write "\tDeny from all\n")
869
870val () = Env.action_one "denyFrom"
871 ("entries", Env.list Env.string)
872 (fn names =>
873 case names of
874 [] => ()
875 | _ => (write "\tDeny from";
876 app (fn name => (write " "; write name)) names;
877 write "\n"))
878
879val () = Env.action_none "satisfyAll"
880 (fn () => write "\tSatisfy all\n")
881
882val () = Env.action_none "satisfyAny"
883 (fn () => write "\tSatisfy any\n")
884
7f012ffd
AC		 885val () = Env.action_one "forceType"
886 ("type", Env.string)
887 (fn ty => (write "\tForceType ";
888 write ty;
889 write "\n"))
890
891val () = Env.action_none "forceTypeOff"
892 (fn () => write "\tForceType None\n")
893
894val () = Env.action_two "action"
895 ("what", Env.string, "how", Env.string)
896 (fn (what, how) => (write "\tAction ";
897 write what;
898 write " ";
899 write how;
900 write "\n"))
901
902val () = Env.action_one "addDefaultCharset"
903 ("charset", Env.string)
904 (fn ty => (write "\tAddDefaultCharset ";
905 write ty;
906 write "\n"))
907
64e85bae 908(*val () = Env.action_one "davSvn"
c8505e59
AC		 909 ("path", Env.string)
910 (fn path => (write "\tDAV svn\n\tSVNPath ";
911 write path;
912 write "\n"))
913
914val () = Env.action_one "authzSvnAccessFile"
915 ("path", Env.string)
916 (fn path => (write "\tAuthzSVNAccessFile ";
917 write path;
64e85bae 918 write "\n"))*)
c8505e59 919
0aed4302
AC		 920val () = Env.action_none "davFilesystem"
921 (fn path => write "\tDAV filesystem\n")
922
9d7fa346
AC		 923val () = Env.action_two "addDescription"
924 ("description", Env.string, "patterns", Env.list Env.string)
925 (fn (desc, pats) =>
926 case pats of
927 [] => ()
928 | _ => (write "\tAddDescription \"";
929 write (String.toString desc);
930 write "\"";
931 app (fn pat => (write " "; write pat)) pats;
932 write "\n"))
933
1817ed97
AC		 934val () = Env.action_two "addIcon"
935 ("icon", Env.string, "patterns", Env.list Env.string)
936 (fn (icon, pats) =>
937 case pats of
938 [] => ()
939 | _ => (write "\tAddIcon \"";
940 write icon;
941 write "\"";
942 app (fn pat => (write " "; write pat)) pats;
943 write "\n"))
944
9d7fa346
AC		 945val () = Env.action_one "indexOptions"
946 ("options", Env.list autoindex_option)
947 (fn opts =>
948 case opts of
949 [] => ()
950 | _ => (write "\tIndexOptions";
951 app (fn (opt, arg) =>
952 (write " ";
953 write opt;
954 Option.app (fn arg =>
955 (write "="; write arg)) arg)) opts;
956 write "\n"))
957
1817ed97
AC		 958val () = Env.action_one "indexIgnore"
959 ("patterns", Env.list Env.string)
960 (fn pats =>
961 case pats of
962 [] => ()
963 | _ => (write "\tIndexIgnore";
964 app (fn pat => (write " "; write pat)) pats;
965 write "\n"))
966
9d7fa346
AC		 967val () = Env.action_one "set_indexOptions"
968 ("options", Env.list autoindex_option)
969 (fn opts =>
970 case opts of
971 [] => ()
972 | _ => (write "\tIndexOptions";
973 app (fn (opt, arg) =>
974 (write " +";
975 write opt;
976 Option.app (fn arg =>
977 (write "="; write arg)) arg)) opts;
978 write "\n"))
979
980val () = Env.action_one "unset_indexOptions"
981 ("options", Env.list autoindex_option)
982 (fn opts =>
983 case opts of
984 [] => ()
985 | _ => (write "\tIndexOptions";
986 app (fn (opt, _) =>
987 (write " -";
988 write opt)) opts;
989 write "\n"))
990
991val () = Env.action_one "headerName"
992 ("name", Env.string)
993 (fn name => (write "\tHeaderName ";
994 write name;
995 write "\n"))
996
997val () = Env.action_one "readmeName"
998 ("name", Env.string)
999 (fn name => (write "\tReadmeName ";
1000 write name;
1001 write "\n"))
1002
eda33894
AC		 1003val () = Env.action_two "setEnv"
1004 ("key", Env.string, "value", Env.string)
1005 (fn (key, value) => (write "\tSetEnv \"";
1006 write key;
1007 write "\" \"";
ca6ffb3f
AC		 1008 write (String.translate (fn #"\"" => "\\\""
1009 | ch => str ch) value);
eda33894
AC		 1010 write "\"\n"))
1011
f0062360
AC		 1012val () = Env.action_one "diskCache"
1013 ("path", Env.string)
1014 (fn path => (write "\tCacheEnable disk \"";
1015 write path;
1016 write "\"\n"))
83bc6c45 1017
83bc6c45
AC		 1018val () = Env.action_one "phpVersion"
1019 ("version", php_version)
1020 (fn version => (write "\tAddHandler x-httpd-php";
1021 write (Int.toString version);
1022 write " .php .phtml\n"))
1023
bcf547ec
AC		 1024val () = Env.action_two "addType"
1025 ("mime type", Env.string, "extension", Env.string)
1026 (fn (mt, ext) => (write "\tAddType ";
1027 write mt;
1028 write " ";
1029 write ext;
1030 write "\n"))
1031
1032val filter = fn (EVar "includes", _) => SOME "INCLUDES"
1033 | (EVar "deflate", _) => SOME "DEFLATE"
1034 | _ => NONE
1035
1036val () = Env.action_two "addOutputFilter"
1037 ("filters", Env.list filter, "extensions", Env.list Env.string)
1038 (fn (f :: fs, exts as (_ :: _)) =>
1039 (write "\tAddOutputFilter ";
1040 write f;
1041 app (fn f => (write ";"; write f)) fs;
1042 app (fn ext => (write " "; write ext)) exts;
1043 write "\n")
1044 | _ => ())
1045
71420f8b
AC		 1046val () = Domain.registerResetLocal (fn () =>
1047 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
1048
41c58daf
AC		 1049val () = Domain.registerDescriber (Domain.considerAll
1050 [Domain.Extension {extension = "vhost",
d936cf4d 1051 heading = fn host => "Web vhost " ^ host ^ ":"},
41c58daf 1052 Domain.Extension {extension = "vhost_ssl",
d936cf4d 1053 heading = fn host => "SSL web vhost " ^ host ^ ":"}])
41c58daf 1054
ecc307a0
AC		 1055val () = Env.action_none "testNoHtaccess"
1056 (fn path => write "\tAllowOverride None\n")
1057
8a7c40fa 1058end
Unnamed repository; edit this file to name it for gitweb.