Shift FQDN determination code from HTTPD-CORE to DNS.
This commit is contained in:
parent
6486df6080
commit
1cfa3e3595
|
@ -269,8 +269,10 @@
|
||||||
;; Interpolate the userhost struct from our net connection.
|
;; Interpolate the userhost struct from our net connection.
|
||||||
(if (and (pair? path) (string=? (car path) ""))
|
(if (and (pair? path) (string=? (car path) ""))
|
||||||
(let* ((addr (socket-local-address socket))
|
(let* ((addr (socket-local-address socket))
|
||||||
(local-name (my-reported-fqdn addr options))
|
(local-name (or (httpd-options-fqdn options)
|
||||||
(portnum (my-reported-port addr options)))
|
(socket-address->fqdn addr #t)))
|
||||||
|
(portnum (or (httpd-options-reported-port options)
|
||||||
|
(my-reported-port addr))))
|
||||||
(make-http-url (make-userhost #f #f
|
(make-http-url (make-userhost #f #f
|
||||||
local-name
|
local-name
|
||||||
(number->string portnum))
|
(number->string portnum))
|
||||||
|
@ -353,46 +355,7 @@
|
||||||
(write-crlf port))
|
(write-crlf port))
|
||||||
headers))
|
headers))
|
||||||
|
|
||||||
;;; Return my Internet host name (my fully-qualified domain name).
|
(define (my-reported-port addr)
|
||||||
;;; This works only if an actual resolver is behind host-info.
|
|
||||||
;;;
|
|
||||||
;;; 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 my-reported-fqdn
|
|
||||||
(let ((fqdn-lock (make-lock))
|
|
||||||
(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
|
|
||||||
(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)
|
|
||||||
(or (httpd-options-reported-port options)
|
|
||||||
(receive (ip-addr portnum) (socket-address->internet-address addr)
|
(receive (ip-addr portnum) (socket-address->internet-address addr)
|
||||||
portnum)))
|
portnum))
|
||||||
|
|
||||||
|
|
|
@ -1333,3 +1333,28 @@
|
||||||
(d 5 "data " (rr-data-wks:data dns-msg)))
|
(d 5 "data " (rr-data-wks:data dns-msg)))
|
||||||
|
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
(define *fqdn-lock* (make-lock))
|
||||||
|
(define *fqdn-cache* '())
|
||||||
|
|
||||||
|
(define (socket-address->fqdn addr cache?)
|
||||||
|
(receive (ip32 port)
|
||||||
|
(socket-address->internet-address addr)
|
||||||
|
(internet-address->fqdn ip32 cache?)))
|
||||||
|
|
||||||
|
(define (internet-address->fqdn ip32 cache?)
|
||||||
|
(if cache?
|
||||||
|
(begin
|
||||||
|
(obtain-lock *fqdn-lock*)
|
||||||
|
(cond
|
||||||
|
((assv ip32 *fqdn-cache*) =>
|
||||||
|
(lambda (pair)
|
||||||
|
(release-lock *fqdn-lock*)
|
||||||
|
(cdr pair)))
|
||||||
|
(else
|
||||||
|
(release-lock *fqdn-lock*)
|
||||||
|
(let ((fqdn (dns-lookup-ip ip32)))
|
||||||
|
(set! *fqdn-cache*
|
||||||
|
(cons (cons ip32 fqdn) *fqdn-cache*))
|
||||||
|
fqdn))))
|
||||||
|
(dns-lookup-ip ip32)))
|
||||||
|
|
|
@ -197,7 +197,9 @@
|
||||||
address32->ip-string ; converts a address32 in an ip-string
|
address32->ip-string ; converts a address32 in an ip-string
|
||||||
ip-string->address32 ; converts a ip-string in an address32
|
ip-string->address32 ; converts a ip-string in an address32
|
||||||
dns-find-nameserver ; returns a nameserver
|
dns-find-nameserver ; returns a nameserver
|
||||||
dns-find-nameserver-list)) ; returns a list of nameservers
|
dns-find-nameserver-list ; returns a list of nameservers
|
||||||
|
socket-address->fqdn
|
||||||
|
internet-address->fqdn))
|
||||||
|
|
||||||
(define-interface cgi-script-interface
|
(define-interface cgi-script-interface
|
||||||
(export cgi-form-query))
|
(export cgi-form-query))
|
||||||
|
|
Loading…
Reference in New Issue