├── partial-nrepl-nrepl-port ├── test-resources │ ├── ping_imp.clj │ └── ping.clj ├── README.md ├── docs │ ├── deps.png │ ├── test-deps.png │ ├── deps.dot │ └── test-deps.dot ├── load-file-test │ └── nrepl │ │ ├── load_file_sample2.clj │ │ └── load_file_sample.clj └── src │ ├── main │ └── clojure │ │ └── cnrepl │ │ ├── debug.clj │ │ ├── socket.clj │ │ ├── util │ │ ├── lookup.clj │ │ └── print.clj │ │ ├── ack.clj │ │ ├── version.clj │ │ ├── config.clj │ │ ├── helpers.clj │ │ ├── middleware │ │ ├── lookup.clj │ │ ├── completion.clj │ │ ├── caught.clj │ │ ├── dynamic_loader.clj │ │ ├── load_file.clj │ │ ├── sideloader.clj │ │ └── interruptible_eval.clj │ │ ├── sync_channel.clj │ │ ├── misc.clj │ │ ├── middleware.clj │ │ ├── server.clj │ │ ├── tls.clj │ │ └── core.clj │ └── test │ └── clojure │ └── cnrepl │ ├── misc_test.clj │ ├── test_helper.clj │ ├── edn_test.clj │ ├── response_test.clj │ ├── transport_test.clj │ ├── middleware │ ├── completion_test.clj │ ├── lookup_test.clj │ ├── load_file_test.clj │ └── print_test.clj │ ├── describe_test.clj │ ├── util │ ├── lookup_test.clj │ └── completion_test.clj │ ├── middleware_test.clj │ ├── sanity_test.clj │ ├── test_test.clj │ ├── core_test.clj │ └── bencode_test.clj ├── src ├── test │ └── clojure │ │ ├── cheshire │ │ └── core.cljc │ │ └── clojure │ │ └── tools │ │ └── nrepl │ │ └── test_utils.cljr └── main │ ├── dotnet │ └── packager │ │ ├── .vs │ │ └── clojure.tools.nrepl │ │ │ ├── v17 │ │ │ └── .futdcache.v2 │ │ │ └── DesignTimeBuild │ │ │ └── .dtbcache.v2 │ │ └── clojure.tools.nrepl.csproj │ └── clojure │ └── clojure │ └── tools │ ├── nrepl.cljr │ └── nrepl │ ├── impl │ └── utils.cljr │ └── server │ └── middleware.cljr ├── .gitignore ├── deps.edn ├── CONTRIBUTING.md ├── project.clj ├── README.md └── epl.html /partial-nrepl-nrepl-port/test-resources/ping_imp.clj: -------------------------------------------------------------------------------- 1 | (ns ping-imp) 2 | 3 | (defn pong [] "pong-deferred") -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/README.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojure/clr.tools.nrepl/master/partial-nrepl-nrepl-port/README.md -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/docs/deps.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojure/clr.tools.nrepl/master/partial-nrepl-nrepl-port/docs/deps.png -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/docs/test-deps.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojure/clr.tools.nrepl/master/partial-nrepl-nrepl-port/docs/test-deps.png -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/load-file-test/nrepl/load_file_sample2.clj: -------------------------------------------------------------------------------- 1 | (ns nrepl.load-file-sample2) 2 | 3 | (System.Threading.Thread/Sleep 10000) ;;; Thread/sleep -------------------------------------------------------------------------------- /src/test/clojure/cheshire/core.cljc: -------------------------------------------------------------------------------- 1 | (ns cheshire.core) 2 | 3 | ;; dummy namsepace for testing 4 | 5 | (defn generate-string [] "42") 6 | 7 | (defn somethingelse [x] (not x)) 8 | -------------------------------------------------------------------------------- /src/main/dotnet/packager/.vs/clojure.tools.nrepl/v17/.futdcache.v2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojure/clr.tools.nrepl/master/src/main/dotnet/packager/.vs/clojure.tools.nrepl/v17/.futdcache.v2 -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/load-file-test/nrepl/load_file_sample.clj: -------------------------------------------------------------------------------- 1 | (ns nrepl.load-file-sample) 2 | 3 | 4 | 5 | (defn dfunction 6 | "Ensure \t that \n the \r various \f escapes \" work \\ as expected \\\"" 7 | []) -------------------------------------------------------------------------------- /src/main/dotnet/packager/.vs/clojure.tools.nrepl/DesignTimeBuild/.dtbcache.v2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clojure/clr.tools.nrepl/master/src/main/dotnet/packager/.vs/clojure.tools.nrepl/DesignTimeBuild/.dtbcache.v2 -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | /lib/ 3 | /classes/ 4 | /targets/ 5 | /target 6 | /classes 7 | /checkouts 8 | *.jar 9 | *.class 10 | *.dll 11 | *.pdb 12 | *.exe 13 | .lein-deps-sum 14 | .lein-failures 15 | .lein-plugins 16 | .vs 17 | .cpcache 18 | 19 | #Visual Studio artifacts 20 | bin 21 | obj 22 | *.user 23 | *.suo 24 | *.nupkg 25 | .vs -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/debug.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.debug) 2 | 3 | (def ^{:private true} pr-agent (agent *out*)) 4 | 5 | (defn- write-out [out & args] 6 | (binding [*out* out] 7 | (pr "Thd " (-> System.Threading.Thread/CurrentThread (.ManagedThreadId)) ": ") 8 | (prn (apply str args)) 9 | out)) 10 | 11 | (defn prn-thread [& args] 12 | (send pr-agent write-out args)) 13 | 14 | 15 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src/main/clojure"] 2 | :deps { io.github.clojure/clr.tools.reader {:git/tag "v1.4.2" :git/sha "c1186e3"} } 3 | :aliases 4 | {:test 5 | {:extra-paths ["src/test/clojure"] 6 | :extra-deps {io.github.dmiller/test-runner {:git/tag "v0.5.1clr" :git/sha "814e06f"}} 7 | ;; :main-opts {"-m" "cognitect.test-runner" "-d" "src/test/clojure"} 8 | :exec-fn cognitect.test-runner.api/test 9 | :exec-args {:dirs ["src/test/clojure"]}}} 10 | } 11 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This is a [Clojure contrib] project. 2 | 3 | Under the Clojure contrib [guidelines], this project cannot accept 4 | pull requests. All patches must be submitted via [JIRA]. 5 | 6 | See [Contributing] and the [FAQ] on the Clojure development [wiki] for 7 | more information on how to contribute. 8 | 9 | [Clojure contrib]: http://dev.clojure.org/display/doc/Clojure+Contrib 10 | [Contributing]: http://dev.clojure.org/display/community/Contributing 11 | [FAQ]: http://dev.clojure.org/display/community/Contributing+FAQ 12 | [JIRA]: http://dev.clojure.org/jira/browse/NREPL 13 | [guidelines]: http://dev.clojure.org/display/community/Guidelines+for+Clojure+Contrib+committers 14 | [wiki]: http://dev.clojure.org/ -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/misc_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.misc-test 2 | (:require [clojure.test :refer [deftest is]] 3 | [cnrepl.misc :as misc] 4 | [clojure.clr.io :as io]) ;;; clojure.java.io 5 | ) ;;; (:import [java.net URL]) 6 | 7 | (deftest sanitize-meta-test 8 | (is (not-empty (:file (misc/sanitize-meta {:file "clojure/core.clj"})))) 9 | 10 | (is (= "/foo/bar/baz.clj" 11 | (:file (misc/sanitize-meta {:file "/foo/bar/baz.clj"})))) 12 | 13 | (is (= "/foo/bar/baz.clj" 14 | (:file (misc/sanitize-meta {:file (io/as-file "/foo/bar/baz.clj")})))) ;;; io/file 15 | 16 | (is (= "https://foo.bar/" ;;; "https://foo.bar" -- I don't know ny System.Uri ctor adds the / 17 | (:file (misc/sanitize-meta {:file (System.Uri. "https://foo.bar")}))))) ;;; URL. -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/test_helper.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | ; 9 | 10 | ;; clojure.test-helper 11 | ;; 12 | ;; Utility functions shared by various tests in the Clojure 13 | ;; test suite 14 | ;; 15 | ;; tomfaulhaber (gmail) 16 | ;; Created 04 November 2010 17 | 18 | 19 | ;;; A small piece copied from the Clojure test suite 20 | 21 | (ns cnrepl.test-helper 22 | (:use clojure.test)) 23 | 24 | (let [nl Environment/NewLine] ;;; (System/getProperty "line.separator")] 25 | (defn platform-newlines [s] (.Replace s "\n" nl))) ;;; .replace 26 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/socket.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.socket 2 | "Compatibility layer for java.io vs java.nio sockets to allow an 3 | incremental transition to nio, since the JDK's filesystem sockets 4 | don't support the java.io socket interface, and we can't use the 5 | compatibility layer for bidirectional read and write: 6 | https://bugs.openjdk.java.net/browse/JDK-4509080." 7 | #_(:require 8 | [clojure.java.io :as io] 9 | [nrepl.misc :refer [log]] 10 | [nrepl.tls :as tls] 11 | [nrepl.socket.dynamic :refer [get-path]]) 12 | #_(:import 13 | (java.io BufferedInputStream BufferedOutputStream File OutputStream) 14 | (java.net InetSocketAddress ProtocolFamily ServerSocket Socket SocketAddress 15 | StandardProtocolFamily URI) 16 | (java.nio ByteBuffer) 17 | (java.nio.file Path) 18 | (java.nio.channels Channels ClosedChannelException NetworkChannel 19 | ServerSocketChannel SocketChannel) 20 | (javax.net.ssl SSLServerSocket))) 21 | 22 | 23 | ;;; I don't have the time, energy, or patience to deal with this at this time. Anyone else? ;;; 24 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/edn_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.edn-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [cnrepl.core :as nrepl] 4 | [cnrepl.server :as server] 5 | [cnrepl.transport :as transport]) 6 | (:import 7 | (cnrepl.server Server))) 8 | 9 | (defn return-evaluation 10 | [message] 11 | (with-open [^Server server (server/start-server :transport-fn transport/edn)] 12 | (with-open [^nrepl.transport.FnTransport 13 | conn (nrepl/connect :transport-fn transport/edn 14 | :port (:port server))] 15 | (-> (nrepl/client conn 1000) 16 | (nrepl/message message) 17 | nrepl/response-values)))) 18 | 19 | (deftest edn-transport-communication 20 | (testing "op as a string value" 21 | (is (= (return-evaluation {:op "eval" :code "(+ 2 3)"}) 22 | [5]))) 23 | (testing "op as a keyword value" 24 | (is (= (return-evaluation {:op :eval :code "(+ 2 3)"}) 25 | [5]))) 26 | (testing "simple expressions" 27 | (is (= (return-evaluation {:op "eval" :code "(range 40)"}) 28 | [(eval '(range 40))])))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/util/lookup.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.util.lookup 2 | "Symbol info lookup. 3 | 4 | It's meant to provide you with useful data like definition location, 5 | parameter lists, etc. 6 | 7 | NOTE: The functionality here is experimental and 8 | the API is subject to changes." 9 | {:author "Bozhidar Batsov" 10 | :added "0.8"} 11 | (:require 12 | [cnrepl.misc :as misc])) 13 | 14 | (defn special-sym-meta 15 | [sym] 16 | ;; clojure.repl/special-doc is private, so we need to work a 17 | ;; bit to be able to invoke it 18 | (let [f (misc/requiring-resolve 'clojure.repl/special-doc)] 19 | (assoc (f sym) 20 | :ns "clojure.core" 21 | :file "clojure/core.clj" 22 | :special-form "true"))) 23 | 24 | (defn normal-sym-meta 25 | [ns sym] 26 | (some-> (ns-resolve ns sym) meta)) 27 | 28 | (defn sym-meta 29 | [ns sym] 30 | (if (special-symbol? sym) 31 | (special-sym-meta sym) 32 | (normal-sym-meta ns sym))) 33 | 34 | (defn lookup 35 | "Lookup the metadata for `sym`. 36 | If the `sym` is not qualified than it will be resolved in the context 37 | of `ns`." 38 | [ns sym] 39 | (some-> (sym-meta ns sym) misc/sanitize-meta)) -------------------------------------------------------------------------------- /src/main/dotnet/packager/clojure.tools.nrepl.csproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | netstandard2.0;netstandard2.1 5 | 6 | 7 | 8 | clojure.tools.nrepl 9 | clojure.tools 10 | clojure.tools.nrepl 11 | clojure.tools.nrepl 12 | clojure.tools.nrepl 13 | ClojureCLR Contributors 14 | A port of babashka/babashka.nrepl to ClojureCLR 15 | Copyright © Rich Hickey, Michiel Borkent, ClojureCLR Contributors 2024 16 | EPL-1.0 17 | https://github.com/clojure/clr.tools.namesapce 18 | ClojureCLR contributors 19 | Clojure;ClojureCLR 20 | 0.1.0-alpha2 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/response_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.response-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [cnrepl.core :as nrepl] 5 | [cnrepl.transport :as t]) 6 | #_(:import 7 | (java.util.concurrent BlockingQueue LinkedBlockingQueue TimeUnit))) 8 | 9 | (deftest response-seq 10 | (let [[local remote] (t/piped-transports)] 11 | (doseq [x (range 10)] (t/send remote x)) 12 | (is (= (range 10) (nrepl/response-seq local 0))) 13 | 14 | ;; ensure timeouts don't capture later responses 15 | (nrepl/response-seq local 100) 16 | (doseq [x (range 10)] (t/send remote x)) 17 | (is (= (range 10) (nrepl/response-seq local 0))))) 18 | 19 | (deftest client 20 | (let [[local remote] (t/piped-transports)] 21 | (doseq [x (range 10)] (t/send remote x)) 22 | (is (= (range 10) ((nrepl/client local 100) 17))) 23 | (is (= 17 (t/recv remote))))) 24 | 25 | (deftest client-heads 26 | (let [[local remote] (t/piped-transports) 27 | client1 (nrepl/client local Int32/MaxValue) ;;; Long/MAX_VALUE, switched from Int64 to Int32 because timeout value in client is Int32 28 | all-seq (client1)] 29 | (doseq [x (range 10)] (t/send remote x)) 30 | (is (= [0 1 2] (take 3 all-seq))) 31 | (is (= (range 3 7) (take 4 (client1 :a)))) 32 | (is (= :a (t/recv remote))) 33 | (is (= (range 10) (take 10 all-seq))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/docs/deps.dot: -------------------------------------------------------------------------------- 1 | strict digraph G { 2 | 3 | rankdir = RL; 4 | 5 | /* here start the interfaces */ 6 | 7 | node [shape=box]; 8 | 9 | 10 | bencode; 11 | config; 12 | misc; 13 | version; 14 | middleware -> { misc, transport, version}; 15 | 16 | transport -> {bencode, misc, version}; 17 | 18 | 19 | 20 | 21 | 22 | 23 | helpers -> { "mw.load-file" } 24 | server -> {ack, middleware, "mw.dynamic-loader", "mw.completion", 25 | "mw.interruptible-eval", "mw.load-file", 26 | "mw.lookup", "mw.session", "mw.sideloader", misc, transport}; 27 | 28 | 29 | 30 | "util.completion" -> {misc}; 31 | "util.lookup" -> {misc}; 32 | "util.print"; 33 | 34 | 35 | 36 | "mw.caught" -> {middleware, "mw.print", misc, transport}; 37 | "mw.completion" -> {"util.completion", middleware, misc, transport}; 38 | "mw.dynamic-loader" -> {middleware, "mw.session", misc, transport}; 39 | "mw.interruptible-eval" -> {middleware, "mw.caught", "mw.print", misc, transport}; 40 | "mw.load-file" -> {middleware, "mw.caught", "mw.interruptible-eval", "mw.print", transport}; 41 | "mw.lookup" -> {middleware, misc, "util.lookup", transport}; 42 | "mw.print" -> {middleware, misc, transport}; 43 | "mw.session" -> {middleware "mw.interruptible-eval", misc, transport}; 44 | "mw.sideloader" -> {middleware, misc, transport}; 45 | 46 | 47 | ack -> {core, transport }; 48 | 49 | cmdline -> {config, core, ack, server, transport, version}; 50 | 51 | core -> { misc, transport, version }; 52 | 53 | 54 | } 55 | 56 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/test-resources/ping.clj: -------------------------------------------------------------------------------- 1 | (ns ping 2 | "This provides an example of a middleware, including a deferred handler 3 | that's not loaded until called. This is representative of how cider-nrepl 4 | and refactor-nrepl handles deferred loading" 5 | (:require [cnrepl.middleware :as middleware :refer [set-descriptor!]] 6 | [cnrepl.misc :as misc :refer [response-for]] 7 | [cnrepl.transport :as t])) 8 | 9 | (def deferred-handler 10 | (delay 11 | (fn [{:keys [transport] :as msg}] 12 | (t/send transport (response-for msg 13 | {:pong 14 | ((misc/requiring-resolve (symbol "ping-imp/pong"))) 15 | :status :done}))))) 16 | 17 | (defn wrap-ping 18 | [h] 19 | (fn [{:keys [op transport] :as msg}] 20 | (case op 21 | "ping" 22 | (t/send transport (response-for msg {:pong "pong" 23 | :status :done})) 24 | "deferred-ping" 25 | (@deferred-handler msg) 26 | 27 | (h msg)))) 28 | 29 | (set-descriptor! #'wrap-ping 30 | {:requires #{} 31 | :expects #{} 32 | :handles {"ping" 33 | {:doc "Ping" 34 | :requires {} 35 | :returns {"status" "done"}} 36 | "deferred-ping" 37 | {:doc "Ping" 38 | :requires {} 39 | :returns {"status" "done"}}}}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/util/print.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.util.print 2 | "Pretty-print related utilities. 3 | All functions here are simple wrappers compatible with the expectations of 4 | nrepl.middleware.print/wrap-print." 5 | {:added "0.8"} 6 | (:refer-clojure :exclude [pr]) 7 | (:require 8 | [clojure.pprint :as pp])) 9 | 10 | (def ^:private pr-options 11 | [:print-dup 12 | :print-readably 13 | :print-length 14 | :print-level 15 | :print-meta 16 | :print-namespace-maps]) 17 | 18 | (defn- option->var 19 | [option] 20 | (resolve (symbol "clojure.core" (str "*" (name option) "*")))) 21 | 22 | (defn- pr-bindings 23 | [options] 24 | (->> (select-keys options pr-options) 25 | (into {} (keep (fn [[option value]] 26 | (when-let [var (option->var option)] 27 | [var value])))))) 28 | 29 | (defn pr 30 | "Equivalent to `clojure.core/pr`. Any options corresponding to dynamic 31 | printing configuration vars in `clojure.core` will, if provided, be bound 32 | accordingly (e.g. `clojure.core/*print-length*` will be used if 33 | `:print-length` is provided)." 34 | ([value writer] 35 | (pr value writer nil)) 36 | ([value writer options] 37 | (with-bindings (pr-bindings options) 38 | (if *print-dup* 39 | (print-dup value writer) 40 | (print-method value writer))))) 41 | 42 | (defn pprint 43 | "A simple wrapper around `clojure.pprint/write`." 44 | ([value writer] 45 | (pprint value writer {})) 46 | ([value writer options] 47 | (apply pp/write value (mapcat identity (assoc options :stream writer))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/transport_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.transport-test 2 | (:require [cnrepl.transport :as sut] 3 | [clojure.test :refer [deftest testing is]]) 4 | (:import [System.IO MemoryStream])) ;;; [java.io ByteArrayOutputStream] 5 | 6 | (deftest bencode-safe-write-test 7 | (testing "safe-write-bencode only writes if the whole message is writable" 8 | (let [out (MemoryStream.)] ;;; ByteArrayOutputStream. 9 | (is (thrown? ArgumentException ;;; IllegalArgumentException 10 | (#'sut/safe-write-bencode out {"obj" (Object.)}))) 11 | (is (empty? (.ToArray out)))))) ;;; .toByteArray 12 | 13 | (deftest tty-read-conditional-test 14 | (testing "tty-read-msg is configured to read conditionals" 15 | (let [in (-> "(try nil (catch #?(:clj Throwable :cljr Exception) e nil))" 16 | (#(MemoryStream. (.GetBytes System.Text.Encoding/UTF8 %))) ;;; (java.io.StringReader.) 17 | (clojure.lang.PushbackInputStream.)) ;;; (java.io.PushbackReader.) 18 | out (MemoryStream.)] ;;; (ByteArrayOutputStream.) 19 | (is (= ['(try nil (catch Exception e nil))] ;;; Throwable 20 | (let [^cnrepl.transport.FnTransport fn-transport (sut/tty in out nil)] 21 | (.recv fn-transport) ;; :op "clone" 22 | (-> (.recv fn-transport) ;; :op "eval" 23 | :code))))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/middleware/completion_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.completion-test 2 | {:author "Bozhidar Batsov"} 3 | (:require 4 | [clojure.test :refer :all] 5 | [cnrepl.core :as cnrepl] 6 | [cnrepl.core-test :refer [def-repl-test repl-server-fixture project-base-dir clean-response]]) 7 | (:import 8 | )) ;;; not used? (java.io File) 9 | 10 | (use-fixtures :each repl-server-fixture) 11 | 12 | (defn dummy-completion [prefix _ns _options] 13 | [{:candidate prefix}]) 14 | 15 | (def-repl-test completions-op 16 | (let [result (-> (cnrepl/message session {:op "completions" :prefix "map" :ns "clojure.core"}) 17 | cnrepl/combine-responses 18 | clean-response 19 | (select-keys [:completions :status]))] 20 | (is (= #{:done} (:status result))) 21 | (is (not-empty (:completions result))))) 22 | 23 | (def-repl-test completions-op-error 24 | (let [result (-> (cnrepl/message session {:op "completions"}) 25 | cnrepl/combine-responses 26 | clean-response 27 | (select-keys [:completions :status]))] 28 | (is (= #{:done :completion-error :namespace-not-found} (:status result))))) 29 | 30 | (def-repl-test completions-op-custom-fn 31 | (let [result (-> (cnrepl/message session {:op "completions" :prefix "map" :ns "clojure.core" :complete-fn "cnrepl.middleware.completion-test/dummy-completion"}) 32 | cnrepl/combine-responses 33 | clean-response 34 | (select-keys [:completions :status]))] 35 | (is (= #{:done} (:status result))) 36 | (is (= [{:candidate "map"}] (:completions result))))) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/nrepl.cljr: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.nrepl 2 | {:author "Michiel Borkent, modified for ClojureCLR by David Miller"} 3 | (:require [clojure.tools.nrepl.impl.server :as server] 4 | [clojure.tools.nrepl.server.middleware :as middleware] 5 | [clojure.string :as string]) 6 | (:import [System.Net Dns IPEndPoint IPAddress] 7 | [System.Net.Sockets TcpListener] )) 8 | 9 | (set! *warn-on-reflection* true) 10 | 11 | (defn stop-server! [{:keys [socket]}] 12 | (.Stop ^TcpListener socket)) 13 | 14 | (defn parse-opt [host+port] 15 | (let [parts (string/split host+port #":") 16 | [host port] (if (= 1 (count parts)) 17 | [nil (Int64/Parse ^String (first parts))] 18 | [(first parts) 19 | (Int64/Parse ^String (second parts))])] 20 | {:host host 21 | :port port})) 22 | 23 | (defn start-server! [& [{:keys [host port quiet] 24 | :or {host "127.0.0.1" 25 | port 1667} 26 | :as opts}]] 27 | (let [ctx (assoc {} :sessions (atom #{})) 28 | opts (assoc opts :xform 29 | (get opts :xform 30 | middleware/default-xform)) 31 | host-entry (Dns/GetHostEntry ^String host) 32 | ip-address (first (.AddressList host-entry)) 33 | ip-endpoint (IPEndPoint. ^IPAddress ip-address (int port)) 34 | tcp-listener (doto (TcpListener. ip-endpoint) (.Start)) ;; start required here in order to pick up .LocalEndPoint 35 | local-port (.Port ^IPEndPoint (.LocalEndPoint (.Server tcp-listener)))] 36 | (when-not quiet 37 | (println (format "Started nREPL server at %s:%d" (.Address ip-endpoint) local-port))) 38 | {:socket tcp-listener 39 | :future (future 40 | (server/listen ctx tcp-listener opts))})) 41 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/describe_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.describe-test 2 | {:author "Chas Emerick"} 3 | (:require 4 | [clojure.test :refer [is testing use-fixtures]] 5 | [cnrepl.core :as cnrepl] 6 | [cnrepl.core-test :refer [def-repl-test repl-server-fixture]] 7 | [cnrepl.middleware :as middleware] 8 | [cnrepl.server :as server] 9 | [cnrepl.version :as version])) 10 | 11 | (use-fixtures :once repl-server-fixture) 12 | 13 | (def-repl-test simple-describe 14 | (let [{{:keys [nrepl clojure java]} :versions 15 | ops :ops} (cnrepl/combine-responses 16 | (cnrepl/message timeout-client {:op "describe"}))] 17 | (testing "versions" 18 | (when-not (every? #(contains? java %) [:major :minor :incremental ]) ;;; removed :update 19 | (println "Got less information out of `java.version` than we'd like:" 20 | (.ToString Environment/Version) "=>" java)) ;;; (System/getProperty "java.version") 21 | (is (= (#'middleware/safe-version version/version) nrepl)) 22 | (is (= (#'middleware/safe-version *clojure-version*) (dissoc clojure :version-string))) 23 | (is (= (clojure-version) (:version-string clojure))) 24 | (is (= (.ToString Environment/Version) (:version-string java)))) ;;; (System/getProperty "java.version") 25 | 26 | (is (= server/built-in-ops (set (map name (keys ops))))) 27 | (is (every? empty? (map val ops))))) 28 | 29 | (def-repl-test verbose-describe 30 | (let [{:keys [ops aux]} (cnrepl/combine-responses 31 | (cnrepl/message timeout-client 32 | {:op "describe" :verbose? "true"}))] 33 | (is (= server/built-in-ops (set (map name (keys ops))))) 34 | (is (every? seq (map (comp :doc val) ops))) 35 | (is (= {:current-ns "user"} aux)))) -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojure.clr/tools.nrepl "0.1.0-alpha2" 2 | :description "Port of https://github.com/babashka/babashka.nrepl to ClojureCLR" 3 | :url "https://github.com/clojure/clr.tools.nrepl" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure.clr/tools.reader "1.4.2"]] 7 | :source-paths ["src/main/clojure"] 8 | :test-paths ["src/test/clojure"] 9 | :min-lein-version "2.0.0" 10 | :plugins [[lein-clr "0.2.0"]] 11 | :deploy-repositories [["clojars" {:url "https://clojars.org/repo/" 12 | :sign-releases false}]] 13 | :clr {:cmd-templates {:clj-exe [#_"mono" [CLJCLR15_40 %1]] 14 | :clj-dep [#_"mono" ["target/clr/clj/Debug 4.0" %1]] 15 | :clj-url "https://github.com/downloads/clojure/clojure-clr/clojure-clr-1.4.0-Debug-4.0.zip" 16 | :clj-zip "clojure-clr-1.4.0-Debug-4.0.zip" 17 | :curl ["curl" "--insecure" "-f" "-L" "-o" %1 %2] 18 | :nuget-ver [#_"mono" [*PATH "nuget.exe"] "install" %1 "-Version" %2] 19 | :nuget-any [#_"mono" [*PATH "nuget.exe"] "install" %1] 20 | :unzip ["unzip" "-d" %1 %2] 21 | :wget ["wget" "--no-check-certificate" "--no-clobber" "-O" %1 %2]} 22 | ;; for automatic download/unzip of ClojureCLR, 23 | ;; 1. make sure you have curl or wget installed and on PATH, 24 | ;; 2. uncomment deps in :deps-cmds, and 25 | ;; 3. use :clj-dep instead of :clj-exe in :main-cmd and :compile-cmd 26 | :deps-cmds [; [:wget :clj-zip :clj-url] ; edit to use :curl instead of :wget 27 | ; [:unzip "../clj" :clj-zip] 28 | ] 29 | :main-cmd [:clj-exe "Clojure.Main.exe"] 30 | :compile-cmd [:clj-exe "Clojure.Compile.exe"]}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/ack.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.ack 2 | (:require 3 | [cnrepl.core :as nrepl] 4 | [cnrepl.transport :as t])) 5 | 6 | ;; could be a lot fancier, but it'll do for now 7 | (def ^{:private true} ack-port-promise (atom nil)) 8 | 9 | (defn reset-ack-port! 10 | [] 11 | (reset! ack-port-promise (promise)) 12 | ;; save people the misery of ever trying to deref the empty promise in their REPL 13 | nil) 14 | 15 | (defn wait-for-ack 16 | "Waits for a presumably just-launched nREPL server to connect and 17 | deliver its port number. Returns that number if it's delivered 18 | within `timeout` ms, otherwise nil. Assumes that `ack` 19 | middleware has been applied to the local nREPL server handler. 20 | 21 | Expected usage: 22 | 23 | (reset-ack-port!) 24 | (start-server already-running-server-port) 25 | => (wait-for-ack) 26 | 59872 ; the port of the server started via start-server" 27 | [timeout] 28 | (let [f (future @@ack-port-promise)] 29 | (deref f timeout nil))) 30 | 31 | (defn handle-ack 32 | [h] 33 | (fn [{:keys [op port transport] :as msg}] 34 | (if (not= op "ack") 35 | (h msg) 36 | (try 37 | (deliver @ack-port-promise port) 38 | (t/send transport {:status :done}) 39 | (catch Exception _e))))) ;;; Throwable 40 | 41 | ;; TODO: could stand to have some better error handling around all of this 42 | (defn send-ack 43 | ([my-port ack-port] 44 | (send-ack my-port ack-port t/bencode)) 45 | ([my-port ack-port transport-fn] 46 | (with-open [^System.IDisposable transport (nrepl/connect :transport-fn transport-fn ;;; ^java.io.Closeable 47 | :port ack-port)] 48 | (let [client (nrepl/client transport 1000)] 49 | ;; consume response from the server, solely to let that side 50 | ;; finish cleanly without (by default) spewing a SocketException when 51 | ;; the ack client goes away suddenly 52 | (dorun (nrepl/message client {:op "ack" :port my-port})))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/version.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.version 2 | {:author "Colin Jones" 3 | :added "0.5"} 4 | #_(:import java.util.Properties)) 5 | 6 | #_(defn- map-from-property-filepath [file] ;;; makes no sense in CLR environment 7 | (try 8 | (let [file-reader (.. (Thread/currentThread) 9 | (getContextClassLoader) 10 | (getResourceAsStream file)) 11 | props (Properties.)] 12 | (.load props file-reader) 13 | (into {} props)) 14 | (catch Exception e nil))) 15 | 16 | #_(defn- get-properties-filename [group artifact] 17 | (str "META-INF/maven/" group "/" artifact "/pom.properties")) 18 | 19 | (defn- get-version 20 | "Attempts to get the project version from system properties (set when running 21 | Leiningen), or a properties file based on the group and artifact ids (in jars 22 | built by Leiningen), or a default version passed in. Falls back to an empty 23 | string when no default is present." 24 | ([group artifact] 25 | (get-version group artifact "")) 26 | ([group artifact default-version] 27 | (or #_(System/getProperty (str artifact ".version")) ;;; makes no sense in CLR environment 28 | #_(-> (get-properties-filename group artifact) ;;; makes no sense in CLR environment 29 | map-from-property-filepath 30 | (get "version")) 31 | default-version))) 32 | 33 | (def ^{:private true} version-string 34 | "Current version of nREPL as a string. 35 | See also `version`." 36 | (get-version "nrepl" "nrepl")) 37 | 38 | (def version 39 | "Current version of nREPL. 40 | Map of :major, :minor, :incremental, :qualifier, and :version-string." 41 | (assoc (->> version-string 42 | (re-find #"(\d+)\.(\d+)\.(\d+)-?(.*)") 43 | rest 44 | (map #(try (Int32/Parse %) (catch Exception e nil))) ;;; Integer/parseInt 45 | (zipmap [:major :minor :incremental :qualifier])) 46 | :version-string version-string)) 47 | 48 | 49 | ;;; IF WE WANT THIS TO WORK, WE'LL HAVE TO HAND-CODE IT!! -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/middleware/lookup_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.lookup-test 2 | {:author "Bozhidar Batsov"} 3 | (:require 4 | [clojure.test :refer :all] 5 | [cnrepl.core :as cnrepl] 6 | [cnrepl.core-test :refer [def-repl-test repl-server-fixture project-base-dir clean-response]]) 7 | (:import 8 | )) ;;; (java.io File) - not used? 9 | 10 | (use-fixtures :each repl-server-fixture) 11 | 12 | (defn dummy-lookup [ns sym] 13 | {:foo 1 14 | :bar 2}) 15 | 16 | (defprotocol MyProtocol 17 | (protocol-method [_])) 18 | 19 | (defn fn-with-coll-in-arglist 20 | [{{bar :bar} :baz}] 21 | bar) 22 | 23 | (def-repl-test lookup-op 24 | (doseq [op [{:op "lookup" :sym "map" :ns "clojure.core"} 25 | {:op "lookup" :sym "let" :ns "clojure.core"} 26 | {:op "lookup" :sym "*assert*" :ns "clojure.core"} 27 | {:op "lookup" :sym "map" :ns "cnrepl.core"} 28 | {:op "lookup" :sym "future" :ns "cnrepl.core"} 29 | {:op "lookup" :sym "protocol-method" :ns "cnrepl.middleware.lookup-test"} 30 | {:op "lookup" :sym "fn-with-coll-in-arglist" :ns "cnrepl.middleware.lookup-test"}]] 31 | (let [result (-> (cnrepl/message session op) 32 | cnrepl/combine-responses 33 | clean-response)] 34 | (is (= #{:done} (:status result))) 35 | (is (not-empty (:info result)))))) 36 | 37 | (def-repl-test lookup-op-error 38 | (let [result (-> (cnrepl/message session {:op "lookup"}) 39 | cnrepl/combine-responses 40 | clean-response)] 41 | (is (= #{:done :lookup-error :namespace-not-found} (:status result))))) 42 | 43 | (def-repl-test lookup-op-custom-fn 44 | (let [result (-> (cnrepl/message session {:op "lookup" :sym "map" :ns "clojure.core" :lookup-fn "cnrepl.middleware.lookup-test/dummy-lookup"}) 45 | cnrepl/combine-responses 46 | clean-response)] 47 | (is (= #{:done} (:status result))) 48 | (is (= {:foo 1 :bar 2} (:info result))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/docs/test-deps.dot: -------------------------------------------------------------------------------- 1 | strict digraph G { 2 | 3 | rankdir = RL; 4 | 5 | /* here start the interfaces */ 6 | 7 | subgraph clustermain { 8 | 9 | node [shape=box]; 10 | 11 | bencode; 12 | ack; 13 | cmdline; 14 | core; 15 | server; 16 | transport; 17 | misc; 18 | "mw.caught"; 19 | "mw.print"; 20 | "mw.session"; 21 | "mw.sideloader"; 22 | "mw.interruptible_eval"; 23 | middleware; 24 | version; 25 | helpers; 26 | "util.completion"; 27 | "util.lookup"; 28 | "mw.dynamic_loader"; 29 | } 30 | 31 | subgraph clustermiddleware { 32 | node [shape=box]; 33 | "mw.caught"; 34 | "mw.print"; 35 | "mw.session"; 36 | "mw.sideloader"; 37 | "mw.interruptible_eval"; 38 | "mw.dynamic_loader"; 39 | } 40 | 41 | subgraph clusterutil { 42 | node [shape=box]; 43 | "util.completion"; 44 | "util.lookup"; 45 | } 46 | 47 | subgraph clustercoretest { 48 | node [shape=ellipse]; 49 | core_test -> {core, ack, "mw.caught", "mw.print", "mw.session", "mw.sideloader", misc, server, transport}; 50 | 51 | } 52 | 53 | subgraph clustercoretestdep { 54 | node [shape=ellipse]; 55 | cmdline_test -> {ack, cmdline, core, core_test, server, transport}; 56 | 57 | describe_test -> {core, core_test, middleware, server, version}; 58 | helpers_test -> {core, core_test, helpers}; 59 | 60 | } 61 | 62 | subgraph clustermaintest{ 63 | 64 | node [shape=ellipse]; 65 | bencode_test -> {bencode}; 66 | edn_test -> {core, server, transport}; 67 | middleware_test -> {middleware, server}; 68 | misc_test -> {misc}; 69 | response_test -> {core, transport}; 70 | transport_test -> {transport}; 71 | 72 | } 73 | 74 | 75 | 76 | 77 | subgraph clusterutiltest { 78 | 79 | node [shape=ellipse]; 80 | 81 | 82 | "util.completion_test" -> {"util.completion"}; 83 | "util.lookup_test" -> {bencode, "util.lookup"}; 84 | 85 | } 86 | 87 | subgraph clustermwtest { 88 | 89 | node [shape=ellipse]; 90 | 91 | 92 | sanity_test -> {core, "mw.interruptible_eval", "mw.print", "mw.session", misc, transport}; 93 | "mw.completion_test" -> {core, core_test}; 94 | "mw.dynamic_loader_test" -> {core, "mw.dynamic_loader", transport}; 95 | "mw.load_file_test" -> {core, core_test}; 96 | "mw.lookup_test" -> {core, core_test}; 97 | "mw.print_test" -> {core, "mw.print", transport}; 98 | 99 | 100 | } 101 | } 102 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/config.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.config 2 | "Server configuration utilities. 3 | Some server options can be configured via configuration 4 | files (local or global). This namespace provides 5 | convenient API to work with them. 6 | 7 | The config resolution algorithm is the following: 8 | The global config file .nrepl/nrepl.edn is merged with 9 | any local config file (.nrepl.edn) if present. 10 | The values in the local config file take precedence." 11 | {:author "Bozhidar Batsov" 12 | :added "0.5"} 13 | (:require 14 | [clojure.clr.io :as io] ;;; clojure.java.io 15 | [clojure.edn :as edn])) 16 | 17 | (def ^:private home-dir 18 | "The user's home directory." 19 | (Environment/GetEnvironmentVariable "USERPROFILE")) ;;; (System/getProperty "user.home") 20 | 21 | (def config-dir 22 | "nREPL's configuration directory. 23 | By default it's ~/.nrepl, but this can be overridden 24 | with the NREPL_CONFIG_DIR env variable." 25 | (or (Environment/GetEnvironmentVariable "NREPL_CONFIG_DIR") ;;; (System/getenv "NREPL_CONFIG_DIR") 26 | (Environment/GetEnvironmentVariable "nrepl.config.dir") 27 | (str home-dir System.IO.Path/DirectorySeparatorChar ".nrepl"))) ;;; java.io.File/separator 28 | 29 | (def config-file 30 | "nREPL's config file." 31 | (str config-dir System.IO.Path/PathSeparator "nrepl.edn")) ;;; java.io.File/separator 32 | 33 | (defn- load-edn 34 | "Load edn from an io/reader source (filename or io/resource)." 35 | [source] 36 | (with-open [r (io/text-reader source)] ;;; io/reader 37 | (edn/read (clojure.lang.PushbackTextReader. r)))) ;;; java.io.PushbackReader. 38 | 39 | (defn- load-config 40 | "Load the configuration file identified by `filename`. 41 | Return its contents as EDN if the file exists, 42 | or an empty map otherwise." 43 | [filename] 44 | (let [file (System.IO.FileInfo. filename)] ;;; io/file 45 | (if (.Exists file) ;;; .exists 46 | (load-edn file) 47 | {}))) 48 | 49 | (def config 50 | "Configuration map. 51 | It's created by merging the global configuration file 52 | with a local configuration file that would normally 53 | the placed in the directory in which you're running 54 | nREPL." 55 | (merge 56 | (load-config config-file) 57 | (load-config ".nrepl.edn"))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/helpers.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.helpers 2 | {:author "Chas Emerick"} 3 | (:require 4 | [cnrepl.middleware.load-file :as load-file]) 5 | (:import 6 | (System.IO FileInfo ))) ;;; (java.io File StringReader) 7 | 8 | (defn load-file-command 9 | "(If it is available, sending nrepl.middleware.load-file 10 | compatible messages is far preferable.) 11 | 12 | Returns a string expression that can be sent to an nREPL session to 13 | load the Clojure code in given local file in the remote REPL's environment, 14 | preserving debug information (e.g. line numbers, etc). 15 | 16 | Typical usage: (nrepl-client-fn 17 | {:op \"eval\" :code 18 | (load-file-command \"/path/to/clojure/file.clj\")}) 19 | 20 | If appropriate, the source path from which the code is being loaded may 21 | be provided as well (suitably trimming the file's path to a relative one 22 | when loaded). 23 | 24 | The 3-arg variation of this function expects the full source of the file to be loaded, 25 | the source-root-relative path of the source file, and the name of the file. e.g.: 26 | 27 | (load-file-command \"…code here…\" \"some/ns/name/file.clj\" \"file.clj\")" 28 | ([f] (load-file-command f nil)) 29 | ([f source-root] 30 | (let [^String abspath (if (string? f) f (.DirectoryName ^FileInfo f)) ;;; .getAbsolutePath ^File 31 | source-root (cond 32 | (nil? source-root) "" 33 | (string? source-root) source-root 34 | (instance? FileInfo source-root) (.DirectoryName ^FileInfo source-root))] ;;; File .getAbsolutePath ^File 35 | (load-file-command (slurp abspath :encoding "UTF-8") 36 | (if (and (seq source-root) 37 | (.StartsWith abspath source-root)) ;;; .startsWith 38 | (-> abspath 39 | (.Substring (count source-root)) ;;; 40 | (System.Text.RegularExpressions.Regex/Replace "^[/\\\\]" "")) ;;; (.replaceAll "^[/\\\\]" "") 41 | abspath) 42 | (-> abspath FileInfo. .Name)))) ;;; File. .getName 43 | ([code file-path file-name] 44 | (load-file/load-file-code code file-path file-name))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/lookup.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.lookup 2 | "Symbol info lookup middleware. 3 | 4 | It's meant to provide you with useful data like definition location, 5 | parameter lists, etc. 6 | 7 | The middleware can be configured to use a different lookup 8 | function via a dynamic variable or a request parameter. 9 | 10 | NOTE: The functionality here is experimental and 11 | the API is subject to changes." 12 | {:author "Bozhidar Batsov" 13 | :added "0.8"} 14 | (:require 15 | [cnrepl.middleware :as middleware :refer [set-descriptor!]] 16 | [cnrepl.misc :refer [response-for] :as misc] 17 | [cnrepl.util.lookup :as lookup] 18 | [cnrepl.transport :as t]) 19 | (:import cnrepl.transport.Transport)) 20 | 21 | (def ^:dynamic *lookup-fn* 22 | "Function to use for lookup. Takes two arguments: 23 | 24 | * `ns`, the namespace in which to do the lookup. 25 | * `sym`, the symbol to lookup " 26 | lookup/lookup) 27 | 28 | (defn lookup-reply 29 | [{:keys [session sym ns lookup-fn] :as msg}] 30 | (try 31 | (let [ns (if ns (symbol ns) (symbol (str (@session #'*ns*)))) 32 | sym (symbol sym) 33 | lookup-fn (or (and lookup-fn (misc/requiring-resolve (symbol lookup-fn))) *lookup-fn*)] 34 | (response-for msg {:status :done :info (lookup-fn ns sym)})) 35 | (catch Exception _e 36 | (if (nil? ns) 37 | (response-for msg {:status #{:done :lookup-error :namespace-not-found}}) 38 | (response-for msg {:status #{:done :lookup-error}}))))) 39 | 40 | (defn wrap-lookup 41 | "Middleware that provides symbol info lookup. 42 | It understands the following params: 43 | 44 | * `sym` - the symbol which to lookup. 45 | * `ns`- the namespace in which to do lookup. Defaults to `*ns*`. 46 | * `lookup` – a fully-qualified symbol naming a var whose function to use for 47 | lookup. Must point to a function with signature [sym ns]." 48 | [h] 49 | (fn [{:keys [op ^Transport transport] :as msg}] 50 | (if (= op "lookup") 51 | (t/send transport (lookup-reply msg)) 52 | (h msg)))) 53 | 54 | (set-descriptor! #'wrap-lookup 55 | {:requires #{"clone"} 56 | :expects #{} 57 | :handles {"lookup" 58 | {:doc "Lookup symbol info." 59 | :requires {"sym" "The symbol to lookup."} 60 | :optional {"ns" "The namespace in which we want to do lookup. Defaults to `*ns*`." 61 | "lookup-fn" "The fully qualified name of a lookup function to use instead of the default one (e.g. `my.ns/lookup`)."} 62 | :returns {"info" "A map of the symbol's info."}}}}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/util/lookup_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.util.lookup-test 2 | (:require [clojure.test :refer :all] 3 | [cnrepl.bencode :as bencode] 4 | [cnrepl.util.lookup :as l :refer [lookup]]) 5 | (:import (System.IO MemoryStream))) ;;; (java.io ByteArrayOutputStream)) 6 | 7 | (deftest lookup-test 8 | (testing "special sym lookup" 9 | (is (not-empty (lookup 'clojure.core 'if)))) 10 | 11 | (testing "fully qualified sym lookup" 12 | (is (not-empty (lookup 'cnrepl.util.lookup 'clojure.core/map)))) 13 | 14 | (testing "aliased sym lookup" 15 | (is (not-empty (lookup 'cnrepl.util.lookup 'misc/log)))) ;;; 'str/upper-case -- alias for str in cnrepl.util.lookup, so substituted 16 | 17 | (testing "non-qualified lookup" 18 | (is (not-empty (lookup 'clojure.core 'map))) 19 | 20 | (is (= {:ns "clojure.core" 21 | :name "map" 22 | :arglists "([f] [f coll] [f c1 c2] [f c1 c2 c3] [f c1 c2 c3 & colls])" 23 | :arglists-str "([f] [f coll] [f c1 c2] [f c1 c2 c3] [f c1 c2 c3 & colls])"} 24 | (select-keys (lookup 'cnrepl.util.lookup 'map) [:ns :name :arglists :arglists-str]) 25 | (select-keys (lookup 'clojure.core 'map) [:ns :name :arglists :arglists-str])))) 26 | 27 | (testing "macro lookup" 28 | (is (= {:ns "clojure.core" 29 | :name "future" 30 | :macro "True"} ;;; "true" -- Seriously, (str true) => "true" in JVM, "True" in CLR 31 | (select-keys (lookup 'clojure.core 'future) [:ns :name :macro])))) 32 | 33 | (testing "special form lookup" 34 | (is (= {:ns "clojure.core" 35 | :name "let" 36 | :special-form "True"} ;;; "true" -- Seriously, (str true) => "true" in JVM, "True" in CLR 37 | (select-keys (lookup 'clojure.core 'let) [:ns :name :special-form])))) 38 | 39 | (testing "Java sym lookup" 40 | (is (empty? (lookup 'clojure.core 'String))))) 41 | 42 | (defn- bencode-str 43 | "Bencode a thing and write it into a string." 44 | [thing] 45 | (let [out (MemoryStream.)] ;;; ByteArrayOutputStream 46 | (try 47 | (bencode/write-bencode out thing) 48 | (.ToString out) ;;; .toString 49 | (catch ArgumentException ex ;;; IllegalArgumentException 50 | (throw (ex-info (.Message ex) {:thing thing})))))) ;;; .getMessage 51 | 52 | (defn- lookup-public-vars 53 | "Look up every public var in all namespaces in the classpath and return the result as a set." 54 | [] 55 | (transduce 56 | (comp 57 | (mapcat ns-publics) 58 | (map (comp meta val)) 59 | (map #(lookup (.getName (:ns %)) (:name %)))) 60 | conj 61 | #{} 62 | (all-ns))) 63 | 64 | (deftest bencode-test 65 | (doseq [m (lookup-public-vars)] 66 | (is ((comp string? not-empty) (bencode-str m))))) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/nrepl/impl/utils.cljr: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.nrepl.impl.utils 2 | {:author "Michiel Borkent, modified for ClojureCLR by David Miller" 3 | :no-doc true} 4 | (:refer-clojure :exclude [send]) 5 | (:require [clojure.tools.bencode.core :refer [write-bencode]] 6 | [clojure.tools.reader.reader-types :as rt] 7 | [clojure.tools.reader :as ctr]) 8 | (:import [System.IO Stream StringWriter])) 9 | 10 | (set! *warn-on-reflection* true) 11 | 12 | (defn response-for [old-msg msg] 13 | (let [session (get old-msg :session "none") 14 | id (get old-msg :id "unknown")] 15 | (assoc msg "session" session "id" id))) 16 | 17 | (defn send [^Stream os msg {:keys [debug-send]}] 18 | (when debug-send (prn "Sending" msg)) 19 | (write-bencode os msg) 20 | (.Flush os)) 21 | 22 | (defn send-exception [os msg ^Exception ex {:keys [debug] :as opts}] 23 | (let [d (ex-data ex) 24 | ex-name (some-> ^Object (ex-cause ex) .GetType .FullName) 25 | ex-map (Throwable->map ex) 26 | cause (:cause ex-map) 27 | {:keys [:file :line :column]} d 28 | ns *ns* ;;; @sci/ns -- NO IDEA what this should be 29 | loc-str (str ns " " 30 | (when line 31 | (str (str (or file "REPL") ":") 32 | line ":" column""))) 33 | _strace (.StackTrace ex)] 34 | (when debug (prn "sending exception" ex-map)) 35 | (send os (response-for msg {"err" (str ex-name 36 | (when cause (str ": " cause)) 37 | " " loc-str "\n")}) opts) 38 | (send os (response-for msg {"ex" (str "class " ex-name) 39 | "root-ex" (str "class " ex-name) 40 | "status" #{"eval-error"}}) opts) 41 | (send os (response-for msg {"status" #{"done"}}) opts))) 42 | 43 | 44 | (defn reader 45 | [x] 46 | (rt/indexing-push-back-reader (rt/push-back-reader x))) 47 | 48 | 49 | ;; A couple of ideas here take from borkdude/edamame::edamame.impl.parser 50 | 51 | (defn whitespace? [c] 52 | (and c (or (identical? c \,) 53 | (Char/IsWhiteSpace (char c))))) 54 | 55 | (def eof (Object.)) 56 | 57 | (defn skip-whitespace 58 | "Skips whitespace. Returns :none or :some depending on whitespace 59 | read. If end of stream is reached, returns nil." 60 | [reader] 61 | (loop [read :none] 62 | (when-let [c (rt/read-char reader)] 63 | (if (whitespace? c) 64 | (recur :some) 65 | (do (rt/unread reader c) 66 | read))))) 67 | 68 | 69 | (defn parse-next 70 | [reader] 71 | (if-let [c (and (skip-whitespace reader) 72 | (rt/peek-char reader))] 73 | (ctr/read reader) 74 | eof)) 75 | 76 | ;; this is taken from sci.impl.interpreter/eval-string* 77 | 78 | (defn eval-string* [s] 79 | (with-bindings {#'*ns* *ns*} 80 | (let [reader (reader s)] 81 | (loop [ret nil] 82 | (let [expr (parse-next reader)] 83 | (if (= eof expr) 84 | ret 85 | (let [ret (eval expr)] 86 | (recur ret)))))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/middleware_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware-test 2 | (:require 3 | [clojure.test :refer [deftest is are]] 4 | [cnrepl.middleware :as middleware :refer [linearize-middleware-stack]] 5 | [cnrepl.server :refer [default-middleware]])) 6 | 7 | (defn- wonky-resolve [s] (if (symbol? s) (resolve s) s)) 8 | 9 | (defn- indexed-stack 10 | [x] 11 | (->> x 12 | (map wonky-resolve) 13 | shuffle 14 | linearize-middleware-stack 15 | (map-indexed #(vector (if (var? %2) 16 | (-> (#'middleware/var-name %2) symbol name symbol) 17 | %2) 18 | %)) 19 | (into {}))) 20 | 21 | (deftest sanity 22 | (let [stack (indexed-stack default-middleware)] 23 | (is (stack 'wrap-print)) 24 | (are [before after] (< (stack before) (stack after)) 25 | 'interruptible-eval 'wrap-load-file 26 | 'interruptible-eval 'session 27 | 'wrap-describe 'wrap-print 28 | 'interruptible-eval 'wrap-print)) 29 | 30 | (let [n ^{::middleware/descriptor 31 | {:expects #{"clone"} :requires #{}}} {:dummy :middleware2} 32 | m ^{::middleware/descriptor 33 | {:expects #{"eval"} :requires #{n #'cnrepl.middleware.print/wrap-print}}} 34 | {:dummy :middleware} 35 | q ^{::middleware/descriptor 36 | {:expects #{} :requires #{"describe" "eval"}}} {:dummy :middleware3} 37 | stack (indexed-stack (concat default-middleware [m q n]))] 38 | ;(->> stack clojure.set/map-invert (into (sorted-map)) vals println) 39 | (are [before after] (< (stack before) (stack after)) 40 | 'interruptible-eval m 41 | m 'wrap-print 42 | 'session n 43 | q 'wrap-describe 44 | m n 45 | 46 | 'interruptible-eval 'wrap-load-file 47 | 'interruptible-eval 'session 48 | 'wrap-describe 'wrap-print 49 | 'interruptible-eval 'wrap-print))) 50 | 51 | (deftest append-dependency-free-middleware 52 | (let [m ^{::middleware/descriptor 53 | {:expects #{} :requires #{}}} {:dummy :middleware} 54 | n {:dummy "This not-middleware is supposed to be sans-descriptor, don't panic!"} 55 | stack (->> (concat default-middleware [m n]) 56 | shuffle 57 | linearize-middleware-stack)] 58 | (is (= #{n m} (set (take-last 2 stack)))))) 59 | 60 | (deftest no-descriptor-warning 61 | (let [^String s (with-out-str 62 | (binding [*err* *out*] 63 | (indexed-stack (conj default-middleware {:dummy :middleware}))))] 64 | (is (.Contains s "No nREPL middleware descriptor in metadata of {:dummy :middleware}")))) ;;; .contains 65 | 66 | (deftest NREPL-53-regression 67 | (is (= [0 1 2] 68 | (map :id 69 | (linearize-middleware-stack 70 | [^{::middleware/descriptor 71 | {:expects #{} :requires #{"1"}}} 72 | {:id 0} 73 | 74 | ^{::middleware/descriptor 75 | {:expects #{} :requires #{} :handles {"1" {}}}} 76 | {:id 1} 77 | 78 | ^{::middleware/descriptor 79 | {:expects #{"1"} :requires #{}}} 80 | {:id 2}]))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/middleware/load_file_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.load-file-test 2 | {:author "Chas Emerick"} 3 | (:require 4 | [clojure.test :refer :all] 5 | [cnrepl.core :as cnrepl] 6 | [cnrepl.core-test :refer [def-repl-test repl-server-fixture project-base-dir]]) 7 | (:import 8 | (System.IO FileInfo Path))) ;;; (java.io File) 9 | 10 | (use-fixtures :each repl-server-fixture) 11 | 12 | (def-repl-test load-code-with-debug-info 13 | (dorun (cnrepl/message timeout-session 14 | {:op "load-file" :file "\n\n\n(defn function [])"})) 15 | (is (contains? 16 | ;; different versions of Clojure use different default :file metadata 17 | #{[{:file "NO_SOURCE_PATH" :line 4}] 18 | [{:file "NO_SOURCE_FILE" :line 4}]} 19 | (repl-values timeout-session 20 | (cnrepl/code 21 | (-> #'function 22 | meta 23 | (select-keys [:file :line])))))) 24 | (dorun (cnrepl/message timeout-session {:op "load-file" 25 | :file "\n\n\n\n\n\n\n\n\n(defn afunction [])" 26 | :file-path "path/from/source/root.clj" 27 | :file-name "root.clj"})) 28 | (is (= [{:file "path/from/source/root.clj" :line 10}] 29 | (repl-values timeout-session 30 | (cnrepl/code 31 | (-> #'afunction 32 | meta 33 | (select-keys [:file :line]))))))) 34 | 35 | (def-repl-test load-file-with-debug-info 36 | (dorun 37 | (cnrepl/message timeout-session 38 | {:op "load-file" 39 | :file (slurp (FileInfo. (Path/Combine (.FullName project-base-dir) "load-file-test/nrepl/load_file_sample.clj"))) ;;; File. added Path.Combine + .FullName 40 | :file-path "nrepl/load_file_sample.clj" 41 | :file-name "load_file_sample.clj"})) 42 | (is (= [{:file "nrepl/load_file_sample.clj" :line 5}] 43 | (repl-values timeout-session 44 | (cnrepl/code 45 | (-> #'nrepl.load-file-sample/dfunction 46 | meta 47 | (select-keys [:file :line]))))))) 48 | 49 | (def-repl-test load-file-with-print-vars 50 | (set! *print-length* 3) 51 | (set! *print-level* 3) 52 | (dorun 53 | (cnrepl/message session {:op "load-file" 54 | :file "(def a (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 6)))))) 55 | (def b 2) (def c 3) (def ^{:internal true} d 4)" 56 | :file-path "path/from/source/root.clj" 57 | :file-name "root.clj"})) 58 | (is (= [4] 59 | (repl-values session (cnrepl/code d))))) 60 | 61 | (def-repl-test load-file-response-no-ns 62 | (is (not (contains? (cnrepl/combine-responses 63 | (cnrepl/message session 64 | {:op "load-file" 65 | :file "(ns foo) (def x 5)" 66 | :file-path "/path/to/source.clj" 67 | :file-name "source.clj"})) 68 | :ns)))) -------------------------------------------------------------------------------- /src/test/clojure/clojure/tools/nrepl/test_utils.cljr: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.nrepl.test-utils 2 | {:author "Michiel Borkent, modified for ClojureCLR by David Miller"} 3 | (:require [clojure.clr.io :as io]) 4 | (:import [System.Net Dns IPEndPoint IPAddress] 5 | [System.Net.Sockets TcpListener SocketException] )) 6 | 7 | (set! *warn-on-reflection* true) 8 | 9 | (defn current-time-millis [] 10 | (.ToUnixTimeMilliseconds DateTimeOffset/UtcNow)) 11 | 12 | 13 | (defn wait-for-port 14 | "Waits for TCP connection to be available on host and port. Options map 15 | supports `:timeout` and `:pause`. If `:timeout` is provided and reached, 16 | `:default`'s value (if any) is returned. The `:pause` option determines 17 | the time waited between retries." 18 | ([host port] 19 | (wait-for-port host port nil)) 20 | ([^String host ^long port {:keys [:default :timeout :pause] :as opts}] 21 | (let [opts (merge {:host host 22 | :port port} 23 | opts) 24 | t0 (current-time-millis) 25 | host-entry (Dns/GetHostEntry ^String host) 26 | ip-address (first (.AddressList host-entry)) 27 | ip-endpoint (IPEndPoint. ^IPAddress ip-address (int port))] 28 | (loop [] 29 | (let [v (try (.Stop (TcpListener. ip-endpoint)) 30 | (- (current-time-millis) t0) 31 | (catch SocketException _e 32 | (let [took (- (current-time-millis) t0)] 33 | (if (and timeout (>= took timeout)) 34 | :wait-for-port.impl/timed-out 35 | :wait-for-port.impl/try-again))))] 36 | (cond (identical? :wait-for-port.impl/try-again v) 37 | (do (System.Threading.Thread/Sleep (int (or pause 100))) 38 | (recur)) 39 | (identical? :wait-for-port.impl/timed-out v) 40 | default 41 | :else 42 | (assoc opts :took v))))))) 43 | 44 | (defn wait-for-path 45 | "Waits for file path to be available. Options map supports `:default`, 46 | `:timeout` and `:pause`. If `:timeout` is provided and reached, `:default`'s 47 | value (if any) is returned. The `:pause` option determines the time waited 48 | between retries." 49 | ([path] 50 | (wait-for-path path nil)) 51 | ([^String path {:keys [:default :timeout :pause] :as opts}] 52 | (let [opts (merge {:path path} 53 | opts) 54 | t0 (current-time-millis)] 55 | (loop [] 56 | (let [v (when (not (.Exists (io/file-info path))) 57 | (let [took (- (current-time-millis) t0)] 58 | (if (and timeout (>= took timeout)) 59 | :wait-for-path.impl/timed-out 60 | :wait-for-path.impl/try-again)))] 61 | (cond (identical? :wait-for-path.impl/try-again v) 62 | (do (System.Threading.Thread/Sleep (int (or pause 100))) 63 | (recur)) 64 | (identical? :wait-for-path.impl/timed-out v) 65 | default 66 | :else 67 | (assoc opts :took 68 | (- (current-time-millis) t0)))))))) 69 | 70 | (comment 71 | (wait-for-port "localhost" 80) 72 | (wait-for-port "localhost" 80 {:timeout 1000}) 73 | (wait-for-port "google.com" 80) 74 | 75 | (wait-for-path "/tmp/hi") 76 | (wait-for-path "/tmp/there" {:timeout 1000}) 77 | 78 | ) 79 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/completion.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.completion 2 | "Code completion middleware. 3 | 4 | The middleware is a simple wrapper around the 5 | functionality in `nrepl.completion`. Its 6 | API is inspired by cider-nrepl's \"complete\" middleware. 7 | 8 | The middleware can be configured to use a different completion 9 | function via a dynamic variable or a request parameter. 10 | 11 | NOTE: The functionality here is experimental and 12 | the API is subject to changes." 13 | {:author "Bozhidar Batsov" 14 | :added "0.8"} 15 | (:require 16 | [clojure.walk :as walk] 17 | [cnrepl.util.completion :as complete] 18 | [cnrepl.middleware :as middleware :refer [set-descriptor!]] 19 | [cnrepl.misc :refer [response-for] :as misc] 20 | [cnrepl.transport :as t]) 21 | (:import cnrepl.transport.Transport)) 22 | 23 | (def ^:dynamic *complete-fn* 24 | "Function to use for completion. Takes three arguments: `prefix`, the completion prefix, 25 | `ns`, the namespace in which to look for completions, and `options`, a map of additional 26 | options for the completion function." 27 | complete/completions) 28 | 29 | (def ^:private parse-options 30 | (memoize 31 | (fn [options] 32 | (update (walk/keywordize-keys options) :extra-metadata (comp set (partial map keyword)))))) 33 | 34 | (defn completion-reply 35 | [{:keys [session prefix ns complete-fn options] :as msg}] 36 | (let [ns (if ns (symbol ns) (symbol (str (@session #'*ns*)))) 37 | completion-fn (or (and complete-fn (misc/requiring-resolve (symbol complete-fn))) *complete-fn*)] 38 | (try 39 | (response-for msg {:status :done :completions (completion-fn prefix ns (parse-options options))}) 40 | (catch Exception e 41 | (if (nil? ns) 42 | (response-for msg {:status #{:done :completion-error}}) 43 | (response-for msg {:status #{:done :completion-error :namespace-not-found}})))))) 44 | 45 | (defn wrap-completion 46 | "Middleware that provides code completion. 47 | It understands the following params: 48 | 49 | * `prefix` - the prefix which to complete. 50 | * `ns`- the namespace in which to do completion. Defaults to `*ns*`. 51 | * `complete-fn` – a fully-qualified symbol naming a var whose function to use for 52 | completion. Must point to a function with signature [prefix ns options]. 53 | * `options` – a map of options to pass to the completion function." 54 | [h] 55 | (fn [{:keys [op ^Transport transport] :as msg}] 56 | (if (= op "completions") 57 | (t/send transport (completion-reply msg)) 58 | (h msg)))) 59 | 60 | (set-descriptor! #'wrap-completion 61 | {:requires #{"clone"} 62 | :expects #{} 63 | :handles {"completions" 64 | {:doc "Provides a list of completion candidates." 65 | :requires {"prefix" "The prefix to complete."} 66 | :optional {"ns" "The namespace in which we want to obtain completion candidates. Defaults to `*ns*`." 67 | "complete-fn" "The fully qualified name of a completion function to use instead of the default one (e.g. `my.ns/completion`)." 68 | "options" "A map of options supported by the completion function. Supported keys: `extra-metadata` (possible values: `:arglists`, `:docs`)."} 69 | :returns {"completions" "A list of completion candidates. Each candidate is a map with `:candidate` and `:type` keys. Vars also have a `:ns` key."}}}}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/sanity_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.sanity-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [cnrepl.core :as cnrepl] 5 | [cnrepl.middleware.interruptible-eval :as eval] 6 | [cnrepl.middleware.print :as print] 7 | [cnrepl.middleware.session :as session] 8 | [cnrepl.misc :as misc] 9 | [cnrepl.transport :as transport :refer [piped-transports]]) 10 | #_(:import 11 | (java.util.concurrent BlockingQueue LinkedBlockingQueue TimeUnit))) 12 | 13 | (defn- internal-eval 14 | ([expr] (internal-eval nil expr)) 15 | ([ns expr] 16 | (let [[local remote] (piped-transports) 17 | expr (if (string? expr) 18 | expr 19 | (binding [*print-meta* true] 20 | (pr-str expr))) 21 | msg (cond-> {:code expr :transport remote :session (atom {})} 22 | ns (assoc :ns ns))] 23 | (eval/evaluate msg) 24 | (-> (cnrepl/response-seq local 0) 25 | (cnrepl/combine-responses) 26 | (select-keys [:ns :value :out :err]))))) 27 | 28 | (deftest eval-sanity 29 | (try 30 | (are [result expr] (= result (internal-eval expr)) 31 | {:ns "user" :value [3]} 32 | '(+ 1 2) 33 | 34 | {:ns "user" :value [nil]} 35 | '*1 36 | 37 | {:ns "user" :value [nil]} 38 | '(do (def ^{:dynamic true} ++ +) nil) 39 | 40 | {:ns "user" :value [5]} 41 | '(binding [++ -] (++ 8 3)) 42 | 43 | {:ns "user" :value [42]} 44 | '(set! *print-length* 42) 45 | 46 | {:ns "user" :value [nil]} 47 | '*print-length*) 48 | (finally (ns-unmap *ns* '++)))) 49 | 50 | (deftest specified-namespace 51 | (try 52 | (are [ns result expr] (= result (internal-eval ns expr)) 53 | (ns-name *ns*) 54 | {:ns "user" :value [3]} 55 | '(+ 1 2) 56 | 57 | 'user 58 | {:ns "user" :value '[("user" "++")]} 59 | '(do 60 | (def ^{:dynamic true} ++ +) 61 | (map #(-> #'++ meta % str) [:ns :name])) 62 | 63 | (ns-name *ns*) 64 | {:ns "user" :value [5]} 65 | '(binding [user/++ -] 66 | (user/++ 8 3))) 67 | (finally (ns-unmap 'user '++)))) 68 | 69 | (deftest multiple-expressions 70 | (are [result expr] (= result (internal-eval expr)) 71 | {:ns "user" :value [4 65536.0]} 72 | "(+ 1 3) (Math/Pow 2 16)" ;;; Math/pow 73 | 74 | {:ns "user" :value [4 20 1 0]} 75 | "(+ 2 2) (* *1 5) (/ *2 4) (- *3 4)" 76 | 77 | {:ns "user" :value [nil]} 78 | '*1)) 79 | 80 | #_(deftest repl-out-writer --- can't do this test without implementing more methods for replying-PrintWriter TODO? 81 | (let [[local remote] (piped-transports) 82 | w (print/replying-PrintWriter :out {:transport remote} {})] 83 | (doto w 84 | .Flush ;;; .flush 85 | (.WriteLine "println") ;;; .println 86 | (.Write "abcd") ;;; .write 87 | (.Write (.ToCharArray "ef") 0 2) ;;; .write .toCharArray 88 | (.Write "gh" 0 2) ;;; .write 89 | (.Write (.ToCharArray "ij")) ;;; .write .toCharArray 90 | (.Write " klm" 5 1) ;;; .write 91 | (.Write 32) ;;; .write 92 | .Flush) ;;; .flush 93 | (with-open [out w] ;;; (java.io.PrintWriter. w) I don't have anything to wrap around w 94 | (binding [*out* out] 95 | (newline) 96 | (prn #{}) 97 | (flush))) 98 | 99 | (is (= [(str "println" Environment/NewLine) ;;; (System/getProperty "line.separator") 100 | "abcdefghijm " 101 | "\n#{}\n"] 102 | (->> (cnrepl/response-seq local 0) 103 | (map :out)))))) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # clr.tools.nrepl # 2 | 3 | A port of [babashka/babashka.nrepl](https://github.com/babashka/babashka.nrepl) library to ClojureCLR. 4 | 5 | A shoutout to Michiel Borkent (@borkdude) for writing the original and for assistance in getting this port up and running. 6 | 7 | There is a work-in-progress port of [nrepl/nrepl](https://github.com/nrepl/nrepl). That is in down in subdirectory `partial-nrepl-nrepl-port`. Go for it. 8 | 9 | # Status 10 | 11 | We are in alpha for the first release. The original test suite passes. We are starting work to test against nREPL clients (think of Calva, CIDER). 12 | 13 | # Usage 14 | 15 | The original `babashka.nrepl` was build to to run under SCI. (See [https://github.com/babashka/sci](https://github.com/babashka/sci).) This port has nothing to do with SCI. 16 | Otherwise the usage is similar to the original. We reproduce those notes here with appropriate modifications. 17 | 18 | The original version needed a SCI context passed in to `start-server!`. 19 | We have maintained that parameter for now -- we will be passing in an empty map -- until we can assess possible need for it in our context. 20 | This aspect of the interface may change as we continue with the alpha development. 21 | 22 | ## Starting a server 23 | 24 | To start an nREPL server, call `clojure.tools.nrepl/start-server!`. The call takes one optional argumen, a server options map. 25 | 26 | ``` 27 | (clojure.tools.nrepl/start-server! {:host "127.0.0.1" :port 12345}) 28 | ``` 29 | 30 | Option keys include: 31 | 32 | - `:debug` -- if set to `true`, the nREPL server will print to standard output all the messages it is receiving over the nREPL channel. 33 | - `:debug-send` -- if set to `true`, the server will also print the messages it is sending 34 | - `:quiet` -- if set to `true` the nREPL server will not print out the message "starting nREPL server at ..." when starting. 35 | Note that some clients (CIDER?) require this message in order pick up information such as the port number, or so I've heard. 36 | If not specified, `:quiet` defatuls to `false`, and the message will be printed. 37 | - `:port` -- the port number. If not specified, defaults to `1667`. 38 | - `:host` -- the host IP address or DNS name. If not specified, it defaults to `0.0.0.0`. (Bind to every interface.) 39 | - `:xform` -- if not specified, defatuls to `clojure.core.nrepl.middleware/default-xform`. 40 | See the [babashka.nrepl middleware docs](https://github.com/babashka/babashka.nrepl/blob/master/doc/middleware.md) for more information. 41 | 42 | If no options hashmap is specifed at all, all the defaults will be used. Thus you can start the nREPL server minimally with 43 | 44 | ``` 45 | (clojure.tools.nrepl/start-server!) 46 | ``` 47 | 48 | ## Stopping a server 49 | 50 | Pass the result returned from `start-server!` to `stop-server!`: 51 | 52 | ``` 53 | (def server (clojure.tools.nrepl/start-server!)) 54 | .... 55 | 56 | (clojure.tools.nrepl/stop-server! server) 57 | ``` 58 | 59 | 60 | ## Parsing an nREPL options string 61 | 62 | Use `clojure.tools.nrepl/parse-opt` to parse a `hostname:port` string into a map to pass to `start-server!`: 63 | 64 | ``` 65 | (clojure.tools.nrepl/start-server! {} (clojure.tools.nrepl/parse-opt "localhost:12345")) 66 | ``` 67 | 68 | ## Middleware 69 | 70 | The nREPL middleware is customizable. 71 | Also this is untested. 72 | We will be following the [babashka.nrepl middleware docs](https://github.com/babashka/babashka.nrepl/blob/master/doc/middleware.md). 73 | 74 | There is a rumor that the middleware design may change in the future. 75 | 76 | 77 | 78 | # Releases 79 | 80 | 81 | [clj](https://clojure.org/guides/getting_started) dependency information: 82 | ```clojure 83 | io.github.clojure/clr.tools.nrepl {:git/tag "v0.1.2-alpha2" :git/sha "a58009f"} 84 | ``` 85 | 86 | or 87 | ```clojure 88 | io.github.clojure/clr.tools.nrepl {:git/tag "v0.1.0-alpha2" :git/sha "a58009f"} 89 | ``` 90 | (I made a typo in the tagname when I first put this up. Either one will work now.) 91 | 92 | ``` 93 | PM> Install-Package clojure.tools.nrepl -Version 0.1.0-alpha2 94 | ``` 95 | 96 | Leiningen/Clojars reference: 97 | 98 | ``` 99 | [org.clojure.clr/tools.nrepl "0.1.0-alpha2] 100 | ``` 101 | 102 | 103 | # Copyright and License # 104 | 105 | The babashka.nrepl code had the following: 106 | 107 | 108 | > The project code is Copyright © 2019-2023 Michiel Borkent 109 | > 110 | > It is distributed under the Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 111 | 112 | 113 | 114 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/caught.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.caught 2 | "Support for a hook for conveying errors interactively, akin to the `:caught` 3 | option of `clojure.main/repl`. See the docstring of `wrap-caught` and the 4 | Evaluation Errors section of the Middleware documentation for more 5 | information." 6 | {:author "Michael Griffiths" 7 | :added "0.6"} 8 | (:require 9 | [clojure.main] 10 | [cnrepl.middleware :refer [set-descriptor!]] 11 | [cnrepl.middleware.print :as print] 12 | [cnrepl.misc :as misc] 13 | [cnrepl.transport :as transport]) 14 | (:import 15 | (cnrepl.transport Transport))) 16 | 17 | (def ^:dynamic *caught-fn* 18 | "Function to use to convey interactive errors (generally by printing to 19 | `*err*`). Takes one argument, a `java.lang.Throwable`." 20 | clojure.main/repl-caught) 21 | 22 | (def default-bindings 23 | {#'*caught-fn* *caught-fn*}) 24 | 25 | (defn- bound-configuration 26 | [] 27 | {::caught-fn *caught-fn*}) 28 | 29 | (def configuration-keys 30 | [::caught-fn ::print?]) 31 | 32 | (defn- resolve-caught 33 | [{:keys [::caught transport] :as msg}] 34 | (when-let [var-sym (some-> caught (symbol))] 35 | (let [caught-var (misc/requiring-resolve var-sym)] 36 | (when-not caught-var 37 | (let [resp {:status ::error 38 | ::error (str "Couldn't resolve var " var-sym)}] 39 | (transport/send transport (misc/response-for msg resp)))) 40 | caught-var))) 41 | 42 | (defn- caught-transport 43 | [{:keys [transport] :as msg} opts] 44 | (reify Transport 45 | (recv [this] 46 | (transport/recv transport)) 47 | (recv [this timeout] 48 | (transport/recv transport timeout)) 49 | (send [this {:keys [::throwable] :as resp}] 50 | (let [{:keys [::caught-fn ::print?]} (-> (merge msg (bound-configuration) resp opts) 51 | (select-keys configuration-keys))] 52 | (when throwable 53 | (caught-fn throwable)) 54 | (transport/send transport (cond-> (apply dissoc resp configuration-keys) 55 | (and throwable print?) 56 | (update ::print/keys (fnil conj []) ::throwable) 57 | (not print?) 58 | (dissoc ::throwable)))) 59 | this))) 60 | 61 | (defn wrap-caught 62 | "Middleware that provides a hook for any `java.lang.Throwable` that should be 63 | conveyed interactively (generally by printing to `*err*`). 64 | 65 | Returns a handler which calls said hook on the `::caught/throwable` slot of 66 | messages sent via the request's transport. 67 | 68 | Supports the following options: 69 | 70 | * `::caught` – a fully-qualified symbol naming a var whose function to use to 71 | convey interactive errors. Must point to a function that takes a 72 | `java.lang.Throwable` as its sole argument. 73 | 74 | * `::caught-fn` – the function to use to convey interactive errors. Will be 75 | resolved from the above option if provided. Defaults to 76 | `clojure.main/repl-caught`. Must take a `java.lang.Throwable` as its sole 77 | argument. 78 | 79 | * `::print?` – if logical true, the printed value of any interactive errors 80 | will be returned in the response (otherwise they will be elided). Delegates to 81 | `nrepl.middleware.print` to perform the printing. Defaults to false. 82 | 83 | The options may be specified in either the request or the responses sent on 84 | its transport. If any options are specified in both, those in the request will 85 | be preferred." 86 | [handler] 87 | (fn [msg] 88 | (let [caught-var (resolve-caught msg) 89 | msg (assoc msg ::caught-fn (or caught-var *caught-fn*)) 90 | opts (cond-> (select-keys msg configuration-keys) 91 | ;; no caught-fn provided in the request, so defer to the response 92 | (nil? caught-var) 93 | (dissoc ::caught-fn) 94 | ;; in bencode empty list is logical false 95 | (contains? msg ::print?) 96 | (update ::print? #(if (= [] %) false (boolean %))))] 97 | (handler (assoc msg :transport (caught-transport msg opts)))))) 98 | 99 | (set-descriptor! #'wrap-caught {:requires #{#'print/wrap-print} 100 | :expects #{} 101 | :handles {}}) 102 | 103 | (def wrap-caught-optional-arguments 104 | {"nrepl.middleware.caught/caught" "A fully-qualified symbol naming a var whose function to use to convey interactive errors. Must point to a function that takes a `java.lang.Throwable` as its sole argument." 105 | "nrepl.middleware.caught/print?" "If logical true, the printed value of any interactive errors will be returned in the response (otherwise they will be elided). Delegates to `nrepl.middleware.print` to perform the printing. Defaults to false."}) -------------------------------------------------------------------------------- /src/main/clojure/clojure/tools/nrepl/server/middleware.cljr: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.nrepl.server.middleware 2 | (:require [clojure.tools.nrepl.impl.server :as server] 3 | clojure.set)) 4 | 5 | (def wrap-read-msg 6 | "Middleware for normalizing an nrepl message read from bencode." 7 | (map (fn [m] 8 | (update m :msg server/read-msg)))) 9 | 10 | ;; make default message processing public 11 | ;; but not the underlying multimethod 12 | (defn default-process-msg [rf result msg] 13 | (server/process-msg rf result msg)) 14 | 15 | (def wrap-response-for 16 | "Middleware responsible for updating message with session and id." 17 | (map (fn [response] 18 | (let [old-msg (:response-for response) 19 | session (get old-msg :session "none") 20 | id (get old-msg :id "unknown")] 21 | (-> response 22 | (assoc-in [:response "session"] session) 23 | (assoc-in [:response "id"] id)))))) 24 | 25 | (defn wrap-process-message 26 | "Middleware for producing responses based on op code." 27 | {::requires #{#'wrap-read-msg} 28 | ::expects #{#'wrap-response-for}} 29 | [rf] 30 | (completing 31 | (fn [result input] 32 | (default-process-msg rf result input)))) 33 | 34 | (def default-middleware 35 | #{#'wrap-read-msg 36 | #'wrap-process-message 37 | #'wrap-response-for}) 38 | 39 | (defn ^:private merge-graph [g1 g2] 40 | (merge-with clojure.set/union g1 g2)) 41 | 42 | (defn ^:private middleware->graph 43 | "Given a set of middleware, return a graph represented as a map. 44 | 45 | Each (key, value) pair is: (node, set of nodes pointed to). 46 | " 47 | [middleware] 48 | (transduce 49 | (map 50 | (fn [v] 51 | (reduce merge-graph 52 | {} 53 | (let [vmeta (meta v) 54 | requires (::requires vmeta) 55 | expects (::expects vmeta)] 56 | (assert (seqable? requires) ":clojure.tools.nrepl.server.middleware/requires must be seqable") 57 | (assert (seqable? expects) ":clojure.tools.nrepl.server.middleware/expects must be seqable") 58 | (assert (every? #(contains? middleware %) 59 | (concat requires 60 | expects)) 61 | (str "Middleware required or expected, but not provided")) 62 | (cons {v (into #{} requires)} 63 | (for [expected expects] 64 | {expected #{v}})))))) 65 | (completing merge-graph) 66 | {} 67 | middleware)) 68 | 69 | ;; Based off of Kahn's algorithm 70 | ;; https://en.wikipedia.org/wiki/Topological_sorting 71 | (defn ^:private topo-sort [g] 72 | (loop [deps [] 73 | g g] 74 | (if (seq g) 75 | (let [next-deps (into #{} (comp 76 | (filter (fn [[f deps]] 77 | (empty? deps))) 78 | (map (fn [[f deps]] 79 | f))) 80 | g)] 81 | (when (empty? next-deps) 82 | (throw (ArgumentException. "Middleware has cycles or missing dependencies!"))) 83 | (recur (conj deps next-deps) 84 | (reduce-kv (fn [g f deps] 85 | (conj g [f (clojure.set/difference deps next-deps)])) 86 | {} 87 | (apply dissoc g next-deps)))) 88 | ;; else 89 | deps))) 90 | 91 | (defn middleware->xform 92 | "Converts a set of middleware functions into a transducer 93 | that can be used with the sci nrepl server. 94 | 95 | Middleware functions will topologically sorted based off the 96 | meta data keys :babashka.nrepl.server.middleware/requires and :babashka.nrepl.middleware/expects. 97 | " 98 | [middleware] 99 | (let [g (middleware->graph middleware) 100 | sorted (topo-sort g) 101 | xform (transduce cat 102 | comp 103 | sorted)] 104 | xform)) 105 | 106 | (def default-xform 107 | "Default middleware used by sci nrepl server." 108 | (middleware->xform default-middleware)) 109 | 110 | (defn default-middleware-with-extra-ops 111 | "Use the default handler, but use the map of `op-handlers` first. 112 | 113 | `op-handlers` should be a map of `op` => `handler`. 114 | 115 | A handler is function that receives three arguments, [rf result nrepl-request]. 116 | The `rf` argument should be called with result and the `nrepl-response`. For multiple synchronous 117 | responses, the result of calling rf should be chained. 118 | 119 | Example: 120 | 121 | ``` 122 | (middleware/default-middleware-with-extra-ops 123 | {:foo (fn [rf result request] 124 | (-> result 125 | (rf {:response {:foo-echo (-> request :msg :foo)} 126 | :response-for request}) 127 | (rf {:response {:bar-echo (-> request :msg :bar)} 128 | :response-for request})))}) 129 | ``` 130 | " 131 | [op-handlers] 132 | (let [op-handler 133 | (with-meta 134 | (fn [rf] 135 | (completing 136 | (fn [result request] 137 | (if-let [handler (op-handlers (-> request :msg :op))] 138 | (handler rf result request) 139 | (default-process-msg rf result request))))) 140 | {::requires #{#'wrap-read-msg} 141 | ::expects #{#'wrap-response-for}})] 142 | (middleware->xform 143 | (-> default-middleware 144 | (disj #'wrap-process-message) 145 | (conj op-handler))))) 146 | 147 | -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/dynamic_loader.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.dynamic-loader 2 | "Support the ability to interactively update the middleware of the *running* 3 | nREPL server. This can be used by tools to configure an existing instance of 4 | an environment after connection. 5 | 6 | It can also be used to load extra namespaces, in addition to the ones that new 7 | middleware are defined in, to handle existing middleware that performs 8 | deferred loading. 9 | 10 | When combined with the sideloader, this could be used to inject middleware 11 | that are unknown to the server prior to connection." 12 | {:author "Shen Tian" 13 | :added "0.8"} 14 | (:require [clojure.string :as str] 15 | [cnrepl.middleware :refer [linearize-middleware-stack set-descriptor!]] 16 | [cnrepl.middleware.session :as middleware.session] 17 | [cnrepl.misc :as misc :refer [response-for with-session-classloader]] 18 | [cnrepl.transport :as t])) 19 | 20 | (def ^:dynamic *state* nil) 21 | 22 | (defn unknown-op 23 | "Sends an :unknown-op :error for the given message." 24 | [{:keys [op transport] :as msg}] 25 | (t/send transport (response-for msg :status #{:error :unknown-op :done} :op op))) 26 | 27 | (defn- update-stack! 28 | [session middleware] 29 | (with-session-classloader session 30 | (let [resolved (map (fn [middleware-str-or-var] 31 | (if (var? middleware-str-or-var) 32 | middleware-str-or-var 33 | (-> middleware-str-or-var 34 | (str/replace "#'" "") 35 | symbol 36 | misc/requiring-resolve))) 37 | middleware) 38 | stack (linearize-middleware-stack resolved)] 39 | (if (every? some? resolved) 40 | (reset! *state* {:handler ((apply comp (reverse stack)) unknown-op) 41 | :stack stack}) 42 | {:unresolved (keep (fn [[m resolved]] 43 | (when (nil? resolved) m)) 44 | (zipmap middleware resolved))})))) 45 | 46 | (defn- require-namespaces 47 | [session namespaces] 48 | (with-session-classloader session 49 | (run! (fn [namespace] 50 | (try 51 | (require (symbol namespace)) 52 | (catch Exception _ nil))) ;;; Throwable 53 | namespaces))) 54 | 55 | (defn wrap-dynamic-loader 56 | "The dynamic loader is both part of the middleware stack, but is also able to 57 | modify the stack. To further complicate things, the middleware architecture 58 | works best when each middleware is a var, resolving to an 1-arity function. 59 | 60 | The state of the external world is thus passed to this middleware by rebinding 61 | the `*state*` var, and we expect this to have two keys: 62 | 63 | - `:handler`, the current active handler 64 | - `:stack`, a col of vars that represent the current middleware stack. 65 | 66 | Note that if `*state*` is not rebound, this middleware will not work." 67 | [h] 68 | (fn [{:keys [op transport session middleware extra-namespaces] :as msg}] 69 | (when-not (instance? clojure.lang.IAtom *state*) 70 | (throw (ex-info "dynamic-loader/*state* is not bond to an atom. This is likely a bug" 71 | {:state-class (class *state*)}))) 72 | (case op 73 | "add-middleware" 74 | (do 75 | (require-namespaces session extra-namespaces) 76 | (let [{:keys [unresolved]} 77 | (update-stack! session (concat middleware (:stack @*state*)))] 78 | (if-not unresolved 79 | (t/send transport (response-for msg {:status :done})) 80 | (t/send transport (response-for msg {:status #{:done :error} 81 | :unresolved-middleware unresolved}))))) 82 | 83 | "swap-middleware" 84 | (do 85 | (require-namespaces session extra-namespaces) 86 | (let [{:keys [unresolved]} (update-stack! session middleware)] 87 | (when transport 88 | (if-not unresolved 89 | (t/send transport (response-for msg {:status :done})) 90 | (t/send transport (response-for msg {:status #{:done :error} 91 | :unresolved-middleware unresolved})))))) 92 | 93 | "ls-middleware" 94 | (t/send transport (response-for msg 95 | :middleware (mapv str (:stack @*state*)) 96 | :status :done)) 97 | 98 | (h msg)))) 99 | 100 | (def ^{:private true} add-swap-ops 101 | {:requires {"middleware" "a list of middleware"} 102 | :optional {"extra-namespaces" "a list of extra namespaces to load. This is useful when the new middleware feature deferred loading"} 103 | :returns {"status" "`done`, once done, and `error`, if there's any problems in loading a middleware" 104 | "unresolved-middleware" "List of middleware that could not be resolved"}}) 105 | 106 | (set-descriptor! #'wrap-dynamic-loader 107 | {:requires #{#'middleware.session/session} 108 | :expects #{} 109 | :handles {"ls-middleware" 110 | {:doc "List of current middleware" 111 | :requires {} 112 | :returns {"middleware" "list of vars representing loaded middleware, from inside out"}} 113 | "add-middleware" 114 | (merge add-swap-ops 115 | {:doc "Adding some middleware"}) 116 | "swap-middleware" 117 | (merge add-swap-ops 118 | {:doc "Replace the whole middleware stack"})}}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/sync_channel.clj: -------------------------------------------------------------------------------- 1 | ;- 2 | ; Copyright (c) David Miller. All rights reserved. 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this distribution. 6 | ; By using this software in any fashion, you are agreeing to be bound by 7 | ; the terms of this license. 8 | ; You must not remove this notice, or any other, from this software. 9 | 10 | 11 | (ns #^{:author "David Miller" 12 | :doc "A simple synchronous channel"} 13 | cnrepl.sync-channel 14 | (:refer-clojure :exclude (take)) 15 | (:require [cnrepl.debug :as debug]) 16 | (:import [System.Threading Monitor WaitHandle AutoResetEvent])) 17 | 18 | ;; Reason for existence 19 | ;; 20 | ;; The original (ClojureJVM) FnTransport code uses a java.util.concurrent.SynchronousQueue. 21 | ;; The description in the Java documentation reads: 22 | ;; 23 | ;; A blocking queue in which each insert operation must wait for a corresponding remove operation by another thread, 24 | ;; and vice versa. A synchronous queue does not have any internal capacity, not even a capacity of one. You cannot 25 | ;; peek at a synchronous queue because an element is only present when you try to remove it; you cannot insert an 26 | ;; element (using any method) unless another thread is trying to remove it; you cannot iterate as there is nothing 27 | ;; to iterate. The head of the queue is the element that the first queued inserting thread is trying to add to the 28 | ;; queue; if there is no such queued thread then no element is available for removal and poll() will return null. 29 | ;; For purposes of other Collection methods (for example contains), a SynchronousQueue acts as an empty collection. 30 | ;; This queue does not permit null elements. Synchronous queues are similar to rendezvous channels used in CSP and Ada. 31 | ;; They are well suited for handoff designs, in which an object running in one thread must sync up with an object 32 | ;; running in another thread in order to hand it some information, event, or task. 33 | ;; 34 | ;; In the use here, there is a single producer and a single consuer. 35 | ;; 36 | ;; The CLR does not supply such a construct. The closest equivalent would be a System.Collections.Concurrent.BlockingCollection 37 | ;; with zero capacity, but that class only allows capacity greater than zero. With capacity one, it would not require a producer 38 | ;; or a consumer to wait for its matching consumer/producer to come along. 39 | ;; 40 | ;; Another possibility might be the channels in System.Threading.Channels. However, it does not seem to be able to force 41 | ;; a producer to wait for a consumer. And at any rate, it is not available for .NET Framework. 42 | ;; 43 | ;; 44 | ;; Because our usage can be restricted to one allowing only one consumer waiting and one producer waiting at a time, we do not 45 | ;; need to deal with queuing producers or consumers and hence with fairness issues and the like. 46 | ;; 47 | ;; Because this sort of construct can be tricky to get right, I'll spend a little time describing the implementation 48 | ;; in the hopes of convincing you -- well, me, really -- that it's correct. 49 | ;; 50 | ;; Single-threadedness for producers and consumers is enforced by lock management. 51 | ;; A producer calling put trys to get the p-lock. 52 | ;; If it fails to get the lock, there must be a producer already working, so an error is thrown. 53 | ;; If it succeeds, it has the lock until it is released by a consumer. 54 | ;; 55 | ;; Similarly for a consumer. 56 | ;; 57 | ;; Coordination between consumer and producer is implemented by a pair of AutoResetEvents. 58 | ;; A producer enters, sets the value field, signals the consumer-wait-event and waits to be signaled to continue. 59 | ;; A consumer enters, waits for its signal, grabs the value, sets the value field to nil, and signals the waiting producer. 60 | ;; Access to the value field comes before the wait for the producer and after the wait for the consumer. 61 | ;; Thus, we do not need to protect access to the value field. 62 | 63 | 64 | (defprotocol SyncChannel 65 | "A synchronous channel (single-threaded on producer and consumer)" 66 | (put [this value] "Put a value to this channel (Producer)") 67 | (take [this] "Get a value from this channel (Consumer)") 68 | (poll [this] [this timeout] "Get a value from this channel if one is available (within the designated timeout period)")) 69 | 70 | 71 | 72 | ;; SimpleSyncChannel assumes there is a single producer thread and a single consumer thread. 73 | 74 | (deftype SimpleSyncChannel [^:volatile-mutable value 75 | p-lock 76 | c-lock 77 | ^AutoResetEvent producer-wait-event 78 | ^AutoResetEvent consumer-wait-event] 79 | SyncChannel 80 | (put [this v] 81 | (try 82 | (when-not (Monitor/TryEnter p-lock) 83 | (throw (Exception. "Producer not single-threaded"))) 84 | (set! value v) 85 | (WaitHandle/SignalAndWait consumer-wait-event producer-wait-event) 86 | (finally 87 | (Monitor/Exit p-lock)))) 88 | 89 | 90 | (take [this] 91 | (poll this -1)) 92 | 93 | (poll [this] 94 | (poll this 0)) 95 | 96 | (poll [this timeout] 97 | (try 98 | (when-not (Monitor/TryEnter c-lock) 99 | (throw (Exception. "Consumer not single-threaded"))) 100 | 101 | (when (.WaitOne consumer-wait-event timeout) 102 | ;; We were signaled, so a value is waiting 103 | (let [v value] 104 | (set! value nil) 105 | (.Set producer-wait-event) 106 | v)) 107 | (finally 108 | (Monitor/Exit c-lock))))) 109 | 110 | 111 | 112 | (defn make-simple-sync-channel [] 113 | (SimpleSyncChannel. nil (Object.) (Object.) (AutoResetEvent. false) (AutoResetEvent. false))) 114 | 115 | (comment 116 | 117 | (require '[cnrepl.debug :as debug]) 118 | (def q (make-simple-sync-channel)) 119 | (future (dotimes [i 5] (debug/prn-thread "put start " i) (put q i) (debug/prn-thread "put finish " i))) 120 | (future (dotimes [i 5] (debug/prn-thread "take start " i) (debug/prn-thread "take finish " (take q)))) 121 | 122 | ) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/test_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.test-test 2 | (:require 3 | [clojure.clr.io :as io] ;;; clojure.java.io 4 | [clojure.main] 5 | [clojure.set :as set] 6 | [clojure.test :refer [are deftest is testing use-fixtures]] 7 | [cnrepl.core :as cnrepl :refer [client 8 | client-session 9 | code 10 | combine-responses 11 | connect 12 | message 13 | new-session 14 | read-response-value 15 | response-seq 16 | response-values 17 | url-connect]] 18 | [cnrepl.ack :as ack] 19 | [cnrepl.middleware.caught :as middleware.caught] 20 | [cnrepl.middleware.print :as middleware.print] 21 | [cnrepl.middleware.session :as session] 22 | [cnrepl.middleware.sideloader :as sideloader] 23 | [cnrepl.misc :refer [uuid]] 24 | [cnrepl.server :as server] 25 | [cnrepl.transport :as transport]) 26 | (:import 27 | (System.IO FileInfo) ;;; (java.io File Writer) 28 | ;;; java.net.SocketException 29 | (cnrepl.server Server))) 30 | 31 | 32 | (def tf #'transport/bencode) 33 | (def s (server/start-server :transport-fn tf)) 34 | (def conn (connect :port (:port s) :transport-fn tf)) 35 | (def cli (cnrepl.core/client conn Int64/MaxValue)) 36 | (def sess (client-session cli)) 37 | 38 | 39 | 40 | 41 | 42 | (defmacro when-require [n & body] 43 | (let [nn (eval n)] 44 | (try (require nn) 45 | (catch Exception e nil)) ;;; Throwable 46 | (when (find-ns nn) 47 | `(do ~@body)))) 48 | 49 | (def transport-fn->protocol 50 | "Add your transport-fn var here so it can be tested" 51 | {#'transport/bencode "nrepl" 52 | #_#'transport/edn #_"nrepl+edn"}) 53 | 54 | ;; There is a profile that adds the fastlane dependency and test 55 | ;; its transports. 56 | (when-require 'fastlane.core 57 | (def transport-fn->protocol 58 | (merge transport-fn->protocol 59 | {(find-var 'fastlane.core/transit+msgpack) "transit+msgpack" 60 | (find-var 'fastlane.core/transit+json) "transit+json" 61 | (find-var 'fastlane.core/transit+json-verbose) "transit+json-verbose"}))) 62 | 63 | (def ^FileInfo project-base-dir (FileInfo. ".")) ;;; ^File(System/getProperty "nrepl.basedir" ".") 64 | 65 | (def ^:dynamic ^cnrepl.server.Server *server* nil) 66 | (def ^{:dynamic true} *transport-fn* nil) 67 | 68 | (defn start-server-for-transport-fn 69 | [transport-fn f] 70 | (with-open [^Server server (server/start-server :transport-fn transport-fn)] 71 | (binding [*server* server 72 | *transport-fn* transport-fn] 73 | (testing (str (-> transport-fn meta :name) " transport") 74 | (f)) 75 | (set! *print-length* nil) 76 | (set! *print-level* nil)))) 77 | 78 | (def transport-fns 79 | (keys transport-fn->protocol)) 80 | 81 | (defn repl-server-fixture 82 | "This iterates through each transport being tested, starts a server, 83 | runs the test against that server, then cleans up all sessions." 84 | [f] 85 | (doseq [transport-fn transport-fns] 86 | (start-server-for-transport-fn transport-fn f) 87 | (session/close-all-sessions!))) 88 | 89 | (use-fixtures :each repl-server-fixture) 90 | 91 | (defmacro def-repl-test 92 | [name & body] 93 | `(deftest ~name 94 | (with-open [^cnrepl.transport.FnTransport 95 | transport# (connect :port (:port *server*) 96 | :transport-fn *transport-fn*)] 97 | (let [~'transport transport# 98 | ~'client (client transport# Int64/MaxValue) ;;; Long/MAX_VALUE 99 | ~'session (client-session ~'client) 100 | ~'timeout-client (client transport# 1000) 101 | ~'timeout-session (client-session ~'timeout-client) 102 | ~'repl-eval #(message % {:op "eval" :code %2}) 103 | ~'repl-values (comp response-values ~'repl-eval)] 104 | ~@body)))) 105 | 106 | (defn- strict-transport? [] 107 | ;; TODO: add transit here. 108 | (or (= *transport-fn* #'transport/edn) 109 | (when-require 'fastlane.core 110 | (or (= *transport-fn* #'fastlane.core/transit+msgpack) 111 | (= *transport-fn* #'fastlane.core/transit+json) 112 | (= *transport-fn* #'fastlane.core/transit+json-verbose))))) 113 | 114 | (defn- check-response-format 115 | "checks response against spec, if available it to do a spec check later" 116 | [resp] 117 | (when-require 'cnrepl.spec 118 | (when-not (#'clojure.spec.alpha/valid? :cnrepl.spec/message resp) 119 | (throw (Exception. ^String (#'clojure.spec.alpha/explain-str :cnrepl.spec/message resp))))) 120 | resp) 121 | 122 | (defn clean-response 123 | "Cleans a response to help testing. 124 | 125 | This manually coerces bencode responses to (close) to what the raw EDN 126 | response is, so we can standardise testing around the richer format. It 127 | retains strictness on EDN transports. 128 | 129 | - de-identifies the response 130 | - ensures the status to a set of keywords 131 | - turn the content of truncated-keys to keywords" 132 | [resp] 133 | (let [de-identify 134 | (fn [resp] 135 | (dissoc resp :id :session)) 136 | normalize-status 137 | (fn [resp] 138 | (if-let [status (:status resp)] 139 | (assoc resp :status (set (map keyword status))) 140 | resp)) 141 | ;; This is a good example of a middleware details that's showing through 142 | keywordize-truncated-keys 143 | (fn [resp] 144 | (if (contains? resp ::middleware.print/truncated-keys) 145 | (update resp ::middleware.print/truncated-keys #(mapv keyword %)) 146 | resp))] 147 | (cond-> resp 148 | true de-identify 149 | (not (strict-transport?)) normalize-status 150 | (not (strict-transport?)) keywordize-truncated-keys 151 | (strict-transport?) check-response-format))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/load_file.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.load-file 2 | {:author "Chas Emerick"} 3 | (:require 4 | [cnrepl.middleware :as middleware :refer [set-descriptor!]] [cnrepl.debug :as debug] 5 | [cnrepl.middleware.caught :as caught] 6 | [cnrepl.middleware.interruptible-eval :as eval] 7 | [cnrepl.middleware.print :as print]) 8 | (:import cnrepl.transport.Transport)) 9 | 10 | ;; need to hold file contents "out of band" so as to avoid JVM method 11 | ;; size limitations (cannot eval an expression larger than some size 12 | ;; [64k?]), so the naive approach of just interpolating file contents 13 | ;; into an expression to be evaluated doesn't work 14 | ;; see http://code.google.com/p/counterclockwise/issues/detail?id=429 15 | ;; and http://groups.google.com/group/clojure/browse_thread/thread/f54044da06b9939f 16 | (defonce ^{:private true 17 | :doc "An atom that temporarily holds the contents of files to 18 | be loaded."} file-contents (atom {})) 19 | 20 | (defn- load-large-file-code 21 | "A variant of `load-file-code` that returns an 22 | expression that will only work if evaluated within the same process 23 | where it was called. Here to work around the JVM method size limit 24 | so that (by default, for those tools using the load-file middleware) 25 | loading files of any size will work when the nREPL server is running 26 | remotely or locally." 27 | [file file-path file-name] 28 | #_(debug/prn-thread (str "load-large-file-code: " file-path ", " file-name ", " file)) 29 | ;; mini TTL impl so that any code orphaned by errors that occur 30 | ;; between here and the evaluation of the Compiler/load expression 31 | ;; below are cleaned up on subsequent loads 32 | (let [t (Environment/TickCount) ;;; System/currentTimeMillis 33 | file-key ^{:t t} [file-path (gensym)]] 34 | (swap! file-contents 35 | (fn [file-contents] 36 | (let [expired-keys 37 | (filter 38 | (comp #(and % 39 | (< 100000000 (- (Environment/TickCount) %))) ;;; (< 10000 (- (System/currentTimeMillis) %)) -- need to switch to ticks 40 | :t meta) 41 | (keys file-contents))] 42 | (assoc (apply dissoc file-contents expired-keys) 43 | file-key file)))) 44 | (binding [*print-length* nil 45 | *print-level* nil] 46 | (pr-str `(try 47 | (clojure.lang.Compiler/load 48 | (System.IO.StringReader. (@@(var file-contents) '~file-key)) ;;; java.io.StringReader. 49 | ~file-path 50 | ~file-name 51 | ~file-name) 52 | (finally 53 | (swap! @(var file-contents) dissoc '~file-key))))))) 54 | 55 | (defn ^{:dynamic true} load-file-code 56 | "Given the contents of a file, its _source-path-relative_ path, 57 | and its filename, returns a string of code containing a single 58 | expression that, when evaluated, will load those contents with 59 | appropriate filename references and line numbers in metadata, etc. 60 | 61 | Note that because a single expression is produced, very large 62 | file loads will fail due to the JVM method size limitation. 63 | In such cases, see `load-large-file-code'`." 64 | [file file-path file-name] 65 | #_(debug/prn-thread (str "load-file-code: " file-path ", " file-name ", " file)) 66 | (apply format 67 | "(clojure.lang.Compiler/load (System.IO.StringReader. %s) %s %s %s)" ;;; java.io.StringReader. Add nil (load needs four args) 68 | (map (fn [item] 69 | (binding [*print-length* nil 70 | *print-level* nil] 71 | (pr-str item))) 72 | [file file-path file-path file-name]))) 73 | 74 | (defn wrap-load-file 75 | "Middleware that evaluates a file's contents, as per load-file, 76 | but with all data supplied in the sent message (i.e. safe for use 77 | with remote REPL environments). 78 | 79 | This middleware depends on the availability of an :op \"eval\" 80 | middleware below it (such as interruptible-eval)." 81 | [h] 82 | (fn [{:keys [op file file-name file-path ^Transport transport] :as msg}] 83 | (if (not= op "load-file") 84 | (h msg) 85 | (h (assoc (dissoc msg :file :file-name :file-path) 86 | :op "eval" 87 | :code ((if (thread-bound? #'load-file-code) 88 | load-file-code 89 | load-file-code) ;;; load-large-file-code -- do we need this? 90 | file file-path file-name) 91 | :transport (reify Transport 92 | (recv [this] (.recv transport)) 93 | (recv [this timeout] (.recv transport timeout)) 94 | (send [this resp] 95 | ;; *ns* is always 'user' after loading a file, so 96 | ;; *remove it to avoid confusing tools that assume any 97 | ;; *:ns always reports *ns* 98 | (.send transport (dissoc resp :ns)) 99 | this))))))) 100 | 101 | (set-descriptor! #'wrap-load-file 102 | {:requires #{#'caught/wrap-caught #'print/wrap-print} 103 | :expects #{"eval"} 104 | :handles {"load-file" 105 | {:doc "Loads a body of code, using supplied path and filename info to set source file and line number metadata. Delegates to underlying \"eval\" middleware/handler." 106 | :requires {"file" "Full contents of a file of code."} 107 | :optional (merge caught/wrap-caught-optional-arguments 108 | print/wrap-print-optional-arguments 109 | {"file-path" "Source-path-relative path of the source file, e.g. clojure/java/io.clj" 110 | "file-name" "Name of source file, e.g. io.clj"}) 111 | :returns (-> (meta #'eval/interruptible-eval) 112 | ::middleware/descriptor 113 | :handles 114 | (get "eval") 115 | :returns 116 | (dissoc "ns"))}}}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/misc.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.misc 2 | "Misc utilities used in nREPL's implementation (potentially also 3 | useful for anyone extending it)." 4 | {:author "Chas Emerick"} 5 | (:refer-clojure :exclude [requiring-resolve]) 6 | (:require [clojure.clr.io :as io])) 7 | 8 | (defn log 9 | [ex & msgs] 10 | (let [ex (when (instance? Exception ex) ex) ;;; Throwable 11 | msgs (if ex msgs (cons ex msgs))] 12 | (binding [*out* *err*] 13 | (apply println "ERROR:" (.Message ex) msgs) 14 | (when ex (println (.StackTrace ^Exception ex)))))) ;;; (.printStackTrace ^Throwable ex) 15 | 16 | (defmacro noisy-future 17 | "Executes body in a future, logging any exceptions that make it to the 18 | top level." 19 | [& body] 20 | `(future 21 | (try 22 | ~@body 23 | (catch Exception ex# ;;; Throwable 24 | (log ex#) 25 | (throw ex#))))) 26 | 27 | (defmacro returning 28 | "Executes `body`, returning `x`." 29 | {:style/indent 1} 30 | [x & body] 31 | `(let [x# ~x] ~@body x#)) 32 | 33 | (defn uuid 34 | "Returns a new UUID string." 35 | [] 36 | (str (Guid/NewGuid))) ;;; java.util.UUID/randomUUID 37 | 38 | (defn response-for 39 | "Returns a map containing the :session and :id from the \"request\" `msg` 40 | as well as all entries specified in `response-data`, which can be one 41 | or more maps (which will be merged), *or* key-value pairs. 42 | 43 | (response-for msg :status :done :value \"5\") 44 | (response-for msg {:status :interrupted}) 45 | 46 | The :session value in `msg` may be any Clojure reference type (to accommodate 47 | likely implementations of sessions) that has an :id slot in its metadata, 48 | or a string." 49 | [{:keys [session id]} & response-data] 50 | {:pre [(seq response-data)]} 51 | (let [{:keys [status] :as response} (if (map? (first response-data)) 52 | (reduce merge response-data) 53 | (apply hash-map response-data)) 54 | response (if (not status) 55 | response 56 | (assoc response :status (if (coll? status) 57 | status 58 | #{status}))) 59 | basis (merge (when id {:id id}) 60 | ;; AReference should make this suitable for any session implementation? 61 | (when session {:session (if (instance? clojure.lang.AReference session) 62 | (-> session meta :id) 63 | session)}))] 64 | (merge basis response))) 65 | 66 | (defn requiring-resolve 67 | "Resolves namespace-qualified sym per 'resolve'. If initial resolve fails, 68 | attempts to require sym's namespace and retries. Returns nil if sym could not 69 | be resolved." 70 | [sym & [log?]] 71 | (or (resolve sym) 72 | (try 73 | (require (symbol (namespace sym))) 74 | (resolve sym) 75 | (catch Exception e 76 | (when log? 77 | (log e)))))) 78 | 79 | (defmacro with-session-classloader ;;; for now, definitely a no-op 80 | "This macro does two things: 81 | 82 | 1. If the session has a classloader set, then execute the body using that. 83 | This is typically used to trigger the sideloader, when active. 84 | 85 | 2. Bind `clojure.lang.Compiler/LOADER` to the context classloader, which 86 | might also be the sideloader. This is required to get hotloading with 87 | pomegranate working under certain conditions." 88 | [session & body] 89 | `(let [ctxcl# nil ;;; ctxcl# (.getContextClassLoader (Thread/currentThread)) 90 | ;;; alt-cl# (when-let [classloader# (:classloader (meta ~session)) 91 | ;;; (classloader#)) 92 | cl# nil ] ;;; cl# (or alt-cl# ctxcl#) 93 | (if (= ctxcl# cl#) 94 | (with-bindings {} ;;; clojure.lang.Compiler/LOADER cl# 95 | ~@body) 96 | (do 97 | ;;; (.setContextClassLoader (Thread/currentThread) cl#) 98 | (try 99 | (with-bindings {} ;;; clojure.lang.Compiler/LOADER cl# 100 | ~@body) 101 | (finally 102 | )))))) ;;; (.setContextClassLoader (Thread/currentThread) ctxcl#) 103 | 104 | (defn java-8? ;;; definitely a no-oop. 105 | "Util to check if we are using Java 8. Useful for features that behave 106 | differently after version 8." 107 | [] 108 | false) ;;; (.startsWith (System/getProperty "java.runtime.version") 109 | ;;; "1.8") 110 | 111 | (def safe-var-metadata 112 | "A list of var metadata attributes are safe to return to the clients. 113 | We need to guard ourselves against EDN data that's not encodeable/decodable 114 | with bencode. We also optimize the response payloads by not returning 115 | redundant metadata." 116 | [:ns :name :doc :file :arglists :forms :macro :special-form 117 | :protocol :line :column :added :deprecated :resource]) 118 | 119 | (defn- handle-file-meta 120 | "Convert :file metadata to string. 121 | Typically `value` would be a string, a File or an URL." 122 | [value] 123 | (when value 124 | (str (if (string? value) 125 | ;; try to convert relative file paths like "clojure/core.clj" 126 | ;; to absolute file paths 127 | (or #_(io/resource value) value) ;;; we don't have io/resource -- what is the equiv? 128 | ;; If :file is a File or URL object we just return it as is 129 | ;; and convert it to string 130 | value)))) 131 | 132 | (defn sanitize-meta 133 | "Sanitize a Clojure metadata map such that it can be bencoded." 134 | [m] 135 | (-> m 136 | (select-keys safe-var-metadata) 137 | (update :ns str) 138 | (update :name str) 139 | (update :protocol str) 140 | (update :file handle-file-meta) 141 | (cond-> (:macro m) (update :macro str)) 142 | (cond-> (:special-form m) (update :special-form str)) 143 | (assoc :arglists-str (str (:arglists m))) 144 | (cond-> (:arglists m) (update :arglists str)))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/sideloader.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.sideloader 2 | "Support the ability to interactively load resources (including Clojure source 3 | files) and classes from the client. This can be used to add dependencies to 4 | the nREPL environment after initial startup." 5 | {:author "Christophe Grand" 6 | :added "0.7"} 7 | (:require 8 | [clojure.clr.io :as io] ;;; clojure.java.io 9 | [cnrepl.middleware :as middleware :refer [set-descriptor!]] 10 | [cnrepl.misc :refer [response-for]] 11 | [cnrepl.transport :as t])) 12 | ;;;;;;;;;;;;;;;;;; Making this a no-op for now -- no idea what the equivalent would be in CLR ;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; TODO: dedup with base64 in elisions branch once both are merged 14 | (defn base64-encode [^System.IO.Stream in] ;;; ^java.io.InputStream 15 | (let [table "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 16 | sb (StringBuilder.)] 17 | (loop [shift 4 buf 0] 18 | (let [got (.Read in)] ;;; .read 19 | (if (neg? got) 20 | (do 21 | (when-not (= shift 4) 22 | (let [n (bit-and (bit-shift-right buf 6) 63)] 23 | (.Append sb (.get_Chars table n)))) ;;; .append .charAt 24 | (cond 25 | (= shift 2) (.append sb "==") 26 | (= shift 0) (.append sb \=)) 27 | (str sb)) 28 | (let [buf (bit-or buf (bit-shift-left got shift)) 29 | n (bit-and (bit-shift-right buf 6) 63)] 30 | (.Append sb (.get_Chars table n)) ;;; .append .charAt 31 | (let [shift (- shift 2)] 32 | (if (neg? shift) 33 | (do 34 | (.Append sb (.get_Chars table (bit-and buf 63))) ;;; .append .charAt 35 | (recur 4 0)) 36 | (recur shift (bit-shift-left buf 6)))))))))) 37 | 38 | (defn base64-decode [^String s] 39 | (let [table "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 40 | in (System.IO.StringReader. s) ;;; java.io.StringReader. 41 | bos (System.IO.MemoryStream.)] ;;; java.io.ByteArrayOutputStream. 42 | (loop [bits 0 buf 0] 43 | (let [got (.Read in)] ;;; .read 44 | (when-not (or (neg? got) (= 61 got)) 45 | (let [table-idx (.IndexOf table got)] ;;; .indexOf 46 | (if (= -1 table-idx) 47 | (recur bits buf) 48 | (let [buf (bit-or table-idx (bit-shift-left buf 6)) 49 | bits (+ bits 6)] 50 | (if (<= 8 bits) 51 | (let [bits (- bits 8)] 52 | (.Write bos (bit-shift-right buf bits)) ;;; .write 53 | (recur bits (bit-and 63 buf))) 54 | (recur bits buf)))))))) 55 | (.ToArray bos))) ;;; .toByteArray 56 | 57 | (defn- sideloader 58 | "Creates a classloader that obey standard delegating policy." 59 | [{:keys [session id transport] :as msg} pending] 60 | (fn [] nil)) 61 | #_(let [resolve-fn 62 | (fn [type name] 63 | (let [p (promise)] 64 | ;; Swap into the atom *before* sending the lookup request to ensure that the server 65 | ;; knows about the pending request when the client sends the response. 66 | (swap! pending assoc [(clojure.core/name type) name] p) 67 | (t/send transport (response-for msg 68 | {:status :sideloader-lookup 69 | :type type 70 | :name name})) 71 | @p))] 72 | (proxy [clojure.lang.DynamicClassLoader] [(.getContextClassLoader (Thread/currentThread))] 73 | (findResource [name] 74 | (when-some [bytes (resolve-fn "resource" name)] 75 | (let [file (doto (java.io.File/createTempFile "nrepl-sideload-" (str "-" (re-find #"[^/]*$" name))) 76 | .deleteOnExit)] 77 | (io/copy bytes file) 78 | (-> file .toURI .toURL)))) 79 | (findClass [name] 80 | (if-some [bytes (resolve-fn "class" name)] 81 | (.defineClass ^clojure.lang.DynamicClassLoader this name bytes nil) 82 | (throw (ClassNotFoundException. name)))))) 83 | 84 | (defn wrap-sideloader 85 | "Middleware that enables the client to serve resources and classes to the server." 86 | [h] 87 | (let [pending (atom {})] 88 | (fn [{:keys [op type name content transport session] :as msg}] 89 | (case op 90 | "sideloader-start" 91 | (alter-meta! session assoc 92 | :classloader (sideloader msg pending) 93 | ::pending pending)) 94 | 95 | "sideloader-provide" 96 | (let [pending (::pending (meta session))] 97 | (if-some [p (and pending (@pending [type name]))] 98 | (do 99 | (deliver p (let [bytes (base64-decode content)] 100 | (when (pos? (count bytes)) 101 | bytes))) 102 | (swap! pending dissoc [type name]) 103 | (t/send transport (response-for msg {:status :done}))) 104 | (t/send transport (response-for msg {:status #{:done :unexpected-provide} 105 | :type type 106 | :name name})))) 107 | 108 | (h msg)))) 109 | 110 | (set-descriptor! #'wrap-sideloader 111 | {:requires #{"clone"} 112 | :expects #{"eval"} 113 | :handles {"sideloader-start" 114 | {:doc "Starts a sideloading session." 115 | :requires {"session" "the id of the session"} 116 | :optional {} 117 | :returns {"status" "\"sideloader-lookup\", never ever returns \"done\"."}} 118 | "sideloader-provide" 119 | {:doc "Provides a requested class or resource." 120 | :requires {"session" "the id of the session" 121 | "content" "base64 string" 122 | "type" "\"class\" or \"resource\"" 123 | "name" "the class or resource name"} 124 | :optional {} 125 | :returns {}}}}) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.core-test 2 | (:require 3 | [clojure.clr.io :as io] ;;; clojure.java.io 4 | [clojure.main] 5 | [clojure.set :as set] 6 | [clojure.test :refer [are deftest is testing use-fixtures]] 7 | [cnrepl.core :as cnrepl :refer [client 8 | client-session 9 | code 10 | combine-responses 11 | connect 12 | message 13 | new-session 14 | read-response-value 15 | response-seq 16 | response-values 17 | url-connect]] 18 | [cnrepl.ack :as ack] 19 | [cnrepl.middleware.caught :as middleware.caught] 20 | [cnrepl.middleware.print :as middleware.print] 21 | [cnrepl.middleware.session :as session] 22 | [cnrepl.middleware.sideloader :as sideloader] 23 | [cnrepl.misc :refer [uuid]] 24 | [cnrepl.server :as server] 25 | [cnrepl.transport :as transport]) 26 | (:import 27 | (System.IO FileInfo) ;;; (java.io File Writer) 28 | ;;; java.net.SocketException 29 | (cnrepl.server Server))) 30 | 31 | (defmacro when-require [n & body] 32 | (let [nn (eval n)] 33 | (try (require nn) 34 | (catch Exception e nil)) ;;; Throwable 35 | (when (find-ns nn) 36 | `(do ~@body)))) 37 | 38 | (def transport-fn->protocol 39 | "Add your transport-fn var here so it can be tested" 40 | {#'transport/bencode "nrepl" 41 | #'transport/edn "nrepl+edn"}) 42 | 43 | ;; There is a profile that adds the fastlane dependency and test 44 | ;; its transports. 45 | (when-require 'fastlane.core 46 | (def transport-fn->protocol 47 | (merge transport-fn->protocol 48 | {(find-var 'fastlane.core/transit+msgpack) "transit+msgpack" 49 | (find-var 'fastlane.core/transit+json) "transit+json" 50 | (find-var 'fastlane.core/transit+json-verbose) "transit+json-verbose"}))) 51 | 52 | (def ^FileInfo project-base-dir (FileInfo. ".")) ;;; ^File(System/getProperty "nrepl.basedir" ".") 53 | 54 | (def ^:dynamic ^cnrepl.server.Server *server* nil) 55 | (def ^{:dynamic true} *transport-fn* nil) 56 | 57 | (defn start-server-for-transport-fn 58 | [transport-fn f] 59 | (with-open [^Server server (server/start-server :transport-fn transport-fn)] 60 | (binding [*server* server 61 | *transport-fn* transport-fn] 62 | (testing (str (-> transport-fn meta :name) " transport") 63 | (f)) 64 | (set! *print-length* nil) 65 | (set! *print-level* nil)))) 66 | 67 | (def transport-fns 68 | (keys transport-fn->protocol)) 69 | 70 | (defn repl-server-fixture 71 | "This iterates through each transport being tested, starts a server, 72 | runs the test against that server, then cleans up all sessions." 73 | [f] 74 | (doseq [transport-fn transport-fns] 75 | (start-server-for-transport-fn transport-fn f) 76 | (session/close-all-sessions!))) 77 | 78 | (use-fixtures :each repl-server-fixture) 79 | 80 | (defmacro def-repl-test 81 | [name & body] 82 | `(deftest ~name 83 | (with-open [^cnrepl.transport.FnTransport 84 | transport# (connect :port (:port *server*) 85 | :transport-fn *transport-fn*)] 86 | (let [~'transport transport# 87 | ~'client (client transport# Int32/MaxValue) ;;; Long/MAX_VALUE 88 | ~'session (client-session ~'client) 89 | ~'timeout-client (client transport# 1000) 90 | ~'timeout-session (client-session ~'timeout-client) 91 | ~'repl-eval #(message % {:op "eval" :code %2}) 92 | ~'repl-values (comp response-values ~'repl-eval)] 93 | ~@body)))) 94 | 95 | (defn- strict-transport? [] 96 | ;; TODO: add transit here. 97 | (or (= *transport-fn* #'transport/edn) 98 | (when-require 'fastlane.core 99 | (or (= *transport-fn* #'fastlane.core/transit+msgpack) 100 | (= *transport-fn* #'fastlane.core/transit+json) 101 | (= *transport-fn* #'fastlane.core/transit+json-verbose))))) 102 | 103 | (defn- check-response-format 104 | "checks response against spec, if available it to do a spec check later" 105 | [resp] 106 | (when-require 'cnrepl.spec 107 | (when-not (#'clojure.spec.alpha/valid? :cnrepl.spec/message resp) 108 | (throw (Exception. ^String (#'clojure.spec.alpha/explain-str :cnrepl.spec/message resp))))) 109 | resp) 110 | 111 | (defn clean-response 112 | "Cleans a response to help testing. 113 | 114 | This manually coerces bencode responses to (close) to what the raw EDN 115 | response is, so we can standardise testing around the richer format. It 116 | retains strictness on EDN transports. 117 | 118 | - de-identifies the response 119 | - ensures the status to a set of keywords 120 | - turn the content of truncated-keys to keywords" 121 | [resp] 122 | (let [de-identify 123 | (fn [resp] 124 | (dissoc resp :id :session)) 125 | normalize-status 126 | (fn [resp] 127 | (if-let [status (:status resp)] 128 | (assoc resp :status (set (map keyword status))) 129 | resp)) 130 | ;; This is a good example of a middleware details that's showing through 131 | keywordize-truncated-keys 132 | (fn [resp] 133 | (if (contains? resp ::middleware.print/truncated-keys) 134 | (update resp ::middleware.print/truncated-keys #(mapv keyword %)) 135 | resp))] 136 | (cond-> resp 137 | true de-identify 138 | (not (strict-transport?)) normalize-status 139 | (not (strict-transport?)) keywordize-truncated-keys 140 | (strict-transport?) check-response-format))) 141 | 142 | (def-repl-test eval-literals 143 | (are [literal] (= (binding [*ns* (find-ns 'user)] ; needed for the ::keyword 144 | (-> literal read-string eval list)) 145 | (repl-values client literal)) 146 | "5" 147 | "0xff" 148 | "5.1" 149 | "-2e12" 150 | "1/4" 151 | "'symbol" 152 | "'namespace/symbol" 153 | ":keyword" 154 | "::local-ns-keyword" 155 | ":other.ns/keyword" 156 | "\"string\"" 157 | "\"string\\nwith\\r\\nlinebreaks\"" 158 | "'(1 2 3)" 159 | "[1 2 3]" 160 | "{1 2 3 4}" 161 | "#{1 2 3 4}") 162 | 163 | (is (= (->> "#\"regex\"" read-string eval list (map str)) 164 | (->> "#\"regex\"" (repl-values client) (map str))))) 165 | 166 | (def-repl-test simple-expressions 167 | (are [expr] (= [(eval expr)] (repl-values client (pr-str expr))) 168 | '(range 40) 169 | '(apply + (range 100)))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/util/completion_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.util.completion-test 2 | "Unit tests for completion utilities." 3 | (:require [clojure.set :as set] 4 | [clojure.test :refer :all] 5 | [cnrepl.util.completion :as completion :refer [completions]])) 6 | 7 | (def t-var "var" nil) 8 | (defn t-fn "fn" [x] x) 9 | (defmacro t-macro "macro" [y] y) 10 | 11 | (defn- candidates 12 | "Return only the candidate names without any additional 13 | metadata for them." 14 | ([prefix] 15 | (candidates prefix *ns*)) 16 | ([prefix ns] 17 | (map :candidate (completions prefix ns)))) 18 | 19 | (defn- distinct-candidates? 20 | "Return true if every candidate occurs in the list of 21 | candidates only once." 22 | ([prefix] 23 | (distinct-candidates? prefix *ns*)) 24 | ([prefix ns] 25 | (apply distinct? (candidates prefix ns)))) 26 | 27 | (deftest completions-test 28 | (testing "var completion" 29 | (is (= '("alength" "alias" "all-ns" "alter" "alter-meta!" "alter-var-root") 30 | (candidates "al" 'clojure.core))) 31 | 32 | (is (= '("cio/make-binary-reader" "cio/make-binary-writer" "cio/make-input-stream" "cio/make-output-stream" "cio/make-text-reader" "cio/make-text-writer") ;;; a bunch of things replaced 33 | (candidates "cio/make" 'clojure.core))) ;;; jio 34 | 35 | (is (= '("clojure.core/alter" "clojure.core/alter-meta!" "clojure.core/alter-var-root") 36 | (candidates "clojure.core/alt" 'clojure.core))) 37 | 38 | (is (= () (candidates "fake-ns-here/"))) 39 | 40 | (is (= () (candidates "/")))) 41 | 42 | (testing "namespace completion" 43 | (is (= '("cnrepl.util.completion" "cnrepl.util.completion-test") 44 | (candidates "cnrepl.util.comp"))) 45 | 46 | #_(is (set/subset? ;;; I'm not sure wha tthe provlem is -- not getting any of these internals. ClojureCLR bug or completions bug? 47 | #{"clojure.core" "clojure.core.ArrayChunk" "clojure.core.ArrayManager" "clojure.core.IVecImpl" "clojure.core.Vec" "clojure.core.VecNode" "clojure.core.VecSeq" "clojure.core.protocols" "clojure.core.protocols.InternalReduce"} 48 | (set (candidates "clojure.co"))))) 49 | 50 | (testing "Java instance methods completion" 51 | (is (= '(".ToUpper" ".ToUpperInvariant") ;;; .toUpperCase 52 | (candidates ".ToUpper"))) ;;; .toUpper 53 | 54 | (is (distinct-candidates? ".ToString"))) ;;; .toString 55 | 56 | (testing "static members completion" 57 | (is (= '("Console/KeyAvailable") ;;; "System/out" 58 | (candidates "Console/K"))) ;;; "System/o" 59 | 60 | (is (= '("System.Console/KeyAvailable") ;;; "java.lang.System/out" 61 | (candidates "System.Console/KeyAvailable"))) ;;; "java.lang.System/out" 62 | 63 | (is (some #{"String/Concat"} (candidates "String/"))) ;;; "String/valueOf 64 | (is (distinct-candidates? "String/C")) ;;; String/v 65 | 66 | (is (not (some #{"String/IndexOf" ".IndexOf"} (candidates "String/"))))) ;;; indexOf 67 | 68 | (testing "candidate types" 69 | (is (some #{{:candidate "t-var" 70 | :type :var}} 71 | (completions "t-var" 'cnrepl.util.completion-test))) 72 | (is (some #{{:candidate "t-var" 73 | :type :var 74 | :doc "var"}} 75 | (completions "t-var" 'cnrepl.util.completion-test {:extra-metadata #{:arglists :doc}}))) 76 | (is (some #{{:candidate "t-fn" 77 | :type :function}} 78 | (completions "t-fn" 'cnrepl.util.completion-test))) 79 | (is (some #{{:candidate "t-fn" 80 | :type :function 81 | :arglists "([x])" 82 | :doc "fn"}} 83 | (completions "t-fn" 'cnrepl.util.completion-test {:extra-metadata #{:arglists :doc}}))) 84 | (is (some #{{:candidate "t-macro" 85 | :type :macro}} 86 | (completions "t-macro" 'cnrepl.util.completion-test))) 87 | (is (some #{{:candidate "t-macro" 88 | :type :macro 89 | :arglists "([y])" 90 | :doc "macro"}} 91 | (completions "t-macro" 'cnrepl.util.completion-test {:extra-metadata #{:arglists :doc}}))) 92 | (is (some #{{:candidate "unquote" :type :var}} 93 | (completions "unquote" 'clojure.core))) 94 | (is (some #{{:candidate "if" :ns "clojure.core" :type :special-form}} 95 | (completions "if" 'clojure.core))) 96 | (is (some #{{:candidate "ArgumentException" :type :class}} ;;; UnsatisfiedLinkError 97 | (completions "ArgumentEx" 'clojure.core))) ;;; 98 | ;; ns with :doc meta 99 | (is (some #{{:candidate "clojure.core" 100 | :type :namespace}} 101 | (completions "clojure.core" 'clojure.core))) 102 | (is (some #{{:candidate "clojure.core" 103 | :type :namespace 104 | :doc "Fundamental library of the Clojure language"}} 105 | (completions "clojure.core" 'clojure.core {:extra-metadata #{:doc}}))) 106 | ;; ns with docstring argument 107 | (is (some #{{:candidate "cnrepl.util.completion-test" 108 | :type :namespace}} 109 | (completions "cnrepl.util.completion-test" 'clojure.core))) 110 | (is (some #{{:candidate "cnrepl.util.completion-test" 111 | :type :namespace 112 | :doc "Unit tests for completion utilities."}} 113 | (completions "cnrepl.util.completion-test" 'clojure.core {:extra-metadata #{:doc}}))) 114 | (is (some #{{:candidate "Int32/Parse" :type :static-method}} ;;; Integer/parseInt 115 | (completions "Int32/Parse" 'clojure.core))) ;;; Integer/parseInt 116 | (is (some #{{:candidate "Environment/SetEnvironmentVariable", :type :static-method}} ;;; "File/separator" 117 | (completions "Environment/" 'cnrepl.util.completion))) ;;; "File/" 118 | (is (some #{{:candidate ".ToString" :type :method}} ;;;.toString 119 | (completions ".ToString" 'clojure.core))))) ;;;.toString 120 | 121 | (deftest keyword-completions-test 122 | (testing "colon prefix" 123 | (is (set/subset? #{":doc" ":refer" ":refer-clojure"} 124 | (set (candidates ":" *ns*))))) 125 | 126 | (testing "unqualified keywords" 127 | (do #{:t-key-foo :t-key-bar :t-key-baz :t-key/quux} 128 | (is (set/subset? #{":t-key-foo" ":t-key-bar" ":t-key-baz" ":t-key/quux"} 129 | (set (candidates ":t-key" *ns*)))))) 130 | 131 | (testing "auto-resolved unqualified keywords" 132 | (do #{::foo ::bar ::baz} 133 | (is (set/subset? #{":cnrepl.util.completion-test/bar" ":cnrepl.util.completion-test/baz"} 134 | (set (candidates ":cnrepl.util.completion-test/ba" *ns*)))) 135 | (is (set/subset? #{"::bar" "::baz"} 136 | (set (candidates "::ba" 'cnrepl.util.completion-test)))))) 137 | 138 | (testing "auto-resolved qualified keywords" 139 | (do #{:cnrepl.core/aliased-one :cnrepl.core/aliased-two} 140 | (require '[cnrepl.core :as core]) 141 | (is (set/subset? #{"::core/aliased-one" "::core/aliased-two"} 142 | (set (candidates "::core/ali" *ns*)))))) 143 | 144 | (testing "namespace aliases" 145 | (is (set/subset? #{"::set"} 146 | (set (candidates "::s" 'cnrepl.util.completion-test))))) 147 | 148 | (testing "namespace aliases without namespace" 149 | (is (empty? (candidates "::/" *ns*))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/bencode_test.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Meikel Brandmeyer. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | 10 | (ns cnrepl.bencode-test 11 | (:require [clojure.test :refer [are deftest is testing]] 12 | [cnrepl.bencode :as bencode :refer [read-bencode 13 | read-netstring 14 | write-bencode 15 | write-netstring]]) 16 | (:import clojure.lang.RT 17 | System.IO.MemoryStream, clojure.lang.PushbackInputStream)) ;;; [java.io ByteArrayInputStream ByteArrayOutputStream PushbackInputStream] 18 | 19 | (defn #^{:private true} >bytes 20 | [#^String input] 21 | (.GetBytes System.Text.Encoding/UTF8 input)) ;;; (.getBytes input "UTF-8")) 22 | 23 | (defmulti #^{:private true} > input 40 | (map (fn [[k v]] [k ( bytes 46 | MemoryStream. ;;; ByteArrayInputStream. 47 | PushbackInputStream. 48 | reader)) 49 | 50 | (defn- >input 51 | [^String input & args] 52 | (-> (.GetBytes System.Text.Encoding/UTF8 input) ;;; input 53 | ;;; (.getBytes "UTF-8") 54 | (#(apply decode % args)) 55 | input x :reader read-netstring) y) 59 | "0:," "" 60 | "13:Hello, World!," "Hello, World!" 61 | "16:Hällö, Würld!," "Hällö, Würld!" 62 | "25:Здравей, Свят!," "Здравей, Свят!")) 63 | 64 | (deftest test-string-reading 65 | (are [x y] (= (>input x :reader read-bencode) y) 66 | "0:" "" 67 | "13:Hello, World!" "Hello, World!" 68 | "16:Hällö, Würld!" "Hällö, Würld!" 69 | "25:Здравей, Свят!" "Здравей, Свят!")) 70 | 71 | (deftest test-integer-reading 72 | (are [x y] (= (>input x :reader read-bencode) y) 73 | "i0e" 0 74 | "i42e" 42 75 | "i-42e" -42)) 76 | 77 | (deftest test-list-reading 78 | (are [x y] (= (>input x :reader read-bencode) y) 79 | "le" [] 80 | "l6:cheesee" ["cheese"] 81 | "l6:cheese3:ham4:eggse" ["cheese" "ham" "eggs"])) 82 | 83 | (deftest test-map-reading 84 | (are [x y] (= (>input x :reader read-bencode) y) 85 | "de" {} 86 | "d3:ham4:eggse" {"ham" "eggs"})) 87 | 88 | (deftest test-nested-reading 89 | (are [x y] (= (>input x :reader read-bencode) y) 90 | "l6:cheesei42ed3:ham4:eggsee" ["cheese" 42 {"ham" "eggs"}] 91 | "d6:cheesei42e3:haml4:eggsee" {"cheese" 42 "ham" ["eggs"]})) 92 | 93 | (defn- >stream 94 | [thing & {:keys [writer]}] 95 | (doto (MemoryStream.) ;;; (ByteArrayOutputStream.) 96 | (writer thing))) 97 | 98 | (defn- >output 99 | [& args] 100 | (-> >stream 101 | ^MemoryStream (apply args) ;;; ByteArrayOutputStream 102 | (#(.GetString System.Text.Encoding/UTF8 (.ToArray %))))) ;;; (.toString "UTF-8") had to add the .ToArray and also wrap as fn because the GetString takes args in the 'wrong' order. 103 | 104 | (deftest test-netstring-writing 105 | (are [x y] (= (>output (>bytes x) :writer write-netstring) y) 106 | "" "0:," 107 | "Hello, World!" "13:Hello, World!," 108 | "Hällö, Würld!" "16:Hällö, Würld!," 109 | "Здравей, Свят!" "25:Здравей, Свят!,")) 110 | 111 | (deftest test-byte-array-writing 112 | (are [x y] (= (>output (>bytes x) :writer write-bencode) y) 113 | "" "0:" 114 | "Hello, World!" "13:Hello, World!" 115 | "Hällö, Würld!" "16:Hällö, Würld!" 116 | "Здравей, Свят!" "25:Здравей, Свят!")) 117 | 118 | (deftest test-string-writing 119 | (are [x y] (= (>output x :writer write-bencode) y) 120 | "" "0:" 121 | "Hello, World!" "13:Hello, World!" 122 | "Hällö, Würld!" "16:Hällö, Würld!" 123 | "Здравей, Свят!" "25:Здравей, Свят!")) 124 | 125 | (deftest test-input-stream-writing 126 | (are [x y] (= (>output (MemoryStream. (>bytes x)) ;;; ByteArrayInputStream. 127 | :writer write-bencode) y) 128 | "" "0:" 129 | "Hello, World!" "13:Hello, World!" 130 | "Hällö, Würld!" "16:Hällö, Würld!" 131 | "Здравей, Свят!" "25:Здравей, Свят!")) 132 | 133 | (deftest test-integer-writing 134 | (are [x y] (= (>output x :writer write-bencode) y) 135 | 0 "i0e" 136 | 42 "i42e" 137 | -42 "i-42e" 138 | 139 | ;; Works for all integral types. 140 | ;; Note: BigInts (42N) not tested, since they are not 141 | ;; supported in 1.2. 142 | (Byte/Parse "42") "i42e" ;;; Byte/parseByte 10 143 | (Int16/Parse "42") "i42e" ;;; Short/parseShort 10 144 | (Int32/Parse "42") "i42e" ;;; Integer/parseInt 10 145 | (Int64/Parse "42") "i42e")) ;;; Long/parseLong 10 146 | 147 | (deftest test-named-writing 148 | (are [x y] (= (>output x :writer write-bencode) y) 149 | :foo "3:foo" 150 | :foo/bar "7:foo/bar" 151 | 'foo "3:foo" 152 | 'foo/bar "7:foo/bar")) 153 | 154 | (deftest test-list-writing 155 | (are [x y] (= (>output x :writer write-bencode) y) 156 | nil "le" 157 | [] "le" 158 | ["cheese"] "l6:cheesee" 159 | ["cheese" "ham" "eggs"] "l6:cheese3:ham4:eggse")) 160 | 161 | (deftest test-map-writing 162 | (are [x y] (= (>output x :writer write-bencode) y) 163 | {} "de" 164 | {"ham" "eggs"} "d3:ham4:eggse" 165 | {:ham "eggs"} "d3:ham4:eggse" 166 | {'ham "eggs"} "d3:ham4:eggse" 167 | {:h/am "eggs"} "d4:h/am4:eggse")) 168 | 169 | (deftest test-nested-writing 170 | (are [x y] (= (>output x :writer write-bencode) y) 171 | ["cheese" 42 {"ham" "eggs"}] "l6:cheesei42ed3:ham4:eggsee" 172 | {"cheese" 42 "ham" ["eggs"]} "d6:cheesei42e3:haml4:eggsee")) 173 | 174 | (deftest test-lexicographic-sorting 175 | (let [source ["ham" "eggs" "hamburg" "hamburger" "cheese"] 176 | expected ["cheese" "eggs" "ham" "hamburg" "hamburger"] 177 | to-test (->> source 178 | (map >bytes) 179 | (sort @#'cnrepl.bencode/lexicographically) ;;; nrepl. 180 | (map > [119 80 78 71 13 10 26 10 0 0 0 13 73 72 68 82 0 0 0 ;;; -119 80 78 71 13 10 26 10 0 0 0 13 73 72 68 82 0 0 0 187 | 100 0 0 0 100 8 6 0 0 0 112 30 107 84 0 0 3 16 105 ;;; 100 0 0 0 100 8 6 0 0 0 112 -30 -107 84 0 0 3 -16 105 188 | 67 67 80 73 67 67 32 80 114 111 102 105 108 101 0 0 40 ;;; 67 67 80 73 67 67 32 80 114 111 102 105 108 101 0 0 40 189 | 111 115 85 35 111 37 84 20 63 119 111 92 92 22 63 ;;; -111 -115 85 -35 111 -37 84 20 63 -119 111 92 -92 22 63 190 | 96 79 114 14 21 117 81 85 83 91 71 27 26 83 58 6 ;;; -96 -79 -114 14 21 -117 -81 85 83 91 -71 27 26 -83 -58 6 191 | 73 109 91 23 66 26 71 51 40 42 92 55 117 110] ;;; 73 -109 -91 -23 66 26 -71 -51 -40 42 -92 -55 117 110 192 | (map byte) 193 | (into-array System.Byte))] ;;; Byte/TYPE 194 | (is (= (seq binary-data) 195 | (-> {"data" binary-data} 196 | (>stream :writer write-bencode) 197 | .ToArray ;;; .toByteArray 198 | (decode :reader read-bencode) 199 | (get "data") 200 | seq))))) 201 | 202 | #_(deftest unwritable-values 203 | (testing "write-bencode writes eagerly" 204 | (let [out (ByteArrayOutputStream.)] 205 | (is (thrown? IllegalArgumentException 206 | (write-bencode out {"obj" (Object.)}))) 207 | (is (= "d3:obj" (String. (.toByteArray out))))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware 2 | (:refer-clojure :exclude [comparator]) 3 | (:require 4 | [clojure.set :as set] 5 | [cnrepl.misc :as misc] 6 | [cnrepl.transport :as transport] 7 | [cnrepl.version :as version])) 8 | 9 | (defn- var-name 10 | [^clojure.lang.Var v] 11 | (str (.ns v) \/ (.sym v))) 12 | 13 | (defn- wrap-conj-descriptor 14 | [descriptor-map h] 15 | (fn [{:keys [op descriptors] :as msg}] 16 | (h (if-not (= op "describe") 17 | msg 18 | (assoc msg :descriptors (merge descriptor-map descriptors)))))) 19 | 20 | (defn set-descriptor! 21 | "Sets the given [descriptor] map as the ::descriptor metadata on 22 | the provided [middleware-var], after assoc'ing in the var's 23 | fully-qualified name as the descriptor's \"implemented-by\" value." 24 | [middleware-var descriptor] 25 | (let [descriptor (-> descriptor 26 | (assoc :implemented-by (-> middleware-var var-name symbol)) 27 | (update-in [:expects] (fnil conj #{}) "describe"))] 28 | (alter-meta! middleware-var assoc ::descriptor descriptor) 29 | (alter-var-root middleware-var #(comp (partial wrap-conj-descriptor 30 | {middleware-var descriptor}) %)))) 31 | 32 | (defn- safe-version 33 | [m] 34 | (into {} (filter (fn [[_ v]] (or (number? v) (string? v))) m))) 35 | 36 | (defn- clr-version ;;; java-version 37 | [] 38 | (let [version-string (.ToString Environment/Version) ;;; (System/getProperty "java.version") 39 | version-seq (re-seq #"\d+" version-string) 40 | version-map (if (<= 3 (count version-seq)) 41 | (zipmap [:major :minor :incremental :update] version-seq) 42 | {})] 43 | (assoc version-map :version-string version-string))) 44 | 45 | (defn wrap-describe 46 | [h] 47 | (fn [{:keys [op descriptors verbose? transport] :as msg}] 48 | (if (= op "describe") 49 | (transport/send transport (misc/response-for msg 50 | (merge 51 | (when-let [aux (reduce 52 | (fn [aux {:keys [describe-fn]}] 53 | (if describe-fn 54 | (merge aux (describe-fn msg)) 55 | aux)) 56 | nil 57 | (vals descriptors))] 58 | {:aux aux}) 59 | {:ops (let [ops (apply merge (map :handles (vals descriptors)))] 60 | (if verbose? 61 | ops 62 | (zipmap (keys ops) (repeat {})))) 63 | :versions {:nrepl (safe-version version/version) 64 | :clojure (safe-version 65 | (assoc *clojure-version* :version-string (clojure-version))) 66 | :java (safe-version (clr-version))} ;;; java-version 67 | :status :done}))) 68 | (h msg)))) 69 | 70 | (set-descriptor! #'wrap-describe 71 | {:handles {"describe" 72 | {:doc "Produce a machine- and human-readable directory and documentation for the operations supported by an nREPL endpoint." 73 | :requires {} 74 | :optional {"verbose?" "Include informational detail for each \"op\"eration in the return message."} 75 | :returns {"ops" "Map of \"op\"erations supported by this nREPL endpoint" 76 | "versions" "Map containing version maps (like *clojure-version*, e.g. major, minor, incremental, and qualifier keys) for values, component names as keys. Common keys include \"nrepl\" and \"clojure\"." 77 | "aux" "Map of auxiliary data contributed by all of the active nREPL middleware via :describe-fn functions in their descriptors."}}}}) 78 | ;; eliminate implicit expectation of "describe" handler; this is the only 79 | ;; special case introduced by the conj'ing of :expects "describe" by set-descriptor! 80 | (alter-meta! #'wrap-describe update-in [::descriptor :expects] disj "describe") 81 | 82 | (defn- dependencies 83 | [set start dir] 84 | (let [ops (start dir) 85 | deps (set/select 86 | (comp seq (partial set/intersection ops) :handles) 87 | set)] 88 | (when (deps start) 89 | (throw (ArgumentException. ;DM: IllegalArgumentException 90 | (format "Middleware %s depends upon itself via %s" 91 | (:implemented-by start) 92 | dir)))) 93 | (concat ops 94 | (mapcat #(dependencies set % dir) deps)))) 95 | 96 | (defn- comparator 97 | [{a-requires :requires a-expects :expects a-handles :handles} 98 | {b-requires :requires b-expects :expects b-handles :handles}] 99 | (or (->> (into {} [[[a-requires b-handles] -1] 100 | [[a-expects b-handles] 1] 101 | [[b-requires a-handles] 1] 102 | [[b-expects a-handles] -1]]) 103 | (map (fn [[sets ret]] 104 | (and (seq (apply set/intersection sets)) ret))) 105 | (some #{-1 1})) 106 | 0)) 107 | 108 | (defn- extend-deps 109 | [middlewares] 110 | (let [descriptor #(-> % meta ::descriptor) 111 | middlewares (concat middlewares 112 | (->> (map descriptor middlewares) 113 | (mapcat (juxt :expects :requires)) 114 | (mapcat identity) 115 | (filter var?)))] 116 | (doseq [m (remove descriptor middlewares)] 117 | (binding [*out* *err*] 118 | (printf "[WARNING] No nREPL middleware descriptor in metadata of %s, see nrepl.middleware/set-descriptor!" m) 119 | (println))) 120 | (let [middlewares (set (for [m middlewares] 121 | (-> (descriptor m) 122 | ;; only conj'ing m here to support direct reference to 123 | ;; middleware dependencies in :expects and :requires, 124 | ;; e.g. interruptable-eval's dep on 125 | ;; nrepl.middleware.print/wrap-print 126 | (update-in [:handles] (comp set #(conj % m) keys)) 127 | (assoc :implemented-by m))))] 128 | (set (for [m middlewares] 129 | (reduce 130 | #(update-in % [%2] into (dependencies middlewares % %2)) 131 | m #{:expects :requires})))))) 132 | 133 | (defn- topologically-sort 134 | "Topologically sorts the given middlewares according to the comparator, 135 | with the added heuristic that any middlewares that have no dependencies 136 | will be sorted toward the end." 137 | [komparator stack] 138 | (let [stack (vec stack) 139 | ;; using indexes into the above vector as the vertices in the 140 | ;; graph algorithm, will translate back into middlewares at 141 | ;; the end. 142 | vertices (range (count stack)) 143 | edges (for [i1 vertices 144 | i2 (range i1) 145 | :let [x (komparator (stack i1) (stack i2))] 146 | :when (not= 0 x)] 147 | (if (neg? x) [i1 i2] [i2 i1])) 148 | ;; the trivial vertices have no connections, and we pull them 149 | ;; out here so we can make sure they get put on the end 150 | trivial-vertices (remove (set (apply concat edges)) vertices)] 151 | (loop [sorted-vertices [] 152 | remaining-edges edges 153 | remaining-vertices (remove (set trivial-vertices) vertices)] 154 | (if (seq remaining-vertices) 155 | (let [non-initials (->> remaining-edges 156 | (map second) 157 | (set)) 158 | next-vertex (->> remaining-vertices 159 | (remove non-initials) 160 | (first))] 161 | (if next-vertex 162 | (recur (conj sorted-vertices next-vertex) 163 | (remove #((set %) next-vertex) remaining-edges) 164 | (remove #{next-vertex} remaining-vertices)) 165 | ;; Cycle detected! Have to actually assemble a cycle so we 166 | ;; can throw a useful error. 167 | (let [start (first remaining-vertices) 168 | step (into {} remaining-edges) 169 | cycle (->> (iterate step start) 170 | (rest) 171 | (take-while (complement #{start})) 172 | (cons start)) 173 | data {:cycle (map stack cycle)}] 174 | (throw (ex-info 175 | "Unable to satisfy nREPL middleware ordering requirements!" 176 | data))))) 177 | (map stack (concat sorted-vertices trivial-vertices)))))) 178 | 179 | (defn linearize-middleware-stack 180 | [middlewares] 181 | (->> middlewares 182 | extend-deps 183 | (topologically-sort comparator) 184 | (map :implemented-by))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/server.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.server 2 | "Default server implementations" 3 | {:author "Chas Emerick"} 4 | (:require 5 | [cnrepl.ack :as ack] 6 | [cnrepl.middleware.dynamic-loader :as dynamic-loader] 7 | [cnrepl.middleware :as middleware] 8 | cnrepl.middleware.completion 9 | cnrepl.middleware.interruptible-eval 10 | cnrepl.middleware.load-file 11 | cnrepl.middleware.lookup 12 | cnrepl.middleware.session 13 | cnrepl.middleware.sideloader 14 | [cnrepl.misc :refer [log noisy-future response-for returning]] 15 | ;;; [cnrepl.socket :as socket :refer [inet-socket unix-server-socket]] 16 | [cnrepl.tls :as tls] 17 | [cnrepl.transport :as t]) 18 | (:import 19 | [System.Net.Sockets SocketOptionLevel SocketOptionName TcpListener Socket SocketType ProtocolType SocketShutdown SocketException] ;;; (java.net ServerSocket SocketException) 20 | [System.Net IPAddress IPEndPoint])) ;;; [java.nio.channels ClosedChannelException] 21 | 22 | (defn handle* 23 | [msg handler transport] 24 | (try 25 | (handler (assoc msg :transport transport)) 26 | (catch Exception t ;;; Throwable 27 | (log t "Unhandled REPL handler exception processing message" msg)))) 28 | 29 | (defn- normalize-msg 30 | "Normalize messages that are not quite in spec. This comes into effect with 31 | The EDN transport, and other transports that allow more types/data structures 32 | than bencode, as there's more opportunity to be out of specification." 33 | [msg] 34 | (cond-> msg 35 | (keyword? (:op msg)) (update :op name))) 36 | 37 | (defn handle 38 | "Handles requests received via [transport] using [handler]. 39 | Returns nil when [recv] returns nil for the given transport." 40 | [handler transport] 41 | (when-let [msg (normalize-msg (t/recv transport))] 42 | (noisy-future (handle* msg handler transport)) 43 | (recur handler transport))) 44 | 45 | (defn- safe-close 46 | [^IDisposable x] ;;; ^java.io.Closeable 47 | (try 48 | (.Dispose x) ;;; .close 49 | (catch Exception e ;;; java.io.IOException 50 | (log e "Failed to close " x)))) 51 | 52 | (defn- accept-connection 53 | [{:keys [^TcpListener server-socket open-transports transport greeting handler] ;;; ^ServerSocket 54 | :as server}] 55 | (when-let [sock (try 56 | (.Client (.AcceptTcpClient server-socket)) ;;; (socket/accept server-socket) 57 | (catch SocketException _ ;;; ClosedChannelException 58 | nil))] 59 | (noisy-future 60 | (let [transport (transport sock)] 61 | (try 62 | (swap! open-transports conj transport) 63 | (when greeting (greeting transport)) 64 | (handle handler transport) 65 | (catch SocketException _ 66 | nil) 67 | (finally 68 | (swap! open-transports disj transport) 69 | (safe-close transport))))) 70 | (noisy-future 71 | (try 72 | (accept-connection server) 73 | (catch SocketException _ 74 | nil))))) 75 | 76 | (defn stop-server 77 | "Stops a server started via `start-server`." 78 | [{:keys [open-transports ^TcpListener server-socket] :as server}] ;;; ^ServerSocket 79 | (returning server 80 | (.Stop server-socket) ;;; .close 81 | (swap! open-transports 82 | #(reduce 83 | (fn [s t] 84 | ;; should always be true for the socket server... 85 | (if (instance? IDisposable t) ;;; java.io.Closeable 86 | (do 87 | (safe-close t) 88 | (disj s t)) 89 | s)) 90 | % %)))) 91 | 92 | (defn unknown-op 93 | "Sends an :unknown-op :error for the given message." 94 | [{:keys [op transport] :as msg}] 95 | (t/send transport (response-for msg :status #{:error :unknown-op :done} :op op))) 96 | 97 | (def default-middleware 98 | "Middleware vars that are implicitly merged with any additional 99 | middleware provided to nrepl.server/default-handler." 100 | [#'cnrepl.middleware/wrap-describe 101 | #'cnrepl.middleware.completion/wrap-completion 102 | #'cnrepl.middleware.interruptible-eval/interruptible-eval 103 | #'cnrepl.middleware.load-file/wrap-load-file 104 | #'cnrepl.middleware.lookup/wrap-lookup 105 | #'cnrepl.middleware.session/add-stdin 106 | #'cnrepl.middleware.session/session 107 | #_#'cnrepl.middleware.sideloader/wrap-sideloader ;;; Kill this for now until we figure out what it should do. 108 | #'cnrepl.middleware.dynamic-loader/wrap-dynamic-loader]) 109 | 110 | (def built-in-ops 111 | "Get all the op names from default middleware automatically" 112 | (->> default-middleware 113 | (map #(-> % meta :cnrepl.middleware/descriptor :handles keys)) 114 | (reduce concat) 115 | set)) 116 | 117 | (def ^{:deprecated "0.8.0"} default-middlewares 118 | "Use `nrepl.server/default-middleware` instead. Middleware" 119 | default-middleware) 120 | 121 | (defn default-handler 122 | "A default handler supporting interruptible evaluation, stdin, sessions, 123 | readable representations of evaluated expressions via `pr`, sideloading, and 124 | dynamic loading of middleware. 125 | 126 | Additional middleware to mix into the default stack may be provided; these 127 | should all be values (usually vars) that have an nREPL middleware descriptor 128 | in their metadata (see `nrepl.middleware/set-descriptor!`). 129 | 130 | This handler bootstraps by initiating with just the dynamic loader, then 131 | using that to load the other middleware." 132 | [& additional-middleware] 133 | (let [initial-handler (dynamic-loader/wrap-dynamic-loader nil) 134 | state (atom {:handler initial-handler 135 | :stack [#'cnrepl.middleware.dynamic-loader/wrap-dynamic-loader]})] 136 | (binding [dynamic-loader/*state* state] 137 | (initial-handler {:op "swap-middleware" 138 | :state state 139 | :middleware (concat default-middleware additional-middleware)})) 140 | (fn [msg] 141 | (binding [dynamic-loader/*state* state] 142 | ((:handler @state) msg))))) 143 | 144 | (defrecord Server [server-socket port open-transports transport greeting handler] 145 | IDisposable ;;; java.io.Closeable 146 | (Dispose [this] (stop-server this))) ;;; (close [this] (stop-server this)) 147 | 148 | (defn ^Server start-server 149 | "Starts a socket-based nREPL server. Configuration options include: 150 | 151 | * :port — defaults to 0, which autoselects an open port 152 | * :bind — bind address, by default \"127.0.0.1\" 153 | * :socket — filesystem socket path (alternative to :port and :bind). 154 | Note that POSIX does not specify the effect (if any) of the 155 | socket file's permissions (and some systems have ignored them), 156 | so any access control should be arranged via parent directories. 157 | * :tls? - specify `true` to use TLS. 158 | * :tls-keys-file - A file that contains the certificates and private key. 159 | * :tls-keys-str - A string that contains the certificates and private key. 160 | :tls-keys-file or :tls-keys-str must be given if :tls? is true. 161 | * :handler — the nREPL message handler to use for each incoming connection; 162 | defaults to the result of `(default-handler)` 163 | * :transport-fn — a function that, given a java.net.Socket corresponding 164 | to an incoming connection, will return a value satisfying the 165 | nrepl.Transport protocol for that Socket. 166 | * :ack-port — if specified, the port of an already-running server 167 | that will be connected to inform of the new server's port. 168 | Useful only by Clojure tooling implementations. 169 | * :greeting-fn - called after a client connects, receives 170 | a nrepl.transport/Transport. Usually, Clojure-aware client-side tooling 171 | would provide this greeting upon connecting to the server, but telnet et 172 | al. isn't that. See `nrepl.transport/tty-greeting` for an example of such 173 | a function. 174 | 175 | Returns a (record) handle to the server that is started, which may be stopped 176 | either via `stop-server`, (.close server), or automatically via `with-open`. 177 | The port that the server is open on is available in the :port slot of the 178 | server map (useful if the :port option is 0 or was left unspecified)." 179 | [& {:keys [port bind socket tls? tls-keys-str tls-keys-file transport-fn handler ack-port greeting-fn consume-exception]}] 180 | (when (and socket (or port bind tls?)) 181 | (let [msg "Cannot listen on both port and filesystem socket"] 182 | (log msg) 183 | (throw (ex-info msg {:cnrepl/kind ::invalid-start-request})))) 184 | (when (and tls? (not (or tls-keys-str tls-keys-file))) 185 | (let [msg "tls? is true, but tls-keys-str nor tls-keys-file is present"] 186 | (log msg) 187 | (throw (ex-info msg {:cnrepl/kind ::invalid-start-request})))) 188 | (let [transport-fn (or transport-fn t/bencode) 189 | port (or port 0) ;;; ss (cond socket 190 | bind (or bind "127.0.0.1") ;;; (unix-server-socket socket) 191 | ipe (IPEndPoint. (IPAddress/Parse bind) port) ;;; (or tls? (or tls-keys-str tls-keys-file)) 192 | ss (doto (TcpListener. ipe) ;;; (inet-socket bind port (tls/ssl-context-or-throw tls-keys-str tls-keys-file)) 193 | (.Start)) ;; req to pick up the .LocalEndPoint on the server. ;;; :else 194 | ;;; (inet-socket bind port)) 195 | server (Server. ss 196 | (.Port ^IPEndPoint (.LocalEndPoint (.Server ss))) ;;; (when-not socket (.getLocalPort ^ServerSocket ss)) 197 | (atom #{}) 198 | transport-fn 199 | greeting-fn 200 | (or handler (default-handler)))] 201 | (noisy-future 202 | (try 203 | (accept-connection server) 204 | (catch Exception t ;;; Throwable 205 | (cond consume-exception 206 | (consume-exception t) 207 | (instance? SocketException t) 208 | nil 209 | :else 210 | (throw t))))) 211 | (when ack-port 212 | (ack/send-ack (:port server) ack-port transport-fn)) 213 | server)) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/tls.clj: -------------------------------------------------------------------------------- 1 | ; Original code from https://github.com/aphyr/less-awful-ssl/ : 2 | ; Copyright © 2013 Kyle Kingsbury (aphyr@aphyr.com) 3 | ; Distributed under the Eclipse Public License, the same as Clojure. 4 | 5 | ; 2022 Added TLSv1.3, Elliptic Curve support and misc. string utils by Ivar Refsdal (refsdal.ivar@gmail.com) 6 | ;;;;;;;;;; I don't have the patience or energy to try to figure this for the CLR at this time. Maybe someone else can do it. ;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | (ns cnrepl.tls 8 | "Interacting with the Java crypto APIs is one of the worst things you can do 9 | as a developer. I'm so sorry about all of this." 10 | {:added "1.1"} 11 | #_(:require [clojure.java.io :as io :refer [input-stream]] 12 | [clojure.stacktrace] 13 | [clojure.string :as str]) 14 | #_(:import (java.io IOException) 15 | (java.net InetSocketAddress) 16 | (java.security KeyFactory 17 | KeyStore) 18 | (java.security.cert Certificate 19 | CertificateFactory) 20 | (java.security.spec PKCS8EncodedKeySpec) 21 | (javax.net.ssl HandshakeCompletedListener 22 | KeyManager 23 | KeyManagerFactory 24 | SSLContext 25 | SSLException SSLServerSocket 26 | SSLSocket 27 | TrustManager 28 | TrustManagerFactory 29 | X509KeyManager 30 | X509TrustManager))) 31 | 32 | #_(defmacro base64->binary [string] 33 | (if (try (import 'java.util.Base64) 34 | (catch ClassNotFoundException _)) 35 | `(let [^String s# ~string] 36 | (.decode (java.util.Base64/getMimeDecoder) s#)) 37 | (do 38 | (import 'javax.xml.bind.DatatypeConverter) 39 | `(javax.xml.bind.DatatypeConverter/parseBase64Binary ~string)))) 40 | 41 | #_(def ^:private ^CertificateFactory x509-cert-factory 42 | "The X.509 certificate factory" 43 | (CertificateFactory/getInstance "X.509")) 44 | 45 | #_(def ^:private key-store-password 46 | "You know, a mandatory password stored in memory so we can... encrypt... data 47 | stored in memory." 48 | (char-array "GheesBetDyPhuvwotNolofamLydMues9")) 49 | 50 | #_(defn- get-private-key [^PKCS8EncodedKeySpec spec] 51 | (reduce (fn [_ keyFactory] 52 | (try 53 | (let [kf (KeyFactory/getInstance keyFactory)] 54 | (reduced (.generatePrivate kf spec))) 55 | (catch Exception _ 56 | nil))) 57 | nil 58 | ["EC" "RSA"])) 59 | 60 | #_(defn- get-parts [s begin? end?] 61 | (when (string? s) 62 | (loop [res [] 63 | curr [] 64 | consume? false 65 | [lin & rst :as lines] (str/split-lines s)] 66 | (cond (empty? lines) 67 | res 68 | 69 | (begin? lin) 70 | (recur res (conj curr lin) true rst) 71 | 72 | (end? lin) 73 | (recur (conj res (str/join "\n" (conj curr lin))) [] false rst) 74 | 75 | consume? 76 | (recur res (conj curr lin) true rst) 77 | 78 | (false? consume?) 79 | (recur res curr false rst))))) 80 | 81 | #_(defn- str->private-key [s] 82 | (some->> s 83 | ; LOL Java 84 | (re-find #"(?ms)^-----BEGIN ?.*? PRIVATE KEY-----$(.+)^-----END ?.*? PRIVATE KEY-----$") 85 | last 86 | base64->binary 87 | PKCS8EncodedKeySpec. 88 | get-private-key)) 89 | 90 | #_(defn- get-certs [cert-str] 91 | (get-parts cert-str 92 | (fn [s] (= (str/trim s) "-----BEGIN CERTIFICATE-----")) 93 | (fn [s] (= (str/trim s) "-----END CERTIFICATE-----")))) 94 | 95 | #_(defn- str->ca-certificate [cert] 96 | (first (get-certs cert))) 97 | 98 | #_(defn- str->self-certificate [cert] 99 | (second (get-certs cert))) 100 | 101 | #_(defn- ^Certificate str->certificate 102 | "Loads an X.509 certificate from a string." 103 | [tls-keys-str] 104 | (with-open [stream (input-stream (.getBytes ^String (str->ca-certificate tls-keys-str)))] 105 | (.generateCertificate x509-cert-factory stream))) 106 | 107 | #_(defn- ^"[Ljava.security.cert.Certificate;" str->certificates 108 | "Loads an X.509 certificate chain from a string." 109 | [tls-keys-str] 110 | (let [self-cert (str->self-certificate tls-keys-str)] 111 | (with-open [stream (input-stream (.getBytes ^String self-cert))] 112 | (let [^"[Ljava.security.cert.Certificate;" ar (make-array Certificate 0)] 113 | (.toArray (.generateCertificates x509-cert-factory stream) ar))))) 114 | 115 | #_(defn- key-store 116 | "Makes a keystore from a private key and a public certificate" 117 | [key certs] 118 | (doto (KeyStore/getInstance (KeyStore/getDefaultType)) 119 | (.load nil nil) 120 | ; alias, private key, password, certificate chain 121 | (.setKeyEntry "cert" key key-store-password certs))) 122 | 123 | #_(defn- trust-store 124 | "Makes a trust store, suitable for backing a TrustManager, out of a CA cert." 125 | [ca-cert] 126 | (doto (KeyStore/getInstance "JKS") 127 | (.load nil nil) 128 | (.setCertificateEntry "cacert" ca-cert))) 129 | 130 | #_(defn- trust-manager 131 | "An X.509 trust manager for a KeyStore." 132 | [^KeyStore key-store] 133 | (let [factory (TrustManagerFactory/getInstance "PKIX" "SunJSSE")] 134 | ; I'm concerned that getInstance might return the *same* factory each time, 135 | ; so we'll defensively lock before mutating here: 136 | (locking factory 137 | (->> (doto factory (.init key-store)) 138 | .getTrustManagers 139 | (filter (partial instance? X509TrustManager)) 140 | first)))) 141 | 142 | #_(defn- key-manager 143 | "An X.509 key manager for a KeyStore." 144 | ([key-store password] 145 | (let [factory (KeyManagerFactory/getInstance "SunX509" "SunJSSE")] 146 | (locking factory 147 | (->> (doto factory (.init key-store, password)) 148 | .getKeyManagers 149 | (filter (partial instance? X509KeyManager)) 150 | first)))) 151 | ([key-store] 152 | (key-manager key-store key-store-password))) 153 | 154 | #_(defn- ssl-context-generator 155 | "Returns a function that yields SSL contexts. Takes a PKCS8 key file, a 156 | certificate file, and optionally, a trusted CA certificate used to verify peers." 157 | ([key certs ca-cert] 158 | (let [key-manager (key-manager (key-store key certs)) 159 | trust-manager (trust-manager (trust-store ca-cert))] 160 | (fn build-context [] 161 | (doto (SSLContext/getInstance "TLSv1.3") 162 | (.init (into-array KeyManager [key-manager]) 163 | (into-array TrustManager [trust-manager]) 164 | nil))))) 165 | ([key certs] 166 | (let [key-manager (key-manager (key-store key certs))] 167 | (fn build-context [] 168 | (doto (SSLContext/getInstance "TLSv1.3") 169 | (.init (into-array KeyManager [key-manager]) 170 | nil 171 | nil)))))) 172 | 173 | #_(defn- close-silently [^SSLSocket sock] 174 | (when sock 175 | (try 176 | (.close sock) 177 | nil 178 | (catch IOException _ 179 | nil)))) 180 | 181 | #_(defn- ssl-str-context 182 | "Given a string of a PKCS8 key, a certificate file and a trusted CA certificate 183 | used to verify peers, returns an SSLContext." 184 | [tls-keys-str] 185 | (let [key (str->private-key tls-keys-str) 186 | certs (str->certificates tls-keys-str) 187 | ca-cert (str->certificate tls-keys-str)] 188 | ((ssl-context-generator key certs ca-cert)))) 189 | 190 | #_(defn ssl-context-or-throw 191 | "Create a SSL/TLS context from either a string or a file containing two certificates and a private key. 192 | Throws an exception if the SSL/TLS context could not be created." 193 | [tls-keys-str tls-keys-file] 194 | (cond 195 | (and (some? tls-keys-file) (not (.exists (io/file tls-keys-file)))) 196 | (throw (ex-info (str ":tls-keys-file specified as " tls-keys-file " , but was not found.") 197 | {:cnrepl/kind :cnrepl.server/invalid-start-request})) 198 | 199 | (and (some? tls-keys-file) (.exists (io/file tls-keys-file))) 200 | (try 201 | (ssl-str-context (slurp tls-keys-file)) 202 | (catch Exception e 203 | (throw (ex-info (str "Could not create TLS Context from file " tls-keys-file 204 | " . Error message: " (.getMessage e)) 205 | {:cnrepl/kind :cnrepl.server/invalid-start-request})))) 206 | 207 | (string? tls-keys-str) 208 | (try 209 | (ssl-str-context tls-keys-str) 210 | (catch Exception e 211 | (throw (ex-info (str "Could not create TLS Context from string. " 212 | "Error message: " (.getMessage e)) 213 | {:cnrepl/kind :cnrepl.server/invalid-start-request})))) 214 | 215 | :else 216 | (throw (ex-info (str "Could not create TLS Context. Neither :tls-keys-str nor :tls-keys-file given.") 217 | {:cnrepl/kind :cnrepl.server/invalid-start-request})))) 218 | 219 | #_(def enabled-protocols 220 | "An array of protocols we support." 221 | (into-array String ["TLSv1.3"])) 222 | 223 | #_(defn ^SSLServerSocket server-socket 224 | "Given an SSL context, makes a server SSLSocket." 225 | [^SSLContext context ^String host port] 226 | (let [^SSLServerSocket sock (.. context 227 | getServerSocketFactory 228 | createServerSocket)] 229 | (doto sock 230 | (.bind (InetSocketAddress. host ^int port)) 231 | (.setNeedClientAuth true) 232 | (.setReuseAddress true) 233 | (.setEnabledProtocols enabled-protocols)))) 234 | 235 | #_(defn ^SSLSocket socket 236 | "Given an SSL context, makes a client SSLSocket." 237 | [^SSLContext context ^String host port connect-timeout-ms] 238 | (let [^SSLSocket sock (-> context 239 | .getSocketFactory 240 | (.createSocket))] 241 | (.setEnabledProtocols sock enabled-protocols) 242 | (.connect sock (InetSocketAddress. host ^int port) ^int connect-timeout-ms) 243 | sock)) 244 | 245 | #_(defn accept 246 | "Accepts a new TLS connection. Waits 10 000 milliseconds for the TLS handshake 247 | to complete. Requires that the client certificate is different from the server certificate." 248 | [^SSLServerSocket server] 249 | (let [p (promise) 250 | ^SSLSocket sock (.accept server)] 251 | (.addHandshakeCompletedListener sock 252 | (reify HandshakeCompletedListener 253 | (handshakeCompleted [_ e] 254 | (if (= (into [] (.getLocalCertificates e)) 255 | (into [] (.getPeerCertificates e))) 256 | (deliver p :handshake-bad!) 257 | (deliver p :handshake-ok!))))) 258 | (future 259 | (when (= :timeout (deref p 10000 :timeout)) 260 | (deliver p :handshake-bad!) 261 | (close-silently sock))) 262 | (try 263 | (.startHandshake sock) 264 | (let [v @p] 265 | (if (= v :handshake-bad!) 266 | (close-silently sock) 267 | sock)) 268 | (catch SSLException e 269 | (close-silently sock) 270 | (throw e))))) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/test/clojure/cnrepl/middleware/print_test.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.print-test 2 | "Tests for the print middleware. This does not depend on, or use the `eval` 3 | middleware. Instead, it sends the values to be printed directly in the 4 | `:value` slot, and uses an echo handler to send it back via the printing 5 | transport. 6 | 7 | These tests are transport agnostic, and do not deal with sessions, session 8 | IDs, and message IDs" 9 | (:refer-clojure :exclude [print]) 10 | (:require [clojure.test :refer [deftest is testing]] 11 | [cnrepl.core :refer [combine-responses]] 12 | [cnrepl.middleware.print :as print] 13 | [cnrepl.transport :as t]) 14 | (:import [System.IO TextWriter])) ;;; [java.io Writer] 15 | 16 | (defn echo-handler 17 | [{:keys [transport] :as msg}] 18 | (t/send transport (select-keys msg (::print/keys msg)))) 19 | 20 | (defn test-transport 21 | "This transport just collects messages sent into an atom" 22 | [queue] 23 | (t/fn-transport 24 | nil 25 | #(swap! queue conj %))) 26 | 27 | (defmacro testing-print 28 | "Macro for print tests. Exposes a function `handle`, which takes a msg. 29 | the `:value` in the message will be printed, using whatever extra print 30 | arguments supplied." 31 | {:style/indent 1} 32 | [doc & body] 33 | `(testing ~doc 34 | (let [~'handle (fn [msg#] 35 | (let [print-handler# (print/wrap-print echo-handler) 36 | resps# (atom []) 37 | resp-transport# (test-transport resps#)] 38 | (print-handler# (assoc msg# 39 | :transport resp-transport# 40 | ::print/keys (or (get msg# ::print/keys) 41 | #{:value}))) 42 | (doall @resps#)))] 43 | ~@body))) 44 | 45 | (defn custom-printer 46 | [value ^TextWriter writer opts] ;;; ^Writer 47 | (.Write writer (format "" value (or (:sub opts) "...")))) ;;; .write 48 | 49 | (deftest value-printing 50 | (testing-print "bad symbol should fall back to default printer" 51 | (is (= [{:status #{::print/error} 52 | ::print/error "Couldn't resolve var my.missing.ns/printer"} 53 | {:value "42"}] 54 | (handle {:value 42 55 | ::print/keys #{:value} 56 | ::print/print 'my.missing.ns/printer})))) 57 | (testing-print "custom printing function symbol should be used" 58 | (is (= [{:value ""}] ;;; true 59 | (handle {::print/keys #{:value} 60 | :value true 61 | ::print/print `custom-printer})))) 62 | (testing-print "empty print options are ignored" 63 | (is (= [{:value ""}] 64 | (handle {:value 42 65 | ::print/print `custom-printer 66 | ::print/keys #{:value} 67 | ::print/options {}})))) 68 | (testing-print "options should be passed to printer" 69 | (is (= [{:value ""}] 70 | (handle {:value 3 71 | ::print/print `custom-printer 72 | ::print/keys #{:value} 73 | ::print/options {:sub "bar"}}))))) 74 | 75 | (deftest override-value-printing 76 | (testing-print "custom ::print/keys" 77 | (is (= [{:out "[1 2 3 4 5]"}] 78 | (handle {:value "value" 79 | :out [1 2 3 4 5] 80 | ::print/keys [:out]})))) 81 | (testing-print "empty ::print/keys" 82 | (is (= [{}] 83 | (handle {:value [1 2 3 4 5] 84 | ::print/keys []}))))) 85 | 86 | (deftest streamed-printing 87 | (testing-print "value response arrives before ns response" 88 | (let [responses (handle {:value (range 10) 89 | ::print/stream? 1})] 90 | (is (= [{:value "(0 1 2 3 4 5 6 7 8 9)"} {}] 91 | responses)))) 92 | (testing-print "large output should be streamed" 93 | (let [[resp1 resp2 resp3] 94 | (handle {:value (range 512) 95 | ::print/stream? 1})] 96 | (is (-> resp1 97 | ^String (:value) 98 | (.StartsWith "(0 1 2 3"))) ;;; .startsWith 99 | (is (= {} (dissoc resp1 :value))) 100 | (is (-> resp2 101 | ^String (:value) 102 | (.EndsWith "510 511)"))) ;;; .endsWith 103 | (is (= {} (dissoc resp2 :value))) 104 | (is (= {} resp3)))) 105 | (testing-print "respects buffer-size option" 106 | (is (= [{:value "(0 1 2 3"} 107 | {:value " 4 5 6 7"} 108 | {:value " 8 9 10 "} 109 | {:value "11 12 13"} 110 | {:value " 14 15)"} 111 | {}] 112 | (handle {:value (range 16) 113 | ::print/stream? 1 114 | ::print/buffer-size 8})))) 115 | (testing-print "works with custom printer" 116 | (let [[resp1 resp2 resp3] (handle {:value (range 512) 117 | ::print/stream? 1 118 | ::print/print `custom-printer})] 119 | (is (-> resp1 120 | ^String (:value) 121 | (.StartsWith " resp2 124 | ^String (:value) 125 | (.EndsWith "510 511) ...>"))) ;;; .endsWith 126 | (is (= {} (dissoc resp2 :value))) 127 | (is (= {} resp3)))) 128 | (testing-print "works with custom printer and print-options" 129 | (let [[resp1 resp2 resp3] (handle {:value (range 512) 130 | ::print/stream? 1 131 | ::print/print `custom-printer 132 | ::print/options {:sub "bar"}})] 133 | (is (-> resp1 134 | ^String (:value) 135 | (.StartsWith " resp2 138 | ^String (:value) 139 | (.EndsWith "510 511) bar>"))) ;;; .endsWith 140 | (is (= {} (dissoc resp2 :value))) 141 | (is (= {} resp3))))) 142 | 143 | (deftest multiple-keys 144 | (testing-print "respects buffer-size option" 145 | (is (= [{:value "(0 1 2 3"} 146 | {:value " 4 5 6)"} 147 | {:out "(6 5 4 3"} 148 | {:out " 2 1 0)"} 149 | {}] 150 | (handle {:value (range 7) 151 | :out (reverse (range 7)) 152 | ::print/stream? 1 153 | ::print/buffer-size 8 154 | ::print/keys [:value :out]}))))) 155 | 156 | (deftest print-quota 157 | (testing-print "quota option respected" 158 | (is (= [{:value "(0 1 2 3" ;;; ) adding extra paren so my editor doesn't mislead me. 159 | :status #{::print/truncated} 160 | ::print/truncated-keys [:value]}] 161 | (handle {:value (range 512) 162 | ::print/quota 8})))) 163 | (testing-print "works with streamed printing" 164 | (is (= [{:value "(0 1 2 3"} ;;; )> adding extra paren so my editor doesn't mislead me. 165 | {:status #{::print/truncated}} 166 | {}] 167 | (handle {:value (range 512) 168 | ::print/stream? 1 169 | ::print/quota 8})))) 170 | 171 | (testing-print "works with custom printer" 172 | (is (= [{:value " adding extra paren so my editor doesn't mislead me. 173 | :status #{::print/truncated} 174 | ::print/truncated-keys [:value]}] 175 | (handle {:value (range 512) 176 | ::print/print `custom-printer 177 | ::print/quota 8})))) 178 | (testing-print "works with custom printer and streamed printing" 179 | (is (= [{:value " adding extra paren so my editor doesn't mislead me. 180 | {:status #{::print/truncated}} 181 | {}] 182 | (handle {:value (range 512) 183 | ::print/print `custom-printer 184 | ::print/stream? 1 185 | ::print/quota 8}))))) 186 | 187 | (defn custom-printer-2 188 | [value ^TextWriter writer] ;;; ^Writer 189 | (.Write writer (format "" value))) ;;; .write 190 | 191 | ;; These tests used to the `session-print-configuration` tests from `core-test`. 192 | ;; here, we are simply testing the use of dynamic vars to configure printing 193 | ;; behaviour, thus are not going via the `session` middleware to do that. 194 | 195 | (deftest dynamic-var-print-configuration 196 | (testing-print "setting *print-fn* works" 197 | (is (= [{:value ""}] 198 | (binding [print/*print-fn* custom-printer-2] 199 | (handle {:value (range 10)}))))) 200 | (testing-print "request can still override *print-fn*" 201 | (is (= [{:value ""}] 202 | (binding [print/*print-fn* custom-printer-2] 203 | (handle {:value (range 10) 204 | ::print/print `custom-printer}))))) 205 | (testing-print "setting stream options works" 206 | (is (= [{:value ""} 210 | {}] 211 | (binding [print/*print-fn* custom-printer-2 212 | print/*stream?* true 213 | print/*buffer-size* 8] 214 | (handle {:value (range 10)}))))) 215 | (testing-print "request can still override stream options" 216 | (is (= [{:value ""}] 217 | (binding [print/*print-fn* custom-printer-2 218 | print/*stream?* true 219 | print/*buffer-size* 8] 220 | (handle {:value (range 10) 221 | ::print/stream? nil})))) 222 | 223 | (is (= [{:value ""} 225 | {}] 226 | (binding [print/*print-fn* custom-printer-2 227 | print/*stream?* true 228 | print/*buffer-size* 8] 229 | (handle {:value (range 10) 230 | ::print/buffer-size 16}))))) 231 | (testing-print "setting *quota* works" 232 | (is (= [{:value " transport 46 | (response-seq response-timeout) 47 | tracking-seq)] 48 | (reset! latest-head [0 head]) 49 | head)] 50 | ^{::transport transport ::timeout response-timeout} 51 | (fn this 52 | ([] (or (second @latest-head) 53 | (restart))) 54 | ([msg] 55 | (transport/send transport msg) 56 | (this))))) 57 | 58 | (defn- take-until 59 | "Like (take-while (complement f) coll), but includes the first item in coll that 60 | returns true for f." 61 | [f coll] 62 | (let [[head tail] (split-with (complement f) coll)] 63 | (concat head (take 1 tail)))) 64 | 65 | (defn- delimited-transport-seq 66 | "Returns a function of one arument that performs described below. 67 | The following \"message\" is the argument of the function returned by this function. 68 | 69 | - Merge delimited-slots to the message 70 | - Sends a message via client 71 | - Filter only items related to the delimited-slots of client's response seq 72 | - Returns head of the seq that will terminate 73 | upon receipt of a :status, when :status is an element of termination-statuses" 74 | [client termination-statuses delimited-slots] 75 | (with-meta 76 | (comp (partial take-until (comp #(seq (clojure.set/intersection % termination-statuses)) 77 | set 78 | :status)) 79 | (let [keys (keys delimited-slots)] 80 | (partial filter #(= delimited-slots (select-keys % keys)))) 81 | client 82 | #(merge % delimited-slots)) 83 | (-> (meta client) 84 | (update-in [::termination-statuses] (fnil into #{}) termination-statuses) 85 | (update-in [::taking-until] merge delimited-slots)))) 86 | 87 | (defn message 88 | "Sends a message via [client] with a fixed message :id added to it 89 | by `delimited-transport-seq`. 90 | Returns the head of the client's response seq, filtered to include only 91 | messages related to the message :id that will terminate upon receipt of a 92 | \"done\" :status." 93 | [client {:keys [id] :as msg :or {id (uuid)}}] 94 | (let [f (delimited-transport-seq client #{"done" :done} {:id id})] 95 | (f msg))) 96 | 97 | (defn new-session 98 | "Provokes the creation and retention of a new session, optionally as a clone 99 | of an existing retained session, the id of which must be provided as a :clone 100 | kwarg. Returns the new session's id." 101 | [client & {:keys [clone]}] 102 | (let [resp (first (message client (merge {:op "clone"} (when clone {:session clone}))))] 103 | (or (:new-session resp) 104 | (throw (InvalidOperationException. ;;; IllegalStateException. 105 | (str "Could not open new session; :clone response: " resp)))))) 106 | 107 | (defn client-session 108 | "Returns a function of one argument. Accepts a message that is sent via the 109 | client provided with a fixed :session id added to it. Returns the 110 | head of the client's response seq, filtered to include only 111 | messages related to the :session id that will terminate when the session is 112 | closed." 113 | [client & {:keys [session clone]}] 114 | (let [session (or session (apply new-session client (when clone [:clone clone])))] 115 | (delimited-transport-seq client #{"session-closed"} {:session session}))) 116 | 117 | (defn combine-responses 118 | "Combines the provided seq of response messages into a single response map. 119 | 120 | Certain message slots are combined in special ways: 121 | 122 | - only the last :ns is retained 123 | - :value is accumulated into an ordered collection 124 | - :status and :session are accumulated into a set 125 | - string values (associated with e.g. :out and :err) are concatenated" 126 | [responses] 127 | (reduce 128 | (fn [m [k v]] 129 | (case k 130 | (:id :ns) (assoc m k v) 131 | :value (update-in m [k] (fnil conj []) v) 132 | :status (update-in m [k] (fnil into #{}) v) 133 | :session (update-in m [k] (fnil conj #{}) v) 134 | (if (string? v) 135 | (update-in m [k] #(str % v)) 136 | (assoc m k v)))) 137 | {} (apply concat responses))) 138 | 139 | (defn code* 140 | "Returns a single string containing the pr-str'd representations 141 | of the given expressions." 142 | [& expressions] 143 | (apply str (map pr-str expressions))) 144 | 145 | (defmacro code 146 | "Expands into a string consisting of the macro's body's forms 147 | (literally, no interpolation/quasiquoting of locals or other 148 | references), suitable for use in an `\"eval\"` message, e.g.: 149 | 150 | {:op \"eval\", :code (code (+ 1 1) (slurp \"foo.txt\"))}" 151 | [& body] 152 | (apply code* body)) 153 | 154 | (defn read-response-value 155 | "Returns the provided response message, replacing its :value string with 156 | the result of (read)ing it. Returns the message unchanged if the :value 157 | slot is empty or not a string." 158 | [{:keys [value] :as msg}] 159 | (if-not (string? value) 160 | msg 161 | (try 162 | (assoc msg :value (read-string value)) 163 | (catch Exception e 164 | (throw (InvalidOperationException. (str "Could not read response value: " value) e)))))) ;DM: IllegalStateException 165 | 166 | (defn response-values 167 | "Given a seq of responses (as from response-seq or returned from any function returned 168 | by client or client-session), returns a seq of values read from :value slots found 169 | therein." 170 | [responses] 171 | (->> responses 172 | (map read-response-value) 173 | combine-responses 174 | :value)) 175 | 176 | (defn- tls-connect 177 | [{:keys [port host transport-fn tls-keys-str tls-keys-file]}] 178 | (throw (NotImplementedException. "TLS connections not yet implemented. "))) ;;; (let [tls-context (tls/ssl-context-or-throw tls-keys-str tls-keys-file)] 179 | ;;; (transport-fn (tls/socket tls-context ^String host (int port) 10000))) 180 | 181 | (defn connect 182 | "Connects to a socket-based REPL at the given host (defaults to 127.0.0.1) and port, 183 | or using the supplied socket, returning the Transport (by default `nrepl.transport/bencode`) 184 | for that connection. 185 | 186 | Transports are most easily used with `client`, `client-session`, and 187 | `message`, depending on the semantics desired." 188 | [& {:keys [port host socket transport-fn tls-keys-str tls-keys-file] 189 | :or {transport-fn transport/bencode 190 | host "127.0.0.1"} 191 | :as opts}] 192 | {:pre [transport-fn]} 193 | (cond 194 | socket 195 | (throw (NotImplementedException. "unix sockets not yet implemented")) ;;; (transport-fn (socket/unix-client-socket socket)) 196 | 197 | (or tls-keys-str tls-keys-file) 198 | (throw (NotImplementedException. "TLS connections not yet implemented")) ;;; (tls-connect (assoc opts :transport-fn transport-fn :host host)) 199 | 200 | (and host port) 201 | (transport-fn (.Client (System.Net.Sockets.TcpClient. ^String host (int port)))) ;;; (transport-fn (java.net.Socket. ^String host (int port))) 202 | 203 | :else 204 | (throw (ArgumentException. "A host plus port or a socket must be supplied to connect.")))) ;;; IllegalArgumentException. 205 | 206 | (defn- ^System.Uri to-uri ;;; ^java.net.URI 207 | [x] 208 | {:post [(instance? System.Uri %)]} ;;; java.net.URI 209 | (if (string? x) 210 | (System.Uri. x) ;;; java.net.URI 211 | x)) 212 | 213 | (defn- socket-info 214 | [x] 215 | (let [uri (to-uri x) 216 | port (.Port uri)] ;;; .getPort 217 | (merge {:host (.Host uri)} ;;; .getHost 218 | (when (pos? port) 219 | {:port port})))) 220 | 221 | (def ^{:private false} uri-scheme #(-> (to-uri %) .Scheme .ToLower)) ;;; .getScheme .toLowerCase 222 | 223 | (defmulti url-connect 224 | "Connects to an nREPL endpoint identified by the given URL/URI. Valid 225 | examples include: 226 | 227 | nrepl://192.168.0.12:7889 228 | telnet://localhost:5000 229 | http://your-app-name.heroku.com/repl 230 | 231 | This is a multimethod that dispatches on the scheme of the URI provided 232 | (which can be a string or java.net.URI). By default, implementations for 233 | nrepl (corresponding to using the default bencode transport) and 234 | telnet (using the `nrepl.transport/tty` transport) are 235 | registered. Alternative implementations may add support for other schemes, 236 | such as HTTP, HTTPS, JMX, existing message queues, etc." 237 | uri-scheme) 238 | 239 | ;; TODO: oh so ugly 240 | (defn- add-socket-connect-method! 241 | [protocol connect-defaults] 242 | (defmethod url-connect protocol 243 | [uri] 244 | (apply connect (mapcat identity 245 | (merge connect-defaults 246 | (socket-info uri)))))) 247 | 248 | (add-socket-connect-method! "nrepl+edn" {:transport-fn transport/edn 249 | :port 7888}) 250 | (add-socket-connect-method! "nrepl" {:transport-fn transport/bencode 251 | :port 7888}) 252 | (add-socket-connect-method! "telnet" {:transport-fn transport/tty}) 253 | 254 | (defmethod url-connect :default 255 | [uri] 256 | (throw (ArgumentException. ;;; IllegalArgumentException. 257 | (format "No nREPL support known for scheme %s, url %s" (uri-scheme uri) uri)))) 258 | 259 | (def ^{:deprecated "0.5.0"} version 260 | "Use `nrepl.version/version` instead. 261 | Current version of nREPL. 262 | Map of :major, :minor, :incremental, :qualifier, and :version-string." 263 | version/version) 264 | 265 | (def ^{:deprecated "0.5.0"} version-string 266 | "Use `(:version-string nrepl.version/version)` instead. 267 | Current version of nREPL as a string. 268 | See also `version`." 269 | (:version-string version/version)) -------------------------------------------------------------------------------- /partial-nrepl-nrepl-port/src/main/clojure/cnrepl/middleware/interruptible_eval.clj: -------------------------------------------------------------------------------- 1 | (ns cnrepl.middleware.interruptible-eval 2 | "Supports the ability to evaluation code. The name of the middleware is 3 | slightly misleading, as interrupt is currently supported at a session level 4 | but the name is retained for backwards compatibility." 5 | {:author "Chas Emerick"} 6 | (:require 7 | clojure.main 8 | clojure.test 9 | [cnrepl.middleware :refer [set-descriptor!]] [cnrepl.debug :as debug] 10 | [cnrepl.middleware.caught :as caught] 11 | [cnrepl.middleware.print :as print] 12 | [cnrepl.misc :as misc :refer [response-for ]] ;;; with-session-classloader -- removed 13 | [cnrepl.transport :as t]) 14 | (:import 15 | (clojure.lang Compiler+CompilerException LineNumberingTextReader) ;;;Compiler$CompilerException LineNumberingPushbackReader 16 | (System.IO StringReader TextWriter) ;;;(java.io FilterReader LineNumberReader StringReader Writer) 17 | (System.Threading ThreadInterruptedException))) ;;; (java.lang.reflect Field) 18 | 19 | (def ^:dynamic *msg* 20 | "The message currently being evaluated." 21 | nil) 22 | 23 | (defn- capture-thread-bindings 24 | "Capture thread bindings, excluding nrepl implementation vars." 25 | [] 26 | (dissoc (get-thread-bindings) #'*msg*)) 27 | 28 | (defn- set-line! 29 | [^LineNumberingTextReader reader line] ;;; ^LineNumberingPushbackReader 30 | (-> reader (.set_LineNumber line))) ;;; .setLineNumber 31 | 32 | (defn- set-column! ;;; It would be easier to make the column number settable. Why not, if rown 33 | [^LineNumberingTextReader reader column] ;;; ^LineNumberingPushbackReader 34 | (when-let [field (.GetField LineNumberingTextReader "_columnNumber" ;;; (->> LineNumberingPushbackReader 35 | (enum-or System.Reflection.BindingFlags/NonPublic ;;; (.getDeclaredFields) 36 | System.Reflection.BindingFlags/Instance))] ;;; (filter #(= "_columnNumber" (.getName ^Field %))) 37 | ;;; first) 38 | (.SetValue field reader column) ;;; (-> ^Field field 39 | ;;; (doto (.setAccessible true)) 40 | )) ;;; (.set reader column)) 41 | 42 | (defn- source-logging-pushback-reader 43 | [code line column] 44 | (let [reader (LineNumberingTextReader. (StringReader. code))] ;;; LineNumberingPushbackReader. 45 | (when line (set-line! reader (int line))) 46 | (when column (set-column! reader (int column))) 47 | reader)) 48 | 49 | (defn- interrupted? 50 | "Returns true if the given throwable was ultimately caused by an interrupt." 51 | [^Exception e] ;;; ^Throwable SHOULD THESE BE ThreadAbortException? Only in 461? 52 | (or (instance? ThreadInterruptedException (clojure.main/root-cause e)) ;;; ThreadDeath 53 | (and (instance? Compiler+CompilerException e) ;;; Compiler$CompilerException 54 | (instance? ThreadInterruptedException (.InnerException e))))) ;;; ThreadDeath .getCause 55 | 56 | (defn evaluate 57 | "Evaluates a msg's code within the dynamic context of its session. 58 | 59 | Uses `clojure.main/repl` to drive the evaluation of :code (either a string 60 | or a seq of forms to be evaluated), which may also optionally specify a :ns 61 | (resolved via `find-ns`). The map MUST contain a Transport implementation 62 | in :transport; expression results and errors will be sent via that Transport. 63 | 64 | Note: we are doubling up on restoring of ctxcl in a `catch` block both here 65 | and within `misc/with-session-classloader`. Not too sure why this is needed, 66 | but it does seem to be a fix for https://github.com/nrepl/nrepl/issues/206" 67 | [{:keys [transport session eval ns code file line column out-limit] 68 | :as msg}] 69 | #_(debug/prn-thread "ie/evaluate: " code) 70 | (let [explicit-ns (and ns (-> ns symbol find-ns)) 71 | original-ns (@session #'*ns*) 72 | maybe-restore-original-ns (if explicit-ns 73 | #(assoc % #'*ns* original-ns) 74 | identity)] 75 | (if (and ns (not explicit-ns)) 76 | (t/send transport (response-for msg {:status #{:error :namespace-not-found :done} 77 | :ns ns})) 78 | (let [ ;;; no such thing for CLR: ctxcl (.getContextClassLoader (Thread/currentThread)) 79 | ;; TODO: out-limit -> out-buffer-size | err-buffer-size 80 | ;; TODO: new options: out-quota | err-quota 81 | opts {::print/buffer-size (or out-limit (get (meta session) :out-limit))} 82 | out (print/replying-PrintWriter :out msg opts) 83 | err (print/replying-PrintWriter :err msg opts)] 84 | (try 85 | (clojure.main/repl 86 | :eval (let [eval-fn (if eval (find-var (symbol eval)) clojure.core/eval)] 87 | (fn [form] 88 | (eval-fn form))) ;;; (with-session-classloader session (eval-fn form)) 89 | :init #(let [bindings 90 | (-> (get-thread-bindings) 91 | (into caught/default-bindings) 92 | (into print/default-bindings) 93 | (into @session) 94 | (into {#'*out* out 95 | #'*err* err 96 | ;; clojure.test captures *out* at load-time, so we need to make sure 97 | ;; runtime output of test status/results is redirected properly 98 | ;; TODO: is this something we need to consider in general, or is this 99 | ;; specific hack reasonable? 100 | #'clojure.test/*test-out* out}) 101 | (cond-> explicit-ns (assoc #'*ns* explicit-ns) 102 | file (assoc #'*file* file)))] 103 | (pop-thread-bindings) 104 | (push-thread-bindings bindings)) 105 | :read (if (string? code) 106 | (let [reader (source-logging-pushback-reader code line column) 107 | read-cond (or (-> msg :read-cond keyword) 108 | :allow)] 109 | #(try (read {:read-cond read-cond :eof %2} reader) 110 | (catch Exception e ;;; RuntimeException 111 | ;; If error happens during reading the string, we 112 | ;; don't want eval to start reading and executing the 113 | ;; rest of it. So we skip over the remaining text. 114 | (.ReadToEnd ^LineNumberingTextReader reader) ;;; (.skip ^LineNumberingPushbackReader reader Long/MAX_VALUE) 115 | (throw e)))) 116 | (let [code (.GetEnumerator ^System.Collections.IEnumerable code)] ;;; .iterator ^Iterable 117 | #(or (and (.MoveNext code) (.Current code) ) %2))) ;;; (.hasNext code) (.next code) 118 | :prompt #(reset! session (maybe-restore-original-ns (capture-thread-bindings))) 119 | :need-prompt (constantly true) 120 | :print (fn [value] 121 | ;; *out* has :tag metadata; *err* does not 122 | (.Flush ^TextWriter *err*) ;;; .flush ^Writer 123 | (.Flush ^TextWriter *out*) ;;; .flush -- added type hint TODO -- not clear this is always true, based on a comment I made elsewhere 124 | (t/send transport (response-for msg {:ns (str (ns-name *ns*)) 125 | :value value 126 | ::print/keys #{:value}}))) 127 | :caught (fn [^Exception e] ;;; Throwable 128 | (when-not (interrupted? e) 129 | (let [resp {::caught/throwable e 130 | :status :eval-error 131 | :ex (str (class e)) 132 | :root-ex (str (class (clojure.main/root-cause e)))}] 133 | (t/send transport (response-for msg resp)))))) 134 | (finally 135 | ;;; (when (misc/java-8?) 136 | ;;; (.setContextClassLoader (Thread/currentThread) ctxcl)) 137 | (.Flush ^TextWriter err) ;;; .flush -- added type hint 138 | (.Flush ^TextWriter out))))))) ;;; .flush -- added type hint 139 | 140 | (defn interruptible-eval 141 | "Evaluation middleware that supports interrupts. Returns a handler that supports 142 | \"eval\" and \"interrupt\" :op-erations that delegates to the given handler 143 | otherwise." 144 | [h & configuration] 145 | (fn [{:keys [op session id transport] :as msg}] 146 | (let [{:keys [exec] session-id :id} (meta session)] 147 | (case op 148 | "eval" 149 | (if-not (:code msg) 150 | (t/send transport (response-for msg :status #{:error :no-code :done})) 151 | (exec id 152 | #(binding [*msg* msg] 153 | (evaluate msg)) 154 | #(t/send transport (response-for msg :status :done)))) 155 | (h msg))))) 156 | 157 | (set-descriptor! #'interruptible-eval 158 | {:requires #{"clone" "close" #'caught/wrap-caught #'print/wrap-print} 159 | :expects #{} 160 | :handles {"eval" 161 | {:doc "Evaluates code. Note that unlike regular stream-based Clojure REPLs, nREPL's `\"eval\"` short-circuits on first read error and will not try to read and execute the remaining code in the message." 162 | :requires {"code" "The code to be evaluated." 163 | "session" "The ID of the session within which to evaluate the code."} 164 | :optional (merge caught/wrap-caught-optional-arguments 165 | print/wrap-print-optional-arguments 166 | {"id" "An opaque message ID that will be included in responses related to the evaluation, and which may be used to restrict the scope of a later \"interrupt\" operation." 167 | "eval" "A fully-qualified symbol naming a var whose function value will be used to evaluate [code], instead of `clojure.core/eval` (the default)." 168 | "ns" "The namespace in which to perform the evaluation. The supplied namespace must exist already (e.g. be loaded). If no namespace is specified the evaluation falls back to `*ns*` for the session in question." 169 | "file" "The path to the file containing [code]. `clojure.core/*file*` will be bound to this." 170 | "line" "The line number in [file] at which [code] starts." 171 | "column" "The column number in [file] at which [code] starts." 172 | "read-cond" "The options passed to the reader before the evaluation. Useful when middleware in a higher layer wants to process reader conditionals."}) 173 | :returns {"ns" "*ns*, after successful evaluation of `code`." 174 | "value" "The result of evaluating `code`, often `read`able. This printing is provided by the `print` middleware. Superseded by `ex` and `root-ex` if an exception occurs during evaluation." 175 | "ex" "The type of exception thrown, if any. If present, then `:value` will be absent." 176 | "root-ex" "The type of the root exception thrown, if any. If present, then `:value` will be absent."}}}}) -------------------------------------------------------------------------------- /epl.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Eclipse Public License - Version 1.0 8 | 25 | 26 | 27 | 28 | 29 | 30 |

