From 9ef92bef33ada3844eb20f5e2d1a9db9355ead21 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 31 Oct 2000 04:53:17 +0000 Subject: [PATCH] Synch with Gnus. --- lisp/ChangeLog | 11 +++ lisp/mml.el | 260 ++++++++++++++++++++++++------------------------------- lisp/mml2015.el | 20 ++--- lisp/qp.el | 6 +- 4 files changed, 139 insertions(+), 158 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d800645..0d46836 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2000-10-30 23:37:07 ShengHuo ZHU + + * qp.el (quoted-printable-encode-region): Replace leading - when + ultra safe. + * mml.el (mml-generate-mime-postprocess-function): Removed. + (mml-postprocess-alist): Removed. + (mml-generate-mime-1): Use ultra-safe when sign. + * mml2015.el (mml2015-fix-micalg): Uppercase. + (mml2015-verify): Insert LF. + (mml2015-mailcrypt-sign): Downcase; search backward. + 2000-10-16 11:36:52 Lars Magne Ingebrigtsen * nnultimate.el (nnultimate-forum-table-p): Be a bit more diff --git a/lisp/mml.el b/lisp/mml.el index ed8753d..3950474 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -73,27 +73,6 @@ unknown encoding; `use-ascii': always use ASCII for those characters with unknown encoding; `multipart': always send messages with more than one charsets.") -(defvar mml-generate-mime-preprocess-function nil - "A function called before generating a mime part. -The function is called with one parameter, which is the part to be -generated.") - -(defvar mml-generate-mime-postprocess-function 'mml-postprocess - "A function called after generating a mime part. -The function is called with one parameter, which is the generated part.") - -(autoload 'mml2015-sign "mml2015") -(autoload 'mml2015-encrypt "mml2015") -(autoload 'mml-smime-encrypt "mml-smime") -(autoload 'mml-smime-sign "mml-smime") - -(defvar mml-postprocess-alist - '(("pgp-sign" . mml2015-sign) - ("pgp-encrypt" . mml2015-encrypt) - ("smime-sign" . mml-smime-sign) - ("smime-encrypt" . mml-smime-encrypt)) - "Alist of postprocess functions.") - (defvar mml-generate-default-type "text/plain") (defvar mml-buffer-list nil) @@ -300,130 +279,128 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (buffer-string))))) (defun mml-generate-mime-1 (cont) - (save-restriction - (narrow-to-region (point) (point)) - (if mml-generate-mime-preprocess-function - (funcall mml-generate-mime-preprocess-function cont)) - (cond - ((or (eq (car cont) 'part) (eq (car cont) 'mml)) - (let ((raw (cdr (assq 'raw cont))) - coded encoding charset filename type) - (setq type (or (cdr (assq 'type cont)) "text/plain")) - (if (and (not raw) - (member (car (split-string type "/")) '("text" "message"))) - (with-temp-buffer + (let ((mm-use-ultra-safe-encoding + (or mm-use-ultra-safe-encoding (assq 'sign cont)))) + (save-restriction + (narrow-to-region (point) (point)) + (cond + ((or (eq (car cont) 'part) (eq (car cont) 'mml)) + (let ((raw (cdr (assq 'raw cont))) + coded encoding charset filename type) + (setq type (or (cdr (assq 'type cont)) "text/plain")) + (if (and (not raw) + (member (car (split-string type "/")) '("text" "message"))) + (with-temp-buffer + (cond + ((cdr (assq 'buffer cont)) + (insert-buffer-substring (cdr (assq 'buffer cont)))) + ((and (setq filename (cdr (assq 'filename cont))) + (not (equal (cdr (assq 'nofile cont)) "yes"))) + (mm-insert-file-contents filename)) + ((eq 'mml (car cont)) + (insert (cdr (assq 'contents cont)))) + (t + (save-restriction + (narrow-to-region (point) (point)) + (insert (cdr (assq 'contents cont))) + ;; Remove quotes from quoted tags. + (goto-char (point-min)) + (while (re-search-forward + "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) + (delete-region (+ (match-beginning 0) 2) + (+ (match-beginning 0) 3)))))) + (cond + ((eq (car cont) 'mml) + (let ((mml-boundary (funcall mml-boundary-function + (incf mml-multipart-number))) + (mml-generate-default-type "text/plain")) + (mml-to-mime)) + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + ((string= (car (split-string type "/")) "message") + (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) + ;; ignore 0x1b, it is part of iso-2022-jp + (setq encoding (mm-body-7-or-8)))) + (t + (setq charset (mm-encode-body)) + (setq encoding (mm-body-encoding + charset (cdr (assq 'encoding cont)))))) + (setq coded (buffer-string))) + (mm-with-unibyte-buffer (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and (setq filename (cdr (assq 'filename cont))) (not (equal (cdr (assq 'nofile cont)) "yes"))) - (mm-insert-file-contents filename)) - ((eq 'mml (car cont)) - (insert (cdr (assq 'contents cont)))) + (let ((coding-system-for-read mm-binary-coding-system)) + (mm-insert-file-contents filename nil nil nil nil t))) (t - (save-restriction - (narrow-to-region (point) (point)) - (insert (cdr (assq 'contents cont))) - ;; Remove quotes from quoted tags. - (goto-char (point-min)) - (while (re-search-forward - "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3)))))) - (cond - ((eq (car cont) 'mml) - (let ((mml-boundary (funcall mml-boundary-function - (incf mml-multipart-number))) - (mml-generate-default-type "text/plain")) - (mml-to-mime)) - (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) - ;; ignore 0x1b, it is part of iso-2022-jp - (setq encoding (mm-body-7-or-8)))) - ((string= (car (split-string type "/")) "message") - (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) - ;; ignore 0x1b, it is part of iso-2022-jp - (setq encoding (mm-body-7-or-8)))) - (t - (setq charset (mm-encode-body)) - (setq encoding (mm-body-encoding - charset (cdr (assq 'encoding cont)))))) - (setq coded (buffer-string))) - (mm-with-unibyte-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and (setq filename (cdr (assq 'filename cont))) - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read mm-binary-coding-system)) - (mm-insert-file-contents filename nil nil nil nil t))) - (t - (insert (cdr (assq 'contents cont))))) - (setq encoding (mm-encode-buffer type) - coded (buffer-string)))) - (mml-insert-mime-headers cont type charset encoding) - (insert "\n") - (insert coded))) - ((eq (car cont) 'external) - (insert "Content-Type: message/external-body") - (let ((parameters (mml-parameter-string - cont '(expiration size permission))) - (name (cdr (assq 'name cont)))) - (when name - (setq name (mml-parse-file-name name)) - (if (stringp name) + (insert (cdr (assq 'contents cont))))) + (setq encoding (mm-encode-buffer type) + coded (buffer-string)))) + (mml-insert-mime-headers cont type charset encoding) + (insert "\n") + (insert coded))) + ((eq (car cont) 'external) + (insert "Content-Type: message/external-body") + (let ((parameters (mml-parameter-string + cont '(expiration size permission))) + (name (cdr (assq 'name cont)))) + (when name + (setq name (mml-parse-file-name name)) + (if (stringp name) + (mml-insert-parameter + (mail-header-encode-parameter "name" name) + "access-type=local-file") (mml-insert-parameter - (mail-header-encode-parameter "name" name) - "access-type=local-file") - (mml-insert-parameter - (mail-header-encode-parameter - "name" (file-name-nondirectory (nth 2 name))) - (mail-header-encode-parameter "site" (nth 1 name)) - (mail-header-encode-parameter - "directory" (file-name-directory (nth 2 name)))) - (mml-insert-parameter - (concat "access-type=" - (if (member (nth 0 name) '("ftp@" "anonymous@")) - "anon-ftp" - "ftp"))))) - (when parameters - (mml-insert-parameter-string - cont '(expiration size permission)))) - (insert "\n\n") - (insert "Content-Type: " (cdr (assq 'type cont)) "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: " - (or (cdr (assq 'encoding cont)) "binary")) - (insert "\n\n") - (insert (or (cdr (assq 'contents cont)))) - (insert "\n")) - ((eq (car cont) 'multipart) - (let* ((type (or (cdr (assq 'type cont)) "mixed")) - (mml-generate-default-type (if (equal type "digest") - "message/rfc822" - "text/plain")) - (handler (assoc type mml-generate-multipart-alist))) - (if handler - (funcall (cdr handler) cont) - ;; No specific handler. Use default one. - (let ((mml-boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" - type mml-boundary)) - ;; Skip `multipart' and `type' elements. - (setq cont (cddr cont)) - (while cont - (insert "\n--" mml-boundary "\n") - (mml-generate-mime-1 (pop cont))) - (insert "\n--" mml-boundary "--\n"))))) - (t - (error "Invalid element: %S" cont))) - (if mml-generate-mime-postprocess-function - (funcall mml-generate-mime-postprocess-function cont)) - (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist))) - (when item - (funcall (nth 1 item) cont))) - (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist))) - (when item - (funcall (nth 1 item) cont))))) + (mail-header-encode-parameter + "name" (file-name-nondirectory (nth 2 name))) + (mail-header-encode-parameter "site" (nth 1 name)) + (mail-header-encode-parameter + "directory" (file-name-directory (nth 2 name)))) + (mml-insert-parameter + (concat "access-type=" + (if (member (nth 0 name) '("ftp@" "anonymous@")) + "anon-ftp" + "ftp"))))) + (when parameters + (mml-insert-parameter-string + cont '(expiration size permission)))) + (insert "\n\n") + (insert "Content-Type: " (cdr (assq 'type cont)) "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: " + (or (cdr (assq 'encoding cont)) "binary")) + (insert "\n\n") + (insert (or (cdr (assq 'contents cont)))) + (insert "\n")) + ((eq (car cont) 'multipart) + (let* ((type (or (cdr (assq 'type cont)) "mixed")) + (mml-generate-default-type (if (equal type "digest") + "message/rfc822" + "text/plain")) + (handler (assoc type mml-generate-multipart-alist))) + (if handler + (funcall (cdr handler) cont) + ;; No specific handler. Use default one. + (let ((mml-boundary (mml-compute-boundary cont))) + (insert (format "Content-Type: multipart/%s; boundary=\"%s\"\n" + type mml-boundary)) + ;; Skip `multipart' and `type' elements. + (setq cont (cddr cont)) + (while cont + (insert "\n--" mml-boundary "\n") + (mml-generate-mime-1 (pop cont))) + (insert "\n--" mml-boundary "--\n"))))) + (t + (error "Invalid element: %S" cont))) + (let ((item (assoc (cdr (assq 'sign cont)) mml-sign-alist))) + (when item + (funcall (nth 1 item) cont))) + (let ((item (assoc (cdr (assq 'encrypt cont)) mml-encrypt-alist))) + (when item + (funcall (nth 1 item) cont)))))) (defun mml-compute-boundary (cont) "Return a unique boundary that does not exist in CONT." @@ -880,13 +857,6 @@ If RAW, don't highlight the article." (interactive) (mml-parse)) -(defun mml-postprocess (cont) - (let ((pp (cdr (or (assq 'postprocess cont) - (assq 'pp cont)))) - item) - (if (and pp (setq item (assoc pp mml-postprocess-alist))) - (funcall (cdr item) cont)))) - (provide 'mml) ;;; mml.el ends here diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 9651553..4153f5e 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -61,9 +61,10 @@ (list handles)))) (defun mml2015-fix-micalg (alg) - (if (and alg (string-match "^pgp-" alg)) - (substring alg (match-end 0)) - alg)) + (upcase + (if (and alg (string-match "^pgp-" alg)) + (substring alg (match-end 0)) + alg))) ;;;###autoload (defun mml2015-verify (handle ctl) @@ -77,10 +78,8 @@ (or (mml2015-fix-micalg (mail-content-type-get ctl 'micalg)) "SHA1"))) - (insert part) + (insert part "\n") (goto-char (point-max)) - (unless (bolp) - (insert "\n")) (unless (setq part (mm-find-part-by-type (cdr handle) "application/pgp-signature")) (error "Corrupted pgp-signature part.")) @@ -120,10 +119,10 @@ (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" boundary)) (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n" - hash)) - (insert "\n") - (insert (format "--%s\n" boundary)) - (unless (re-search-forward (cdr (assq 'signed-end-line scheme-alist))) + (downcase hash))) + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (unless (re-search-backward (cdr (assq 'signed-end-line scheme-alist))) (error "Cannot find signature part." )) (goto-char (match-beginning 0)) (unless (re-search-backward "^-+BEGIN" nil t) @@ -135,7 +134,6 @@ (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) - (defun mml2015-mailcrypt-encrypt (cont) (mc-encrypt-generic (or (message-options-get 'message-recipients) diff --git a/lisp/qp.el b/lisp/qp.el index 79e4362..4dccdcf 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -125,8 +125,10 @@ encode lines starting with \"From\"." ;; line. (when mm-use-ultra-safe-encoding (beginning-of-line) - (when (looking-at "From ") - (replace-match "From=20" nil t))) + (if (looking-at "From ") + (replace-match "From=20" nil t) + (if (looking-at "-") + (replace-match "=2D" nil t)))) (end-of-line) (while (> (current-column) 76);; tab-width must be 1. (beginning-of-line) -- 1.7.10.4