CLI: symmetric mode, multi-recipient, fingerprint, list
ober
c9252cb628e87b2eeef1a6bd267d80bfdf5b6bf5
--- a/pgp-native/src/lib.rs +++ b/pgp-native/src/lib.rs @@ -264,6 +264,32 @@ pub unsafe extern "C" fn jpgp_pgp_encrypt( }) } +// ── SHA-256 (used for fingerprints) ───────────────────────────────────────── + +/// SHA-256 of `input` written to `out` (must be 32 bytes). +#[no_mangle] +pub unsafe extern "C" fn jpgp_sha256( + input: *const u8, + input_len: u32, + out: *mut u8, +) -> i32 { + guard(|| { + if out.is_null() { + return JPGP_E_INVALID_INPUT; + } + let data = match unsafe { slice_from(input, input_len) } { + Some(s) => s, + None => return JPGP_E_INVALID_INPUT, + }; + use sha2::{Digest, Sha256}; + let mut hasher = Sha256::new(); + hasher.update(data); + let digest = hasher.finalize(); + unsafe { slice::from_raw_parts_mut(out, 32).copy_from_slice(&digest) }; + JPGP_OK + }) +} + // ── ABI version stamp ─────────────────────────────────────────────────────── /// ABI version. Bump when the FFI surface changes incompatibly. --- a/pgp/cli.ss +++ b/pgp/cli.ss @@ -59,6 +59,15 @@ (def (opt-or opts flag default) (or (opt opts flag) default)) + ;; Return a list of values for any flag in FLAGS, in order. + (def (opt-all opts . flags) + (let loop ([xs opts] [acc '()]) + (cond + [(null? xs) (reverse acc)] + [(member (car (car xs)) flags) + (loop (cdr xs) (cons (cdr (car xs)) acc))] + [else (loop (cdr xs) acc)]))) + (def (die fmt . args) (apply fprintf (cons (current-error-port) (cons (string-append "jpgp: " fmt "\n") args))) (exit 1)) @@ -76,20 +85,37 @@ Commands: pubkey [--identity PATH] [--out PATH] Print or write the public-key line for this identity. - encrypt -r RECIPIENT [-i IN] [-o OUT] - Encrypt IN to RECIPIENT. + list [--identity PATH] + Show identity info: paths, age pubkey, fingerprint. + + fingerprint [--identity PATH] + Print SHA256: fingerprint of this identity's jpgp1 pubkey line. + + encrypt [-r RECIPIENT ...] [-s|--symmetric] [-i IN] [-o OUT] + Encrypt IN to one or more recipients. RECIPIENT may be a bare 'age1...' string, a path to a jpgp1 public-key line, or a path to an OpenPGP .asc public key. - OpenPGP recipients produce gpg-compatible output. + Multiple -r flags are allowed for age/jpgp recipients (all share + one armored output). OpenPGP recipients require a single -r and + produce gpg-compatible output. + With --symmetric, prompts for a passphrase instead. - decrypt [-i IN] [-o OUT] [--identity PATH] - Decrypt IN with this identity (age messages only in v1). + decrypt [-s|--symmetric] [-i IN] [-o OUT] [--identity PATH] + Decrypt IN. Defaults to identity mode; pass --symmetric to use + a passphrase. Inbound OpenPGP needs --pgp-key SECRET.asc. + + decrypt --pgp-key SECRET.asc [--pgp-pass PASS] [-i IN] [-o OUT] + Decrypt an OpenPGP message with an armored secret key. sign [-i IN] [-o OUT] [--identity PATH] Sign IN with this identity. Writes a jpgp signature blob. - verify SIG [-i IN] - Verify SIG against IN. + sign --pgp-key SECRET.asc [--pgp-pass PASS] [-i IN] [-o OUT] + Produce a gpg-compatible detached signature. + + verify SIG [-i IN] [--pubkey FILE] + Verify SIG against IN. SIG may be a jpgp or OpenPGP signature. + With OpenPGP, pass --pgp-pubkey PUB.asc. version Print version. @@ -136,38 +162,104 @@ Globally, -i/--in '-' means stdin and -o/--out '-' means stdout. [line (identity-pubkey-line id)]) (write-file-bytes out (string->utf8 line))))) + ;; ── fingerprint / list ───────────────────────────────────────────────── + + ;; SSH-style fingerprint: "SHA256:" + base64 of sha256(jpgp1 line) with + ;; trailing '=' padding stripped. + (def (strip-trailing-padding s) + (let loop ([n (string-length s)]) + (cond + [(zero? n) s] + [(char=? (string-ref s (- n 1)) #\=) (loop (- n 1))] + [else (substring s 0 n)]))) + + (def (identity-fingerprint id) + (let* ([line (string-trim (identity-pubkey-line id))] + [hash (jpgp-sha256 (string->utf8 line))] + [b64 (u8vector->base64-string hash)]) + (string-append "SHA256:" (strip-trailing-padding b64)))) + + (def (cmd-fingerprint rest) + (let* ([parsed (parse-opts rest '(("--identity" . #t)))] + [opts (car parsed)] + [idp (opt-or opts "--identity" (default-identity-path))]) + (let* ([pass (read-passphrase (format "Passphrase for ~a: " idp))] + [id (load-identity idp pass)]) + (display (identity-fingerprint id)) + (newline)))) + + (def (cmd-list rest) + (let* ([parsed (parse-opts rest '(("--identity" . #t)))] + [opts (car parsed)] + [idp (opt-or opts "--identity" (default-identity-path))]) + (cond + [(not (file-exists? idp)) + (die "no identity at ~a — run `jpgp keygen`" idp)] + [else + (let* ([pass (read-passphrase (format "Passphrase for ~a: " idp))] + [id (load-identity idp pass)]) + (fprintf (current-output-port) + "Identity: ~a~%Age pubkey: ~a~%Fingerprint: ~a~%Public line: ~a" + idp + (identity-age-pub id) + (identity-fingerprint id) + (identity-pubkey-line id)))]))) + ;; ── encrypt ──────────────────────────────────────────────────────────── - (def (recipient->dispatch r) - (case (car r) - [(age) (values 'age (cadr r))] - [(jpgp) (let ([fields (cadr r)]) - (let ([a (assq 'age fields)]) - (unless a (jpgp-error 'encrypt "jpgp1 line missing age= field")) - (values 'age (cdr a))))] - [(pgp) (values 'pgp (cadr r))] - [else (jpgp-error 'encrypt "unknown recipient kind: ~s" (car r))])) + ;; Extract the age recipient string from an age- or jpgp-tagged recipient. + (def (age-string-of rec) + (case (car rec) + [(age) (cadr rec)] + [(jpgp) (let ([a (assq 'age (cadr rec))]) + (unless a (jpgp-error 'encrypt "jpgp1 line missing age= field")) + (cdr a))] + [else (jpgp-error 'encrypt "expected age/jpgp recipient, got ~s" (car rec))])) + + (def (all-age-style? recs) + (let loop ([xs recs]) + (cond + [(null? xs) #t] + [(or (eq? (car (car xs)) 'age) (eq? (car (car xs)) 'jpgp)) + (loop (cdr xs))] + [else #f]))) (def (cmd-encrypt rest) (let* ([parsed (parse-opts rest '(("-r" . #t) ("--recipient" . #t) ("-i" . #t) ("--in" . #t) - ("-o" . #t) ("--out" . #t)))] + ("-o" . #t) ("--out" . #t) + ("-s" . #f) ("--symmetric" . #f)))] [opts (car parsed)] - [rec (or (opt opts "-r") (opt opts "--recipient") - (die "encrypt: -r RECIPIENT required"))] + [symmetric? (or (opt opts "-s") (opt opts "--symmetric"))] [inp (or (opt opts "-i") (opt opts "--in") "-")] - [outp (or (opt opts "-o") (opt opts "--out") "-")]) - (let-values ([(kind val) (recipient->dispatch (recipient-from-file rec))]) - (let ([plain (read-file-bytes inp)]) - (case kind - [(age) - (let ([ct (jpgp-age-encrypt plain (string-append val "\n"))]) - (write-file-bytes outp ct))] - [(pgp) - (let ([ct (jpgp-pgp-encrypt val plain)]) - (write-file-bytes outp ct))] - [else (jpgp-error 'encrypt "unsupported recipient kind ~s" kind)]))))) + [outp (or (opt opts "-o") (opt opts "--out") "-")] + [plain (read-file-bytes inp)]) + (cond + [symmetric? + (let ([pass (read-passphrase-confirm "Passphrase: ")]) + (when (string=? pass "") + (die "empty passphrase not allowed")) + (let ([ct (jpgp-pass-encrypt plain pass)]) + (write-file-bytes outp ct)))] + [else + (let ([raw-recs (opt-all opts "-r" "--recipient")]) + (when (null? raw-recs) + (die "encrypt: -r RECIPIENT required (or --symmetric)")) + (let ([recs (map recipient-from-file raw-recs)]) + (cond + [(all-age-style? recs) + (let* ([age-strs (map age-string-of recs)] + [joined (apply string-append + (map (lambda (s) (string-append s "\n")) + age-strs))] + [ct (jpgp-age-encrypt plain joined)]) + (write-file-bytes outp ct))] + [(and (= 1 (length recs)) (eq? (car (car recs)) 'pgp)) + (let ([ct (jpgp-pgp-encrypt (cadr (car recs)) plain)]) + (write-file-bytes outp ct))] + [else + (die "encrypt: cannot mix age and PGP recipients in one output, and multi-PGP is not supported yet")])))]))) ;; ── decrypt ──────────────────────────────────────────────────────────── @@ -175,21 +267,33 @@ Globally, -i/--in '-' means stdin and -o/--out '-' means stdout. (let* ([parsed (parse-opts rest '(("-i" . #t) ("--in" . #t) ("-o" . #t) ("--out" . #t) - ("--identity" . #t)))] + ("--identity" . #t) + ("--pgp-key" . #t) ("--pgp-pass" . #t) + ("-s" . #f) ("--symmetric" . #f)))] [opts (car parsed)] + [symmetric? (or (opt opts "-s") (opt opts "--symmetric"))] + [pgp-key (opt opts "--pgp-key")] [idp (opt-or opts "--identity" (default-identity-path))] [inp (or (opt opts "-i") (opt opts "--in") "-")] - [outp (or (opt opts "-o") (opt opts "--out") "-")]) - (let* ([pass (read-passphrase (format "Passphrase for ~a: " idp))] - [id (load-identity idp pass)] - [ct (read-file-bytes inp)] - [text (guard (e [#t #f]) (utf8->string ct))]) - (cond - [(and text (or (pgp-message-armor? text))) - (die "this is an OpenPGP message — inbound PGP decryption is out of scope for v1")] - [else - (let ([pt (jpgp-age-decrypt ct (identity-age-sk id))]) - (write-file-bytes outp pt))])))) + [outp (or (opt opts "-o") (opt opts "--out") "-")] + [ct (read-file-bytes inp)]) + (cond + [symmetric? + (let* ([pass (read-passphrase "Passphrase: ")] + [pt (jpgp-pass-decrypt ct pass)]) + (write-file-bytes outp pt))] + [pgp-key + (die "PGP decryption arrives in the next commit — wiring jpgp-pgp-decrypt FFI")] + [else + (let* ([pass (read-passphrase (format "Passphrase for ~a: " idp))] + [id (load-identity idp pass)] + [text (guard (e [#t #f]) (utf8->string ct))]) + (cond + [(and text (pgp-message-armor? text)) + (die "this is an OpenPGP message — re-run with --pgp-key SECRET.asc")] + [else + (let ([pt (jpgp-age-decrypt ct (identity-age-sk id))]) + (write-file-bytes outp pt))]))]))) ;; ── sign ─────────────────────────────────────────────────────────────── @@ -289,12 +393,14 @@ Globally, -i/--in '-' means stdin and -o/--out '-' means stdout. (cond [(member cmd '("help" "-h" "--help")) (cmd-help)] [(member cmd '("version" "-v" "--version")) (cmd-version)] - [(string=? cmd "keygen") (cmd-keygen rest)] - [(string=? cmd "pubkey") (cmd-pubkey rest)] - [(string=? cmd "encrypt") (cmd-encrypt rest)] - [(string=? cmd "decrypt") (cmd-decrypt rest)] - [(string=? cmd "sign") (cmd-sign rest)] - [(string=? cmd "verify") (cmd-verify rest)] + [(string=? cmd "keygen") (cmd-keygen rest)] + [(string=? cmd "pubkey") (cmd-pubkey rest)] + [(string=? cmd "list") (cmd-list rest)] + [(string=? cmd "fingerprint") (cmd-fingerprint rest)] + [(string=? cmd "encrypt") (cmd-encrypt rest)] + [(string=? cmd "decrypt") (cmd-decrypt rest)] + [(string=? cmd "sign") (cmd-sign rest)] + [(string=? cmd "verify") (cmd-verify rest)] [else (die "unknown command: ~a (try `jpgp help`)" cmd)]))]))) ) ;; end library --- a/pgp/ffi.ss +++ b/pgp/ffi.ss @@ -19,7 +19,8 @@ jpgp-ed25519-keygen ;; -> (values sk-bv pk-bv) jpgp-ed25519-sign ;; sk-bv bv -> sig-bv jpgp-ed25519-verify ;; pk-bv bv sig-bv -> bool - jpgp-pgp-encrypt) ;; string bv -> bv + jpgp-pgp-encrypt ;; string bv -> bv + jpgp-sha256) ;; bv -> bv(32) (import (except (chezscheme) make-hash-table hash-table? @@ -139,6 +140,11 @@ (foreign-procedure "jpgp_pgp_encrypt" (string u8* unsigned-32 u8* unsigned-32 u8*) integer-32))) + (define c-sha256 + (and *jpgp-loaded?* + (foreign-procedure "jpgp_sha256" + (u8* unsigned-32 u8*) integer-32))) + (define c-abi-version (and *jpgp-loaded?* (foreign-procedure "jpgp_abi_version" () unsigned-32))) @@ -263,4 +269,12 @@ plaintext-bv (bytevector-length plaintext-bv) out buf-len out-len-bv)))) + (def (jpgp-sha256 input-bv) + (need-lib 'jpgp-sha256) + (let ([out (make-bytevector 32 0)]) + (let ([code (c-sha256 input-bv (bytevector-length input-bv) out)]) + (unless (= code JPGP-OK) + (jpgp-error 'jpgp-sha256 "~a" (jpgp-error-message code))) + out))) + ) ;; end library --- a/test/test-all.ss +++ b/test/test-all.ss @@ -133,6 +133,22 @@ (bytevector? (cdr (assq 'ed25519 fields))) (= 32 (bytevector-length (cdr (assq 'ed25519 fields)))))))) +;; ── sha256 ───────────────────────────────────────────────────────────── +;; Compare against the known NIST test vectors, byte-for-byte. +(check "sha256 of empty bytevector matches NIST vector" + (bytevector=? (jpgp-sha256 #vu8()) + #vu8(#xe3 #xb0 #xc4 #x42 #x98 #xfc #x1c #x14 + #x9a #xfb #xf4 #xc8 #x99 #x6f #xb9 #x24 + #x27 #xae #x41 #xe4 #x64 #x9b #x93 #x4c + #xa4 #x95 #x99 #x1b #x78 #x52 #xb8 #x55))) + +(check "sha256 of 'abc' matches NIST vector" + (bytevector=? (jpgp-sha256 (string->utf8 "abc")) + #vu8(#xba #x78 #x16 #xbf #x8f #x01 #xcf #xea + #x41 #x41 #x40 #xde #x5d #xae #x22 #x23 + #xb0 #x03 #x61 #xa3 #x96 #x17 #x7a #x9c + #xb4 #x10 #xff #x61 #xf2 #x00 #x15 #xad))) + ;; ── armor detection ──────────────────────────────────────────────────── (check "blob-kind detects age cipher" (eq? 'age-cipher