'-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 57500c5..642e35f 100644 (file)
--- a/src/main-client.sml
+++ b/src/main-client.sml
@@ -18,24 +18,70 @@
 
 (* Driver for configuration requests *)
 
+val () = Domain.declareClient ()
+
+fun uid () =
+    case Posix.ProcEnv.getenv "DOMTOOL_USER" of
+       NONE => Posix.ProcEnv.getuid ()
+      | SOME user => Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam user)
+
 fun domtoolRoot () =
     let
-       val uid = Posix.ProcEnv.getuid ()
-       val uname = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
-       val dname = OS.Path.joinDirFile {dir = Config.homeBase,
-                                        file = uname}
+       val dname = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid (uid ()))
     in
        OS.Path.joinDirFile {dir = dname,
-                            file = "domtool"}
+                            file = ".domtool"}
+    end
+
+fun libnameOpt () =
+    let
+       val libname = OS.Path.joinDirFile {dir = domtoolRoot (),
+                                          file = "lib.dtl"}
+    in
+       if Posix.FileSys.access (libname, []) then
+           SOME libname
+       else
+           NONE
     end
 
+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 CommandLine.arguments () of
+    case args of
        [fname] =>
        if Posix.FileSys.access (fname, []) then
-           Main.request fname
+           doit fname
        else
-           Main.request (OS.Path.joinDirFile {dir = domtoolRoot (),
-                                              file = fname})
-      | [] => Main.requestDir (domtoolRoot ())
+           doit (OS.Path.joinDirFile {dir = domtoolRoot (),
+                                      file = fname})
+      | [] => doitDir (domtoolRoot ())
       | _ => print "Invalid command-line arguments\n"