- [GUI] added support for HTTP proxy;

- [fediverse] added 'edit-status'.

etc/shared.conf

@@ -172,6 +172,14 @@ color-regexp                     = "\*[^*]+\*" #ffff00 bold
 
 #color-regexp                     = "/[^/]+/" #ffff00 italic
 
+gemini.search-engine.uri        = "gemini://kennedy.gemi.dev/search"
+
+# gemini proxy, forward all the gemini and http requests to the servel
+# below, the response  is converted, by the proxy, in  a format fitted
+# for a gemini client (e.g HTML is converted to gemtext)
+
+gemini.proxy.uri                = ""
+
 # The width of  the generated table of contents for  gemini pages when
 # tinmop is ran as exclusive gemini client (command line option "-G")
 

src/api-client.lisp

@@ -547,6 +547,27 @@ database."
                       :spoiler-text subject
                       :visibility   visibility))
 
+(defun-api-call edit-status (content
+                             attachments
+                             attachments-alt-text
+                             subject
+                             language)
+  "Edit a status
+- content the new text of the message
+- attachments a list  of file path to attach or  nil il no attachments
+  to this message exists
+- subject the subject of this message"
+  (tooter:edit-status *client*
+                      content
+                      :language     language
+                      :media        (mapcar (lambda (path alt-text)
+                                              (tooter:make-media *client*
+                                                                 (fs:namestring->pathname path)
+                                                                 :description alt-text))
+                                            attachments
+                                            attachments-alt-text)
+                      :spoiler-text subject))
+
 (defun-api-call search-user (username &key (limit 1) (resolve nil))
   "Find user identified by username"
   (tooter:search-accounts *client* username :limit limit :resolve resolve))

src/constants.lisp

