(std11-non-atom-regexp): New constant.

[elisp/flim.git] / smtp.el

diff --git a/smtp.el b/smtp.el
index 7e22426..fb5d546 100644 (file)
--- a/smtp.el
+++ b/smtp.el
@@ -1,6 +1,6 @@
 ;;; smtp.el --- basic functions to send mail with SMTP server
 
 ;;; smtp.el --- basic functions to send mail with SMTP server
 

-;; Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.

 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;     Simon Leinen <simon@switch.ch> (ESMTP support)
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;     Simon Leinen <simon@switch.ch> (ESMTP support)

@@ -27,15 +27,15 @@
 
 
 ;;; Commentary:
 
 
 ;;; Commentary:

-;; 
+;;

 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'pces)
-(require 'pcustom)
+(require 'custom)

 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)
 (require 'luna)
 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)
 (require 'luna)

+(require 'mel) ; binary-funcall

 
 (defgroup smtp nil
   "SMTP protocol for sending mail."
 
 (defgroup smtp nil
   "SMTP protocol for sending mail."

@@ -61,7 +61,7 @@ called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS."
 (defcustom smtp-service "smtp"
   "SMTP service port number.  \"smtp\" or 25."
   :type '(choice (integer :tag "25" 25)
 (defcustom smtp-service "smtp"
   "SMTP service port number.  \"smtp\" or 25."
   :type '(choice (integer :tag "25" 25)

-                 (string :tag "smtp" "smtp"))
+                (string :tag "smtp" "smtp"))

   :group 'smtp)
 
 (defcustom smtp-local-domain nil
   :group 'smtp)
 
 (defcustom smtp-local-domain nil

@@ -112,8 +112,25 @@ don't define this value."
   :group 'smtp-extensions)
 
 (defvar sasl-mechanisms)
   :group 'smtp-extensions)
 
 (defvar sasl-mechanisms)

-  
-(defvar smtp-open-connection-function #'open-network-stream)
+
+;;;###autoload
+(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-read-point nil)
 

@@ -121,6 +138,11 @@ don't define this value."
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 
 
 (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
 ;;; @ SMTP package
 ;;; A package contains a mail message, an envelope sender address,
 ;;; and one or more envelope recipient addresses.  In ESMTP model

@@ -235,9 +257,8 @@ Return a newly allocated connection-object.
 BUFFER is the buffer to associate with the connection.  SERVER is name
 of the host to connect to.  SERVICE is name of the service desired."
   (let ((process
 BUFFER is the buffer to associate with the connection.  SERVER is name
 of the host to connect to.  SERVICE is name of the service desired."
   (let ((process

-        (as-binary-process
-         (funcall smtp-open-connection-function
-                  "SMTP" buffer  server service)))
+        (binary-funcall smtp-open-connection-function
+                        "SMTP" buffer server service))

        connection)
     (when process
       (setq connection (smtp-make-connection process server service))
        connection)
     (when process
       (setq connection (smtp-make-connection process server service))

@@ -249,6 +270,7 @@ of the host to connect to.  SERVICE is name of the service desired."
 
 ;;;###autoload
 (defun smtp-via-smtp (sender recipients buffer)
 
 ;;;###autoload
 (defun smtp-via-smtp (sender recipients buffer)

+  "Like `smtp-send-buffer', but sucks in any errors."

   (condition-case nil
       (progn
        (smtp-send-buffer sender recipients buffer)
   (condition-case nil
       (progn
        (smtp-send-buffer sender recipients buffer)

@@ -259,6 +281,10 @@ of the host to connect to.  SERVICE is name of the service desired."
 
 ;;;###autoload
 (defun smtp-send-buffer (sender recipients buffer)
 
 ;;;###autoload
 (defun smtp-send-buffer (sender recipients buffer)

+  "Send a message.
+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)
   (let ((server
         (if (functionp smtp-server)
             (funcall smtp-server sender recipients)

@@ -290,7 +316,9 @@ of the host to connect to.  SERVICE is name of the service desired."
          (smtp-response-error
           (smtp-primitive-helo package)))
        (if smtp-use-starttls
          (smtp-response-error
           (smtp-primitive-helo package)))
        (if smtp-use-starttls

-           (smtp-primitive-starttls package))
+           (progn
+           (smtp-primitive-starttls package)
+           (smtp-primitive-ehlo package)))

        (if smtp-use-sasl
            (smtp-primitive-auth package))
        (smtp-primitive-mailfrom package)
        (if smtp-use-sasl
            (smtp-primitive-auth package))
        (smtp-primitive-mailfrom package)

@@ -495,13 +523,13 @@ of the host to connect to.  SERVICE is name of the service desired."
        response)
     (while response-continue
       (goto-char smtp-read-point)
        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))
        (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
       (setq response
            (nconc response
                   (list (buffer-substring

@@ -523,7 +551,7 @@ of the host to connect to.  SERVICE is name of the service desired."
           (smtp-connection-encoder-internal connection)))
       (set-buffer (process-buffer process))
       (goto-char (point-max))
           (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
       (insert command)
       (setq smtp-read-point (point))
       (if encoder

@@ -537,8 +565,8 @@ of the host to connect to.  SERVICE is name of the service desired."
         (smtp-connection-encoder-internal connection)))
     ;; Escape "." at start of a line.
     (if (eq (string-to-char data) ?.)
         (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)))
     (if encoder
        (setq data (funcall encoder data)))
     (process-send-string process data)))