cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-03-11 11:10:43 +01:00
Code Issues

- fixed gopher URL parser.

Browse Source
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

40
src/gopher/parser.lisp

@ -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))