-adapt calls of make-error-response
-allow header in 405 answers -answer 501, not 405, for unimplemented/unrecognized methods
This commit is contained in:
		
							parent
							
								
									5f64e72cd0
								
							
						
					
					
						commit
						880a05229c
					
				|  | @ -259,9 +259,11 @@ | |||
| 
 | ||||
| 	      (else (make-error-response (status-code forbidden) req))))) | ||||
| 	  | ||||
| 	 (else  | ||||
| 	 ((string=? request-method "POST") | ||||
| 	  (make-error-response (status-code method-not-allowed) req  | ||||
| 			       request-method)))))) | ||||
| 			        "GET, HEAD")) | ||||
| 	 (else  | ||||
| 	  (make-error-response (status-code not-implemented) req)))))) | ||||
| 
 | ||||
| (define (directory-index-serve-response fname file-path req options) | ||||
|   (file-serve-response (string-append fname "index.html") file-path req options)) | ||||
|  | @ -445,9 +447,12 @@ | |||
| 			(let ((n-files (directory-index req fname port options))) | ||||
| 			  (emit-tag port 'hr) | ||||
| 			  (format port "~d files" n-files)))))))))))) | ||||
|      (else | ||||
|       (make-error-response (status-code method-not-allowed) req  | ||||
| 			   request-method))))) | ||||
| 	  | ||||
| 	 ((string=? request-method "POST") | ||||
| 	  (make-error-response (status-code method-not-allowed) req  | ||||
| 			       "GET, HEAD")) | ||||
| 	 (else  | ||||
| 	  (make-error-response (status-code not-implemented) req))))) | ||||
| 
 | ||||
| (define (index-or-directory-serve-response fname file-path req options) | ||||
|   (let ((index-fname (string-append fname "index.html"))) | ||||
|  |  | |||
|  | @ -172,10 +172,12 @@ | |||
| 			       out)) | ||||
| 	       (with-tag out address () | ||||
| 		 (write-string address out))))))) | ||||
| 
 | ||||
| 	 (else  | ||||
| 	 ((or (string=? request-method "HEAD") | ||||
| 	      (string=? request-method "POST")) | ||||
| 	  (make-error-response (status-code method-not-allowed) req  | ||||
| 				    request-method))))))) | ||||
| 				    "GET")) | ||||
| 	 (else | ||||
| 	  (make-error-response (status-code not-implemented) req))))))) | ||||
| 
 | ||||
| (define split-header-line | ||||
|   (let ((split (infix-splitter (make-regexp "(, *)|(  +)|( *\t *)"))) | ||||
|  |  | |||
|  | @ -70,9 +70,13 @@ | |||
| 	        | ||||
| 	       (with-tag out address () | ||||
| 		 (display address out))))))) | ||||
| 	 (else  | ||||
| 	 ((or (string=? request-method "HEAD") | ||||
| 	      (string=? request-method "POST")) | ||||
| 	  (make-error-response (status-code method-not-allowed) req  | ||||
| 				    request-method))))))) | ||||
| 			       "GET")) | ||||
| 	 (else | ||||
| 	  (make-error-response (status-code not-implemented) req))))))) | ||||
| 
 | ||||
| 
 | ||||
| (define (cat-man-page key section out) | ||||
|   (let ((title (if section | ||||
|  |  | |||
|  | @ -38,8 +38,13 @@ | |||
|     (cond  | ||||
|      ((string=? request-method "POST")	; Could do others also. | ||||
|       (seval path req)) | ||||
|      ((or (string=? request-method "HEAD") | ||||
| 	  (string=? request-method "GET")) | ||||
|       (make-error-response (status-code method-not-allowed) req  | ||||
| 				    "POST")) | ||||
|      (else | ||||
|       (make-error-response (status-code method-not-allowed) req request-method))))) | ||||
|       (make-error-response (status-code not-implemented) req))))) | ||||
| 
 | ||||
| 
 | ||||
| (define (seval path req) | ||||
|     (make-response | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	 vibr
						vibr