Dirac Agent checks for proper version of nREPL middleware

binaryage · Jan 27, 2016 · c62831f · c62831f
1 parent 70c3c6c
commit c62831f
Show file tree

Hide file tree

Showing 9 changed files with 120 additions and 55 deletions.
diff --git a/project.clj b/project.clj
@@ -14,6 +14,7 @@
                  [org.clojure/tools.cli "0.3.3"]
                  [org.clojure/tools.nrepl "0.2.12"]
                  [clj-logging-config "1.9.12"]
+                 [version-clj "0.1.2"]
                  [environ "1.0.1"]
                  [http-kit "2.1.21-alpha2"]]
 

diff --git a/src/agent/dirac/agent.clj b/src/agent/dirac/agent.clj
@@ -6,12 +6,14 @@
             [dirac.agent.version :refer [version]]
             [dirac.lib.nrepl-tunnel :as nrepl-tunnel]
             [dirac.lib.utils :as utils])
-  (:import (java.net ConnectException)))
+  (:import (java.net ConnectException)
+           (clojure.lang ExceptionInfo)))
 
 (defn ^:dynamic failed-to-start-dirac-agent-message [max-boot-trials trial-display nrepl-server-url]
   (str "Failed to start Dirac Agent. "
-       "The nREPL server didn't come online in time. Made " max-boot-trials " connection attempts "
-       "over last " trial-display " seconds. Did you really start your nREPL server at " nrepl-server-url "? "
+       "The nREPL server didn't come online in time. "
+       "Made " max-boot-trials " connection attempts over last " trial-display " seconds.\n"
+       "Did you really start your nREPL server at " nrepl-server-url "? "
        "Maybe a firewall problem?"))
 
 ; -- DiracAgent construction  -----------------------------------------------------------------------------------------------
