1
0
Fork 0

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

This commit is contained in:
cage 2021-07-16 11:32:36 +02:00
parent be03c790c9
commit 0972cc3ed0
4 changed files with 27 additions and 17 deletions

View File

@ -2908,21 +2908,8 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
(defun tofu-delete (host) (defun tofu-delete (host)
(query (delete-from +table-gemini-tofu-cert+ (where (:= :host 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 :* (query (select :*
(from +table-cache+) (from +table-cache+)
(where (:and (:like :key text-looking-for) (where (:and (:like :key text-looking-for)

View File

@ -465,11 +465,34 @@
(defun text-file-stream-p (meta) (defun text-file-stream-p (meta)
(mime-text-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) (defun fetch-cached-certificate (url)
(let ((certificate nil) (let ((certificate nil)
(key nil)) (key nil))
(multiple-value-bind (certificate-cache key-cache) (multiple-value-bind (certificate-cache key-cache)
(db:ssl-cert-find url) (tls-cert-find url)
(if (and certificate-cache (if (and certificate-cache
key-cache) key-cache)
(setf certificate certificate-cache (setf certificate certificate-cache

View File

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

View File

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