Eclipse Public License - v 1.0

31 | 32 |

THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 33 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR 34 | DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS 35 | AGREEMENT.

36 | 37 |

1. DEFINITIONS

38 | 39 |

"Contribution" means:

40 | 41 |

a) in the case of the initial Contributor, the initial 42 | code and documentation distributed under this Agreement, and

43 |

b) in the case of each subsequent Contributor:

44 |

i) changes to the Program, and

45 |

ii) additions to the Program;

46 |

where such changes and/or additions to the Program 47 | originate from and are distributed by that particular Contributor. A 48 | Contribution 'originates' from a Contributor if it was added to the 49 | Program by such Contributor itself or anyone acting on such 50 | Contributor's behalf. Contributions do not include additions to the 51 | Program which: (i) are separate modules of software distributed in 52 | conjunction with the Program under their own license agreement, and (ii) 53 | are not derivative works of the Program.

54 | 55 |

"Contributor" means any person or entity that distributes 56 | the Program.

57 | 58 |

"Licensed Patents" mean patent claims licensable by a 59 | Contributor which are necessarily infringed by the use or sale of its 60 | Contribution alone or when combined with the Program.

61 | 62 |

"Program" means the Contributions distributed in accordance 63 | with this Agreement.

64 | 65 |

"Recipient" means anyone who receives the Program under 66 | this Agreement, including all Contributors.

