Preliminary regeneration support

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

diff --git a/src/main.sml b/src/main.sml
index 0f65362..715b486 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -116,10 +116,13 @@ fun checkDir dname =
        val (_, files) = Order.order (SOME b) files
     in
        if !ErrorMsg.anyErrors then
-           false
+           raise ErrorMsg.Error
        else
            (foldl (fn (fname, G) => check' G fname) b files;
-            !ErrorMsg.anyErrors)
+            if !ErrorMsg.anyErrors then
+                raise ErrorMsg.Error
+            else
+                ())
     end
 
 fun reduce fname =
@@ -152,6 +155,15 @@ fun eval fname =
            Eval.exec (Defaults.eInit ()) body'
       | NONE => raise ErrorMsg.Error
 
+fun eval' fname =
+    case reduce fname of
+       (SOME body') =>
+       if !ErrorMsg.anyErrors then
+           raise ErrorMsg.Error
+       else
+           ignore (Eval.exec' (Defaults.eInit ()) body')
+      | NONE => raise ErrorMsg.Error
+
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
 
@@ -207,7 +219,9 @@ fun request fname =
 
 fun requestDir dname =
     let
-       val (user, bio) = requestBio (fn () => ignore (checkDir dname))
+       val _ = ErrorMsg.reset ()
+
+       val (user, bio) = requestBio (fn () => checkDir dname)
 
        val b = basis ()
 
@@ -246,15 +260,18 @@ fun requestDir dname =
                                before TextIO.closeIn inf
                            end) files
     in
-       Msg.send (bio, MsgMultiConfig codes);
-       case Msg.recv bio of
-           NONE => print "Server closed connection unexpectedly.\n"
-         | SOME m =>
-           case m of
-               MsgOk => print "Configuration succeeded.\n"
-             | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
-             | _ => print "Unexpected server reply.\n";
-       OpenSSL.close bio
+       if !ErrorMsg.anyErrors then
+           ()
+       else
+           (Msg.send (bio, MsgMultiConfig codes);
+            case Msg.recv bio of
+                NONE => print "Server closed connection unexpectedly.\n"
+              | SOME m =>
+                case m of
+                    MsgOk => print "Configuration succeeded.\n"
+                  | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
+                  | _ => print "Unexpected server reply.\n";
+            OpenSSL.close bio)
     end
     handle ErrorMsg.Error => ()
 
@@ -324,6 +341,21 @@ fun requestWhoHas perm =
        before OpenSSL.close bio
     end
 
+fun requestRegen () =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgRegenerate);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Regeneration succeeded.\n"
+             | MsgError s => print ("Regeneration failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
 fun requestRmdom dom =
     let
        val (_, bio) = requestBio (fn () => ())
@@ -339,6 +371,48 @@ fun requestRmdom dom =
        OpenSSL.close bio
     end
 
+fun regenerate () =
+    let
+       val b = basis ()
+       val _ = Tycheck.disallowExterns ()
+
+       fun doUser user =
+           let
+               val _ = Domain.setUser user
+               val _ = ErrorMsg.reset ()
+
+               val dname = Config.domtoolDir user
+
+               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
+                   print ("User " ^ user ^ "'s configuration has errors!\n")
+               else
+                   app eval' files
+           end
+               handle IO.Io _ => ()
+                    | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
+    in
+       Env.pre ();
+       app doUser (Acl.users ());
+       Env.post ()
+    end
+
 fun service () =
     let
        val () = Acl.read Config.aclFile
@@ -373,10 +447,12 @@ fun service () =
                                in
                                    TextIO.output (outf, code);
                                    TextIO.closeOut outf;
-                                   eval outname
+                                   eval' outname
                                end
                        in
-                           (app doOne codes;
+                           (Env.pre ();
+                            app doOne codes;
+                            Env.post ();
                             Msg.send (bio, MsgOk))
                            handle ErrorMsg.Error =>
                                   (print "Compilation error\n";
@@ -503,6 +579,30 @@ fun service () =
                                      ignore (OpenSSL.readChar bio);
                                      OpenSSL.close bio)
                                     handle OpenSSL.OpenSSL _ => ();
+                                    loop ())
+
+                             | MsgRegenerate =>
+                               if Acl.query {user = user, class = "priv", value = "regen"}
+                                  orelse Acl.query {user = user, class = "priv", value = "all"} then
+                                   ((regenerate ();
+                                     Msg.send (bio, MsgOk);
+                                     print "Regenerated all configuration.\n")
+                                    handle OpenSSL.OpenSSL s =>
+                                           (print "OpenSSL error\n";
+                                            Msg.send (bio,
+                                                      MsgError
+                                                          ("Error during regeneration: "
+                                                           ^ s)));
+                                   (ignore (OpenSSL.readChar bio);
+                                    OpenSSL.close bio)
+                                   handle OpenSSL.OpenSSL _ => ();
+                                   loop ())
+                               else
+                                   ((Msg.send (bio, MsgError "Not authorized to regeneration");
+                                     print "Unauthorized user asked to regenerate!\n";
+                                     ignore (OpenSSL.readChar bio);
+                                     OpenSSL.close bio)
+                                    handle OpenSSL.OpenSSL _ => ();
                                     loop ())                           
 
                              | _ =>