dan
/
liminix
1
0
Fork 5
Code Issues 2 Pull Requests 1 Projects Releases Wiki Activity

clevis-decrypt-tang in fennel 

needs a lot of tidying up, but works on my test file
This commit is contained in:
Daniel Barlow 2024-08-28 01:37:44 +01:00
parent ff76d854fc
commit a41839f3d1
3 changed files with 210 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/default.nix
View File

@ -118,6 +118,7 @@ in {
serviceFns = callPackage ./service-fns { };
swconfig = callPackage ./swconfig { };
systemconfig = callPackage ./systemconfig { };
tangc = callPackage ./tangc { };
tufted = callPackage ./tufted { };
uevent-watch = callPackage ./uevent-watch { };
usb-modeswitch = callPackage ./usb-modeswitch { };

41
pkgs/tangc/default.nix Normal file
View File

@ -0,0 +1,41 @@
{
fetchurl,
writeFennel,
fennel,
fennelrepl,
runCommand,
jose,
lua,
anoia,
lualinux,
fetch-freebsd,
openssl,
rxi-json,
makeWrapper,
stdenv
}:
let name = "tangc";
in stdenv.mkDerivation {
inherit name;
src = ./.;
buildInputs = [fetch-freebsd rxi-json openssl lua jose];
nativeBuildInputs = [ makeWrapper ];
buildPhase = "";
installPhase = ''
mkdir -p $out/bin
cp -p ${writeFennel name {
packages = [
fetch-freebsd
rxi-json
fennel
anoia
lualinux
jose
] ;
mainFunction = "run";
} ./tangc.fnl } $out/bin/${name}
wrapProgram $out/bin/${name} --set JOSE_BIN ${jose}/bin/jose
'';
}

168
pkgs/tangc/tangc.fnl Normal file
View File

@ -0,0 +1,168 @@
(local json (require :json))
(local http (require :fetch))
(local { : view : join } (require :fennel))
(local { : split : base64 : %%} (require :anoia))
(local ll (require :lualinux))
(fn popen2 [pname argv envp]
(case (ll.pipe2)
(cin-s cin-d)
(match (ll.pipe2)
(cout-s cout-d)
(let [(pid err) (ll.fork)]
(if (not pid) (error (.. "error: " err))
(= pid 0)
(do
(ll.close cin-d)
(ll.close cout-s)
(ll.dup2 cin-s 0)
(ll.dup2 cout-d 1)
(ll.dup2 cout-d 2)
(ll.execve pname argv envp)
(error "execve failed"))
(> pid 0)
(do
(ll.close cin-s)
(ll.close cout-d)))
(values pid cin-d cout-s))
(nil err) (error (.. "popen pipe out: " err)))
(nil err) (error (.. "popen pipe in: " err))))
(local CLEVIS_DEFAULT_THP_LEN 43) ; Length of SHA-256 thumbprint.
(local thumbprint-algs ["S256" "S1"])
(fn exited [pid]
(match (ll.waitpid pid)
(0 status) false
(pid status) (rshift (band status 0xff00) 8)
(nil errno) (error (.. "waitpid: " errno))))
(fn min [a b] (if (< a b) a b))
(fn trace [s] (print :TRACE s) s)
(fn write-all [fd str]
(let [written (ll.write fd str)]
(if (< written (# str))
(write-all fd (string.sub str (+ written 1) -1)))))
(fn jose [params inputstr]
(let [env (ll.environ)
(pid in out) (popen2 (os.getenv "JOSE_BIN") params env)]
;(print "exec " (os.getenv "JOSE_BIN") (view params))
;(print "writing")
(when inputstr (write-all in inputstr))
;(print :written)
(ll.close in)
(let [output
(accumulate [o ""
buf #(match (ll.read out) "" nil s s)]
(.. o buf))]
(values (exited pid) output))))
(fn has-key? [keys kid alg]
(let [jkeys (json.encode keys)
(exitcode srv) (jose
["jose" "jwk" "thp" "-i-"
"-f" kid
"-a" alg]
jkeys)]
(if (= exitcode 0)
(json.decode srv)
nil)))
(fn jwk-generate [crv]
(let [(exitcode eph)
(jose ["jose" "jwk" "gen"
"-i" (%% "{\"alg\":\"ECMR\",\"crv\":%q}" crv)]
"")]
(if (= exitcode 0)
(json.decode eph)
(error (.. "Error generating ephemeral key: " exitcode "/" eph) ))))
(fn jwk-pub [response]
(let [(exitcode pub)
(jose ["jose" "jwk" "pub" "-i-"]
(json.encode response))]
(if (= exitcode 0)
(json.decode pub)
(error (.. "Error pub " exitcode "/" pub) ))))
(fn jwk-exc-noi [clt eph]
(let [payload (.. (json.encode clt) " " (json.encode eph))
(exitcode xfr)
(jose ["jose" "jwk" "exc"
"-l-" "-r-"]
payload)]
(if (= exitcode 0)
(json.decode xfr)
(error (.. "Error calling jwk exc: " exitcode " / " xfr )))))
(fn jwk-exc [clt eph]
(let [payload (.. (json.encode clt) " " (json.encode eph))
(exitcode xfr)
(jose ["jose" "jwk" "exc"
"-i" "{\"alg\":\"ECMR\"}"
"-l-" "-r-"]
payload)]
(if (= exitcode 0)
(json.decode xfr)
(error (.. "Error calling jwk exc: " exitcode " / " xfr )))))
(fn jwe-dec [jwk ph undigested]
(let [payload (.. (json.encode jwk) ph undigested)
; _ (print :payload payload)
(exitcode plaintext)
(jose ["jose" "jwe" "dec" "-k-" "-i-"]
payload)]
(if (= exitcode 0)
plaintext
(error (.. "Error calling jwe dec: " exitcode " / " plaintext )))))
(fn parse-jwe [jwe]
(assert (= jwe.clevis.pin "tang") "invalid clevis.pin")
(assert jwe.clevis.tang.adv "no advertised keys")
(assert (>= (# jwe.kid) CLEVIS_DEFAULT_THP_LEN)
"tang using a deprecated hash for the JWK thumbprints")
(let [srv (accumulate [ret nil
_ alg (ipairs thumbprint-algs)
&until ret]
(or ret (has-key? jwe.clevis.tang.adv jwe.kid alg)))]
{
:kid jwe.kid
:clt (assert jwe.epk)
:crv (assert jwe.epk.crv "Unable to determine EPK's curve!")
:url (assert jwe.clevis.tang.url "no tang url")
:srv (assert srv
"JWE header validation of 'clevis.tang.adv' failed: key thumbprint does not match")
}))
(fn http-post [url body]
(json.decode
(http.request "POST" url
"" 0
"application/x-www-form-urlencoded"
body)))
(fn run []
(let [b64 (base64 :url)
raw (: (io.input) :read "*a")
dot (string.find raw "." 1 true)
ph (string.sub raw 1 dot)
undigested (string.sub raw (+ 1 dot) -1)
jwe (json.decode (b64:decode ph))
{ : srv : crv : clt : kid : url} (parse-jwe jwe)
eph (jwk-generate crv)
xfr (jwk-exc clt eph)
response (http-post (.. url "/rec/" kid) (json.encode xfr))]
(assert (and (= response.kty "EC") (= response.crv crv))
"Received invalid server reply!")
(let [tmp (jwk-exc eph srv)
rep (jwk-pub response)
jwk (jwk-exc-noi rep tmp)]
(print (jwe-dec jwk ph undigested)))))
{ : run }