Skip to content

Instantly share code, notes, and snippets.


hiredman/foo.clj Secret

Created Apr 29, 2020
What would you like to do?
(def authorized-keys (atom {}))
(defn verify [id signature]
(defn sign [secret-key string-to-sign]
(defn wrap-repl [handler]
(let [repls (atom {})]
(letfn [(start-repl []
(let [in-in (
in-out ( in-in)
out-in (
out-out ( out-in)
repl-loop (future
(with-open [in (clojure.lang.LineNumberingPushbackReader.
out (
(binding [*in* in
*out* out
*err* out]
out-q (java.util.concurrent.LinkedBlockingQueue.)
keep-alive (java.util.concurrent.SynchronousQueue.)
out-loop (future
(with-open [out-in out-in]
(loop []
(let [buf (byte-array 1024)
n (.read out-in buf)]
(.put out-q {:limit n
:buf buf})
(when (not (neg? n))
keep-alive-loop (future
(with-open [in-in in-in
out-out out-out]
(loop []
(when (.poll keep-alive 10 java.util.concurrent.TimeUnit/SECONDS)
{:in-in in-in
:out-q out-q
:keep-alive keep-alive}))]
(fn [req]
;; repl authenticates via challenge and response
(cond (and (= "/ercy" (:uri req)) (= :get (:request-method req)))
(let [challenge (str (java.util.UUID/randomUUID))]
(doseq [[k v] @repls]
(when (not= ::foo (deref (:keep-alive v) 0 ::foo))
(swap! repls dissoc k)))
;; first get creates the repl and returns an initial challenge
(swap! repls assoc challenge (start-repl))
{:status 200
:headers {"CHALLENGE" challenge}
:body challenge})
(and (= "/ercy" (:uri req))
(= :post (:request-method req))
(verify (get-in req [:headers "CHALLENGE"])
(get-in req [:headers "SIGNATURE"]))
(contains? @repls (get-in req [:headers "CHALLENGE"])))
;; subsequent posts include a signed challenge, if the
;; signature verifies then the post body is sent to the
;; repl and any repl output is returned with a new
;; challenge for next time
(let [{:keys [in-in out-q keep-alive-loop]} (get @repls (get-in req [:headers "CHALLENGE"]))
baos (]
(.offer keep-alive-loop true)
(while (.peek out-q)
(let [{:keys [limit buf]} (.take out-q)]
(.write baos buf 0 limit)))
( (:body req) in-in)
(let [new-ch (str (java.util.UUID/randomUUID))]
(swap! repls (fn [r]
(-> r
(dissoc (get-in req [:headers "CHALLENGE"]))
(assoc new-ch (get r (get-in req [:headers "CHALLENGE"]))))))
{:status 200
:headers {"CHALLENGE" new-ch}
:body (.toByteArray baos)}))
(handler req))))))
(defn http-repl [uri port secret-key]
(let [http-client (-> (
out-q (java.util.concurrent.LinkedBlockingQueue.)
challenge (atom nil)
(.send http-client
(-> (
(.uri uri)
(reset! challenge (.get (.firstValue (.headers initial-response) "CHALLENGE")))
(loop []
(let [{:keys [limit buf]} (.poll out-q 1 java.util.concurrent.TimeUnit/SECONDS)]
(let [response (.send http-client
(-> (
(.setHeader "CHALLENGE" @challenge)
(.setHeader "SIGNATURE" (sign secret-key @challenge))
(.POST (if buf
($BodyPublishers/ofByteArray buf 0 limit)
($BodyPublishers/ofByteArray (byte-array 0))))
(.uri uri)
(reset! challenge (-> response
(.firstValue "CHALLENGE")
( (.body response)
(when-not (neg? limit)
(loop []
(let [buf (byte-array 1024)
n (.read *in* buf)]
(.offer out-q {:limit n :buf buf})
(when (not (neg? n))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment