make MY-REPORTED-FQDN fit for lots of virtual hosts

This commit is contained in:
interp 2002-09-02 14:34:31 +00:00
parent 27f6bb4dbd
commit 0ab5c48cfc
2 changed files with 30 additions and 18 deletions

View File

@ -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)

View File

@ -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)