val webNodes_all = [("navajos", {version = APACHE_2, auth = MOD_WAKLOG})]
val webNodes_admin = [("deleuze", {version = APACHE_2, auth = MOD_WAKLOG})]
-val webNodes_default = ["navajos"]
-
val proxyTargets = ["http://hcoop.net/cgi-bin/mailman",
"http://hcoop.net/pipermail"]
val webNodes_all : (string * ConfigTypes.apache_info) list
val webNodes_admin : (string * ConfigTypes.apache_info) list
- val webNodes_default : string list
val proxyTargets : string list
(* Specifically exempted URIs for proxying *)
val domtool_publish = ConfigCore.installPrefix ^ "/sbin/domtool-publish"
-val defaultNs = "ns1.hcoop.net"
-
-val defaultRefresh = 86400
-val defaultRetry = 1800
-val defaultExpiry = 1209600
-val defaultMinimum = 3600
-
val nodeIps = [("deleuze", "69.90.123.67"), ("hopper", "69.90.123.74"), ("fritz", "69.90.123.75"), ("navajos", "69.90.123.70"), ("bog", "69.90.123.72"), ("outpost", "151.236.216.192")]
val dispatcherName = "fritz"
val domtool_publish : string
-(* DNS SOA parameter defaults *)
-val defaultNs : string
-val defaultRefresh : int
-val defaultRetry : int
-val defaultExpiry : int
-val defaultMinimum : int
-
(* Names of machines who will receive configuration *)
val nodeIps : (string * string) list
val dispatcherName : string
val reload = ConfigCore.sudo ^ " " ^ ConfigCore.installPrefix ^ "/sbin/domtool-publish exim"
-val aliasTo = ["deleuze"]
-
val mainLog = "/var/log/exim4/mainlog"
end
val relayDomains : string
(* File to which to write a comma-separate list of domains to relay mail for *)
-val aliasTo : string list
-(* Default nodes to which alias directives are applied *)
-
val mainLog : string
(* Path to main log file *)
--- /dev/null
+extern val you : your_user;
+extern val defaultMailbox : email;
+extern val defaultServerAdmin : email;
+
+var SSL : ssl = no_ssl;
+
+var User : your_user = you;
+
+var Group : your_group = "nogroup";
+
+var DocumentRoot : your_path = (home "public_html");
+var SuExec : suexec_flag = true;
+var PhpVersion : php_version = php5;
+
+var Mailbox : email = defaultMailbox;
+var ServerAdmin : email = defaultServerAdmin;
+
+var Aliases : [your_domain] = [];
+
+val defaultTTL : int = 3600;
+val defaultNs : domain = "ns1.hcoop.net";
+val defaultRefresh : int = 86400;
+val defaultRetry : int = 1800;
+val defaultExpiry : int = 1209600;
+val defaultMinimum : int = 3600;
+
+val dnsMasterNode : master = (internalMaster dns_master_node);
+val dnsSlaveNodes : [dns_node] = dns_slave_nodes;
+
+var DNS : dnsKind = useDns (soa defaultNs serialAuto defaultRefresh defaultRetry defaultExpiry defaultMinimum) dnsMasterNode dnsSlaveNodes;
+var TTL : int = defaultTTL;
+
+var WWW : [Vhost] = Skip;
+var CreateWWW : bool = true;
+var DefaultA : bool = true;
+var DefaultAlias : bool = true;
+var DefaultAliasSource : aliasSource = defaultSource;
+var HandleMail : bool = true;
+var AddMX : bool = true;
+
+var MailNodes : [mail_node] = ["deleuze"];
+
+var MailManPlaces : [mailman_place] = [mailman_place_default mailman_node];
+
+var DefaultWebNode : web_node = web_node;
\ No newline at end of file
{{A server not controlled by domtool will serve as master.}}
extern val internalMaster : dns_node -> master;
{{A server controlled by domtool will serve as master.}}
+extern val dns_master_node : dns_node;
+{{Internal master DNS node}}
+extern val dns_slave_nodes : [dns_node];
+{{Internal slave DNS nodes}}
extern type dnsKind;
{{How should DNS for this domain be handled?}}
DExternType of string
| DExternVal of string * typ
| DVal of string * typ option * exp
+ | DEnv of string * typ option * exp
| DContext of string
type decl = decl' * string option * position
if !ErrorMsg.anyErrors then
G
else
- Tycheck.checkFile G (Defaults.tInit prog) prog
+ Tycheck.checkFile G prog
end
fun autodoc {outdir, infiles} =
(case isAction evs t of
SOME evs => (types, contexts, s :: actions, vals, evs)
| NONE => (types, contexts, actions, s :: vals, evs))
+ | DEnv (s, _, _) =>
+ (types, contexts, actions, vals, StringSet.add (evs, s))
| DContext s => (types, s :: contexts, actions, vals, evs))
acc decls
end
+++ /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.
- *)
-
-(* Default record field database *)
-
-signature DEFAULTS = sig
- val registerDefault : string * Ast.typ * (unit -> Ast.exp) -> unit
-
- val tInit : Ast.file -> Ast.typ
- val eInit : unit -> Env.env_vars
-end
+++ /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.
- *)
-
-(* Default record field database *)
-
-structure Defaults :> DEFAULTS = struct
-
-open Ast Print
-
-structure SM = StringMap
-
-val dmy = ErrorMsg.dummyLoc
-
-val defaultT : record ref = ref SM.empty
-val defaultV : (unit -> exp) SM.map ref = ref SM.empty
-
-fun registerDefault (name, t, v) =
- case SM.find (!defaultT, name) of
- NONE => (defaultT := SM.insert (!defaultT, name, t);
- defaultV := SM.insert (!defaultV, name, v))
- | SOME _ => raise Fail "Duplicate default environment variable"
-
-fun allSets (e, _) =
- case e of
- ESkip => true
- | ESet _ => true
- | ESeq es => List.all allSets es
- | _ => false
-
-val dmy = ErrorMsg.dummyLoc
-
-fun bodyType (_, _, SOME e) =
- if allSets e then
- (CPrefix (CRoot, dmy), dmy)
- else
- (CRoot, dmy)
- | bodyType _ = (CRoot, dmy)
-
-fun tInit p =
- (TAction (bodyType p,
- !defaultT,
- StringMap.empty),
- dmy)
-
-fun eInit () = SM.map (fn f => f ()) (!defaultV)
-
-
-end
class = "domain"};
your_usrs := Acl.class {user = getUser (),
class = "user"};
- your_grps := Acl.class {user = getUser (),
- class = "group"};
+ your_grps := SS.add (Acl.class {user = getUser (),
+ class = "group"},
+ "nogroup");
your_pths := your_paths;
readable_pths := SS.union (your_paths, world_readable);
your_ipss := Acl.class {user = getUser (),
fun validNode s = List.exists (fn s' => s = s') nodes
fun yourDomain s = !fakePrivs orelse SS.member (your_domains (), s)
-fun yourUser s = SS.member (your_users (), s)
-fun yourGroup s = SS.member (your_groups (), s)
+fun yourUser s = !fakePrivs orelse SS.member (your_users (), s)
+fun yourGroup s = !fakePrivs orelse SS.member (your_groups (), s)
+
fun checkPath paths path =
+ !fakePrivs orelse
(List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
orelse ch = #"-" orelse ch = #"_") path
andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ()))
val yourPath = checkPath your_paths
val readablePath = checkPath readable_paths
+
fun yourIp s = !fakePrivs orelse SS.member (your_ips (), s)
fun yourDomainHost s =
| _ => NONE)
-val nsD = (EString Config.defaultNs, dl)
-val serialD = (EVar "serialAuto", dl)
-val refD = (EInt Config.defaultRefresh, dl)
-val retD = (EInt Config.defaultRetry, dl)
-val expD = (EInt Config.defaultExpiry, dl)
-val minD = (EInt Config.defaultMinimum, dl)
-
-val soaD = multiApp ((EVar "soa", dl),
- dl,
- [nsD, serialD, refD, retD, expD, minD])
-
-val masterD = (EApp ((EVar "internalMaster", dl),
- (EString Config.Bind.masterNode, dl)),
- dl)
+val _ = Env.registerFunction ("you",
+ fn [] => SOME (EString (getUser ()), dl)
+ | _ => NONE)
-val slavesD = (EList (map (fn s => (EString s, dl))
- (List.filter (fn x => List.exists (fn y => y = x) (Config.dnsNodes_all @ Config.dnsNodes_admin)) Config.Bind.slaveNodes)), dl)
-
-val _ = Defaults.registerDefault ("Aliases",
- (TList (TBase "your_domain", dl), dl),
- (fn () => (EList [], dl)))
-
-val _ = Defaults.registerDefault ("Mailbox",
- (TBase "email", dl),
- (fn () => (EString (getUser ()), dl)))
-
-val _ = Defaults.registerDefault ("DNS",
- (TBase "dnsKind", dl),
- (fn () => multiApp ((EVar "useDns", dl),
- dl,
- [soaD, masterD, slavesD])))
+val _ = Env.registerFunction ("defaultMailbox",
+ fn [] => SOME (EString (getUser ()), dl)
+ | _ => NONE)
-val _ = Defaults.registerDefault ("TTL",
- (TBase "int", dl),
- (fn () => (EInt Config.Bind.defaultTTL, dl)))
type soa = {ns : string,
serial : int option,
Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
fun homedir () = homedirOf (getUser ())
+ handle e => if !fakePrivs then "/tmp" else raise e
type subject = {node : string, domain : string}
| EQ | COMMA | BSLASH | BSLASHBSLASH | SEMI | LET | IN | BEGIN | END
| IF | THEN | ELSE
| ROOT | SKIP
- | EXTERN | TYPE | VAL | WITH | WHERE | CONTEXT
+ | EXTERN | TYPE | VAL | ENV | WITH | WHERE | CONTEXT
%nonterm
file of file
| EXTERN VAL SYMBOL COLON typ (DExternVal (SYMBOL, typ))
| VAL SYMBOL EQ exp (DVal (SYMBOL, NONE, exp))
| VAL SYMBOL COLON typ EQ exp (DVal (SYMBOL, SOME typ, exp))
+ | ENV CSYMBOL EQ exp (DEnv (CSYMBOL, NONE, exp))
+ | ENV CSYMBOL COLON typ EQ exp (DEnv (CSYMBOL, SOME typ, exp))
| CONTEXT CSYMBOL (DContext CSYMBOL)
docOpt : (NONE)
<INITIAL> "extern" => (Tokens.EXTERN (yypos, yypos + size yytext));
<INITIAL> "type" => (Tokens.TYPE (yypos, yypos + size yytext));
<INITIAL> "val" => (Tokens.VAL (yypos, yypos + size yytext));
+<INITIAL> "var" => (Tokens.ENV (yypos, yypos + size yytext));
<INITIAL> "context" => (Tokens.CONTEXT (yypos, yypos + size yytext));
<INITIAL> "Root" => (Tokens.ROOT (yypos, yypos + size yytext));
(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
type env
val empty : env
+ val initialDynEnvTypes : env -> Ast.typ Ast.StringMap.map
+ val initialDynEnvVals : env -> env_vars
+
val bindType : env -> string -> env
val bindVal : env -> string * Ast.typ * Ast.exp option -> env
val bindContext : env -> string -> env
+ val bindInitialDynEnvVal : env -> string * Ast.typ * Ast.exp -> env
val lookupType : env -> string -> bool
val lookupVal : env -> string -> Ast.typ option
val lookupEquation : env -> string -> Ast.exp option
val lookupContext : env -> string -> bool
+ val lookupInitialDynEnvVal : env -> string -> Ast.typ option
val types : env -> Ast.StringSet.set
val vals : env -> Ast.StringSet.set
val contexts : env -> Ast.StringSet.set
+ val dynamics : env -> Ast.StringSet.set
end
(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
fun containerV_none name (f, g) = registerContainer (name, noneV name f, g)
fun containerV_one name args (f, g) = registerContainer (name, oneV name args f, g)
-type env = SS.set * (typ * exp option) SM.map * SS.set
-val empty : env = (SS.empty, SM.empty, SS.empty)
+type env = SS.set * (typ * exp option) SM.map * SS.set * (typ * exp) SM.map
+val empty : env = (SS.empty, SM.empty, SS.empty, SM.empty)
-fun lookupType (ts, _, _) name = SS.member (ts, name)
-fun lookupVal (_, vs, _) name =
+
+fun initialDynEnvTypes (_, _, _, ds) =
+ SM.map (fn (t, e) => t) ds
+
+fun initialDynEnvVals (_, _, _, ds) =
+ SM.map (fn (t, v) => v) ds
+
+fun lookupType (ts, _, _, _) name = SS.member (ts, name)
+fun lookupVal (_, vs, _, _) name =
case SM.find (vs, name) of
NONE => NONE
| SOME (t, _) => SOME t
-fun lookupEquation (_, vs, _) name =
+fun lookupEquation (_, vs, _, _) name =
case SM.find (vs, name) of
NONE => NONE
| SOME (_, eqo) => eqo
-fun lookupContext (_, _, cs) name = SS.member (cs, name)
+fun lookupContext (_, _, cs, _) name = SS.member (cs, name)
+fun lookupInitialDynEnvVal (_, _, _, ds) name =
+ case SM.find (ds, name) of
+ NONE => NONE
+ | SOME (t, _) => SOME t
-fun bindType (ts, vs, cs) name = (SS.add (ts, name), vs, cs)
-fun bindVal (ts, vs, cs) (name, t, eqo) = (ts, SM.insert (vs, name, (t, eqo)), cs)
-fun bindContext (ts, vs, cs) name = (ts, vs, SS.add (cs, name))
+fun bindType (ts, vs, cs, ds) name = (SS.add (ts, name), vs, cs, ds)
+fun bindVal (ts, vs, cs, ds) (name, t, eqo) = (ts, SM.insert (vs, name, (t, eqo)), cs, ds)
+fun bindContext (ts, vs, cs, ds) name = (ts, vs, SS.add (cs, name), ds)
+fun bindInitialDynEnvVal (ts, vs, cs, ds) (name, t, eqn) = (ts, vs, cs, SM.insert (ds, name, (t, eqn)))
-fun types (ts, _, _) = ts
-fun vals (_, vs, _) = SM.foldli (fn (name, _, vs) => SS.add (vs, name)) SS.empty vs
-fun contexts (_, _, cs) = cs
+fun types (ts, _, _, _) = ts
+fun vals (_, vs, _, _) = SM.foldli (fn (name, _, vs) => SS.add (vs, name)) SS.empty vs
+fun contexts (_, _, cs, _) = cs
+fun dynamics (_, _, _, ds) = SM.foldli (fn (name, _, ds) => SS.add (ds, name)) SS.empty ds
end
files
in
Tycheck.allowExterns ();
+ Domain.declareClient ();
+ Domain.fakePrivileges ();
if emacs then
Autodoc.makeEmacsKeywords files
else
()
else
Option.app (Unused.check G) (#3 prog);
- Tycheck.checkFile G (Defaults.tInit prog) prog)
+ Tycheck.checkFile G prog)
end
fun basis () =
raise ErrorMsg.Error
else
let
- val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
+ val G' = Tycheck.checkFile G prog
in
if !ErrorMsg.anyErrors then
raise ErrorMsg.Error
ok := false)
else
();
- ignore (foldl checker' (basis (), Defaults.eInit ()) files)
+ let val basis' = basis () in
+ ignore (foldl checker' (basis', Env.initialDynEnvVals basis') files)
+ end
end
else if String.isSuffix "_admin" user then
()
end
in
doIt (fn () => (Env.pre ();
- ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
+ let val basis' = basis () in
+ ignore (foldl doOne (basis', Env.initialDynEnvVals basis') codes)
+ end;
Env.post ();
Msg.send (bio, MsgOk);
("Configuration complete.", NONE)))
(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
NONE => expNeeded G e
| SOME t => unionCTE ((typNeeded G t, SS.empty),
expNeeded G e))
+ | DEnv (name, to, e) => (Env.bindInitialDynEnvVal G (name, dt, (Ast.ESkip, ErrorMsg.dummyLoc)),
+ case to of
+ NONE => expNeeded G e
+ | SOME t => unionCTE ((typNeeded G t, SS.empty),
+ expNeeded G e))
| DContext name => (Env.bindContext G name, empty)
fun fileSig (_, ds, eo) =
val realLogDir : {user : string, node : string, vhostId : string} -> string
(* OK, where is it _really_ located? (Target of log syncing into AFS) *)
- val defaults : (string * Ast.typ * (unit -> Ast.exp)) list
- (* Default environment variables *)
-
val ssl : string option Env.arg
val webPlace : (string * string) Env.arg
Env.string
validExtension
-val defaults = [("WebPlaces",
- (TList (TBase "web_place", dl), dl),
- (fn () => (EList (map webPlaceDefault 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))),
- ("PhpVersion",
- (TBase "php_version", dl),
- (fn () => (EVar "php5", dl)))]
-
-val () = app Defaults.registerDefault defaults
+val _ = Env.registerFunction ("defaultServerAdmin",
+ fn [] => SOME (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)
+ | _ => NONE)
val redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
Env.string
validSrvDomain
+val _ = Env.registerFunction ("dns_master_node",
+ fn [] => SOME (EString Config.Bind.masterNode, dl)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("dns_slave_nodes",
+ fn [] => SOME (EList (map (fn n => (EString n, dl)) Config.Bind.slaveNodes), dl)
+ | _ => NONE)
+
end
+++ /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
- * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
- *
- * 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),
- StringMap.empty,
- StringMap.empty), dl),
- (fn () => (ESkip, dl)))
-
-val _ = Defaults.registerDefault ("CreateWWW",
- (TBase "bool", dl),
- (fn () => (EVar "true", dl)))
-
-val _ = Defaults.registerDefault ("DefaultA",
- (TBase "bool", dl),
- (fn () => (EVar "true", dl)))
-
-val _ = Defaults.registerDefault ("DefaultAlias",
- (TBase "bool", dl),
- (fn () => (EVar "true", dl)))
-
-val _ = Defaults.registerDefault ("DefaultAliasSource",
- (TBase "aliasSource", dl),
- (fn () => (EVar "defaultSource", dl)))
-
-val _ = Defaults.registerDefault ("HandleMail",
- (TBase "bool", dl),
- (fn () => (EVar "true", dl)))
-
-val _ = Defaults.registerDefault ("AddMX",
- (TBase "bool", dl),
- (fn () => (EVar "true", dl)))
-
-val _ = Defaults.registerDefault ("DefaultWebNode",
- (TBase "web_node", dl),
- (fn () => (EString "navajos", dl)))
-
-end
open Ast
-val dl = ErrorMsg.dummyLoc
-
-val _ = Defaults.registerDefault ("MailNodes",
- (TList (TBase "mail_node", dl), dl),
- (fn () => (EList (map (fn s => (EString s, dl)) Config.Exim.aliasTo), dl)))
-
val aliasesChanged = ref false
val aliasesDefaultChanged = ref false
val hostsChanged = ref false
SOME (node, ip)
| mailmanPlace _ = NONE
-fun mailmanPlaceDefault node = (EApp ((EVar "mailman_place_default", dl), (EString node, dl)), dl)
-
val _ = Env.registerFunction ("mailman_place_to_web_node",
fn [e] => Option.map (fn (node, _) => (EString node, dl)) (mailmanPlace e)
| _ => NONE)
fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (mailmanPlace e)
| _ => NONE)
-val () = Defaults.registerDefault
- ("MailmanPlaces",
- (TList (TBase "mailman_place", dl), dl),
- (fn () => (EList [mailmanPlaceDefault Config.Mailman.node], dl)))
-
val files = ref ([] : TextIO.outstream list)
val write = ref (fn _ : string => ())
ident name, space 1,
punct ":", space 1,
p_typ t])
+ | DEnv (name, NONE, _) => string "Unannotated env declaration!"
+ | DEnv (name, SOME t, _) => anchor ("D_" ^ name,
+ dBox [keyword "var", space 1,
+ ident name, space 1,
+ punct ":", space 1,
+ p_typ t])
| DContext name => anchor ("C_" ^ name,
dBox [keyword "context", space 1,
ident name])
space 1,
punct ":", space 1,
p_typ t]
+ | DEnv (name, NONE, _) => string "Unannotated var declaration!"
+ | DEnv (name, SOME t, _) => dBox [keyword "var", space 1,
+ link ("#D_" ^ name, ident name),
+ space 1,
+ punct ":", space 1,
+ p_typ t]
| DContext name => dBox [keyword "context", space 1,
link ("#C_" ^ name, ident name)]
slave.sig
slave.sml
-defaults.sig
-defaults.sml
-
pcre.sig
pcre.sml
plugins/firewall.sig
plugins/firewall.sml
-plugins/easy_domain.sig
-plugins/easy_domain.sml
-
mail/vmail.sig
mail/vmail.sml
(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
val checkDecl : Env.env -> Ast.decl -> Env.env
- val checkFile : Env.env -> Ast.typ -> Ast.file -> Env.env
+ val checkFile : Env.env -> Ast.file -> Env.env
val resetUnif : unit -> unit
val newUnif : unit -> Ast.typ'
(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2006-2007, Adam Chlipala
+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
SOME ue));
bindVal G (name, to, SOME e)
end
+ | DEnv (name, to, e) =>
+ let
+ val to =
+ case to of
+ NONE => (newUnif (), loc)
+ | SOME to => checkTyp G to
+
+ val t = checkExp G e
+ in
+ hasTyp (e, t, to)
+ handle Unify ue =>
+ Describe.describe_type_error loc
+ (WrongType ("Dynamically bound value",
+ e,
+ t,
+ to,
+ SOME ue));
+ bindInitialDynEnvVal G (name, to, e)
+ end
| DContext name => bindContext G name
fun printActionDiffs {have, need} =
| _ => false
-fun checkFile G tInit (_, ds, eo) =
+fun checkFile G (prog as (_, ds, eo)) =
let
val G' = foldl (fn (d, G) => checkDecl G d) G ds
+
+ fun tInitial prog env =
+ (* This should likely only take the dynamic env as an argument *)
+ let
+ fun allSets (e, _) =
+ case e of
+ ESkip => true
+ | ESet _ => true
+ | ESeq es => List.all allSets es
+ | _ => false
+
+ val dmy = ErrorMsg.dummyLoc
+
+ fun bodyType (_, _, SOME e) =
+ if allSets e then
+ (CPrefix (CRoot, dmy), dmy)
+ else
+ (CRoot, dmy)
+ | bodyType _ = (CRoot, dmy)
+ in
+ (TAction (bodyType prog,
+ Env.initialDynEnvTypes env,
+ StringMap.empty),
+ dmy)
+ end
+
in
case eo of
NONE => ()
| SOME (e as (_, loc)) =>
let
val t = checkExp G' e
+ val tInit = tInitial prog G'
in
hasTyp (e, t, tInit)
handle Unify _ =>
HCoop / hcoop / domtool2.git / commitdiff