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_paths = Acl.class {user = getUser (),
class = "path"}
in
+ fakePrivs := false;
your_doms := Acl.class {user = getUser (),
class = "domain"};
your_usrs := Acl.class {user = getUser (),
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 validNode s = List.exists (fn s' => s = s') nodes
-fun yourDomain s = SS.member (your_domains (), s)
-fun yourUser s = SS.member (your_users (), s)
-fun yourGroup s = SS.member (your_groups (), s)
+fun yourDomain s = !fakePrivs orelse SS.member (your_domains (), 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 =
- 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 ())
+ !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 = SS.member (your_ips (), s)
+fun yourIp s = !fakePrivs orelse SS.member (your_ips (), s)
fun yourDomainHost s =
- yourDomain s
+ !fakePrivs
+ orelse yourDomain s
orelse let
val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
in
(* Driver for configuration requests *)
+val () = Domain.declareClient ()
+
fun uid () =
case Posix.ProcEnv.getenv "DOMTOOL_USER" of
NONE => Posix.ProcEnv.getuid ()
NONE
end
-val (doit, doitDir, args) =
- case CommandLine.arguments () of
- "-tc" :: args => (fn fname =>
- let
- val _ : string = Main.setupUser ()
- val env = Main.basis ()
- val env =
- case libnameOpt () of
- NONE => env
- | SOME libname => #1 (Main.check env libname)
- in
- ignore (Main.check env fname)
- end,
- Main.checkDir,
- args)
- | args => (fn fname => Main.request (fname, libnameOpt ()),
- Main.requestDir,
- args)
+val (tc, fake, args) = foldl (fn (arg, (tc, fake, args)) =>
+ case arg of
+ "-tc" => (true, fake, args)
+ | "-fake" => (tc, true, args)
+ | _ => (tc, fake, arg :: args))
+ (false, false, []) (CommandLine.arguments ())
+
+val args = rev args
+
+val (doit, doitDir) =
+ if tc then
+ (fn fname =>
+ let
+ val _ : string = Main.setupUser ()
+ val () = if fake then
+ Domain.fakePrivileges ()
+ else
+ ()
+ val env = Main.basis ()
+ val env =
+ case libnameOpt () of
+ NONE => env
+ | SOME libname => #1 (Main.check env libname)
+ in
+ ignore (Main.check env fname)
+ end,
+ Main.checkDir)
+ else
+ (fn fname => Main.request (fname, libnameOpt ()),
+ Main.requestDir)
val _ =
case args of