diff --git a/etc/shared.conf b/etc/shared.conf index fc81ecd..372b0d3 100644 --- a/etc/shared.conf +++ b/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") diff --git a/src/api-client.lisp b/src/api-client.lisp index 35d0632..03b7b9a 100644 --- a/src/api-client.lisp +++ b/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)) diff --git a/src/constants.lisp b/src/constants.lisp index 98e74d8..fa56b66 100644 --- a/src/constants.lisp +++ b/src/constants.lisp @@ -173,11 +173,13 @@ General Public License for more details." (define-constant +file-scheme+ "file" :test #'string=) -(define-constant +about-scheme+ "about" :test #'string=) +(define-constant +http-scheme+ "http" :test #'string=) -(define-constant +internal-scheme-bookmark+ "bookmark" :test #'string=) +(define-constant +about-scheme+ "about" :test #'string=) -(define-constant +internal-scheme-gemlogs+ "gemlog" :test #'string=) +(define-constant +internal-scheme-bookmark+ "bookmark" :test #'string=) + +(define-constant +internal-scheme-gemlogs+ "gemlog" :test #'string=) (define-constant +internal-scheme-view-source+ "view-source" :test #'string=) diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index 960828d..bd6140d 100644 --- a/src/gemini-viewer.lisp +++ b/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) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 0ac2342..a762eab 100644 --- a/src/gemini/client.lisp +++ b/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+))) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index 53f3441..129157d 100644 --- a/src/gemini/package.lisp +++ b/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 diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 1066c8a..d981a9f 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -1083,8 +1083,12 @@ 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))) + (let* ((actual-iri (remove-standard-port 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,13 +1146,14 @@ 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 - :query encoded-input - :port port))))) + :scheme scheme + :query encoded-input + :port port))))) (defun slurp-text-data (main-window iri) (labels ((maybe-open-if-completed (stream-info support-file) diff --git a/src/gui/server/public-api-gemini-certificates.lisp b/src/gui/server/public-api-gemini-certificates.lisp index 904fc67..c404ed8 100644 --- a/src/gui/server/public-api-gemini-certificates.lisp +++ b/src/gui/server/public-api-gemini-certificates.lisp @@ -50,8 +50,13 @@ t) (defun gemini-delete-tofu-certificate (iri) - (let ((host (uri:host (iri:iri-parse iri)))) - (db:tofu-delete host))) + (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))))) (defun gemini-import-certificate (uri cert-file key-file) (db-utils:with-ready-database (:connect nil) diff --git a/src/gui/server/public-api-gemini-stream.lisp b/src/gui/server/public-api-gemini-stream.lisp index bf50c7c..0577e0b 100644 --- a/src/gui/server/public-api-gemini-stream.lisp +++ b/src/gui/server/public-api-gemini-stream.lisp @@ -91,8 +91,8 @@ (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) - (gemini-client:displace-iri parsed-iri ) + (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) (let* ((starting-status :streaming) @@ -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)) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index 6ba3ade..5a6396a 100644 --- a/src/gui/server/public-api.lisp +++ b/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 diff --git a/src/package.lisp b/src/package.lisp index 771a943..8113542 100644 --- a/src/package.lisp +++ b/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