67 | 68 |

2. GRANT OF RIGHTS

69 | 70 |

a) Subject to the terms of this Agreement, each 71 | Contributor hereby grants Recipient a non-exclusive, worldwide, 72 | royalty-free copyright license to reproduce, prepare derivative works 73 | of, publicly display, publicly perform, distribute and sublicense the 74 | Contribution of such Contributor, if any, and such derivative works, in 75 | source code and object code form.

76 | 77 |

b) Subject to the terms of this Agreement, each 78 | Contributor hereby grants Recipient a non-exclusive, worldwide, 79 | royalty-free patent license under Licensed Patents to make, use, sell, 80 | offer to sell, import and otherwise transfer the Contribution of such 81 | Contributor, if any, in source code and object code form. This patent 82 | license shall apply to the combination of the Contribution and the 83 | Program if, at the time the Contribution is added by the Contributor, 84 | such addition of the Contribution causes such combination to be covered 85 | by the Licensed Patents. The patent license shall not apply to any other 86 | combinations which include the Contribution. No hardware per se is 87 | licensed hereunder.

88 | 89 |

c) Recipient understands that although each Contributor 90 | grants the licenses to its Contributions set forth herein, no assurances 91 | are provided by any Contributor that the Program does not infringe the 92 | patent or other intellectual property rights of any other entity. Each 93 | Contributor disclaims any liability to Recipient for claims brought by 94 | any other entity based on infringement of intellectual property rights 95 | or otherwise. As a condition to exercising the rights and licenses 96 | granted hereunder, each Recipient hereby assumes sole responsibility to 97 | secure any other intellectual property rights needed, if any. For 98 | example, if a third party patent license is required to allow Recipient 99 | to distribute the Program, it is Recipient's responsibility to acquire 100 | that license before distributing the Program.