@@ -90,10 +92,13 @@
         (let [result (try
                        (log/info (str "Starting Dirac Agent (attempt #" trial ")"))
                        (create! config)
+                       (catch ExceptionInfo e                                                                                 ; for example missing nREPL middleware
+                         (log/error "ERROR:" (.getMessage e))
+                         :error)
                        (catch ConnectException _
                          ::retry)                                                                                             ; server might not be online yet
                        (catch Throwable e
-                         (log/error "Failed to create Dirac Agent:" e)                                                        ; ***
+                         (log/error "ERROR:" "Failed to create Dirac Agent:\n" e)                                             ; ***
                          ::error))]
           (case result
             true (let [agent @current-agent]
@@ -103,7 +108,7 @@
                    (println (get-agent-info agent))
                    true)                                                                                                      ; success
             false (do
-                    (log/error "Failed to start Dirac Agent.")
+                    (log/error "ERROR:" "Failed to start Dirac Agent.")
                     false)
             ::error false                                                                                                     ; error was already reported by ***
             ::retry (do

diff --git a/src/agent/dirac/agent/version.clj b/src/agent/dirac/agent/version.clj
@@ -1,4 +1,4 @@
 (ns dirac.agent.version
   (:require [dirac.version]))
 
-(def version dirac.version/version)
+(def ^:dynamic version dirac.version/version)
diff --git a/src/lib/dirac/lib/nrepl_client.clj b/src/lib/dirac/lib/nrepl_client.clj
@@ -65,18 +65,22 @@
   {:pre [(instance? NREPLClient client)]}
   (not (nil? (get-raw-nrepl-client client))))
 
+(defn get-connection-url [options]
+  (let [{:keys [host port]} options]
+    (utils/get-nrepl-server-url host port)))
+
+(defn get-server-connection-url [client]
+  (get-connection-url (get-options client)))
+
 (defn get-client-info [client]
   {:pre [(instance? NREPLClient client)]}
   (if (connected? client)
-    (let [{:keys [host port]} (get-options client)
-          url (utils/get-nrepl-server-url host port)]
+    (let [url (get-server-connection-url client)]
       (str "Connected to nREPL server at " url "."))
     (str "Not connected to nREPL server.")))
 
 (defn connect-with-options [options]
-  (let [{:keys [host port]} options
-        url (utils/get-nrepl-server-url host port)]
-    (nrepl/url-connect url)))
+  (nrepl/url-connect (get-connection-url options)))
 
 ; -- sending ----------------------------------------------------------------------------------------------------------------
 
@@ -149,7 +153,7 @@
 
 (defn create! [tunnel options]
   (let [connection (connect-with-options options)
-        raw-nrepl-client (nrepl/client connection Long/MAX_VALUE)
+        raw-nrepl-client (nrepl/client connection Long/MAX_VALUE)                                                             ; TODO: response timeout should be configurable
         response-table (atom {})
         response-poller (spawn-response-poller! tunnel connection response-table options)
         client (make-client tunnel options connection raw-nrepl-client response-poller response-table)]

diff --git a/src/lib/dirac/lib/nrepl_tunnel.clj b/src/lib/dirac/lib/nrepl_tunnel.clj
@@ -2,9 +2,11 @@
   (require [clojure.core.async :refer [chan <!! <! >!! put! alts!! timeout close! go go-loop]]
            [clojure.core.async.impl.protocols :as core-async]
            [clojure.tools.logging :as log]
+           [version-clj.core :refer [version-compare]]
            [dirac.lib.nrepl-protocols :refer [NREPLTunnelService]]
            [dirac.lib.nrepl-tunnel-server :as nrepl-tunnel-server]
            [dirac.lib.nrepl-client :as nrepl-client]
+           [dirac.lib.version :as lib]
            [dirac.lib.utils :as utils]))
 
 ; Unfortunately, we cannot easily implement full-blown nREPL client in Dirac DevTools.
@@ -42,6 +44,25 @@
 ;       ...        <-s->  [ nREPL client ] <-> [ nREPL tunnel server ]  <-ws->  [ nREPL tunnel client #2 ]
 ;                                                                       <-ws->  [ nREPL tunnel client #3 ]
 
+(def nrepl-setup-doc-url "https://github.com/binaryage/dirac#start-nrepl-server")
+(def agent-setup-doc-url "https://github.com/binaryage/dirac#start-dirac-agent")
+
+(defn ^:dynamic missing-nrepl-middleware-msg [url]
+  (str "Dirac nREPL middleware is not present in nREPL server at " url "!\n"
+       "Didn't you forget to add :nrepl-middleware [dirac.nrepl.middleware/dirac-repl] to your :repl-options?\n"
+       "Please follow Dirac installation instructions: " nrepl-setup-doc-url "."))
+
+(defn ^:dynamic old-nrepl-middleware-msg [expected-version reported-version]
+  (str "WARNING: The version of Dirac nREPL middleware is old. "
+       "Expected '" expected-version "', got '" reported-version "'.\n"
+       "You probably want to review your nREPL server setup and bump binaryage/dirac version to '" expected-version "'.\n"
+       "Please follow Dirac installation instructions: " nrepl-setup-doc-url "."))
+
+(defn ^:dynamic unknown-nrepl-middleware-msg [expected-version reported-version]
+  (str "WARNING: The version of Dirac nREPL middleware is unknown (too recent). "
+       "Expected '" expected-version "', got '" reported-version "'.\n"
+       "You probably want to review your Dirac Agent setup and bump binaryage/dirac version to '" reported-version "'.\n"
+       "Please follow Dirac installation instructions: " agent-setup-doc-url "."))
 
 ; -- NREPLTunnel constructor ------------------------------------------------------------------------------------------------
 
@@ -155,15 +176,15 @@
 ;
 
 (defn deliver-server-message! [tunnel message]
-  (let [channel (get-server-messages-channel tunnel)
-        receipt (promise)]
-    (if (core-async/closed? channel)
-      (log/warn (str tunnel) (str "An attempt to enqueue a message for nREPL server, but channel was already closed! => ignored\n")
-                (utils/pp message))
-      (log/trace (str tunnel) (str "Enqueue message " (utils/sid message) " to be sent to nREPL server:\n")
-                 (utils/pp message)))
-    (put! channel [message receipt])
-    receipt))
+  (if-let [channel (get-server-messages-channel tunnel)]                                                                      ; we silently ignore messages when channel is not yet set (during initialization)
+    (let [receipt (promise)]
+      (if (core-async/closed? channel)
+        (log/warn (str tunnel) (str "An attempt to enqueue a message for nREPL server, but channel was already closed! => ignored\n")
+                  (utils/pp message))
+        (log/trace (str tunnel) (str "Enqueue message " (utils/sid message) " to be sent to nREPL server:\n")
+                   (utils/pp message)))
+      (put! channel [message receipt])
+      receipt)))
 
 (defn run-server-messages-channel-processing-loop! [tunnel]
   (log/debug (str tunnel) "Starting server-messages-channel-processing-loop")
@@ -179,15 +200,15 @@
           (deliver (get-server-messages-done-promise tunnel) true))))))
 
 (defn deliver-client-message! [tunnel message]
-  (let [channel (get-client-messages-channel tunnel)
-        receipt (promise)]
-    (if (core-async/closed? channel)
-      (log/warn (str tunnel) (str "An attempt to enqueue a message for DevTools client, but channel was already closed! => ignored\n")
-                (utils/pp message))
-      (log/trace (str tunnel) (str "Enqueue message " (utils/sid message) " to be sent to a DevTools client via tunnel:\n")
-                 (utils/pp message)))
-    (put! channel [message receipt])
-    receipt))
+  (if-let [channel (get-client-messages-channel tunnel)]                                                                      ; we silently ignore messages when channel is not yet set (during initialization)
+    (let [receipt (promise)]
+      (if (core-async/closed? channel)
+        (log/warn (str tunnel) (str "An attempt to enqueue a message for DevTools client, but channel was already closed! => ignored\n")
+                  (utils/pp message))
+        (log/trace (str tunnel) (str "Enqueue message " (utils/sid message) " to be sent to a DevTools client via tunnel:\n")
+                   (utils/pp message)))
+      (put! channel [message receipt])
+      receipt)))
 
 (defn run-client-messages-channel-processing-loop! [tunnel]
   (log/debug (str tunnel) "Starting client-messages-channel-processing-loop")
@@ -204,28 +225,46 @@
 
 ; -- NREPLTunnel life cycle -------------------------------------------------------------------------------------------------
 
+(defn check-nrepl-middleware! [nrepl-client]
+  (log/trace "check-nrepl-middleware! lib-version" lib/version)
+  (let [identify-response (<!! (nrepl-client/send! nrepl-client {:op "identify-dirac-nrepl-middleware"}))
+        {:keys [version]} identify-response]
+    (log/debug "identify-dirac-nrepl-middleware response:" identify-response)
+    (if version
+      (case (version-compare version lib/version)
+        -1 [:old (old-nrepl-middleware-msg lib/version version)]
+        1 [:unknown (unknown-nrepl-middleware-msg lib/version version)]
+        0 [:ok])
+      [:missing (missing-nrepl-middleware-msg (nrepl-client/get-server-connection-url nrepl-client))])))
+
 (defn create! [options]
   (let [tunnel (make-tunnel! options)
         server-messages (chan)
         client-messages (chan)]
-    (set-server-messages-channel! tunnel server-messages)
-    (set-client-messages-channel! tunnel client-messages)
-    (let [nrepl-client (nrepl-client/create! tunnel (:nrepl-server options))
-          nrepl-tunnel-server (nrepl-tunnel-server/create! tunnel (:nrepl-tunnel options))]
-      (set-nrepl-client! tunnel nrepl-client)
-      (set-nrepl-tunnel-server! tunnel nrepl-tunnel-server)
-      (run-server-messages-channel-processing-loop! tunnel)
-      (run-client-messages-channel-processing-loop! tunnel)
-      (log/debug "Created" (str tunnel))
-      tunnel)))
+    (let [nrepl-client (nrepl-client/create! tunnel (:nrepl-server options))]
+      (let [[status message] (check-nrepl-middleware! nrepl-client)]
+        (case status
+          :missing (throw (ex-info message {}))
+          (:old, :unknown) (log/warn message)
+          nil))
+      (let [nrepl-tunnel-server (nrepl-tunnel-server/create! tunnel (:nrepl-tunnel options))]
+        (set-nrepl-client! tunnel nrepl-client)
+        (set-server-messages-channel! tunnel server-messages)
+        (set-client-messages-channel! tunnel client-messages)
+        (set-nrepl-client! tunnel nrepl-client)
+        (set-nrepl-tunnel-server! tunnel nrepl-tunnel-server)
+        (run-server-messages-channel-processing-loop! tunnel)
+        (run-client-messages-channel-processing-loop! tunnel)
+        (log/debug "Created" (str tunnel))
+        tunnel))))
 
 (defn destroy! [tunnel]
   (log/trace "Destroying" (str tunnel))
   (when-let [nrepl-tunnel-server (get-nrepl-tunnel-server tunnel)]
     (nrepl-tunnel-server/disconnect-all-clients! nrepl-tunnel-server)
     (close! (get-client-messages-channel tunnel))
     @(get-client-messages-done-promise tunnel)
-    (Thread/sleep 1000)                                                                                                         ; give networking code some time to send outstanding messages
+    (Thread/sleep 1000)                                                                                                       ; give networking code some time to send outstanding messages
     (nrepl-tunnel-server/destroy! nrepl-tunnel-server)
     (set-nrepl-tunnel-server! tunnel nil))
   (close! (get-server-messages-channel tunnel))

diff --git a/src/lib/dirac/lib/version.clj b/src/lib/dirac/lib/version.clj
@@ -0,0 +1,4 @@
+(ns dirac.lib.version
+  (:require [dirac.version]))
+
+(def ^:dynamic version dirac.version/version)
diff --git a/src/nrepl/dirac/nrepl/middleware.clj b/src/nrepl/dirac/nrepl/middleware.clj
@@ -8,4 +8,8 @@
                  {:requires #{"clone"}
                   ; piggieback unconditionally hijacks eval and load-file
                   :expects  #{"eval" "load-file"}
-                  :handles  {}})
+                  :handles  {"identify-dirac-nrepl-middleware"
+                             {:doc "Checks for presence of Dirac nREPL middleware"
+                              :requires {}
+                              :optional {}
+                              :returns {"version" "Version of Dirac nREPL middleware."}}}})
diff --git a/src/nrepl/dirac/nrepl/piggieback.clj b/src/nrepl/dirac/nrepl/piggieback.clj
@@ -16,6 +16,7 @@
             [cljs.env :as env]
             [cljs.analyzer :as ana]
             [dirac.nrepl.driver :as driver]
