liminix

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

certifix-client.fnl (2521B)

      1 (local { : view } (require :fennel))
      2 (local { : assoc : split } (require :anoia))
      3 
      4 (local ctx (require :openssl.ssl.context))
      5 (local csr (require :openssl.x509.csr))
      6 (local altname (require :openssl.x509.altname))
      7 (local pkey (require :openssl.pkey))
      8 (local xn (require :openssl.x509.name))
      9 
     10 (local request (require :http.request))
     11 (local http_tls (require :http.tls))
     12 (local x509 (require :openssl.x509))
     13 
     14 (macro ncall [f]
     15   `(case ,f
     16      ok# ok#
     17      (nil err#) (error err#)))
     18 
     19 
     20 (fn x509-name [subj]
     21   (let [n (xn.new)]
     22     (each [_ c (ipairs (split "," subj))]
     23       (let [(k v) (string.match c "(.-)=(.+)")]
     24         (n:add k v)))
     25     n))
     26 
     27 (fn x509-altname [subj]
     28   (let [an (altname.new)]
     29     (each [_ c (ipairs (split "," subj))]
     30       (let [(k v) (string.match c "(.-)=(.+)")]
     31         (if (= k "CN") (an:add "DNS" v))))
     32     an))
     33 
     34 (fn parse-args [args]
     35   (case args
     36     ["--secret" secret & rest]
     37     (assoc (parse-args rest)
     38            :secret (with-open [f (ncall (io.open secret :r))] (f:read "l")))
     39 
     40     ["--subject" subject & rest]
     41     (assoc (parse-args rest) :subject subject)
     42 
     43     ["--key-out" pathname & rest]
     44     (assoc (parse-args rest) :key-out pathname)
     45 
     46     ["--certificate-out" pathname & rest]
     47     (assoc (parse-args rest) :certificate-out pathname)
     48 
     49     [server] { : server }
     50     _ {}))
     51 
     52 
     53 (local options (parse-args arg))
     54 
     55 (fn private-key []
     56   (pkey.new { :type :rsa :bits 2048 }))
     57 
     58 (fn signing-request [pk]
     59   (doto (csr.new)
     60     (: :setVersion 1)
     61     (: :setSubject (x509-name options.subject))
     62     (: :setSubjectAlt (x509-altname options.subject))
     63     (: :setPublicKey pk)
     64     (: :addAttribute :challengePassword [options.secret])
     65     (: :sign pk)))
     66 
     67 (fn http-post [url  body]
     68   (let [r (request.new_from_uri url)
     69         h r.headers]
     70     (h:upsert ":method" :POST)
     71     (h:upsert "content-type" "application/x-pem-file")
     72     (when body
     73       (r:set_body body))
     74     (or
     75      (case (r:go)
     76        (headers stream)
     77        (if (= (headers:get ":status") "200")
     78            (stream:get_body_as_string)
     79            (error (.. "error response from server: "
     80                       (headers:get ":status"))))
     81 
     82        (nil failure)
     83        (error (.. "error: " failure))))))
     84 
     85 (fn run []
     86   (let [pk (private-key)
     87         csr (signing-request pk)
     88         cert (http-post options.server (csr:toPEM))]
     89     (with-open [f (ncall (io.open options.key-out :w))]
     90       (f:write (pk:toPEM :private)))
     91     (with-open [f (ncall (io.open options.certificate-out :w))]
     92       (f:write cert))
     93     (print "done")))
     94 
     95 
     96 { : run }