Use DNS for FQDN determination in SMTP.
This commit is contained in:
parent
1cfa3e3595
commit
cfc8d84aad
|
@ -1358,3 +1358,16 @@
|
|||
(cons (cons ip32 fqdn) *fqdn-cache*))
|
||||
fqdn))))
|
||||
(dns-lookup-ip ip32)))
|
||||
|
||||
(define (host-fqdn name-or-socket-address)
|
||||
(if (socket-address? name-or-socket-address)
|
||||
(socket-address->fqdn name-or-socket-address #f)
|
||||
(internet-address->fqdn
|
||||
(car
|
||||
(host-info:addresses
|
||||
(host-info name-or-socket-address)))
|
||||
#f)))
|
||||
|
||||
(define (system-fqdn)
|
||||
(internet-address->fqdn (car (host-info:addresses (host-info (system-name))))
|
||||
#t))
|
||||
|
|
|
@ -29,11 +29,6 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;;; This is broken -- the (SYSTEM-NAME) proc returns a local name, not
|
||||
;;; a useful Internet host name. How do we do that?
|
||||
;;; [Andreas:] I've inserted a way to do this. It works fine on my
|
||||
;;; system. Does it work on your, too?
|
||||
|
||||
;;; (send-mail-via-smtp from to-list headers body [host])
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Mail message to recipients in list TO-LIST. Message handed off to server
|
||||
|
@ -50,8 +45,11 @@
|
|||
(define (send-mail-via-smtp from to-list headers body . maybe-host)
|
||||
(call-with-current-continuation
|
||||
(lambda (bailout)
|
||||
(let ((local (host-info:name (host-info (system-name))))
|
||||
(socket (smtp/open (:optional maybe-host "localhost"))))
|
||||
(let* ((host (:optional maybe-host "localhost"))
|
||||
(local (if (string=? host "localhost")
|
||||
(system-name) ; we don't need any DNS for that
|
||||
(system-fqdn)))
|
||||
(socket (smtp/open host)))
|
||||
(receive (code text)
|
||||
(smtp-transactions/no-close socket ; Do prologue.
|
||||
(smtp/helo local)
|
||||
|
|
|
@ -199,7 +199,9 @@
|
|||
dns-find-nameserver ; returns a nameserver
|
||||
dns-find-nameserver-list ; returns a list of nameservers
|
||||
socket-address->fqdn
|
||||
internet-address->fqdn))
|
||||
internet-address->fqdn
|
||||
host-fqdn
|
||||
system-fqdn))
|
||||
|
||||
(define-interface cgi-script-interface
|
||||
(export cgi-form-query))
|
||||
|
@ -434,12 +436,13 @@
|
|||
(define-structure smtp smtp-interface
|
||||
|
||||
(open scsh ; write-string read-string/partial force-output
|
||||
; system-name user-login-name and sockets
|
||||
; user-login-name and sockets
|
||||
(subset srfi-1 (filter-map))
|
||||
crlf-io ; read-crlf-line write-crlf
|
||||
receiving ; values receive
|
||||
let-opt ; let-optionals
|
||||
error-package ; error
|
||||
dns ; SYSTEM-FQDN
|
||||
scheme)
|
||||
(files (lib smtp)))
|
||||
|
||||
|
|
Loading…
Reference in New Issue