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