Consolidate the timeout handling.

conormcd · conormcd · commit 77829feee345 · 2016-02-25T00:45:22.000Z
Previously there were two sources of timeout values. Now there is one,
in the session options. In the process of consolidating these timeouts
we've made it a bit easier to manage the timeouts on a per-session
basis.
diff --git a/src/clj_libssh2/agent.clj b/src/clj_libssh2/agent.clj
@@ -25,11 +25,11 @@
   [session ssh-agent previous]
   (when (nil? previous)
     (handle-errors session
-      (with-timeout :agent
+      (with-timeout session :agent
         (libssh2-agent/list-identities ssh-agent))))
   (let [id (PointerByReference.)
         ret (handle-errors session
-              (with-timeout :agent
+              (with-timeout session :agent
                 (libssh2-agent/get-identity ssh-agent id previous)))]
     (case ret
       0 (.getValue id)
@@ -59,12 +59,12 @@
     (try
       (log/info "Connecting to the SSH agent...")
       (handle-errors session
-        (with-timeout :agent
+        (with-timeout session :agent
           (libssh2-agent/connect ssh-agent)))
       (when (loop [previous nil]
               (log/info "Fetching an ID to authenticate with...")
               (if-let [id (get-identity session ssh-agent previous)]
-                (when-not (= 0 (with-timeout :agent
+                (when-not (= 0 (with-timeout session :agent
                                  (libssh2-agent/userauth ssh-agent username id)))
                   (recur id))
                 :fail))
@@ -75,7 +75,7 @@
       true
       (finally
         (handle-errors session
-          (with-timeout :agent
+          (with-timeout session :agent
             (log/info "Disconnecting from the agent...")
             (libssh2-agent/disconnect ssh-agent)))
         (libssh2-agent/free ssh-agent)))))
diff --git a/src/clj_libssh2/authentication.clj b/src/clj_libssh2/authentication.clj
@@ -58,7 +58,7 @@
     (when-not (.exists (file keyfile))
       (error/raise (FileNotFoundException. keyfile))))
   (handle-errors session
-    (with-timeout :auth
+    (with-timeout session :auth
       (libssh2-userauth/publickey-fromfile (:session session)
                                            (:username credentials)
                                            (:public-key credentials)
@@ -70,7 +70,7 @@
   [session credentials]
   (log/info "Authenticating using a username and password.")
   (handle-errors session
-    (with-timeout :auth
+    (with-timeout session :auth
       (libssh2-userauth/password (:session session)
                                  (:username credentials)
                                  (:password credentials))))
diff --git a/src/clj_libssh2/channel.clj b/src/clj_libssh2/channel.clj
@@ -25,8 +25,7 @@
    0 on success. An exception will be thrown if an error occurs."
   [session channel]
   (log/info "Closing channel.")
-  (block session
-    (handle-errors session (libssh2-channel/close channel))))
+  (block session :lib (handle-errors session (libssh2-channel/close channel))))
 
 (defn exec
   "Execute a command on the remote host. This merely starts the execution of
@@ -44,7 +43,7 @@
    0 on success. An exception will be thrown if an error occurs."
   [session channel commandline]
   (log/info "Executing a command on the remote host.")
-  (block session
+  (block session :request
     (handle-errors session (libssh2-channel/exec channel commandline))))
 
 (defn exit-signal
@@ -117,7 +116,7 @@
 
    0 on success or throws an exception on failure."
   [session channel]
-  (block session (handle-errors session (libssh2-channel/free channel))))
+  (block session :lib (handle-errors session (libssh2-channel/free channel))))
 
 (defn open
   "Create a new channel for a session.
@@ -131,7 +130,7 @@
    A newly-allocated channel object, or throws exception on failure."
   [session]
   (log/info "Opening a new channel.")
-  (block-return session (libssh2-channel/open-session (:session session))))
+  (block-return session :lib (libssh2-channel/open-session (:session session))))
 
 (defn open-scp-recv
   "Create a new channel dedicated to receiving a file using SCP.
@@ -149,7 +148,7 @@
   [session remote-path]
   (log/info "Opening a new channel to receive a file using SCP.")
   (let [fileinfo (Stat/newInstance)]
-    {:channel (block-return session
+    {:channel (block-return session :request
                 (libssh2-scp/recv2 (:session session) remote-path fileinfo))
      :fileinfo fileinfo}))
 
@@ -175,7 +174,7 @@
   (let [mode (or mode 0644)
         mtime (or mtime 0)
         atime (or atime 0)]
-    (block-return session
+    (block-return session :request
       (libssh2-scp/send64 (:session session) remote-path mode size mtime atime))))
 
 (defn send-eof
@@ -191,7 +190,8 @@
    0 on success, throws an exception on failure."
   [session channel]
   (log/info "Notifying the remote host of EOF")
-  (block session (handle-errors session (libssh2-channel/send-eof channel))))
+  (block session :request
+    (handle-errors session (libssh2-channel/send-eof channel))))
 
 (defn setenv
   "Set a selection of environment variables on the channel. These will be
@@ -224,7 +224,7 @@
                                            {:session session})
                               ret))]
     (doseq [[k v] env]
-      (block session
+      (block session :request
         (handle-errors session
           (fail-if-forbidden
             (libssh2-channel/setenv channel (->str k) (->str v))))))))
@@ -419,7 +419,7 @@
    nil, or throw an exception if the timeout is exceeded on any of the streams
    given."
   [session channel streams]
-  (let [read-timeout (-> session :options :read-timeout)
+  (let [read-timeout (-> session :options :timeout :read)
         last-read-time (->> streams
                             (remove #(= :input (:direction %)))
                             (map :last-read-time)
diff --git a/src/clj_libssh2/error.clj b/src/clj_libssh2/error.clj
@@ -6,14 +6,6 @@
             [clj-libssh2.libssh2.session :as libssh2-session])
   (:import [com.sun.jna.ptr IntByReference PointerByReference]))
 
-(def timeouts
-  "An atom map where the keys are keywords being the symbolic names of named
-   timeouts (see get-timeout/set-timeout) and the values are the number of
-   milliseconds for that timeout."
-  (atom {:agent 10000
-         :auth 10000
-         :known-hosts 10000}))
-
 (def error-messages
   "All of the error codes that are documented for libssh2 except for
    LIBSSH2_ERROR_SOCKET_NONE which despite its name is a generic error and
@@ -172,33 +164,20 @@
      (maybe-throw-error (:session session#) res#)
      res#))
 
-(defn get-timeout
-  "Get a timeout value.
+(defn enforce-timeout
+  "Throw an error if a timeout has been exceeded.
 
    Arguments:
 
-   name-or-value Either the name of a symbolic timeout (e.g. :session) or a
-                 number of milliseconds.
-
-   Return:
-
-   A number of milliseconds for the timeout."
-  [name-or-value]
-  (or (get @timeouts name-or-value) name-or-value 1000))
-
-(defn set-timeout
-  "Update a timeout value.
-
-   Arguments:
-
-   timeout-name The name of a symbolic timeout.
-   millis       The number of milliseconds for that timeout.
-
-   Return:
-
-   A map of all the current symbolic timeouts."
-  [timeout-name millis]
-  (swap! timeouts assoc timeout-name millis))
+   session    The clj-libssh2.session.Session object for the current session.
+   start-time The time the timeout is relative to.
+   timeout    The number of milliseconds describing the timeout value."
+  [session start-time timeout]
+  (when (< (if (keyword? timeout)
+             (-> session :options :timeout timeout)
+             timeout)
+           (- (System/currentTimeMillis) start-time))
+    (handle-errors session libssh2/ERROR_TIMEOUT)))
 
 (defmacro with-timeout
   "Run some code that could return libssh2/ERROR_EAGAIN and if it does, retry
@@ -213,22 +192,24 @@
 
    Arguments:
 
-   timeout Either a number of milliseconds or a keyword referring to a named
-           timeout set using set-timeout.
+   session The clj-libssh2.session.Session object for the current session.
+   timeout A number of milliseconds specifying the timeout. This macro will
+           wait for at least that number of milliseconds before failing with a
+           timeout error. It may return successfully sooner, but this value is
+           the minimum time you will wait for failure. The argument can also be
+           passed a keyword which will be looked up in the :timeout section of
+           the session options.
 
    Return:
 
    Either the return value of the code being wrapped or an exception if the
    timeout is exceeded."
-  [timeout & body]
+  [session timeout & body]
   `(let [start# (System/currentTimeMillis)
-         timeout# (get-timeout ~timeout)]
-     (loop [timedout# false]
-       (if timedout#
-         (raise (format "Timeout of %d ms exceeded" timeout#)
-                {:timeout ~timeout
-                 :timeout-length timeout#})
-         (let [r# (do ~@body)]
-           (if (= r# libssh2/ERROR_EAGAIN)
-             (recur (< timeout# (- (System/currentTimeMillis) start#)))
-             r#))))))
+         session# ~session
+         timeout# ~timeout]
+     (loop [result# (do ~@body)]
+       (enforce-timeout session# start# timeout#)
+       (if (= result# libssh2/ERROR_EAGAIN)
+         (recur (do ~@body))
+         result#))))
diff --git a/src/clj_libssh2/known_hosts.clj b/src/clj_libssh2/known_hosts.clj
@@ -84,7 +84,7 @@
    0 on success or an exception if the key does not validate."
   [session known-hosts host port host-key fail-on-missing fail-on-mismatch]
   (handle-errors session
-    (with-timeout :known-hosts
+    (with-timeout session :known-hosts
       (checkp-result fail-on-mismatch fail-on-missing
         (libssh2-knownhost/checkp known-hosts
                                   host
@@ -112,7 +112,7 @@
   [session known-hosts known-hosts-file]
   (when (.exists (file known-hosts-file))
     (handle-errors session
-      (with-timeout :known-hosts
+      (with-timeout session :known-hosts
         (libssh2-knownhost/readfile known-hosts
                                     known-hosts-file
                                     libssh2/KNOWNHOST_FILE_OPENSSH)))))
diff --git a/src/clj_libssh2/session.clj b/src/clj_libssh2/session.clj
@@ -15,16 +15,20 @@
    protect against attempting to close sessions twice."
   (atom #{}))
 
-(def default-opts
+(def ^:private default-opts
   "The default options for a session. These are not only the defaults, but an
    exhaustive list of the legal options."
-  {:blocking-timeout 60000
-   :character-set "UTF-8"
+  {:character-set "UTF-8"
    :fail-if-not-in-known-hosts false
    :fail-unless-known-hosts-matches true
    :known-hosts-file nil
    :read-chunk-size (* 1024 1024)
-   :read-timeout 60000
+   :timeout {:agent 5000        ; All agent operations
+             :auth 5000         ; All authentication calls
+             :known-hosts 5000  ; All interactions with the known hosts API
+             :lib 1000          ; Operations that are 100% local library calls
+             :read 60000        ; Reads from the remote host
+             :request 5000}     ; Simple calls to the remote host
    :write-chunk-size (* 1024 1024)})
 
 (defrecord Session [session socket host port options])
@@ -56,7 +60,9 @@
    keys in default-opts."
   [opts]
   {:pre [(map? opts) (every? (set (keys default-opts)) (keys opts))]}
-  (merge default-opts opts))
+  (merge default-opts
+         (assoc opts
+                :timeout (merge (:timeout default-opts) (:timeout opts)))))
 
 (defn- destroy-session
   "Free a libssh2 session object from a Session and optionally raise an
@@ -77,10 +83,10 @@
    (destroy-session session "Shutting down normally." false))
   ([session reason raise]
    (log/info "Tearing down the session.")
-   (socket/block session
+   (socket/block session :request
      (handle-errors session
        (libssh2-session/disconnect (:session session) reason)))
-   (socket/block session
+   (socket/block session :lib
      (handle-errors session
        (libssh2-session/free (:session session))))
    (when raise
@@ -98,7 +104,7 @@
    0 on success. Throws an exception on failure."
   [session]
   (log/info "Handshaking with the remote host.")
-  (socket/block session
+  (socket/block session :request
     (handle-errors session
       (libssh2-session/handshake (:session session) (:socket session)))))
 
diff --git a/src/clj_libssh2/socket.clj b/src/clj_libssh2/socket.clj
@@ -95,33 +95,29 @@
        (when (>= 0 select-result)
          (handle-errors session libssh2/ERROR_TIMEOUT))))))
 
-(defn enforce-blocking-timeout
-  [session start-time]
-  (when (< (-> session :options :blocking-timeout)
-           (- (System/currentTimeMillis) start-time))
-    (handle-errors session libssh2/ERROR_TIMEOUT)))
-
 (defmacro block
   "Turn a non-blocking call that returns EAGAIN into a blocking one."
-  [session & body]
+  [session timeout & body]
   `(let [session# ~session
-         start-time# (System/currentTimeMillis)]
+         start-time# (System/currentTimeMillis)
+         timeout# ~timeout]
      (while (= libssh2/ERROR_EAGAIN (do ~@body))
        (handle-errors session#
          (wait session# start-time#))
-       (enforce-blocking-timeout session# start-time#))))
+       (error/enforce-timeout session# start-time# timeout#))))
 
 (defmacro block-return
   "Similar to block, but for functions that return a pointer"
-  [session & body]
+  [session timeout & body]
   `(let [session# ~session
-         start-time# (System/currentTimeMillis)]
+         start-time# (System/currentTimeMillis)
+         timeout# ~timeout]
      (loop [result# (do ~@body)]
        (if (nil? result#)
          (let [errno# (libssh2-session/last-errno (:session session#))]
            (handle-errors session# errno#)
            (when (= libssh2/ERROR_EAGAIN errno#)
              (wait session# start-time#))
-           (enforce-blocking-timeout session# start-time#)
+           (error/enforce-timeout session# start-time# timeout#)
            (recur (do ~@body)))
          result#))))
diff --git a/src/clj_libssh2/ssh.clj b/src/clj_libssh2/ssh.clj
@@ -149,7 +149,7 @@
       (let [output (FileOutputStream. local-path)
             file-size (.getSize fileinfo)
             read-chunk-size (-> session :options :read-chunk-size)
-            read-timeout (-> session :options :read-timeout)
+            read-timeout (-> session :options :timeout :read)
             finish (fn [bytes-read]
                      (.close output)
                      {:local-path local-path
diff --git a/test/clj_libssh2/test_error.clj b/test/clj_libssh2/test_error.clj
diff --git a/test/clj_libssh2/test_ssh.clj b/test/clj_libssh2/test_ssh.clj
