Move SSD TLS pin validation to typed Jerboa

ober

7ee872121d16791efa0b2aae8a9be7ea1d6cd2ed

diff --git a/.build.yml b/.build.yml
index 1370ba5..a64e187 100644
--- a/.build.yml
+++ b/.build.yml
@@ -5,7 +5,7 @@ packages:
   - make=4.4.1-r4
 sources:
   # Build dependency: full immutable commit, mirrored in dependencies.lock.json.
-  - "https://git.sr.ht/~lisp/jerboa#06442a897016857792d3ff87af5d08bfeb21eb78"
+  - "https://git.sr.ht/~lisp/jerboa#035ee76dd63f2402a3cd9501d4485e081c66dbb3"
   # The second source is the build subject selected by the SourceHut submitter.
   - https://git.sr.ht/~lisp/jerboa-android
 tasks:
@@ -14,6 +14,6 @@ tasks:
       test "$(apk info -v chez-scheme)" = chez-scheme-10.3.0-r2
       test "$(apk info -v git)" = git-2.54.0-r0
       test "$(apk info -v make)" = make-4.4.1-r4
-      test "$(git -C ../jerboa rev-parse HEAD)" = 06442a897016857792d3ff87af5d08bfeb21eb78
-      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = b1cd91d5bc7427458c2b9321e9155a9bc679daad
+      test "$(git -C ../jerboa rev-parse HEAD)" = 035ee76dd63f2402a3cd9501d4485e081c66dbb3
+      test "$(git -C ../jerboa rev-parse 'HEAD^{tree}')" = 3aa2b2c5769a308f6ab616ca6e0b7d78c41014a9
       JERBOA="chez --libdirs .:../jerboa/lib --script" make test
diff --git a/dependencies.lock.json b/dependencies.lock.json
index 7f04505..80a656d 100644
--- a/dependencies.lock.json
+++ b/dependencies.lock.json
@@ -11,8 +11,8 @@
   "generator_runtime": {
     "name": "jerboa",
     "repository": "https://git.sr.ht/~lisp/jerboa",
-    "commit": "06442a897016857792d3ff87af5d08bfeb21eb78",
-    "tree": "b1cd91d5bc7427458c2b9321e9155a9bc679daad"
+    "commit": "035ee76dd63f2402a3cd9501d4485e081c66dbb3",
+    "tree": "3aa2b2c5769a308f6ab616ca6e0b7d78c41014a9"
   },
   "assurance_tools": {
     "osv_scanner": {
diff --git a/scripts/verify-supply-chain.sh b/scripts/verify-supply-chain.sh
index 96b9e5a..3b971e1 100755
--- a/scripts/verify-supply-chain.sh
+++ b/scripts/verify-supply-chain.sh
@@ -3,8 +3,8 @@ set -eu
 
 repo=$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd -P)
 lock="$repo/dependencies.lock.json"
-jerboa_commit=06442a897016857792d3ff87af5d08bfeb21eb78 # gitsafe:ignore
-jerboa_tree=b1cd91d5bc7427458c2b9321e9155a9bc679daad # gitsafe:ignore
+jerboa_commit=035ee76dd63f2402a3cd9501d4485e081c66dbb3 # gitsafe:ignore
+jerboa_tree=3aa2b2c5769a308f6ab616ca6e0b7d78c41014a9 # gitsafe:ignore
 gradle_sha=20f1b1176237254a6fc204d8434196fa11a4cfb387567519c61556e8710aed78
 jdk_macos_sha=8fa1eff40bb637a33613b2ccb8b12c70dc3661cc22cf8e784943715769a05336
 jdk_linux_sha=d8afc263758141a66e0e3aafc321e783f7016696f4eaea067d340a269037d331
diff --git a/templates/ssd-review.ss b/templates/ssd-review.ss
index 00bab92..8a16883 100644
--- a/templates/ssd-review.ss
+++ b/templates/ssd-review.ss
@@ -1996,6 +1996,8 @@
                       (java nio file Files)
                       (java nio file Path)
                       (java security MessageDigest)
+                      (java security PublicKey)
+                      (java security cert CertificateException)
                       (java security cert X509Certificate)
                       (java util zip ZipEntry)
                       (javax net ssl X509TrustManager))
@@ -2053,9 +2055,11 @@
                 zipEntryIsDirectory zipEntryIsFile zipEntryDeclaresExcessiveSize)
         (type File)
         (type Path)
+        (type CertificateException)
+        (type MessageDigest)
+        (type PublicKey)
         (type URL)
         (type ZipEntry)
-        (type TruthStore)
         (type X509Certificate)
         (type X509TrustManager)
         (type Int32)
@@ -2084,6 +2088,15 @@
           (kotlin-call android util Base64 decode))
         (extern (messageDigestIsEqual (actual : Bytes) (expected : Bytes)) : Bool
           (kotlin-call java security MessageDigest isEqual))
