Add read-only path type

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

diff --git a/src/main.sml b/src/main.sml
index 660c892..4198901 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -869,14 +869,20 @@ fun requestFirewall {node, uname} =
        before OpenSSL.close bio
     end
 
-fun regenerate context =
+fun regenerateEither tc checker context =
     let
+       fun ifReal f =
+           if tc then
+               ()
+           else
+               f ()
+
        val _ = ErrorMsg.reset ()
 
        val b = basis ()
        val () = Tycheck.disallowExterns ()
 
-       val () = Domain.resetGlobal ()
+       val () = ifReal Domain.resetGlobal
 
        val ok = ref true
  
@@ -934,7 +940,7 @@ fun regenerate context =
                            (ErrorMsg.reset ();
                             print ("User " ^ user ^ "'s configuration has errors!\n"))
                        else
-                           app eval' files
+                           app checker files
                    end
                else
                    ()
@@ -942,77 +948,23 @@ fun regenerate context =
            handle IO.Io {name, function, ...} =>
                   (print ("IO error processing user " ^ user ^ ": " ^ function ^ ": " ^ name ^ "\n");
                    ok := false)
-                | OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
-                                       ok := false)
+                | exn as OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
+                                              ok := false)
                 | ErrorMsg.Error => (ErrorMsg.reset ();
                                      print ("User " ^ user ^ " had a compilation error.\n");
                                      ok := false)
                 | _ => (print "Unknown exception during regeneration!\n";
                         ok := false)
     in
-       app contactNode Config.nodeIps;
-       Env.pre ();
+       ifReal (fn () => (app contactNode Config.nodeIps;
+                         Env.pre ()));
        app doUser (Acl.users ());
-       Env.post ();
+       ifReal Env.post;
        !ok
     end
 
-fun regenerateTc context =
-    let
-       val _ = ErrorMsg.reset ()
-
-       val b = basis ()
-       val () = Tycheck.disallowExterns ()
-
-       val () = Domain.resetGlobal ()
-
-       val ok = ref true
-
-       fun doUser user =
-           let
-               val _ = Domain.setUser user
-               val _ = ErrorMsg.reset ()
-
-               val dname = Config.domtoolDir user
-           in
-               if Posix.FileSys.access (dname, []) then
-                   let
-                       val dir = Posix.FileSys.opendir dname
-
-                       fun loop files =
-                           case Posix.FileSys.readdir dir of
-                               NONE => (Posix.FileSys.closedir dir;
-                                        files)
-                             | SOME fname =>
-                               if notTmp fname then
-                                   loop (OS.Path.joinDirFile {dir = dname,
-                                                              file = fname}
-                                         :: files)
-                               else
-                                   loop files
-
-                       val files = loop []
-                       val (_, files) = Order.order (SOME b) files
-                   in
-                       if !ErrorMsg.anyErrors then
-                           (ErrorMsg.reset ();
-                            print ("User " ^ user ^ "'s configuration has errors!\n");
-                            ok := false)
-                       else
-                           app (ignore o check) files
-                   end
-               else
-                   ()
-           end
-           handle IO.Io _ => ()
-                | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
-                | ErrorMsg.Error => (ErrorMsg.reset ();
-                                     print ("User " ^ user ^ " had a compilation error.\n"))
-                | _ => print "Unknown exception during -tc regeneration!\n"
-    in
-       app doUser (Acl.users ());
-       !ok
-    end
+val regenerate = regenerateEither false eval'
+val regenerateTc = regenerateEither true (ignore o check)
 
 fun rmuser user =
     let