liminix

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

certifix-client.fnl (2276B)

      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 http (require :fetch))
     11 
     12 (macro ncall [f]
     13   `(case ,f
     14      ok# ok#
     15      (nil err#) (error err#)))
     16 
     17 
     18 (fn x509-name [subj]
     19   (let [n (xn.new)]
     20     (each [_ c (ipairs (split "," subj))]
     21       (let [(k v) (string.match c "(.-)=(.+)")]
     22         (n:add k v)))
     23     n))
     24 
     25 (fn x509-altname [subj]
     26   (let [an (altname.new)]
     27     (each [_ c (ipairs (split "," subj))]
     28       (let [(k v) (string.match c "(.-)=(.+)")]
     29         (if (= k "CN") (an:add "DNS" v))))
     30     an))
     31 
     32 (fn parse-args [args]
     33   (case args
     34     ["--secret" secret & rest]
     35     (assoc (parse-args rest)
     36            :secret (with-open [f (ncall (io.open secret :r))] (f:read "l")))
     37 
     38     ["--subject" subject & rest]
     39     (assoc (parse-args rest) :subject subject)
     40 
     41     ["--key-out" pathname & rest]
     42     (assoc (parse-args rest) :key-out pathname)
     43 
     44     ["--certificate-out" pathname & rest]
     45     (assoc (parse-args rest) :certificate-out pathname)
     46 
     47     [server] { : server }
     48     _ {}))
     49 
     50 
     51 (local options (parse-args arg))
     52 
     53 (fn private-key []
     54   (pkey.new { :type :rsa :bits 1024 }))
     55 
     56 (fn signing-request [pk]
     57   (doto (csr.new)
     58     (: :setVersion 3)
     59     (: :setSubject (x509-name options.subject))
     60     (: :setSubjectAlt (x509-altname options.subject))
     61     (: :setPublicKey pk)
     62     (: :addAttribute :challengePassword [options.secret])
     63     (: :sign pk)))
     64 
     65 
     66 (fn http-post [url body]
     67   (match
     68       (http.request "POST" url
     69                     "" 0
     70                     "application/x-pem-file"
     71                     body)
     72     s s
     73     (nil code msg) (error (.. "Error " code " POST " url ": " msg))))
     74 
     75 
     76 (fn run []
     77   (let [pk (private-key)
     78         csr (signing-request pk)
     79     ;; key-out (or options.key-out-handle io.stdout)
     80     ;; cert-out (or options.cert-out-handle io.stdout)
     81         cert (http-post options.server (csr:toPEM))]
     82     (with-open [f (ncall (io.open options.key-out :w))]
     83       (f:write (pk:toPEM :private)))
     84     (with-open [f (ncall (io.open options.certificate-out :w))]
     85       (f:write cert))
     86     (print "done")))
     87 
     88 
     89 { : run }