(defvar sasl-mechanisms)
;;;###autoload
-(defvar smtp-open-connection-function #'open-network-stream)
+(defvar smtp-open-connection-function #'open-network-stream
+ "*Function used for connecting to a SMTP server.
+The function will be called with the same four arguments as
+`open-network-stream' and should return a process object.
+Here is an example:
+
+\(setq smtp-open-connection-function
+ #'(lambda (name buffer host service)
+ (let ((process-connection-type nil))
+ (start-process name buffer \"ssh\" \"-C\" host
+ \"nc\" host service))))
+
+It connects to a SMTP server using \"ssh\" before actually connecting
+to the SMTP port. Where the command \"nc\" is the netcat executable;
+see http://www.atstake.com/research/tools/index.html#network_utilities
+for details. In addition, you will have to modify the value for
+`smtp-end-of-line' to \"\\n\" if you use \"telnet\" instead of \"nc\".")
(defvar smtp-read-point nil)
(defvar smtp-submit-package-function #'smtp-submit-package)
+(defvar smtp-end-of-line "\r\n"
+ "*String to use as end-of-line marker when talking to a SMTP server.
+This is \"\\r\\n\" by default, but it may have to be \"\\n\" when using a non
+native connection function. See also `smtp-open-connection-function'.")
+
;;; @ SMTP package
;;; A package contains a mail message, an envelope sender address,
;;; and one or more envelope recipient addresses. In ESMTP model
(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))
+ (save-excursion
+ (let ((rec
+ (mapcar (lambda (recipient)
+ (let (server)
+ (if (and (string-match "@\\([^\t\n ]*\\)" recipient)
+ (setq server
+ (smtp-find-mx
+ (match-string 1 recipient))))
+ (cons server (list recipient))
+ (error (format "cannot find server for %s." 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)
#'starttls-open-stream
smtp-open-connection-function))
server package)
- (while (car servers)
- (setq server (caar servers))
- (setq recipients (cdar servers))
- (if (not (and server recipients))
- ;; MAILER-DAEMON is required. :)
- (error (format "Cannot send <%s>"
- (mapconcat 'concat recipients ">,<"))))
- (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)))
+ (while (car servers)
+ (setq server (caar servers))
+ (setq recipients (cdar servers))
+ (if (not (and server recipients))
+ ;; MAILER-DAEMON is required. :)
+ (error (format "Cannot send <%s>"
+ (mapconcat 'concat recipients ">,<"))))
+ (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'
response)
(while response-continue
(goto-char smtp-read-point)
- (while (not (search-forward "\r\n" nil t))
+ (while (not (search-forward smtp-end-of-line nil t))
(accept-process-output (smtp-connection-process-internal connection))
(goto-char smtp-read-point))
(if decoder
(let ((string (buffer-substring smtp-read-point (- (point) 2))))
(delete-region smtp-read-point (point))
- (insert (funcall decoder string) "\r\n")))
+ (insert (funcall decoder string) smtp-end-of-line)))
(setq response
(nconc response
(list (buffer-substring
(smtp-connection-encoder-internal connection)))
(set-buffer (process-buffer process))
(goto-char (point-max))
- (setq command (concat command "\r\n"))
+ (setq command (concat command smtp-end-of-line))
(insert command)
(setq smtp-read-point (point))
(if encoder
(smtp-connection-encoder-internal connection)))
;; Escape "." at start of a line.
(if (eq (string-to-char data) ?.)
- (setq data (concat "." data "\r\n"))
- (setq data (concat data "\r\n")))
+ (setq data (concat "." data smtp-end-of-line))
+ (setq data (concat data smtp-end-of-line)))
(if encoder
(setq data (funcall encoder data)))
(process-send-string process data)))
projects / elisp / flim.git / blobdiff