@@ -173,6 +173,8 @@ General Public License for more details."
 
 (define-constant +file-scheme+                     "file"                   :test #'string=)
 
+(define-constant +http-scheme+                     "http"                   :test #'string=)
+
 (define-constant +about-scheme+                    "about"                  :test #'string=)
 
 (define-constant +internal-scheme-bookmark+        "bookmark"               :test #'string=)

src/gemini-viewer.lisp

@@ -221,7 +221,7 @@
 
 (defgeneric downloading-allowed-p (object))
 
-(defgeneric downloading-start-thread (object function host port path query fragment))
+(defgeneric downloading-start-thread (object function scheme host port path query fragment))
 
 (defmethod abort-downloading ((object gemini-stream))
   (with-accessors ((download-thread-lock download-thread-lock)) object
@@ -252,6 +252,7 @@
 
 (defmethod downloading-start-thread ((object gemini-stream)
                                      function
+                                     scheme
                                      host
                                      port
                                      path
@@ -265,6 +266,7 @@
     (setf start-time (db-utils:local-time-obj-now))
     (setf download-iri (gemini-parser:make-gemini-iri host
                                                       path
+                                                      :scheme   scheme
                                                       :query    query
                                                       :port     port
                                                       :fragment fragment))
@@ -370,7 +372,7 @@
         (text-utils:percent-decode    fragment)
         fragment)))
 
-(defun request-stream-gemini-document-thread (wrapper-object host
+(defun request-stream-gemini-document-thread (wrapper-object scheme host
                                               port path query fragment favicon
                                               gemini-format-p
                                               &key
@@ -433,6 +435,7 @@
           (with-open-support-file (file-stream support-file character)
             (let* ((url                    (gemini-parser:make-gemini-iri host
                                                                           path
+                                                                          :scheme   scheme
                                                                           :query    query
                                                                           :port     port
                                                                           :fragment fragment))
@@ -587,7 +590,7 @@
                    (if enqueue
                        :streaming
                        :running))))
-      (multiple-value-bind (actual-iri host path query port fragment)
+      (multiple-value-bind (actual-iri host path query port fragment scheme)
           (gemini-client:displace-iri parsed-iri)
         (gemini-client:debug-gemini "response is a stream")
         (labels ((make-text-based-stream (gemini-format-p)
@@ -607,6 +610,7 @@
                                                           :download-socket socket))
                           (favicon      (fetch-favicon parsed-iri))
                           (thread-fn    (request-stream-gemini-document-thread gemini-stream
+                                                                               scheme
                                                                                host
                                                                                port
                                                                                path
@@ -619,6 +623,7 @@
                      (program-events:push-event enqueue-event)
                      (downloading-start-thread gemini-stream
                                                thread-fn
+                                               scheme
                                                host
                                                port
                                                path
@@ -665,6 +670,7 @@
                (program-events:push-event enqueue-event)
                (downloading-start-thread gemini-stream
                                          thread-fn
+                                         scheme
                                          host
                                          port
                                          path
@@ -683,7 +689,7 @@
                       (use-cached-file-if-exists  nil)
                       (do-nothing-if-exists-in-db nil))
   (labels ((get-user-input (hide-input url prompt)
-             (multiple-value-bind (actual-iri host path query port fragment)
+             (multiple-value-bind (actual-iri host path query port fragment scheme)
                  (gemini-client:displace-iri (iri:iri-parse url))
                (declare (ignore actual-iri query fragment))
                (flet ((on-input-complete (input)
@@ -692,6 +698,7 @@
                             (let ((encoded-input (maybe-percent-encode input)))
                               (request (gemini-parser:make-gemini-iri host
                                                                       path
+                                                                      :scheme scheme
                                                                       :query
                                                                       encoded-input
                                                                       :port     port)

src/gemini/client.lisp

@@ -441,6 +441,7 @@
   :documentation "timeout, in seconds, for reading response from remote server")
 
 (defun request (host path &key
+                            (scheme  +gemini-scheme+)
                             (query nil)
                             (port  +gemini-default-port+)
                             (fragment nil)
@@ -451,10 +452,12 @@
       (swconf:config-gemini-proxy)
     (let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
                                  (percent-encode-path path)
+                                 :scheme   scheme
                                  :query    (percent-encode-query query)
                                  :port     port
                                  :fragment (percent-encode-fragment fragment)))
            (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
+      ;; (return-from request nil)
       (cl+ssl:with-global-context (ctx :auto-free-p t)
         (handler-case
             (let* ((actual-host (or proxy-host
@@ -555,13 +558,16 @@
                                   :certificate-key certificate-key
                                   :certificate-key-password certificate-key-password))))
     (let ((parsed-iri (iri:iri-parse url)))
-      (multiple-value-bind (actual-iri host path query port)
+      (multiple-value-bind (actual-iri host path query port x scheme)
           (displace-iri parsed-iri)
+        (declare (ignore x))
         (multiple-value-bind (status code-description meta response socket)
             (if (absolute-titan-url-p url)
                 (make-titan-request)
                 (gemini-client:request host
                                        path
+                                       :scheme                   (or scheme
+                                                                     +gemini-scheme+)
                                        :certificate-key          certificate-key
                                        :certificate-key-password certificate-key-password
                                        :client-certificate       certificate
@@ -765,3 +771,8 @@ TODO: Add client certificate."
                                       :ignore-warning t)
           (request-dispatch url dispatch-table))
         (fs:slurp-file url :convert-to-string nil))))
+
+(defun url-needs-proxy-p (url)
+  (and (swconf:config-gemini-proxy)
+       (string= (uri:scheme (iri:iri-parse url))
+                +http-scheme+)))

src/gemini/package.lisp

@@ -204,7 +204,8 @@
    :clear-cache-certificate-password
    :substitute-cache-certificate-password
    :build-redirect-iri
-   :slurp-gemini-url))
+   :slurp-gemini-url
+   :url-needs-proxy-p))
 
 (defpackage :gemini-dummy-server
   (:use

src/gui/client/main-window.lisp

@@ -1084,7 +1084,11 @@ local file paths."
 (defun open-iri (iri main-window use-cache &key (status +stream-status-streaming+))
   (handler-case
       (let* ((actual-iri  (remove-standard-port iri))
-             (parsed-iri (iri:iri-parse actual-iri)))
+             (parsed-iri  (iri:iri-parse actual-iri))
+             (needs-proxy (cev:enqueue-request-and-wait-results :gemini-url-needs-proxy-p
+                                                                1
+                                                                ev:+maximum-event-priority+
+                                                                actual-iri)))
         (cond
           ((string= (uri:scheme parsed-iri) +internal-scheme-view-source+)
            (setf (uri:scheme parsed-iri) gemini-constants:+gemini-scheme+)
@@ -1100,7 +1104,8 @@ local file paths."
            (menu:manage-gemlogs))
           ((gemini-client:absolute-titan-url-p actual-iri)
            (client-titan-window:init-window main-window main-window actual-iri))
-          ((gemini-parser:gemini-iri-p actual-iri)
+          ((or (gemini-parser:gemini-iri-p actual-iri)
+               needs-proxy)
            (let ((stream-frame (stream-frame main-window)))
              (start-stream-iri (iri-ensure-path actual-iri)
                                main-window
@@ -1141,11 +1146,12 @@ local file paths."
                                  :button-message button-label))
          (encoded-input (maybe-percent-encode raw-input)))
     (when (string-not-empty-p raw-input)
-      (multiple-value-bind (actual-iri host path query port fragment)
+      (multiple-value-bind (actual-iri host path query port fragment scheme)
           (gemini-client:displace-iri parsed-iri)
         (declare (ignore actual-iri query fragment))
         (gemini-parser:make-gemini-iri host
                                        path
+                                       :scheme scheme
                                        :query  encoded-input
                                        :port   port)))))
 

src/gui/server/public-api-gemini-certificates.lisp

@@ -50,8 +50,13 @@
   t)
 
 (defun gemini-delete-tofu-certificate (iri)
+  (multiple-value-bind (proxy-host x)
+      (swconf:config-gemini-proxy)
+    (declare (ignore x))
+    (if proxy-host
+        (db:tofu-delete proxy-host)
         (let ((host (uri:host (iri:iri-parse iri))))
-    (db:tofu-delete host)))
+          (db:tofu-delete host)))))
 
 (defun gemini-import-certificate (uri cert-file key-file)
   (db-utils:with-ready-database (:connect nil)

src/gui/server/public-api-gemini-stream.lisp

@@ -91,7 +91,7 @@
 
 (defun request-success-dispatched-fn (status code-description meta response socket iri parsed-iri)
   (declare (ignore iri))
-  (multiple-value-bind (actual-iri host path query port fragment)
+  (multiple-value-bind (actual-iri host path query port fragment scheme)
       (gemini-client:displace-iri parsed-iri)
     (debug-gemini-gui "response is a stream")
     (labels ((make-text-based-stream (gemini-format-p)
@@ -112,6 +112,7 @@
                                                       :download-socket socket))
                       (favicon         (gemini-viewer::fetch-favicon parsed-iri))
                       (thread-fn       (gemini-viewer::request-stream-gemini-document-thread gemini-stream
+                                                                                             scheme
                                                                                   host
                                                                                   port
                                                                                   path
@@ -124,6 +125,7 @@
                  (gemini-viewer:push-db-stream gemini-stream)
                  (gemini-viewer::downloading-start-thread gemini-stream
                                                           thread-fn
+                                                          scheme
                                                           host
                                                           port
                                                           path
@@ -167,6 +169,7 @@
            (gemini-viewer:push-db-stream gemini-stream)
            (gemini-viewer::downloading-start-thread gemini-stream
                                                     thread-fn
+                                                    scheme
                                                     host
                                                     port
                                                     path
@@ -625,3 +628,6 @@
 (defun titan-save-token (url token)
   (db:save-titan-token url token)
   t)
+
+(defun gemini-url-needs-proxy-p (url)
+  (gemini-client:url-needs-proxy-p url))

src/gui/server/public-api.lisp

@@ -44,6 +44,9 @@
      (gen-rpc "complete-net-address"
               'complete-net-address
               "hint" 0)
+     (gen-rpc "gemini-url-needs-proxy-p"
+              'gemini-url-needs-proxy-p
+              "iri"         0)
      (gen-rpc "gemini-request"
               'gemini-request
               "iri"         0

src/package.lisp

@@ -74,6 +74,7 @@
    :+octect-type+
    :+gemini-file-extension+
    :+file-scheme+
+   :+http-scheme+
    :+about-scheme+
    :+internal-scheme-bookmark+
    :+internal-scheme-gemlogs+
@@ -1876,6 +1877,7 @@
    :fetch-remote-status
    :get-remote-status
    :send-status
+   :edit-status
    :get-status-context
    :search-user
    :find-results