Really fix semicolons in URL

This commit is contained in:
Cadence Ember 2023-04-17 00:46:15 +12:00
parent 040d9b94de
commit a1bba22054
Signed by: cadence
GPG Key ID: BC1C2C61CF521B17
1 changed files with 37 additions and 20 deletions

View File

@ -35,23 +35,40 @@
(define (make-dispatcher-tree ds)
(define subdomain-dispatcher (hash-ref ds 'subdomain-dispatcher))
(sequencer:make
subdomain-dispatcher
(pathprocedure:make "/" (hash-ref ds 'page-home))
(pathprocedure:make "/proxy" (hash-ref ds 'page-proxy))
(pathprocedure:make "/search" (hash-ref ds 'page-global-search))
(pathprocedure:make "/set-user-settings" (hash-ref ds 'page-set-user-settings))
(pathprocedure:make "/buddyfight/wiki/It_Doesn't_Work!!" (hash-ref ds 'page-it-works))
(filter:make (pregexp (format "^/~a/wiki/Category:.+$" px-wikiname)) (lift:make (hash-ref ds 'page-category)))
(filter:make (pregexp (format "^/~a/wiki/File:.+$" px-wikiname)) (lift:make (hash-ref ds 'page-file)))
(if (config-true? 'feature_offline::enabled)
(filter:make (pregexp (format "^/~a/wiki/.+$" px-wikiname)) (lift:make (hash-ref ds 'page-wiki-offline)))
(λ (_conn _req) (next-dispatcher)))
(filter:make (pregexp (format "^/~a/wiki/.+$" px-wikiname)) (lift:make (hash-ref ds 'page-wiki)))
(filter:make (pregexp (format "^/~a/search$" px-wikiname)) (lift:make (hash-ref ds 'page-search)))
(filter:make (pregexp (format "^/~a(/(wiki(/)?)?)?$" px-wikiname)) (lift:make (hash-ref ds 'redirect-wiki-home)))
(if (config-true? 'feature_offline::enabled)
(filter:make (pregexp (format "^/archive/~a/(styles|images)/.+$" px-wikiname)) (lift:make (hash-ref ds 'page-static-archive)))
(λ (_conn _req) (next-dispatcher)))
(hash-ref ds 'static-dispatcher)
(lift:make (hash-ref ds 'page-not-found))))
(define tree
(sequencer:make
subdomain-dispatcher
(pathprocedure:make "/" (hash-ref ds 'page-home))
(pathprocedure:make "/proxy" (hash-ref ds 'page-proxy))
(pathprocedure:make "/search" (hash-ref ds 'page-global-search))
(pathprocedure:make "/set-user-settings" (hash-ref ds 'page-set-user-settings))
(pathprocedure:make "/buddyfight/wiki/It_Doesn't_Work!!" (hash-ref ds 'page-it-works))
(filter:make (pregexp (format "^/~a/wiki/Category:.+$" px-wikiname)) (lift:make (hash-ref ds 'page-category)))
(filter:make (pregexp (format "^/~a/wiki/File:.+$" px-wikiname)) (lift:make (hash-ref ds 'page-file)))
(if (config-true? 'feature_offline::enabled)
(filter:make (pregexp (format "^/~a/wiki/.+$" px-wikiname)) (lift:make (hash-ref ds 'page-wiki-offline)))
(λ (_conn _req) (next-dispatcher)))
(filter:make (pregexp (format "^/~a/wiki/.+$" px-wikiname)) (lift:make (hash-ref ds 'page-wiki)))
(filter:make (pregexp (format "^/~a/search$" px-wikiname)) (lift:make (hash-ref ds 'page-search)))
(filter:make (pregexp (format "^/~a(/(wiki(/)?)?)?$" px-wikiname)) (lift:make (hash-ref ds 'redirect-wiki-home)))
(if (config-true? 'feature_offline::enabled)
(filter:make (pregexp (format "^/archive/~a/(styles|images)/.+$" px-wikiname)) (lift:make (hash-ref ds 'page-static-archive)))
(λ (_conn _req) (next-dispatcher)))
(hash-ref ds 'static-dispatcher)
(lift:make (hash-ref ds 'page-not-found))))
(make-semicolon-fixer-dispatcher tree))
(define ((make-semicolon-fixer-dispatcher orig-dispatcher) conn orig-req)
(define orig-uri (request-uri orig-req))
(define pps (url-path orig-uri)) ; list of path/param structs
(define new-path
(for/list ([pp pps])
(if (null? (path/param-param pp))
pp
;; path/param does have params, which need to be fixed into a semicolon.
(path/param
(string-append (path/param-path pp) ";" (string-join (path/param-param pp) ";"))
null))))
(define new-uri (struct-copy url orig-uri [path new-path]))
(define new-req (struct-copy request orig-req [uri new-uri]))
(orig-dispatcher conn new-req))