From 8230416499f50b3ca92c93cc0468018e3defa513 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 29 Sep 2024 14:55:54 +0200 Subject: [PATCH] - fixed 'loop-fetch'. --- src/gemini/dummy-server.lisp | 30 +++++++++++++++++++ src/gui/client/main-window.lisp | 51 +++++++++++++++++++-------------- 2 files changed, 59 insertions(+), 22 deletions(-) diff --git a/src/gemini/dummy-server.lisp b/src/gemini/dummy-server.lisp index b1c67ae..4153f25 100644 --- a/src/gemini/dummy-server.lisp +++ b/src/gemini/dummy-server.lisp @@ -59,6 +59,21 @@ and key stored in the file pointed by the filesystem path request client-cert-fingerprint) (cond + ((cl-ppcre:scan "pause" request) + (let ((response (format nil + "~a text/gemini~a~a" + (code gemini-client::+20+) + #\return #\newline))) + (write-sequence (text-utils:string->octets response) + stream) + (loop for i from 0 below 100 do + (when (= i 10) + (sleep 1)) + (write-sequence (text-utils:string->octets (format nil "~a~%" i)) + stream) + (finish-output stream)) + (close stream) + (get-data))) ((cl-ppcre:scan "slow" request) (format t "slow...~%") (let ((response (format nil @@ -79,6 +94,21 @@ and key stored in the file pointed by the filesystem path ((cl-ppcre:scan "timeout" request) (format t "timeout...~%") (sleep 3600)) + ((cl-ppcre:scan "empty-response" request) + (close stream) + (format t "empty response.~%") + (get-data)) + ((cl-ppcre:scan "empty-body-response" request) + (format t "empty-body...~%") + (let ((response (format nil + "~a text/gemini~a~a" + (code gemini-client::+20+) + #\return #\newline))) + (format t "sending: ~a~%" response) + (write-sequence (text-utils:string->octets response) + stream) + (close stream) + (get-data))) ((null client-cert-fingerprint) (let ((response (format nil "~a please provide a certificate~a~a" diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 737a456..bfbe424 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -163,29 +163,36 @@ nil) nil))) (fetch-latest-lines (iri last-lines-fetched-count) - (gui-goodies:with-notify-errors - (cev:enqueue-request-and-wait-results :gemini-stream-parsed-line-slice - 1 - ev:+standard-event-priority+ - iri - last-lines-fetched-count ; start slice - nil))) ; end slice - (loop-fetch (&optional (last-lines-fetched-count 0)) - (let* ((last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count)) - (next-start-fetching (length last-lines-fetched))) - (misc:dbg "loop fetch ~a ~a" iri last-lines-fetched-count) - (loop while (not (or (funcall aborting-function) - (and (stream-exausted-p) - (<= next-start-fetching 0)))) + (handler-case + (cev:enqueue-request-and-wait-results :gemini-stream-parsed-line-slice + 1 + ev:+standard-event-priority+ + iri + last-lines-fetched-count ; start slice + nil) ; end slice + (error (e) + (ev:with-enqueued-process-and-unblock () + (gui-goodies:error-dialog main-window e))))) + (loop-fetch () + (let* ((last-lines-fetched (fetch-latest-lines iri 0)) + (last-lines-fetched-count (length last-lines-fetched))) + (loop named fetching + while (not (funcall aborting-function)) do - (progn - (when last-lines-fetched - (ev:with-enqueued-process-and-unblock () - (gui-goodies:with-notify-errors - (funcall process-function stream-wrapper last-lines-fetched)))) - (setf last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count)) - (setf next-start-fetching (length last-lines-fetched)) - (incf last-lines-fetched-count next-start-fetching))) + (when last-lines-fetched + (ev:with-enqueued-process-and-unblock () + (gui-goodies:with-notify-errors + (funcall process-function stream-wrapper last-lines-fetched)))) + (let* ((stream-finished (stream-exausted-p)) + (new-lines-fetched (fetch-latest-lines iri + last-lines-fetched-count)) + (new-line-fetched-count (length new-lines-fetched))) + (if (and (= new-line-fetched-count 0) + stream-finished) + (return-from fetching t) + (progn + (setf last-lines-fetched new-lines-fetched) + (incf last-lines-fetched-count new-line-fetched-count))))) (ev:with-enqueued-process-and-unblock () (gui-goodies:with-notify-errors (perform-after-stream-exausted-actions))))))