cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-28 03:59:17 +01:00
Code Issues

- [RPC] added debug function for gemini streams.

Browse Source
This commit is contained in:
cage 2023-06-28 17:39:58 +02:00
parent cde0ac281f
commit 3d642b4531
1 changed files with 22 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/gui/server/public-api-gemini-stream.lisp
View File

@ -21,6 +21,10 @@
(a:define-constant +tofu-error-status-code+ -1 :test #'=)
(defun debug-gemini-gui (&rest data)
(apply #'gemini-client:debug-gemini (append (list (strcat "[gui] " (first data))
(rest data)))))
(defmethod yason:encode ((object iri-complete-response) &optional (stream *standard-output*))
(let ((json:*symbol-encoder* #'json:encode-symbol-as-lowercase)
(yason:*list-encoder* #'yason:encode-plist)
@ -86,7 +90,7 @@
(declare (ignore iri))
(multiple-value-bind (actual-iri host path query port fragment)
(gemini-client:displace-iri parsed-iri )
(gemini-client:debug-gemini "response is a stream")
(debug-gemini-gui "response is a stream")
(labels ((make-text-based-stream (gemini-format-p)
(let* ((starting-status :streaming)
(gemini-stream (make-instance 'gemini-viewer::gemini-file-stream
@ -124,7 +128,7 @@
fragment))))
(cond
((gemini-client:gemini-file-stream-p meta)
(gemini-client:debug-gemini "response is a gemini document stream")
(debug-gemini-gui "response is a gemini document stream")
(gemini-viewer:push-url-to-history *gemini-window* actual-iri)
(make-text-based-stream t)
(make-gemini-response (gemini-client:code gemini-client:+success+)
@ -156,7 +160,7 @@
status
code-description
meta)))
(gemini-client:debug-gemini "response is *not* a gemini file stream")
(debug-gemini-gui "response is *not* a gemini file stream")
(gemini-viewer:push-db-stream gemini-stream)
(gemini-viewer::downloading-start-thread gemini-stream
thread-fn
@ -184,15 +188,15 @@
(do-nothing-if-exists-in-db nil))
(labels ((redirect-dispatch (status code-description meta response socket iri parsed-iri)
(declare (ignore parsed-iri response socket))
(gemini-client:debug-gemini "response redirect to: ~s" meta)
(debug-gemini-gui "response redirect to: ~s" meta)
(make-gemini-response status code-description meta iri))
(input-dispatch (status code-description meta response socket iri parsed-iri)
(declare (ignore response socket parsed-iri))
(gemini-client:debug-gemini "response requested input: ~s" meta)
(debug-gemini-gui "response requested input: ~s" meta)
(make-gemini-response status code-description meta iri))
(sensitive-input-dispatch (status code-description meta response socket iri parsed-iri)
(declare (ignore response socket parsed-iri))
(gemini-client:debug-gemini "response requested sensitive input: ~s"
(debug-gemini-gui "response requested sensitive input: ~s"
meta)
(make-gemini-response status code-description meta iri))
(certificate-request-dispatch (status
@ -202,7 +206,7 @@
socket iri
parsed-iri)
(declare (ignore status code-description response socket meta parsed-iri))
(gemini-client:debug-gemini "response requested certificate")
(debug-gemini-gui "response requested certificate")
(multiple-value-bind (cached-certificate cached-key)
(gemini-client:fetch-cached-certificate iri)
(%gemini-request iri
@ -221,15 +225,15 @@
:success
#'request-success-dispatched-fn)
:ignore-warning nil)
(gemini-client:debug-gemini "viewer requesting iri ~s" url)
(debug-gemini-gui "viewer requesting iri ~s" url)
(let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url))))
(db:gemlog-mark-as-seen actual-iri)
(if use-cached-file-if-exists
(let ((cached-stream (gemini-viewer:find-db-stream-url actual-iri)))
(gemini-client:debug-gemini "checking cache")
(debug-gemini-gui "checking cache")
(if cached-stream
(progn
(gemini-client:debug-gemini "caching found for ~a" actual-iri)
(debug-gemini-gui "caching found for ~a" actual-iri)
(gemini-viewer:push-url-to-history *gemini-window* actual-iri)
(make-gemini-response (gw:status-code cached-stream)
(gw:status-code-description cached-stream)
@ -237,17 +241,20 @@
actual-iri
:cached t))
(progn
(gemini-client:debug-gemini "caching *not* found for ~a" actual-iri)
(debug-gemini-gui "caching *not* found for ~a"
actual-iri)
(%gemini-request actual-iri
:certificate-key certificate-key
:certificate certificate
:use-cached-file-if-exists nil
:do-nothing-if-exists-in-db
do-nothing-if-exists-in-db))))
(gemini-client:request-dispatch url
gemini-client::dispatch-table
:certificate certificate
:certificate-key certificate-key))))
(progn
(debug-gemini-gui "ignoring cache")
(gemini-client:request-dispatch url
gemini-client::dispatch-table
:certificate certificate
:certificate-key certificate-key)))))
(gemini-client:gemini-tofu-error (e)
(make-gemini-response +tofu-error-status-code+
(format nil "~a" e)