mirror of https://codeberg.org/cage/tinmop/
- fixed 'loop-fetch'.
This commit is contained in:
parent
ac757ce4a6
commit
8230416499
|
@ -59,6 +59,21 @@ and key stored in the file pointed by the filesystem path
|
||||||
request
|
request
|
||||||
client-cert-fingerprint)
|
client-cert-fingerprint)
|
||||||
(cond
|
(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)
|
((cl-ppcre:scan "slow" request)
|
||||||
(format t "slow...~%")
|
(format t "slow...~%")
|
||||||
(let ((response (format nil
|
(let ((response (format nil
|
||||||
|
@ -79,6 +94,21 @@ and key stored in the file pointed by the filesystem path
|
||||||
((cl-ppcre:scan "timeout" request)
|
((cl-ppcre:scan "timeout" request)
|
||||||
(format t "timeout...~%")
|
(format t "timeout...~%")
|
||||||
(sleep 3600))
|
(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)
|
((null client-cert-fingerprint)
|
||||||
(let ((response (format nil
|
(let ((response (format nil
|
||||||
"~a please provide a certificate~a~a"
|
"~a please provide a certificate~a~a"
|
||||||
|
|
|
@ -163,29 +163,36 @@
|
||||||
nil)
|
nil)
|
||||||
nil)))
|
nil)))
|
||||||
(fetch-latest-lines (iri last-lines-fetched-count)
|
(fetch-latest-lines (iri last-lines-fetched-count)
|
||||||
(gui-goodies:with-notify-errors
|
(handler-case
|
||||||
(cev:enqueue-request-and-wait-results :gemini-stream-parsed-line-slice
|
(cev:enqueue-request-and-wait-results :gemini-stream-parsed-line-slice
|
||||||
1
|
1
|
||||||
ev:+standard-event-priority+
|
ev:+standard-event-priority+
|
||||||
iri
|
iri
|
||||||
last-lines-fetched-count ; start slice
|
last-lines-fetched-count ; start slice
|
||||||
nil))) ; end slice
|
nil) ; end slice
|
||||||
(loop-fetch (&optional (last-lines-fetched-count 0))
|
(error (e)
|
||||||
(let* ((last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count))
|
(ev:with-enqueued-process-and-unblock ()
|
||||||
(next-start-fetching (length last-lines-fetched)))
|
(gui-goodies:error-dialog main-window e)))))
|
||||||
(misc:dbg "loop fetch ~a ~a" iri last-lines-fetched-count)
|
(loop-fetch ()
|
||||||
(loop while (not (or (funcall aborting-function)
|
(let* ((last-lines-fetched (fetch-latest-lines iri 0))
|
||||||
(and (stream-exausted-p)
|
(last-lines-fetched-count (length last-lines-fetched)))
|
||||||
(<= next-start-fetching 0))))
|
(loop named fetching
|
||||||
|
while (not (funcall aborting-function))
|
||||||
do
|
do
|
||||||
(progn
|
|
||||||
(when last-lines-fetched
|
(when last-lines-fetched
|
||||||
(ev:with-enqueued-process-and-unblock ()
|
(ev:with-enqueued-process-and-unblock ()
|
||||||
(gui-goodies:with-notify-errors
|
(gui-goodies:with-notify-errors
|
||||||
(funcall process-function stream-wrapper last-lines-fetched))))
|
(funcall process-function stream-wrapper last-lines-fetched))))
|
||||||
(setf last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count))
|
(let* ((stream-finished (stream-exausted-p))
|
||||||
(setf next-start-fetching (length last-lines-fetched))
|
(new-lines-fetched (fetch-latest-lines iri
|
||||||
(incf last-lines-fetched-count next-start-fetching)))
|
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 ()
|
(ev:with-enqueued-process-and-unblock ()
|
||||||
(gui-goodies:with-notify-errors
|
(gui-goodies:with-notify-errors
|
||||||
(perform-after-stream-exausted-actions))))))
|
(perform-after-stream-exausted-actions))))))
|
||||||
|
|
Loading…
Reference in New Issue