mirror of https://codeberg.org/cage/tinmop/
- [gemini fixed validity check for client certificate (thanks op!).
This commit is contained in:
parent
be03c790c9
commit
0972cc3ed0
17
src/db.lisp
17
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)
|
||||
(when-let* ((text-looking-for (strcat url "%"))
|
||||
(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 "%"))
|
||||
(defun find-tls-certificates-rows (&optional (url-like ""))
|
||||
(when-let* ((text-looking-for (prepare-for-sql-like url-like))
|
||||
(query (select :*
|
||||
(from +table-cache+)
|
||||
(where (:and (:like :key text-looking-for)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -53,6 +53,7 @@
|
|||
:gemini-link
|
||||
:target
|
||||
:name
|
||||
:path-last-dir
|
||||
:gemini-response
|
||||
:status-code
|
||||
:meta
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue