mirror of
https://codeberg.org/cage/tinmop/
synced 2025-03-04 10:07:38 +01:00
- fixed gopher URL parser.
This commit is contained in:
parent
ce9aa8e47a
commit
f8f05a49ab
@ -275,6 +275,25 @@
|
||||
(defrule gopher-menu (and (* gopher-dir-entity) (? gopher-last-line))
|
||||
(:function first))
|
||||
|
||||
(defun has-line-type-p (data)
|
||||
(or (%line-type-file-p data)
|
||||
(%line-type-dir-p data)
|
||||
(%line-type-cso-p data)
|
||||
(%line-type-error-p data)
|
||||
(%line-type-mac-hex-file-p data)
|
||||
(%line-type-dos-archive-file-p data)
|
||||
(%line-type-uuencoded-file-p data)
|
||||
(%line-type-index-search-p data)
|
||||
(%line-type-telnet-session-p data)
|
||||
(%line-type-binary-file-p data)
|
||||
(%line-type-redundant-server-p data)
|
||||
(%line-type-tn3270-session-p data)
|
||||
(%line-type-gif-file-p data)
|
||||
(%line-type-image-file-p data)
|
||||
(%line-type-info-p data)
|
||||
(%line-type-uri-p data)
|
||||
(%line-type-empty-p data)))
|
||||
|
||||
(defun parse-menu (data)
|
||||
(let ((menu (parse 'gopher-menu data)))
|
||||
(loop for entry in menu
|
||||
@ -349,11 +368,10 @@
|
||||
(list host port)))))
|
||||
|
||||
(defrule gopher-gopher-url (and (+ (not #\:))
|
||||
"://"
|
||||
gopher-gopher-url-authority
|
||||
(? (and (not #\/)
|
||||
(& #\/)))
|
||||
(* (character-ranges (#\u0000 #\uffff))))
|
||||
"://"
|
||||
gopher-gopher-url-authority
|
||||
(? (character-ranges (#\u0000 #\uffff)))
|
||||
(* (character-ranges (#\u0000 #\uffff))))
|
||||
(:function (lambda (a)
|
||||
(let* ((host-port (third a))
|
||||
(host (coerce (first host-port) 'string))
|
||||
@ -361,14 +379,14 @@
|
||||
(parse-integer (coerce (third host-port) 'string))
|
||||
70))
|
||||
(type-path (fourth a))
|
||||
(type (if (car type-path)
|
||||
(string (car type-path))
|
||||
(type (if type-path
|
||||
type-path
|
||||
+line-type-dir+))
|
||||
(path (coerce (fifth a) 'string)))
|
||||
(when (and (string-not-empty-p path)
|
||||
(not (car type-path)))
|
||||
(setf path (strcat "/" path)))
|
||||
(list host port path type)))))
|
||||
(list host
|
||||
port
|
||||
(percent-decode path)
|
||||
(string type))))))
|
||||
|
||||
(defun parse-iri (iri)
|
||||
(let* ((parsed (parse 'gopher-gopher-url iri))
|
||||
|
Loading…
x
Reference in New Issue
Block a user