101 | 102 |

d) Each Contributor represents that to its knowledge it 103 | has sufficient copyright rights in its Contribution, if any, to grant 104 | the copyright license set forth in this Agreement.

105 | 106 |

3. REQUIREMENTS

107 | 108 |

A Contributor may choose to distribute the Program in object code 109 | form under its own license agreement, provided that:

110 | 111 |

a) it complies with the terms and conditions of this 112 | Agreement; and

113 | 114 |

b) its license agreement:

115 | 116 |

i) effectively disclaims on behalf of all Contributors 117 | all warranties and conditions, express and implied, including warranties 118 | or conditions of title and non-infringement, and implied warranties or 119 | conditions of merchantability and fitness for a particular purpose;

120 | 121 |

ii) effectively excludes on behalf of all Contributors 122 | all liability for damages, including direct, indirect, special, 123 | incidental and consequential damages, such as lost profits;

124 | 125 |

iii) states that any provisions which differ from this 126 | Agreement are offered by that Contributor alone and not by any other 127 | party; and

128 | 129 |

iv) states that source code for the Program is available 130 | from such Contributor, and informs licensees how to obtain it in a 131 | reasonable manner on or through a medium customarily used for software 132 | exchange.

133 | 134 |

When the Program is made available in source code form:

135 | 136 |

