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