cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- quote meta characters when matching for RE, searching for a common prefix from a bag of strings.

This commit is contained in:
cage 2021-04-16 18:34:27 +02:00
parent b4b9e57c56
commit d9ebbe84ab
2 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/gemini/client.lisp
View File

@ -357,20 +357,20 @@
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
(cl+ssl:with-global-context (ctx :auto-free-p t)
(let* ((socket (open-tls-socket host port))
(stream (usocket:socket-stream socket))
(ssl-hostname (if (or (iri:ipv4-address-p host)
(iri:ipv6-address-p host))
nil
host))
(ssl-stream (cl+ssl:make-ssl-client-stream stream
:certificate client-certificate
:key certificate-key
:external-format nil
:unwrap-stream-p t
:verify nil
:hostname ssl-hostname))
(request (format nil "~a~a~a" iri #\return #\newline))
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
(stream (usocket:socket-stream socket))
(ssl-hostname (if (or (iri:ipv4-address-p host)
(iri:ipv6-address-p host))
nil
host))
(ssl-stream (cl+ssl:make-ssl-client-stream stream
:certificate client-certificate
:key certificate-key
:external-format nil
:unwrap-stream-p t
:verify nil
:hostname ssl-hostname))
(request (format nil "~a~a~a" iri #\return #\newline))
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
(debug-gemini "sending request ~a" request)
(if (not (db:tofu-passes-p host cert-hash))
(error 'gemini-tofu-error :host host)

4
src/text-utils.lisp
View File

@ -118,7 +118,9 @@
(setf res (strcat res (string (elt pivot-string prefix-count)))))
(%advance ()
(loop for i in actual-strings do
(when (not (cl-ppcre:scan (strcat "^" res) i))
(when (not (cl-ppcre:scan (strcat "^"
(cl-ppcre:quote-meta-chars res))
i))
(setf res (subseq res 0 (1- (length res))))
(return-from %advance nil)))
(when (< (1+ prefix-count)