diff --git a/README.md b/README.md index 7ee12252..d366c9ab 100644 --- a/README.md +++ b/README.md @@ -172,7 +172,7 @@ Check out the image on [Docker hub](https://hub.docker.com/r/borkdude/babashka/) Usage: bb [ -i | -I ] [ -o | -O ] [ --stream ] [--verbose] [ ( --classpath | -cp ) ] [ --uberscript ] [ ( --main | -m ) | -e | -f | - --repl | --socket-repl [:] ] + --repl | --socket-repl [:] | --nrepl-server [:] ] [ arg* ] Options: @@ -194,6 +194,7 @@ Options: -m, --main Call the -main function from namespace with args. --repl Start REPL. Use rlwrap for history. --socket-repl Start socket REPL. Specify port (e.g. 1666) or host and port separated by colon (e.g. 127.0.0.1:1666). + --nrepl-server Start nREPL server. Specify port (e.g. 1667) or host and port separated by colon (e.g. 127.0.0.1:1667). --time Print execution time before exiting. -- Stop parsing args and pass everything after -- to *command-line-args* diff --git a/deps.edn b/deps.edn index 644d698e..c09a693c 100644 --- a/deps.edn +++ b/deps.edn @@ -9,7 +9,9 @@ org.clojure/data.csv {:mvn/version "1.0.0"}, cheshire {:mvn/version "5.10.0"} fipp {:mvn/version "0.6.22"} - com.cognitect/transit-clj {:mvn/version "1.0.324"}} + com.cognitect/transit-clj {:mvn/version "1.0.324"} + ;; nrepl/bencode {:mvn/version "1.0.0"} + } :aliases {:main {:main-opts ["-m" "babashka.main"]} :profile diff --git a/project.clj b/project.clj index becb1397..8dbf52a2 100644 --- a/project.clj +++ b/project.clj @@ -19,7 +19,8 @@ [org.clojure/data.csv "1.0.0"] [cheshire "5.10.0"] [fipp "0.6.22"] - [com.cognitect/transit-clj "1.0.324"]] + [com.cognitect/transit-clj "1.0.324"] + #_[nrepl/bencode "1.0.0"]] :profiles {:test {:dependencies [[clj-commons/conch "0.9.2"] [com.clojure-goes-fast/clj-async-profiler "0.4.0"]]} :uberjar {:global-vars {*assert* false} diff --git a/src/babashka/impl/bencode.clj b/src/babashka/impl/bencode.clj new file mode 100644 index 00000000..3d452eb6 --- /dev/null +++ b/src/babashka/impl/bencode.clj @@ -0,0 +1,11 @@ +(ns babashka.impl.bencode + {:no-doc true} + (:require [babashka.impl.bencode.core :as bencode] + [sci.impl.namespaces :refer [copy-var]] + [sci.impl.vars :as vars])) + +(def tns (vars/->SciNamespace 'bencode.core nil)) + +(def bencode-namespace + {'read-bencode (copy-var bencode/read-bencode tns) + 'write-bencode (copy-var bencode/write-bencode tns)}) diff --git a/src/babashka/impl/bencode/core.clj b/src/babashka/impl/bencode/core.clj new file mode 100644 index 00000000..20e24e5b --- /dev/null +++ b/src/babashka/impl/bencode/core.clj @@ -0,0 +1,420 @@ +(ns babashka.impl.bencode.core + "A netstring and bencode implementation for Clojure." + {:author "Meikel Brandmeyer" + :no-doc true} + (:require [clojure.java.io :as io]) + (:import [java.io ByteArrayOutputStream + EOFException + InputStream + IOException + OutputStream + PushbackInputStream])) + +;; Copyright (c) Meikel Brandmeyer. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +;; # Motivation +;; +;; In each and every application, which contacts peer processes via some +;; communication channel, the handling of the communication channel is +;; obviously a central part of the application. Unfortunately introduces +;; handling of buffers of varying sizes often bugs in form of buffer +;; overflows and similar. +;; +;; A strong factor in this situation is of course the protocol which goes +;; over the wire. Depending on its design it might be difficult to estimate +;; the size of the input up front. This introduces more handling of message +;; buffers to accomodate for inputs of varying sizes. This is particularly +;; difficult in languages like C, where there is no bounds checking of array +;; accesses and where errors might go unnoticed for considerable amount of +;; time. +;; +;; To address these issues D. Bernstein developed the so called +;; [netstrings][net]. They are especially designed to allow easy construction +;; of the message buffers, easy and robust parsing. +;; +;; BitTorrent extended this to the [bencode][bc] protocol which also +;; includes ways to encode numbers and collections like lists or maps. +;; +;; *wire* is based on these ideas. +;; +;; [net]: http://cr.yp.to/proto/netstrings.txt +;; [bc]: http://wiki.theory.org/BitTorrentSpecification#Bencoding +;; +;; # Netstrings +;; +;; Now let's start with the basic netstrings. They consist of a byte count, +;; followed a colon and the binary data and a trailing comma. Examples: +;; +;; 13:Hello, World!, +;; 10:Guten Tag!, +;; 0:, +;; +;; The initial byte count allows to efficiently allocate a sufficiently +;; sized message buffer. The trailing comma serves as a hint to detect +;; incorrect netstrings. +;; +;; ## Low-level reading +;; +;; We will need some low-level reading helpers to read the bytes from +;; the input stream. These are `read-byte` as well as `read-bytes`. They +;; are split out, because doing such a simple task as reading a byte is +;; mild catastrophe in Java. So it would add some clutter to the algorithm +;; `read-netstring`. +;; +;; On the other hand they might be also useful elsewhere. +;; +;; To remove some magic numbers from the code below. + +(set! *warn-on-reflection* true) + +(def #^{:const true} i 105) +(def #^{:const true} l 108) +(def #^{:const true} d 100) +(def #^{:const true} comma 44) +(def #^{:const true} minus 45) + +;; These two are only used boxed. So we keep them extra here. + +(def e 101) +(def colon 58) + +(defn #^{:private true} read-byte + #^long [#^InputStream input] + (let [c (.read input)] + (when (neg? c) + (throw (EOFException. "Invalid netstring. Unexpected end of input."))) + ;; Here we have a quirk for example. `.read` returns -1 on end of + ;; input. However the Java `Byte` has only a range from -128 to 127. + ;; How does the fit together? + ;; + ;; The whole thing is shifted. `.read` actually returns an int + ;; between zero and 255. Everything below the value 128 stands + ;; for itself. But larger values are actually negative byte values. + ;; + ;; So we have to do some translation here. `Byte/byteValue` would + ;; do that for us, but we want to avoid boxing here. + (if (< 127 c) (- c 256) c))) + +(defn #^{:private true :tag "[B"} read-bytes + #^Object [#^InputStream input n] + (let [content (byte-array n)] + (loop [offset (int 0) + len (int n)] + (let [result (.read input content offset len)] + (when (neg? result) + (throw + (EOFException. + "Invalid netstring. Less data available than expected."))) + (when (not= result len) + (recur (+ offset result) (- len result))))) + content)) + +;; `read-long` is used for reading integers from the stream as well +;; as the byte count prefixes of byte strings. The delimiter is \: +;; for byte count prefixes and \e for integers. + +(defn #^{:private true} read-long + #^long [#^InputStream input delim] + (loop [n (long 0)] + ;; We read repeatedly a byte from the input… + (let [b (read-byte input)] + ;; …and stop at the delimiter. + (cond + (= b minus) (- (read-long input delim)) + (= b delim) n + :else (recur (+ (* n (long 10)) (- (long b) (long 48)))))))) + +;; ## Reading a netstring +;; +;; Let's dive straight into reading a netstring from an `InputStream`. +;; +;; For convenience we split the function into two subfunctions. The +;; public `read-netstring` is the normal entry point, which also checks +;; for the trailing comma after reading the payload data with the +;; private `read-netstring*`. +;; +;; The reason we need the less strict `read-netstring*` is that with +;; bencode we don't have a trailing comma. So a check would not be +;; beneficial here. +;; +;; However the consumer doesn't have to care. `read-netstring` as +;; well as `read-bencode` provide the public entry points, which do +;; the right thing. Although they both may reference the `read-netstring*` +;; underneath. +;; +;; With this in mind we define the inner helper function first. + +(declare #^"[B" string>payload + #^String stringpayload` and `stringpayload + [#^String s] + (.getBytes s "UTF-8")) + +(defn #^{:private true :tag String} stringpayload (str (alength content)))) + (.write (int colon)) + (.write content))) + +(defn write-netstring + "Write the given binary data to the output stream in form of a classic + netstring." + [#^OutputStream output content] + (doto output + (write-netstring* content) + (.write (int comma)))) + +;; # Bencode +;; +;; However most of the time we don't want to send simple blobs of data +;; back and forth. The data sent between the communication peers usually +;; have some structure, which has to be carried along the way to the +;; other side. Here [bencode][bc] come into play. +;; +;; Bencode defines additionally to netstrings easily parseable structures +;; for lists, maps and numbers. It allows to communicate information +;; about the data structure to the peer on the other side. +;; +;; ## Tokens +;; +;; The data is encoded in tokens in bencode. There are several types of +;; tokens: +;; +;; * A netstring without trailing comma for string data. +;; * A tag specifiyng the type of the following tokens. +;; The tag may be one of these: +;; * `\i` to encode integers. +;; * `\l` to encode lists of items. +;; * `\d` to encode maps of item pairs. +;; * `\e` to end the a previously started tag. +;; +;; ## Reading bencode +;; +;; Reading bencode encoded data is basically parsing a stream of tokens +;; from the input. Hence we need a read-token helper which allows to +;; retrieve the next token. + +(defn #^{:private true} read-token + [#^PushbackInputStream input] + (let [ch (read-byte input)] + (cond + (= (long e) ch) nil + (= i ch) :integer + (= l ch) :list + (= d ch) :map + :else (do + (.unread input (int ch)) + (read-netstring* input))))) + +;; To read the bencode encoded data we walk a long the sequence of tokens +;; and act according to the found tags. + +(declare read-integer read-list read-map) + +(defn read-bencode + "Read bencode token from the input stream." + [input] + (let [token (read-token input)] + (case token + :integer (read-integer input) + :list (read-list input) + :map (read-map input) + token))) + +;; Of course integers and the collection types are have to treated specially. +;; +;; Integers for example consist of a sequence of decimal digits. + +(defn #^{:private true} read-integer + [input] + (read-long input e)) + +;; *Note:* integers are an ugly special case, which cannot be +;; handled with `read-token` or `read-netstring*`. +;; +;; Lists are just a sequence of other tokens. + +(declare token-seq) + +(defn #^{:private true} read-list + [input] + (vec (token-seq input))) + +;; Maps are sequences of key/value pairs. The keys are always +;; decoded into strings. The values are kept as is. + +(defn #^{:private true} read-map + [input] + (->> (token-seq input) + (into {} (comp (partition-all 2) + (map (fn [[k v]] + [(string> #(read-bencode input) + repeatedly + (take-while identity))) + +;; ## Writing bencode +;; +;; Writing bencode is similar easy as reading it. The main entry point +;; takes a string, map, sequence or integer and writes it according to +;; the rules to the given OutputStream. + +(defmulti write-bencode + "Write the given thing to the output stream. “Thing” means here a + string, map, sequence or integer. Alternatively an ByteArray may + be provided whose contents are written as a bytestring. Similar + the contents of a given InputStream are written as a byte string. + Named things (symbols or keywords) are written in the form + 'namespace/name'." + (fn [_output thing] + (cond + (bytes? thing) :bytes + (instance? InputStream thing) :input-stream + (integer? thing) :integer + (string? thing) :string + (symbol? thing) :named + (keyword? thing) :named + (map? thing) :map + (or (nil? thing) (coll? thing) (.isArray (class thing))) :list + :else (type thing)))) + +(defmethod write-bencode :default + [output x] + (throw (IllegalArgumentException. (str "Cannot write value of type " (class x))))) + +;; The following methods should be pretty straight-forward. +;; +;; The easiest case is of course when we already have a byte array. +;; We can simply pass it on to the underlying machinery. + +(defmethod write-bencode :bytes + [output bytes] + (write-netstring* output bytes)) + +;; For strings we simply write the string as a netstring without +;; trailing comma after encoding the string as UTF-8 bytes. + +(defmethod write-bencode :string + [output string] + (write-netstring* output (string>payload string))) + +;; Streaming does not really work, since we need to know the +;; number of bytes to write upfront. So we read in everything +;; for InputStreams and pass on the byte array. + +(defmethod write-bencode :input-stream + [output stream] + (let [bytes (ByteArrayOutputStream.)] + (io/copy stream bytes) + (write-netstring* output (.toByteArray bytes)))) + +;; Integers are again the ugly special case. + +(defmethod write-bencode :integer + [#^OutputStream output n] + (doto output + (.write (int i)) + (.write (string>payload (str n))) + (.write (int e)))) + +;; Symbols and keywords are converted to a string of the +;; form 'namespace/name' or just 'name' in case its not +;; qualified. We do not add colons for keywords since the +;; other side might not have the notion of keywords. + +(defmethod write-bencode :named + [output thing] + (let [nspace (namespace thing) + name (name thing)] + (->> (str (when nspace (str nspace "/")) name) + string>payload + (write-netstring* output)))) + +;; Lists as well as maps work recursively to print their elements. + +(defmethod write-bencode :list + [#^OutputStream output lst] + (.write output (int l)) + (doseq [elt lst] + (write-bencode output elt)) + (.write output (int e))) + +;; However, maps are a bit special because their keys are sorted +;; lexicographically based on their byte string represantation. + +(declare lexicographically) + +(defmethod write-bencode :map + [#^OutputStream output m] + (let [translation (into {} (map (juxt string>payload identity) (keys m))) + key-strings (sort lexicographically (keys translation)) + >value (comp m translation)] + (.write output (int d)) + (doseq [k key-strings] + (write-netstring* output k) + (write-bencode output (>value k))) + (.write output (int e)))) + +;; However, since byte arrays are not `Comparable` we need a custom +;; comparator which we can feed to `sort`. + +(defn #^{:private true} lexicographically + [#^"[B" a #^"[B" b] + (let [alen (alength a) + blen (alength b) + len (min alen blen)] + (loop [i 0] + (if (== i len) + (- alen blen) + (let [x (- (int (aget a i)) (int (aget b i)))] + (if (zero? x) + (recur (inc i)) + x)))))) diff --git a/src/babashka/impl/classes.clj b/src/babashka/impl/classes.clj index cf2fc3e7..e5f48a4c 100644 --- a/src/babashka/impl/classes.clj +++ b/src/babashka/impl/classes.clj @@ -204,6 +204,8 @@ java.security.MessageDigest (instance? java.io.InputStream v) java.io.InputStream + (instance? java.io.OutputStream v) + java.io.OutputStream (instance? java.nio.file.FileSystem v) java.nio.file.FileSystem))))) diff --git a/src/babashka/impl/clojure/main.clj b/src/babashka/impl/clojure/main.clj index 3d8a9f2f..db26af93 100644 --- a/src/babashka/impl/clojure/main.clj +++ b/src/babashka/impl/clojure/main.clj @@ -48,6 +48,11 @@ *e nil] ~@body)) +(def ^{:doc "A sequence of lib specs that are applied to `require` +by default when a new command-line REPL is started."} repl-requires + '[[clojure.repl :refer (dir doc)] + [clojure.pprint :refer (pprint)]]) + (defn repl "Generic, reusable, read-eval-print loop. By default, reads from *in*, writes to *out*, and prints exception summaries to *err*. If you use the diff --git a/src/babashka/impl/clojure/stacktrace.clj b/src/babashka/impl/clojure/stacktrace.clj index 4f088b16..07f19ef1 100644 --- a/src/babashka/impl/clojure/stacktrace.clj +++ b/src/babashka/impl/clojure/stacktrace.clj @@ -1,10 +1,16 @@ (ns babashka.impl.clojure.stacktrace {:no-doc true} - (:require [clojure.stacktrace :as stacktrace])) + (:require [clojure.stacktrace :as stacktrace] + [sci.core :as sci])) + +(defmacro wrap-out [f] + `(fn [& ~'args] + (binding [*out* @sci/out] + (apply ~f ~'args)))) (def stacktrace-namespace {'root-cause stacktrace/root-cause - 'print-trace-element stacktrace/print-trace-element - 'print-throwable stacktrace/print-throwable - 'print-stack-trace stacktrace/print-stack-trace - 'print-cause-trace stacktrace/print-cause-trace}) + 'print-trace-element (wrap-out stacktrace/print-trace-element) + 'print-throwable (wrap-out stacktrace/print-throwable) + 'print-stack-trace (wrap-out stacktrace/print-stack-trace) + 'print-cause-trace (wrap-out stacktrace/print-cause-trace)}) diff --git a/src/babashka/impl/nrepl_server.clj b/src/babashka/impl/nrepl_server.clj new file mode 100644 index 00000000..ce8a6309 --- /dev/null +++ b/src/babashka/impl/nrepl_server.clj @@ -0,0 +1,236 @@ +(ns babashka.impl.nrepl-server + {:no-doc true} + (:refer-clojure :exclude [send future binding]) + (:require [babashka.impl.bencode.core :refer [write-bencode read-bencode]] + [clojure.string :as str] + [sci.core :as sci] + [sci.impl.interpreter :refer [eval-string*]] + [sci.impl.utils :as sci-utils] + [sci.impl.vars :as vars]) + (:import [java.io StringWriter OutputStream InputStream PushbackInputStream EOFException] + [java.net ServerSocket])) + +(set! *warn-on-reflection* true) + +(def port 1667) +(def dev? (volatile! nil)) + +(defn response-for [old-msg msg] + (let [session (get old-msg :session "none") + m (assoc msg "session" session) + id (get old-msg :id "unknown") + m (assoc m "id" id)] + m)) + +(defn send [^OutputStream os msg] + ;;(when @dev? (prn "Sending" msg)) + (write-bencode os msg) + (.flush os)) + +(defn send-exception [os msg ^Throwable ex] + (let [ex-map (Throwable->map ex) + ex-name (-> ex-map :via first :type) + cause (:cause ex-map)] + (when @dev? (prn "sending exception" ex-map)) + (send os (response-for msg {"err" (str ex-name ": " cause "\n")})) + (send os (response-for msg {"ex" (str "class " ex-name) + "root-ex" (str "class " ex-name) + "status" #{"eval-error"}})) + (send os (response-for msg {"status" #{"done"}})))) + +(defn eval-msg [ctx o msg #_threads] + (try + (let [ns-str (get msg :ns) + sci-ns (if ns-str + (sci-utils/namespace-object (:env ctx) (symbol ns-str) nil false) + (sci-utils/namespace-object (:env ctx) 'user nil false))] + (sci/binding [vars/current-ns sci-ns + sci/print-length @sci/print-length] + (let [session (get msg :session "none") + id (get msg :id "unknown")] + (when @dev? (println "Registering thread for" (str session "-" id))) + ;; (swap! threads assoc [session id] (Thread/currentThread)) + (let [code-str (get msg :code) + sw (StringWriter.) + value (if (str/blank? code-str) + ::nil + (sci/binding [sci/out sw + vars/current-ns @vars/current-ns] (eval-string* ctx code-str))) + out-str (not-empty (str sw)) + env (:env ctx)] + (swap! env update-in [:namespaces 'clojure.core] + (fn [core] + (assoc core + '*1 value + '*2 (get core '*1) + '*3 (get core '*2)))) + (when @dev? (println "out str:" out-str)) + (when out-str + (send o (response-for msg {"out" out-str}))) + (send o (response-for msg (cond-> {"ns" (vars/current-ns-name)} + (not (identical? value ::nil)) (assoc "value" (pr-str value))))) + (send o (response-for msg {"status" #{"done"}})))))) + (catch Exception ex + (swap! (:env ctx) update-in [:namespaces 'clojure.core] + (fn [core] + (assoc core '*e ex))) + (send-exception o msg ex)))) + +(defn fully-qualified-syms [ctx ns-sym] + (let [syms (eval-string* ctx (format "(keys (ns-map '%s))" ns-sym)) + sym-strs (map #(str "`" %) syms) + sym-expr (str "[" (str/join " " sym-strs) "]") + syms (eval-string* ctx sym-expr)] + syms)) + +(defn match [_alias->ns ns->alias query [sym-ns sym-name qualifier]] + (let [pat (re-pattern query)] + (or (when (and (identical? :unqualified qualifier) (re-find pat sym-name)) + [sym-ns sym-name]) + (when sym-ns + (or (when (re-find pat (str sym-ns "/" sym-name)) + [sym-ns (str sym-ns "/" sym-name)]) + (when (re-find pat (str (get ns->alias (symbol sym-ns)) "/" sym-name)) + [sym-ns (str (get ns->alias (symbol sym-ns)) "/" sym-name)])))))) + +(defn complete [ctx o msg] + (try + (let [ns-str (get msg :ns) + sci-ns (if ns-str + (sci-utils/namespace-object (:env ctx) (symbol ns-str) nil false) + (sci-utils/namespace-object (:env ctx) 'user nil false))] + (sci/binding [vars/current-ns sci-ns] + (let [ + ;;ns-sym (symbol ns) + query (:symbol msg) + from-current-ns (fully-qualified-syms ctx (eval-string* ctx "(ns-name *ns*)")) + from-current-ns (map (fn [sym] + [(namespace sym) (name sym) :unqualified]) + from-current-ns) + alias->ns (eval-string* ctx "(let [m (ns-aliases *ns*)] (zipmap (keys m) (map ns-name (vals m))))") + ns->alias (zipmap (vals alias->ns) (keys alias->ns)) + from-aliased-nss (doall (mapcat + (fn [alias] + (let [ns (get alias->ns alias) + syms (eval-string* ctx (format "(keys (ns-publics '%s))" ns))] + (map (fn [sym] + [(str ns) (str sym) :qualified]) + syms))) + (keys alias->ns))) + svs (concat from-current-ns from-aliased-nss) + completions (keep (fn [entry] + (match alias->ns ns->alias query entry)) + svs) + completions (mapv (fn [[namespace name]] + {"candidate" (str name) "ns" (str namespace) #_"type" #_"function"}) + completions)] + (when @dev? (prn "completions" completions)) + (send o (response-for msg {"completions" completions + "status" #{"done"}}))))) + (catch Throwable e + (println e) + (send o (response-for msg {"completions" [] + "status" #{"done"}}))))) + +;; GraalVM doesn't support the .stop method on Threads, so for now we will have to live without interrupt +#_(defn interrupt [_ctx os msg threads] + (let [session (get msg :session "none") + id (get msg :interrupt-id)] + (when-let [t (get @threads [session id])] + (when @dev? (println "Killing thread" (str session "-" id))) + (try (.stop ^java.lang.Thread t) + (catch Throwable e + (println e)))) + (send os (response-for msg {"status" #{"done"}})))) + +(defn read-msg [msg] + (-> (zipmap (map keyword (keys msg)) + (map #(if (bytes? %) + (String. (bytes %)) + %) (vals msg))) + (update :op keyword))) + +(defn session-loop [ctx ^InputStream is os id #_threads] + (when @dev? (println "Reading!" id (.available is))) + (when-let [msg (try (read-bencode is) + (catch EOFException _ + (println "Client closed connection.")))] + (let [msg (read-msg msg)] + (when @dev? (prn "Received" msg)) + (case (get msg :op) + :clone (do + (when @dev? (println "Cloning!")) + (let [id (str (java.util.UUID/randomUUID))] + (send os (response-for msg {"new-session" id "status" #{"done"}})) + (recur ctx is os id #_threads))) + :eval (do + (eval-msg ctx os msg #_threads) + (recur ctx is os id #_threads)) + :load-file (let [file (:file msg) + msg (assoc msg :code file)] + (eval-msg ctx os msg #_threads) + (recur ctx is os id #_threads)) + :complete (do + (complete ctx os msg) + (recur ctx is os id #_threads)) + ;; :interrupt (do + ;; (interrupt ctx os msg threads) + ;; (recur ctx is os id threads)) + :describe + (do (send os (response-for msg {"status" #{"done"} + "aux" {} + "ops" (zipmap #{"clone", "describe", "eval"} + (repeat {})) + "versions" {} #_{"nrepl" {"major" "0" + "minor" "4" + "incremental" "0" + "qualifier" ""} + "clojure" + {"*clojure-version*" + (zipmap (map name (keys *clojure-version*)) + (vals *clojure-version*))}}})) + (recur ctx is os id #_threads)) + ;; fallback + (do (when @dev? + (println "Unhandled message" msg)) + (send os (response-for msg {"status" #{"error" "unknown-op" "done"}})) + (recur ctx is os id #_threads)))))) + +(defn listen [ctx ^ServerSocket listener] + (when @dev? (println "Listening")) + (let [client-socket (.accept listener) + in (.getInputStream client-socket) + in (PushbackInputStream. in) + out (.getOutputStream client-socket) + #_threads #_(atom {})] + (when @dev? (println "Connected.")) + (sci/future + (sci/binding + ;; allow *ns* to be set! inside future + [vars/current-ns (vars/->SciNamespace 'user nil) + sci/print-length @sci/print-length] + (session-loop ctx in out "pre-init" #_threads))) + (recur ctx listener))) + + +(def server (atom nil)) + +(defn stop-server! [] + (when-let [s @server] + (.close ^ServerSocket s) + (reset! server nil))) + +(defn start-server! [ctx host+port] + (vreset! dev? (= "true" (System/getenv "BABASHKA_DEV"))) + (let [parts (str/split host+port #":") + [address port] (if (= 1 (count parts)) + [nil (Integer. ^String (first parts))] + [(java.net.InetAddress/getByName (first parts)) + (Integer. ^String (second parts))]) + host+port (if-not address (str "localhost:" port) + host+port)] + #_(complete ctx nil {:symbol "json"}) + (println "Starting nREPL server at" host+port) + (let [socket-server (new ServerSocket port 0 address)] + (reset! server socket-server) + (listen ctx socket-server)))) diff --git a/src/babashka/impl/transit.clj b/src/babashka/impl/transit.clj index e7c84311..73eb7026 100644 --- a/src/babashka/impl/transit.clj +++ b/src/babashka/impl/transit.clj @@ -3,6 +3,7 @@ [sci.impl.namespaces :refer [copy-var]] [sci.impl.vars :as vars])) + (def tns (vars/->SciNamespace 'cognitect.transit nil)) (def transit-namespace diff --git a/src/babashka/main.clj b/src/babashka/main.clj index d77d5297..e1f7c80b 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -2,18 +2,20 @@ {:no-doc true} (:require [babashka.impl.async :refer [async-namespace async-protocols-namespace]] + [babashka.impl.bencode :refer [bencode-namespace]] [babashka.impl.cheshire :refer [cheshire-core-namespace]] [babashka.impl.classes :as classes] [babashka.impl.classpath :as cp] [babashka.impl.clojure.core :refer [core-extras]] [babashka.impl.clojure.java.io :refer [io-namespace]] [babashka.impl.clojure.java.shell :refer [shell-namespace]] - [babashka.impl.clojure.main :refer [demunge]] + [babashka.impl.clojure.main :as clojure-main :refer [demunge]] [babashka.impl.clojure.pprint :refer [pprint-namespace]] [babashka.impl.clojure.stacktrace :refer [stacktrace-namespace]] [babashka.impl.common :as common] [babashka.impl.csv :as csv] [babashka.impl.curl :refer [curl-namespace]] + [babashka.impl.nrepl-server :as nrepl-server] [babashka.impl.pipe-signal-handler :refer [handle-pipe! pipe-signal-received?]] [babashka.impl.repl :as repl] [babashka.impl.socket-repl :as socket-repl] @@ -115,6 +117,12 @@ (assoc opts-map :socket-repl (or (first options) "1666")))) + ("--nrepl-server") + (let [options (next options)] + (recur (next options) + (assoc opts-map + :nrepl (or (first options) + "1667")))) ("--eval", "-e") (let [options (next options)] (recur (next options) @@ -158,7 +166,7 @@ (def usage-string "Usage: bb [ -i | -I ] [ -o | -O ] [ --stream ] [--verbose] [ ( --classpath | -cp ) ] [ --uberscript ] [ ( --main | -m ) | -e | -f | - --repl | --socket-repl [:] ] + --repl | --socket-repl [:] | --nrepl-server [:] ] [ arg* ]") (defn print-usage [] (println usage-string)) @@ -188,6 +196,7 @@ -m, --main Call the -main function from namespace with args. --repl Start REPL. Use rlwrap for history. --socket-repl Start socket REPL. Specify port (e.g. 1666) or host and port separated by colon (e.g. 127.0.0.1:1666). + --nrepl-server Start nREPL server. Specify port (e.g. 1667) or host and port separated by colon (e.g. 127.0.0.1:1667). --time Print execution time before exiting. -- Stop parsing args and pass everything after -- to *command-line-args* @@ -218,6 +227,11 @@ Everything after that is bound to *command-line-args*.")) ;; hang until SIGINT @(promise)) +(defn start-nrepl! [address ctx] + (nrepl-server/start-server! ctx address) + ;; hang until SIGINT + #_@(promise)) + (defn exit [n] (throw (ex-info "" {:bb/exit-code n}))) @@ -232,7 +246,8 @@ Everything after that is bound to *command-line-args*.")) csv clojure.data.csv json cheshire.core curl babashka.curl - transit cognitect.transit}) + transit cognitect.transit + bencode bencode.core}) (def cp-state (atom nil)) @@ -258,13 +273,15 @@ Everything after that is bound to *command-line-args*.")) 'clojure.data.csv csv/csv-namespace 'cheshire.core cheshire-core-namespace 'clojure.stacktrace stacktrace-namespace - 'clojure.main {'demunge demunge} + 'clojure.main {'demunge demunge + 'repl-requires clojure-main/repl-requires} 'clojure.repl {'demunge demunge} 'clojure.test t/clojure-test-namespace 'babashka.classpath {'add-classpath add-classpath*} 'clojure.pprint pprint-namespace 'babashka.curl curl-namespace - 'cognitect.transit transit-namespace}) + 'cognitect.transit transit-namespace + 'bencode.core bencode-namespace}) (def bindings {'java.lang.System/exit exit ;; override exit, so we have more control @@ -295,7 +312,7 @@ Everything after that is bound to *command-line-args*.")) {:keys [:version :shell-in :edn-in :shell-out :edn-out :help? :file :command-line-args :expressions :stream? :time? - :repl :socket-repl + :repl :socket-repl :nrepl :verbose? :classpath :main :uberscript] :as _opts} (parse-opts args) @@ -403,6 +420,7 @@ Everything after that is bound to *command-line-args*.")) [(print-help) 0] repl [(repl/start-repl! sci-ctx) 0] socket-repl [(start-socket-repl! socket-repl sci-ctx) 0] + nrepl [(start-nrepl! nrepl sci-ctx) 0] (not (str/blank? expression)) (try (loop [] @@ -446,7 +464,8 @@ Everything after that is bound to *command-line-args*.")) (defn -main [& args] (if-let [dev-opts (System/getenv "BABASHKA_DEV")] - (let [{:keys [:n]} (edn/read-string dev-opts) + (let [{:keys [:n]} (if (= "true" dev-opts) {:n 1} + (edn/read-string dev-opts)) last-iteration (dec n)] (dotimes [i n] (if (< i last-iteration) diff --git a/src/babashka/wait.clj b/src/babashka/wait.clj index af2cc9d4..f4bf6999 100644 --- a/src/babashka/wait.clj +++ b/src/babashka/wait.clj @@ -17,8 +17,8 @@ opts) t0 (System/currentTimeMillis)] (loop [] - (let [v (try (with-open [_ (Socket. host port)] - (- (System/currentTimeMillis) t0)) + (let [v (try (.close (Socket. host port)) + (- (System/currentTimeMillis) t0) (catch ConnectException _e (let [took (- (System/currentTimeMillis) t0)] (if (and timeout (>= took timeout)) diff --git a/test/babashka/impl/nrepl_server_test.clj b/test/babashka/impl/nrepl_server_test.clj new file mode 100644 index 00000000..bec00443 --- /dev/null +++ b/test/babashka/impl/nrepl_server_test.clj @@ -0,0 +1,120 @@ +(ns babashka.impl.nrepl-server-test + (:require + [babashka.impl.bencode.core :as bencode] + [babashka.impl.nrepl-server :refer [start-server! stop-server!]] + [babashka.test-utils :as tu] + [babashka.wait :as wait] + [cheshire.core :as cheshire] + [clojure.java.shell :refer [sh]] + [clojure.test :as t :refer [deftest is testing]] + [sci.impl.opts :refer [init]]) + (:import [java.lang ProcessBuilder$Redirect])) + +(set! *warn-on-reflection* true) + +(defn bytes->str [x] + (if (bytes? x) (String. (bytes x)) + (str x))) + +(defn read-msg [msg] + (let [res (zipmap (map keyword (keys msg)) + (map #(if (bytes? %) + (String. (bytes %)) + %) + (vals msg))) + res (if-let [status (:status res)] + (assoc res :status (mapv bytes->str status)) + res)] + res)) + +(defn read-reply [in session id] + (loop [] + (let [msg (read-msg (bencode/read-bencode in))] + (if (and (= (:session msg) session) + (= (:id msg) id)) + msg + (recur))))) + +(defn nrepl-test [] + (with-open [socket (java.net.Socket. "127.0.0.1" 1667) + in (.getInputStream socket) + in (java.io.PushbackInputStream. in) + os (.getOutputStream socket)] + (bencode/write-bencode os {"op" "clone"}) + (let [session (:new-session (read-msg (bencode/read-bencode in)))] + (testing "session" + (is session)) + (testing "eval" + (bencode/write-bencode os {"op" "eval" "code" "(+ 1 2 3)" "session" session "id" 1}) + (let [msg (read-reply in session 1) + id (:id msg) + value (:value msg)] + (is (= 1 id)) + (is (= value "6")))) + (testing "load-file" + (bencode/write-bencode os {"op" "load-file" "file" "(ns foo) (defn foo [] :foo)" "session" session "id" 2}) + (read-reply in session 2) + (bencode/write-bencode os {"op" "eval" "code" "(foo)" "ns" "foo" "session" session "id" 3}) + (is (= ":foo" (:value (read-reply in session 3))))) + (testing "complete" + (testing "completions for fo" + (bencode/write-bencode os {"op" "complete" + "symbol" "fo" + "session" session + "id" 4 + "ns" "foo"}) + (let [reply (read-reply in session 4) + completions (:completions reply) + completions (mapv read-msg completions) + completions (into #{} (map (juxt :ns :candidate)) completions)] + (is (contains? completions ["foo" "foo"])) + (is (contains? completions ["clojure.core" "format"])))) + (testing "completions for quux should be empty" + (bencode/write-bencode os {"op" "complete" + "symbol" "quux" + "session" session "id" 6 + "ns" "foo"}) + (let [reply (read-reply in session 6) + completions (:completions reply)] + (is (empty? completions))) + (testing "unless quux is an alias" + (bencode/write-bencode os {"op" "eval" "code" "(require '[cheshire.core :as quux])" "session" session "id" 7}) + (bencode/write-bencode os {"op" "complete" "symbol" "quux" "session" session "id" 8}) + (let [reply (read-reply in session 8) + completions (:completions reply) + completions (mapv read-msg completions) + completions (into #{} (map (juxt :ns :candidate)) completions)] + (is (contains? completions ["cheshire.core" "quux/generate-string"])))))) + #_(testing "interrupt" ;; .stop doesn't work on Thread in GraalVM, this is why we can't have this yet + (bencode/write-bencode os {"op" "eval" "code" "(range)" "session" session "id" 9}) + (Thread/sleep 1000) + (bencode/write-bencode os {"op" "interrupt" "session" session "interrupt-id" 9 "id" 10}) + (is (contains? (set (:status (read-reply in session 10))) "done")))))) + +(deftest nrepl-server-test + (let [proc-state (atom nil)] + (try + (if tu/jvm? + (future + (start-server! + (init {:namespaces {'cheshire.core {'generate-string cheshire/generate-string}} + :features #{:bb}}) "0.0.0.0:1667")) + (let [pb (ProcessBuilder. ["./bb" "--nrepl-server" "0.0.0.0:1667"]) + _ (.redirectError pb ProcessBuilder$Redirect/INHERIT) + ;; _ (.redirectOutput pb ProcessBuilder$Redirect/INHERIT) + ;; env (.environment pb) + ;; _ (.put env "BABASHKA_DEV" "true") + proc (.start pb)] + (reset! proc-state proc))) + (babashka.wait/wait-for-port "localhost" 1667) + (nrepl-test) + (finally + (if tu/jvm? + (stop-server!) + (when-let [proc @proc-state] + (.destroy ^Process proc))))))) + +;;;; Scratch + +(comment + ) diff --git a/test/babashka/impl/socket_repl_test.clj b/test/babashka/impl/socket_repl_test.clj index 8bad7823..18abb4e4 100644 --- a/test/babashka/impl/socket_repl_test.clj +++ b/test/babashka/impl/socket_repl_test.clj @@ -2,10 +2,10 @@ (:require [babashka.impl.socket-repl :refer [start-repl! stop-repl!]] [babashka.test-utils :as tu] + [clojure.java.io :as io] [clojure.java.shell :refer [sh]] [clojure.string :as str] [clojure.test :as t :refer [deftest is testing]] - [clojure.java.io :as io] [sci.impl.opts :refer [init]])) (set! *warn-on-reflection* true)