scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

make-error-response: 

use stuff in req where req isn't #f
This commit is contained in:
vibr 2004-08-11 10:17:14 +00:00
parent 2ee378aea9
commit f22f43ccd1
1 changed files with 11 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
scheme/httpd/response.scm
View File

@ -189,7 +189,7 @@
(lambda (port options) (lambda (port options)
(title-html port "Document moved") (title-html port "Document moved")
(format port (format port
"This document has ~A moved to a <a href=\"~A\">new location</a>.~%" "The requested resource has moved ~A to a <a href=\"~A\">new location</a>.~%"
(if (eq? code (status-code moved-perm)) (if (eq? code (status-code moved-perm))
"permanently" "permanently"
"temporarily") "temporarily")
@ -204,18 +204,17 @@
(write-string "The request the client sent could not be understood by this server due to malformed syntax.\n Report to client maintainer.\n" port) (write-string "The request the client sent could not be understood by this server due to malformed syntax.\n Report to client maintainer.\n" port)
(close-html port extras)))) (close-html port extras))))
;; This error response requires two args: ;; This error response requires one arg:
;; the first one is the disallowed method; ;; the value of the Allow field header,
;; the second one is the value of the Allow field header,
;; which must be a list of valid methods for the requested resource ;; which must be a list of valid methods for the requested resource
((eq? code (status-code method-not-allowed)) ((eq? code (status-code method-not-allowed))
(assert 2) (assert 1)
(create-response (create-response
(list (cons 'allow (cadr extras))) (list (cons 'allow (car extras)))
(lambda (port options) (lambda (port options)
(generic-title port) (generic-title port)
(format port "The method ~A is not allowed on the requested resource.~%" (car extras)) (format port "The method ~A is not allowed on the requested resource ~A.~%" (request-method req) (request-uri req))
(close-html port (cddr extras))))) (close-html port (cdr extras)))))
;; This error response requires one arg: ;; This error response requires one arg:
;; the value of the WWW-Authenticate header field, ;; the value of the WWW-Authenticate header field,
@ -234,7 +233,7 @@
'() '()
(lambda (port options) (lambda (port options)
(title-html port "Request not allowed.") (title-html port "Request not allowed.")
(write-string "The request the client sent is not allowed.\n" port) (write-string "The request the client sent is not allowed.\n Retrying won't help.\n" port)
(close-html port extras)))) (close-html port extras))))
((eq? code (status-code not-found)) ((eq? code (status-code not-found))
@ -242,7 +241,7 @@
'() '()
(lambda (port options) (lambda (port options)
(title-html port "Resource not found") (title-html port "Resource not found")
(write-string "The requested resource was not found on this server.\n" port) (format port "The requested resource ~A was not found on this server.\n" (request-uri req))
(close-html port extras)))) (close-html port extras))))
((eq? code (status-code internal-error)) ((eq? code (status-code internal-error))
@ -255,17 +254,14 @@
"[no mail address available]")) "[no mail address available]"))
(close-html port extras)))) (close-html port extras))))
;; This error response requires one arg:
;; the unimplemented method
((eq? code (status-code not-implemented)) ((eq? code (status-code not-implemented))
(assert 1)
(create-response (create-response
'() '()
(lambda (port options) (lambda (port options)
(generic-title port) (generic-title port)
(format port "This server does not recognize or does not implement the requested method \"~A\".~%" (format port "This server does not recognize or does not implement the requested method \"~A\".~%"
(car extras)) (request-method req))
(close-html port (cdr extras))))) (close-html port extras))))
((eq? code (status-code bad-gateway)) ((eq? code (status-code bad-gateway))
(create-response (create-response