a) it must be made available under this Agreement; and

137 | 138 |

b) a copy of this Agreement must be included with each 139 | copy of the Program.

140 | 141 |

Contributors may not remove or alter any copyright notices contained 142 | within the Program.

143 | 144 |

Each Contributor must identify itself as the originator of its 145 | Contribution, if any, in a manner that reasonably allows subsequent 146 | Recipients to identify the originator of the Contribution.

147 | 148 |

4. COMMERCIAL DISTRIBUTION

149 | 150 |

Commercial distributors of software may accept certain 151 | responsibilities with respect to end users, business partners and the 152 | like. While this license is intended to facilitate the commercial use of 153 | the Program, the Contributor who includes the Program in a commercial 154 | product offering should do so in a manner which does not create 155 | potential liability for other Contributors. Therefore, if a Contributor 156 | includes the Program in a commercial product offering, such Contributor 157 | ("Commercial Contributor") hereby agrees to defend and 158 | indemnify every other Contributor ("Indemnified Contributor") 159 | against any losses, damages and costs (collectively "Losses") 160 | arising from claims, lawsuits and other legal actions brought by a third 161 | party against the Indemnified Contributor to the extent caused by the 162 | acts or omissions of such Commercial Contributor in connection with its 163 | distribution of the Program in a commercial product offering. The 164 | obligations in this section do not apply to any claims or Losses 165 | relating to any actual or alleged intellectual property infringement. In 166 | order to qualify, an Indemnified Contributor must: a) promptly notify 167 | the Commercial Contributor in writing of such claim, and b) allow the 168 | Commercial Contributor to control, and cooperate with the Commercial 169 | Contributor in, the defense and any related settlement negotiations. The 170 | Indemnified Contributor may participate in any such claim at its own 171 | expense.

