Fix crunching of mirrored filenames

Previously, a “!” was enough to throw off the
crunching; that’s fixed now! Huzzah!
This commit is contained in:
Jaidyn Ann 2024-05-29 21:54:38 -05:00
parent 55362c7075
commit 93022814fd
2 changed files with 24 additions and 4 deletions

View File

@ -89,13 +89,12 @@ among the given tags."
"Given a URL, return the corresponding path we would download it to, were we "Given a URL, return the corresponding path we would download it to, were we
to mirror it." to mirror it."
(let* ((url (quri:uri url)) (let* ((url (quri:uri url))
(path (quri:uri-path url))) (path (uri-path+query url)))
(pathname (pathname
(format nil "~@[~A/~]~A/~A~@[.~A~]" (format nil "~@[~A/~]~A/~A"
base-dir base-dir
(quri:uri-host url) (quri:uri-host url)
(pathname-name path) (pathname-leaf path)))))
(pathname-type path)))))
@ -183,3 +182,9 @@ That is, 443 is implied by HTTPS, so nil is returned; but 998 wouldnt be impl
(defun uri-path+query (uri) (defun uri-path+query (uri)
"Return everything in a URI after the TLD — that is, both the path _and_ the query." "Return everything in a URI after the TLD — that is, both the path _and_ the query."
(format nil "~A~@[?~A~]" (quri:uri-path uri) (quri:uri-query uri))) (format nil "~A~@[?~A~]" (quri:uri-path uri) (quri:uri-query uri)))
;; pathname → string
(defun pathname-leaf (pathname)
"Given a pathname, return the entirety of the file leaf.
That is, everything following the last directory name."
(car (last (cl-strings:split (namestring pathname) #\/))))

View File

@ -70,6 +70,12 @@
(mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt" (mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt"
:base-dir #p"base/"))) :base-dir #p"base/")))
(define-test mirrored-pathname.esperanto-question (:tags '(base))
(assert-equal
#p"base/invalid.tld/?!?! ĉu ne?!?!.png"
(mirror-img::mirrored-pathname "https://invalid.tld/dir/s/d/ askldjas/ asldkja/?!?! ĉu ne?!?!.png"
:base-dir #p"base/")))
(define-test linked-urls (:tags '(dom)) (define-test linked-urls (:tags '(dom))
(assert-equal (assert-equal
'("http://localhost:4242/res/img/b/fireplace.jpg" '("http://localhost:4242/res/img/b/fireplace.jpg"
@ -119,3 +125,12 @@
nil nil
(mirror-img::uri-explicit-port (quri:uri "https://xwx.moe:443/bird.png")))) (mirror-img::uri-explicit-port (quri:uri "https://xwx.moe:443/bird.png"))))
(define-test pathname-leaf.simple (:tags '(util))
(assert-equal
"apple_berries.png"
(mirror-img::pathname-leaf #p"/mom/dad/apple/laksdjal/apple_berries.png")))
(define-test pathname-leaf.very-weird (:tags '(util))
(assert-equal
" lak -!?ĉ_berries.png"
(mirror-img::pathname-leaf #p"/mom/dad?!?Ljla asdasd'' aslkdjĉ/apple/laksdjal/ lak -!?ĉ_berries.png")))