HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add a slash
[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
2882ee37
AC		 89fun validLocation s =
90 size s > 0 andalso size s < 1000 andalso CharVector.all
91 (fn ch => Char.isAlphaNum ch
92 orelse ch = #"-"
93 orelse ch = #"_"
94 orelse ch = #"."
95 orelse ch = #"/") s
96
97val _ = Env.type_one "location"
98 Env.string
99 validLocation
100
434a7b1f
AC		 101fun validCert s = Acl.query {user = Domain.getUser (),
102 class = "cert",
103 value = s}
104
105val _ = Env.type_one "ssl_cert_path"
106 Env.string
107 validCert
108
109fun ssl e = case e of
110 (EVar "no_ssl", _) => SOME NONE
111 | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
112 | _ => NONE
113
128e7b0b
AC		 114val defaults = [("WebPlaces",
115 (TList (TBase "web_place", dl), dl),
116 (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
8cbb9632
AC		 117 ("SSL",
118 (TBase "ssl", dl),
119 (fn () => (EVar "no_ssl", dl))),
120 ("User",
121 (TBase "your_user", dl),
122 (fn () => (EString (Domain.getUser ()), dl))),
123 ("Group",
124 (TBase "your_group", dl),
125 (fn () => (EString "nogroup", dl))),
126 ("DocumentRoot",
127 (TBase "your_path", dl),
128 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
129 ("ServerAdmin",
130 (TBase "email", dl),
131 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
132 ("SuExec",
133 (TBase "suexec_flag", dl),
134 (fn () => (EVar "true", dl)))]
135
136val () = app Defaults.registerDefault defaults
f8dfbbcc
AC		 137
138val redirect_code = fn (EVar "temp", _) => SOME "temp"
139 | (EVar "permanent", _) => SOME "permanent"
140 | (EVar "seeother", _) => SOME "seeother"
141 | (EVar "redir300", _) => SOME "300"
142 | (EVar "redir301", _) => SOME "301"
143 | (EVar "redir302", _) => SOME "302"
144 | (EVar "redir303", _) => SOME "303"
145 | (EVar "redir304", _) => SOME "304"
146 | (EVar "redir305", _) => SOME "305"
147 | (EVar "redir307", _) => SOME "307"
148 | _ => NONE
149
150val flag = fn (EVar "redirect", _) => SOME "R"
151 | (EVar "forbidden", _) => SOME "F"
152 | (EVar "gone", _) => SOME "G"
153 | (EVar "last", _) => SOME "L"
154 | (EVar "chain", _) => SOME "C"
155 | (EVar "nosubreq", _) => SOME "NS"
156 | (EVar "nocase", _) => SOME "NC"
157 | (EVar "qsappend", _) => SOME "QSA"
158 | (EVar "noescape", _) => SOME "NE"
159 | (EVar "passthrough", _) => SOME "PT"
160 | (EApp ((EVar "mimeType", _), e), _) =>
161 Option.map (fn s => "T=" ^ s) (Env.string e)
162 | (EApp ((EVar "redirectWith", _), e), _) =>
163 Option.map (fn s => "R=" ^ s) (redirect_code e)
164 | (EApp ((EVar "skip", _), e), _) =>
165 Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
166 | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
167 (case Env.string e1 of
168 NONE => NONE
169 | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
170 (Env.string e2))
171
172 | _ => NONE
173
e95a129e
AC		 174val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
175 | (EVar "ornext", _) => SOME "OR"
176 | _ => NONE
177
d441e69f
AC		 178val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
179 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
180 | (EVar "indexes", _) => SOME "Indexes"
181 | _ => NONE
182
9d7fa346
AC		 183val autoindex_width = fn (EVar "autofit", _) => SOME "*"
184 | (EApp ((EVar "characters", _), n), _) =>
185 Option.map Int.toString (Env.int n)
186 | _ => NONE
187
188val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
189 Option.map (fn w => ("DescriptionWidth", SOME w))
190 (autoindex_width w)
191 | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE)
192 | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE)
193 | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE)
194 | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE)
195 | (EApp ((EVar "iconHeight", _), n), _) =>
196 Option.map (fn w => ("IconHeight", SOME (Int.toString w)))
197 (Env.int n)
198 | (EApp ((EVar "iconWidth", _), n), _) =>
199 Option.map (fn w => ("IconWidth", SOME (Int.toString w)))
200 (Env.int n)
201 | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE)
202 | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE)
203 | (EApp ((EVar "nameWidth", _), w), _) =>
204 Option.map (fn w => ("NameWidth", SOME w))
205 (autoindex_width w)
206 | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE)
207 | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE)
208 | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE)
209 | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE)
210 | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE)
211 | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE)
212 | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE)
213 | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE)
214 | (EVar "trackModified", _) => SOME ("TrackModified", NONE)
215 | (EVar "versionSort", _) => SOME ("VersionSort", NONE)
216 | (EVar "xhtml", _) => SOME ("XHTML", NONE)
217
218 | _ => NONE
f8dfbbcc 219
8a7c40fa 220val vhostsChanged = ref false
8e965b2d 221val logDeleted = ref false
8a7c40fa
AC		 222
223val () = Slave.registerPreHandler
8e965b2d
AC		 224 (fn () => (vhostsChanged := false;
225 logDeleted := false))
8a7c40fa 226
7db53a0b
AC		 227fun findVhostUser fname =
228 let
229 val inf = TextIO.openIn fname
230
231 fun loop () =
232 case TextIO.inputLine inf of
233 NONE => NONE
234 | SOME line =>
00a13ad8
AC		 235 if String.isPrefix "# Owner: " line then
236 case String.tokens Char.isSpace line of
237 [_, _, user] => SOME user
238 | _ => NONE
239 else
240 loop ()
7db53a0b
AC		 241 in
242 loop ()
243 before TextIO.closeIn inf
3a941c29 244 end handle _ => NONE
7db53a0b 245
55d4a268
AC		 246val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
247
248fun isVersion1 node =
f8ef6c20
AC		 249 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
250 | _ => false) webNodes_full
55d4a268
AC		 251
252fun imVersion1 () = isVersion1 (Slave.hostname ())
253
f8ef6c20
AC		 254fun isWaklog node =
255 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
256 | _ => false) webNodes_full
257
55d4a268
AC		 258fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
259fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
260fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
c17d0537 261fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
55d4a268 262
b59d9074 263fun logDir {user, node, vhostId} =
2a7d2818 264 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
409542d7 265 "/",
b59d9074
AC		 266 node,
267 "/",
268 vhostId]
269
8a7c40fa 270val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 271 let
272 val spl = OS.Path.splitDirFile (#file fs)
273 in
274 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 275 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
276 val realVhostFile = OS.Path.joinDirFile
277 {dir = Config.Apache.confDir,
278 file = #file spl}
279
280 val user = findVhostUser (#file fs)
19026493
AC		 281 val oldUser = case #action fs of
282 Slave.Delete false => user
283 | _ => findVhostUser realVhostFile
3a941c29
AC		 284 in
285 if (oldUser = NONE andalso #action fs <> Slave.Add)
1638d5a2 286 orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
3a941c29
AC		 287 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
288 else
289 let
5b07cebd 290 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
b59d9074
AC		 291 OS.Path.base (#file spl) ^ ".ssl"
292 else
293 OS.Path.base (#file spl)
294
3a941c29 295 fun realLogDir user =
b59d9074
AC		 296 logDir {user = valOf user,
297 node = Slave.hostname (),
298 vhostId = vhostId}
c17d0537
AC		 299
300 fun backupLogs () =
301 OS.Path.joinDirFile
302 {dir = Config.Apache.backupLogDirOf
303 (isVersion1 (Slave.hostname ())),
304 file = vhostId}
3a941c29
AC		 305 in
306 vhostsChanged := true;
307 case #action fs of
1638d5a2 308 Slave.Delete _ =>
31b50af0
AC		 309 let
310 val ldir = realLogDir oldUser
311 in
312 if !logDeleted then
313 ()
314 else
315 (ignore (OS.Process.system (down ()));
c17d0537 316 ignore (OS.Process.system (fixperms ()));
31b50af0
AC		 317 logDeleted := true);
318 ignore (OS.Process.system (Config.rm
319 ^ " -rf "
320 ^ realVhostFile));
321 Slave.moveDirCreate {from = ldir,
c17d0537 322 to = backupLogs ()}
31b50af0 323 end
3a941c29
AC		 324 | Slave.Add =>
325 let
326 val rld = realLogDir user
327 in
328 ignore (OS.Process.system (Config.cp
329 ^ " "
330 ^ #file fs
331 ^ " "
332 ^ realVhostFile));
333 if Posix.FileSys.access (rld, []) then
334 ()
335 else
c17d0537 336 Slave.moveDirCreate {from = backupLogs (),
31b50af0 337 to = rld}
3a941c29
AC		 338 end
339
340 | _ =>
341 (ignore (OS.Process.system (Config.cp
342 ^ " "
343 ^ #file fs
344 ^ " "
345 ^ realVhostFile));
346 if user <> oldUser then
347 let
348 val old = realLogDir oldUser
349 val rld = realLogDir user
350 in
351 if !logDeleted then
352 ()
353 else
55d4a268 354 (ignore (OS.Process.system (down ()));
3a941c29
AC		 355 logDeleted := true);
356 ignore (OS.Process.system (Config.rm
357 ^ " -rf "
358 ^ realLogDir oldUser));
359 if Posix.FileSys.access (rld, []) then
360 ()
361 else
409542d7 362 Slave.mkDirAll rld
3a941c29
AC		 363 end
364 else
365 ())
366 end
367 end
7a2b27f0
AC		 368 else
369 ()
370 end)
8a7c40fa
AC		 371
372val () = Slave.registerPostHandler
373 (fn () =>
374 (if !vhostsChanged then
55d4a268 375 Slave.shellF ([if !logDeleted then undown () else reload ()],
8a7c40fa
AC		 376 fn cl => "Error reloading Apache with " ^ cl)
377 else
378 ()))
379
7a2b27f0
AC		 380val vhostFiles : (string * TextIO.outstream) list ref = ref []
381fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
382fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 383
f8dfbbcc 384val rewriteEnabled = ref false
ce01b51a 385val localRewriteEnabled = ref false
c98b57cf
AC		 386val currentVhost = ref ""
387val currentVhostId = ref ""
8a5b34c9 388val sslEnabled = ref false
f8dfbbcc 389
7a2b27f0 390val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 391fun registerPre f =
392 let
393 val old = !pre
394 in
395 pre := (fn x => (old x; f x))
396 end
397
398val post = ref (fn () => ())
399fun registerPost f =
400 let
401 val old = !post
402 in
403 post := (fn () => (old (); f ()))
404 end
405
e9f528ab
AC		 406fun doPre x = !pre x
407fun doPost () = !post ()
408
7f75d838
AC		 409val aliaser = ref (fn _ : string => ())
410fun registerAliaser f =
411 let
412 val old = !aliaser
413 in
414 aliaser := (fn x => (old x; f x))
415 end
416
8a7c40fa
AC		 417val () = Env.containerV_one "vhost"
418 ("host", Env.string)
419 (fn (env, host) =>
420 let
128e7b0b 421 val places = Env.env (Env.list webPlace) (env, "WebPlaces")
8a7c40fa 422
434a7b1f 423 val ssl = Env.env ssl (env, "SSL")
8a7c40fa
AC		 424 val user = Env.env Env.string (env, "User")
425 val group = Env.env Env.string (env, "Group")
426 val docroot = Env.env Env.string (env, "DocumentRoot")
427 val sadmin = Env.env Env.string (env, "ServerAdmin")
434a7b1f 428 val suexec = Env.env Env.bool (env, "SuExec")
8a7c40fa
AC		 429
430 val fullHost = host ^ "." ^ Domain.currentDomain ()
434a7b1f
AC		 431 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
432 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
8a7c40fa 433 in
c98b57cf
AC		 434 currentVhost := fullHost;
435 currentVhostId := vhostId;
8a5b34c9 436 sslEnabled := Option.isSome ssl;
c98b57cf 437
f8dfbbcc 438 rewriteEnabled := false;
ce01b51a 439 localRewriteEnabled := false;
128e7b0b 440 vhostFiles := map (fn (node, ip) =>
8a7c40fa
AC		 441 let
442 val file = Domain.domainFile {node = node,
443 name = confFile}
2a7d2818
AC		 444
445 val ld = logDir {user = user, node = node, vhostId = vhostId}
8a7c40fa 446 in
00a13ad8
AC		 447 TextIO.output (file, "# Owner: ");
448 TextIO.output (file, user);
449 TextIO.output (file, "\n<VirtualHost ");
128e7b0b 450 TextIO.output (file, ip);
8a7c40fa 451 TextIO.output (file, ":");
434a7b1f
AC		 452 TextIO.output (file, case ssl of
453 SOME _ => "443"
454 | NONE => "80");
8a7c40fa 455 TextIO.output (file, ">\n");
7a2b27f0 456 TextIO.output (file, "\tErrorLog ");
2a7d2818 457 TextIO.output (file, ld);
7a2b27f0 458 TextIO.output (file, "/error.log\n\tCustomLog ");
2a7d2818 459 TextIO.output (file, ld);
7a2b27f0 460 TextIO.output (file, "/access.log combined\n");
55d4a268
AC		 461 TextIO.output (file, "\tServerName ");
462 TextIO.output (file, fullHost);
e519d696
AC		 463 app
464 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
465 TextIO.output (file, host);
466 TextIO.output (file, ".");
467 TextIO.output (file, dom)))
468 (Domain.currentAliasDomains ());
3f84c976 469
55d4a268
AC		 470 if suexec then
471 if isVersion1 node then
472 (TextIO.output (file, "\n\tUser ");
473 TextIO.output (file, user);
474 TextIO.output (file, "\n\tGroup ");
475 TextIO.output (file, group))
476 else
477 (TextIO.output (file, "\n\tSuexecUserGroup ");
478 TextIO.output (file, user);
479 TextIO.output (file, " ");
480 TextIO.output (file, group))
481 else
482 ();
3f84c976 483
f8ef6c20 484 if isWaklog node then
a09d0e82 485 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
f8ef6c20 486 TextIO.output (file, user);
fdf9a42d 487 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
f8ef6c20
AC		 488 TextIO.output (file, user))
489 else
490 ();
3f84c976 491
e34e1f36 492 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
3f84c976
AC		 493 TextIO.output (file, user);
494 TextIO.output (file, "/DAVLock");
495
2a7d2818 496 (ld, file)
8a7c40fa 497 end)
128e7b0b 498 places;
8a7c40fa
AC		 499 write "\n\tDocumentRoot ";
500 write docroot;
501 write "\n\tServerAdmin ";
502 write sadmin;
434a7b1f
AC		 503 case ssl of
504 SOME cert =>
505 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
506 write cert)
507 | NONE => ();
7a2b27f0 508 write "\n";
128e7b0b 509 !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
5cab5a98 510 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
8a7c40fa 511 end,
7f75d838
AC		 512 fn () => (!post ();
513 write "</VirtualHost>\n";
7a2b27f0 514 app (TextIO.closeOut o #2) (!vhostFiles)))
8a7c40fa 515
ce01b51a
AC		 516val inLocal = ref false
517
2882ee37
AC		 518val () = Env.container_one "location"
519 ("prefix", Env.string)
520 (fn prefix =>
521 (write "\t<Location ";
522 write prefix;
ce01b51a
AC		 523 write ">\n";
524 inLocal := true),
525 fn () => (write "\t</Location>\n";
526 inLocal := false;
527 localRewriteEnabled := false))
2882ee37
AC		 528
529val () = Env.container_one "directory"
530 ("directory", Env.string)
531 (fn directory =>
532 (write "\t<Directory ";
533 write directory;
ce01b51a
AC		 534 write ">\n";
535 inLocal := true),
536 fn () => (write "\t</Directory>\n";
537 inLocal := false;
538 localRewriteEnabled := false))
2882ee37 539
f8dfbbcc 540fun checkRewrite () =
ce01b51a
AC		 541 if !inLocal then
542 if !rewriteEnabled orelse !localRewriteEnabled then
543 ()
544 else
545 (write "\tRewriteEngine on\n";
546 localRewriteEnabled := true)
547 else if !rewriteEnabled then
f8dfbbcc
AC		 548 ()
549 else
550 (write "\tRewriteEngine on\n";
551 rewriteEnabled := true)
552
553val () = Env.action_three "localProxyRewrite"
554 ("from", Env.string, "to", Env.string, "port", Env.int)
555 (fn (from, to, port) =>
556 (checkRewrite ();
557 write "\tRewriteRule\t";
558 write from;
559 write "\thttp://localhost:";
560 write (Int.toString port);
561 write "/";
562 write to;
563 write " [P]\n"))
564
e95a129e
AC		 565val () = Env.action_two "proxyPass"
566 ("from", Env.string, "to", Env.string)
567 (fn (from, to) =>
568 (write "\tProxyPass\t";
569 write from;
570 write "\t";
571 write to;
572 write "\n"))
573
574val () = Env.action_two "proxyPassReverse"
575 ("from", Env.string, "to", Env.string)
576 (fn (from, to) =>
577 (write "\tProxyPassReverse\t";
578 write from;
579 write "\t";
580 write to;
581 write "\n"))
f8dfbbcc
AC		 582
583val () = Env.action_three "rewriteRule"
584 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
585 (fn (from, to, flags) =>
586 (checkRewrite ();
587 write "\tRewriteRule\t";
588 write from;
589 write "\t";
590 write to;
591 case flags of
592 [] => ()
593 | flag::rest => (write " [";
594 write flag;
595 app (fn flag => (write ",";
596 write flag)) rest;
597 write "]");
598 write "\n"))
599
e95a129e
AC		 600val () = Env.action_three "rewriteCond"
601 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
602 (fn (from, to, flags) =>
603 (checkRewrite ();
604 write "\tRewriteCond\t";
605 write from;
606 write "\t";
607 write to;
608 case flags of
609 [] => ()
610 | flag::rest => (write " [";
611 write flag;
612 app (fn flag => (write ",";
613 write flag)) rest;
614 write "]");
615 write "\n"))
616
94b7b11a
AC		 617val () = Env.action_one "rewriteBase"
618 ("prefix", Env.string)
619 (fn prefix =>
620 (checkRewrite ();
621 write "\tRewriteBase\t";
622 write prefix;
623 write "\n"))
624
c98b57cf
AC		 625val () = Env.action_one "rewriteLogLevel"
626 ("level", Env.int)
627 (fn level =>
628 (checkRewrite ();
629 write "\tRewriteLog ";
7a2b27f0 630 write' (fn x => x);
c98b57cf
AC		 631 write "/rewrite.log\n\tRewriteLogLevel ";
632 write (Int.toString level);
633 write "\n"))
634
d5754b53
AC		 635val () = Env.action_two "alias"
636 ("from", Env.string, "to", Env.string)
637 (fn (from, to) =>
638 (write "\tAlias\t";
639 write from;
640 write " ";
641 write to;
642 write "\n"))
643
644val () = Env.action_two "scriptAlias"
645 ("from", Env.string, "to", Env.string)
646 (fn (from, to) =>
647 (write "\tScriptAlias\t";
648 write from;
649 write " ";
650 write to;
651 write "\n"))
652
653val () = Env.action_two "errorDocument"
654 ("code", Env.string, "handler", Env.string)
655 (fn (code, handler) =>
656 (write "\tErrorDocument\t";
657 write code;
658 write " ";
659 write handler;
660 write "\n"))
661
d441e69f
AC		 662val () = Env.action_one "options"
663 ("options", Env.list apache_option)
664 (fn opts =>
665 case opts of
666 [] => ()
667 | _ => (write "\tOptions";
668 app (fn opt => (write " "; write opt)) opts;
669 write "\n"))
670
671val () = Env.action_one "set_options"
672 ("options", Env.list apache_option)
673 (fn opts =>
674 case opts of
675 [] => ()
676 | _ => (write "\tOptions";
677 app (fn opt => (write " +"; write opt)) opts;
678 write "\n"))
679
680val () = Env.action_one "unset_options"
681 ("options", Env.list apache_option)
682 (fn opts =>
683 case opts of
684 [] => ()
685 | _ => (write "\tOptions";
686 app (fn opt => (write " -"; write opt)) opts;
687 write "\n"))
d5754b53 688
edd38024
AC		 689val () = Env.action_one "directoryIndex"
690 ("filenames", Env.list Env.string)
691 (fn opts =>
692 (write "\tDirectoryIndex";
693 app (fn opt => (write " "; write opt)) opts;
694 write "\n"))
695
e519d696 696val () = Env.action_one "serverAliasHost"
edd38024
AC		 697 ("host", Env.string)
698 (fn host =>
699 (write "\tServerAlias ";
700 write host;
7f75d838
AC		 701 write "\n";
702 !aliaser host))
edd38024 703
e519d696
AC		 704val () = Env.action_one "serverAlias"
705 ("host", Env.string)
706 (fn host =>
707 (app
708 (fn dom =>
709 let
710 val full = host ^ "." ^ dom
711 in
712 write "\tServerAlias ";
713 write full;
714 write "\n";
715 !aliaser full
716 end)
717 (Domain.currentDomains ())))
718
719val () = Env.action_none "serverAliasDefault"
720 (fn () =>
721 (app
722 (fn dom =>
723 (write "\tServerAlias ";
724 write dom;
725 write "\n";
726 !aliaser dom))
727 (Domain.currentDomains ())))
728
2aeb9eec
AC		 729val authType = fn (EVar "basic", _) => SOME "basic"
730 | (EVar "digest", _) => SOME "digest"
35dc7746 731 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 732 | _ => NONE
733
8a5b34c9
AC		 734fun allowAuthType "kerberos" = !sslEnabled
735 | allowAuthType _ = true
736
2aeb9eec
AC		 737val () = Env.action_one "authType"
738 ("type", authType)
739 (fn ty =>
8a5b34c9
AC		 740 if allowAuthType ty then
741 (write "\tAuthType ";
742 write ty;
743 write "\n";
744 case ty of
745 "kerberos" =>
746 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
747 | _ => ())
748 else
749 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 750
751val () = Env.action_one "authName"
752 ("name", Env.string)
753 (fn name =>
754 (write "\tAuthName \"";
755 write name;
756 write "\"\n"))
757
758val () = Env.action_one "authUserFile"
759 ("file", Env.string)
760 (fn name =>
761 (write "\tAuthUserFile ";
762 write name;
763 write "\n"))
764
765val () = Env.action_none "requireValidUser"
766 (fn () => write "\tRequire valid-user\n")
767
768val () = Env.action_one "requireUser"
769 ("users", Env.list Env.string)
770 (fn names =>
771 case names of
772 [] => ()
773 | _ => (write "\tRequire user";
774 app (fn name => (write " "; write name)) names;
775 write "\n"))
776
777val () = Env.action_one "requireGroup"
778 ("groups", Env.list Env.string)
779 (fn names =>
780 case names of
781 [] => ()
782 | _ => (write "\tRequire group";
783 app (fn name => (write " "; write name)) names;
784 write "\n"))
785
786val () = Env.action_none "orderAllowDeny"
787 (fn () => write "\tOrder allow,deny\n")
788
789val () = Env.action_none "orderDenyAllow"
790 (fn () => write "\tOrder deny,allow\n")
791
792val () = Env.action_none "allowFromAll"
793 (fn () => write "\tAllow from all\n")
794
795val () = Env.action_one "allowFrom"
796 ("entries", Env.list Env.string)
797 (fn names =>
798 case names of
799 [] => ()
800 | _ => (write "\tAllow from";
801 app (fn name => (write " "; write name)) names;
802 write "\n"))
803
804val () = Env.action_none "denyFromAll"
805 (fn () => write "\tDeny from all\n")
806
807val () = Env.action_one "denyFrom"
808 ("entries", Env.list Env.string)
809 (fn names =>
810 case names of
811 [] => ()
812 | _ => (write "\tDeny from";
813 app (fn name => (write " "; write name)) names;
814 write "\n"))
815
816val () = Env.action_none "satisfyAll"
817 (fn () => write "\tSatisfy all\n")
818
819val () = Env.action_none "satisfyAny"
820 (fn () => write "\tSatisfy any\n")
821
7f012ffd
AC		 822val () = Env.action_one "forceType"
823 ("type", Env.string)
824 (fn ty => (write "\tForceType ";
825 write ty;
826 write "\n"))
827
828val () = Env.action_none "forceTypeOff"
829 (fn () => write "\tForceType None\n")
830
831val () = Env.action_two "action"
832 ("what", Env.string, "how", Env.string)
833 (fn (what, how) => (write "\tAction ";
834 write what;
835 write " ";
836 write how;
837 write "\n"))
838
839val () = Env.action_one "addDefaultCharset"
840 ("charset", Env.string)
841 (fn ty => (write "\tAddDefaultCharset ";
842 write ty;
843 write "\n"))
844
64e85bae 845(*val () = Env.action_one "davSvn"
c8505e59
AC		 846 ("path", Env.string)
847 (fn path => (write "\tDAV svn\n\tSVNPath ";
848 write path;
849 write "\n"))
850
851val () = Env.action_one "authzSvnAccessFile"
852 ("path", Env.string)
853 (fn path => (write "\tAuthzSVNAccessFile ";
854 write path;
64e85bae 855 write "\n"))*)
c8505e59 856
0aed4302
AC		 857val () = Env.action_none "davFilesystem"
858 (fn path => write "\tDAV filesystem\n")
859
9d7fa346
AC		 860val () = Env.action_two "addDescription"
861 ("description", Env.string, "patterns", Env.list Env.string)
862 (fn (desc, pats) =>
863 case pats of
864 [] => ()
865 | _ => (write "\tAddDescription \"";
866 write (String.toString desc);
867 write "\"";
868 app (fn pat => (write " "; write pat)) pats;
869 write "\n"))
870
871val () = Env.action_one "indexOptions"
872 ("options", Env.list autoindex_option)
873 (fn opts =>
874 case opts of
875 [] => ()
876 | _ => (write "\tIndexOptions";
877 app (fn (opt, arg) =>
878 (write " ";
879 write opt;
880 Option.app (fn arg =>
881 (write "="; write arg)) arg)) opts;
882 write "\n"))
883
884val () = Env.action_one "set_indexOptions"
885 ("options", Env.list autoindex_option)
886 (fn opts =>
887 case opts of
888 [] => ()
889 | _ => (write "\tIndexOptions";
890 app (fn (opt, arg) =>
891 (write " +";
892 write opt;
893 Option.app (fn arg =>
894 (write "="; write arg)) arg)) opts;
895 write "\n"))
896
897val () = Env.action_one "unset_indexOptions"
898 ("options", Env.list autoindex_option)
899 (fn opts =>
900 case opts of
901 [] => ()
902 | _ => (write "\tIndexOptions";
903 app (fn (opt, _) =>
904 (write " -";
905 write opt)) opts;
906 write "\n"))
907
908val () = Env.action_one "headerName"
909 ("name", Env.string)
910 (fn name => (write "\tHeaderName ";
911 write name;
912 write "\n"))
913
914val () = Env.action_one "readmeName"
915 ("name", Env.string)
916 (fn name => (write "\tReadmeName ";
917 write name;
918 write "\n"))
919
eda33894
AC		 920val () = Env.action_two "setEnv"
921 ("key", Env.string, "value", Env.string)
922 (fn (key, value) => (write "\tSetEnv \"";
923 write key;
924 write "\" \"";
ca6ffb3f
AC		 925 write (String.translate (fn #"\"" => "\\\""
926 | ch => str ch) value);
eda33894
AC		 927 write "\"\n"))
928
71420f8b
AC		 929val () = Domain.registerResetLocal (fn () =>
930 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
931
41c58daf
AC		 932val () = Domain.registerDescriber (Domain.considerAll
933 [Domain.Extension {extension = "vhost",
d300166d 934 heading = fn host => "Web vhost " ^ host},
41c58daf 935 Domain.Extension {extension = "vhost_ssl",
d300166d 936 heading = fn host => "SSL web vhost " ^ host}])
41c58daf 937
8a7c40fa 938end
Unnamed repository; edit this file to name it for gitweb.