cmdline.clj

(ns nrepl.cmdline
  "A proof-of-concept command-line client for nREPL.  Please see
  e.g. REPL-y for a proper command-line nREPL client @
  https://github.com/trptcolin/reply/"
  {:author "Chas Emerick"}
  (:require
   [clojure.edn :as edn]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [nrepl.config :as config]
   [nrepl.core :as nrepl]
   [nrepl.misc :refer [uuid]]
   [nrepl.server :as nrepl-server]
   [nrepl.socket :as socket]
   [nrepl.transport :as transport]
   [nrepl.util.threading :as threading]
   [nrepl.version :as version])
  (:import
   [java.io FileNotFoundException]))

(defn- clean-up-and-exit
  "Performs any necessary clean up and calls `(System/exit status)`."
  [status]
  (shutdown-agents)
  (flush)
  (binding [*out* *err*] (flush))
  (System/exit status))

(defn exit
  "Requests that the process exit with the given `status`.  Does not
  return."
  [status]
  ;; :nrepl/kind is our shared (ns independent) ExceptionInfo discriminator
  (throw (ex-info nil {:nrepl/kind ::exit ::status status})))

(defn die
  "`Print`s items in `msg` to *err* and then exits with a status of 2."
  [& msg]
  (binding [*out* *err*]
    (doseq [m msg] (print m)))
  (exit 2))

(defmacro ^{:author "Colin Jones"} set-signal-handler!
  [signal f]
  (if (try (Class/forName "sun.misc.Signal")
           (catch Throwable _e))
    `(try
       (sun.misc.Signal/handle
        (sun.misc.Signal. ~signal)
        (proxy [sun.misc.SignalHandler] []
          (handle [signal#] (~f signal#))))
       (catch Throwable e#))
    `(println "Unable to set signal handlers.")))

(def colored-output
  {:err #(binding [*out* *err*]
           (print "\033[31m")
           (print %)
           (print "\033[m")
           (flush))
   :out print
   :value (fn [x]
            (print "\033[34m")
            (print x)
            (println "\033[m")
            (flush))})

(def running-repl (atom {:transport nil
                         :client nil}))

(defn- done?
  [input]
  (some (partial = input)
        ['exit 'quit '(exit) '(quit)]))

(defn repl-intro
  "Returns nREPL interactive repl intro copy and version info as a new-line
  separated string."
  []
  (format "nREPL %s
Clojure %s
%s %s
Interrupt: Control+C
Exit:      Control+D or (exit) or (quit)"
          (:version-string version/version)
          (clojure-version)
          (System/getProperty "java.vm.name")
          (System/getProperty "java.runtime.version")))

