- (let* ((domain (get-domain-from-email (message-to msg)))
- (mail-server (get-mail-server-for-domain domain)))
- (print "Attempting delivery to " mail-server)
- (let-values (((tcp-in tcp-out) (tcp-connect mail-server 25)))
- (let ((smtp-session (make-outgoing-smtp-session tcp-in tcp-out)))
- (let ((result (and
- (smtp-session 'expect "220")
- (smtp-session 'send "helo " (config-host config))
- (smtp-session 'expect "250")
- (smtp-session 'send "mail from:" (message-from msg))
- (smtp-session 'expect "250")
- (smtp-session 'send "rcpt to:" (message-to msg))
- (smtp-session 'expect "250")
- (smtp-session 'send "data")
- (smtp-session 'expect "354")
- (smtp-session 'send (message-text msg))
- (smtp-session 'send ".")
- (smtp-session 'expect "250" "5") ;Do not try again on rejects.
- (smtp-session 'send "quit"))))
- (close-input-port tcp-in)
- (close-output-port tcp-out)
- (print "Connection closed.")
- (if result
- (print "* MESSAGE DELIVERED (remote)")
- (print "* REMOTE DELIVERY FAILED (unexpected server response)"))
- result)))))
+ (let ((domain (get-domain-from-email (message-to msg))))
+ (let loop ((mail-servers (get-mail-servers-for-domain domain)))
+ (if (null? mail-servers)
+ (begin
+ (print "* REMOTE DELIVERY FAILED (Could not connect to any mail server)")
+ #f)
+ (condition-case
+ (let ((mail-server (car mail-servers)))
+ (print "Attempting delivery to " mail-server)
+ (let-values (((tcp-in tcp-out) (tcp-connect mail-server 25)))
+ (let ((smtp-session (make-outgoing-smtp-session tcp-in tcp-out)))
+ (let ((result (and
+ (smtp-session 'expect "220")
+ (smtp-session 'send "helo " (config-host config))
+ (smtp-session 'expect "250")
+ (smtp-session 'send "mail from:" (message-from msg))
+ (smtp-session 'expect "250")
+ (smtp-session 'send "rcpt to:" (message-to msg))
+ (smtp-session 'expect "250")
+ (smtp-session 'send "data")
+ (smtp-session 'expect "354")
+ (smtp-session 'send (message-text msg))
+ (smtp-session 'send ".")
+ (smtp-session 'expect "250" "5") ;Do not try again on rejects.
+ (smtp-session 'send "quit"))))
+ (close-input-port tcp-in)
+ (close-output-port tcp-out)
+ (print "Connection closed.")
+ (if result
+ (print "* MESSAGE DELIVERED (remote)")
+ (print "* REMOTE DELIVERY FAILED (unexpected server response)"))
+ result))))
+ (o (exn)
+ (print-error-messsage o)
+ (print "* Failed to connect. Trying next server.")
+ (loop (cdr mail-servers))))))))