Function: mm-possibly-verify-or-decrypt

mm-possibly-verify-or-decrypt is a byte-compiled function defined in mm-decode.el.gz.

Signature

(mm-possibly-verify-or-decrypt PARTS CTL &optional FROM)

Aliases

mh-mm-possibly-verify-or-decrypt (obsolete since 29.1)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/mm-decode.el.gz
(defun mm-possibly-verify-or-decrypt (parts ctl &optional from)
  (let ((type (car ctl))
	(subtype (cadr (split-string (car ctl) "/")))
	(mm-security-handle ctl) ;; (car CTL) is the type.
	(smime-type (cdr (assq 'smime-type (mm-handle-type parts))))
	protocol func functest)
    (cond
     ((or (equal type "application/x-pkcs7-mime")
	  (equal type "application/pkcs7-mime"))
      (add-text-properties 0 (length (car ctl))
                           (list 'buffer (car parts))
                           (car ctl))
      (let* ((envelope-p (string= smime-type "enveloped-data"))
             (decrypt-or-verify-option (if envelope-p
                                           mm-decrypt-option
                                         mm-verify-option))
             (question (if envelope-p
                           "Decrypt (S/MIME) part? "
                         "Verify signed (S/MIME) part? ")))
        (with-temp-buffer
	  (when (and (cond
		      ((equal smime-type "signed-data") t)
		      ((eq decrypt-or-verify-option 'never) nil)
		      ((eq decrypt-or-verify-option 'always) t)
		      ((eq decrypt-or-verify-option 'known) t)
		      (t (y-or-n-p (format question))))
                     (mm-view-pkcs7 parts from))

	    (goto-char (point-min))
	    ;; The encrypted document is a MIME part, and may use either
	    ;; CRLF (Outlook and the like) or newlines for end-of-line
	    ;; markers.  Translate from CRLF.
	    (while (search-forward "\r\n" nil t)
	      (replace-match "\n"))
	    ;; Normally there will be a Content-type header here, but
	    ;; some mailers don't add that to the encrypted part, which
	    ;; makes the subsequent re-dissection fail here.
	    (save-restriction
	      (mail-narrow-to-head)
	      (unless (mail-fetch-field "content-type")
                (goto-char (point-max))
                (insert "Content-type: text/plain\n\n")))
	    (setq parts (mm-dissect-buffer t))))))
     ((equal subtype "signed")
      (unless (and (setq protocol
			 (mm-handle-multipart-ctl-parameter ctl 'protocol))
		   (not (equal protocol "multipart/mixed")))
	;; The message is broken or draft-ietf-openpgp-multsig-01.
	(let ((protocols mm-verify-function-alist))
	  (while protocols
	    (if (and (or (not (setq functest (nth 3 (car protocols))))
			 (funcall functest parts ctl))
		     (mm-find-part-by-type parts (caar protocols) nil t))
		(setq protocol (caar protocols)
		      protocols nil)
	      (setq protocols (cdr protocols))))))
      (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
      (when (cond
	     ((eq mm-verify-option 'never) nil)
	     ((eq mm-verify-option 'always) t)
	     ((eq mm-verify-option 'known)
	      (and func
		   (or (not (setq functest
				  (nth 3 (assoc protocol
						mm-verify-function-alist))))
		       (funcall functest parts ctl))))
	     (t
	      (y-or-n-p
	       (format "Verify signed (%s) part? "
		       (or (nth 2 (assoc protocol mm-verify-function-alist))
			   (format "protocol=%s" protocol))))))
	(save-excursion
	  (if func
	      (setq parts (funcall func parts ctl))
	    (mm-sec-error 'gnus-details
			  (format "Unknown sign protocol (%s)" protocol))))))
     ((equal subtype "encrypted")
      (unless (setq protocol
		    (mm-handle-multipart-ctl-parameter ctl 'protocol))
	;; The message is broken.
	(let ((parts parts))
	  (while parts
	    (if (assoc (mm-handle-media-type (car parts))
		       mm-decrypt-function-alist)
		(setq protocol (mm-handle-media-type (car parts))
		      parts nil)
	      (setq parts (cdr parts))))))
      (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
      (when (cond
	     ((eq mm-decrypt-option 'never) nil)
	     ((eq mm-decrypt-option 'always) t)
	     ((eq mm-decrypt-option 'known)
	      (and func
		   (or (not (setq functest
				  (nth 3 (assoc protocol
						mm-decrypt-function-alist))))
		       (funcall functest parts ctl))))
	     (t
	      (y-or-n-p
	       (format "Decrypt (%s) part? "
		       (or (nth 2 (assoc protocol mm-decrypt-function-alist))
			   (format "protocol=%s" protocol))))))
	(save-excursion
	  (if func
	      (setq parts (funcall func parts ctl))
	    (mm-sec-error
	     'gnus-details
	     (format "Unknown encrypt protocol (%s)" protocol)))))))
    ;; Check the results (which are now in `parts').
    (let ((err (get-text-property 0 'sec-error (car mm-security-handle))))
      (if (or (not err)
	      (not (equal subtype "encrypted")))
	  parts
	;; We had an error during decryption.  Report what it is.
	(list
	 (mm-make-handle
	  (with-current-buffer (generate-new-buffer " *mm*")
	    (insert "Error!  Result from decryption:\n\n"
		    (or (get-text-property 0 'gnus-details
					   (car mm-security-handle))
			"")
		    "\n\n"
		    (or (get-text-property 0 'gnus-details
					   (car mm-security-handle))
			""))
	    (current-buffer))
	  '("text/plain")))))))