Less noisy pinging and shutting down

diff --git a/src/domain.sml b/src/domain.sml
index 8960bf9..d1046b7 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -699,10 +699,10 @@ fun handleSite (site, files) =
        if site = Config.defaultNode then
            Slave.handleChanges files
        else let
-               val bio = OpenSSL.connect (valOf (!ssl_context),
-                                          nodeIp site
-                                          ^ ":"
-                                          ^ Int.toString Config.slavePort)
+               val bio = OpenSSL.connect true (valOf (!ssl_context),
+                                               nodeIp site
+                                               ^ ":"
+                                               ^ Int.toString Config.slavePort)
            in
                app (fn file => Msg.send (bio, MsgFile file)) files;
                Msg.send (bio, MsgDoFiles);

diff --git a/src/main-admin.sml b/src/main-admin.sml
index 0e404c6..183db60 100644 (file)
--- a/src/main-admin.sml
+++ b/src/main-admin.sml
@@ -61,6 +61,6 @@ val _ =
          app (fn s => (print s; print "\n")) (Acl.users ()))
                      
        | _ => (print "Invalid command-line arguments\n";
-              print "See the documentation: http://wiki2.hcoop.net/DomTool/AdminProcedures\n"))
+              print "See the documentation: http://wiki.hcoop.net/DomTool/AdminProcedures\n"))
     handle OpenSSL.OpenSSL s => (print ("OpenSSL exception: " ^ s ^ "\n");
                                 OS.Process.exit OS.Process.failure)

diff --git a/src/main.sml b/src/main.sml
index b2f59b5..db1b52b 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -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

diff --git a/src/openssl.sig b/src/openssl.sig
index a3641a9..2e027b9 100644 (file)
--- a/src/openssl.sig
+++ b/src/openssl.sig
@@ -41,7 +41,7 @@ val writeString : bio * string -> unit
 
 val context : bool -> string * string * string -> context
 
-val connect : context * string -> bio
+val connect : bool -> context * string -> bio
 val close : bio -> unit
 
 val listen : context * int -> listener

diff --git a/src/openssl.sml b/src/openssl.sml
index aad3925..26001cc 100644 (file)
--- a/src/openssl.sml
+++ b/src/openssl.sml
@@ -266,9 +266,15 @@ fun context printErr (chain, key, root) =
            context
     end
 
-fun connect (context, hostname) =
+fun connect printErr (context, hostname) =
     let
        val bio = F_OpenSSL_SML_new_ssl_connect.f' context
+
+       val ssl_err =
+           if printErr then
+               ssl_err
+           else
+               (fn _ => ())
     in
        if C.Ptr.isNull' bio then
            (ssl_err ("Error initializating connection to " ^ hostname);