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

Provide default values if the CGI script fails to provide status or 

content-type.
This commit is contained in:
mainzelm 2003-01-28 15:20:36 +00:00
parent 022ea25ba6
commit 615886e492
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
scheme/httpd/cgi-server.scm
View File

@ -240,9 +240,15 @@
(let* ((headers (read-rfc822-headers script-port)) (let* ((headers (read-rfc822-headers script-port))
(ctype (get-header headers 'content-type)) (ctype (get-header headers 'content-type))
(loc (get-header headers 'location)) (loc (get-header headers 'location))
(stat (extract-status-code-and-text (get-header headers 'status) (stat (cond ((get-header headers 'status)
req)) => (lambda (code.text)
(extra-headers (delete-headers (delete-headers (delete-headers headers (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) 'content-type)
'location) 'location)
'status))) 'status)))
@ -261,7 +267,7 @@
(number->status-code (car stat)) (number->status-code (car stat))
(cdr stat) ; text (cdr stat) ; text
(time) (time)
ctype (or ctype "text/html")
extra-headers extra-headers
(make-writer-body (make-writer-body
(lambda (out options) (lambda (out options)
@ -271,11 +277,7 @@
(define (get-header headers tag) (define (get-header headers tag)
(cond (cond
((assq tag headers) => cdr) ((assq tag headers) => cdr)
(else (else #f)))
(http-error (status-code bad-gateway) #f
(string-append "CGI script didn't generate "
(symbol->string tag)
" header")))))
(define (delete-headers headers tag) (define (delete-headers headers tag)
(alist-delete tag headers)) (alist-delete tag headers))