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

- fixed gopher URL parser.

This commit is contained in:
cage 2024-10-13 14:58:07 +02:00
parent ce9aa8e47a
commit f8f05a49ab
1 changed files with 29 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/gopher/parser.lisp
View File

@ -275,6 +275,25 @@
(defrule gopher-menu (and (* gopher-dir-entity) (? gopher-last-line)) (defrule gopher-menu (and (* gopher-dir-entity) (? gopher-last-line))
(:function first)) (: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) (defun parse-menu (data)
(let ((menu (parse 'gopher-menu data))) (let ((menu (parse 'gopher-menu data)))
(loop for entry in menu (loop for entry in menu
@ -349,11 +368,10 @@
(list host port))))) (list host port)))))
(defrule gopher-gopher-url (and (+ (not #\:)) (defrule gopher-gopher-url (and (+ (not #\:))
"://" "://"
gopher-gopher-url-authority gopher-gopher-url-authority
(? (and (not #\/) (? (character-ranges (#\u0000 #\uffff)))
(& #\/))) (* (character-ranges (#\u0000 #\uffff))))
(* (character-ranges (#\u0000 #\uffff))))
(:function (lambda (a) (:function (lambda (a)
(let* ((host-port (third a)) (let* ((host-port (third a))
(host (coerce (first host-port) 'string)) (host (coerce (first host-port) 'string))
@ -361,14 +379,14 @@
(parse-integer (coerce (third host-port) 'string)) (parse-integer (coerce (third host-port) 'string))
70)) 70))
(type-path (fourth a)) (type-path (fourth a))
(type (if (car type-path) (type (if type-path
(string (car type-path)) type-path
+line-type-dir+)) +line-type-dir+))
(path (coerce (fifth a) 'string))) (path (coerce (fifth a) 'string)))
(when (and (string-not-empty-p path) (list host
(not (car type-path))) port
(setf path (strcat "/" path))) (percent-decode path)
(list host port path type))))) (string type))))))
(defun parse-iri (iri) (defun parse-iri (iri)
(let* ((parsed (parse 'gopher-gopher-url iri)) (let* ((parsed (parse 'gopher-gopher-url iri))