From 8d2d72c843a59410d80dacb6f37551ab7483117f Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 15 Dec 2000 07:46:35 +0000 Subject: [PATCH] Synch with `flim-1_14' (to be continued). --- mel-b-ccl.el | 2 +- mel-q-ccl.el | 2 +- mime-def.el | 33 +++----- mmbuffer.el | 103 +++++++++--------------- mmexternal.el | 1 + qmtp.el | 2 +- smtp.el | 245 ++++++++++++++++++++++++++++----------------------------- std11.el | 7 +- 8 files changed, 178 insertions(+), 217 deletions(-) diff --git a/mel-b-ccl.el b/mel-b-ccl.el index 32bd8c8..803df63 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1998,1999 Tanaka Akira -;; Author: Tanaka Akira +;; Author: Tanaka Akira ;; Created: 1998/9/17 ;; Keywords: MIME, Base64 diff --git a/mel-q-ccl.el b/mel-q-ccl.el index c15fed2..b9c70b7 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -961,7 +961,7 @@ MODE allows `text', `comment', `phrase' or nil. Default value is (unless (featurep 'xemacs) (defun q-encoding-ccl-encoded-length (string &optional mode) (let ((status [nil nil nil nil nil nil nil nil nil])) - (fillarray status nil) + (fillarray status nil) ; XXX: Is this necessary? (ccl-execute-on-string (cond ((eq mode 'text) 'mel-ccl-count-uq) diff --git a/mime-def.el b/mime-def.el index 32b5a17..1da89bc 100644 --- a/mime-def.el +++ b/mime-def.el @@ -5,8 +5,7 @@ ;; Author: MORIOKA Tomohiko ;; Keywords: definition, MIME, multimedia, mail, news -;; This file is part of DEISUI (Deisui is an Entity Implementation for -;; SEMI based User Interfaces). +;; This file is part of FLIM (Faithful Library about Internet Message). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -38,8 +37,7 @@ (eval-and-compile (defconst mime-library-product ["CLIME" (1 14 0) "五間堂"] - "Product name, version number and code name of MIME-library package.") - ) + "Product name, version number and code name of MIME-library package.")) (defmacro mime-product-name (product) (` (aref (, product) 0))) @@ -131,7 +129,7 @@ base64-token-regexp base64-token-padding-regexp base64-token-padding-regexp - "\\)")) + "\\)")) ;; (defconst eword-B-encoding-and-encoded-text-regexp ;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp)) @@ -247,9 +245,8 @@ service." (,@ rest) (funcall (mel-find-function '(, name) (, (car (last args)))) - (,@ (luna-arglist-to-arguments (butlast args)))) - ))))) - ))) + (,@ (luna-arglist-to-arguments + (butlast args)))))))))))) (put 'mel-define-service 'lisp-indent-function 'defun) @@ -263,10 +260,8 @@ service." (while (and rest (progn (require (car rest)) - (null (setq f (intern-soft encoding ob-array))) - )) - (setq rest (cdr rest)) - ) + (null (setq f (intern-soft encoding ob-array))))) + (setq rest (cdr rest))) f)))) (defsubst mel-copy-method (service src-backend dst-backend) @@ -276,9 +271,8 @@ service." (when f (setq sym (intern dst-backend oa)) (or (fboundp sym) - (fset sym (symbol-function f)) - )))) - + (fset sym (symbol-function f)))))) + (defsubst mel-copy-backend (src-backend dst-backend) (let ((services mel-service-list)) (while services @@ -292,8 +286,7 @@ Each parent must be backend name (string)." (cons 'progn (mapcar (function (lambda (parent) - (` (mel-copy-backend (, parent) (, type))) - )) + (` (mel-copy-backend (, parent) (, type))))) parents))) (defmacro mel-define-method (name args &rest body) @@ -335,8 +328,7 @@ variable and (nth 1 (car (last ARGS))) is name of backend (encoding)." (class (nth 1 specializer))) (` (progn (define-function (, function) - (intern (, class) (, (intern (format "%s-obarray" name))))) - )))) + (intern (, class) (, (intern (format "%s-obarray" name))))))))) (defvar base64-dl-module (if (and (fboundp 'base64-encode-string) @@ -345,8 +337,7 @@ variable and (nth 1 (car (last ARGS))) is name of backend (encoding)." (if (fboundp 'dynamic-link) (let ((path (expand-file-name "base64.so" exec-directory))) (and (file-exists-p path) - path) - )))) + path))))) ;;; @ end diff --git a/mmbuffer.el b/mmbuffer.el index 97fc783..d1fef8d 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -35,8 +35,7 @@ body-start body-end)) - (luna-define-internal-accessors 'mime-buffer-entity) - ) + (luna-define-internal-accessors 'mime-buffer-entity)) (luna-define-method initialize-instance :after ((entity mime-buffer-entity) &rest init-args) @@ -64,8 +63,7 @@ (setq header-end (point-min) body-start (point-min))) (mime-buffer-entity-set-header-end-internal entity header-end) - (mime-buffer-entity-set-body-start-internal entity body-start) - ) + (mime-buffer-entity-set-body-start-internal entity body-start)) (or (mime-entity-content-type-internal entity) (save-restriction (narrow-to-region header-start header-end) @@ -73,15 +71,11 @@ entity (let ((str (std11-fetch-field "Content-Type"))) (if str - (mime-parse-Content-Type str) - ))) - )) - )) + (mime-parse-Content-Type str)))))))) entity) (luna-define-method mime-entity-name ((entity mime-buffer-entity)) - (buffer-name (mime-buffer-entity-buffer-internal entity)) - ) + (buffer-name (mime-buffer-entity-buffer-internal entity))) ;;; @ entity @@ -90,8 +84,7 @@ (luna-define-method mime-insert-entity ((entity mime-buffer-entity)) (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-body-end-internal entity)) - ) + (mime-buffer-entity-body-end-internal entity))) (luna-define-method mime-write-entity ((entity mime-buffer-entity) filename) (save-excursion @@ -99,8 +92,7 @@ (write-region-as-raw-text-CRLF (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-body-end-internal entity) - filename) - )) + filename))) ;;; @ entity header @@ -119,8 +111,7 @@ (luna-define-method mime-insert-entity-body ((entity mime-buffer-entity)) (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity)) - ) + (mime-buffer-entity-body-end-internal entity))) (luna-define-method mime-write-entity-body ((entity mime-buffer-entity) filename) @@ -128,8 +119,7 @@ (set-buffer (mime-buffer-entity-buffer-internal entity)) (write-region-as-binary (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) - filename) - )) + filename))) ;;; @ entity content @@ -157,8 +147,7 @@ (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename - (or (mime-entity-encoding entity) "7bit")) - )) + (or (mime-entity-encoding entity) "7bit")))) ;;; @ header field @@ -177,7 +166,7 @@ (or (symbolp field-name) (setq field-name (intern (capitalize (capitalize field-name))))) - (mime-entity-set-original-header-internal + (mime-entity-set-original-header-internal entity (put-alist field-name ret (mime-entity-original-header-internal entity))) @@ -190,83 +179,71 @@ (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-header-end-internal entity) - invisible-fields visible-fields) - ) + invisible-fields visible-fields)) ;;; @ header buffer ;;; ;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity)) -;; (mime-buffer-entity-buffer-internal entity) -;; ) +;; (mime-buffer-entity-buffer-internal entity)) ;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity)) ;; (set-buffer (mime-buffer-entity-buffer-internal entity)) -;; (goto-char (mime-buffer-entity-header-start-internal entity)) -;; ) +;; (goto-char (mime-buffer-entity-header-start-internal entity))) ;; (luna-define-method mime-entity-header-start-point ((entity ;; mime-buffer-entity)) -;; (mime-buffer-entity-header-start-internal entity) -;; ) +;; (mime-buffer-entity-header-start-internal entity)) ;; (luna-define-method mime-entity-header-end-point ((entity ;; mime-buffer-entity)) -;; (mime-buffer-entity-header-end-internal entity) -;; ) +;; (mime-buffer-entity-header-end-internal entity)) ;;; @ body buffer ;;; ;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity)) -;; (mime-buffer-entity-buffer-internal entity) -;; ) +;; (mime-buffer-entity-buffer-internal entity)) ;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity)) ;; (set-buffer (mime-buffer-entity-buffer-internal entity)) -;; (goto-char (mime-buffer-entity-body-start-internal entity)) -;; ) +;; (goto-char (mime-buffer-entity-body-start-internal entity))) ;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity)) ;; (set-buffer (mime-buffer-entity-buffer-internal entity)) -;; (goto-char (mime-buffer-entity-body-end-internal entity)) -;; ) +;; (goto-char (mime-buffer-entity-body-end-internal entity))) ;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity)) -;; (mime-buffer-entity-body-start-internal entity) -;; ) +;; (mime-buffer-entity-body-start-internal entity)) ;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity)) -;; (mime-buffer-entity-body-end-internal entity) -;; ) +;; (mime-buffer-entity-body-end-internal entity)) ;;; @ buffer (obsolete) ;;; ;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity)) -;; (mime-buffer-entity-buffer-internal entity) -;; ) +;; (mime-buffer-entity-buffer-internal entity)) ;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity)) -;; (mime-buffer-entity-header-start-internal entity) -;; ) +;; (mime-buffer-entity-header-start-internal entity)) ;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity)) -;; (mime-buffer-entity-body-end-internal entity) -;; ) +;; (mime-buffer-entity-body-end-internal entity)) ;;; @ children ;;; -(defun mmbuffer-parse-multipart (entity) +(defun mmbuffer-parse-multipart (entity &optional representation-type) (with-current-buffer (mime-buffer-entity-buffer-internal entity) - (let* ((representation-type - (mime-entity-representation-type-internal entity)) - (content-type (mime-entity-content-type-internal entity)) + (or representation-type + (setq representation-type + (mime-entity-representation-type-internal entity))) + (let* ((content-type (mime-entity-content-type-internal entity)) (dash-boundary (concat "--" (mime-content-type-parameter content-type "boundary"))) @@ -276,8 +253,7 @@ (dc-ctl (if (eq (mime-content-type-subtype content-type) 'digest) (make-mime-content-type 'message 'rfc822) - (make-mime-content-type 'text 'plain) - )) + (make-mime-content-type 'text 'plain))) (body-start (mime-buffer-entity-body-start-internal entity)) (body-end (mime-buffer-entity-body-end-internal entity))) (save-restriction @@ -300,27 +276,23 @@ (save-restriction (narrow-to-region cb ce) (setq ret (mime-parse-message representation-type dc-ctl - entity (cons i node-id))) - ) + entity (cons i node-id)))) (setq children (cons ret children)) (goto-char (setq cb ncb)) - (setq i (1+ i)) - ) + (setq i (1+ i))) (setq ce (point-max)) (save-restriction (narrow-to-region cb ce) (setq ret (mime-parse-message representation-type dc-ctl - entity (cons i node-id))) - ) + entity (cons i node-id)))) (setq children (cons ret children)) - (mime-entity-set-children-internal entity (nreverse children)) - ) + (mime-entity-set-children-internal entity (nreverse children))) (mime-entity-set-content-type-internal entity (make-mime-content-type 'message 'x-broken)) - nil) - )))) + nil))))) -(defun mmbuffer-parse-encapsulated (entity &optional external) +(defun mmbuffer-parse-encapsulated (entity &optional external + representation-type) (mime-entity-set-children-internal entity (with-current-buffer (mime-buffer-entity-buffer-internal entity) @@ -332,7 +304,8 @@ (progn (require 'mmexternal) 'mime-external-entity) - (mime-entity-representation-type-internal entity)) + (or representation-type + (mime-entity-representation-type-internal entity))) nil entity (cons 0 (mime-entity-node-id-internal entity)))))))) diff --git a/mmexternal.el b/mmexternal.el index 04e5649..9da0773 100644 --- a/mmexternal.el +++ b/mmexternal.el @@ -24,6 +24,7 @@ ;;; Code: +(require 'mmgeneric) (require 'mime) (require 'pces) diff --git a/qmtp.el b/qmtp.el index ef1a84d..feab66a 100644 --- a/qmtp.el +++ b/qmtp.el @@ -29,7 +29,7 @@ ;; To send mail using QMTP instead of SMTP, do -;; (fset 'smtp-via-smtp 'qmtp-via-qmtp) +;; (fset 'smtp-send-buffer 'qmtp-send-buffer) ;;; Code: diff --git a/smtp.el b/smtp.el index 418028c..82dccb6 100644 --- a/smtp.el +++ b/smtp.el @@ -32,9 +32,10 @@ ;;; Code: (require 'pces) -(require 'pcustom) +(require 'custom) (require 'mail-utils) ; mail-strip-quoted-names (require 'sasl) +(require 'luna) (defgroup smtp nil "SMTP protocol for sending mail." @@ -60,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) - (string :tag "smtp" "smtp")) + (string :tag "smtp" "smtp")) :group 'smtp) (defcustom smtp-local-domain nil @@ -120,36 +121,32 @@ don't define this value." (defvar smtp-submit-package-function (function smtp-submit-package)) -;;; @ SMTP package structure +;;; @ SMTP package ;;; A package contains a mail message, an envelope sender address, ;;; and one or more envelope recipient addresses. In ESMTP model ;;; the current sending package should be guaranteed to be accessible ;;; anywhere from the hook methods (or SMTP commands). -(defmacro smtp-package-sender (package) - "Return the sender of PACKAGE, a string." - (` (aref (, package) 0))) - -(defmacro smtp-package-recipients (package) - "Return the recipients of PACKAGE, a list of strings." - (` (aref (, package) 1))) +(eval-and-compile + (luna-define-class smtp-package () + (sender + recipients + buffer)) -(defmacro smtp-package-buffer (package) - "Return the data of PACKAGE, a buffer." - (` (aref (, package) 2))) + (luna-define-internal-accessors 'smtp-package)) -(defmacro smtp-make-package (sender recipients buffer) +(defun smtp-make-package (sender recipients buffer) "Create a new package structure. A package is a unit of SMTP message SENDER specifies the package sender, a string. RECIPIENTS is a list of recipients. BUFFER may be a buffer or a buffer name which contains mail message." - (` (vector (, sender) (, recipients) (, buffer)))) + (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer)) -(defun smtp-package-buffer-size (package) +(defun smtp-package-buffer-internal-size (package) "Return the size of PACKAGE, an integer." (save-excursion - (set-buffer (smtp-package-buffer package)) + (set-buffer (smtp-package-buffer-internal package)) (let ((size (+ (buffer-size) ;; Add one byte for each change-of-line @@ -165,49 +162,42 @@ BUFFER may be a buffer or a buffer name which contains mail message." (setq size (1+ size))) size))) -;;; @ SMTP connection structure +;;; @ SMTP connection ;;; We should consider the function `open-network-stream' is a emulation ;;; for another network stream. They are likely to be implemented with an ;;; external program and the function `process-contact' returns the ;;; process id instead of `(HOST SERVICE)' pair. -(defmacro smtp-connection-process (connection) - "Return the subprocess-object of CONNECTION." - (` (aref (, connection) 0))) - -(defmacro smtp-connection-server (connection) - "Return the server of CONNECTION, a string." - (` (aref (, connection) 1))) - -(defmacro smtp-connection-service (connection) - "Return the service of CONNECTION, a string or an integer." - (` (aref (, connection) 2))) - -(defmacro smtp-connection-extensions (connection) - "Return the SMTP extensions of CONNECTION, a list of strings." - (` (aref (, connection) 3))) +(eval-and-compile + (luna-define-class smtp-connection () + (process + server + service + extensions + encoder + decoder)) -(defmacro smtp-connection-set-extensions (connection extensions) - "Set the SMTP extensions of CONNECTION. -EXTENSIONS is a list of cons cells of the form \(EXTENSION . PARAMETERS). -Where EXTENSION is a symbol and PARAMETERS is a list of strings." - (` (aset (, connection) 3 (, extensions)))) + (luna-define-internal-accessors 'smtp-connection)) -(defmacro smtp-make-connection (process server service) +(defun smtp-make-connection (process server service) "Create a new connection structure. PROCESS is an internal subprocess-object. SERVER is name of the host to connect to. SERVICE is name of the service desired." - (` (vector (, process) (, server) (, service) nil))) + (luna-make-entity 'smtp-connection :process process :server server :service service)) -(defun smtp-connection-opened (connection) - "Say whether the CONNECTION to server has been opened." - (let ((process (smtp-connection-process connection))) +(luna-define-generic smtp-connection-opened (connection) + "Say whether the CONNECTION to server has been opened.") + +(luna-define-generic smtp-close-connection (connection) + "Close the CONNECTION to server.") + +(luna-define-method smtp-connection-opened ((connection smtp-connection)) + (let ((process (smtp-connection-process-internal connection))) (if (memq (process-status process) '(open run)) t))) -(defun smtp-close-connection (connection) - "Close the CONNECTION to server." - (let ((process (smtp-connection-process connection))) +(luna-define-method smtp-close-connection ((connection smtp-connection)) + (let ((process (smtp-connection-process-internal connection))) (delete-process process))) (defun smtp-make-fqdn () @@ -244,11 +234,12 @@ to connect to. SERVICE is name of the service desired." 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 - (as-binary-process + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (process (funcall smtp-open-connection-function - "SMTP" buffer server service))) - connection) + "SMTP" buffer server service)) + connection) (when process (setq connection (smtp-make-connection process server service)) (set-process-filter process 'smtp-process-filter) @@ -318,51 +309,43 @@ of the host to connect to. SERVICE is name of the service desired." (let* ((connection (smtp-find-connection (current-buffer))) (response - (smtp-read-response - (smtp-connection-process connection)))) + (smtp-read-response connection))) (if (/= (car response) 220) (smtp-response-error response)))) (defun smtp-primitive-ehlo (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process (format "EHLO %s" (smtp-make-fqdn))) - (setq response (smtp-read-response process)) + (smtp-send-command connection (format "EHLO %s" (smtp-make-fqdn))) + (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)) - (smtp-connection-set-extensions + (smtp-connection-set-extensions-internal connection (mapcar - (function - (lambda (extension) - (let ((extensions - (split-string extension))) - (setcar extensions - (car (read-from-string - (downcase (car extensions))))) - extensions))) + (lambda (extension) + (let ((extensions + (split-string extension))) + (setcar extensions + (car (read-from-string + (downcase (car extensions))))) + extensions)) (cdr response))))) (defun smtp-primitive-helo (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process (format "HELO %s" (smtp-make-fqdn))) - (setq response (smtp-read-response process)) + (smtp-send-command connection (format "HELO %s" (smtp-make-fqdn))) + (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)))) (defun smtp-primitive-auth (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) (mechanisms - (cdr (assq 'auth (smtp-connection-extensions connection)))) + (cdr (assq 'auth (smtp-connection-extensions-internal connection)))) (sasl-mechanisms (or smtp-sasl-mechanisms sasl-mechanisms)) (mechanism @@ -374,20 +357,20 @@ of the host to connect to. SERVICE is name of the service desired." (unless mechanism (error "No authentication mechanism available")) (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp" - (smtp-connection-server connection))) + (smtp-connection-server-internal connection))) (if smtp-sasl-properties (sasl-client-set-properties client smtp-sasl-properties)) (setq name (sasl-mechanism-name mechanism) ;; Retrieve the initial response step (sasl-next-step client nil)) (smtp-send-command - process + connection (if (sasl-step-data step) (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t)) (format "AUTH %s" name))) (catch 'done (while t - (setq response (smtp-read-response process)) + (setq response (smtp-read-response connection)) (when (= (car response) 235) ;; The authentication process is finished. (setq step (sasl-next-step client step)) @@ -399,97 +382,93 @@ of the host to connect to. SERVICE is name of the service desired." (sasl-step-set-data step (base64-decode-string (nth 1 response))) (setq step (sasl-next-step client step)) (smtp-send-command - process (if (sasl-step-data step) - (base64-encode-string (sasl-step-data step) t) - "")))))) + connection + (if (sasl-step-data step) + (base64-encode-string (sasl-step-data step) t) + "")))) + ;;; (smtp-connection-set-encoder-internal + ;;; connection (sasl-client-encoder client)) + ;;; (smtp-connection-set-decoder-internal + ;;; connection (sasl-client-decoder client)) + )) (defun smtp-primitive-starttls (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) ;; STARTTLS --- begin a TLS negotiation (RFC 2595) - (smtp-send-command process "STARTTLS") - (setq response (smtp-read-response process)) + (smtp-send-command connection "STARTTLS") + (setq response (smtp-read-response connection)) (if (/= (car response) 220) (smtp-response-error response)) - (starttls-negotiate process))) + (starttls-negotiate (smtp-connection-process-internal connection)))) (defun smtp-primitive-mailfrom (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) (extensions - (smtp-connection-extensions + (smtp-connection-extensions-internal connection)) (sender - (smtp-package-sender package)) + (smtp-package-sender-internal package)) extension response) ;; SIZE --- Message Size Declaration (RFC1870) (if (and smtp-use-size (assq 'size extensions)) - (setq extension (format "SIZE=%d" (smtp-package-buffer-size package)))) + (setq extension (format "SIZE=%d" (smtp-package-buffer-internal-size package)))) ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652) (if (and smtp-use-8bitmime (assq '8bitmime extensions)) (setq extension (concat extension " BODY=8BITMIME"))) (smtp-send-command - process + connection (if extension (format "MAIL FROM:<%s> %s" sender extension) (format "MAIL FROM:<%s>" sender))) - (setq response (smtp-read-response process)) + (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)))) (defun smtp-primitive-rcptto (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) (recipients - (smtp-package-recipients package)) + (smtp-package-recipients-internal package)) response) (while recipients (smtp-send-command - process (format "RCPT TO:<%s>" (pop recipients))) - (setq response (smtp-read-response process)) + connection (format "RCPT TO:<%s>" (pop recipients))) + (setq response (smtp-read-response connection)) (unless (memq (car response) '(250 251)) (smtp-response-error response))))) (defun smtp-primitive-data (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process "DATA") - (setq response (smtp-read-response process)) + (smtp-send-command connection "DATA") + (setq response (smtp-read-response connection)) (if (/= (car response) 354) (smtp-response-error response)) (save-excursion - (set-buffer (smtp-package-buffer package)) + (set-buffer (smtp-package-buffer-internal package)) (goto-char (point-min)) (while (not (eobp)) (smtp-send-data - process (buffer-substring (point) (progn (end-of-line)(point)))) + connection (buffer-substring (point) (progn (end-of-line)(point)))) (beginning-of-line 2))) - (smtp-send-command process ".") - (setq response (smtp-read-response process)) + (smtp-send-command connection ".") + (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)))) (defun smtp-primitive-quit (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process "QUIT") - (setq response (smtp-read-response process)) + (smtp-send-command connection "QUIT") + (setq response (smtp-read-response connection)) (if (/= (car response) 221) (smtp-response-error response)))) @@ -510,14 +489,20 @@ of the host to connect to. SERVICE is name of the service desired." (defun smtp-response-error (response) (signal 'smtp-response-error response)) -(defun smtp-read-response (process) - (let ((response-continue t) +(defun smtp-read-response (connection) + (let ((decoder + (smtp-connection-decoder-internal connection)) + (response-continue t) response) (while response-continue (goto-char smtp-read-point) (while (not (search-forward "\r\n" nil t)) - (accept-process-output process) + (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"))) (setq response (nconc response (list (buffer-substring @@ -531,21 +516,33 @@ of the host to connect to. SERVICE is name of the service desired." response-continue nil))) response)) -(defun smtp-send-command (process command) +(defun smtp-send-command (connection command) (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert command "\r\n") - (setq smtp-read-point (point)) - (process-send-string process command) - (process-send-string process "\r\n"))) - -(defun smtp-send-data (process data) - ;; Escape "." at start of a line. - (if (eq (string-to-char data) ?.) - (process-send-string process ".")) - (process-send-string process data) - (process-send-string process "\r\n")) + (let ((process + (smtp-connection-process-internal connection)) + (encoder + (smtp-connection-encoder-internal connection))) + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (setq command (concat command "\r\n")) + (insert command) + (setq smtp-read-point (point)) + (if encoder + (setq command (funcall encoder command))) + (process-send-string process command)))) + +(defun smtp-send-data (connection data) + (let ((process + (smtp-connection-process-internal connection)) + (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"))) + (if encoder + (setq data (funcall encoder data))) + (process-send-string process data))) (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO:
." diff --git a/std11.el b/std11.el index dc7bde5..e1276e5 100644 --- a/std11.el +++ b/std11.el @@ -1,8 +1,8 @@ ;;; std11.el --- STD 11 functions for GNU Emacs -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -435,8 +435,7 @@ be the result." (setq token (car lal)) (or (std11-ignored-token-p token) (if (and (setq token-value (cdr token)) - (find-non-ascii-charset-string token-value) - ) + (find-non-ascii-charset-string token-value)) (setq token nil) ))) (setq lal (cdr lal)) -- 1.7.10.4