diff --git a/scheme/httpd/cgi-server.scm b/scheme/httpd/cgi-server.scm index 7d519e5..33ce4bf 100644 --- a/scheme/httpd/cgi-server.scm +++ b/scheme/httpd/cgi-server.scm @@ -274,11 +274,6 @@ (copy-inport->outport script-port out) (close-input-port script-port))))))) -(define (get-header headers tag) - (cond - ((assq tag headers) => cdr) - (else #f))) - (define (delete-headers headers tag) (alist-delete tag headers)) diff --git a/scheme/httpd/seval.scm b/scheme/httpd/seval.scm index a43d551..bfd3421 100644 --- a/scheme/httpd/seval.scm +++ b/scheme/httpd/seval.scm @@ -104,7 +104,3 @@ (read (make-string-input-port s))))) (else (error "No `Content-length:' field in POST request.")))) -(define (get-header headers tag) - (cond - ((assq tag headers) => cdr) - (else #f))) \ No newline at end of file diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index 85d20e2..8d260c1 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -207,6 +207,7 @@ locks let-opt ;:OPTIONAL handle-fatal-error + (subset sunet-utilities (get-header)) ; GET-HEADER scsh scheme) (files surflets)) diff --git a/scheme/httpd/surflets/surflets.scm b/scheme/httpd/surflets/surflets.scm index da56ae6..66e0cb7 100644 --- a/scheme/httpd/surflets/surflets.scm +++ b/scheme/httpd/surflets/surflets.scm @@ -86,10 +86,6 @@ (release-lock *cache-lock*) result)) -(define (get-header headers tag) - (cond ((assq tag headers) => cdr) - (else #f))) - ;; Will be needed when we handle POST requests. (define (get-content-length headers) diff --git a/scheme/lib/sunet-utilities.scm b/scheme/lib/sunet-utilities.scm index 7306d2c..87bd4e0 100644 --- a/scheme/lib/sunet-utilities.scm +++ b/scheme/lib/sunet-utilities.scm @@ -67,3 +67,9 @@ thunk (lambda () (release-lock lock)))) + + +;; Get Header from (RFC822 like) header alist +(define (get-header headers tag) + (cond ((assq tag headers) => cdr) + (else #f))) \ No newline at end of file diff --git a/scheme/packages.scm b/scheme/packages.scm index 38db66b..0c1d0ec 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -199,7 +199,8 @@ dump copy-inport->outport dotdot-check - with-lock)) + with-lock + get-header)) (define-interface handle-fatal-error-interface (export with-fatal-error-handler* @@ -714,6 +715,7 @@ handle ; IGNORE-ERROR parse-html-forms ; PARSE-HTML-FORM-QUERY threads ; SLEEP + sunet-utilities ; GET-HEADER ) (files (httpd seval))) @@ -765,7 +767,7 @@ sunet-version formats format-net - sunet-utilities ; host-name-or-empty + sunet-utilities ; host-name-or-empty, get-header let-opt ; let-optionals handle-fatal-error )