secrets: encrypted at-rest API key store + import from opencode/claude-code/aider
ober
3bd589c8b7a6d62ae5f7f47f5c09a4938fd922e5
--- a/build-binary.ss +++ b/build-binary.ss @@ -107,6 +107,8 @@ "lib/jcode/core/log" "lib/jcode/core/session" "lib/jcode/core/message" + "lib/jcode/core/secrets" + "lib/jcode/core/secrets-import" "lib/jcode/core/escalation" "lib/jcode/core/expert" "lib/jcode/core/agent" @@ -329,7 +331,9 @@ "std/net/request" "std/net/uri" "std/net/http" - "std/db/sqlite"))) + "std/db/sqlite" + "std/crypto/aead" + "std/crypto/compare"))) ;; jerbsearch (vendored) — used by jcode/tool/web for in-process metasearch. ;; Compiled .so files live under vendor/jerboa-websearch/src/jerbsearch/. --- a/src/jcode/core/config.ss +++ b/src/jcode/core/config.ss @@ -13,11 +13,28 @@ (import :std/text/json :std/os/path - :jcode/core/models) + :jcode/core/models + :jcode/core/secrets) (def *config* (make-parameter #f)) (def *version* "0.1.1") +;; Canonical mapping of provider name -> env var. Used both at load +;; time to seed the providers hash and at lookup time so env vars +;; outrank the encrypted store. +(def *provider-env-vars* + '(("openai" . "OPENAI_API_KEY") + ("anthropic" . "ANTHROPIC_API_KEY") + ("google" . "GOOGLE_API_KEY") + ("openrouter" . "OPENROUTER_API_KEY") + ("deepseek" . "DEEPSEEK_API_KEY") + ("xai" . "XAI_API_KEY") + ("groq" . "GROQ_API_KEY") + ("mistral" . "MISTRAL_API_KEY") + ("together" . "TOGETHER_API_KEY") + ("cerebras" . "CEREBRAS_API_KEY") + ("perplexity" . "PERPLEXITY_API_KEY"))) + (def (jcode-home) "Return ~/.jcode, creating it if needed." (let ((dir (path-join (getenv "HOME") ".jcode"))) @@ -46,28 +63,11 @@ config)) (def (merge-env-config config) + ;; We DO NOT inject env vars into the providers hash here; lookup is + ;; layered in config-get-provider-key so env > encrypted-store > + ;; plaintext. Still seed opencode plaintext for backward compat. (let ((providers (or (hash-get config "providers") (make-hash-table)))) - ;; Load keys from opencode auth.json if available (merge-opencode-keys! providers) - ;; Env vars override everything - (for-each - (lambda (pair) - (let ((key (getenv (car pair)))) - (when key - (let ((p (or (hash-get providers (cdr pair)) (make-hash-table)))) - (hash-put! p "api_key" key) - (hash-put! providers (cdr pair) p))))) - '(("OPENAI_API_KEY" . "openai") - ("ANTHROPIC_API_KEY" . "anthropic") - ("GOOGLE_API_KEY" . "google") - ("OPENROUTER_API_KEY" . "openrouter") - ("DEEPSEEK_API_KEY" . "deepseek") - ("XAI_API_KEY" . "xai") - ("GROQ_API_KEY" . "groq") - ("MISTRAL_API_KEY" . "mistral") - ("TOGETHER_API_KEY" . "together") - ("CEREBRAS_API_KEY" . "cerebras") - ("PERPLEXITY_API_KEY" . "perplexity"))) (hash-put! config "providers" providers) config)) @@ -99,8 +99,28 @@ ((not (hash-table? obj)) #f) (else (loop (hash-get obj (car keys)) (cdr keys)))))) +(def (env-key-for-provider provider) + (let ((entry (assoc provider *provider-env-vars*))) + (and entry + (let ((v (getenv (cdr entry)))) + (and v (not (string=? v "")) v))))) + +(def (encrypted-key-for-provider provider) + ;; Only consult the encrypted store for providers that we know take + ;; an API key (those listed in *provider-env-vars*). Local providers + ;; like mlx/ollama need no key and asking for one would force a + ;; spurious passphrase prompt at startup. + ;; + ;; If the store is locked, secret-store-get will prompt for the + ;; passphrase; further calls in the same process hit the cache. + (and (assoc provider *provider-env-vars*) + (secret-store-exists?) + (secret-store-get provider))) + (def (config-get-provider-key provider) - (config-ref "providers" provider "api_key")) + (or (env-key-for-provider provider) + (encrypted-key-for-provider provider) + (config-ref "providers" provider "api_key"))) (def (config-model) (or (config-ref "model") new file mode 100644 --- /dev/null +++ b/src/jcode/core/secrets-import.ss @@ -0,0 +1,214 @@ +;;; Importers that pull API keys from other tools' plaintext stores into +;;; the encrypted jcode secret store. Each importer is best-effort and +;;; safe to call when the source file is missing — it returns a short +;;; (imported . count) result for the CLI to surface. +;;; +;;; Currently supported sources: +;;; +;;; opencode ~/.local/share/opencode/auth.json +;;; ~/.jcode/auth.json (legacy / shared) +;;; claude-code ~/.claude/.credentials.json (OAuth only — no key) +;;; aider ~/.aider.conf.yml (line-grep parse) +;;; env current process env vars +;;; prompt interactive entry for each known provider +;;; +;;; The store must be unlocked (or initialized) before calling any +;;; importer. The CLI subcommand handles that. + +(export *known-providers* + import-from-opencode! + import-from-claude-code! + import-from-aider! + import-from-env! + import-prompt-missing!) + +(import :std/text/json + :std/misc/string + :std/os/path + :jcode/core/secrets + :jcode/core/log + :jerboa/core + :jerboa/runtime) + +(def logger (make-logger "secrets-import")) + +;; Canonical provider names and their conventional env-var spellings. +(def *known-providers* + '(("anthropic" . "ANTHROPIC_API_KEY") + ("openai" . "OPENAI_API_KEY") + ("google" . "GOOGLE_API_KEY") + ("openrouter" . "OPENROUTER_API_KEY") + ("deepseek" . "DEEPSEEK_API_KEY") + ("xai" . "XAI_API_KEY") + ("groq" . "GROQ_API_KEY") + ("mistral" . "MISTRAL_API_KEY") + ("together" . "TOGETHER_API_KEY") + ("cerebras" . "CEREBRAS_API_KEY") + ("perplexity" . "PERPLEXITY_API_KEY"))) + +(def (read-json-safe path) + ;; Returns the parsed JSON object or #f on any failure. + (and (file-exists? path) + (guard (e (#t (log-warn logger "read-failed" `((path . ,path))) + #f)) + (call-with-input-file path read-json)))) + +;;; ---- opencode / jcode auth.json ---- + +(def (import-opencode-file! path) + (let ((auth (read-json-safe path))) + (cond + ((not auth) 0) + (else + (let loop ((names (map car *known-providers*)) (added 0)) + (cond + ((null? names) added) + (else + (let* ((name (car names)) + (entry (and (hash-table? auth) (hash-get auth name))) + (k (and entry (hash-table? entry) (hash-get entry "key")))) + (cond + ((and k (string? k) (not (string=? k ""))) + (secret-store-set! name k) + (loop (cdr names) (+ added 1))) + (else (loop (cdr names) added))))))))))) + +(def (import-from-opencode!) + ;; Check ~/.jcode/auth.json first, then opencode's path. Both formats + ;; are identical so we just sum the imports. + (let* ((home (getenv "HOME")) + (jcode (path-join home ".jcode" "auth.json")) + (oc (path-join home ".local" "share" "opencode" "auth.json")) + (n1 (import-opencode-file! jcode)) + (n2 (import-opencode-file! oc))) + (log-info logger "opencode-import" `((jcode . ,n1) (opencode . ,n2))) + (+ n1 n2))) + +;;; ---- claude-code .credentials.json ---- + +(def (import-from-claude-code!) + ;; Claude Code stores an OAuth bundle, not an API key. We can detect + ;; the OAuth shape and tell the user to grab an API key from the + ;; console instead of silently importing nothing. + (let* ((path (path-join (getenv "HOME") ".claude" ".credentials.json")) + (d (read-json-safe path))) + (cond + ((not d) 0) + ((and (hash-table? d) (hash-get d "claudeAiOauth")) + ;; OAuth-only — surface a warning and import nothing. + (display " Claude Code uses OAuth tokens (no API key to import)." + (current-error-port)) + (newline (current-error-port)) + (display " Get an API key from https://console.anthropic.com/ and add it with" + (current-error-port)) + (newline (current-error-port)) + (display " jcode keys add anthropic" + (current-error-port)) + (newline (current-error-port)) + 0) + ((and (hash-table? d) (hash-get d "anthropic_api_key")) + (let ((k (hash-get d "anthropic_api_key"))) + (when (and (string? k) (not (string=? k ""))) + (secret-store-set! "anthropic" k)) + 1)) + (else 0)))) + +;;; ---- aider config ---- + +(def (aider-key-line->pair line) + ;; Recognize "<provider>-api-key: <value>" (with optional quotes). + ;; Returns (provider . key) or #f. + (let ((trimmed (string-trim line))) + (cond + ((or (string=? trimmed "") + (and (> (string-length trimmed) 0) + (char=? (string-ref trimmed 0) #\#))) + #f) + (else + (let ((colon (string-index trimmed #\:))) + (and colon + (let* ((k (string-trim (substring trimmed 0 colon))) + (v (string-trim (substring trimmed (+ colon 1) + (string-length trimmed))))) + (and (string-suffix? "-api-key" k) + (> (string-length v) 0) + (cons (substring k 0 (- (string-length k) 8)) + (strip-quotes v)))))))))) + +(def (strip-quotes s) + (let ((n (string-length s))) + (cond + ((< n 2) s) + ((or (and (char=? (string-ref s 0) #\") + (char=? (string-ref s (- n 1)) #\")) + (and (char=? (string-ref s 0) #\') + (char=? (string-ref s (- n 1)) #\'))) + (substring s 1 (- n 1))) + (else s)))) + +(def (import-from-aider!) + (let ((path (path-join (getenv "HOME") ".aider.conf.yml"))) + (cond + ((not (file-exists? path)) 0) + (else + (let ((added 0)) + (call-with-input-file path + (lambda (p) + (let loop () + (let ((line (get-line p))) + (cond + ((eof-object? line) (void)) + (else + (let ((pair (aider-key-line->pair line))) + (when (and pair + (assoc (car pair) *known-providers*)) + (secret-store-set! (car pair) (cdr pair)) + (set! added (+ added 1)))) + (loop))))))) + (log-info logger "aider-import" `((count . ,added) (path . ,path))) + added))))) + +;;; ---- env vars ---- + +(def (import-from-env!) + (let loop ((entries *known-providers*) (added 0)) + (cond + ((null? entries) added) + (else + (let* ((name (car (car entries))) + (var (cdr (car entries))) + (val (getenv var))) + (cond + ((and val (not (string=? val ""))) + (secret-store-set! name val) + (loop (cdr entries) (+ added 1))) + (else + (loop (cdr entries) added)))))))) + +;;; ---- interactive prompt ---- + +(def (import-prompt-missing!) + ;; Walks known providers; for each one that has NO stored key, asks + ;; whether to enter one. Empty / EOF input skips. Returns the count + ;; of keys added in this pass. + (let ((added 0) + (have (secret-store-list))) + (for-each + (lambda (entry) + (let* ((name (car entry)) + (already (member name have))) + (unless already + (display (format " ~a key (blank to skip): " name) + (current-error-port)) + (flush-output-port (current-error-port)) + (let ((line (guard (e (#t #f)) + (get-line (current-input-port))))) + (cond + ((or (not line) (eof-object? line)) (void)) + (else + (let ((v (string-trim line))) + (unless (string=? v "") + (secret-store-set! name v) + (set! added (+ added 1)))))))))) + *known-providers*) + added)) new file mode 100644 --- /dev/null +++ b/src/jcode/core/secrets.ss @@ -0,0 +1,389 @@ +;;; jcode encrypted secret store. +;;; +;;; API keys are persisted under ~/.jcode/keys.enc as a 3-line text file: +;;; +;;; JCODE-KEYS-v1 +;;; <salt-hex> 16 random bytes for scrypt +;;; <ciphertext-hex> IV(12) || AES-256-GCM ciphertext || tag(16) +;;; +;;; A 32-byte AEAD key is derived from a master passphrase via +;;; scrypt(N=16384, r=8, p=1, len=32) against the salt. The cleartext +;;; payload is a JSON object mapping provider name -> api key string. +;;; +;;; Passphrase resolution at unlock: +;;; 1. JCODE_PASSPHRASE env var (non-interactive use) +;;; 2. /dev/tty prompt with stty -echo +;;; +;;; Once unlocked, the derived key + salt + secrets hash-table are cached +;;; in a single box for the rest of the process; subsequent writes reuse +;;; the cached key so the user is only prompted once per session. + +(export *secrets-cache* + secret-store-path + secret-store-exists? + secret-store-locked? + secret-store-lock! + secret-store-unlock! + secret-store-init! + secret-store-get + secret-store-set! + secret-store-remove! + secret-store-list + secret-store-change-passphrase! + secret-prompt-passphrase + bytevector->hex + hex->bytevector) + +(import :std/text/json + :std/misc/string + :std/os/path + :jcode/core/log + :jerboa/core + :jerboa/runtime) + +(def logger (make-logger "secrets")) + +(def *file-magic* "JCODE-KEYS-v1") +(def *salt-bytes* 16) +(def *pbkdf2-iters* 600000) ;; OWASP 2023 recommendation +(def *key-bytes* 32) + +;; Cache layout: (list derived-key salt secrets-hashtable) or #f when locked. +(def *secrets-cache* (box #f)) + +;;; ---- hex helpers (private; mirrors std/crypto/password impl) ---- + +(def (hex-val c) + (cond + ((and (char>=? c #\0) (char<=? c #\9)) + (- (char->integer c) (char->integer #\0))) + ((and (char>=? c #\a) (char<=? c #\f)) + (+ 10 (- (char->integer c) (char->integer #\a)))) + ((and (char>=? c #\A) (char<=? c #\F)) + (+ 10 (- (char->integer c) (char->integer #\A)))) + (else (error 'hex-val "Invalid hex char" c)))) + +(def (bytevector->hex bv) + (let* ((len (bytevector-length bv)) + (out (make-string (* len 2)))) + (do ((i 0 (+ i 1))) + ((= i len) out) + (let* ((b (bytevector-u8-ref bv i)) + (hi (bitwise-arithmetic-shift-right b 4)) + (lo (bitwise-and b #xf))) + (string-set! out (* i 2) (string-ref "0123456789abcdef" hi)) + (string-set! out (+ (* i 2) 1) (string-ref "0123456789abcdef" lo)))))) + +(def (hex->bytevector s) + (let* ((trimmed (string-trim s)) + (len (string-length trimmed)) + (out-len (quotient len 2)) + (result (make-bytevector out-len))) + (do ((i 0 (+ i 2)) (j 0 (+ j 1))) + ((>= i len) result) + (bytevector-u8-set! result j + (+ (* (hex-val (string-ref trimmed i)) 16) + (hex-val (string-ref trimmed (+ i 1)))))))) + +;;; ---- cache accessors ---- + +(def (secret-store-dir) + ;; Local copy of jcode-home semantics so this module has no + ;; dependency on jcode/core/config (which depends on us). + (let ((dir (path-join (getenv "HOME") ".jcode"))) + (unless (file-exists? dir) (mkdir dir)) + dir)) + +(def (secret-store-path) + (path-join (secret-store-dir) "keys.enc")) + +(def (secret-store-exists?) + (file-exists? (secret-store-path))) + +(def (secret-store-locked?) + (not (unbox *secrets-cache*))) + +(def (secret-store-lock!) + (set-box! *secrets-cache* #f)) + +(def (cached-key) (let ((c (unbox *secrets-cache*))) (and c (car c)))) +(def (cached-salt) (let ((c (unbox *secrets-cache*))) (and c (cadr c)))) +(def (cached-secrets) (let ((c (unbox *secrets-cache*))) (and c (caddr c)))) + +;;; ---- KDF + AEAD wrappers ---- + +;; libcrypto must be loaded before resolving foreign-procedure symbols. +;; (std crypto aead) also loads it, but at compile time symbol resolution +;; happens here, so we explicitly load up front. In static builds the +;; symbols are pre-registered via Sforeign_symbol. +(def _libcrypto-loaded + ;; Try in order: dlopen(NULL) (works when libcrypto symbols are + ;; statically linked into the binary), then absolute paths used by + ;; macOS/Homebrew and Linux. Bare "libcrypto.so"/".dylib" fails on + ;; macOS with SIP because dyld refuses untrusted library names. + (or (guard (e (#t #f)) (load-shared-object "") #t) + (guard (e (#t #f)) (load-shared-object "/opt/homebrew/opt/openssl@3/lib/libcrypto.dylib") #t) + (guard (e (#t #f)) (load-shared-object "/opt/homebrew/opt/openssl/lib/libcrypto.dylib") #t) + (guard (e (#t #f)) (load-shared-object "/usr/local/opt/openssl@3/lib/libcrypto.dylib") #t) + (guard (e (#t #f)) (load-shared-object "/usr/lib/libcrypto.dylib") #t) + (guard (e (#t #f)) (load-shared-object "/usr/lib/x86_64-linux-gnu/libcrypto.so.3") #t) + (guard (e (#t #f)) (load-shared-object "/usr/lib/aarch64-linux-gnu/libcrypto.so.3") #t) + (guard (e (#t #f)) (load-shared-object "libcrypto.so.3") #t) + (guard (e (#t #f)) (load-shared-object "libcrypto.so") #t))) + +(def c-PKCS5_PBKDF2_HMAC + (foreign-procedure "PKCS5_PBKDF2_HMAC" + (u8* int u8* int int uptr int u8*) int)) + +(def c-EVP_sha256 + (foreign-procedure "EVP_sha256" () uptr)) + +(def (derive-key passphrase salt) + (let* ((pass-bv (string->utf8 passphrase)) + (out (make-bytevector *key-bytes* 0)) + (rc (c-PKCS5_PBKDF2_HMAC + pass-bv (bytevector-length pass-bv) + salt (bytevector-length salt) + *pbkdf2-iters* + (c-EVP_sha256) + *key-bytes* + out))) + (unless (= rc 1) + (error 'derive-key "PBKDF2 failed")) + out)) + +;;; ---- AES-256-GCM via direct libcrypto FFI ---- +;;; Ciphertext layout: IV(12) || ct || tag(16). + +(def c-EVP_CIPHER_CTX_new + (foreign-procedure "EVP_CIPHER_CTX_new" () uptr)) +(def c-EVP_CIPHER_CTX_free + (foreign-procedure "EVP_CIPHER_CTX_free" (uptr) void)) +(def c-EVP_aes_256_gcm + (foreign-procedure "EVP_aes_256_gcm" () uptr)) +(def c-EVP_EncryptInit_ex + (foreign-procedure "EVP_EncryptInit_ex" (uptr uptr uptr u8* u8*) int)) +(def c-EVP_EncryptUpdate + (foreign-procedure "EVP_EncryptUpdate" (uptr u8* u8* u8* int) int)) +(def c-EVP_EncryptFinal_ex + (foreign-procedure "EVP_EncryptFinal_ex" (uptr u8* u8*) int)) +(def c-EVP_CIPHER_CTX_ctrl + (foreign-procedure "EVP_CIPHER_CTX_ctrl" (uptr int int u8*) int)) +(def c-EVP_DecryptInit_ex + (foreign-procedure "EVP_DecryptInit_ex" (uptr uptr uptr u8* u8*) int)) +(def c-EVP_DecryptUpdate + (foreign-procedure "EVP_DecryptUpdate" (uptr u8* u8* u8* int) int)) +(def c-EVP_DecryptFinal_ex + (foreign-procedure "EVP_DecryptFinal_ex" (uptr u8* u8*) int)) + +(def EVP_CTRL_GCM_GET_TAG #x10) +(def EVP_CTRL_GCM_SET_TAG #x11) +(def GCM_IV_LEN 12) +(def GCM_TAG_LEN 16) + +(def (encrypt-bytes plain-bv key) + (let* ((pt-len (bytevector-length plain-bv)) + (iv (random-bytes GCM_IV_LEN)) + (ct (make-bytevector pt-len)) + (tag (make-bytevector GCM_TAG_LEN)) + (outlen (make-bytevector 4 0)) + (ctx (c-EVP_CIPHER_CTX_new))) + (when (= ctx 0) (error 'encrypt-bytes "EVP_CIPHER_CTX_new failed")) + (dynamic-wind + (lambda () (void)) + (lambda () + (when (= 0 (c-EVP_EncryptInit_ex ctx (c-EVP_aes_256_gcm) 0 key iv)) + (error 'encrypt-bytes "EVP_EncryptInit_ex failed")) + (when (= 0 (c-EVP_EncryptUpdate ctx ct outlen plain-bv pt-len)) + (error 'encrypt-bytes "EVP_EncryptUpdate failed")) + (when (= 0 (c-EVP_EncryptFinal_ex ctx (make-bytevector 16) outlen)) + (error 'encrypt-bytes "EVP_EncryptFinal_ex failed")) + (when (= 0 (c-EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_GCM_GET_TAG GCM_TAG_LEN tag)) + (error 'encrypt-bytes "get tag failed")) + (let ((result (make-bytevector (+ GCM_IV_LEN pt-len GCM_TAG_LEN)))) + (bytevector-copy! iv 0 result 0 GCM_IV_LEN) + (bytevector-copy! ct 0 result GCM_IV_LEN pt-len) + (bytevector-copy! tag 0 result (+ GCM_IV_LEN pt-len) GCM_TAG_LEN) + result)) + (lambda () (c-EVP_CIPHER_CTX_free ctx))))) + +(def (decrypt-bytes cipher-bv key) + (let* ((total (bytevector-length cipher-bv)) + (ct-len (- total GCM_IV_LEN GCM_TAG_LEN))) + (when (< ct-len 0) + (error 'decrypt-bytes "ciphertext too short")) + (let* ((iv (make-bytevector GCM_IV_LEN)) + (ct (make-bytevector ct-len)) + (tag (make-bytevector GCM_TAG_LEN)) + (pt (make-bytevector ct-len)) + (outlen (make-bytevector 4 0)) + (ctx (c-EVP_CIPHER_CTX_new))) + (bytevector-copy! cipher-bv 0 iv 0 GCM_IV_LEN) + (bytevector-copy! cipher-bv GCM_IV_LEN ct 0 ct-len) + (bytevector-copy! cipher-bv (+ GCM_IV_LEN ct-len) tag 0 GCM_TAG_LEN) + (when (= ctx 0) (error 'decrypt-bytes "EVP_CIPHER_CTX_new failed")) + (dynamic-wind + (lambda () (void)) + (lambda () + (when (= 0 (c-EVP_DecryptInit_ex ctx (c-EVP_aes_256_gcm) 0 key iv)) + (error 'decrypt-bytes "EVP_DecryptInit_ex failed")) + (when (= 0 (c-EVP_DecryptUpdate ctx pt outlen ct ct-len)) + (error 'decrypt-bytes "EVP_DecryptUpdate failed")) + (when (= 0 (c-EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_GCM_SET_TAG GCM_TAG_LEN tag)) + (error 'decrypt-bytes "set tag failed")) + (when (= 0 (c-EVP_DecryptFinal_ex ctx (make-bytevector 16) outlen)) + (error 'decrypt-bytes "authentication failed — wrong key or corrupted store")) + pt) + (lambda () (c-EVP_CIPHER_CTX_free ctx)))))) + +;;; ---- passphrase prompt ---- + +(def (secret-prompt-passphrase prompt) + (let ((env (getenv "JCODE_PASSPHRASE"))) + (cond + ((and env (not (string=? env ""))) env) + (else + (display prompt (current-error-port)) + (flush-output-port (current-error-port)) + (system "stty -echo 2>/dev/null") + (let ((line (guard (e (#t #f)) + (get-line (current-input-port))))) + (system "stty echo 2>/dev/null") + (newline (current-error-port)) + (cond + ((or (not line) (eof-object? line)) + (error 'secret-prompt-passphrase "no passphrase provided")) + (else (string-trim line)))))))) + +;;; ---- on-disk format ---- + +(def (write-store-with-key path key salt secrets) + (let* ((json (json-object->string secrets)) + (cipher (encrypt-bytes (string->utf8 json) key))) + ;; call-with-output-file raises if the path exists; delete first so the + ;; write is idempotent across re-saves. + (when (file-exists? path) (delete-file path)) + (call-with-output-file path + (lambda (p) + (put-string p *file-magic*) (newline p) + (put-string p (bytevector->hex salt)) (newline p) + (put-string p (bytevector->hex cipher)) (newline p)))) + ;; Tighten permissions — umask may have left this 0644. + (system (format "chmod 600 ~a 2>/dev/null" path))) + +(def (read-store-with-passphrase path passphrase) + (call-with-input-file path + (lambda (p) + (let ((magic (get-line p))) + (unless (equal? magic *file-magic*) + (error 'read-store "unknown file format" magic))) + (let* ((salt-hex (get-line p)) + (cipher-hex (get-line p)) + (salt (hex->bytevector salt-hex)) + (cipher (hex->bytevector cipher-hex)) + (key (derive-key passphrase salt)) + (plain (guard (e (#t #f)) + (utf8->string (decrypt-bytes cipher key))))) + (cond + ((not plain) + (error 'read-store "wrong passphrase or corrupt file")) + (else + (values (string->json-object plain) key salt))))))) + +;;; ---- public API ---- + +(def secret-store-unlock! + (case-lambda + (() (secret-store-unlock!/internal #f)) + ((pass) (secret-store-unlock!/internal pass)))) + +(def (secret-store-unlock!/internal opt-pass) + (unless (unbox *secrets-cache*) + (let* ((path (secret-store-path)) + (pass (or opt-pass + (secret-prompt-passphrase "Master passphrase: ")))) + (let-values (((secrets key salt) (read-store-with-passphrase path pass))) + (set-box! *secrets-cache* (list key salt secrets)) + (log-info logger "store-unlocked" + `((path . ,path) + (count . ,(length (hash-keys secrets))))))))) + +(def secret-store-init! + (case-lambda + (() (secret-store-init!/internal #f)) + ((pass) (secret-store-init!/internal pass)))) + +(def (secret-store-init!/internal opt-pass) + (let ((path (secret-store-path))) + (when (file-exists? path) + (error 'secret-store-init! "store already exists" path)) + (let* ((pass1 (or opt-pass + (secret-prompt-passphrase "New master passphrase: "))) + (pass2 (if opt-pass + pass1 + (secret-prompt-passphrase "Confirm passphrase: ")))) + (unless (string=? pass1 pass2) + (error 'secret-store-init! "passphrases do not match")) + (when (< (string-length pass1) 8) + (error 'secret-store-init! "passphrase must be at least 8 chars")) + (let* ((salt (random-bytes *salt-bytes*)) + (key (derive-key pass1 salt)) + (secrets (make-hash-table))) + (write-store-with-key path key salt secrets) + (set-box! *secrets-cache* (list key salt secrets)) + (log-info logger "store-created" `((path . ,path))))))) + +(def (secret-store-get name) + ;; If the store is locked and exists on disk, transparently unlock + ;; (which may prompt). Returns #f if name not present. + (when (and (secret-store-locked?) (secret-store-exists?)) + (secret-store-unlock!)) + (let ((secrets (cached-secrets))) + (and secrets (hash-get secrets name)))) + +(def (secret-store-set! name value) + (when (secret-store-locked?) + (cond + ((secret-store-exists?) (secret-store-unlock!)) + (else (error 'secret-store-set! + "store does not exist; call secret-store-init! first")))) + (let ((secrets (cached-secrets)) + (key (cached-key)) + (salt (cached-salt))) + (hash-put! secrets name value) + (write-store-with-key (secret-store-path) key salt secrets) + (log-info logger "secret-set" `((name . ,name))))) + +(def (secret-store-remove! name) + (when (secret-store-locked?) + (when (secret-store-exists?) (secret-store-unlock!))) + (let ((secrets (cached-secrets)) + (key (cached-key)) + (salt (cached-salt))) + (when secrets + (hash-remove! secrets name) + (write-store-with-key (secret-store-path) key salt secrets) + (log-info logger "secret-removed" `((name . ,name)))))) + +(def (secret-store-list) + ;; Returns a list of provider names whose keys are stored. Never + ;; returns the values. + (when (and (secret-store-locked?) (secret-store-exists?)) + (secret-store-unlock!)) + (let ((secrets (cached-secrets))) + (if secrets (hash-keys secrets) '()))) + +(def (secret-store-change-passphrase! old-pass new-pass) + (let* ((path (secret-store-path)) + (existed? (file-exists? path))) + (unless existed? + (error 'secret-store-change-passphrase! "no store to change")) + (let-values (((secrets _k _s) (read-store-with-passphrase path old-pass))) + (when (< (string-length new-pass) 8) + (error 'secret-store-change-passphrase! + "new passphrase must be at least 8 chars")) + (let* ((salt (random-bytes *salt-bytes*)) + (key (derive-key new-pass salt))) + (write-store-with-key path key salt secrets) + (set-box! *secrets-cache* (list key salt secrets)) + (log-info logger "passphrase-changed" '()))))) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -6,6 +6,8 @@ :std/misc/thread :std/text/json :jcode/core/config + :jcode/core/secrets + :jcode/core/secrets-import :jcode/core/log :jcode/core/session :jcode/core/message @@ -84,6 +86,7 @@ ((null? rest) (interactive-mode opts)) ((equal? (car rest) "session") (session-command (cdr rest))) ((equal? (car rest) "config") (config-command (cdr rest))) + ((equal? (car rest) "keys") (keys-command (cdr rest))) ((equal? (car rest) "serve") (serve-main (cdr rest))) ((equal? (car rest) "relay") (relay-main (cdr rest))) ((equal? (car rest) "connect") (connect-main (cdr rest))) @@ -168,6 +171,9 @@ COMMANDS: session list List all sessions session resume Resume a previous session config Show or edit configuration + keys Manage encrypted API key store + (init | list | add | remove | unlock | + change-passphrase | import) serve Start JSONL server (stdio mode) serve --port N Start TCP server (default bind: 127.0.0.1) serve --port N --bind ADDR @@ -647,3 +653,144 @@ EXAMPLES: (printf "Provider: ~a~n" (config-provider)) (printf "Model: ~a~n" (config-model)) (printf "API Key: ~a~n" (if (config-api-key) "configured" "not set"))) + +;;; ---- keys subcommand ---- +;;; +;;; jcode keys init create a new encrypted store +;;; jcode keys list show provider names with stored keys +;;; jcode keys add <provider> prompt for value, store it +;;; jcode keys remove <provider> delete a stored entry +;;; jcode keys unlock prompt for passphrase + cache it +;;; jcode keys change-passphrase rotate the master passphrase +;;; jcode keys import [source] source = opencode | claude-code | +;;; aider | env | prompt | all + +(def (keys-usage) + (printf "Usage: jcode keys <subcommand>~n") + (printf " init create the encrypted store~n") + (printf " list list provider names with keys~n") + (printf " add <provider> add or update a key~n") + (printf " remove <provider> remove a stored key~n") + (printf " unlock prompt for passphrase~n") + (printf " change-passphrase rotate master passphrase~n") + (printf " import [opencode|claude-code|aider|env|prompt|all]~n") + (printf " bulk-import from other tools~n")) + +(def (read-line/tty prompt) + (display prompt (current-error-port)) + (flush-output-port (current-error-port)) + (let ((line (guard (e (#t #f)) (get-line (current-input-port))))) + (cond + ((or (not line) (eof-object? line)) #f) + (else line)))) + +(def (keys-cmd-init) + (cond + ((secret-store-exists?) + (printf "Store already exists at ~a~n" (secret-store-path)) + (printf "Use 'jcode keys change-passphrase' to rotate, or remove the file first.~n")) + (else + (secret-store-init!) + (printf "Created encrypted store at ~a~n" (secret-store-path))))) + +(def (keys-cmd-list) + (cond + ((not (secret-store-exists?)) + (printf "No encrypted store. Run 'jcode keys init' to create one.~n")) + (else + (let ((names (secret-store-list))) + (cond + ((null? names) (printf "(no keys stored)~n")) + (else + (for-each (lambda (n) (printf " ~a~n" n)) names))))))) + +(def (keys-cmd-add args) + (cond + ((null? args) + (printf "Usage: jcode keys add <provider>~n")) + (else + (let ((provider (car args))) + (unless (secret-store-exists?) (secret-store-init!)) + (let ((val (read-line/tty (format "~a key: " provider)))) + (cond + ((or (not val) (string=? (string-trim val) "")) + (printf "Aborted (empty input).~n")) + (else + (secret-store-set! provider (string-trim val)) + (printf "Stored key for ~a.~n" provider)))))))) + +(def (keys-cmd-remove args) + (cond + ((null? args) + (printf "Usage: jcode keys remove <provider>~n")) + ((not (secret-store-exists?)) + (printf "No encrypted store.~n")) + (else + (let ((provider (car args))) + (secret-store-remove! provider) + (printf "Removed ~a.~n" provider))))) + +(def (keys-cmd-unlock) + (cond + ((not (secret-store-exists?)) + (printf "No encrypted store. Run 'jcode keys init' first.~n")) + (else + (secret-store-unlock!) + (printf "Store unlocked (~a key(s) cached).~n" + (length (secret-store-list)))))) + +(def (keys-cmd-change-passphrase) + (cond + ((not (secret-store-exists?)) + (printf "No encrypted store. Run 'jcode keys init' first.~n")) + (else + (let ((old (secret-prompt-passphrase "Current passphrase: ")) + (new (secret-prompt-passphrase "New passphrase: ")) + (cf (secret-prompt-passphrase "Confirm new passphrase: "))) + (cond + ((not (string=? new cf)) + (printf "Passphrases do not match. Aborted.~n")) + (else + (secret-store-change-passphrase! old new) + (printf "Master passphrase rotated.~n"))))))) + +(def (keys-cmd-import args) + (let ((source (if (null? args) "all" (car args)))) + (unless (secret-store-exists?) (secret-store-init!)) + (cond + ((equal? source "opencode") + (printf "Imported ~a key(s) from opencode.~n" (import-from-opencode!))) + ((equal? source "claude-code") + (printf "Imported ~a key(s) from Claude Code.~n" (import-from-claude-code!))) + ((equal? source "aider") + (printf "Imported ~a key(s) from Aider.~n" (import-from-aider!))) + ((equal? source "env") + (printf "Imported ~a key(s) from environment.~n" (import-from-env!))) + ((equal? source "prompt") + (printf "Imported ~a key(s) from prompts.~n" (import-prompt-missing!))) + ((equal? source "all") + (let* ((n1 (import-from-opencode!)) + (n2 (import-from-claude-code!)) + (n3 (import-from-aider!)) + (n4 (import-from-env!))) + (printf "Imported ~a key(s) total (opencode=~a claude-code=~a aider=~a env=~a)~n" + (+ n1 n2 n3 n4) n1 n2 n3 n4) + (printf "~nProviders still missing a key:~n") + (import-prompt-missing!))) + (else + (printf "Unknown import source: ~a~n" source) + (printf "Valid: opencode | claude-code | aider | env | prompt | all~n"))))) + +(def (keys-command args) + (cond + ((null? args) (keys-usage)) + ((equal? (car args) "init") (keys-cmd-init)) + ((equal? (car args) "list") (keys-cmd-list)) + ((equal? (car args) "add") (keys-cmd-add (cdr args))) + ((equal? (car args) "remove") (keys-cmd-remove (cdr args))) + ((equal? (car args) "unlock") (keys-cmd-unlock)) + ((equal? (car args) "change-passphrase") (keys-cmd-change-passphrase)) + ((equal? (car args) "import") (keys-cmd-import (cdr args))) + (else + (printf "Unknown keys subcommand: ~a~n" (car args)) + (keys-usage))))