172 | 173 |

For example, a Contributor might include the Program in a commercial 174 | product offering, Product X. That Contributor is then a Commercial 175 | Contributor. If that Commercial Contributor then makes performance 176 | claims, or offers warranties related to Product X, those performance 177 | claims and warranties are such Commercial Contributor's responsibility 178 | alone. Under this section, the Commercial Contributor would have to 179 | defend claims against the other Contributors related to those 180 | performance claims and warranties, and if a court requires any other 181 | Contributor to pay any damages as a result, the Commercial Contributor 182 | must pay those damages.

183 | 184 |

5. NO WARRANTY

185 | 186 |

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 187 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS 188 | OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, 189 | ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 190 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 191 | responsible for determining the appropriateness of using and 192 | distributing the Program and assumes all risks associated with its 193 | exercise of rights under this Agreement , including but not limited to 194 | the risks and costs of program errors, compliance with applicable laws, 195 | damage to or loss of data, programs or equipment, and unavailability or 196 | interruption of operations.

197 | 198 |

6. DISCLAIMER OF LIABILITY

199 | 200 |

EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT 201 | NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 202 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 203 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 204 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 205 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 206 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 207 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

208 | 209 |

7. GENERAL

210 | 211 |

If any provision of this Agreement is invalid or unenforceable under 212 | applicable law, it shall not affect the validity or enforceability of 213 | the remainder of the terms of this Agreement, and without further action 214 | by the parties hereto, such provision shall be reformed to the minimum 215 | extent necessary to make such provision valid and enforceable.

