HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
HCoop IP synonyms; PhpVersion env var
[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 ();
600 write "\tRewriteRule\t";
601 write from;
602 write "\thttp://localhost:";
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 ();
630 write "\tRewriteRule\t";
631 write from;
632 write "\t";
633 write to;
634 case flags of
635 [] => ()
636 | flag::rest => (write " [";
637 write flag;
638 app (fn flag => (write ",";
639 write flag)) rest;
640 write "]");
641 write "\n"))
642
e95a129e
AC		 643val () = Env.action_three "rewriteCond"
644 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
645 (fn (from, to, flags) =>
646 (checkRewrite ();
647 write "\tRewriteCond\t";
648 write from;
649 write "\t";
650 write to;
651 case flags of
652 [] => ()
653 | flag::rest => (write " [";
654 write flag;
655 app (fn flag => (write ",";
656 write flag)) rest;
657 write "]");
658 write "\n"))
659
94b7b11a
AC		 660val () = Env.action_one "rewriteBase"
661 ("prefix", Env.string)
662 (fn prefix =>
663 (checkRewrite ();
664 write "\tRewriteBase\t";
665 write prefix;
666 write "\n"))
667
c98b57cf
AC		 668val () = Env.action_one "rewriteLogLevel"
669 ("level", Env.int)
670 (fn level =>
671 (checkRewrite ();
672 write "\tRewriteLog ";
7a2b27f0 673 write' (fn x => x);
c98b57cf
AC		 674 write "/rewrite.log\n\tRewriteLogLevel ";
675 write (Int.toString level);
676 write "\n"))
677
d5754b53
AC		 678val () = Env.action_two "alias"
679 ("from", Env.string, "to", Env.string)
680 (fn (from, to) =>
681 (write "\tAlias\t";
682 write from;
683 write " ";
684 write to;
685 write "\n"))
686
687val () = Env.action_two "scriptAlias"
688 ("from", Env.string, "to", Env.string)
689 (fn (from, to) =>
690 (write "\tScriptAlias\t";
691 write from;
692 write " ";
693 write to;
694 write "\n"))
695
696val () = Env.action_two "errorDocument"
697 ("code", Env.string, "handler", Env.string)
698 (fn (code, handler) =>
989965b1
AC		 699 let
700 val hasSpaces = CharVector.exists Char.isSpace handler
d5754b53 701
989965b1
AC		 702 fun maybeQuote () =
703 if hasSpaces then
704 write "\""
705 else
706 ()
707 in
708 write "\tErrorDocument\t";
709 write code;
710 write " ";
711 maybeQuote ();
712 write handler;
713 maybeQuote ();
714 write "\n"
715 end)
716
d441e69f
AC		 717val () = Env.action_one "options"
718 ("options", Env.list apache_option)
719 (fn opts =>
720 case opts of
721 [] => ()
722 | _ => (write "\tOptions";
723 app (fn opt => (write " "; write opt)) opts;
724 write "\n"))
725
726val () = Env.action_one "set_options"
727 ("options", Env.list apache_option)
728 (fn opts =>
729 case opts of
730 [] => ()
731 | _ => (write "\tOptions";
732 app (fn opt => (write " +"; write opt)) opts;
733 write "\n"))
734
735val () = Env.action_one "unset_options"
736 ("options", Env.list apache_option)
737 (fn opts =>
738 case opts of
739 [] => ()
740 | _ => (write "\tOptions";
741 app (fn opt => (write " -"; write opt)) opts;
742 write "\n"))
d5754b53 743
781ebc11
AC		 744val () = Env.action_one "cgiExtension"
745 ("extension", Env.string)
746 (fn ext => (write "\tAddHandler cgi-script ";
747 write ext;
748 write "\n"))
749
edd38024
AC		 750val () = Env.action_one "directoryIndex"
751 ("filenames", Env.list Env.string)
752 (fn opts =>
753 (write "\tDirectoryIndex";
754 app (fn opt => (write " "; write opt)) opts;
755 write "\n"))
756
e519d696 757val () = Env.action_one "serverAliasHost"
edd38024
AC		 758 ("host", Env.string)
759 (fn host =>
760 (write "\tServerAlias ";
761 write host;
7f75d838
AC		 762 write "\n";
763 !aliaser host))
edd38024 764
e519d696
AC		 765val () = Env.action_one "serverAlias"
766 ("host", Env.string)
767 (fn host =>
768 (app
769 (fn dom =>
770 let
771 val full = host ^ "." ^ dom
772 in
773 write "\tServerAlias ";
774 write full;
775 write "\n";
776 !aliaser full
777 end)
778 (Domain.currentDomains ())))
779
780val () = Env.action_none "serverAliasDefault"
781 (fn () =>
782 (app
783 (fn dom =>
784 (write "\tServerAlias ";
785 write dom;
786 write "\n";
787 !aliaser dom))
788 (Domain.currentDomains ())))
789
2aeb9eec
AC		 790val authType = fn (EVar "basic", _) => SOME "basic"
791 | (EVar "digest", _) => SOME "digest"
35dc7746 792 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 793 | _ => NONE
794
8a5b34c9
AC		 795fun allowAuthType "kerberos" = !sslEnabled
796 | allowAuthType _ = true
797
2aeb9eec
AC		 798val () = Env.action_one "authType"
799 ("type", authType)
800 (fn ty =>
8a5b34c9
AC		 801 if allowAuthType ty then
802 (write "\tAuthType ";
803 write ty;
804 write "\n";
805 case ty of
806 "kerberos" =>
807 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
808 | _ => ())
809 else
810 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 811
812val () = Env.action_one "authName"
813 ("name", Env.string)
814 (fn name =>
815 (write "\tAuthName \"";
816 write name;
817 write "\"\n"))
818
819val () = Env.action_one "authUserFile"
820 ("file", Env.string)
821 (fn name =>
822 (write "\tAuthUserFile ";
823 write name;
824 write "\n"))
825
826val () = Env.action_none "requireValidUser"
827 (fn () => write "\tRequire valid-user\n")
828
829val () = Env.action_one "requireUser"
830 ("users", Env.list Env.string)
831 (fn names =>
832 case names of
833 [] => ()
834 | _ => (write "\tRequire user";
835 app (fn name => (write " "; write name)) names;
836 write "\n"))
837
838val () = Env.action_one "requireGroup"
839 ("groups", Env.list Env.string)
840 (fn names =>
841 case names of
842 [] => ()
843 | _ => (write "\tRequire group";
844 app (fn name => (write " "; write name)) names;
845 write "\n"))
846
847val () = Env.action_none "orderAllowDeny"
848 (fn () => write "\tOrder allow,deny\n")
849
850val () = Env.action_none "orderDenyAllow"
851 (fn () => write "\tOrder deny,allow\n")
852
853val () = Env.action_none "allowFromAll"
854 (fn () => write "\tAllow from all\n")
855
856val () = Env.action_one "allowFrom"
857 ("entries", Env.list Env.string)
858 (fn names =>
859 case names of
860 [] => ()
861 | _ => (write "\tAllow from";
862 app (fn name => (write " "; write name)) names;
863 write "\n"))
864
865val () = Env.action_none "denyFromAll"
866 (fn () => write "\tDeny from all\n")
867
868val () = Env.action_one "denyFrom"
869 ("entries", Env.list Env.string)
870 (fn names =>
871 case names of
872 [] => ()
873 | _ => (write "\tDeny from";
874 app (fn name => (write " "; write name)) names;
875 write "\n"))
876
877val () = Env.action_none "satisfyAll"
878 (fn () => write "\tSatisfy all\n")
879
880val () = Env.action_none "satisfyAny"
881 (fn () => write "\tSatisfy any\n")
882
7f012ffd
AC		 883val () = Env.action_one "forceType"
884 ("type", Env.string)
885 (fn ty => (write "\tForceType ";
886 write ty;
887 write "\n"))
888
889val () = Env.action_none "forceTypeOff"
890 (fn () => write "\tForceType None\n")
891
892val () = Env.action_two "action"
893 ("what", Env.string, "how", Env.string)
894 (fn (what, how) => (write "\tAction ";
895 write what;
896 write " ";
897 write how;
898 write "\n"))
899
900val () = Env.action_one "addDefaultCharset"
901 ("charset", Env.string)
902 (fn ty => (write "\tAddDefaultCharset ";
903 write ty;
904 write "\n"))
905
64e85bae 906(*val () = Env.action_one "davSvn"
c8505e59
AC		 907 ("path", Env.string)
908 (fn path => (write "\tDAV svn\n\tSVNPath ";
909 write path;
910 write "\n"))
911
912val () = Env.action_one "authzSvnAccessFile"
913 ("path", Env.string)
914 (fn path => (write "\tAuthzSVNAccessFile ";
915 write path;
64e85bae 916 write "\n"))*)
c8505e59 917
0aed4302
AC		 918val () = Env.action_none "davFilesystem"
919 (fn path => write "\tDAV filesystem\n")
920
9d7fa346
AC		 921val () = Env.action_two "addDescription"
922 ("description", Env.string, "patterns", Env.list Env.string)
923 (fn (desc, pats) =>
924 case pats of
925 [] => ()
926 | _ => (write "\tAddDescription \"";
927 write (String.toString desc);
928 write "\"";
929 app (fn pat => (write " "; write pat)) pats;
930 write "\n"))
931
1817ed97
AC		 932val () = Env.action_two "addIcon"
933 ("icon", Env.string, "patterns", Env.list Env.string)
934 (fn (icon, pats) =>
935 case pats of
936 [] => ()
937 | _ => (write "\tAddIcon \"";
938 write icon;
939 write "\"";
940 app (fn pat => (write " "; write pat)) pats;
941 write "\n"))
942
9d7fa346
AC		 943val () = Env.action_one "indexOptions"
944 ("options", Env.list autoindex_option)
945 (fn opts =>
946 case opts of
947 [] => ()
948 | _ => (write "\tIndexOptions";
949 app (fn (opt, arg) =>
950 (write " ";
951 write opt;
952 Option.app (fn arg =>
953 (write "="; write arg)) arg)) opts;
954 write "\n"))
955
1817ed97
AC		 956val () = Env.action_one "indexIgnore"
957 ("patterns", Env.list Env.string)
958 (fn pats =>
959 case pats of
960 [] => ()
961 | _ => (write "\tIndexIgnore";
962 app (fn pat => (write " "; write pat)) pats;
963 write "\n"))
964
9d7fa346
AC		 965val () = Env.action_one "set_indexOptions"
966 ("options", Env.list autoindex_option)
967 (fn opts =>
968 case opts of
969 [] => ()
970 | _ => (write "\tIndexOptions";
971 app (fn (opt, arg) =>
972 (write " +";
973 write opt;
974 Option.app (fn arg =>
975 (write "="; write arg)) arg)) opts;
976 write "\n"))
977
978val () = Env.action_one "unset_indexOptions"
979 ("options", Env.list autoindex_option)
980 (fn opts =>
981 case opts of
982 [] => ()
983 | _ => (write "\tIndexOptions";
984 app (fn (opt, _) =>
985 (write " -";
986 write opt)) opts;
987 write "\n"))
988
989val () = Env.action_one "headerName"
990 ("name", Env.string)
991 (fn name => (write "\tHeaderName ";
992 write name;
993 write "\n"))
994
995val () = Env.action_one "readmeName"
996 ("name", Env.string)
997 (fn name => (write "\tReadmeName ";
998 write name;
999 write "\n"))
1000
eda33894
AC		 1001val () = Env.action_two "setEnv"
1002 ("key", Env.string, "value", Env.string)
1003 (fn (key, value) => (write "\tSetEnv \"";
1004 write key;
1005 write "\" \"";
ca6ffb3f
AC		 1006 write (String.translate (fn #"\"" => "\\\""
1007 | ch => str ch) value);
eda33894
AC		 1008 write "\"\n"))
1009
f0062360
AC		 1010val () = Env.action_one "diskCache"
1011 ("path", Env.string)
1012 (fn path => (write "\tCacheEnable disk \"";
1013 write path;
1014 write "\"\n"))
83bc6c45 1015
83bc6c45
AC		 1016val () = Env.action_one "phpVersion"
1017 ("version", php_version)
1018 (fn version => (write "\tAddHandler x-httpd-php";
1019 write (Int.toString version);
1020 write " .php .phtml\n"))
1021
bcf547ec
AC		 1022val () = Env.action_two "addType"
1023 ("mime type", Env.string, "extension", Env.string)
1024 (fn (mt, ext) => (write "\tAddType ";
1025 write mt;
1026 write " ";
1027 write ext;
1028 write "\n"))
1029
1030val filter = fn (EVar "includes", _) => SOME "INCLUDES"
1031 | (EVar "deflate", _) => SOME "DEFLATE"
1032 | _ => NONE
1033
1034val () = Env.action_two "addOutputFilter"
1035 ("filters", Env.list filter, "extensions", Env.list Env.string)
1036 (fn (f :: fs, exts as (_ :: _)) =>
1037 (write "\tAddOutputFilter ";
1038 write f;
1039 app (fn f => (write ";"; write f)) fs;
1040 app (fn ext => (write " "; write ext)) exts;
1041 write "\n")
1042 | _ => ())
1043
71420f8b
AC		 1044val () = Domain.registerResetLocal (fn () =>
1045 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
1046
41c58daf
AC		 1047val () = Domain.registerDescriber (Domain.considerAll
1048 [Domain.Extension {extension = "vhost",
d936cf4d 1049 heading = fn host => "Web vhost " ^ host ^ ":"},
41c58daf 1050 Domain.Extension {extension = "vhost_ssl",
d936cf4d 1051 heading = fn host => "SSL web vhost " ^ host ^ ":"}])
41c58daf 1052
8a7c40fa 1053end
Unnamed repository; edit this file to name it for gitweb.