Fix regeneration of multi-file dependencies

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

diff --git a/src/main.sml b/src/main.sml
index b2f59b5..381badb 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -175,7 +175,7 @@ fun reduce G fname =
        val (G, body) = check G fname
     in
        if !ErrorMsg.anyErrors then
-           NONE
+           (G, NONE)
        else
            case body of
                SOME body =>
@@ -186,16 +186,16 @@ fun reduce G fname =
                                         [PD.string "Result:",
                                          PD.space 1,
                                          p_exp body']))*)
-                   SOME (G, body')
+                   (G, SOME body')
                end
-             | _ => NONE
+             | _ => (G, NONE)
     end
 
 (*(Defaults.eInit ())*)
 
 fun eval G evs fname =
     case reduce G fname of
-       SOME (G, body') =>
+       (G, SOME body') =>
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
        else
@@ -204,7 +204,7 @@ fun eval G evs fname =
            in
                (G, evs')
            end
-      | NONE => (G, evs)
+      | (G, NONE) => (G, evs)
 
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
@@ -233,20 +233,24 @@ fun requestContext f =
        (user, context)
     end
 
-fun requestBio f =
+fun requestBio' printErr f =
     let
        val (user, context) = requestContext f
     in
-       (user, OpenSSL.connect (context, dispatcher))
+       (user, OpenSSL.connect printErr (context, dispatcher))
     end
 
-fun requestSlaveBio () =
+val requestBio = requestBio' true
+
+fun requestSlaveBio' printErr =
     let
        val (user, context) = requestContext (fn () => ())
     in
-       (user, OpenSSL.connect (context, self))
+       (user, OpenSSL.connect printErr (context, self))
     end
 
+fun requestSlaveBio () = requestSlaveBio' true
+
 fun request fname =
     let
        val (user, bio) = requestBio (fn () => ignore (check (basis ()) fname))
@@ -341,7 +345,7 @@ fun requestDir dname =
 
 fun requestPing () =
     let
-       val (_, bio) = requestBio (fn () => ())
+       val (_, bio) = requestBio' false (fn () => ())
     in
        OpenSSL.close bio;
        OS.Process.success
@@ -354,7 +358,7 @@ fun requestShutdown () =
     in
        Msg.send (bio, MsgShutdown);
        case Msg.recv bio of
-           NONE => print "Server closed connection unexpectedly.\n"
+           NONE => ()
          | SOME m =>
            case m of
                MsgOk => print "Shutdown begun.\n"
@@ -365,7 +369,7 @@ fun requestShutdown () =
 
 fun requestSlavePing () =
     let
-       val (_, bio) = requestSlaveBio ()
+       val (_, bio) = requestSlaveBio' false
     in
        OpenSSL.close bio;
        OS.Process.success
@@ -378,7 +382,7 @@ fun requestSlaveShutdown () =
     in
        Msg.send (bio, MsgShutdown);
        case Msg.recv bio of
-           NONE => print "Server closed connection unexpectedly.\n"
+           NONE => ()
          | SOME m =>
            case m of
                MsgOk => print "Shutdown begun.\n"
@@ -721,10 +725,10 @@ fun requestMysqlFixperms () =
 fun requestApt {node, pkg} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QApt pkg))
 
@@ -750,10 +754,10 @@ fun requestApt {node, pkg} =
 fun requestCron {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QCron uname))
 
@@ -779,10 +783,10 @@ fun requestCron {node, uname} =
 fun requestFtp {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QFtp uname))
 
@@ -808,10 +812,10 @@ fun requestFtp {node, uname} =
 fun requestTrustedPath {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QTrustedPath uname))
 
@@ -837,10 +841,10 @@ fun requestTrustedPath {node, uname} =
 fun requestSocketPerm {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QSocket uname))
 
@@ -868,11 +872,11 @@ fun requestSocketPerm {node, uname} =
 fun requestFirewall {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
-
+       val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+                 
        val _ = Msg.send (bio, MsgQuery (QFirewall uname))
 
        fun loop () =
@@ -989,10 +993,10 @@ fun regenerateEither tc checker context =
            if node = Config.defaultNode then
                Domain.resetLocal ()
            else let
-                   val bio = OpenSSL.connect (context,
-                                              ip
-                                              ^ ":"
-                                              ^ Int.toString Config.slavePort)
+                   val bio = OpenSSL.connect true (context,
+                                                   ip
+                                                   ^ ":"
+                                                   ^ Int.toString Config.slavePort)
                in
                    Msg.send (bio, MsgRegenerate);
                    case Msg.recv bio of