+            [dirac.nrepl.version :refer [version]]
             [clojure.tools.logging :as log])
   (:import clojure.lang.LineNumberingPushbackReader
            java.io.StringReader
@@ -207,20 +208,27 @@
 (defn- load-file [{:keys [session transport file-path] :as msg}]
   (evaluate (assoc msg :code (format "(load-file %s)" (pr-str file-path)))))
 
+(defn identify-dirac-nrepl-middleware [msg]
+  (let [{:keys [transport]} msg]
+    (transport/send transport (response-for msg
+                                            :version version))))
+
 (defn wrap-cljs-repl [handler]
   (fn [{:keys [session op] :as msg}]
-    (let [handler (or (when-let [f (and (@session #'*cljs-repl-env*)
-                                        ({"eval" #'evaluate "load-file" #'load-file} op))]
-                        (fn [msg] (enqueue msg #(f msg))))
-                      handler)]
-      ; ensure that bindings exist so cljs-repl can set!
-      (when-not (contains? @session #'*cljs-repl-env*)
-        (swap! session (partial merge {#'*cljs-repl-env*     *cljs-repl-env*
-                                       #'*cljs-compiler-env* *cljs-compiler-env*
-                                       #'*cljs-repl-options* *cljs-repl-options*
-                                       #'*original-clj-ns*   *original-clj-ns*
-                                       #'ana/*cljs-ns*       ana/*cljs-ns*})))
-      (handler msg))))
+    (case op
+      "identify-dirac-nrepl-middleware" (identify-dirac-nrepl-middleware msg)
+      (let [handler (or (when-let [f (and (@session #'*cljs-repl-env*)
+                                          ({"eval" #'evaluate "load-file" #'load-file} op))]
+                          (fn [msg] (enqueue msg #(f msg))))
+                        handler)]
+        ; ensure that bindings exist so cljs-repl can set!
+        (when-not (contains? @session #'*cljs-repl-env*)
+          (swap! session (partial merge {#'*cljs-repl-env*     *cljs-repl-env*
+                                         #'*cljs-compiler-env* *cljs-compiler-env*
+                                         #'*cljs-repl-options* *cljs-repl-options*
+                                         #'*original-clj-ns*   *original-clj-ns*
+                                         #'ana/*cljs-ns*       ana/*cljs-ns*})))
+        (handler msg)))))
 
 (defn send-bootstrap-info! [server-url]
   (log/trace "send-bootstrap-info!" server-url)

diff --git a/src/nrepl/dirac/nrepl/version.clj b/src/nrepl/dirac/nrepl/version.clj
@@ -1,4 +1,4 @@
 (ns dirac.nrepl.version
   (:require [dirac.version]))
 
-(def version dirac.version/version)
+(def ^:dynamic version dirac.version/version)