adapt make-error-response:
- no URI header field in 1.1 - new 30x status codes in 1.1
This commit is contained in:
		
							parent
							
								
									1b4bdb59c6
								
							
						
					
					
						commit
						5e14a326b9
					
				| 
						 | 
				
			
			@ -173,20 +173,22 @@
 | 
			
		|||
			   (make-writer-body writer-proc)))))
 | 
			
		||||
 | 
			
		||||
    (cond
 | 
			
		||||
     ;; This error response requires two args: message is the new URI: field,
 | 
			
		||||
     ;; and the first EXTRA is the older Location: field.
 | 
			
		||||
     ((or (eq? code (status-code moved-temp))
 | 
			
		||||
	  (eq? code (status-code moved-perm)))
 | 
			
		||||
     ;; This error response requires one arg:
 | 
			
		||||
     ;; message is the Location field. 
 | 
			
		||||
     ;; the Location field's field value must be a single absolute URI
 | 
			
		||||
     ((or (eq? code (status-code found));302
 | 
			
		||||
	  (eq? code (status-code see-other));303
 | 
			
		||||
	  (eq? code (status-code temp-redirect));307
 | 
			
		||||
	  (eq? code (status-code moved-perm)));301
 | 
			
		||||
      (create-response
 | 
			
		||||
       (list (cons 'uri message)
 | 
			
		||||
	     (cons 'location (car extras)))
 | 
			
		||||
       (list (cons 'location message))
 | 
			
		||||
       (lambda (port options)
 | 
			
		||||
	 (title-html port "Document moved")
 | 
			
		||||
	 (format port
 | 
			
		||||
		 "This document has ~A moved to a <A HREF=\"~A\">new location</A>.~%"
 | 
			
		||||
		 (if (eq? code (status-code moved-temp))
 | 
			
		||||
		     "temporarily"
 | 
			
		||||
		     "permanently")
 | 
			
		||||
		 (if (eq? code (status-code moved-perm))
 | 
			
		||||
		     "permanently"
 | 
			
		||||
		     "temporarily")
 | 
			
		||||
		 message)
 | 
			
		||||
	 (close-html port))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -290,7 +292,7 @@ response of a gateway.~%")
 | 
			
		|||
;; the browser won't notice the redirect. Thus, it will keep the
 | 
			
		||||
;; original URL. For "real" redirections, use 
 | 
			
		||||
;; (make-error-response (status-code moved-perm) req 
 | 
			
		||||
;;                      "new-location" "new-location").
 | 
			
		||||
;;                      "new-location").
 | 
			
		||||
(define (make-redirect-response new-location)
 | 
			
		||||
  (make-response
 | 
			
		||||
   (status-code redirect)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue