diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index 529ba3b..208efdf 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -409,21 +409,32 @@ the requested method (~A).~%" ;;; Return my Internet host name (my fully-qualified domain name). ;;; This works only if an actual resolver is behind host-info. ;;; -;;; On systems that do DNS via NIS/Yellow Pages, you only get an -;;; unqualified hostname. Also, in case of aliased names, you just -;;; might get the wrong one. Furthermore, you may get screwed in the -;;; presence of a server accelerator such as Squid. +;;; In case of aliased names, you just might get the wrong one. +;;; Furthermore, you may get screwed in the presence of a server +;;; accelerator such as Squid. -(define *fqdn-cache* #f) - -(define (my-reported-fqdn addr options) - (or *fqdn-cache* - (begin - (set! *fqdn-cache* (or (httpd-options-fqdn options) - (dns-lookup-ip (socket-address->string addr)) - (host-info:name (host-info addr)))) - *fqdn-cache*))) +(define my-reported-fqdn + (let ((fqdn-lock (make-lock)) + (fqdn-cache #f) + (used-addr #f) + (used-options #f)) + (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)) + (host-info:name (host-info addr)))) + (set! used-addr addr) + (set! used-options options) + fqdn-cache))))) + (release-lock fqdn-lock) + result)))) (define (my-reported-port addr options) (or (httpd-options-reported-port options) diff --git a/scheme/packages.scm b/scheme/packages.scm index dea1cf0..116b023 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -650,6 +650,7 @@ string-lib ; STRING-INDEX dns ; dns-lookup-ip sunet-utilities ; socket-address->string + locks ; make-lock et al. handle-fatal-error httpd-read-options