--- /dev/null
+{{The most common kinds of domain configuration}}
+
+val web_ip : (ip) = "1.2.3.4";
+
+val dom =
+ \ d : (your_domain) ->
+ \\ config : Domain ->
+ domain d with
+ dns (dnsNS "ns.hcoop.net");
+ dns (dnsNS "ns2.hcoop.net");
+
+ dns (dnsA "www" web_ip);
+
+ handleMail;
+ mailbox <- Mailbox;
+ catchAllAlias mailbox;
+
+ vhost "www" with
+ end;
+
+ config
+ end;
* action are abandoned *)
| EWith of exp * exp
(* Apply a TNested to an action *)
+ | EALam of string * pred * exp
+ (* Abstraction for building TNested values *)
withtype exp = exp' * position
datatype decl' =
val items = map (fn file =>
let
val file' = modify file
+ val (desc, _, _) = Parse.parse file
in
LI {ty = NONE,
value = NONE,
- content = TextBlock (A {name = NONE,
- href = SOME (file' ^ ".html"),
- rel = NONE,
- rev = NONE,
- title = NONE,
- content = PCDATA (uppercase file')})}
+ content = BlockList
+ [TextBlock (A {name = NONE,
+ href = SOME (file' ^ ".html"),
+ rel = NONE,
+ rev = NONE,
+ title = NONE,
+ content = PCDATA (uppercase file')}),
+ TextBlock (PCDATA (Option.getOpt (desc, "")))]}
end) infiles
val index = HTML {version = NONE,
(EString Config.defaultNode, dl)),
dl)
+val _ = Defaults.registerDefault ("Mailbox",
+ (TBase "email", dl),
+ (fn () => (EString (getUser ()), dl)))
+
val _ = Defaults.registerDefault ("DNS",
(TBase "dnsKind", dl),
(fn () => multiApp ((EVar "useDns", dl),
| ARROW | DARROW | LARROW
| COLON | CARET | BANG | AND
| LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
- | EQ | COMMA | BSLASH | SEMI | LET | IN | END
+ | EQ | COMMA | BSLASH | BSLASHBSLASH | SEMI | LET | IN | END
| ROOT
| EXTERN | TYPE | VAL | WITH | WHERE | CONTEXT
| BSLASH SYMBOL COLON LPAREN typ RPAREN ARROW exp (ELam (SYMBOL, SOME typ, exp),
(BSLASHleft, expright))
| BSLASH SYMBOL ARROW exp (ELam (SYMBOL, NONE, exp), (BSLASHleft, expright))
+ | BSLASHBSLASH SYMBOL COLON ctxt ARROW exp (EALam (SYMBOL, ctxt, exp),
+ (BSLASHBSLASHleft, expright))
| CSYMBOL EQ exp (ESet (CSYMBOL, exp), (CSYMBOLleft, expright))
| exp SEMI exp (let
val ls = case #1 exp2 of
<INITIAL> "=" => (Tokens.EQ (yypos, yypos + size yytext));
<INITIAL> "," => (Tokens.COMMA (yypos, yypos + size yytext));
+<INITIAL> "\\\\" => (Tokens.BSLASHBSLASH (yypos, yypos + size yytext));
<INITIAL> "\\" => (Tokens.BSLASH (yypos, yypos + size yytext));
<INITIAL> ":" => (Tokens.COLON (yypos, yypos + size yytext));
<INITIAL> ";" => (Tokens.SEMI (yypos, yypos + size yytext));
punct ":", space 1,
dBox [punct "(", p_typ t, punct ")"],
space 1, punct "->", space 1, p_exp e, punct ")"]
+ | EALam (x, p, e) => dBox [punct "(\\", space 1, exp x, space 1,
+ punct ":", space 1, p_pred p,
+ space 1, punct "->", space 1, p_exp e, punct ")"]
| EVar x => exp x
| EApp (e1, e2) => dBox [punct "(", p_exp e1, break {nsp = 1, offset = 0}, p_exp e2, punct ")"]
fun check fname =
let
+ val uid = Posix.ProcEnv.getuid ()
+ val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
+
+ val () = Acl.read Config.aclFile
+ val () = Domain.setUser user
+
val _ = ErrorMsg.reset ()
val _ = Env.preTycheck ()
fun request fname =
let
+ val _ = check fname
+
val uid = Posix.ProcEnv.getuid ()
val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
- val () = Acl.read Config.aclFile
- val () = Domain.setUser user
- val _ = check fname
-
val context = OpenSSL.context (Config.certDir ^ "/" ^ user ^ ".pem",
Config.keyDir ^ "/" ^ user ^ ".pem",
Config.trustStore)
val dt = (TError, ErrorMsg.dummyLoc)
-fun expNeeded G (e, _) =
+fun expNeeded G (e, loc) =
case e of
EInt _ => ((SS.empty,
if Env.lookupType G "int" then
| SOME t => unionCTE ((typNeeded G t, SS.empty),
expNeeded G' e)
end
+ | EALam (x, p, e) =>
+ let
+ val G' = Env.bindVal G (x, (TAction (p, StringMap.empty, StringMap.empty), loc), NONE)
+ in
+ unionCTE (((predNeeded G p, SS.empty), SS.empty),
+ expNeeded G' e)
+ end
| EVar x =>
(case Env.lookupVal G x of
NONE => ((SS.empty, SS.empty), SS.singleton x)
string ":", space 1,
dBox [string "(", p_typ t, string ")"],
space 1, string "->", space 1, p_exp e, string ")"]
+ | EALam (x, c, e) => dBox [string "(\\\\", space 1, string x, space 1,
+ string ":", space 1, p_pred c,
+ space 1, string "->", space 1, p_exp e, string ")"]
| EVar x => string x
| EApp (e1, e2) => dBox [string "(", p_exp e1, break {nsp = 1, offset = 0}, p_exp e2, string ")"]
open Ast Print Env
+structure SM = StringMap
+
fun freeIn x (b, _) =
case b of
EInt _ => false
| ESeq es => List.exists (freeIn x) es
| ELocal (e1, e2) => freeIn x e1 orelse freeIn x e2
| EWith (e1, e2) => freeIn x e1 orelse freeIn x e2
+ | EALam (x', _, b') => x <> x' andalso freeIn x b'
local
val freshCount = ref 0
| ESeq es => (ESeq (map (subst x e) es), loc)
| ELocal (b1, b2) => (ELocal (subst x e b1, subst x e b2), loc)
| EWith (b1, b2) => (EWith (subst x e b1, subst x e b2), loc)
+ | EALam (x', p, b') =>
+ if x = x' then
+ bAll
+ else if freeIn x' e then
+ let
+ val x'' = freshVar ()
+ in
+ (EALam (x'', p, subst x e (subst x' (EVar x'', loc) b')), loc)
+ end
+ else
+ (EALam (x', p, subst x e b'), loc)
fun reduceExp G (eAll as (e, loc)) =
case e of
| EGet (x, v, b) => (EGet (x, v, reduceExp G b), loc)
| ESeq es => (ESeq (map (reduceExp G) es), loc)
| ELocal (e1, e2) => (ELocal (reduceExp G e1, reduceExp G e2), loc)
- | EWith (e1, e2) => (EWith (reduceExp G e1, reduceExp G e2), loc)
+ | EWith (e1, e2) =>
+ let
+ val e1' = reduceExp G e1
+ val e2' = reduceExp G e2
+ in
+ case e1' of
+ (EALam (x, _, b), _) => reduceExp G (subst x e2' b)
+ | _ => (EWith (e1', e2'), loc)
+ end
+ | EALam (x, p, e) =>
+ let
+ val G' = bindVal G (x, (TAction (p, SM.empty, SM.empty), loc), NONE)
+ in
+ (EALam (x, p, reduceExp G' e), loc)
+ end
end
(TError, loc))
end
+ | EALam (x, p, e) =>
+ let
+ val p' = checkPred G p
+
+ val G' = bindVal G (x, (TAction (p, SM.empty, SM.empty), loc), NONE)
+ val t' = checkExp G' e
+ in
+ case t' of
+ (TAction _, _) => (TNested (p, t'), loc)
+ | _ => (dte (WrongForm ("Body of nested configuration 'fn'",
+ "action",
+ e,
+ t',
+ NONE));
+ (TError, loc))
+ end
+
| ESet (evar, e) =>
let
val t = checkExp G e
--- /dev/null
+domain "hcoop.net" with
+ dns (dnsNS "ns.hcoop.net");
+
+ dns (dnsA "a" "1.2.3.4");
+ dns (dnsCNAME "b" "a.hcoop.net");
+ dns (dnsMX 1 "mail.nowhere.eu");
+
+ handleMail;
+
+ emailAlias "someone" "someoneElse";
+ aliasMulti "me" ["nowhere","smelly@yikes.com"];
+
+ catchAllAlias "me@gmail.com";
+
+ mailmanWebHost "lists.hcoop.net";
+
+ dns (dnsA "www" web_ip);
+ vhost "www" where
+ DocumentRoot = "/home/adamc/html";
+ ServerAdmin = "my@other.address"
+ with
+ serverAlias "hcoop.net";
+ addDefaultCharset "mumbo-jumbo/incomprehensible";
+
+ location "/theMorgue" with
+ rewriteRule "A" "B" [];
+ end;
+ end;
+end;
+
+domain "schizomaniac.net" where
+ TTL = 1234
+with
+ vhost "www" with
+ directory "/home/adamc/thisPlace" with
+ unset_options [includesNOEXEC];
+ indexOptions [iconsAreLinks, scanHtmlTitles, iconWidth 45];
+ end
+ end;
+
+ vhost "proxy" with
+ proxyPass "/proxyLand" "http://localhost:1234/otherProxyLand";
+ proxyPassReverse "/proxyLand" "http://localhost:1234/otherProxyLand";
+ end;
+end;
--- /dev/null
+dom "hcoop.net" with
+end;