tangc.fnl (6988B)
1 (local json (require :json)) 2 (local http (require :fetch)) 3 (local { : base64 : %%} (require :anoia)) 4 (local { : spawn } (require :anoia.process)) 5 (local { : find-executable } (require :anoia.fs)) 6 (local ll (require :lualinux)) 7 8 (local CLEVIS_DEFAULT_THP_LEN 43) ; Length of SHA-256 thumbprint. 9 (local thumbprint-algs ["S256" "S1"]) 10 11 (fn jose [params inputstr] 12 (var buf inputstr) 13 (let [env (ll.environ) 14 argv (doto params (table.insert 1 "jose")) 15 output [] 16 exitstatus 17 (spawn 18 (find-executable "jose" (os.getenv "PATH")) argv envp 19 (fn [stream fd] 20 (match stream 21 :out (let [b (ll.read fd)] 22 (if (> (# b) 0) 23 (do (table.insert output b) true) 24 (do (ll.close fd) false))) 25 :in (let [b (string.sub buf (+ 1 (ll.write fd buf)) -1)] 26 (if (> (# b) 0) 27 (do (set buf b) true) 28 (do (ll.close fd) false))))))] 29 (values exitstatus (table.concat output)))) 30 31 (fn jose! [params inputstr] 32 (let [(exitcode out) (jose params inputstr)] 33 (if (= exitcode 0) 34 (json.decode out) 35 (error (%% "jose %q failed (exit=%d): %q" 36 (table.concat params " ") exitcode out))))) 37 38 (fn josep! [params inputstr] 39 (let [(exitcode out) (jose params inputstr)] 40 (if (= exitcode 0) 41 out 42 (error (%% "jose %q failed (exit=%d): %q" 43 (table.concat params " ") exitcode out))))) 44 45 (fn has-key? [keys kid alg] 46 (jose! ["jwk" "thp" "-i-" "-f" kid "-a" alg] (json.encode keys))) 47 48 (fn search-key [keys kid] 49 (accumulate [ret nil 50 _ alg (ipairs thumbprint-algs) 51 &until ret] 52 (or ret (has-key? keys kid alg)))) 53 54 (fn jwk-generate [crv] 55 (jose! ["jwk" "gen" "-i" (%% "{\"alg\":\"ECMR\",\"crv\":%q}" crv)] "")) 56 57 (fn jwk-pub [response] 58 (jose! ["jwk" "pub" "-i-"] (json.encode response))) 59 60 (fn jwk-exc-noi [clt eph] 61 (jose! ["jwk" "exc" "-l-" "-r-"] 62 (.. (json.encode clt) " " (json.encode eph)))) 63 64 (fn jwk-exc [clt eph] 65 (jose! ["jwk" "exc" "-i" "{\"alg\":\"ECMR\"}" "-l-" "-r-"] 66 (.. (json.encode clt) " " (json.encode eph)))) 67 68 (fn jwe-dec [jwk ph undigested] 69 ;; sometimes jose jwe dec decrypts the file and exits 70 ;; non-zero anyway. FIXME find out why 71 (let [inputstr (.. (json.encode jwk) ph "." undigested) 72 (exitcode out) (jose ["jwe" "dec" "-k-" "-i-"] inputstr)] 73 (if (> exitcode 0) 74 (: io.stderr :write (%% "jose jwe dec exited %d\n" exitcode))) 75 (if (not (= out "")) 76 out 77 (error (%% "jose jwe dec produced no output, exited %d" exitcode))))) 78 79 (fn parse-jwe [jwe] 80 (assert (= jwe.clevis.pin "tang") "invalid clevis.pin") 81 (assert jwe.clevis.tang.adv "no advertised keys") 82 (assert (>= (# jwe.kid) CLEVIS_DEFAULT_THP_LEN) 83 "tang using a deprecated hash for the JWK thumbprints") 84 (let [srv (search-key jwe.clevis.tang.adv jwe.kid)] 85 { 86 :kid jwe.kid 87 :clt (assert jwe.epk) 88 :crv (assert jwe.epk.crv "Unable to determine EPK's curve!") 89 :url (assert jwe.clevis.tang.url "no tang url") 90 :srv (assert srv 91 "JWE header validation of 'clevis.tang.adv' failed: key thumbprint does not match") 92 })) 93 94 (fn http-post [url body] 95 (match 96 (http.request "POST" url 97 "" 0 98 "application/x-www-form-urlencoded" 99 body) 100 s (json.decode s) 101 (nil code msg) (error (.. "Error " code " POST " url ": " msg)))) 102 103 104 (fn http-get [url body] 105 (match 106 (http.fetch url) 107 s (json.decode s) 108 (nil code msg) (error (.. "Error " code " GET " url ": " msg)))) 109 110 (fn decrypt [] 111 (let [b64 (base64 :url) 112 raw (: (io.input) :read "*a") 113 (_ _ ph undigested) (string.find raw "(.-)%.(.+)") 114 jwe (json.decode (b64:decode ph)) 115 { : srv : crv : clt : kid : url} (parse-jwe jwe) 116 eph (jwk-generate crv) 117 xfr (jwk-exc clt eph) 118 response (http-post (.. url "/rec/" kid) (json.encode xfr))] 119 (assert (and (= response.kty "EC") (= response.crv crv)) 120 "Received invalid server reply!") 121 (let [tmp (jwk-exc eph srv) 122 rep (jwk-pub response) 123 jwk (jwk-exc-noi rep tmp)] 124 (print (jwe-dec jwk ph undigested))))) 125 126 (fn perform-encryption [jwks url input] 127 (let [enc (jose! [:jwk :use "-i-" "-r" "-u" "deriveKey" "-o-"] 128 (json.encode jwks)) 129 ;; adding a -s to jwk use will "Always output a JWKSet" which 130 ; ;presumably would make the following line redundant 131 enc_ (if enc.keys enc {:keys [enc]})] 132 (assert (= (# enc_.keys) 1) 133 (.. "Expected one exchange key, got " (# enc_.keys))) 134 135 (let [jwk (doto (. enc_.keys 1) (tset :key_ops nil) (tset :alg nil)) 136 kid (josep! [:jwk :thp "-i-" "-a" (. thumbprint-algs 1)] 137 (json.encode jwk)) 138 jwe {:protected { 139 :alg "ECDH-ES" 140 :enc "A256GCM" 141 :kid kid 142 :clevis {:pin "tang" 143 :tang {:url url :adv jwks }}}}] 144 (josep! [:jwe :enc "-i-" "-k-" "-I-" "-c"] 145 (.. (json.encode jwe) (json.encode jwk) input))))) 146 147 (fn usage [] 148 (print "tangc\n=====\n") 149 (print "tangc decrypt < filename.enc # decrypt") 150 (print (%% "tangc encrypt %q # print available keys" 151 (json.encode {:url "http://tang.local"}))) 152 (print (%% "tangc encrypt %q < plaintext > filename.enc # encrypt" 153 (json.encode {:thp "idGFpbiBhIHByZWJ1aWx0IGRhdGFiYXNlIGZyb20gaH" 154 :url "http://tang.local"}))) 155 (os.exit 1)) 156 157 158 (fn encrypt [cfg] 159 (let [{ : url : thp : adv } cfg 160 _ (or url (usage)) 161 raw-input (: (io.input) :read "*a") 162 b64 (base64 :url) 163 adv (or adv (http-get (.. url "/adv/" (or thp ""))))] 164 (assert adv.payload "advertisement is malformed") 165 (let [jwks (json.decode (b64:decode adv.payload)) 166 ver (jose! [:jwk :use "-i-" "-r" "-u" "verify" "-o-"] 167 (json.encode jwks))] 168 (match 169 (josep! [:jws :ver "-i" (json.encode adv) "-k-" "-a"] (json.encode ver)) 170 "" nil 171 str (error "jws verify of advertised keys failed: " str)) 172 173 (if (and thp (search-key ver thp)) 174 (: (io.output) :write (perform-encryption jwks url raw-input)) 175 ;; the command line options are currently the same as clevis 176 ;; but unless I can greatly improve this wording, that's gonna change 177 (print (.. "\ntangc: Thumbprints of advertised keys are listed below. Rerun this command\nproviding the thp attribute to specify the preferred key\n\n" 178 (josep! [:jwk :thp "-i-" "-a" (. thumbprint-algs 1)] (json.encode ver)))))))) 179 180 181 (fn run [] 182 (case arg 183 ["decrypt"] (decrypt) 184 ["encrypt" cfg] (encrypt (json.decode cfg)) 185 _ (usage))) 186 187 { : run }