From: okada Date: Sat, 17 Nov 2001 15:17:36 +0000 (+0000) Subject: 2001-11-18 Kenichi OKADA X-Git-Tag: slim-1_14_8~6 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=76b2180abe8b1281d4f7479c2e18af4950b15faf;p=elisp%2Fflim.git 2001-11-18 Kenichi OKADA * smtp.el (smtp-send-by-myself): New variable. (smtp-use-starttls-ignore-error): New variable. (smtp-find-mx): New function. (smtp-dig): New function. (smtp-find-server): New function. (smtp-send-buffer-by-myself): New funcion. (smtp-send-buffer): Change for `smtp-send-buffer-by-myself'. --- diff --git a/ChangeLog b/ChangeLog index 0723d0d..87c9ecf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2001-11-18 Kenichi OKADA + + * smtp.el (smtp-send-by-myself): New variable. + (smtp-use-starttls-ignore-error): New variable. + (smtp-find-mx): New function. + (smtp-dig): New function. + (smtp-find-server): New function. + (smtp-send-buffer-by-myself): New funcion. + (smtp-send-buffer): Change for `smtp-send-buffer-by-myself'. + 2001-11-03 Shuhei KOBAYASHI * hmac-md5.el: Removed kludge for Emacs 21 prerelease versions. diff --git a/smtp.el b/smtp.el index d699aec..cda4656 100644 --- a/smtp.el +++ b/smtp.el @@ -58,6 +58,12 @@ called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS." (function :tag "Function")) :group 'smtp) +(defcustom smtp-send-by-myself nil + "If non-nil, smtp.el send a mail by myself without smtp-server. +This option requires \"dig.el\"." + :type 'boolean + :group 'smtp) + (defcustom smtp-service "smtp" "SMTP service port number. \"smtp\" or 25." :type '(choice (integer :tag "25" 25) @@ -91,6 +97,11 @@ don't define this value." :type 'boolean :group 'smtp-extensions) +(defcustom smtp-use-starttls-ignore-error nil + "If non-nil, do not use STARTTLS if STARTTLS is not available." + :type 'boolean + :group 'smtp-extensions) + (defcustom smtp-use-sasl nil "If non-nil, use SMTP Authentication (RFC2554) if available." :type 'boolean @@ -247,6 +258,48 @@ of the host to connect to. SERVICE is name of the service desired." smtp-connection-alist)) connection))) +(eval-and-compile + (autoload 'dig-invoke "dig") + (autoload 'dig-extract-rr "dig")) + +(defun smtp-find-mx (domain &optional doerror) + (let (server) + ;; dig.el resolves only primally MX. + (cond ((setq server (smtp-dig domain "MX")) + (progn (string-match " \\([^ ]*\\)$" server) + (match-string 1 server))) + ((smtp-dig domain "A") + domain) + (t + (if doerror + (error (format "SMTP cannot resolve %s" domain))))))) + +(defun smtp-dig (domain type) + (let (dig-buf) + (set-buffer + (setq dig-buf (dig-invoke domain type))) + (prog1 + (dig-extract-rr domain type) + (kill-buffer dig-buf)))) + +(defun smtp-find-server (recipients) + (let ((rec + (mapcar (lambda (recipient) + (if (string-match "@\\([^\t\n ]*\\)" recipient) + (cons + (smtp-find-mx + (match-string 1 recipient)) + (list recipient)))) + recipients)) + ret rets rlist) + (while (setq rets (pop rec)) + (if (setq ret (assoc (car rets) rec)) + (setcdr ret + (append (cdr ret) (cdr rets))) + (setq rlist + (append rlist (list rets))))) + rlist)) + ;;;###autoload (defun smtp-via-smtp (sender recipients buffer) "Like `smtp-send-buffer', but sucks in any errors." @@ -264,27 +317,29 @@ of the host to connect to. SERVICE is name of the service desired." SENDER is an envelope sender address. RECIPIENTS is a list of envelope recipient addresses. BUFFER may be a buffer or a buffer name which contains mail message." - (let ((server - (if (functionp smtp-server) - (funcall smtp-server sender recipients) - smtp-server)) - (package - (smtp-make-package sender recipients buffer)) - (smtp-open-connection-function - (if smtp-use-starttls - #'starttls-open-stream - smtp-open-connection-function))) - (save-excursion - (set-buffer - (get-buffer-create - (format "*trace of SMTP session to %s*" server))) - (erase-buffer) - (buffer-disable-undo) - (unless (smtp-find-connection (current-buffer)) - (smtp-open-connection (current-buffer) server smtp-service)) - (make-local-variable 'smtp-read-point) - (setq smtp-read-point (point-min)) - (funcall smtp-submit-package-function package)))) + (if smtp-send-by-myself + (smtp-send-buffer-by-myself sender recipients buffer) + (let ((server + (if (functionp smtp-server) + (funcall smtp-server sender recipients) + smtp-server)) + (package + (smtp-make-package sender recipients buffer)) + (smtp-open-connection-function + (if smtp-use-starttls + #'starttls-open-stream + smtp-open-connection-function))) + (save-excursion + (set-buffer + (get-buffer-create + (format "*trace of SMTP session to %s*" server))) + (erase-buffer) + (buffer-disable-undo) + (unless (smtp-find-connection (current-buffer)) + (smtp-open-connection (current-buffer) server smtp-service)) + (make-local-variable 'smtp-read-point) + (setq smtp-read-point (point-min)) + (funcall smtp-submit-package-function package))))) (defun smtp-submit-package (package) (unwind-protect @@ -295,14 +350,14 @@ BUFFER may be a buffer or a buffer name which contains mail message." (smtp-response-error (smtp-primitive-helo package))) (if smtp-use-starttls - (progn - (unless - (assq 'starttls - (smtp-connection-extensions-internal - (smtp-find-connection (current-buffer)))) - (error "STARTTLS is not supported on this server")) - (smtp-primitive-starttls package) - (smtp-primitive-ehlo package))) + (if (assq 'starttls + (smtp-connection-extensions-internal + (smtp-find-connection (current-buffer)))) + (progn + (smtp-primitive-starttls package) + (smtp-primitive-ehlo package)) + (unless smtp-use-starttls-ignore-error + (error "STARTTLS is not supported on this server")))) (if smtp-use-sasl (smtp-primitive-auth package)) (smtp-primitive-mailfrom package) @@ -313,6 +368,38 @@ BUFFER may be a buffer or a buffer name which contains mail message." (smtp-primitive-quit package) (smtp-close-connection connection))))) +(defun smtp-send-buffer-by-myself (sender recipients buffer) + "Send a message by myself. +SENDER is an envelope sender address. +RECIPIENTS is a list of envelope recipient addresses. +BUFFER may be a buffer or a buffer name which contains mail message." + (let ((servers + (smtp-find-server recipients)) + (smtp-open-connection-function + (if smtp-use-starttls + #'starttls-open-stream + smtp-open-connection-function)) + server package) + (while (car servers) + (setq server (caar servers)) + (setq recipients (cdar servers)) + (setq package + (smtp-make-package sender recipients buffer)) + (save-excursion + (set-buffer + (get-buffer-create + (format "*trace of SMTP session to %s*" server))) + (erase-buffer) + (buffer-disable-undo) + (unless (smtp-find-connection (current-buffer)) + (smtp-open-connection (current-buffer) server smtp-service)) + (make-local-variable 'smtp-read-point) + (setq smtp-read-point (point-min)) + (let ((smtp-use-sasl nil) + (smtp-use-starttls-ignore-error t)) + (funcall smtp-submit-package-function package))) + (setq servers (cdr servers))))) + ;;; @ hook methods for `smtp-submit-package' ;;;