- allowed the user to bypas TOFU exception;

- fixed TOFU check.
2025-01-31 04:24:48 +01:00 · 2020-06-23 11:47:21 +02:00 · 2020-06-23 11:47:21 +02:00 · cf7a19dd04
commit cf7a19dd04
parent c513429dc8
7 changed files with 103 additions and 42 deletions
--- a/LICENSES.org
+++ b/LICENSES.org
@ -321,3 +321,35 @@
  ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  SOFTWARE.
+
+- src/gemini-viewer.lisp
+
+  uses code from:
+
+  usocket https://common-lisp.net/project/usocket/
+
+  (This is the MIT / X Consortium license as taken from
+  http://www.opensource.org/licenses/mit-license.html)
+
+  Copyright (c) 2003 Erik Enge
+  Copyright (c) 2006-2007 Erik Huelsmann
+  Copyright (c) 2008-2019 Hans Hueber and Chun Tian
+
+  Permission is hereby granted, free of charge, to any person obtaining
+  a copy of this software and associated documentation files (the
+  "Software"), to deal in the Software without restriction, including
+  without limitation the rights to use, copy, modify, merge, publish,
+  distribute, sublicense, and/or sell copies of the Software, and to
+  permit persons to whom the Software is furnished to do so, subject to
+  the following conditions:
+
+  The above copyright notice and this permission notice shall be
+  included in all copies or substantial portions of the Software.
+
+  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+  LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+  OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+  WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
--- a/po/it.po
+++ b/po/it.po
@ -8,8 +8,8 @@ msgid ""
 msgstr ""
 "Project-Id-Version: tinmop 0.0.1\n"
 "Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n"
-"POT-Creation-Date: 2020-06-22 13:11+0200\n"
-"PO-Revision-Date: 2020-06-22 13:12+0200\n"
+"POT-Creation-Date: 2020-06-23 11:19+0200\n"
+"PO-Revision-Date: 2020-06-23 11:19+0200\n"
 "Last-Translator: cage <cage@invalid.org>\n"
 "Language-Team: Italian\n"
 "Language: it\n"
@ -181,16 +181,25 @@ msgstr "Seguire la redirezione a ~s? [s/N] "
 msgid "Server ~s asks: ~s "
 msgstr "Il server ~s chiede: ~s "

-#: src/gemini-viewer.lisp:85
+#: src/gemini-viewer.lisp:94
 #, lisp-format
-msgid "Error getting ~s: ~a"
-msgstr "Errore connettendomi a ~s: ~a"
+msgid ""
+"Host ~s signature changed! This is a potential security risk! Ignore this "
+"warning? [y/N] "
+msgstr ""
+"La firma dell'host ~s è cambiata! Questo è un potenziale problema di "
+"sicurezza! Proseguire? [s/N]"

-#: src/gemini-viewer.lisp:87 src/tui-utils.lisp:478
+#: src/gemini-viewer.lisp:98 src/tui-utils.lisp:478
 #, lisp-format
 msgid "Error: ~a"
 msgstr "Errore: ~a"

+#: src/gemini-viewer.lisp:103
+#, lisp-format
+msgid "Error getting ~s: ~a"
+msgstr "Errore connettendomi a ~s: ~a"
+
 #: src/gemini/client.lisp:155
 #, lisp-format
 msgid "The server responded with the error ~a: ~a"
--- a/po/tinmop.pot
+++ b/po/tinmop.pot
@ -6,9 +6,9 @@
 #, fuzzy
 msgid ""
 msgstr ""
-"Project-Id-Version: tinmop 0.0.7\n"
+"Project-Id-Version: tinmop 0.0.9\n"
 "Report-Msgid-Bugs-To: https://notabug.org/cage/tinmop/\n"
-"POT-Creation-Date: 2020-06-22 13:11+0200\n"
+"POT-Creation-Date: 2020-06-23 11:19+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@ -174,16 +174,23 @@ msgstr ""
 msgid "Server ~s asks: ~s "
 msgstr ""

-#: src/gemini-viewer.lisp:85
+#: src/gemini-viewer.lisp:94
 #, lisp-format
-msgid "Error getting ~s: ~a"
+msgid ""
+"Host ~s signature changed! This is a potential security risk! Ignore this "
+"warning? [y/N] "
 msgstr ""

-#: src/gemini-viewer.lisp:87 src/tui-utils.lisp:478
+#: src/gemini-viewer.lisp:98 src/tui-utils.lisp:478
 #, lisp-format
 msgid "Error: ~a"
 msgstr ""

+#: src/gemini-viewer.lisp:103
+#, lisp-format
+msgid "Error getting ~s: ~a"
+msgstr ""
+
 #: src/gemini/client.lisp:155
 #, lisp-format
 msgid "The server responded with the error ~a: ~a"
--- a/src/db.lisp
+++ b/src/db.lisp
@ -2540,18 +2540,12 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cage-days-offset)'"
                                offset)))))

 (defun tofu-passes-p (host hash)
-  (let ((known-hash (fetch-single (select :*
-                                    (from +table-gemini-tofu-cert+)
-                                    (where (:= :hash hash)))))
-        (known-host (fetch-single (select :*
+  (let ((known-host (fetch-single (select :*
                                    (from +table-gemini-tofu-cert+)
                                    (where (:= :host host))))))
    (cond
-      (known-hash
-       (string= (db-getf known-hash :host)
-                host))
      (known-host
-       nil)
+       (string= (db-getf known-host :hash) hash))
      (t
       (with-db-current-timestamp (now)
         (query (make-insert +table-gemini-tofu-cert+
--- a/src/gemini-viewer.lisp
+++ b/src/gemini-viewer.lisp
@ -81,9 +81,24 @@
                       (write-sequence body stream)
                       (force-output stream)
                       (os-utils:xdg-open fs:temp-file))))))
-            (error (e)
-              (ui:error-message (format nil (_ "Error getting ~s: ~a") url e)))
+            (gemini-client:gemini-tofu-error (e)
+              (let ((host (gemini-client:host e)))
+                (flet ((on-input-complete (maybe-accepted)
+                         (when (ui::boolean-input-accepted-p maybe-accepted)
+                           (db-utils:with-ready-database (:connect nil)
+                             (db:tofu-delete host)
+                             (request url)))))
+                  (ui:ask-string-input #'on-input-complete
+                                       :prompt
+                                       (format nil
+                                               (_ "Host ~s signature changed! This is a potential security risk! Ignore this warning? [y/N] ")
+                                               host)))))
            (conditions:not-implemented-error (e)
              (ui:error-message (format nil (_ "Error: ~a") e)))
            (gemini-client:gemini-protocol-error (e)
-              (ui:error-message (format nil "~a" e))))))))
+              (ui:error-message (format nil "~a" e)))
+            (error (e)
+              (ui:error-message (format nil
+                                        (_ "Error getting ~s: ~a")
+                                        url
+                                        e))))))))
--- a/src/gemini/client.lisp
+++ b/src/gemini/client.lisp
@ -220,23 +220,25 @@
    (when query
      (setf uri (strcat uri "?" query)))
    (cl+ssl:with-global-context (ctx :auto-free-p t)
-      (usocket:with-client-socket (socket stream
-                                          host
-                                          port
-                                          :element-type '(unsigned-byte 8))
-        (let* ((ssl-stream (cl+ssl:make-ssl-client-stream stream
-                                                          :external-format
-                                                          '(:ASCII)
-                                                          :unwrap-stream-p t
-                                                          :verify          nil
-                                                          :hostname       host))
-               (request    (format nil "~a~a~a" uri #\Return #\Newline))
-               (cert-hash  (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
-          (if (not (db:tofu-passes-p host cert-hash))
-              (error 'gemini-tofu-error :host host)
-              (progn
-                (write-string request ssl-stream)
-                (force-output ssl-stream)
-                (multiple-value-bind (status description meta body gemini-text gemini-links)
-                    (parse-response ssl-stream host port path)
-                  (values status description meta body gemini-text gemini-links)))))))))
+      (let ((socket (usocket:socket-connect host port :element-type '(unsigned-byte 8))))
+        (unwind-protect
+            (when socket
+              (let ((stream (usocket:socket-stream socket)))
+                (let* ((ssl-stream (cl+ssl:make-ssl-client-stream stream
+                                                                  :external-format '(:ascii)
+                                                                  :unwrap-stream-p t
+                                                                  :verify          nil
+                                                                  :hostname        host))
+                       (request    (format nil "~a~a~a" uri #\return #\newline))
+                       (cert-hash  (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
+                  (if (not (db:tofu-passes-p host cert-hash))
+                      (error 'gemini-tofu-error :host host)
+                      (progn
+                        (write-string request ssl-stream)
+                        (force-output ssl-stream)
+                        (multiple-value-bind (status description meta body gemini-text gemini-links)
+                            (parse-response ssl-stream host port path)
+                          (values status description meta body gemini-text
+                                  gemini-links)))))))
+          (when socket
+            (usocket:socket-close socket)))))))
--- a/src/gemini/package.lisp
+++ b/src/gemini/package.lisp
@ -69,6 +69,8 @@
   :gemini-protocol-error
   :error-code
   :error-description
+   :gemini-tofu-error
+   :host
   :response-input-p
   :response-sensitive-input-p
   :response-redirect-p