Less noisy pinging and shutting down

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

diff --git a/src/main.sml b/src/main.sml
index a0f402d..db1b52b 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -46,7 +46,10 @@ fun check' G fname =
        if !ErrorMsg.anyErrors then
            G
        else
-           (Option.app (Unused.check G) (#3 prog);
+           (if isLib fname then
+                ()
+            else
+                Option.app (Unused.check G) (#3 prog);
             Tycheck.checkFile G (Defaults.tInit prog) prog)
     end
 
@@ -102,7 +105,10 @@ fun check G fname =
                        if !ErrorMsg.anyErrors then
                            raise ErrorMsg.Error
                        else
-                           (Option.app (Unused.check G) (#3 prog);
+                           (if isLib fname then
+                                ()
+                            else
+                                Option.app (Unused.check G) (#3 prog);
                             (G', #3 prog))
                    end
            end
@@ -227,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))
@@ -335,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
@@ -348,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"
@@ -359,7 +369,7 @@ fun requestShutdown () =
 
 fun requestSlavePing () =
     let
-       val (_, bio) = requestSlaveBio ()
+       val (_, bio) = requestSlaveBio' false
     in
        OpenSSL.close bio;
        OS.Process.success
@@ -372,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"
@@ -715,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))
 
@@ -744,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))
 
@@ -773,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))
 
@@ -802,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))
 
@@ -831,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))
 
@@ -862,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 () =
@@ -983,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