Mercurial > emacs
diff lisp/gnus/mml2015.el @ 110583:b6d2a63ad993
Merge changes made in Gnus trunk.
nnimap.el: Implement partial IMAP article fetch.
nnimap.el: Have nnimap not update the infos if it can't get info from the server.
Implement functions for showing the complete articles.
gnus-int.el (gnus-open-server): Don't query whether to go offline -- just do it.
gnus-art.el (gnus-mime-delete-part): Fix plural for "byte" when there isn't a single byte.
nndoc.el (nndoc-type-alist): Move mime-parts after mbox. Suggested by Jay Berkenbilt.
mm-decode.el (mm-save-part): Allow saving to other directories the normal Emacs way.
gnus-html.el (gnus-html-rescale-image): Use our defalias gnus-window-inside-pixel-edges.
gnus-srvr.el (gnus-server-copy-server): Add documentation.
gnus.texi (Using IMAP): Document the new nnimap.
nnimap.el (nnimap-wait-for-response): Search further when we're not using streaming.
gnus-int.el (gnus-check-server): Say what the error was when opening failed.
nnheader.el (nnheader-get-report-string): New function.
gnus-int.el (gnus-check-server): Use report-string.
nnimap.el (nnimap-open-connection): Add more error reporting when nnimap fails early.
gnus-start.el (gnus-get-unread-articles): Don't try to open failed servers twice.
nnimap.el (nnimap-wait-for-response): Reversed logic in the nnimap-streaming test.
gnus-art.el: Removed CTAN button stuff, which I don't think is very relevant any more.
Remove NoCeM support, since nobody seems to use it any more.
Remove earcon and gnus-audio.
gnus.el (gnus): Silence gnus-load message.
gnus-group.el (gnus-read-ephemeral-bug-group): Add the bug email address to the To list for easier response.
gnus.texi (Connecting to an IMAP Server): Show how to use as primary method instead of secondary.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sun, 26 Sep 2010 04:03:19 +0000 |
parents | f567b340d004 |
children | 6c6f3972c99c |
line wrap: on
line diff
--- a/lisp/gnus/mml2015.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/mml2015.el Sun Sep 26 04:03:19 2010 +0000 @@ -63,11 +63,6 @@ (require 'pgg))) (and (fboundp 'pgg-sign-region) 'pgg)) - (progn - (ignore-errors - (require 'gpg)) - (and (fboundp 'gpg-sign-detached) - 'gpg)) (progn (ignore-errors (load "mc-toplev")) (and (fboundp 'mc-encrypt-generic) @@ -75,7 +70,7 @@ (fboundp 'mc-cleanup-recipient-headers) 'mailcrypt))) "The package used for PGP/MIME. -Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") +Valid packages include `epg', `pgg' and `mailcrypt'.") ;; Something is not RFC2015. (defvar mml2015-function-alist @@ -85,24 +80,18 @@ mml2015-mailcrypt-decrypt mml2015-mailcrypt-clear-verify mml2015-mailcrypt-clear-decrypt) - (gpg mml2015-gpg-sign - mml2015-gpg-encrypt - mml2015-gpg-verify - mml2015-gpg-decrypt - mml2015-gpg-clear-verify - 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) - (epg mml2015-epg-sign - mml2015-epg-encrypt - mml2015-epg-verify - mml2015-epg-decrypt - mml2015-epg-clear-verify - mml2015-epg-clear-decrypt)) + (pgg mml2015-pgg-sign + mml2015-pgg-encrypt + mml2015-pgg-verify + mml2015-pgg-decrypt + mml2015-pgg-clear-verify + mml2015-pgg-clear-decrypt) + (epg mml2015-epg-sign + mml2015-epg-encrypt + mml2015-epg-verify + mml2015-epg-decrypt + mml2015-epg-clear-verify + mml2015-epg-clear-decrypt)) "Alist of PGP/MIME functions.") (defvar mml2015-result-buffer nil) @@ -148,7 +137,7 @@ ;; Extract plaintext from cleartext signature. IMO, this kind of task ;; should be done by GnuPG rather than Elisp, but older PGP backends -;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG. +;; (such as Mailcrypt, and PGG) discard the output from GnuPG. (defun mml2015-extract-cleartext-signature () ;; Daiki Ueno in ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still @@ -234,6 +223,58 @@ handles (list handles))))) +(defun mml2015-gpg-pretty-print-fpr (fingerprint) + (let* ((result "") + (fpr-length (string-width fingerprint)) + (n-slice 0) + slice) + (setq fingerprint (string-to-list fingerprint)) + (while fingerprint + (setq fpr-length (- fpr-length 4)) + (setq slice (butlast fingerprint fpr-length)) + (setq fingerprint (nthcdr 4 fingerprint)) + (setq n-slice (1+ n-slice)) + (setq result + (concat + result + (case n-slice + (1 slice) + (otherwise (concat " " slice)))))) + result)) + +(defun mml2015-gpg-extract-signature-details () + (goto-char (point-min)) + (let* ((expired (re-search-forward + "^\\[GNUPG:\\] SIGEXPIRED$" + nil t)) + (signer (and (re-search-forward + "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" + nil t) + (cons (match-string 1) (match-string 2)))) + (fprint (and (re-search-forward + "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " + nil t) + (match-string 1))) + (trust (and (re-search-forward + "^\\[GNUPG:\\] \\(TRUST_.*\\)$" + nil t) + (match-string 1))) + (trust-good-enough-p + (cdr (assoc trust mml2015-unabbrev-trust-alist)))) + (cond ((and signer fprint) + (concat (cdr signer) + (unless trust-good-enough-p + (concat "\nUntrusted, Fingerprint: " + (mml2015-gpg-pretty-print-fpr fprint))) + (when expired + (format "\nWARNING: Signature from expired key (%s)" + (car signer))))) + ((re-search-forward + "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) + (match-string 2)) + (t + "From unknown user")))) + (defun mml2015-mailcrypt-clear-decrypt () (let (result) (setq result @@ -446,280 +487,6 @@ (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) -;;; gpg wrapper - -(autoload 'gpg-decrypt "gpg") -(autoload 'gpg-verify "gpg") -(autoload 'gpg-verify-cleartext "gpg") -(autoload 'gpg-sign-detached "gpg") -(autoload 'gpg-sign-encrypt "gpg") -(autoload 'gpg-encrypt "gpg") -(autoload 'gpg-passphrase-read "gpg") - -(defun mml2015-gpg-passphrase () - (or (message-options-get 'gpg-passphrase) - (message-options-set 'gpg-passphrase (gpg-passphrase-read)))) - -(defun mml2015-gpg-decrypt-1 () - (let ((cipher (current-buffer)) plain result) - (if (with-temp-buffer - (prog1 - (gpg-decrypt cipher (setq plain (current-buffer)) - mml2015-result-buffer nil) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string))) - (set-buffer cipher) - (erase-buffer) - (insert-buffer-substring plain) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)))) - '(t) - ;; Some wrong with the return value, check plain text buffer. - (if (> (point-max) (point-min)) - '(t) - nil)))) - -(defun mml2015-gpg-decrypt (handle ctl) - (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1)) - (mml2015-mailcrypt-decrypt handle ctl))) - -(defun mml2015-gpg-clear-decrypt () - (let (result) - (setq result (mml2015-gpg-decrypt-1)) - (if (car result) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-gpg-pretty-print-fpr (fingerprint) - (let* ((result "") - (fpr-length (string-width fingerprint)) - (n-slice 0) - slice) - (setq fingerprint (string-to-list fingerprint)) - (while fingerprint - (setq fpr-length (- fpr-length 4)) - (setq slice (butlast fingerprint fpr-length)) - (setq fingerprint (nthcdr 4 fingerprint)) - (setq n-slice (1+ n-slice)) - (setq result - (concat - result - (case n-slice - (1 slice) - (otherwise (concat " " slice)))))) - result)) - -(defun mml2015-gpg-extract-signature-details () - (goto-char (point-min)) - (let* ((expired (re-search-forward - "^\\[GNUPG:\\] SIGEXPIRED$" - nil t)) - (signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" - nil t) - (cons (match-string 1) (match-string 2)))) - (fprint (and (re-search-forward - "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " - nil t) - (match-string 1))) - (trust (and (re-search-forward - "^\\[GNUPG:\\] \\(TRUST_.*\\)$" - nil t) - (match-string 1))) - (trust-good-enough-p - (cdr (assoc trust mml2015-unabbrev-trust-alist)))) - (cond ((and signer fprint) - (concat (cdr signer) - (unless trust-good-enough-p - (concat "\nUntrusted, Fingerprint: " - (mml2015-gpg-pretty-print-fpr fprint))) - (when expired - (format "\nWARNING: Signature from expired key (%s)" - (car signer))))) - ((re-search-forward - "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) - (match-string 2)) - (t - "From unknown user")))) - -(defun mml2015-gpg-verify (handle ctl) - (catch 'error - (let (part message signature info-is-set-p) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter - ctl 'protocol) - "application/pgp-signature") - t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (setq message (current-buffer)) - (insert part) - ;; Convert <LF> to <CR><LF> in signed text. If --textmode is - ;; specified when signing, the conversion is not necessary. - (goto-char (point-min)) - (end-of-line) - (while (not (eobp)) - (unless (eq (char-before) ?\r) - (insert "\r")) - (forward-line) - (end-of-line)) - (with-temp-buffer - (setq signature (current-buffer)) - (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (mm-insert-part part) - (unless (condition-case err - (prog1 - (gpg-verify message signature mml2015-result-buffer) - (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)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Error.") - (setq info-is-set-p t) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Quit.") - (setq info-is-set-p t) - nil)) - (unless info-is-set-p - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (throw 'error handle))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details)))) - handle))) - -(defun mml2015-gpg-clear-verify () - (if (condition-case err - (prog1 - (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) - (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 mml2015-result-buffer - (mml2015-gpg-extract-signature-details))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (mml2015-extract-cleartext-signature)) - -(defun mml2015-gpg-sign (cont) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) signature) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (with-temp-buffer - (unless (gpg-sign-detached text (setq signature (current-buffer)) - mml2015-result-buffer - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (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-substring signature) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max))))) - -(defun mml2015-gpg-encrypt (cont &optional sign) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) - cipher) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (mm-disable-multibyte) - ;; set up a function to call the correct gpg encrypt routine - ;; with the right arguments. (FIXME: this should be done - ;; differently.) - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign ; passed in when using signencrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (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-substring cipher) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))))) - ;;; pgg wrapper (defvar pgg-default-user-id)