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

+catch calls of make-error-response with too few arguments

This commit is contained in:
vibr 2004-08-10 14:26:50 +00:00
parent 4b37826de8
commit a3dd880c7a
1 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scheme/httpd/response.scm
View File

@ -146,14 +146,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; As a special case, request REQ is allowed to be #f, meaning we haven't ;;; As a special case, request REQ is allowed to be #f, meaning we haven't
;;; even had a chance to parse and construct the request. This is only used ;;; even had a chance to parse and construct the request. This can be the case for
;;; for 400 BAD-REQUEST error report. ;;; internal-error, bad-request, (possibly bad-gateway and ...?)
(define (make-error-response code req . extras) (define (make-error-response code req . extras)
(let* (let*
((generic-title (lambda (port) ;;catch server internal errors coming off by calls of make-error-response with too few arguments
((assert (lambda (n)
(if (< (length extras) n)
(make-error-response (status-code internal-error) req
"Too few arguments to make-error-response"))))
(generic-title (lambda (port)
(title-html port (title-html port
(status-code-message code)))) (status-code-message code))))
(close-html (lambda (port args) (close-html (lambda (port args)
@ -179,6 +183,7 @@
(eq? code (status-code see-other));303 (eq? code (status-code see-other));303
(eq? code (status-code temp-redirect));307 (eq? code (status-code temp-redirect));307
(eq? code (status-code moved-perm)));301 (eq? code (status-code moved-perm)));301
(assert 1)
(create-response (create-response
(list (cons 'location (car extras))) (list (cons 'location (car extras)))
(lambda (port options) (lambda (port options)
@ -204,6 +209,7 @@
;; the second one is 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)
(create-response (create-response
(list (cons 'allow (cadr extras))) (list (cons 'allow (cadr extras)))
(lambda (port options) (lambda (port options)
@ -215,6 +221,7 @@
;; the value of the WWW-Authenticate header field, ;; the value of the WWW-Authenticate header field,
;; which must be a challenge (as described in RFC 2617) ;; which must be a challenge (as described in RFC 2617)
((eq? code (status-code unauthorized)) ((eq? code (status-code unauthorized))
(assert 1)
(create-response (create-response
(list (cons 'WWW-Authenticate (car extras))) (list (cons 'WWW-Authenticate (car extras)))
(lambda (port options) (lambda (port options)
@ -251,6 +258,7 @@
;; This error response requires one arg: ;; This error response requires one arg:
;; the unimplemented method ;; 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)