216 | 217 |

If Recipient institutes patent litigation against any entity 218 | (including a cross-claim or counterclaim in a lawsuit) alleging that the 219 | Program itself (excluding combinations of the Program with other 220 | software or hardware) infringes such Recipient's patent(s), then such 221 | Recipient's rights granted under Section 2(b) shall terminate as of the 222 | date such litigation is filed.

223 | 224 |

All Recipient's rights under this Agreement shall terminate if it 225 | fails to comply with any of the material terms or conditions of this 226 | Agreement and does not cure such failure in a reasonable period of time 227 | after becoming aware of such noncompliance. If all Recipient's rights 228 | under this Agreement terminate, Recipient agrees to cease use and 229 | distribution of the Program as soon as reasonably practicable. However, 230 | Recipient's obligations under this Agreement and any licenses granted by 231 | Recipient relating to the Program shall continue and survive.

232 | 233 |

Everyone is permitted to copy and distribute copies of this 234 | Agreement, but in order to avoid inconsistency the Agreement is 235 | copyrighted and may only be modified in the following manner. The 236 | Agreement Steward reserves the right to publish new versions (including 237 | revisions) of this Agreement from time to time. No one other than the 238 | Agreement Steward has the right to modify this Agreement. The Eclipse 239 | Foundation is the initial Agreement Steward. The Eclipse Foundation may 240 | assign the responsibility to serve as the Agreement Steward to a 241 | suitable separate entity. Each new version of the Agreement will be 242 | given a distinguishing version number. The Program (including 243 | Contributions) may always be distributed subject to the version of the 244 | Agreement under which it was received. In addition, after a new version 245 | of the Agreement is published, Contributor may elect to distribute the 246 | Program (including its Contributions) under the new version. Except as 247 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives no 248 | rights or licenses to the intellectual property of any Contributor under 249 | this Agreement, whether expressly, by implication, estoppel or 250 | otherwise. All rights in the Program not expressly granted under this 251 | Agreement are reserved.

252 | 253 |

This Agreement is governed by the laws of the State of New York and 254 | the intellectual property laws of the United States of America. No party 255 | to this Agreement will bring a legal action under this Agreement more 256 | than one year after the cause of action arose. Each party waives its 257 | rights to a jury trial in any resulting litigation.

258 | 259 | 260 | 261 | --------------------------------------------------------------------------------