jsecmon: PSK transport encrypt/decrypt runnable end-to-end

ober

39ac7b6e965f229569dda3600f3f9a04a897aa1a

diff --git a/Makefile b/Makefile
index 790184e..5cb0aa9 100644
--- a/Makefile
+++ b/Makefile
@@ -329,6 +329,14 @@ auth-check:
 calendar-check:
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/calendar_check.ss
 
+# PSK transport encryption end-to-end (secmon psk.rs encrypt/decrypt_transport):
+# the deterministic AEAD core is the typed kernel (verified by `make test`); this
+# drives it through the FFI bridge + the random-nonce orchestration. Needs the
+# dylib (like lolbin/dga) and the OS CSPRNG via (std crypto random).
+crypto-psk-check: rust
+	cd $(BUILD) && cargo build --release
+	$(SCHEME) --libdirs $(LIBDIRS) --script examples/crypto_psk_check.ss
+
 # Everything that runs through the Jerboa side of the bridge, one shot.
 checks: kernels-check
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/triage_check.ss
@@ -375,6 +383,7 @@ checks: kernels-check
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/lolbin_check.ss
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/dga_check.ss
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/calendar_check.ss
+	$(SCHEME) --libdirs $(LIBDIRS) --script examples/crypto_psk_check.ss
 
 clean:
 	rm -rf $(BUILD)
