Really fix semicolons in URL
This commit is contained in:
parent
040d9b94de
commit
a1bba22054
1 changed files with 37 additions and 20 deletions
|
@ -35,6 +35,7 @@
|
||||||
|
|
||||||
(define (make-dispatcher-tree ds)
|
(define (make-dispatcher-tree ds)
|
||||||
(define subdomain-dispatcher (hash-ref ds 'subdomain-dispatcher))
|
(define subdomain-dispatcher (hash-ref ds 'subdomain-dispatcher))
|
||||||
|
(define tree
|
||||||
(sequencer:make
|
(sequencer:make
|
||||||
subdomain-dispatcher
|
subdomain-dispatcher
|
||||||
(pathprocedure:make "/" (hash-ref ds 'page-home))
|
(pathprocedure:make "/" (hash-ref ds 'page-home))
|
||||||
|
@ -55,3 +56,19 @@
|
||||||
(λ (_conn _req) (next-dispatcher)))
|
(λ (_conn _req) (next-dispatcher)))
|
||||||
(hash-ref ds 'static-dispatcher)
|
(hash-ref ds 'static-dispatcher)
|
||||||
(lift:make (hash-ref ds 'page-not-found))))
|
(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))
|
||||||
|
|
Loading…
Reference in a new issue