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

- [TITAN] prevented dropping of query component. 

After discussing on IRC (thanks!) i think is legit (according to the
  specification) to have URL like that:

  titan://invalid/path/to/script;mime=text/plain;size=1;token=foo?query=bar
This commit is contained in:
cage 2023-08-04 13:58:57 +02:00
parent a7c4e36f09
commit 888a361d86
6 changed files with 56 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/gemini-viewer.lisp
View File

@ -749,8 +749,12 @@
:certificate-key cached-key
:certificate cached-certificate)))
(titan-upload-dispatch (url)
(declare (ignore url))
(values titan-data titan-size titan-mime titan-token)))
(let ((parsed (iri:iri-parse url)))
(values (gemini-client::remove-titan-parameters-from-path (uri:path parsed))
titan-data
titan-size
titan-mime
titan-token))))
(handler-case
(gemini-client:with-request-dispatch-table ((:certificate-requested
#'certificate-request-dispatch

12
src/gemini/client.lisp
View File

@ -476,7 +476,7 @@
"received an unknown response from server ~s ~a ~s ~s"
iri status code-description meta))))
(defun start-titan-request (url data mime-type size token &key (certificate nil) (certificate-key nil))
(defun start-titan-request (url no-parameters-path data mime-type size token &key (certificate nil) (certificate-key nil))
(multiple-value-bind (actual-iri host path query port)
(displace-iri (iri:iri-parse url))
(declare (ignore actual-iri))
@ -484,27 +484,28 @@
((and mime-type size)
(multiple-value-bind (status description meta response socket)
(gemini-client:titan-request host
path
no-parameters-path
mime-type
size
token
data
:query query
:port port
:certificate-key certificate-key
:client-certificate certificate)
(close-ssl-socket socket)
(values status description meta response socket)))
((null mime-type)
(error "mime type not present in ~a" query))
(error "mime type not present in ~a" path))
((null size)
(error "mime type not present or invalid in ~a" query)))))
(error "mime type not present or invalid in ~a" path)))))
(defun request-dispatch (url manage-functions
&key
(certificate nil)
(certificate-key nil))
(flet ((make-titan-request ()
(multiple-value-bind (titan-data size mime token)
(multiple-value-bind (no-parameters-path titan-data size mime token)
(funcall (getf manage-functions :titan-upload
(lambda (url)
(declare (ignore url))
@ -514,6 +515,7 @@
"No function to get titan data provided"))))
url)
(start-titan-request url
no-parameters-path
titan-data
mime
size

4
src/gemini/package.lisp
View File

@ -190,8 +190,8 @@
:debug-gemini
:open-tls-socket
:request
:make-titan-query
:parse-titan-query
:make-titan-parameters
:parse-titan-parameters
:titan-request
:gemini-file-stream-p
:text-file-stream-p

25
src/gemini/titan.lisp
View File

@ -30,14 +30,20 @@
(define-constant +titan-records-separator+ ";" :test #'string=)
(defun make-titan-query (mime-type size token)
(defun make-titan-parameters (mime-type size token)
(format nil
";~a~a~a~a~a~a~a~3*~@[~3:*~a~a~a~a~]"
+titan-mime-key+ +titan-field-separator+ mime-type +titan-records-separator+
+titan-size-key+ +titan-field-separator+ size +titan-records-separator+
+titan-token-key+ +titan-field-separator+ token))
(defun parse-titan-query (query)
(defun remove-titan-parameters-from-path (path)
(subseq path
0
(position +titan-records-separator+ path
:test (lambda (item char) (char= (first-elt item) char)))))
(defun parse-titan-parameters (path)
(flet ((get-value (key)
(multiple-value-bind (matchedp registers)
(scan-to-strings (format nil
@ -46,19 +52,21 @@
+titan-field-separator+
+titan-records-separator+
+titan-records-separator+)
query)
path)
(when matchedp
(first-elt registers)))))
(let ((raw-size (get-value +titan-size-key+)))
(values (get-value +titan-mime-key+)
(values (remove-titan-parameters-from-path path)
(get-value +titan-mime-key+)
(parse-integer raw-size)
(get-value +titan-token-key+)))))
(defgeneric titan-request (host path mime-type size token data
&key port fragment client-certificate certificate-key))
&key query port fragment client-certificate certificate-key))
(defmethod titan-request (host path mime-type (size integer) token (data string)
&key
(query nil)
(port +gemini-default-port+)
(fragment nil)
(client-certificate nil)
@ -70,6 +78,7 @@
size
token
stream
:query query
:port port
:fragment fragment
:client-certificate client-certificate
@ -77,6 +86,7 @@
(defmethod titan-request (host path mime-type (size integer) token (data pathname)
&key
(query nil)
(port +gemini-default-port+)
(fragment nil)
(client-certificate nil)
@ -92,6 +102,7 @@
size
token
stream
:query query
:port port
:fragment fragment
:client-certificate client-certificate
@ -99,15 +110,17 @@
(defmethod titan-request (host path mime-type (size integer) token (data stream)
&key
(query nil)
(port +gemini-default-port+)
(fragment nil)
(client-certificate nil)
(certificate-key nil))
(let* ((iri (make-gemini-iri (idn:host-unicode->ascii host)
(strcat (percent-encode-path path)
(make-titan-query mime-type
(make-titan-parameters mime-type
size
token))
:query query
:scheme +titan-scheme+
:port port
:fragment (percent-encode-fragment fragment)))

4
src/gui/client/titan-window.lisp
View File

@ -76,8 +76,8 @@
size (length trimmed-data-text)
titan-data trimmed-data-text)))
(when (not has-error-p)
(let ((query (gemini-client:make-titan-query mime size (gui:text token-entry))))
(setf (uri:query url) query)
(let ((parameters (gemini-client:make-titan-parameters mime size (gui:text token-entry))))
(setf (uri:path url) (strcat (uri:path url) parameters))
(ev:with-enqueued-process-and-unblock ()
(gui-goodies::with-notify-errors
(gui-goodies:with-busy* (frame)

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

@ -215,12 +215,12 @@
:certificate-key cached-key
:certificate cached-certificate)))
(titan-upload-dispatch (url)
(multiple-value-bind (mime size token)
(gemini-client::parse-titan-query (uri:query (iri:iri-parse url)))
(multiple-value-bind (no-parameters-path mime size token)
(gemini-client::parse-titan-parameters (uri:path (iri:iri-parse url)))
(let ((actual-data (if (fs:file-exists-p titan-data)
(fs:namestring->pathname titan-data)
titan-data)))
(values actual-data size mime token)))))
(values no-parameters-path actual-data size mime token)))))
(handler-case
(gemini-client:with-request-dispatch-table ((:certificate-requested
#'certificate-request-dispatch