diff --git a/examples/crypto_psk_check.ss b/examples/crypto_psk_check.ss
new file mode 100644
index 0000000..ea34005
--- /dev/null
+++ b/examples/crypto_psk_check.ss
@@ -0,0 +1,65 @@
+;;; Parity + behaviour check for PSK transport encryption end-to-end.
+;;;
+;;; The deterministic AEAD core is the verified Typed-Jerboa kernel
+;;; `psk-transport-seal`/`-open` (tests/psk_vectors.rs pins it against an
+;;; independent Python AESGCM reference). Here we drive it through the FFI
+;;; bridge `(jsecmon kernels)` and the randomness-bearing orchestration
+;;; `(jsecmon crypto-psk)` — proving the wrappers marshal correctly and that
+;;; `transport-encrypt`/`-decrypt` behave like secmon's encrypt/decrypt_transport.
+;;;
+;;; Run from the repo root with the dylib built and the repo on the libdir path:
+;;;   (cd build/rust && cargo build --release)
+;;;   scheme --libdirs $JERBOA/lib --libdirs . --script examples/crypto_psk_check.ss
+
+(import (jerboa prelude)
+        (jsecmon kernels)
+        (jsecmon crypto-psk))
+
+(def fails 0)
+(def (check label got want)
+  (let ((ok (equal? got want)))
+    (unless ok (set! fails (+ fails 1)))
+    (displayln (if ok "  ok   " "  FAIL ") label " => " got
+               (if ok "" (str "  (want " want ")")))))
+
+(def psk (make-bytevector 32 66))               ;; the psk.rs test PSK, 0x42 * 32
+(def tk  (derive-transport-key psk))
+
+(displayln "psk transport (deterministic kernel, fixed nonce):")
+;; Cross-check FFI marshalling against the very vector tests/psk_vectors.rs pins,
+;; so a marshalling bug here would diverge from the Rust-verified kernel.
+(check "transport-key from psk"
+       (hex-encode tk)
+       "ba1cc1ebdc48f9f07fa555807dae410a13093ed5d6375919ae3766cf7d748091")
+(check "seal fixed-nonce vector"
+       (hex-encode (psk-transport-seal tk (hex-decode "000102030405060708090a0b")
+                                       (string->utf8 "transport probe")))
+       "000102030405060708090a0b0b33004bb4619b21e2af73b189248ac3425e264c42b841f1f2f99f574647da")
+
+(displayln "psk transport (orchestration, random nonce):")
+(def msg     (string->utf8 "the quick brown fox"))
+(def sealed1 (transport-encrypt tk msg))
+(def sealed2 (transport-encrypt tk msg))
+;; decrypt(encrypt(k, m)) == m
+(check "round-trip"     (transport-decrypt tk sealed1) msg)
+;; a fresh random nonce per call -> two seals of the same plaintext differ,
+(check "nonce randomized" (equal? sealed1 sealed2) #f)
+;; ...yet both still open to the same plaintext.
+(check "both decrypt"   (transport-decrypt tk sealed2) msg)
+;; the 12-byte nonce + 16-byte GCM tag are both present in the frame.
+(check "frame >= nonce+tag" (>= (bytevector-length sealed1) (+ 12 16)) #t)
+
+(displayln "psk transport (rejection):")
+;; a flipped byte anywhere fails the GCM tag -> #f
+(def tampered (bytevector-copy sealed1))
+(def end (- (bytevector-length tampered) 1))
+(bytevector-u8-set! tampered end (bitwise-xor (bytevector-u8-ref tampered end) 1))
+(check "tamper -> #f"    (transport-decrypt tk tampered) #f)
+;; the wrong transport key (different PSK) cannot open it
+(def wrong-tk (derive-transport-key (make-bytevector 32 67)))   ;; 0x43 * 32
+(check "wrong key -> #f" (transport-decrypt wrong-tk sealed1) #f)
+
+(newline)
+(if (= fails 0)
+    (displayln "OK: psk transport round-trips, randomizes, and rejects tampering.")
+    (begin (displayln fails " FAILURES") (exit 1)))
diff --git a/jsecmon/crypto-psk.ss b/jsecmon/crypto-psk.ss
new file mode 100644
index 0000000..155c7d2
--- /dev/null
+++ b/jsecmon/crypto-psk.ss
@@ -0,0 +1,39 @@
+#!chezscheme
+;;; jsecmon — PSK transport encryption orchestration.
+;;;
+;;; secmon's psk.rs encrypt_transport/decrypt_transport: the deterministic AEAD
+;;; core (AES-256-GCM under the transport key, with the 12-byte nonce prepended)
+;;; is the verified Typed-Jerboa kernel `psk-transport-seal`/`-open`. The only
+;;; thing that lives here is the *effect* the kernel deliberately leaves out:
+;;; drawing a fresh random nonce per message. That is the untyped-layer half of
+;;; the typed/untyped split — randomness is I/O, not pure compute.
+;;;
+;;; `(random-bytes 12)` reads the OS CSPRNG (/dev/urandom), which is the
+;;; correct nonce source: GCM needs the (key, nonce) pair never to repeat, and
+;;; a 96-bit random nonce per message satisfies that with overwhelming margin.
+
+(library (jsecmon crypto-psk)
+  (export transport-encrypt transport-decrypt)
+  (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?)
+          (jsecmon kernels)
+          (std crypto random))
+
+  ;; encrypt_transport: seal the plaintext under the transport key with a fresh
+  ;; random 12-byte GCM nonce. The returned frame is nonce ‖ ciphertext‖tag, so
+  ;; the receiver needs only the transport key to open it.
+  (define (transport-encrypt transport-key plaintext)
+    (psk-transport-seal transport-key (random-bytes 12) plaintext))
+
+  ;; decrypt_transport: recover the plaintext from a sealed frame, or #f if the
+  ;; tag fails to authenticate (tampering, or the wrong transport key).
+  (define (transport-decrypt transport-key sealed)
+    (psk-transport-open transport-key sealed)))
diff --git a/jsecmon/kernels.ss b/jsecmon/kernels.ss
index 3db17e4..d2880c2 100644
--- a/jsecmon/kernels.ss
+++ b/jsecmon/kernels.ss
@@ -17,6 +17,8 @@
           lolbin-score-cmdline lolbin-match-bits lolbin-severity
           ;; psk crypto primitives
           constant-time-eq? hex-encode hex-decode hex-string? psk-hex-32?
+          derive-auth-key derive-transport-key
+          psk-transport-seal psk-transport-open
           ;; analytics
           host-risk-score
           ;; dga
@@ -81,6 +83,29 @@
             bv))
         (lambda () (foreign-free pp) (foreign-free pl)))))
 