+        (extern (messageDigestGetInstance (algorithm : String)) : MessageDigest
+          (kotlin-call MessageDigest getInstance))
+        (extern (messageDigestDigest
+                  (digest : MessageDigest)
+                  (data : Bytes)) : Bytes
+          (kotlin-member-call digest))
+        (extern (certificateException
+                  (message : String)) : CertificateException
+          (kotlin-call CertificateException))
         (extern (urlPort (url : URL)) : Int32
           (kotlin-member-get port))
         (extern (urlDefaultPort (url : URL)) : Int32
@@ -2102,13 +2115,16 @@
                   (chain : (Array X509Certificate))
                   (authType : String)) : Unit
           (kotlin-member-call checkClientTrusted))
-        (extern (truthStoreCheckPinnedServerTrusted
-                  (store : TruthStore)
-                  (platform : X509TrustManager)
-                  (expectedPin : Bytes)
+        (extern (x509TrustManagerCheckServerTrusted
+                  (manager : X509TrustManager)
                   (chain : (Array X509Certificate))
                   (authType : String)) : Unit
-          (kotlin-member-call checkPinnedServerTrusted))
+          (kotlin-member-call checkServerTrusted))
+        (extern (x509CertificatePublicKey
+                  (certificate : X509Certificate)) : PublicKey
+          (kotlin-member-get publicKey))
+        (extern (publicKeyEncoded (key : PublicKey)) : Bytes
+          (kotlin-member-get encoded))
         (record RemoteConfig
           ((apiUrl : URL)
            (spkiSha256 : (Nullable Bytes))
@@ -2281,8 +2297,39 @@
         (def (constantTimeNullableBytesMismatch (actual : Bytes)
                                                 (expected : (Nullable Bytes))) : Bool
           (not (constantTimeNullableBytesEqual actual expected)))
+        (def (sha256Bytes (data : Bytes)) : Bytes
+          (messageDigestDigest (messageDigestGetInstance "SHA-256") data))
+        (def (x509CertificateSpkiSha256
+               (certificate : X509Certificate)) : Bytes
+          (sha256Bytes
+            (publicKeyEncoded
+              (x509CertificatePublicKey certificate))))
+        (def (x509CertificateChainPresent
+               (chain : (Array X509Certificate))) : Bool
+          (positiveCount (list-size chain)))
+        (def (x509CertificateChainLeaf
+               (chain : (Array X509Certificate))) : X509Certificate
+          (list-ref chain (int32 0)))
+        (def (trustManagerCheckPinnedServerTrusted
+               (platform : X509TrustManager)
+               (expectedPin : Bytes)
+               (chain : (Array X509Certificate))
+               (authType : String)) : Unit
+          (begin
+            (x509TrustManagerCheckServerTrusted platform chain authType)
+            (if (x509CertificateChainPresent chain)
+              (if (constantTimeBytesMismatch
+                    (x509CertificateSpkiSha256
+                      (x509CertificateChainLeaf chain))
+                    expectedPin)
+                (throw
+                  (certificateException "SSD service identity pin mismatch")
+                  Unit)
+                (begin))
+              (throw
+                (certificateException "Server provided no certificate")
+                Unit))))
         (def (truthStoreMakePinnedTrustManager
-               (store : TruthStore)
                (platform : X509TrustManager)
                (expectedPin : Bytes)) : X509TrustManager
           (object X509TrustManager
@@ -2295,8 +2342,7 @@
             (override (checkServerTrusted
                         (chain : (Array X509Certificate))
                         (authType : String)) : Unit
-              (truthStoreCheckPinnedServerTrusted
-                store
+              (trustManagerCheckPinnedServerTrusted
                 platform
                 expectedPin
                 chain
@@ -10352,23 +10398,13 @@
        "        return connection"
        "    }"
        ""
-       "    internal fun checkPinnedServerTrusted(platform: X509TrustManager, expectedPin: ByteArray, chain: Array<X509Certificate>, authType: String) {"
-       "        platform.checkServerTrusted(chain, authType)"
-       "        if (!positiveCount(chain.size)) throw CertificateException(\"Server provided no certificate\")"
-       "        val leaf = chain[0]"
-       "        val actual = MessageDigest.getInstance(\"SHA-256\").digest(leaf.publicKey.encoded)"
-       "        if (constantTimeBytesMismatch(actual, expectedPin)) {"
-       "            throw CertificateException(\"SSD service identity pin mismatch\")"
-       "        }"
-       "    }"
-       ""
        "    private fun pinnedSocketFactory(config: RemoteConfig): SSLSocketFactory {"
        "        if (!remotePinBytesPresent(config.spkiSha256)) throw CertificateException(\"SPKI pin is required for pinned TLS\")"
        "        val expectedPin = checkNotNull(config.spkiSha256)"
        "        val managerFactory = TrustManagerFactory.getInstance(TrustManagerFactory.getDefaultAlgorithm())"
        "        managerFactory.init(null as KeyStore?)"
        "        val platform = managerFactory.trustManagers.filterIsInstance<X509TrustManager>().single()"
-       "        val pinned = truthStoreMakePinnedTrustManager(this, platform, expectedPin)"
+       "        val pinned = truthStoreMakePinnedTrustManager(platform, expectedPin)"
        "        return SSLContext.getInstance(\"TLS\").apply {"
        "            init(null, arrayOf<TrustManager>(pinned), SecureRandom())"
        "        }.socketFactory"