- [TUI] notify when a parsing error occurred when querying local database.

etc/default-theme.conf

@@ -522,6 +522,10 @@ open-message-link-window.input.selected.foreground   = #FF00FF
 
 # gemini browser
 
+# absolute address for a search engine used in tinmop (both TUI and GUI)
+
+gemini.search-engine.uri                             = "gemini://kennedy.gemi.dev/search"
+
 gemini.downloading.animation                         = "⠇ ⠋ ⠙ ⠸ ⠴ ⠦"
 
 gemini.favicon                                       = "🌍"

etc/init.lisp

@@ -139,7 +139,7 @@
 (defun gemini-search ()
   "Search   the  geminispace   using  keyword   (note:  will   contact
   \"gemini://kennedy.gemi.dev/search\""
- (gemini-viewer:load-gemini-url +gemini-search-engine+))
+ (gemini-viewer:load-gemini-url (swconf:config-gemini-search-engine-iri)))
 
 (defun open-gemini-links-and-ask-tour ()
   "Open the link window and ask for tour link indices"

src/gemini/client.lisp

@@ -447,46 +447,52 @@
                             (client-certificate nil)
                             (certificate-key    nil)
                             (certificate-key-password nil))
-  (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
+  (multiple-value-bind (proxy-host proxy-port)
-                               (percent-encode-path path)
+      (swconf:config-gemini-proxy)
-                               :query    (percent-encode-query query)
+    (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
-                               :port     port
+                                 (percent-encode-path path)
-                               :fragment (percent-encode-fragment fragment)))
+                                 :query    (percent-encode-query query)
-         (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
+                                 :port     port
-    (cl+ssl:with-global-context (ctx :auto-free-p t)
+                                 :fragment (percent-encode-fragment fragment)))
-      (handler-case
+           (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
-          (let ((socket       (open-tls-socket host port)))
+      (cl+ssl:with-global-context (ctx :auto-free-p t)
-            (hooks:run-hooks 'hooks:*after-gemini-socket*)
+        (handler-case
-            (let* ((stream       (usocket:socket-stream socket))
+            (let* ((actual-host (or proxy-host
-                   (ssl-hostname (if (or (iri:ipv4-address-p host)
+                                    host))
-                                         (iri:ipv6-address-p host))
+                   (actual-port (or proxy-port
-                                     nil
+                                    port))
-                                     host))
+                   (socket (open-tls-socket actual-host actual-port)))
-                   (ssl-stream   (cl+ssl:make-ssl-client-stream stream
+              (hooks:run-hooks 'hooks:*after-gemini-socket*)
-                                                                :certificate     client-certificate
+              (let* ((stream       (usocket:socket-stream socket))
-                                                                :key             certificate-key
+                     (ssl-hostname (if (or (iri:ipv4-address-p actual-host)
-                                                                :password
+                                           (iri:ipv6-address-p actual-host))
-                                                                certificate-key-password
+                                       nil
-                                                                :external-format nil ; unsigned byte 8
+                                       actual-host))
-                                                                :unwrap-stream-p t
+                     (ssl-stream   (cl+ssl:make-ssl-client-stream stream
-                                                                :verify          nil
+                                                                  :certificate     client-certificate
-                                                                :hostname        ssl-hostname))
+                                                                  :key             certificate-key
-                   (request    (format nil "~a~a~a" iri #\return #\newline))
+                                                                  :password
-                   (cert-hash  (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
+                                                                  certificate-key-password
-              (debug-gemini "sending request ~a" request)
+                                                                  :external-format nil ; unsigned byte 8
-              (if (not (db:tofu-passes-p host cert-hash))
+                                                                  :unwrap-stream-p t
-                  (error 'gemini-tofu-error :host host)
+                                                                  :verify          nil
-                  (progn
+                                                                  :hostname        ssl-hostname))
-                    (write-sequence (string->octets request) ssl-stream)
+                     (request    (format nil "~a~a~a" iri #\return #\newline))
-                    (force-output ssl-stream)
+                     (cert-hash  (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
-                    (hooks:run-hooks 'hooks:*after-gemini-request-sent*)
+                (debug-gemini "sending request ~a" request)
-                    (multiple-value-bind (status description meta response)
+                (if (not (db:tofu-passes-p actual-host cert-hash))
-                        #+sbcl (sb-sys:with-deadline (:seconds +read-response-deadline+)
+                    (error 'gemini-tofu-error :host actual-host)
-                                 (parse-response ssl-stream))
+                    (progn
-                      #-sbcl (parse-response ssl-stream)
+                      (write-sequence (string->octets request) ssl-stream)
-                      (values status description meta response socket))))))
+                      (force-output ssl-stream)
-        (error (e)
+                      (hooks:run-hooks 'hooks:*after-gemini-request-sent*)
-          (error e))))))
+                      (multiple-value-bind (status description meta response)
+                          #+sbcl (sb-sys:with-deadline (:seconds +read-response-deadline+)
+                                   (parse-response ssl-stream))
+                        #-sbcl (parse-response ssl-stream)
+                        (values status description meta response socket))))))
+          (error (e)
+            (error e)))))))
 
 (defun missing-dispath-function (status code-description meta response socket iri parsed-iri)
   (declare (ignore response socket parsed-iri))

src/gui/client/main-window.lisp

@@ -1074,7 +1074,7 @@ local file paths."
                             (render-line rendered-line))))))))))))
 
 (defun open-search-iri (criteria main-window)
-  (let ((parsed-iri-search-capsule (iri:iri-parse constants:+gemini-search-engine+)))
+  (let ((parsed-iri-search-capsule (iri:iri-parse (swconf:config-gemini-search-engine-iri))))
     (setf (uri:query parsed-iri-search-capsule)
           (text-utils:maybe-percent-encode criteria))
     (let ((search-iri (with-output-to-string (stream)

src/package.lisp

@@ -1481,6 +1481,8 @@
    :config-default-post-language
    :config-announcements-separator
    :config-announcements-icon
+   :config-gemini-proxy
+   :config-gemini-search-engine-iri
    :link-regex->program-to-use
    :link-regex->program-to-use-buffer-size
    :use-tinmop-as-external-program-p

src/program-events.lisp

@@ -2038,30 +2038,31 @@
 
 (defmethod process-event ((object fediverse-local-query-event))
   (with-accessors ((payload payload)) object
-    (multiple-value-bind (statuses destination-folder)
+    (tui-utils:with-notify-errors
-        (fediverse-post-local-search:parse-search-statuses payload)
+        (multiple-value-bind (statuses destination-folder)
-      (let ((folder (or destination-folder
+            (fediverse-post-local-search:parse-search-statuses payload)
-                        (query-results-folder-name))))
+          (let ((folder (or destination-folder
-        (loop for status in statuses do
+                            (query-results-folder-name))))
-          (let* ((status-id  (db:row-message-status-id status))
+            (loop for status in statuses do
-                 (status-row (db:find-status-id status-id)))
+              (let* ((status-id  (db:row-message-status-id status))
-          (when (not (db::find-status-id-folder-timeline status-id
+                     (status-row (db:find-status-id status-id)))
-                                                         folder
+                (when (not (db::find-status-id-folder-timeline status-id
-                                                         db:+home-timeline+))
+                                                               folder
-            (setf (getf status-row :folder)
+                                                               db:+home-timeline+))
-                  folder)
+                  (setf (getf status-row :folder)
-            (setf (getf status-row :timeline)
+                        folder)
-                  db:+home-timeline+)
+                  (setf (getf status-row :timeline)
-            (multiple-value-bind (query column-values)
+                        db:+home-timeline+)
-                (db-utils:insert-query db:+table-status+ status-row)
+                  (multiple-value-bind (query column-values)
-              (db-utils:query-low-level query column-values)))))
+                      (db-utils:insert-query db:+table-status+ status-row)
-        (db:renumber-timeline-message-index db:+home-timeline+
+                    (db-utils:query-low-level query column-values)))))
-                                            folder
+            (db:renumber-timeline-message-index db:+home-timeline+
-                                            :account-id nil)
+                                                folder
-        (let ((refresh-event   (make-instance 'refresh-thread-windows-event
+                                                :account-id nil)
-                                              :new-folder   folder
+            (let ((refresh-event   (make-instance 'refresh-thread-windows-event
-                                              :new-timeline  db:+home-timeline+)))
+                                                  :new-folder   folder
-          (push-event refresh-event))))))
+                                                  :new-timeline  db:+home-timeline+)))
+              (push-event refresh-event)))))))
 
 ;;;; end events
 

src/software-configuration.lisp

@@ -597,6 +597,7 @@
                    gemini
                    gemlog
                    gempub
+                   proxy
                    library
                    sync
                    favicon
@@ -646,7 +647,8 @@
                    purge-history-days-offset
                    purge-cache-days-offset
                    mentions
-                   montage)
+                   montage
+                   search-engine)
 
 (defun perform-trivial-configuration-checks (file)
   (handler-case
@@ -1683,39 +1685,56 @@
                     +key-announcements+
                     +key-icon+)
 
+(defun config-gemini-proxy ()
+  (when-let* ((iri (access:accesses *software-configuration*
+                                    +key-gemini+
+                                    +key-proxy+
+                                    +key-uri+))
+              (parsed-iri (iri:iri-parse iri :null-on-error t)))
+    (values (uri:host parsed-iri)
+            (uri:port parsed-iri))))
+
+(defun config-gemini-search-engine-iri ()
+  (let ((iri (access:accesses *software-configuration*
+                              +key-gemini+
+                              +key-search-engine+
+                              +key-uri+)))
+    (or iri
+        +gemini-search-engine+)))
+
 ;;;;;; tests
 
 (defun trivial-configuration-missing-value-check ()
-  (loop for fn in (list
+  (loop for fn in (list #'gemini-downloading-animation
-                   #'gemini-downloading-animation
+                        #'gemini-default-favicon
-                   #'gemini-default-favicon
+                        #'gemini-link-prefix-to-gemini
-                   #'gemini-link-prefix-to-gemini
+                        #'gemini-link-prefix-to-other
-                   #'gemini-link-prefix-to-other
+                        #'gemini-quote-prefix
-                   #'gemini-quote-prefix
+                        #'gemini-h1-prefix
-                   #'gemini-h1-prefix
+                        #'gemini-h2-prefix
-                   #'gemini-h2-prefix
+                        #'gemini-h3-prefix
-                   #'gemini-h3-prefix
+                        #'gemini-bullet-prefix
-                   #'gemini-bullet-prefix
+                        #'gemini-subscription-url-fg
-                   #'gemini-subscription-url-fg
+                        #'gemini-subscription-count-fg
-                   #'gemini-subscription-count-fg
+                        #'signature-file-path
-                   #'signature-file-path
+                        #'window-titles-ends
-                   #'window-titles-ends
+                        #'tags-new-message-mark
-                   #'tags-new-message-mark
+                        #'config-server-name
-                   #'config-server-name
+                        #'config-username
-                   #'config-username
+                        #'config-password-echo-character
-                   #'config-password-echo-character
+                        #'config-win-focus-mark
-                   #'config-win-focus-mark
+                        #'command-separator-config-values
-                   #'command-separator-config-values
+                        #'message-window-locked-account-mark
-                   #'message-window-locked-account-mark
+                        #'message-window-unlocked-account-mark
-                   #'message-window-unlocked-account-mark
+                        #'message-window-line-mark-values
-                   #'message-window-line-mark-values
+                        #'message-window-attachments-header
-                   #'message-window-attachments-header
+                        #'config-post-allowed-language
-                   #'config-post-allowed-language
+                        #'config-default-post-language
-                   #'config-default-post-language
+                        #'config-announcements-separator)
-                   #'config-announcements-separator)
         do
            (funcall fn)))
 
 (defun trivial-configuration-checks ()
   (assert (length= (config-username)
-                   (config-server-name))))
+                   (config-server-name)))
+  (config-gemini-proxy))