+  ;; Like call->bytes, but for a kernel returning (Option Bytes): the bool flag
+  ;; is #f for None (e.g. AES-GCM authentication failure) — and also for a
+  ;; caught panic from a misuse such as a wrong-length key/nonce, which our
+  ;; callers avoid — so we return #f rather than erroring, and only read the
+  ;; out-params when the flag is true.
+  (define (call->maybe-bytes fill)
+    (let ((pp (foreign-alloc (foreign-sizeof 'void*)))
+          (pl (foreign-alloc (foreign-sizeof 'size_t))))
+      (dynamic-wind
+        (lambda () #t)
+        (lambda ()
+          (and (truthy (fill pp pl))
+               (let* ((data (foreign-ref 'void* pp 0))
+                      (len  (foreign-ref 'size_t pl 0))
+                      (bv   (make-bytevector len)))
+                 (let loop ((i 0))
+                   (when (< i len)
+                     (bytevector-u8-set! bv i (foreign-ref 'unsigned-8 data i))
+                     (loop (+ i 1))))
+                 (free-buffer data len)
+                 bv)))
+        (lambda () (foreign-free pp) (foreign-free pl)))))
+
   ;; Bind a foreign procedure once.
   (define-syntax fp
     (syntax-rules ()
@@ -126,6 +151,39 @@
   (define %psk-hex-32? (fp "jt_jsecmon_typed_psk_psk_hex_32_p" (u8* size_t) unsigned-8))
   (define (psk-hex-32? s) (let ((b (u8->bytes s))) (truthy (%psk-hex-32? b (bytevector-length b)))))
 
+  ;; from_bytes: HKDF-SHA256(no salt) expands a PSK under a per-purpose info tag
+  ;; into a 32-byte auth/transport key (Bytes -> Bytes, vetted hkdf crate).
+  (define %derive-auth
+    (fp "jt_jsecmon_typed_psk_derive_auth_key" (u8* size_t void* void*) unsigned-8))
+  (define (derive-auth-key psk)
+    (call->bytes (lambda (pp pl) (%derive-auth psk (bytevector-length psk) pp pl))))
+
+  (define %derive-transport
+    (fp "jt_jsecmon_typed_psk_derive_transport_key" (u8* size_t void* void*) unsigned-8))
+  (define (derive-transport-key psk)
+    (call->bytes (lambda (pp pl) (%derive-transport psk (bytevector-length psk) pp pl))))
+
+  ;; encrypt_transport: AES-256-GCM under the transport key with the 12-byte
+  ;; nonce prepended to the frame (nonce ‖ ciphertext‖tag).
+  (define %transport-seal
+    (fp "jt_jsecmon_typed_psk_psk_transport_seal"
+        (u8* size_t u8* size_t u8* size_t void* void*) unsigned-8))
+  (define (psk-transport-seal transport-key nonce plaintext)
+    (call->bytes (lambda (pp pl)
+      (%transport-seal transport-key (bytevector-length transport-key)
+                       nonce (bytevector-length nonce)
+                       plaintext (bytevector-length plaintext) pp pl))))
+
+  ;; decrypt_transport: split the leading nonce off and AEAD-open; #f on a bad
+  ;; tag or wrong key (the Option Bytes None arm of the kernel).
+  (define %transport-open
+    (fp "jt_jsecmon_typed_psk_psk_transport_open"
+        (u8* size_t u8* size_t void* void*) unsigned-8))
+  (define (psk-transport-open transport-key sealed)
+    (call->maybe-bytes (lambda (pp pl)
+      (%transport-open transport-key (bytevector-length transport-key)
+                       sealed (bytevector-length sealed) pp pl))))
+
   ;; ── analytics ─────────────────────────────────────────────────────────────
   (define %host-risk
     (fp "jt_jsecmon_analytics_host_risk_score"