Less noisy pinging and shutting down
[hcoop/domtool2.git] / src / main.sml
index b2f59b5..db1b52b 100644 (file)
@@ -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