cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [gemini] in gemini-client:request-dispatch signal a condition 

('not-implemented-error') instead  of doing nothing when  a response
  in not handled (i.e. no function for that response type exists).
This commit is contained in:
cage 2021-02-09 19:32:48 +01:00
parent 4f4a3f4476
commit ae82420cfe
2 changed files with 29 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/gemini-viewer.lisp
View File

@ -429,13 +429,6 @@
(%fill-buffer)))))))
(%fill-buffer))))))
(defun request-fallback-dispatched (status code-description meta response socket iri parsed-iri)
(declare (ignore response socket parsed-iri))
(error (make-condition 'conditions:not-implemented-error
:text (format nil
"received an unknown response from server ~s ~a ~s ~s"
iri status code-description meta))))
(defun request-success-dispatched-clrs (enqueue)
(lambda (status code-description meta response socket iri parsed-iri)
(declare (ignore iri))
@ -594,10 +587,8 @@
:redirect
#'redirect-dispatch
:success
(request-success-dispatched-clrs enqueue)
:fallback
#'request-fallback-dispatched)
:ignore-warning nil)
(request-success-dispatched-clrs enqueue))
:ignore-warning nil)
(gemini-client:debug-gemini "viewer requesting iri ~s" url)
(maybe-initialize-metadata specials:*message-window*)
(let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url))))

51
src/gemini/client.lisp
View File

@ -363,6 +363,13 @@
(parse-response ssl-stream)
(values status description meta response socket)))))))))))
(defun missing-dispath-function (status code-description meta response socket iri parsed-iri)
(declare (ignore response socket parsed-iri))
(error (make-condition 'conditions:not-implemented-error
:text (format nil
"received an unknown response from server ~s ~a ~s ~s"
iri status code-description meta))))
(defun request-dispatch (url manage-functions &key (certificate nil) (certificate-key nil))
(let ((parsed-iri (iri:iri-parse url)))
(multiple-value-bind (actual-iri host path query port fragment)
@ -378,8 +385,7 @@
(flet ((call-appropriate-function (response-type)
(funcall (getf manage-functions
response-type
(lambda (status code-description meta response socket iri parsed-iri)
(declare (ignore status code-description meta response socket iri parsed-iri))))
#'missing-dispath-function)
status
code-description
meta
@ -415,28 +421,25 @@
(let* ((unknown-keys (loop for i in (remove-if-not #'keywordp table)
when (not (find i +allowed-dispatch-keys+))
collect i)))
(if (null table)
(error "Empty dispatch-table")
(progn
(when (not ignore-warning)
(when unknown-keys
(warn (format nil
"found unkown keys in dispatch-table table: ~s"
unknown-keys)))
(when (null (getf table :redirect))
(warn "No dispatch for redirect found"))
(when (null (getf table :certificate-requested))
(warn "No dispatch for certificate request"))
(when (null (getf table :success))
(warn "No dispatch for success found"))
(when (null (getf table :input-requested))
(warn "No dispatch for input request"))
(when (null (getf table :sensitive-input-requested))
(warn "No dispatch for sensitive-input request"))
(when (null (getf table :fallback))
(warn "No dispatch for others responses")))
`(let ((dispatch-table (list ,@table)))
,@body)))))
(when (not ignore-warning)
(when (null table)
(error "Empty dispatch-table"))
(when unknown-keys
(warn (format nil
"found unkown keys in dispatch-table table: ~s"
unknown-keys)))
(when (null (getf table :redirect))
(warn "No dispatch for redirect found"))
(when (null (getf table :certificate-requested))
(warn "No dispatch for certificate request"))
(when (null (getf table :success))
(warn "No dispatch for success found"))
(when (null (getf table :input-requested))
(warn "No dispatch for input request"))
(when (null (getf table :sensitive-input-requested))
(warn "No dispatch for sensitive-input request")))
`(let ((dispatch-table (list ,@table)))
,@body)))
(defun gemini-file-stream-p (meta)
(gemini-client:mime-gemini-p meta))