fix: atomic 0600 file creation, gate crypto commands only, validate ed25519 length, tty passphrase
ober
1cad3470bb599adb691572549af6ddc7dde5c9e7
--- a/pgp/cli.ss +++ b/pgp/cli.ss @@ -479,8 +479,6 @@ Globally, -i/--in '-' means stdin and -o/--out '-' means stdout. ;; ── dispatcher ───────────────────────────────────────────────────────── (def (run-cli raw-args) - (unless (jpgp-available?) - (die "libjpgp_native is not loaded. Did you `make build-native`?")) ;; Chez's --script leaves a literal "--" in command-line-arguments ;; when the Makefile invocation uses `-- $(ARGS)`. Drop it. (let ([args (if (and (pair? raw-args) (string=? (car raw-args) "--")) @@ -492,16 +490,24 @@ Globally, -i/--in '-' means stdin and -o/--out '-' means stdout. (let ([cmd (car args)] [rest (cdr args)]) (cond + ;; help/version are pure metadata and must work even when the + ;; native crypto backend has not been built. [(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 "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)]))]))) + [else + ;; Every remaining subcommand performs crypto, so gate them on + ;; the native backend rather than gating the whole CLI. + (unless (jpgp-available?) + (die "libjpgp_native is not loaded. Did you `make build-native`?")) + (cond + [(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/identity.ss +++ b/pgp/identity.ss @@ -34,11 +34,10 @@ meta atom? partition sort sort! make-date make-time read-file-string path-join) (only (jerboa core) create-directory* getenv) - (only (std misc process) - open-process - process-port-rec-stdin-port - process-port-rec-stdout-port - process-port-rec-stderr-port) + (only (jerboa ffi) c-lambda) + (only (std os posix) + O_CLOEXEC O_CREAT O_TRUNC O_WRONLY + posix-close posix-open posix-write) (only (std text base64) u8vector->base64-string base64-string->u8vector) (pgp util) (pgp ffi) @@ -83,22 +82,41 @@ (not (file-exists? dir))) (create-directory* dir)))))) - (def (chmod-0600 path) - (guard (e [(condition? e) #f]) - (let ([proc (open-process (list 'path: "chmod" 'arguments: (list "600" path)))]) - (close-port (process-port-rec-stdin-port proc)) - (close-port (process-port-rec-stdout-port proc)) - (close-port (process-port-rec-stderr-port proc)) - #t))) + (def c-fchmod (c-lambda (integer-32 unsigned-32) integer-32 "fchmod")) + + ;; Write secret material to `path`, creating it 0600 atomically at creation + ;; time. The mode is passed to open(2) and re-asserted with fchmod(2) (which + ;; ignores umask), so there is never a window where the file is + ;; world-readable. This replaces the old write-then-chmod sequence, which + ;; raced: the file briefly existed with the default umask permissions. + (def (write-private-bytes path bv) + (let ([fd (posix-open path + (bitwise-ior O_WRONLY O_CREAT O_TRUNC O_CLOEXEC) + #o600)]) + (dynamic-wind + (lambda () #f) + (lambda () + (unless (= (c-fchmod fd #o600) 0) + (jpgp-error 'save-identity "cannot enforce 0600 mode on ~a" path)) + (let ([n (bytevector-length bv)]) + (let loop ([off 0]) + (when (< off n) + (let* ([remaining (- n off)] + [chunk (let ([c (make-bytevector remaining)]) + (bytevector-copy! bv off c 0 remaining) + c)] + [written (posix-write fd chunk remaining)]) + (when (<= written 0) + (jpgp-error 'save-identity "short write to ~a" path)) + (loop (+ off written))))))) + (lambda () (posix-close fd))))) (def (save-identity id path passphrase) (ensure-parent-dir path) (let* ([text (identity->text id)] [pt (string->utf8 text)] [ct (jpgp-pass-encrypt pt passphrase)]) - (write-file-bytes path ct) - ;; chmod 600 — best effort - (chmod-0600 path))) + (write-private-bytes path ct))) (def (parse-identity-text text) (let loop ([lines (string-split text #\newline)] --- a/pgp/prompt.ss +++ b/pgp/prompt.ss @@ -31,16 +31,32 @@ (def (enable-tty-echo) (run-constant-command "sh" '("-c" "stty echo </dev/tty 2>/dev/null"))) + ;; Open the controlling terminal for reading, as a textual port. Echo is + ;; disabled on /dev/tty (see disable-tty-echo), so the passphrase must be + ;; read from that same device rather than from (current-input-port), which + ;; may be a redirected stdin. Returns #f when there is no controlling tty. + (def (open-tty-input) + (guard (e [(condition? e) #f]) + (transcoded-port + (open-file-input-port "/dev/tty") + (native-transcoder)))) + (def (read-passphrase prompt) (display prompt (current-error-port)) (flush-output-port (current-error-port)) - (let ([line #f]) + (let ([tty (open-tty-input)] + [line #f]) (dynamic-wind disable-tty-echo - (lambda () (set! line (get-line (current-input-port)))) + (lambda () + ;; Read from /dev/tty (where echo was disabled); fall back to stdin + ;; only when no controlling terminal is available. + (set! line (get-line (or tty (current-input-port))))) (lambda () (enable-tty-echo) - (newline (current-error-port)))) + (newline (current-error-port)) + (when tty + (guard (e [(condition? e) #f]) (close-port tty))))) (if (eof-object? line) "" line))) (def (read-passphrase-confirm prompt) --- a/pgp/recipient.ss +++ b/pgp/recipient.ss @@ -49,12 +49,17 @@ (let ([k (string->symbol (car kv))] [v (cdr kv)]) (loop (cdr xs) - (cons (cons k - (case k - [(ed25519) - (base64-string->u8vector v)] - [else v])) - acc))))])))) + (cons (cons k + (case k + [(ed25519) + (let ([bv (base64-string->u8vector v)]) + (unless (= (bytevector-length bv) 32) + (jpgp-error 'parse-jpgp-pubkey-line + "ed25519 public key must be exactly 32 bytes, got ~a" + (bytevector-length bv))) + bv)] + [else v])) + acc))))])))) (def (jpgp-format-pubkey-line age-str ed25519-pk-bv . opts) (let ([comment (and (pair? opts) (car opts))]) --- a/test/verify-cli.sh +++ b/test/verify-cli.sh @@ -51,13 +51,26 @@ grep -q 'dynamic native loading is disabled' "$tmp/disabled-loader.err" set +e ( cd "$tmp" - JPGP_NATIVE_LIB="./libjpgp_native.dylib" run_verify version + JPGP_NATIVE_LIB="./libjpgp_native.dylib" run_verify keygen ) >"$tmp/relative-loader.out" 2>"$tmp/relative-loader.err" relative_loader_status=$? set -e [ "$relative_loader_status" -ne 0 ] grep -q 'JPGP_NATIVE_LIB must be absolute' "$tmp/relative-loader.err" +# help/version are pure metadata and must succeed even when the native backend +# cannot be loaded (here: a rejected relative JPGP_NATIVE_LIB). Crypto commands +# stay gated on the loader, as checked above. +set +e +( + cd "$tmp" + JPGP_NATIVE_LIB="./libjpgp_native.dylib" run_verify version +) >"$tmp/version-no-native.out" 2>"$tmp/version-no-native.err" +version_no_native_status=$? +set -e +[ "$version_no_native_status" -eq 0 ] +grep -q 'jpg ' "$tmp/version-no-native.out" + untrusted_dir="$tmp/world-writable" mkdir "$untrusted_dir" chmod 0777 "$untrusted_dir"