From da98c4b78c2e4cf47e4e00ab5b9e957fb21c8591 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Wed, 19 Feb 2003 17:05:16 +0000
Subject: [PATCH] factor out GET-HEADER

---
 scheme/httpd/cgi-server.scm        | 5 -----
 scheme/httpd/seval.scm             | 4 ----
 scheme/httpd/surflets/packages.scm | 1 +
 scheme/httpd/surflets/surflets.scm | 4 ----
 scheme/lib/sunet-utilities.scm     | 6 ++++++
 scheme/packages.scm                | 6 ++++--
 6 files changed, 11 insertions(+), 15 deletions(-)

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
 	)