Changes before announcement to hcoop-discuss

diff --git a/lib/easy_domain.dtl b/lib/easy_domain.dtl
new file mode 100644 (file)
index 0000000..9a1ace5
--- /dev/null
+++ b/lib/easy_domain.dtl
@@ -0,0 +1,22 @@
+{{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;

diff --git a/src/ast.sml b/src/ast.sml
index 667a26c..7a9fe25 100644 (file)
--- a/src/ast.sml
+++ b/src/ast.sml
@@ -89,6 +89,8 @@ datatype exp' =
        * 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' =

diff --git a/src/autodoc.sml b/src/autodoc.sml
index 87134e4..b342e6e 100644 (file)
--- a/src/autodoc.sml
+++ b/src/autodoc.sml
@@ -144,15 +144,18 @@ fun autodoc {outdir, infiles} =
        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,

diff --git a/src/domain.sml b/src/domain.sml
index 38993a2..34d6d10 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -172,6 +172,10 @@ val masterD = (EApp ((EVar "internalMaster", dl),
                     (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),

diff --git a/src/domtool.grm b/src/domtool.grm
index 549a183..ca9ff3a 100644 (file)
--- a/src/domtool.grm
+++ b/src/domtool.grm
@@ -31,7 +31,7 @@ open Ast
  | 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
 
@@ -114,6 +114,8 @@ exp    : apps                              (apps)
        | 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

diff --git a/src/domtool.lex b/src/domtool.lex
index cafd14e..80c06c7 100644 (file)
--- a/src/domtool.lex
+++ b/src/domtool.lex
@@ -115,6 +115,7 @@ lineComment = #[^\n]*\n;
 
 <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));

diff --git a/src/htmlPrint.sml b/src/htmlPrint.sml
index 5b756c3..2018556 100644 (file)
--- a/src/htmlPrint.sml
+++ b/src/htmlPrint.sml
@@ -139,6 +139,9 @@ fun p_exp (e, _) =
                                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 ")"]

diff --git a/src/main.sml b/src/main.sml
index 87a1b73..461207a 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -63,6 +63,12 @@ fun basis () =
 
 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 ()
 
@@ -133,13 +139,11 @@ fun hostname () =
 
 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)

diff --git a/src/order.sml b/src/order.sml
index cf1dee1..0d0d363 100644 (file)
--- a/src/order.sml
+++ b/src/order.sml
@@ -70,7 +70,7 @@ fun unionCTE (((c1, t1), v1), ((c2, t2), v2)) =
     
 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
@@ -96,6 +96,13 @@ fun expNeeded G (e, _) =
              | 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)

diff --git a/src/print.sml b/src/print.sml
index 76d3fd1..7e38bb5 100644 (file)
--- a/src/print.sml
+++ b/src/print.sml
@@ -99,6 +99,9 @@ fun p_exp (e, _) =
                                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 ")"]

diff --git a/src/reduce.sml b/src/reduce.sml
index 5913873..37c2a35 100644 (file)
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -22,6 +22,8 @@ structure Reduce :> REDUCE = struct
 
 open Ast Print Env
 
+structure SM = StringMap
+
 fun freeIn x (b, _) =
     case b of
        EInt _ => false
@@ -38,6 +40,7 @@ fun freeIn x (b, _) =
       | 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
@@ -91,6 +94,17 @@ fun subst x e (bAll as (b, loc)) =
       | 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
@@ -127,6 +141,20 @@ fun reduceExp G (eAll as (e, loc)) =
       | 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

diff --git a/src/tycheck.sml b/src/tycheck.sml
index 152eaf7..f1c90dc 100644 (file)
--- a/src/tycheck.sml
+++ b/src/tycheck.sml
@@ -426,6 +426,23 @@ fun checkExp G (eAll as (e, loc)) =
                        (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

diff --git a/tests/testBusy.dtl b/tests/testBusy.dtl
new file mode 100644 (file)
index 0000000..7c2216a
--- /dev/null
+++ b/tests/testBusy.dtl
@@ -0,0 +1,45 @@
+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;

diff --git a/tests/testEasy.dtl b/tests/testEasy.dtl
new file mode 100644 (file)
index 0000000..6c63fb3
--- /dev/null
+++ b/tests/testEasy.dtl
@@ -0,0 +1,2 @@
+dom "hcoop.net" with
+end;