From 0ab5c48cfc7638a03f344da3491eada95b83c492 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Mon, 2 Sep 2002 14:34:31 +0000
Subject: [PATCH] make MY-REPORTED-FQDN fit for lots of virtual hosts

---
 scheme/httpd/core.scm | 39 +++++++++++++++++++++++----------------
 scheme/packages.scm   |  9 +++++++--
 2 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm
index 834b6b1..f14b7a3 100644
--- a/scheme/httpd/core.scm
+++ b/scheme/httpd/core.scm
@@ -345,25 +345,32 @@
 
 (define my-reported-fqdn
   (let ((fqdn-lock (make-lock))
-	(fqdn-cache #f)
-	(used-addr #f)
-	(used-options #f))
+	(fqdn-cache '())		; listof (ip32 port options . fqdn)
+	(key-ip32 car)
+	(key-port cadr)
+	(key-options caddr))
     (lambda (addr options)
       (obtain-lock fqdn-lock)
-      (let ((result
-	     (if fqdn-cache
-		 (or (and (equal? used-addr addr)
-			  (equal? used-options options))
-		     fqdn-cache)
-		 (begin
-		   (set! fqdn-cache (or (httpd-options-fqdn options)
-					(dns-lookup-ip (socket-address->string addr #f))
-					(host-info:name (host-info addr))))
-		   (set! used-addr addr)
-		   (set! used-options options)
-		   fqdn-cache))))
+      (let 
+	  ((result
+	    (receive (ip32 port)
+		 (socket-address->internet-address addr)
+	      (let ((fqdn-entry 
+		     (find (lambda (entry)
+			      (let ((entry-key (car entry)))
+				(and (= ip32 (key-ip32 entry-key))
+				     (= port (key-port entry-key))
+				     (eq? options (key-options entry-key)))))
+			    fqdn-cache)))
+		(if fqdn-entry
+		    (cdr fqdn-entry)
+		    (let ((fqdn (or (httpd-options-fqdn options)
+				    (dns-lookup-ip ip32)
+				    (host-info:name (host-info addr)))))
+		      (set! fqdn-cache 
+			    (cons (cons (list ip32 port options) fqdn) fqdn-cache))
+		      fqdn))))))
 	(release-lock fqdn-lock)
-	
 	result))))
 
 (define (my-reported-port addr options)
diff --git a/scheme/packages.scm b/scheme/packages.scm
index e055c98..f0c51f1 100644
--- a/scheme/packages.scm
+++ b/scheme/packages.scm
@@ -38,7 +38,11 @@
 	  smtp-transactions/no-close
 	  smtp/open smtp/helo smtp/mail smtp/rcpt smtp/data
 	  smtp/send smtp/soml smtp/saml smtp/rset smtp/expn
-	  smtp/help smtp/noop smtp/quit smtp/turn))
+	  smtp/help smtp/noop smtp/quit smtp/turn
+	  handle-smtp-reply
+	  read-smtp-reply
+	  parse-smtp-reply
+	  smtp-stuff))
 
 (define-interface rfc822-interface
   (export read-rfc822-headers
@@ -695,7 +699,8 @@
 	httpd-responses
 
 	sunet-version
-	scheme)
+	scheme
+	srfi-1)				; find
   (files (httpd core)))
 
 (define-structures ((httpd-make-options httpd-make-options-interface)