'-fake' flag added to 'domtool'

[hcoop/domtool2.git] / src / main-client.sml

diff --git a/src/main-client.sml b/src/main-client.sml
index 1c6333d..642e35f 100644 (file)
--- a/src/main-client.sml
+++ b/src/main-client.sml
@@ -18,6 +18,8 @@
 
 (* Driver for configuration requests *)
 
 
 (* Driver for configuration requests *)
 

+val () = Domain.declareClient ()
+

 fun uid () =
     case Posix.ProcEnv.getenv "DOMTOOL_USER" of
        NONE => Posix.ProcEnv.getuid ()
 fun uid () =
     case Posix.ProcEnv.getenv "DOMTOOL_USER" of
        NONE => Posix.ProcEnv.getuid ()


@@ -42,24 +44,36 @@ fun libnameOpt () =
            NONE
     end
 
            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
 
 val _ =
     case args of