Use encrypted jsqlite message logs
ober
4be10b6f95461375c72fae6ab40c35959e4bb124
--- a/.jerbuild +++ b/.jerbuild @@ -2,8 +2,10 @@ ;; ;; jerbuild bundles Chez Scheme + the jerboa stdlib, so NO jerboa source ;; checkout and NO separately-built Chez is required — only a C compiler (cc) -;; for the final link. Pure Jerboa: no jerboa-native-rs and no DuckDB. +;; for the final link. The encrypted jsqlite log backend links the bundled +;; jerboa-native crypto archive. (entry "signal/main.ss") (output "jerboa-signal") -(libdirs ".") +(libdirs "." "../jsqlite/src") +(static-native #t) --- a/Makefile +++ b/Makefile @@ -16,7 +16,10 @@ else \ fi) JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) -LIBDIRS = --libdirs $(CURDIR):$(JH)/lib +JSQLITE_SRC ?= $(CURDIR)/../jsqlite/src +LIBDIRS = --libdirs $(CURDIR):$(JSQLITE_SRC):$(JH)/lib +JERBOA_NATIVE_A ?= $(JH)/jerboa-native-rs/target/release/libjerboa_native.a +export JERBOA_NATIVE_A JEXEC = $(JERBUILD) exec $(LIBDIRS) BIN := jerboa-signal BIN_DIR := $(HOME)/.local/bin @@ -31,7 +34,7 @@ TUI_SHIM := $(TUI_SHIM_DIR)/signal_tui_shim.$(TUI_SHIM_EXT) LOG_SHIM := signal_log_shim.$(TUI_SHIM_EXT) SQLCIPHER_PREFIX := $(shell brew --prefix sqlcipher 2>/dev/null) -.PHONY: all build binary run run-tui test install clean help vendor-deps tui-shim log-shim ensure-jerboa-tools +.PHONY: all build binary run run-tui test install install-log-shim clean help vendor-deps tui-shim log-shim ensure-jerboa-tools .DEFAULT_GOAL := help all: binary @@ -45,7 +48,7 @@ build: binary run: binary ./$(BIN) $(ARGS) -run-tui: binary tui-shim log-shim +run-tui: binary tui-shim ./$(BIN) tui $(ARGS) test: binary @@ -55,9 +58,17 @@ install: binary mkdir -p $(BIN_DIR) install -m 0755 $(BIN) $(BIN_DIR)/$(BIN) test ! -f signal_tui_shim.$(TUI_SHIM_EXT) || install -m 0755 signal_tui_shim.$(TUI_SHIM_EXT) $(BIN_DIR)/signal_tui_shim.$(TUI_SHIM_EXT) - test ! -f $(LOG_SHIM) || install -m 0755 $(LOG_SHIM) $(BIN_DIR)/$(LOG_SHIM) @echo "Installed $(BIN) to $(BIN_DIR)/$(BIN)" +install-log-shim: log-shim + @if [ -f "$(LOG_SHIM)" ]; then \ + mkdir -p $(BIN_DIR); \ + install -m 0755 $(LOG_SHIM) $(BIN_DIR)/$(LOG_SHIM); \ + echo "Installed legacy $(LOG_SHIM) to $(BIN_DIR)/$(LOG_SHIM)"; \ + else \ + echo "No legacy $(LOG_SHIM) built."; \ + fi + clean: rm -f $(BIN) rm -f signal_tui_shim.dylib signal_tui_shim.so @@ -96,12 +107,12 @@ tui-shim: vendor/termbox2 signal/tui/signal_tui_shim.c cp $(TUI_SHIM) signal_tui_shim.$(TUI_SHIM_EXT) -# Encrypted-logging shim (SQLCipher). Skipped with a notice if sqlcipher is -# absent, so building/running still works without message logging. +# Legacy encrypted-logging shim (SQLCipher). New logs use the jsqlite encrypted +# backend; build this only to open pre-jsqlite SQLCipher log files. log-shim: @if [ -z "$(SQLCIPHER_PREFIX)" ]; then \ - echo "log-shim: sqlcipher not found; skipping (encrypted logging disabled)."; \ - echo " enable it with: brew install sqlcipher && make log-shim"; \ + echo "log-shim: sqlcipher not found; skipping legacy SQLCipher support."; \ + echo " enable legacy logs with: brew install sqlcipher && make log-shim"; \ else \ cc -shared -fPIC \ -I$(SQLCIPHER_PREFIX)/include/sqlcipher \ @@ -118,9 +129,10 @@ help: @echo " run-tui Build shim and start the TUI" @echo " test Run tests" @echo " install Install ./jerboa-signal to ~/.local/bin" + @echo " install-log-shim Install optional legacy SQLCipher log shim" @echo " ensure-jerboa-tools Ensure jerboa/jerbuild are available" @echo " tui-shim Build the termbox2 TUI shim" - @echo " log-shim Build the SQLCipher encrypted-logging shim" + @echo " log-shim Build the legacy SQLCipher log shim" @echo " clean Remove build artifacts" @echo "" @echo "Prerequisite: signal-cli must be linked to your Signal account." --- a/README.md +++ b/README.md @@ -99,32 +99,34 @@ too. Use q, Esc, or Ctrl-C to quit. ## Encrypted message log The TUI can log every message to an encrypted SQLite database so you keep a copy -even when the sender later deletes it ("delete for everyone"). It uses -[SQLCipher](https://www.zetetic.net/sqlcipher/) (AES-256) — the whole file, -contents and metadata, is unreadable without your passphrase. +even when the sender later deletes it ("delete for everyone"). New logs use +`jsqlite` for the SQLite engine and a Jerboa-native encrypted container around +the database image; contents and metadata are unreadable without your +passphrase. Enable it: ```sh -brew install sqlcipher -make log-shim # builds signal_log_shim.dylib ./jerboa-signal tui # prompts: passphrase for encrypted message log ``` +Existing SQLCipher log files are still supported as a legacy fallback. To open +those old files, install SQLCipher and build the optional shim: + +```sh +brew install sqlcipher +make log-shim +``` + At startup the TUI asks for a passphrase (echo off). Enter one to log; leave it blank to skip logging for that session. To run unattended, set `JERBOA_SIGNAL_DB_KEY` instead and the prompt is skipped. -The database lives at `~/.local/share/jerboa-signal/messages-<account>.db`. Each +The log lives at `~/.local/share/jerboa-signal/messages-<account>.db`. Each inbound notification and outbound send is one append-only row (with the full raw JSON); remote-deletes, edits, reactions, calls, attachments, and other displayable events are logged as new rows and never overwrite the -original. Read it back with the matching key: - -```sh -sqlcipher ~/.local/share/jerboa-signal/messages-+15551234567.db \ - "PRAGMA key='your passphrase'; SELECT timestamp,direction,sender,kind,body FROM messages;" -``` +original. Logging happens only while the TUI is open — messages that arrive while it is closed are not captured. @@ -150,7 +152,8 @@ Modules: - `signal/cmd-tui.ss` — TUI command entry point; see `docs/TUI_PLAN.md` - `signal/store.ss` — persistent local state (deleted-conversation list) - `signal/capture.ss` — normalizes a notification into an encrypted log row -- `signal/logdb.ss` + `signal/log_shim.c` — FFI to the SQLCipher encrypted log +- `signal/logdb.ss` + `signal/log_crypto.ss` — encrypted jsqlite log backend +- `signal/log_shim.c` — optional legacy SQLCipher log reader - `signal/tui/` — termbox2 FFI and the first terminal shell ## License new file mode 100644 --- /dev/null +++ b/signal/log_crypto.ss @@ -0,0 +1,180 @@ +#!chezscheme +;;; signal/log_crypto -- Rust-backed crypto used by the jsqlite log container. + +(library (signal log_crypto) + (export log-crypto-available? + log-random-bytes + log-scrypt-key + log-aead-seal + log-aead-open) + + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (only (jerboa core) random-bytes)) + + (def *native-load-state* (box 'untried)) + + (def (try-load path) + (and path + (not (string=? path "")) + (file-exists? path) + (load-shared-object path))) + + (def (native-candidates) + (let* ([argv0 (car (command-line))] + [slash (let loop ([i (- (string-length argv0) 1)]) + (cond [(< i 0) #f] + [(char=? (string-ref argv0 i) #\/) i] + [else (loop (- i 1))]))] + [bin-dir (and slash (substring argv0 0 slash))] + [home (or (getenv "HOME") ".")] + [env (getenv "JERBOA_NATIVE_LIB")]) + (append + (if env (list env) '()) + (list "libjerboa_native.dylib" + "libjerboa_native.so" + "lib/libjerboa_native.dylib" + "lib/libjerboa_native.so") + (if bin-dir + (list (string-append bin-dir "/libjerboa_native.dylib") + (string-append bin-dir "/libjerboa_native.so") + (string-append bin-dir "/lib/libjerboa_native.dylib") + (string-append bin-dir "/lib/libjerboa_native.so")) + '()) + (list (string-append home "/.local/bin/libjerboa_native.dylib") + (string-append home "/.local/bin/libjerboa_native.so"))))) + + (def (ensure-native-loaded!) + (cond + [(eq? (unbox *native-load-state*) 'loaded) #t] + [(eq? (unbox *native-load-state*) 'missing) #f] + [else + (let ([loaded? + (or (foreign-entry? "jerboa_aead_seal") + (guard (e [#t #f]) + (let loop ([paths (native-candidates)]) + (cond + [(null? paths) #f] + [(guard (e [#t #f]) (try-load (car paths))) + #t] + [else (loop (cdr paths))]))))]) + (set-box! *native-load-state* (if loaded? 'loaded 'missing)) + loaded?)])) + + (def (entry? name) + (or (foreign-entry? name) + (and (ensure-native-loaded!) (foreign-entry? name)))) + + (def (log-crypto-available?) + (and (entry? "jerboa_scrypt") + (entry? "jerboa_aead_seal") + (entry? "jerboa_aead_open"))) + + (def (last-error) + (if (entry? "jerboa_last_error") + (let* ([buf (make-bytevector 1024 0)] + [proc (foreign-procedure "jerboa_last_error" (u8* size_t) size_t)] + [n (proc buf 1024)] + [len (min n 1023)] + [out (make-bytevector len 0)]) + (bytevector-copy! buf 0 out 0 len) + (utf8->string out)) + "native crypto error")) + + (def (as-bytes v) + (cond [(bytevector? v) v] + [(string? v) (string->utf8 v)] + [else (error 'as-bytes "expected bytevector or string")])) + + (def (log-random-bytes n) + (random-bytes n)) + + (def (log2-power-of-two n) + (unless (and (integer? n) (> n 1) (= 0 (logand n (- n 1)))) + (error 'log-scrypt-key "N must be a power of two")) + (bitwise-length (- n 1))) + + (def (log-scrypt-key password salt out-len n r p) + (unless (entry? "jerboa_scrypt") + (error 'log-scrypt-key "native scrypt is not available")) + (let* ([pw (as-bytes password)] + [s (as-bytes salt)] + [out (make-bytevector out-len 0)] + [proc (foreign-procedure "jerboa_scrypt" + (u8* size_t u8* size_t unsigned-8 unsigned-32 unsigned-32 + u8* size_t) + int)] + [rc (proc pw (bytevector-length pw) + s (bytevector-length s) + (log2-power-of-two n) r p + out out-len)]) + (when (< rc 0) + (error 'log-scrypt-key "scrypt failed" (last-error))) + out)) + + (def (bv-sub bv start len) + (let ([out (make-bytevector len 0)]) + (bytevector-copy! bv start out 0 len) + out)) + + (def (result-length len-buf) + (bytevector-u64-native-ref len-buf 0)) + + (def (log-aead-seal key nonce plaintext aad) + (unless (entry? "jerboa_aead_seal") + (error 'log-aead-seal "native AEAD seal is not available")) + (let* ([k (as-bytes key)] + [n (as-bytes nonce)] + [pt (as-bytes plaintext)] + [ad (as-bytes aad)] + [out-max (+ (bytevector-length pt) 16)] + [out (make-bytevector out-max 0)] + [len-buf (make-bytevector 8 0)] + [proc (foreign-procedure "jerboa_aead_seal" + (u8* size_t u8* size_t u8* size_t u8* size_t + u8* size_t u8*) + int)] + [rc (proc k (bytevector-length k) + n (bytevector-length n) + pt (bytevector-length pt) + ad (bytevector-length ad) + out out-max + len-buf)]) + (when (< rc 0) + (error 'log-aead-seal "AEAD seal failed" (last-error))) + (let ([actual (result-length len-buf)]) + (if (= actual out-max) out (bv-sub out 0 actual))))) + + (def (log-aead-open key nonce ciphertext aad) + (unless (entry? "jerboa_aead_open") + (error 'log-aead-open "native AEAD open is not available")) + (let* ([k (as-bytes key)] + [n (as-bytes nonce)] + [ct (as-bytes ciphertext)] + [ad (as-bytes aad)] + [out-max (bytevector-length ct)] + [out (make-bytevector out-max 0)] + [len-buf (make-bytevector 8 0)] + [proc (foreign-procedure "jerboa_aead_open" + (u8* size_t u8* size_t u8* size_t u8* size_t + u8* size_t u8*) + int)] + [rc (proc k (bytevector-length k) + n (bytevector-length n) + ct (bytevector-length ct) + ad (bytevector-length ad) + out out-max + len-buf)]) + (when (< rc 0) + (error 'log-aead-open "AEAD open failed" (last-error))) + (bv-sub out 0 (result-length len-buf)))) + + ) ;; end library --- a/signal/logdb.ss +++ b/signal/logdb.ss @@ -1,9 +1,9 @@ #!chezscheme -;;; signal/logdb -- FFI to the SQLCipher encrypted message-log shim. +;;; signal/logdb -- encrypted message log. ;;; -;;; Loads signal_log_shim.<dylib|so> (built by `make log-shim`) which links -;;; libsqlcipher. If the shim or sqlcipher is missing, logdb-available? is #f -;;; and every operation is a no-op, so the TUI runs fine without logging. +;;; New logs use a Jerboa-native jsqlite database image stored inside an +;;; authenticated encrypted container. Existing SQLCipher databases are still +;;; opened through the legacy shim so old logs do not disappear. (library (signal logdb) (export logdb-available? @@ -19,8 +19,20 @@ iota 1+ 1- partition make-date make-time) - (except (jerboa prelude) meta atom?) - (std os path)) + (except (jerboa prelude) meta atom? + sqlite-open sqlite-close sqlite-exec sqlite-execute sqlite-query + sqlite-prepare sqlite-finalize sqlite-step sqlite-bind) + (std os path) + (jsqlite api) + (jsqlite value) + (signal log_crypto)) + + (defstruct logdb-handle (backend inner)) + (defstruct jlog (path key salt db)) + + ;; -------------------------------------------------------------------------- + ;; Legacy SQLCipher shim. This stays only for old messages-*.db files that + ;; were created by the previous backend. (def *shim-load-state* (box 'untried)) @@ -35,67 +47,59 @@ (let* ([bin-dir (path-directory (car (command-line)))] [home (or (getenv "HOME") ".")] [loaded? - (guard (e [#t #f]) - (or (try-load-shim "signal_log_shim.dylib") - (try-load-shim "signal_log_shim.so") - (try-load-shim (path-join bin-dir "signal_log_shim.dylib")) - (try-load-shim (path-join bin-dir "signal_log_shim.so")) - (try-load-shim (path-join home ".local" "bin" - "signal_log_shim.dylib")) - (try-load-shim (path-join home ".local" "bin" - "signal_log_shim.so"))))]) + (or (foreign-entry? "signal_log_open") + (guard (e [#t #f]) + (or (try-load-shim "signal_log_shim.dylib") + (try-load-shim "signal_log_shim.so") + (try-load-shim (path-join bin-dir "signal_log_shim.dylib")) + (try-load-shim (path-join bin-dir "signal_log_shim.so")) + (try-load-shim (path-join home ".local" "bin" + "signal_log_shim.dylib")) + (try-load-shim (path-join home ".local" "bin" + "signal_log_shim.so")))))]) (set-box! *shim-load-state* (if loaded? 'loaded 'missing)) loaded?)])) - (def (entry? name) - (and (ensure-shim-loaded!) (foreign-entry? name))) + (def (legacy-entry? name) + (or (foreign-entry? name) + (and (ensure-shim-loaded!) (foreign-entry? name)))) - (def (logdb-available?) - (entry? "signal_log_open")) + (def (legacy-available?) + (legacy-entry? "signal_log_open")) - ;; Open (creating if needed) the encrypted DB at `path` with passphrase `key`. - ;; Returns an opaque handle (nonzero integer) or #f on failure / wrong key. - (def (logdb-open path key) - (and (entry? "signal_log_open") + (def (legacy-open path key) + (and (legacy-entry? "signal_log_open") (let ([h ((foreign-procedure "signal_log_open" (string string) uptr) path key)]) (and (not (= h 0)) h)))) - (def (logdb-close handle) - (when (and handle (entry? "signal_log_close")) + (def (legacy-close handle) + (when (and handle (legacy-entry? "signal_log_close")) ((foreign-procedure "signal_log_close" (uptr) int) handle) (void))) - ;; Append one event. Strings should be non-#f (use "" for absent). Returns #t - ;; on success. Best-effort: callers should still guard, but this never raises - ;; for a #f handle. - (def (logdb-put handle account direction conversation sender - timestamp kind body raw) + (def (legacy-put handle account direction conversation sender + timestamp kind body raw) (and handle - (entry? "signal_log_put") + (legacy-entry? "signal_log_put") (= 0 ((foreign-procedure "signal_log_put" (uptr string string string string integer-64 string string string) int) handle account direction conversation sender timestamp kind body raw)))) - (def (logdb-count handle) - (if (and handle (entry? "signal_log_count")) + (def (legacy-count handle) + (if (and handle (legacy-entry? "signal_log_count")) ((foreign-procedure "signal_log_count" (uptr) integer-64) handle) -1)) - ;; The most recent displayable rows (data/edit with a body), oldest first. - ;; Each row is (direction conversation sender timestamp kind body) -- all - ;; strings except timestamp (integer ms, 0 when unknown). '() when the shim - ;; is missing, the handle is #f, or anything goes wrong: history is - ;; best-effort and must never block the TUI from starting. - (def (logdb-recent handle limit) + (def (legacy-recent handle limit) (if (and handle - (entry? "signal_log_recent") - (entry? "signal_log_row_step") - (entry? "signal_log_row_text") - (entry? "signal_log_row_int") - (entry? "signal_log_row_close")) + (legacy-entry? "signal_log_recent") + (legacy-entry? "signal_log_row_step") + (legacy-entry? "signal_log_row_text") + (legacy-entry? "signal_log_row_int") + (legacy-entry? "signal_log_row_close")) (guard (e [#t '()]) (let ([open (foreign-procedure "signal_log_recent" (uptr integer-64) uptr)] [step (foreign-procedure "signal_log_row_step" (uptr) int)] @@ -108,7 +112,6 @@ (dynamic-wind (lambda () (void)) (lambda () - ;; Rows arrive newest-first; consing reverses to oldest-first. (let loop ([acc '()]) (if (= (step st) 1) (loop (cons (list (text st 0) (text st 1) (text st 2) @@ -118,10 +121,271 @@ (lambda () (close st))))))) '())) - ;; Read a passphrase from the controlling terminal with echo off. + ;; -------------------------------------------------------------------------- + ;; jsqlite encrypted container. + + (def *jlog-magic* (string->utf8 "JSQLITELOGv1\n")) + (def *jlog-salt-len* 16) + (def *jlog-nonce-len* 12) + (def *jlog-key-len* 32) + (def *jlog-scrypt-n* 16384) + (def *jlog-scrypt-r* 8) + (def *jlog-scrypt-p* 1) + + (def *schema-sql* + (list + "CREATE TABLE IF NOT EXISTS messages (id INTEGER PRIMARY KEY AUTOINCREMENT, logged_at INTEGER, account TEXT, direction TEXT, conversation TEXT, sender TEXT, timestamp INTEGER, kind TEXT, body TEXT, raw TEXT NOT NULL)" + "CREATE INDEX IF NOT EXISTS idx_messages_conv ON messages(conversation)" + "CREATE INDEX IF NOT EXISTS idx_messages_ts ON messages(timestamp)")) + + (def *insert-sql* + "INSERT INTO messages (logged_at,account,direction,conversation,sender,timestamp,kind,body,raw) VALUES (?,?,?,?,?,?,?,?,?)") + + (def *recent-sql* + "SELECT direction, conversation, sender, timestamp, kind, body FROM messages WHERE kind IN ('data','edit','reaction','remote-delete','sticker','contact','preview','attachment','call') AND direction IN ('in','out') AND conversation IS NOT NULL AND conversation <> '' AND body IS NOT NULL AND body <> '' ORDER BY id DESC LIMIT ?") + + (def (now-seconds) + (time-second (current-time))) + + (def (read-file-bytevector* path) + (let ([p (open-file-input-port path)]) + (let ([bv (get-bytevector-all p)]) + (close-port p) + (if (eof-object? bv) (make-bytevector 0 0) bv)))) + + (def (write-file-bytevector! path bv) + (let ([p (open-file-output-port path (file-options no-fail))]) + (put-bytevector p bv) + (close-port p))) + + (def (delete-if-exists! path) + (when (file-exists? path) (delete-file path))) + + (def (write-file-atomic! path bv) + (let ([tmp (string-append path ".tmp")]) + (delete-if-exists! tmp) + (write-file-bytevector! tmp bv) + (rename-file tmp path))) + + (def (bv-sub bv start len) + (let ([out (make-bytevector len 0)]) + (bytevector-copy! bv start out 0 len) + out)) + + (def (bv-append . bvs) + (let* ([n (let loop ([xs bvs] [acc 0]) + (if (null? xs) acc + (loop (cdr xs) (+ acc (bytevector-length (car xs))))))] + [out (make-bytevector n 0)]) + (let loop ([xs bvs] [off 0]) + (unless (null? xs) + (let ([bv (car xs)]) + (bytevector-copy! bv 0 out off (bytevector-length bv)) + (loop (cdr xs) (+ off (bytevector-length bv)))))) + out)) + + (def (bv-prefix? prefix bv) + (let ([np (bytevector-length prefix)] + [nb (bytevector-length bv)]) + (and (<= np nb) + (let loop ([i 0]) + (cond [(= i np) #t] + [(= (bytevector-u8-ref prefix i) (bytevector-u8-ref bv i)) + (loop (+ i 1))] + [else #f]))))) + + (def (jlog-container-bytes? bv) + (bv-prefix? *jlog-magic* bv)) + + (def (derive-key passphrase salt) + (log-scrypt-key passphrase salt *jlog-key-len* + *jlog-scrypt-n* *jlog-scrypt-r* *jlog-scrypt-p*)) + + (def (encrypt-container key salt plain) + (let* ([nonce (log-random-bytes *jlog-nonce-len*)] + [sealed (log-aead-seal key nonce plain *jlog-magic*)]) + (bv-append *jlog-magic* salt nonce sealed))) + + (def (decrypt-container bytes passphrase) + (let* ([magic-len (bytevector-length *jlog-magic*)] + [need (+ magic-len *jlog-salt-len* *jlog-nonce-len*)]) + (when (< (bytevector-length bytes) need) + (error 'logdb-open "encrypted jsqlite log is too short")) + (let* ([salt (bv-sub bytes magic-len *jlog-salt-len*)] + [nonce (bv-sub bytes (+ magic-len *jlog-salt-len*) *jlog-nonce-len*)] + [sealed-start (+ magic-len *jlog-salt-len* *jlog-nonce-len*)] + [sealed (bv-sub bytes sealed-start + (- (bytevector-length bytes) sealed-start))] + [key (derive-key passphrase salt)] + [plain (log-aead-open key nonce sealed *jlog-magic*)]) + (values key salt plain)))) + + (def (ensure-schema! db) + (for-each (lambda (sql) (sqlite-exec db sql)) *schema-sql*)) + + (def (new-jlog path passphrase) + (let* ([salt (log-random-bytes *jlog-salt-len*)] + [key (derive-key passphrase salt)] + [db (sqlite-open-bytevector (make-bytevector 0 0))] + [log (make-jlog path key salt db)]) + (ensure-schema! db) + (persist-jlog! log) + (make-logdb-handle 'jsqlite log))) + + (def (open-jlog-container path passphrase bytes) + (let-values ([(key salt plain) (decrypt-container bytes passphrase)]) + (let ([db (sqlite-open-bytevector plain)]) + (ensure-schema! db) + (make-logdb-handle 'jsqlite (make-jlog path key salt db))))) + + (def (open-jlog path passphrase) + (and (log-crypto-available?) + (guard (e [#t #f]) + (if (file-exists? path) + (let ([bytes (read-file-bytevector* path)]) + (cond + [(= (bytevector-length bytes) 0) + (new-jlog path passphrase)] + [(jlog-container-bytes? bytes) + (open-jlog-container path passphrase bytes)] + [else #f])) + (new-jlog path passphrase))))) + + (def (persist-jlog! log) + (let* ([plain (sqlite-db->bytevector (jlog-db log))] + [container (encrypt-container (jlog-key log) (jlog-salt log) plain)]) + (write-file-atomic! (jlog-path log) container))) + + (def (empty->null s) + (if (and (string? s) (string=? s "")) sql-null s)) + + (def (jlog-put log account direction conversation sender + timestamp kind body raw) + (let ([db (jlog-db log)]) + (sqlite-exec db *insert-sql* + (now-seconds) + (empty->null account) + (empty->null direction) + (empty->null conversation) + (empty->null sender) + timestamp + (empty->null kind) + (empty->null body) + (or raw "")) + (persist-jlog! log) + #t)) + + (def (jlog-count log) + (let ([rows (sqlite-query (jlog-db log) "SELECT count(*) FROM messages")]) + (if (and (pair? rows) (pair? (car rows))) (car (car rows)) -1))) + + (def (cell-text v) + (cond [(sql-null? v) ""] + [(string? v) v] + [(number? v) (number->string v)] + [else ""])) + + (def (cell-int v) + (cond [(and (integer? v) (exact? v)) v] + [(number? v) (inexact->exact (truncate v))] + [(string? v) (or (string->number v) 0)] + [else 0])) + + (def (normalize-recent-row row) + (list (cell-text (list-ref row 0)) + (cell-text (list-ref row 1)) + (cell-text (list-ref row 2)) + (cell-int (list-ref row 3)) + (cell-text (list-ref row 4)) + (cell-text (list-ref row 5)))) + + (def (jlog-recent log limit) + (map normalize-recent-row + (reverse + (sqlite-query (jlog-db log) *recent-sql* + (if (and (integer? limit) (> limit 0)) limit 0))))) + + ;; -------------------------------------------------------------------------- + ;; Public API. + + (def (logdb-available?) + (or (log-crypto-available?) (legacy-available?))) + + (def (backend-env-is? name) + (let ([v (getenv "JERBOA_SIGNAL_LOG_BACKEND")]) + (and v (string-ci=? v name)))) + + (def (wrap-legacy h) + (and h (make-logdb-handle 'legacy h))) + + (def (logdb-open path key) + (cond + [(or (backend-env-is? "sqlcipher") (backend-env-is? "legacy")) + (wrap-legacy (legacy-open path key))] + [(backend-env-is? "jsqlite") + (open-jlog path key)] + [else + (or (open-jlog path key) + (wrap-legacy (legacy-open path key)))])) + + (def (logdb-close handle) + (when (logdb-handle? handle) + (case (logdb-handle-backend handle) + [(jsqlite) + (guard (e [#t (void)]) + (let ([log (logdb-handle-inner handle)]) + (persist-jlog! log) + (sqlite-close (jlog-db log))))] + [(legacy) + (legacy-close (logdb-handle-inner handle))] + [else (void)]))) + + (def (logdb-put handle account direction conversation sender + timestamp kind body raw) + (and (logdb-handle? handle) + (guard (e [#t #f]) + (case (logdb-handle-backend handle) + [(jsqlite) + (jlog-put (logdb-handle-inner handle) + account direction conversation sender + timestamp kind body raw)] + [(legacy) + (legacy-put (logdb-handle-inner handle) + account direction conversation sender + timestamp kind body raw)] + [else #f])))) + + (def (logdb-count handle) + (if (logdb-handle? handle) + (guard (e [#t -1]) + (case (logdb-handle-backend handle) + [(jsqlite) (jlog-count (logdb-handle-inner handle))] + [(legacy) (legacy-count (logdb-handle-inner handle))] + [else -1])) + -1)) + + (def (logdb-recent handle limit) + (if (logdb-handle? handle) + (guard (e [#t '()]) + (case (logdb-handle-backend handle) + [(jsqlite) (jlog-recent (logdb-handle-inner handle) limit)] + [(legacy) (legacy-recent (logdb-handle-inner handle) limit)] + [else '()])) + '())) + + ;; Read a passphrase before termbox takes over the terminal. This avoids + ;; depending on the old SQLCipher C shim just to get getpass(3). (def (logdb-prompt-passphrase prompt) - (if (entry? "signal_log_getpass") - ((foreign-procedure "signal_log_getpass" (string) string) prompt) - "")) + (display prompt) + (flush-output-port (current-output-port)) + (dynamic-wind + (lambda () + (guard (e [#t (void)]) (system "stty -echo 2>/dev/null"))) + (lambda () + (let ([line (get-line (current-input-port))]) + (newline) + (if (eof-object? line) "" line))) + (lambda () + (guard (e [#t (void)]) (system "stty echo 2>/dev/null"))))) ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-logdb-jsqlite.ss @@ -0,0 +1,76 @@ +#!chezscheme +;;; Focused test for the encrypted jsqlite log backend. + +(import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (signal logdb)) + +(def path "/tmp/jerboa-signal-logdb-jsqlite-test.db") + +(def (delete-if-exists! p) + (when (file-exists? p) (delete-file p))) + +(def (read-file-bytevector p) + (let ([in (open-file-input-port p)]) + (let ([bv (get-bytevector-all in)]) + (close-port in) + (if (eof-object? bv) (make-bytevector 0 0) bv)))) + +(def (check label pred) + (unless pred + (error 'test-logdb-jsqlite label))) + +(delete-if-exists! path) +(delete-if-exists! (string-append path ".tmp")) + +(check "logdb backend available" (logdb-available?)) + +(let ([h (logdb-open path "correct horse")]) + (check "open new encrypted jsqlite log" h) + (check "put displayable row" + (logdb-put h "acct" "in" "direct:+15550001" "Alice" + 1000 "data" "hello" "{\"ok\":true}")) + (check "put event row" + (logdb-put h "acct" "event" "" "" + 1001 "typing" "" "{\"typing\":true}")) + (check "count after puts" (= (logdb-count h) 2)) + (check "recent filters event rows" + (equal? (logdb-recent h 10) + (list (list "in" "direct:+15550001" "Alice" + 1000 "data" "hello")))) + (logdb-close h)) + +(let ([bytes (read-file-bytevector path)]) + (check "container is not a plain sqlite file" + (or (< (bytevector-length bytes) 6) + (not (and (= (bytevector-u8-ref bytes 0) (char->integer #\S)) + (= (bytevector-u8-ref bytes 1) (char->integer #\Q)) + (= (bytevector-u8-ref bytes 2) (char->integer #\L)) + (= (bytevector-u8-ref bytes 3) (char->integer #\i)) + (= (bytevector-u8-ref bytes 4) (char->integer #\t)) + (= (bytevector-u8-ref bytes 5) (char->integer #\e))))))) + +(let ([h (logdb-open path "correct horse")]) + (check "reopen with correct key" h) + (check "count after reopen" (= (logdb-count h) 2)) + (check "recent after reopen" + (equal? (logdb-recent h 10) + (list (list "in" "direct:+15550001" "Alice" + 1000 "data" "hello")))) + (logdb-close h)) + +(check "wrong key rejected" (not (logdb-open path "wrong horse"))) + +(delete-if-exists! path) +(delete-if-exists! (string-append path ".tmp")) + +(display "logdb jsqlite smoke ok") +(newline)