From ad67612478826cc7e5363067de5bbd4b4df29cef Mon Sep 17 00:00:00 2001 From: cage Date: Wed, 15 Mar 2023 17:18:38 +0100 Subject: [PATCH] - [GUI] fixed discarding rendering of lines coming from a stopped stream; - [GUI] added downloading and opening of non text data. --- src/gemini-viewer.lisp | 1 - src/gui/client/main-window.lisp | 73 ++++++++++++++------ src/gui/server/public-api-gemini-stream.lisp | 55 +++++++++++++-- 3 files changed, 101 insertions(+), 28 deletions(-) diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index d8bd0f0..e367528 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -520,7 +520,6 @@ (download-stream download-stream) (octect-count octect-count) (support-file support-file)) wrapper-object - (lambda () (when-let ((extension (fs:get-extension path))) (setf support-file (fs:temporary-file :extension extension))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 6a0c6b1..4cdaa24 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -112,10 +112,10 @@ (with-notify-errors (apply #'comm:make-request method-name id args)))) -(defun slurp-gemini-stream (iri &key - (use-cache t) - (process-function #'identity) - (aborting-function (constantly nil))) +(defun slurp-gemini-stream (iri stream-wrapper &key + (use-cache t) + (process-function #'identity) + (aborting-function (constantly nil))) (enqueue-request-notify-error :gemini-request 1 iri use-cache) (labels ((stream-exausted-p () (let ((status-completed (enqueue-request-notify-error :gemini-stream-completed-p @@ -135,7 +135,7 @@ nil)) (next-start-fetching (length last-lines-fetched))) (when last-lines-fetched - (funcall process-function last-lines-fetched)) + (funcall process-function stream-wrapper last-lines-fetched)) (loop-fetch (+ last-lines-fetched-count next-start-fetching)))))))) (loop-fetch))) @@ -158,6 +158,7 @@ (eq (status stream-wrapper) +stream-status-canceled+))) (let ((stream-thread (bt:make-thread (lambda () (slurp-gemini-stream iri + stream-wrapper :use-cache use-cache :process-function process-function @@ -483,6 +484,36 @@ :query encoded-input :port port)))) +(defun slurp-non-text-data (main-window iri) + (labels ((maybe-open-if-completed (stream-info support-file) + (if (string-equal (getf stream-info :stream-status) + :completed) + (client-os-utils:open-resource-with-external-program main-window support-file) + (wait-enough-data))) + (wait-enough-data () + (let* ((stream-info + (cev:enqueue-request-and-wait-results :gemini-stream-info + 1 + ev:+maximum-event-priority+ + iri)) + (read-so-far (getf stream-info :octect-count -1)) + (support-file (getf stream-info :support-file))) + (multiple-value-bind (program-exists y wait-for-download) + (swconf:link-regex->program-to-use support-file) + (declare (ignore y)) + (if program-exists + (if wait-for-download + (maybe-open-if-completed stream-info support-file) + (let ((buffer-size (swconf:link-regex->program-to-use-buffer-size support-file))) + (if (or (and buffer-size + (> read-so-far buffer-size)) + (> read-so-far + swconf:+buffer-minimum-size-to-open+)) + (client-os-utils:open-resource-with-external-program main-window support-file) + (wait-enough-data)))) + (maybe-open-if-completed stream-info support-file)))))) + (wait-enough-data))) + (defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+)) (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request 1 @@ -534,21 +565,23 @@ ((gemini-client:header-success-p status-code) (cond ((eq status +stream-status-streaming+) - (let ((stopped-stream (maybe-stop-steaming-stream-thread))) - (clean-gemtext main-window) - (start-streaming-thread iri - :use-cache nil - :process-function - (lambda (lines) - ;; this test ensures that the - ;; collecting events left on - ;; the queue won't be actually - ;; processed, just discarded - (when (not (and stopped-stream - (eq (status stopped-stream) - +stream-status-canceled+))) - (collect-ir-lines iri main-window lines))) - :status status))) + (if (gemini-client:gemini-file-stream-p meta) + (progn + (maybe-stop-steaming-stream-thread) + (clean-gemtext main-window) + (start-streaming-thread iri + :use-cache nil + :status status + :process-function + (lambda (stream-wrapper lines) + ;; this test ensures that the + ;; collecting events left on + ;; the queue won't be actually + ;; processed, just discarded + (when (not (eq (status stream-wrapper) + +stream-status-canceled+)) + (collect-ir-lines iri main-window lines))))) + (slurp-non-text-data main-window iri))) ((eq status +stream-status-downloading+) (when (not (find-db-stream-url iri)) (enqueue-request-notify-error :gemini-request 1 iri use-cache))) diff --git a/src/gui/server/public-api-gemini-stream.lisp b/src/gui/server/public-api-gemini-stream.lisp index 8486131..185bc46 100644 --- a/src/gui/server/public-api-gemini-stream.lisp +++ b/src/gui/server/public-api-gemini-stream.lisp @@ -43,6 +43,46 @@ :contents (list :matches matched-strings :indices indices))))) +(defun request-stream-other-document-thread (wrapper-object + socket + host + port + path + query + fragment + status-code + status-code-description + meta) + (declare (ignorable host + port path query fragment + status-code status-code-description meta)) + (with-accessors ((download-socket gemini-viewer:download-socket) + (download-stream gemini-viewer:download-stream) + (octect-count gemini-viewer:octect-count) + (support-file gemini-viewer:support-file)) wrapper-object + (lambda () + (a:when-let ((extension (fs:get-extension path))) + (setf support-file (fs:temporary-file :extension extension))) + (gemini-viewer::with-open-support-file (file-stream support-file) + (labels ((download-completed-p (buffer read-so-far) + (and buffer + (< read-so-far (length buffer)))) + (%fill-buffer () + (when (gemini-viewer:downloading-allowed-p wrapper-object) + (multiple-value-bind (buffer read-so-far) + (ignore-errors (read-array download-stream + gemini-viewer::+read-buffer-size+)) + (gemini-viewer::increment-bytes-count wrapper-object read-so-far) + (write-sequence buffer file-stream :start 0 :end read-so-far) + (force-output file-stream) + (misc:dbg "letti ~a" read-so-far) + (if (download-completed-p buffer read-so-far) + (progn + (setf (gemini-viewer:stream-status wrapper-object) :completed) + (gemini-client:close-ssl-socket socket)) + (%fill-buffer)))))) + (%fill-buffer)))))) + (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) @@ -99,11 +139,11 @@ actual-iri)) (t (let* ((starting-status :streaming) - (gemini-stream (make-instance 'gemini-others-data-stream + (gemini-stream (make-instance 'gemini-viewer::gemini-others-data-stream :stream-status starting-status :download-stream response :download-socket socket)) - (thread-fn (gemini-viewer::request-stream-other-document-thread gemini-stream + (thread-fn (request-stream-other-document-thread gemini-stream socket host port @@ -114,6 +154,7 @@ code-description meta))) (gemini-client:debug-gemini "response is *not* a gemini file stream") + (gemini-viewer:push-db-stream gemini-stream) (gemini-viewer::downloading-start-thread gemini-stream thread-fn host @@ -180,15 +221,15 @@ (gemini-client:debug-gemini "viewer requesting iri ~s" url) (let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url)))) (if use-cached-file-if-exists - (progn + (let ((cached-stream (gemini-viewer:find-db-stream-url actual-iri))) (gemini-client:debug-gemini "checking cache") - (if (gemini-viewer:find-db-stream-url actual-iri) + (if cached-stream (progn (gemini-client:debug-gemini "caching found for ~a" actual-iri) (gemini-viewer:push-url-to-history *gemini-window* actual-iri) - (make-gemini-response (gemini-client:code gemini-client:+success+) - (gemini-client:description gemini-client:+success+) - nil + (make-gemini-response (gw:status-code cached-stream) + (gw:status-code-description cached-stream) + (gw:meta cached-stream) actual-iri :cached t)) (progn