Provide default values if the CGI script fails to provide status or
content-type.
This commit is contained in:
parent
022ea25ba6
commit
615886e492
|
@ -240,8 +240,14 @@
|
|||
(let* ((headers (read-rfc822-headers script-port))
|
||||
(ctype (get-header headers 'content-type))
|
||||
(loc (get-header headers 'location))
|
||||
(stat (extract-status-code-and-text (get-header headers 'status)
|
||||
req))
|
||||
(stat (cond ((get-header headers 'status)
|
||||
=> (lambda (code.text)
|
||||
(extract-status-code-and-text code.text
|
||||
req)))
|
||||
(else
|
||||
(http-syslog (syslog-level notice)
|
||||
"CGI script didn't generate status header.")
|
||||
200)))
|
||||
(extra-headers (delete-headers (delete-headers (delete-headers headers
|
||||
'content-type)
|
||||
'location)
|
||||
|
@ -261,7 +267,7 @@
|
|||
(number->status-code (car stat))
|
||||
(cdr stat) ; text
|
||||
(time)
|
||||
ctype
|
||||
(or ctype "text/html")
|
||||
extra-headers
|
||||
(make-writer-body
|
||||
(lambda (out options)
|
||||
|
@ -271,11 +277,7 @@
|
|||
(define (get-header headers tag)
|
||||
(cond
|
||||
((assq tag headers) => cdr)
|
||||
(else
|
||||
(http-error (status-code bad-gateway) #f
|
||||
(string-append "CGI script didn't generate "
|
||||
(symbol->string tag)
|
||||
" header")))))
|
||||
(else #f)))
|
||||
|
||||
(define (delete-headers headers tag)
|
||||
(alist-delete tag headers))
|
||||
|
|
Loading…
Reference in New Issue