Michiel Borkent
GitHub
parent
1c0e004f2f
commit
8b90e40de4
14 changed files with 842 additions and 18 deletions
|
|
@ -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 ) <cp> ] [ --uberscript <file> ]
|
||||
[ ( --main | -m ) <main-namespace> | -e <expression> | -f <file> |
|
||||
--repl | --socket-repl [<host>:]<port> ]
|
||||
--repl | --socket-repl [<host>:]<port> | --nrepl-server [<host>:]<port> ]
|
||||
[ arg* ]
|
||||
|
||||
Options:
|
||||
|
|
@ -194,6 +194,7 @@ Options:
|
|||
-m, --main <ns> 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*
|
||||
|
||||
|
|
|
|||
4
deps.edn
4
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
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
11
src/babashka/impl/bencode.clj
Normal file
11
src/babashka/impl/bencode.clj
Normal file
|
|
@ -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)})
|
||||
420
src/babashka/impl/bencode/core.clj
Normal file
420
src/babashka/impl/bencode/core.clj
Normal file
|
|
@ -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 string<payload)
|
||||
|
||||
(defn #^{:private true} read-netstring*
|
||||
[input]
|
||||
(read-bytes input (read-long input colon)))
|
||||
|
||||
;; And the public facing API: `read-netstring`.
|
||||
|
||||
(defn #^"[B" read-netstring
|
||||
"Reads a classic netstring from input—an InputStream. Returns the
|
||||
contained binary data as byte array."
|
||||
[input]
|
||||
(let [content (read-netstring* input)]
|
||||
(when (not= (read-byte input) comma)
|
||||
(throw (IOException. "Invalid netstring. ',' expected.")))
|
||||
content))
|
||||
|
||||
;; Similarly the `string>payload` and `string<payload` functions
|
||||
;; are defined as follows to simplify the conversion between strings
|
||||
;; and byte arrays in various parts of the code.
|
||||
|
||||
(defn #^{:private true :tag "[B"} string>payload
|
||||
[#^String s]
|
||||
(.getBytes s "UTF-8"))
|
||||
|
||||
(defn #^{:private true :tag String} string<payload
|
||||
[#^"[B" b]
|
||||
(String. b "UTF-8"))
|
||||
|
||||
;; ## Writing a netstring
|
||||
;;
|
||||
;; This opposite operation – writing a netstring – is just as important.
|
||||
;;
|
||||
;; *Note:* We take here a byte array, just as we returned a byte
|
||||
;; array in `read-netstring`. The netstring should not be concerned
|
||||
;; about the actual contents. It just sees binary data.
|
||||
;;
|
||||
;; Similar to `read-netstring` we also split `write-netstring` into
|
||||
;; the entry point itself and a helper function.
|
||||
|
||||
(defn #^{:private true} write-netstring*
|
||||
[#^OutputStream output #^"[B" content]
|
||||
(doto output
|
||||
(.write (string>payload (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<payload k) v]))))))
|
||||
|
||||
;; The final missing piece is `token-seq`. This a just a simple
|
||||
;; sequence which reads tokens until the next `\e`.
|
||||
|
||||
(defn #^{:private true} token-seq
|
||||
[input]
|
||||
(->> #(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))))))
|
||||
|
|
@ -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)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)})
|
||||
|
|
|
|||
236
src/babashka/impl/nrepl_server.clj
Normal file
236
src/babashka/impl/nrepl_server.clj
Normal file
|
|
@ -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))))
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ) <cp> ] [ --uberscript <file> ]
|
||||
[ ( --main | -m ) <main-namespace> | -e <expression> | -f <file> |
|
||||
--repl | --socket-repl [<host>:]<port> ]
|
||||
--repl | --socket-repl [<host>:]<port> | --nrepl-server [<host>:]<port> ]
|
||||
[ arg* ]")
|
||||
(defn print-usage []
|
||||
(println usage-string))
|
||||
|
|
@ -188,6 +196,7 @@
|
|||
-m, --main <ns> 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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
120
test/babashka/impl/nrepl_server_test.clj
Normal file
120
test/babashka/impl/nrepl_server_test.clj
Normal file
|
|
@ -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
|
||||
)
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue