- [gemini fixed validity check for client certificate (thanks op!).

src/db.lisp

@@ -2908,21 +2908,8 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
 (defun tofu-delete (host)
   (query (delete-from +table-gemini-tofu-cert+ (where (:= :host host)))))
 
-(defun ssl-cert-find (url)
+(defun find-tls-certificates-rows (&optional (url-like ""))
-  (when-let* ((text-looking-for (strcat url "%"))
+  (when-let* ((text-looking-for (prepare-for-sql-like url-like))
-              (query            (select :*
-                                  (from +table-cache+)
-                                  (where (:and (:like :key text-looking-for)
-                                               (:= :type +cache-tls-certificate-type+)))))
-              (in-cache         (fetch-single query))
-              (id               (getf in-cache :id)))
-    (values (strcat (os-utils:cached-file-path (to-s id))
-                    fs:*directory-sep* os-utils:+ssl-cert-name+)
-            (strcat (os-utils:cached-file-path (to-s id))
-                    fs:*directory-sep* os-utils:+ssl-key-name+))))
-
-(defun find-tls-certificates-rows (&optional (url ""))
-  (when-let* ((text-looking-for (strcat url "%"))
               (query            (select :*
                                   (from +table-cache+)
                                   (where (:and (:like :key text-looking-for)

src/gemini/client.lisp

@@ -465,11 +465,34 @@
 (defun text-file-stream-p (meta)
   (mime-text-p meta))
 
+(defun tls-cert-find (request-iri)
+  (when-let* ((all-rows           (db:find-tls-certificates-rows))
+              (parsed-request-iri (iri:iri-parse request-iri :null-on-error t)))
+    (multiple-value-bind (request-iri request-host request-path request-query request-port
+                          request-fragment request-scheme)
+        (gemini-client:displace-iri parsed-request-iri)
+      (declare (ignore request-iri request-query request-fragment))
+      (loop for row in all-rows do
+        (let ((id (db:row-id row)))
+          (multiple-value-bind (iri host path query port fragment scheme)
+              (gemini-client:displace-iri (iri:iri-parse (db:row-cache-key row)))
+            (declare (ignore iri query fragment))
+            (when (and (string= request-host   host)
+                     (string= request-scheme   scheme)
+                     (=       request-port     port)
+                     (text-utils:string-starts-with-p (gemini-parser:path-last-dir path)
+                                                      request-path))
+              (return-from tls-cert-find
+                (values (strcat (os-utils:cached-file-path (to-s id))
+                                fs:*directory-sep* os-utils:+ssl-cert-name+)
+                        (strcat (os-utils:cached-file-path (to-s id))
+                                fs:*directory-sep* os-utils:+ssl-key-name+))))))))))
+
 (defun fetch-cached-certificate (url)
   (let ((certificate nil)
         (key         nil))
     (multiple-value-bind (certificate-cache key-cache)
-        (db:ssl-cert-find url)
+        (tls-cert-find url)
       (if (and certificate-cache
                key-cache)
           (setf certificate certificate-cache

src/gemini/package.lisp

@@ -53,6 +53,7 @@
    :gemini-link
    :target
    :name
+   :path-last-dir
    :gemini-response
    :status-code
    :meta

src/package.lisp

@@ -990,7 +990,6 @@
    :cache-expired-p
    :tofu-passes-p
    :tofu-delete
-   :ssl-cert-find
    :find-tls-certificates-rows
    :gemini-subscribe-url
    :gemini-find-subscription