(autoload (quote domtool-mode) "domtool-mode/domtool-mode" "\
Major Mode for editing Domtool files." t nil)
-(add-to-list (quote auto-mode-alist) (quote ("\\.\\(com\\|net\\|org\\|edu\\|mil\\|biz\\|info\\|name\\|be\\|ca\\|cc\\|de\\|fr\\|in\\|mu\\|se\\|uk\\|us\\|ws\\)$" . domtool-mode)))
+(add-to-list (quote auto-mode-alist) (quote ("\\.\\(dtl\\|com\\|net\\|org\\|edu\\|mil\\|biz\\|info\\|name\\|be\\|ca\\|cc\\|de\\|fr\\|in\\|mu\\|se\\|uk\\|us\\|ws\\)$" . domtool-mode)))
(* Do-nothing action *)
| ESet of string * exp
(* Set an environment variable *)
- | EGet of string * string * exp
+ | EGet of string * typ option * string * exp
(* Get an environment variable *)
| ESeq of exp list
(* Monad sequencer; execute a number of commands in order *)
(ESeq ls, (exp1left, exp2right))
end)
| exp SEMI (exp)
- | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, CSYMBOL, exp), (SYMBOLleft, expright))
+ | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, NONE, CSYMBOL, exp), (SYMBOLleft, expright))
+ | SYMBOL COLON typ LARROW CSYMBOL SEMI exp (EGet (SYMBOL, SOME typ, CSYMBOL, exp), (SYMBOLleft, expright))
apps : term (term)
| apps term (EApp (apps, term), (appsleft, termright))
case e of
ESkip => SM.empty
| ESet (ev, e) => SM.insert (SM.empty, ev, e)
- | EGet (x, ev, e) => exec' evs (Reduce.subst x (lookup (evs, ev)) e)
+ | EGet (x, _, ev, e) => exec' evs (Reduce.subst x (lookup (evs, ev)) e)
| ESeq es =>
let
val (new, _) =
| ESkip => empty
| ESet (_, e) => expNeeded G e
- | EGet (x, _, e) => expNeeded (Env.bindVal G (x, dt, NONE)) e
+ | EGet (x, topt, _, e) =>
+ (case topt of
+ NONE => expNeeded (Env.bindVal G (x, dt, NONE)) e
+ | SOME t => unionCTE ((typNeeded G t, SS.empty),
+ expNeeded (Env.bindVal G (x, dt, NONE)) e))
| ESeq es => foldl (fn (e, ss) => unionCTE (ss, expNeeded G e))
empty es
| ELocal (e1, e2) => unionCTE (expNeeded G e1, expNeeded G e2)
val logDir : {user : string, node : string, vhostId : string} -> string
(* Where is a vhost's log directory located? *)
+
+ val defaults : (string * Ast.typ * (unit -> Ast.exp)) list
+ (* Default environment variables *)
end
val dl = ErrorMsg.dummyLoc
-val _ = Defaults.registerDefault ("WebNodes",
- (TList (TBase "web_node", dl), dl),
- (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
-
-val _ = Defaults.registerDefault ("SSL",
- (TBase "ssl", dl),
- (fn () => (EVar "no_ssl", dl)))
-
-val _ = Defaults.registerDefault ("User",
- (TBase "your_user", dl),
- (fn () => (EString (Domain.getUser ()), dl)))
-
-val _ = Defaults.registerDefault ("Group",
- (TBase "your_group", dl),
- (fn () => (EString "nogroup", dl)))
-
-val _ = Defaults.registerDefault ("DocumentRoot",
- (TBase "your_path", dl),
- (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
-
-val _ = Defaults.registerDefault ("ServerAdmin",
- (TBase "email", dl),
- (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
-
-val _ = Defaults.registerDefault ("SuExec",
- (TBase "suexec_flag", dl),
- (fn () => (EVar "true", dl)))
+val defaults = [("WebNodes",
+ (TList (TBase "web_node", dl), dl),
+ (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))),
+ ("SSL",
+ (TBase "ssl", dl),
+ (fn () => (EVar "no_ssl", dl))),
+ ("User",
+ (TBase "your_user", dl),
+ (fn () => (EString (Domain.getUser ()), dl))),
+ ("Group",
+ (TBase "your_group", dl),
+ (fn () => (EString "nogroup", dl))),
+ ("DocumentRoot",
+ (TBase "your_path", dl),
+ (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
+ ("ServerAdmin",
+ (TBase "email", dl),
+ (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
+ ("SuExec",
+ (TBase "suexec_flag", dl),
+ (fn () => (EVar "true", dl)))]
+
+val () = app Defaults.registerDefault defaults
val redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *)
+
+(* Derived directives of general use *)
+
+signature EASY_DOMAIN = sig
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2007, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *)
+
+(* Derived directives of general use *)
+
+structure EasyDomain :> EASY_DOMAIN = struct
+
+open Ast
+
+val dl = ErrorMsg.dummyLoc
+
+val _ = Defaults.registerDefault ("WWW",
+ (TAction ((CConst "Vhost", dl),
+ foldl (fn ((v, t, _), r) =>
+ StringMap.insert (r, v, t))
+ StringMap.empty Apache.defaults,
+ StringMap.empty), dl),
+ (fn () => (ESkip, dl)))
+
+end
| ESkip => keyword "_"
| ESet (x, e) => parenIf pn [exp x, space 1, punct "=", space 1, p_exp e]
- | EGet (x1, x2, e) => parenIf pn [dBox [exp x1, space 1, punct "<-",
- space 1, exp x2, punct ";", space 1],
- p_exp e]
+ | EGet (x1, NONE, x2, e) => parenIf pn [dBox [exp x1, space 1, punct "<-",
+ space 1, exp x2, punct ";", space 1],
+ p_exp e]
+ | EGet (x1, SOME t, x2, e) => parenIf pn [dBox [exp x1, space 1, punct ":", space 1, p_typ t,
+ space 1, punct "<-",
+ space 1, exp x2, punct ";", space 1],
+ p_exp e]
| ESeq es => parenIf pn (valOf (foldr (fn (e, NONE) => SOME [p_exp e]
| (e, SOME ds) => SOME (dBox [p_exp e, punct ";", newline] :: ds))
NONE es))
| ESkip => false
| ESet (_, e) => freeIn x e
- | EGet (x', _, b') => x <> x' andalso freeIn x b'
+ | EGet (x', _, _, b') => x <> x' andalso 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
| ESkip => bAll
| ESet (v, b) => (ESet (v, subst x e b), loc)
- | EGet (x', v, b') =>
+ | EGet (x', topt, v, b') =>
if x = x' then
bAll
else if freeIn x' e then
let
val x'' = freshVar ()
in
- (EGet (x'', v, subst x e (subst x' (EVar x'', loc) b')), loc)
+ (EGet (x'', topt, v, subst x e (subst x' (EVar x'', loc) b')), loc)
end
else
- (EGet (x', v, subst x e b'), loc)
+ (EGet (x', topt, v, subst x e 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)
| ESkip => eAll
| ESet (v, b) => (ESet (v, reduceExp G b), loc)
- | EGet (x, v, b) => (EGet (x, v, reduceExp G b), loc)
+ | EGet (x, topt, v, b) => (EGet (x, topt, 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) =>
plugins/firewall.sig
plugins/firewall.sml
+plugins/easy_domain.sig
+plugins/easy_domain.sml
+
mail/vmail.sig
mail/vmail.sml
SOME e
else
NONE
- | EGet (_, _, e) => envVarSetFrom v e
+ | EGet (_, _, _, e) => envVarSetFrom v e
| ESeq es => foldr (fn (e, found) =>
case found of
SOME _ => found
| _ => NONE
+fun ununify (tAll as (t, _)) =
+ case t of
+ TUnif (_, ref (SOME t)) => ununify t
+ | _ => tAll
+
fun checkExp G (eAll as (e, loc)) =
let
val dte = Describe.describe_type_error loc
SM.insert (SM.empty, evar, t)),
loc)
end
- | EGet (x, evar, rest) =>
+ | EGet (x, topt, evar, rest) =>
let
val xt = (newUnif (), loc)
val G' = bindVal G (x, xt, NONE)
val rt = whnorm (checkExp G' rest)
in
- case rt of
+ case topt of
+ NONE => ()
+ | SOME t => subTyp (xt, checkTyp G t);
+
+ case ununify rt of
(TAction (p, d, r), _) =>
(case SM.find (d, evar) of
NONE => (TAction (p, SM.insert (d, evar, xt), r), loc)