foo.clj

(set! *warn-on-reflection* true)

(def authorized-keys (atom {}))

(defn generate-keys []
  (let [k (.generateKeyPair (java.security.KeyPairGenerator/getInstance "EC"))]
    {:public (let [baos (java.io.ByteArrayOutputStream.)]
               (with-open [oos (java.io.ObjectOutputStream. baos)]
                 (.writeObject oos (.getPublic k)))
               (.encodeToString (java.util.Base64/getEncoder)
                                ( .toByteArray baos)))
     :private (let [baos (java.io.ByteArrayOutputStream.)]
                (with-open [oos (java.io.ObjectOutputStream. baos)]
                  (.writeObject oos (.getPrivate k)))
                (.encodeToString (java.util.Base64/getEncoder)
                                 ( .toByteArray baos)))}))

(defn verify [^String id ^String signature]
  (seq
   (for [[user ^String public-key] @authorized-keys
         :when
         (.verify (doto (java.security.Signature/getInstance "SHA3-224withECDSA")
                    (.initVerify
                     ^java.security.PublicKey
                     (.readObject
                      (java.io.ObjectInputStream.
                       (java.io.ByteArrayInputStream.
                        (.decode (java.util.Base64/getDecoder)
                                 public-key)))))
                    (.update (.getBytes id)))
                  (.decode (java.util.Base64/getDecoder)
                           signature))]
     user)))

(defn sign [^String secret-key ^String string-to-sign]
  (.encodeToString
   (java.util.Base64/getEncoder)
   (.sign
    (doto (java.security.Signature/getInstance "SHA3-224withECDSA")
      (.initSign
       (.readObject
        (java.io.ObjectInputStream.
         (java.io.ByteArrayInputStream.
          (.decode (java.util.Base64/getDecoder)
                   secret-key)))))
      (.update (.getBytes string-to-sign))))))

(defn wrap-repl [handler]
  (let [repls (atom {})]
    (letfn [(start-repl []
              (delay
                (let [in-in (java.io.PipedInputStream.)
                      in-out (java.io.PipedOutputStream. in-in)
                      out-in (java.io.PipedInputStream.)
                      out-out (java.io.PipedOutputStream. out-in)
                      repl-loop (future
                                  (with-open [in (clojure.lang.LineNumberingPushbackReader.
                                                  (clojure.java.io/reader
                                                   in-in))
                                              out (java.io.PrintWriter.
                                                   out-out)]
                                    (binding [*in*  in
                                              *out* out
                                              *err* out]
                                      (clojure.core.server/repl))))
                      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))
                                         (recur))))))
                      keep-alive-loop (future
                                        (with-open [in-in in-in
                                                    out-out out-out]
                                          (loop []
                                            (when (.poll keep-alive 2 java.util.concurrent.TimeUnit/SECONDS)
                                              (recur)))))]
                  {:in-in in-in
                   :out-q out-q
                   :keep-alive keep-alive})))]
      (fn [req]
        (prn 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 (java.io.ByteArrayOutputStream.)]
                (.offer ^java.util.concurrent.BlockingQueue keep-alive-loop true)
                (while (.peek ^java.util.concurrent.BlockingQueue out-q)
                  (let [{:keys [limit buf]} (.take ^java.util.concurrent.BlockingQueue out-q)]
                    (.write baos ^bytes buf 0 (int limit))))
                (clojure.java.io/copy (: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)}))
              :else
              (handler req))))))

(defn http-repl [uri secret-key]
  (let [cookies (java.net.CookieManager.)
        http-client (-> (java.net.http.HttpClient/newBuilder)
                        (.cookieHandler cookies)
                        (.build))
        out-q (java.util.concurrent.LinkedBlockingQueue.)
        challenge (atom nil)
        initial-response
        (.send http-client
               (-> (java.net.http.HttpRequest/newBuilder)
                   (.uri uri)
                   (.build))
               (java.net.http.HttpResponse$BodyHandlers/ofString))]
    (reset! challenge (.get (.firstValue (.headers initial-response) "challenge")))
    (future
      (loop []
        (let [{:keys [limit buf]} (.poll out-q 1 java.util.concurrent.TimeUnit/SECONDS)]
          (let [response (.send http-client
                                (-> (java.net.http.HttpRequest/newBuilder)
                                    (.setHeader "challenge" @challenge)
                                    (.setHeader "signature" (sign secret-key @challenge))
                                    (.POST (if buf
                                             (java.net.http.HttpRequest$BodyPublishers/ofByteArray buf 0 limit)
                                             (java.net.http.HttpRequest$BodyPublishers/ofByteArray (byte-array 0))))
                                    (.uri uri)
                                    (.build))
                                (java.net.http.HttpResponse$BodyHandlers/ofInputStream))]
            (reset! challenge (-> response
                                  (.headers)
                                  (.firstValue "challenge")
                                  (.get)))
            (clojure.java.io/copy (.body response)
                                  *out*))
          (when-not (neg? limit)
            (recur)))))
    (let [cbuf (java.nio.CharBuffer/allocate 512)
          cs (java.nio.charset.Charset/forName "utf8")]
      (loop []
        (.clear cbuf)
        (let [n (.read ^java.io.PushbackReader *in* (.array cbuf))]
          (if (neg? n)
            (.offer out-q {:limit -1 :buf (byte-array 0)})
            (do
              (.limit cbuf n)
              (.offer out-q {:limit n :buf (.array (.encode cs cbuf))})
              (recur))))))))