From bd337a9e766103b0503665a8a8d10e334f4b983f Mon Sep 17 00:00:00 2001 From: yamaoka Date: Tue, 24 Sep 2002 22:46:05 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 17 +++++ lisp/gnus-art.el | 2 +- lisp/gnus-start.el | 3 + lisp/mml2015.el | 212 +++++++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 229 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ea3ea82..3cd9f18 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2002-09-24 ShengHuo ZHU + + * gnus-start.el (gnus-1): Create nndraft:queue, nndraft:drafts. + +2002-09-24 Simon Josefsson + + * mml2015.el (top-level): Require mm-util for mm-make-temp-file. + (mml2015-use): Prefer PGG if installed. + (mml2015-function-alist): Add PGG wrappers. + (mml2015-gpg-extract-signature-details): Check mml2015-use too. + (mml2015-gpg-extract-signature-details): PGG strips "gpg: " + prefix, make regexp optionally skip it. + (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt) + (mml2015-pgg-verify, mml2015-pgg-clear-verify, mml2015-pgg-sign) + (mml2015-pgg-encrypt): New functions. + (defvar, autoload): Prevent byte-compile warnings. + 2002-09-24 Katsumi Yamaoka From TSUCHIYA Masatoshi . diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index dcbc3fd..7fb2fb5 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -5861,7 +5861,7 @@ guessing." gnus-button-handle-describe-prefix ""))) (defun gnus-button-handle-apropos-variable (url) - "Call apropos when pushing the corresponing URL button." + "Call apropos when pushing the corresponding URL button." (apropos-variable (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) (defcustom gnus-button-man-level 5 diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 14725c5..40dacd0 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -754,6 +754,9 @@ prompt the user for the name of an NNTP server to use." (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) ;; Do the actual startup. + (if gnus-agent + (gnus-request-create-group "queue" '(nndraft ""))) + (gnus-request-create-group "drafts" '(nndraft "")) (gnus-setup-news nil level dont-connect) (gnus-run-hooks 'gnus-setup-news-hook) (gnus-start-draft-setup) diff --git a/lisp/mml2015.el b/lisp/mml2015.el index ff6c04d..0b8751f 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -31,10 +31,16 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'gnus-clfns)) (require 'mm-decode) +(require 'mm-util) (defvar mml2015-use (or (progn (ignore-errors + (require 'pgg)) + (and (fboundp 'pgg-sign-region) + 'pgg)) + (progn + (ignore-errors (require 'gpg)) (and (fboundp 'gpg-sign-detached) 'gpg)) @@ -59,7 +65,13 @@ mml2015-gpg-verify mml2015-gpg-decrypt mml2015-gpg-clear-verify - mml2015-gpg-clear-decrypt)) + mml2015-gpg-clear-decrypt) + (pgg mml2015-pgg-sign + mml2015-pgg-encrypt + mml2015-pgg-verify + mml2015-pgg-decrypt + mml2015-pgg-clear-verify + mml2015-pgg-clear-decrypt)) "Alist of PGP/MIME functions.") (defvar mml2015-result-buffer nil) @@ -416,7 +428,8 @@ by you.") (defun mml2015-gpg-extract-signature-details () (goto-char (point-min)) - (if (boundp 'gpg-unabbrev-trust-alist) + (if (and (eq mml2015-use 'gpg) + (boundp 'gpg-unabbrev-trust-alist)) (let* ((expired (re-search-forward "^\\[GNUPG:\\] SIGEXPIRED$" nil t)) @@ -443,8 +456,8 @@ by you.") (car signer))))) (t "From unknown user"))) - (if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t) - (match-string 1) + (if (re-search-forward "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) + (match-string 2) "From unknown user"))) (defun mml2015-gpg-verify (handle ctl) @@ -621,6 +634,197 @@ by you.") (insert (format "--%s--\n" boundary)) (goto-char (point-max)))))) +;;; pgg wrapper + +(eval-when-compile + (defvar pgg-errors-buffer) + (defvar pgg-output-buffer)) + +(eval-and-compile + (autoload 'pgg-decrypt-region "gpg") + (autoload 'pgg-verify-region "gpg") + (autoload 'pgg-sign-region "gpg") + (autoload 'pgg-encrypt-region "gpg")) + +(defun mml2015-pgg-decrypt (handle ctl) + (catch 'error + (let ((pgg-errors-buffer mml2015-result-buffer) + child handles result decrypt-status) + (unless (setq child (mm-find-part-by-type + (cdr handle) + "application/octet-stream" nil t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (with-temp-buffer + (mm-insert-part child) + (if (condition-case err + (prog1 + (pgg-decrypt-region (point-min) (point-max)) + (setq decrypt-status (with-current-buffer mml2015-result-buffer + (buffer-string)))) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (with-current-buffer pgg-output-buffer + (setq handles (mm-dissect-buffer t)) + (mm-destroy-parts handle) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (concat decrypt-status "\n" (mm-handle-multipart-ctl-parameter handles 'gnus-details))) + (if (listp (car handles)) + handles + (list handles))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed")))))) + +(defun mml2015-pgg-clear-decrypt () + (let ((pgg-errors-buffer mml2015-result-buffer)) + (if (prog1 + (pgg-decrypt-region (point-min) (point-max)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer mml2015-result-buffer + (buffer-string)))) + (progn + (erase-buffer) + (insert-buffer pgg-output-buffer) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK")) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed")))) + +(defun mml2015-pgg-verify (handle ctl) + (let ((pgg-errors-buffer mml2015-result-buffer) + signature-file part signature) + (if (or (null (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter + ctl 'protocol) + "application/pgp-signature") + t))) + (null (setq signature (mm-find-part-by-type + (cdr handle) "application/pgp-signature" nil t)))) + (progn + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + handle) + (with-temp-buffer + (insert part) + ;; Convert to in verify mode. Sign and + ;; clearsign use --textmode. The conversion is not necessary. + ;; In clearverify, the conversion is not necessary either. + (goto-char (point-min)) + (end-of-line) + (while (not (eobp)) + (unless (eq (char-before) ?\r) + (insert "\r")) + (forward-line) + (end-of-line)) + (with-temp-file (setq signature-file (mm-make-temp-file "pgg")) + (mm-insert-part signature)) + (if (condition-case err + (prog1 + (pgg-verify-region (point-min) (point-max) signature-file t) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer pgg-output-buffer + (buffer-string)))) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (progn + (delete-file signature-file) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (with-current-buffer pgg-output-buffer + (mml2015-gpg-extract-signature-details)))) + (delete-file signature-file) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed")))))) + +(defun mml2015-pgg-clear-verify () + (let ((pgg-errors-buffer mml2015-result-buffer)) + (if (condition-case err + (prog1 + (pgg-verify-region (point-min) (point-max) nil t) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer mml2015-result-buffer + (buffer-string)))) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (with-current-buffer pgg-output-buffer + (mml2015-gpg-extract-signature-details))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed")))) + +(defun mml2015-pgg-sign (cont) + (let ((pgg-errors-buffer mml2015-result-buffer) + (boundary (funcall mml-boundary-function (incf mml-multipart-number)))) + (unless (pgg-sign-region (point-min) (point-max)) + (pop-to-buffer mml2015-result-buffer) + (error "Sign error")) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + ;;; FIXME: what is the micalg? + (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s\n" boundary)) + (insert "Content-Type: application/pgp-signature\n\n") + (insert-buffer pgg-output-buffer) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +(defun mml2015-pgg-encrypt (cont &optional sign) + (let ((pgg-errors-buffer mml2015-result-buffer) + (boundary (funcall mml-boundary-function (incf mml-multipart-number)))) + (unless (pgg-encrypt-region (point-min) (point-max) + (split-string + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+")) + (pop-to-buffer mml2015-result-buffer) + (error "Encrypt error")) + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" + boundary)) + (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/octet-stream\n\n") + (insert-buffer pgg-output-buffer) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + ;;; General wrapper (defun mml2015-clean-buffer () -- 1.7.10.4