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

- fixed gopher URI parser.

This commit is contained in:
cage 2022-10-09 13:23:32 +02:00
parent 6c3874f738
commit a429fe48f2
2 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/init.lisp
View File

@ -264,7 +264,7 @@
(define-key "I" #'print-post-id *thread-keymap*)
(define-key "s d" #'status-tree->text *thread-keymap*)
(define-key "s d" #'status-tree->text *thread-keymap*)
(define-key "up" #'thread-go-up *thread-keymap*)

30
src/gopher/parser.lisp
View File

@ -316,16 +316,25 @@
(defun parse-text-file (data)
(parse 'text-file data))
(defrule gopher-url-authority (or (and (+ (not #\:))
#\:
(+ (not #\/))
#\/)
(and (+ (not #\/))
#\/))
(:function (lambda (a)
(let* ((host-port a)
(host (coerce (first host-port) 'string))
(port (if (third host-port)
(parse-integer (coerce (third host-port) 'string))
70)))
(list host port)))))
(defrule gopher-url (and (+ (not #\:))
"://"
(or (and (+ (not #\:))
#\:
(+ (not #\/))
#\/)
(and (+ (not #\/))
#\/))
(? (and (+ (not #\/))
#\/))
gopher-url-authority
(? (and (not #\/)
(& #\/)))
(* (character-ranges (#\u0000 #\uffff))))
(:function (lambda (a)
(let* ((host-port (third a))
@ -335,9 +344,12 @@
70))
(type-path (fourth a))
(type (if (car type-path)
(coerce (car type-path) 'string)
(string (car 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)))))
(defun parse-iri (iri)