99 lines
2.5 KiB
Fennel
99 lines
2.5 KiB
Fennel
(local { : view} (require :fennel))
|
|
|
|
(local server (require :http.server))
|
|
(local headers (require :http.headers))
|
|
(local ssl (require :openssl))
|
|
(local csr (require :openssl.x509.csr))
|
|
(local x509 (require :openssl.x509))
|
|
(local pkey (require :openssl.pkey))
|
|
(local bignum (require :openssl.bignum))
|
|
|
|
(fn string->bignum [bytes]
|
|
(bignum.new
|
|
(string.format
|
|
"0x%03x%03x%03x%03x%03x"
|
|
(string.unpack "I4I4I4I4I4" bytes))))
|
|
|
|
(fn make-serial []
|
|
;; 20 bytes, but luaossl expects it as a bignum
|
|
(let [bytes (with-open [f (io.open "/dev/urandom" :r)]
|
|
(f:read 20))]
|
|
(string->bignum bytes)))
|
|
|
|
(fn make-headers [status attributes]
|
|
(let [h (headers.new)]
|
|
(h:append ":status" (tostring status))
|
|
(each [k v (pairs attributes)]
|
|
(h:append k v))
|
|
h))
|
|
|
|
(fn send-error [out code text]
|
|
(out:write_headers
|
|
(make-headers code
|
|
{ :content-type "text/plain" })
|
|
false)
|
|
(out:write_chunk text true))
|
|
|
|
(fn not-found [out] (send-error out 404 "not found"))
|
|
|
|
(fn slurp [filename]
|
|
(with-open [f (io.open filename "r")] (f:read "*a")))
|
|
|
|
(local ca-key (pkey.new (slurp "ca.key")))
|
|
(local ca-crt (x509.new (slurp "ca.crt")))
|
|
(local psk (with-open [f (io.open "psk" "r")] (f:read "l")))
|
|
|
|
(fn new-crt [csr]
|
|
(let [crt
|
|
(doto (x509.new)
|
|
(: :setVersion 2)
|
|
(: :setSerial (make-serial))
|
|
(: :setIssuer (ca-crt:getSubject))
|
|
(: :setLifetime (os.time) (+ (* 365 86400) (os.time)))
|
|
(: :setSubject (csr:getSubject))
|
|
(: :setPublicKey (csr:getPublicKey))
|
|
(: :sign ca-key))]
|
|
(crt:toPEM)))
|
|
|
|
(fn approved-request? [csr]
|
|
(let [attr (csr:getAttributes)]
|
|
(accumulate [found false
|
|
_ v (ipairs (. attr "challengePassword"))]
|
|
(or found (= v psk)))))
|
|
|
|
|
|
(fn handle-sign-csr [out]
|
|
(let [req (csr.new (out:get_body_as_string))]
|
|
(if (approved-request? req)
|
|
(do
|
|
(out:write_headers (make-headers 200 { :content-type "text/plain" }) false)
|
|
(out:write_chunk (new-crt req) true))
|
|
(send-error out 400 "missing attributes in CSR"))))
|
|
|
|
|
|
(fn on-stream [sv out]
|
|
(let [hdrs (out:get_headers)
|
|
method (hdrs:get ":method")
|
|
path (or (hdrs:get ":path") "/")]
|
|
(print :path path)
|
|
(case path
|
|
"/sign"
|
|
(handle-sign-csr out)
|
|
_
|
|
(not-found out))))
|
|
|
|
|
|
(fn new-server []
|
|
(server.listen
|
|
{
|
|
:host :localhost
|
|
:port 8201
|
|
:onstream on-stream
|
|
}))
|
|
|
|
|
|
(doto (new-server)
|
|
(: :listen)
|
|
(print "server ready")
|
|
(: :loop))
|