mirror of https://codeberg.org/cage/tinmop/
- [RPC] added debug function for gemini streams.
This commit is contained in:
cage
parent
cde0ac281f
commit
3d642b4531
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue