forked from cadence/breezewiki
		
	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…
	
	Add table
		Add a link
		
	
		Reference in a new issue