factor out GET-HEADER

This commit is contained in:
interp 2003-02-19 17:05:16 +00:00
parent a1f3d72ce8
commit da98c4b78c
6 changed files with 11 additions and 15 deletions

View File

@ -274,11 +274,6 @@
(copy-inport->outport script-port out) (copy-inport->outport script-port out)
(close-input-port script-port))))))) (close-input-port script-port)))))))
(define (get-header headers tag)
(cond
((assq tag headers) => cdr)
(else #f)))
(define (delete-headers headers tag) (define (delete-headers headers tag)
(alist-delete tag headers)) (alist-delete tag headers))

View File

@ -104,7 +104,3 @@
(read (make-string-input-port s))))) (read (make-string-input-port s)))))
(else (error "No `Content-length:' field in POST request.")))) (else (error "No `Content-length:' field in POST request."))))
(define (get-header headers tag)
(cond
((assq tag headers) => cdr)
(else #f)))

View File

@ -207,6 +207,7 @@
locks locks
let-opt ;:OPTIONAL let-opt ;:OPTIONAL
handle-fatal-error handle-fatal-error
(subset sunet-utilities (get-header)) ; GET-HEADER
scsh scsh
scheme) scheme)
(files surflets)) (files surflets))

View File

@ -86,10 +86,6 @@
(release-lock *cache-lock*) (release-lock *cache-lock*)
result)) result))
(define (get-header headers tag)
(cond ((assq tag headers) => cdr)
(else #f)))
;; Will be needed when we handle POST requests. ;; Will be needed when we handle POST requests.
(define (get-content-length headers) (define (get-content-length headers)

View File

@ -67,3 +67,9 @@
thunk thunk
(lambda () (lambda ()
(release-lock lock)))) (release-lock lock))))
;; Get Header from (RFC822 like) header alist
(define (get-header headers tag)
(cond ((assq tag headers) => cdr)
(else #f)))

View File

@ -199,7 +199,8 @@
dump dump
copy-inport->outport copy-inport->outport
dotdot-check dotdot-check
with-lock)) with-lock
get-header))
(define-interface handle-fatal-error-interface (define-interface handle-fatal-error-interface
(export with-fatal-error-handler* (export with-fatal-error-handler*
@ -714,6 +715,7 @@
handle ; IGNORE-ERROR handle ; IGNORE-ERROR
parse-html-forms ; PARSE-HTML-FORM-QUERY parse-html-forms ; PARSE-HTML-FORM-QUERY
threads ; SLEEP threads ; SLEEP
sunet-utilities ; GET-HEADER
) )
(files (httpd seval))) (files (httpd seval)))
@ -765,7 +767,7 @@
sunet-version sunet-version
formats formats
format-net format-net
sunet-utilities ; host-name-or-empty sunet-utilities ; host-name-or-empty, get-header
let-opt ; let-optionals let-opt ; let-optionals
handle-fatal-error handle-fatal-error
) )