HCoop
/
hcoop
/
domtool2.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove Config.{dispatcher,defaultNode}
[hcoop/domtool2.git]
/
src
/
domain.sml
diff --git
a/src/domain.sml
b/src/domain.sml
index
d1046b7
..
2b93535
100644
(file)
--- a/
src/domain.sml
+++ b/
src/domain.sml
@@
-27,6
+27,7
@@
structure SS = DataStructures.StringSet
val ssl_context = ref (NONE : OpenSSL.context option)
fun set_context ctx = ssl_context := SOME ctx
val ssl_context = ref (NONE : OpenSSL.context option)
fun set_context ctx = ssl_context := SOME ctx
+fun get_context () = valOf (!ssl_context)
val nodes = map #1 Config.nodeIps
val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
val nodes = map #1 Config.nodeIps
val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
@@
-35,6
+36,8
@@
fun nodeIp node = valOf (SM.find (nodeMap, node))
val usr = ref ""
fun getUser () = !usr
val usr = ref ""
fun getUser () = !usr
+val fakePrivs = ref false
+val isClient = ref false
val your_doms = ref SS.empty
fun your_domains () = !your_doms
val your_doms = ref SS.empty
fun your_domains () = !your_doms
@@
-62,6
+65,7
@@
fun setUser user =
val your_paths = Acl.class {user = getUser (),
class = "path"}
in
val your_paths = Acl.class {user = getUser (),
class = "path"}
in
+ fakePrivs := false;
your_doms := Acl.class {user = getUser (),
class = "domain"};
your_usrs := Acl.class {user = getUser (),
your_doms := Acl.class {user = getUser (),
class = "domain"};
your_usrs := Acl.class {user = getUser (),
@@
-74,6
+78,12
@@
fun setUser user =
class = "ip"}
end
class = "ip"}
end
+fun declareClient () = isClient := true
+fun fakePrivileges () = if !isClient then
+ fakePrivs := true
+ else
+ raise Fail "Tried to fake privileges as non-client"
+
fun validIp s =
case map Int.fromString (String.fields (fn ch => ch = #".") s) of
[SOME n1, SOME n2, SOME n3, SOME n4] =>
fun validIp s =
case map Int.fromString (String.fields (fn ch => ch = #".") s) of
[SOME n1, SOME n2, SOME n3, SOME n4] =>
@@
-122,20
+132,21
@@
fun validDomain s =
fun validNode s = List.exists (fn s' => s = s') nodes
fun validNode s = List.exists (fn s' => s = s') nodes
-fun yourDomain s = SS.member (your_domains (), s)
+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 checkPath paths path =
fun yourUser s = SS.member (your_users (), s)
fun yourGroup s = SS.member (your_groups (), s)
fun checkPath paths path =
- 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 (
))
+
(
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
val yourPath = checkPath your_paths
val readablePath = checkPath readable_paths
-fun yourIp s = SS.member (your_ips (), s)
+fun yourIp s =
!fakePrivs orelse
SS.member (your_ips (), s)
fun yourDomainHost s =
fun yourDomainHost s =
- yourDomain s
+ !fakePrivs
+ orelse yourDomain s
orelse let
val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
in
orelse let
val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
in
@@
-225,6
+236,10
@@
val _ = Env.type_one "node"
Env.string
validNode
Env.string
validNode
+val _ = Env.type_one "mime_type"
+ Env.string
+ (CharVector.exists (fn ch => ch = #"/"))
+
val _ = Env.registerFunction ("your_ip_to_ip",
fn [e] => SOME e
| _ => NONE)
val _ = Env.registerFunction ("your_ip_to_ip",
fn [e] => SOME e
| _ => NONE)
@@
-264,10
+279,11
@@
val soaD = multiApp ((EVar "soa", dl),
[nsD, serialD, refD, retD, expD, minD])
val masterD = (EApp ((EVar "internalMaster", dl),
[nsD, serialD, refD, retD, expD, minD])
val masterD = (EApp ((EVar "internalMaster", dl),
- (EString Config.masterNode, dl)),
+ (EString Config.
Bind.
masterNode, dl)),
dl)
dl)
-val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
+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),
val _ = Defaults.registerDefault ("Aliases",
(TList (TBase "your_domain", dl), dl),
@@
-599,7
+615,7
@@
val _ = Env.containerV_one "domain"
fun saveSoa (kind, soa : soa) node =
let
fun saveSoa (kind, soa : soa) node =
let
- val {write, writeDom, close} = domainsFile {node = node, name = "soa"}
+ val {write, writeDom, close} = domainsFile {node = node, name = "soa
.conf
"}
in
write kind;
write "\n";
in
write kind;
write "\n";
@@
-696,7
+712,7
@@
fun handleSite (site, files) =
in
print ("New configuration for node " ^ site ^ "\n");
in
print ("New configuration for node " ^ site ^ "\n");
- if site = Config.d
efaultNod
e then
+ if site = Config.d
ispatcherNam
e then
Slave.handleChanges files
else let
val bio = OpenSSL.connect true (valOf (!ssl_context),
Slave.handleChanges files
else let
val bio = OpenSSL.connect true (valOf (!ssl_context),
@@
-969,7
+985,7
@@
fun considerAll ds {node, domain} =
""
end
""
end
-val () = registerDescriber (considerAll [Filename {filename = "soa",
+val () = registerDescriber (considerAll [Filename {filename = "soa
.conf
",
heading = "DNS SOA:",
showEmpty = false}])
heading = "DNS SOA:",
showEmpty = false}])
@@
-979,4
+995,15
@@
val () = Env.registerAction ("domainHost",
(EString (host ^ "." ^ currentDomain ()), dl))
| (_, args) => Env.badArgs ("domainHost", args))
(EString (host ^ "." ^ currentDomain ()), dl))
| (_, args) => Env.badArgs ("domainHost", args))
+val ouc = ref (fn () => ())
+
+fun registerOnUsersChange f =
+ let
+ val f' = !ouc
+ in
+ ouc := (fn () => (f' (); f ()))
+ end
+
+fun onUsersChange () = !ouc ()
+
end
end