(defn- run-repl-with-transport
  [transport {:keys [prompt err out value]
              :or   {prompt #(print (str % "=> "))
                     err    print
                     out    print
                     value  println}}]
  (let [client (nrepl/client transport Long/MAX_VALUE)
        awaiting (atom {})]
    (println (repl-intro))
    (threading/run-with @threading/transport-executor
      ;; Doesn't matter which executor we hijack here, just don't use `future`.
      (doseq [res (client)]
        (some-> (:out res) out)
        (some-> (:err res) err)
        (when-let [p (and (some #{:done "done"} (:status res))
                          (get @awaiting (:id res)))]
          (deliver p true))
        (when (some-> ^String (:id res)
                      (.startsWith "nrepl.cmdline-"))
          (some-> (:value res) value))
        (flush)))
    ;; We take 50ms to listen to any greeting messages, and display the value
    ;; in the `:out` slot.
    (Thread/sleep 50)
    (let [session (nrepl/client-session client)]
      (swap! running-repl assoc :transport transport :client session)
      (binding [*ns* *ns*]
        (loop []
          (prompt *ns*)
          (flush)
          (let [input (read *in* false 'exit)]
            (if (done? input)
              (clean-up-and-exit 0)
              ;; Make sure the metadata read from *in* is preserved when we feed
              ;; the form to nREPL.
              (let [code-str (binding [*print-meta* true]
                               (pr-str input))
                    id (str "nrepl.cmdline-" (uuid))]
                (swap! awaiting assoc id (promise))
                (doseq [res (nrepl/message session {:op "eval" :code code-str :id id})]
                  (when (:ns res) (set! *ns* (create-ns (symbol (:ns res))))))
                @(get @awaiting id)
                (swap! awaiting dissoc id)
                (recur)))))))))

(defn- run-repl
  ([{:keys [server options]}]
   (let [{:keys [host port socket] :or {host "127.0.0.1"}} server
         {:keys [transport tls-keys-file tls-keys-str] :or {transport #'transport/bencode}} options]
     (run-repl-with-transport
      (cond
        socket
        (nrepl/connect :socket socket :transport-fn transport)

        (and host port)
        (nrepl/connect :host host :port port :transport-fn transport :tls-keys-file tls-keys-file :tls-keys-str tls-keys-str)

        :else
        (die "Must supply host/port or socket."))
      options)))
  ([host port]
   (run-repl host port nil))
  ([host port options]
   (run-repl {:server  (cond-> {}
                         host (assoc :host host)
                         port (assoc :port port))
              :options options})))

(def ^:private option-shorthands
  {"-i" "--interactive"
   "-r" "--repl"
   "-f" "--repl-fn"
   "-c" "--connect"
   "-b" "--bind"
   "-h" "--host"
   "-p" "--port"
   "-s" "--socket"
   "-m" "--middleware"
   "-t" "--transport"
   "-n" "--handler"
   "-v" "--version"})

(def ^:private unary-options
  #{"--interactive"
    "--connect"
    "--color"
    "--help"
    "--version"
    "--verbose"})

(defn- expand-shorthands
  "Expand shorthand options into their full forms."
  [args]
  (map (fn [arg] (or (option-shorthands arg) arg)) args))

(defn- keywordize-options [options]
  (reduce-kv
   #(assoc %1 (keyword (str/replace-first %2 "--" "")) %3)
   {}
   options))

(defn- split-args
  "Convert `args` into a map of options + a list of args.
  Unary options are set to true during this transformation.
  Returns a vector combining the map and the list."
  [args]
  (loop [[arg & rem-args :as args] args
         options {}]
    (if-not (and arg (re-matches #"-.*" arg))
      [options args]
      (if (unary-options arg)
        (recur rem-args
               (assoc options arg true))
        (recur (rest rem-args)
               (assoc options arg (first rem-args)))))))

(defn help
  []
  ;; Updating this? Remember to also update server.adoc
  "Usage:

  -i/--interactive            Start nREPL and connect to it with the built-in client.
  -c/--connect                Connect to a running nREPL with the built-in client.
  -C/--color                  Use colors to differentiate values from output in the REPL. Must be combined with --interactive.
  -b/--bind ADDR              Bind address, by default \"127.0.0.1\".
  -h/--host ADDR              Host address to connect to when using --connect. Defaults to \"127.0.0.1\".
  -p/--port PORT              Start nREPL on PORT. Defaults to 0 (random port) if not specified.
  -s/--socket PATH            Start nREPL on filesystem socket at PATH or nREPL to connect to when using --connect.
  --ack ACK-PORT              Acknowledge the port of this server to another nREPL server running on ACK-PORT.
  -n/--handler HANDLER        The nREPL message handler to use for each incoming connection; defaults to the result of `(nrepl.server/default-handler)`. Must be expressed as a namespace-qualified symbol. The underlying var will be automatically `require`d.
  -m/--middleware MIDDLEWARE  A sequence of vars (expressed as namespace-qualified symbols), representing middleware you wish to mix in to the nREPL handler. The underlying vars will be automatically `require`d. If unavailable, the server will exit unless symbols are marked with ^:optional metadata.
  -t/--transport TRANSPORT    The transport to use (default `nrepl.transport/bencode`), expressed as a namespace-qualified symbol. The underlying var will be automatically `require`d.
  --help                      Show this help message.
  -v/--version                Display the nREPL version.
  --verbose                   Show verbose output.")

(defn- require-and-resolve
  "Attempts to resolve the config `key`'s `value` as a namespaced symbol
  and returns the related var if successful.  Otherwise calls `die`."
  [key sym]
  (when-not (symbol? sym)
    (die (format "nREPL %s: %s is not a symbol\n" (name key) (pr-str sym))))
  (let [space (some-> (namespace sym) symbol)]
    (when-not space
      (die (format "nREPL %s: %s has no namespace\n" (name key) sym)))
    (require space)
    (or (ns-resolve space (-> sym name symbol))
        (die (format "nREPL %s: unable to resolve %s\n" (name key) sym)))))

(defn- safe-require-and-resolve
  "Like require-and-resolve but returns nil when sym can't be resolved"
  [key sym]
  (if-let [space (and (symbol? sym) (namespace sym))]
    (try (require (symbol space))
         (ns-resolve (symbol space) (-> sym name symbol))
         (catch FileNotFoundException _))
    (die (format "nREPL %s: %s is not a qualified symbol\n" (name key) (pr-str sym)))))

(def ^:private resolve-mw-xf
  (comp (map #(if (-> % meta :optional)
                (safe-require-and-resolve :middleware %)
                (require-and-resolve :middleware %)))
        (keep identity)))

(defn- handle-seq-var
  [var]
  (let [x @var]
    (if (sequential? x)
      (into [] resolve-mw-xf x)
      [var])))

(defn- handle-interrupt
  [_signal]
  (let [transport (:transport @running-repl)
        client (:client @running-repl)]
    (if (and transport client)
      (doseq [res (nrepl/message client {:op "interrupt"})]
        (when (= ["done" "session-idle"] (:status res))
          (System/exit 0)))
      (System/exit 0))))

(def ^:private mw-xf
  (comp (map symbol)
        resolve-mw-xf
        (mapcat handle-seq-var)))

(defn- ->mw-list
  [middleware-var-strs]
  (into [] mw-xf middleware-var-strs))

(defn- build-handler
  "Build an nREPL handler from `middleware`.
  `middleware` is a sequence of vars or string which can be resolved
  to vars, representing middleware you wish to mix in to the nREPL
  handler. Vars can resolve to a sequence of vars, in which case
  they'll be flattened into the list of middleware."
  [middleware]
  (apply nrepl.server/default-handler (->mw-list middleware)))

(defn- ->int [x]
  (cond
    (nil? x) x
    (number? x) x
    :else (Integer/parseInt x)))

(defn- sanitize-middleware-option
  "Sanitize the middleware option.  In the config it can be either a
  symbol or a vector of symbols."
  [mw-opt]
  (if (symbol? mw-opt)
    [mw-opt]
    mw-opt))

(defn parse-cli-values
  "Converts relevant command line argument values to their config
  representation."
  [options]
  (reduce-kv (fn [result k v]
               (case k
                 (:handler :transport :middleware) (assoc result k (edn/read-string v))
                 result))
             options
             options))

(defn- meta-merge
  "Metadata-aware function used for specifying merge behavior."
  [config-opt cli-opt]
  (if (some (comp :concat meta) [config-opt cli-opt]) (into config-opt cli-opt) cli-opt))

(defn args->cli-options
  "Takes CLI args list and returns vector of parsed options map and
  remaining args."
  [args]
  (let [[options _args] (split-args (expand-shorthands args))
        merge-config (partial merge-with meta-merge config/config)
        options (-> options
                    (keywordize-options)
                    (parse-cli-values)
                    (merge-config))]
    [options _args]))

(defn display-help
  "Prints the help copy to the screen and exits the program with exit code 0."
  []
  (println (help))
  (exit 0))

(defn display-version
  "Prints nREPL version to the screen and exits the program with exit code 0."
  []
  (println (:version-string version/version))
  (exit 0))

(defn- options->transport
  "Takes a map of nREPL CLI options.
  Returns either a default transport or the value of :transport."
  [options]
  (or (some->> options
               (:transport)
               (require-and-resolve :transport))
      #'transport/bencode))

(defn- options->handler
  "Takes a map of nREPL CLI options and list of middleware.
  Returns a request handler function.
  If some handler was explicitly passed we'll use it, otherwise we'll build
  one from whatever was passed via --middleware"
  [options middleware]
  (or (some->> options
               (:handler)
               (require-and-resolve :handler))
      (build-handler middleware)))

(defn- options->ack-port
  "Takes a map of nREPL CLI options.
  Returns integer ack port or nil."
  [options]
  (->int (:ack options)))

(defn- options->repl-fn
  "Takes a map of nREPL CLI options.
  Returns either the :repl-fn config option or uses run-repl."
  [options]
  (or (some->> options
               (:repl-fn)
               (symbol)
               (require-and-resolve :repl-fn))
      #'run-repl))

(defn- options->greeting
  "Takes a map of nREPL CLI options and the selected transport for the server.
  Returns a greeting function or nil."
  [_options transport]
  (when (= transport #'transport/tty)
    #'transport/tty-greeting))

(defn connection-opts
  "Takes map of nREPL CLI options
  Returns map of processed options used to connect or start a nREPL server."
  [options]
  {:port (->int (:port options))
   :host (:host options)
   :socket (:socket options)
   :transport (options->transport options)
   :repl-fn (options->repl-fn options)
   :tls-keys-str (:tls-keys-str options)
   :tls-keys-file (:tls-keys-file options)})

(defn server-opts
  "Takes a map of nREPL CLI options
  Returns map of processed options to start an nREPL server."
  [options]
  (let [middleware (sanitize-middleware-option (:middleware options))
        {:keys [host port socket transport tls-keys-str tls-keys-file]} (connection-opts options)]
    (merge options
           {:host host
            :port port
            :socket socket
            :transport transport
            :bind (:bind options)
            :middleware middleware
            :tls-keys-str tls-keys-str
            :tls-keys-file tls-keys-file
            :handler (options->handler options middleware)
            :greeting (options->greeting options transport)
            :ack-port (options->ack-port options)
            :repl-fn (options->repl-fn options)})))

(defn interactive-repl
  "Runs an interactive repl if :interactive CLI option is true otherwise
  puts the current thread to sleep
  Takes nREPL server map and processed CLI options map.
  Returns nil."
  [server options]
  (let [transport (:transport options)
        repl-fn (:repl-fn options)
        socket (:socket server)
        host (:host server)
        port (:port server)]
    (when (= transport #'transport/tty)
      (die "The built-in client does not support the tty transport. Consider using `nc` or `telnet`.\n"))
    (if socket
      (repl-fn {:server  server
                :options (merge (when (:color options) colored-output)
                                {:transport transport})})
      (repl-fn host port
               (merge (when (:color options) colored-output)
                      {:transport transport}
                      (select-keys options [:tls-keys-str :tls-keys-file]))))))

(defn connect-to-server
  "Connects to a running nREPL server and runs a REPL. Exits program when REPL
  is closed.
  Takes a map of nREPL CLI options."
  [{:keys [host port socket] :as options}]
  (interactive-repl {:host   host
                     :port   port
                     :socket socket}
                    options)
  (exit 0))

(defn server-started-message
  "Returns nREPL server started message that some tools rely on to parse the
  connection details from.
  Takes nREPL server map and processed CLI options map.
  Returns connection header string."
  [{:keys [host port socket] :as server} options]
  (let [transport (:transport options)
        ^java.net.URI uri (socket/as-nrepl-uri server (transport/uri-scheme transport))]
    ;; The format here is important, as some tools (e.g. CIDER) parse the string
    ;; to extract from it the host and the port to connect to
    (if socket
      (str "nREPL server started on socket " (.toASCIIString uri))
      (format "nREPL server started on port %d on host %s - %s"
              port host uri))))

(defn save-port-file
  "Writes a file relative to project classpath with port number so other tools
  can infer the nREPL server port.
  Takes nREPL server map and processed CLI options map.
  Returns nil."
  [server _options]
  ;; Many clients look for this file to infer the port to connect to
  (let [port (:port server)
        port-file (io/file ".nrepl-port")]
    (.deleteOnExit ^java.io.File port-file)
    (spit port-file port)))

(defn start-server
  "Creates an nREPL server instance.
  Takes map of CLI options.
  Returns nREPL server map."
  [{:keys [port bind socket handler transport greeting ack-port tls-keys-str tls-keys-file]}]
  (nrepl-server/start-server
   :port port
   :bind bind
   :socket socket
   :handler handler
   :transport-fn transport
   :greeting-fn greeting
   :ack-port ack-port
   :tls-keys-str tls-keys-str
   :tls-keys-file tls-keys-file))

(defn dispatch-commands
  "Look at options to dispatch a specified command.
  Takes CLI options map. May return a server map, nil, or exit."
  [options]
  (cond (:help options)    (display-help)
        (:version options) (display-version)
        (:connect options) (connect-to-server (connection-opts options))
        :else (let [options (server-opts options)
                    server (start-server options)]
                (println (server-started-message server options))
                (save-port-file server options)
                (if (:interactive options)
                  (interactive-repl server options)
                  ;; Lock the main thread to prevent process from quitting while
                  ;; the server is running.
                  (.join (Thread/currentThread))))))

(defn -main
  [& args]
  (try
    (set-signal-handler! "INT" handle-interrupt)
    (let [[options _args] (args->cli-options args)]
      (dispatch-commands options))
    (catch clojure.lang.ExceptionInfo ex
      (let [{:keys [:nrepl/kind ::status]} (ex-data ex)]
        (case kind
          ::exit (clean-up-and-exit status)
          (:nrepl.server/no-filesystem-sockets
           :nrepl.server/invalid-start-request)
          (do
            (binding [*out* *err*]
              (println (.getMessage ex)))
            (clean-up-and-exit 2))
          (throw ex))))))