luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update example notes app to use org.httpkit.server (#762) [skip ci]

Browse source
This commit is contained in:
Joey Bloom 2021-03-26 17:25:47 -05:00 committed by GitHub
parent 1533a2d0b5
commit 74ba198201
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 61 additions and 98 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

135
examples/notes.clj
View file

@ -1,13 +1,9 @@
#!/usr/bin/env bb #!/usr/bin/env bb
;; Note that babashka comes with org.httpkit.server now, so you don't need to
;; build an http server from scratch anymore like we do here. We should update
;; this script to the built-in webserver. Whoever reads this is welcome to
;; submit a PR.
(import (java.net ServerSocket))
(require '[clojure.java.io :as io] (require '[clojure.java.io :as io]
'[clojure.string :as str]) '[clojure.pprint :refer [pprint]]
'[clojure.string :as str]
'[org.httpkit.server :as server])
(def debug? true) (def debug? true)
(def user "admin") (def user "admin")
@ -40,24 +36,11 @@
(str/join " " (map html v)) (str/join " " (map html v))
:else (str v))) :else (str v)))
(defn write-response [out session-id status headers content]
(let [cookie-header (str "Set-Cookie: notes-id=" session-id)
headers (str/join "\r\n" (conj headers cookie-header))
response (str "HTTP/1.1 " status "\r\n"
(str headers "\r\n")
"Content-Length: " (if content (count content)
0)
"\r\n\r\n"
(when content
(str content)))]
(when debug? (println response))
(binding [*out* out]
(print response)
(flush))))
;; the home page ;; the home page
(defn home-response [out session-id] (defn home-response [session-id]
(let [body (str {:status 200
:headers {"Set-Cookie" (str "notes-id=" session-id)}
:body (str
"<!DOCTYPE html>\n" "<!DOCTYPE html>\n"
(html (html
[:html [:html
@ -69,14 +52,7 @@
(slurp notes-file))] (slurp notes-file))]
[:form {:action "/" :method "post"} [:form {:action "/" :method "post"}
[:input {:type "text" :name "note"}] [:input {:type "text" :name "note"}]
[:input {:type "submit" :value "Submit"}]]]]))] [:input {:type "submit" :value "Submit"}]]]]))})
(write-response out session-id "200 OK" nil body)))
(defn basic-auth-response [out session-id]
(write-response out session-id
"401 Unauthorized"
["WWW-Authenticate: Basic realm=\"notes\""]
nil))
(def known-sessions (def known-sessions
(atom #{})) (atom #{}))
@ -86,67 +62,54 @@
(swap! known-sessions conj uuid) (swap! known-sessions conj uuid)
uuid)) uuid))
(defn get-session-id [headers]
(if-let [cookie-header (first (filter #(str/starts-with? % "Cookie: ") headers))]
(let [parts (str/split (str/replace cookie-header "Cookie: " "") #"; ")]
(if-let [notes-id (first (filter #(str/starts-with? % "notes-id") parts))]
(str/replace notes-id "notes-id=" "")
(new-session!)))
(new-session!)))
(defn basic-auth-header [headers]
(some #(str/starts-with? % "Basic-Auth: ") headers))
(def authenticated-sessions (def authenticated-sessions
(atom #{})) (atom #{}))
(defn authenticate! [session-id headers] (defn authenticate! [session-id headers]
(or (contains? @authenticated-sessions session-id) (or (contains? @authenticated-sessions session-id)
(when (some #(= % (str "Authorization: Basic " base64)) headers) (when (= (headers "authorization") (str "Basic " base64))
(swap! authenticated-sessions conj session-id) (swap! authenticated-sessions conj session-id)
true))) true)))
(defn parse-session-id [cookie]
(when cookie
(when-let [notes-id (first (filter #(str/starts-with? % "notes-id")
(str/split cookie #"; ")))]
(str/replace notes-id "notes-id=" ""))))
(defn basic-auth-response [session-id]
{:status 401
:headers {"WWW-Authenticate" "Basic realm=\"notes\""
"Set-Cookie" (str "notes-id=" session-id)}})
;; run the server ;; run the server
(with-open [server-socket (let [s (new ServerSocket 8080)] (defn handler [req]
(println "Server started on port 8080.") (when debug?
s)] (println "Request:")
(loop [] (pprint req))
(let [client-socket (.accept server-socket)] (let [body (some-> req :body slurp java.net.URLDecoder/decode)
(future session-id (parse-session-id (get-in req [:headers "cookie"]))
(with-open [conn client-socket] _ (when (and debug? body)
(try (println "Request body:" body))
(let [out (io/writer (.getOutputStream conn)) response (cond
is (.getInputStream conn) ;; if we didn't see this session before, we want the user to
in (io/reader is) ;; re-authenticate
[_req & headers :as response]
(loop [headers []]
(let [line (.readLine in)]
(if (str/blank? line)
headers
(recur (conj headers line)))))
session-id (get-session-id headers)
form-data (let [sb (StringBuilder.)]
(loop []
(when (.ready in)
(.append sb (char (.read in)))
(recur)))
(-> (str sb)
(java.net.URLDecoder/decode)))
_ (when debug? (println (str/join "\n" response)))
_ (when-not (str/blank? form-data)
(when debug? (println form-data))
(let [note (str/replace form-data "note=" "")]
(write-note! note)))
_ (when debug? (println))]
(cond
;; if we didn't see this session before, we want the user to re-authenticate
(not (contains? @known-sessions session-id)) (not (contains? @known-sessions session-id))
(let [uuid (new-session!)] (basic-auth-response (new-session!))
(basic-auth-response out uuid))
(not (authenticate! session-id headers)) (not (authenticate! session-id (:headers req)))
(basic-auth-response out session-id) (basic-auth-response session-id)
:else (home-response out session-id)))
(catch Throwable t :else (do (when-not (str/blank? body)
(binding [*err* *out*] (let [note (str/replace body "note=" "")]
(println t))))))) (write-note! note)))
(recur))) (home-response session-id)))]
(when debug?
(println "Response:")
(pprint (dissoc response :body))
(println))
response))
(server/run-server handler {:port 8080})
(println "Server started on port 8080.")
@(promise) ;; wait until SIGINT