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