2024-09-25 09:20:14 +00:00
|
|
|
(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))
|
2024-09-25 11:00:40 +00:00
|
|
|
(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)))
|
|
|
|
|
2024-09-25 09:20:14 +00:00
|
|
|
|
|
|
|
(fn not-found [out]
|
|
|
|
(doto (headers.new)
|
|
|
|
(: :append ":status" :404)
|
|
|
|
(: :append :content-type :text/plain)
|
|
|
|
(out:write_headers false))
|
|
|
|
(out:write_chunk "not found" true))
|
|
|
|
|
|
|
|
(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")))
|
|
|
|
|
|
|
|
(fn new-crt [csr]
|
|
|
|
(let [crt
|
|
|
|
(doto (x509.new)
|
|
|
|
(: :setVersion 2)
|
2024-09-25 11:00:40 +00:00
|
|
|
(: :setSerial (make-serial))
|
2024-09-25 09:20:14 +00:00
|
|
|
(: :setIssuer (ca-crt:getSubject))
|
|
|
|
(: :setLifetime (os.time) (+ (* 365 86400) (os.time)))
|
|
|
|
(: :setSubject (csr:getSubject))
|
|
|
|
(: :setPublicKey (csr:getPublicKey))
|
|
|
|
(: :sign ca-key))]
|
|
|
|
(crt:toPEM)))
|
|
|
|
|
|
|
|
(fn handle-sign-csr [out]
|
|
|
|
(let [body (out:get_body_as_string)]
|
|
|
|
(doto (headers.new)
|
|
|
|
(: :append ":status" :200)
|
|
|
|
(: :append :content-type :text/plain)
|
|
|
|
(out:write_headers false))
|
|
|
|
(let [req (csr.new body)]
|
|
|
|
(print :subject (req:getSubject))
|
|
|
|
(out:write_chunk (new-crt req) true))))
|
|
|
|
|
|
|
|
(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))
|