diff options
Diffstat (limited to 'lisp/gnus/mm-decode.el')
| -rw-r--r-- | lisp/gnus/mm-decode.el | 49 |
1 files changed, 34 insertions, 15 deletions
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index a340418507f..1bce6ca020e 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -602,11 +602,10 @@ files left at the next time." (push temp fails))) (if fails ;; Schedule the deletion of the files left at the next time. - (progn + (with-file-modes #o600 (write-region (concat (mapconcat 'identity (nreverse fails) "\n") "\n") - nil cache-file nil 'silent) - (set-file-modes cache-file #o600)) + nil cache-file nil 'silent)) (when (file-exists-p cache-file) (ignore-errors (delete-file cache-file)))) (setq mm-temp-files-to-be-deleted nil))) @@ -911,8 +910,10 @@ external if displayed external." ;; The function is a string to be executed. (mm-insert-part handle) (mm-add-meta-html-tag handle) - (let* ((dir (make-temp-file - (expand-file-name "emm." mm-tmp-directory) 'dir)) + ;; We create a private sub-directory where we store our files. + (let* ((dir (with-file-modes #o700 + (make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir))) (filename (or (mail-content-type-get (mm-handle-disposition handle) 'filename) @@ -924,8 +925,6 @@ external if displayed external." (assoc "needsterminal" mime-info))) (copiousoutput (assoc "copiousoutput" mime-info)) file buffer) - ;; We create a private sub-directory where we store our files. - (set-file-modes dir #o700) (if filename (setq file (expand-file-name (gnus-map-function mm-file-name-rewrite-functions @@ -941,14 +940,15 @@ external if displayed external." ;; `mailcap-mime-extensions'. (setq suffix (car (rassoc (mm-handle-media-type handle) mailcap-mime-extensions)))) - (setq file (make-temp-file (expand-file-name "mm." dir) - nil suffix)))) + (setq file (with-file-modes #o600 + (make-temp-file (expand-file-name "mm." dir) + nil suffix))))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) ;; The file is deleted after the viewer exists. If the users edits ;; the file, changes will be lost. Set file to read-only to make it ;; clear. - (set-file-modes file #o400) + (set-file-modes file #o400 'nofollow) (message "Viewing with %s" method) (cond (needsterm @@ -1364,10 +1364,7 @@ PROMPT overrides the default one used to ask user for a file name." (setq file (read-file-name (or prompt - (format "Save MIME part to%s: " - (if filename - (format " (default %s)" filename) - ""))) + (format-prompt "Save MIME part to" filename)) (or directory mm-default-directory default-directory) (expand-file-name (or filename "") @@ -1668,18 +1665,26 @@ If RECURSIVE, search recursively." (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")) (with-temp-buffer (when (and (cond + ((equal smime-type "signed-data") t) ((eq mm-decrypt-option 'never) nil) ((eq mm-decrypt-option 'always) t) ((eq mm-decrypt-option 'known) t) (t (y-or-n-p (format "Decrypt (S/MIME) part? ")))) (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. @@ -1688,7 +1693,21 @@ If RECURSIVE, search recursively." (unless (mail-fetch-field "content-type") (goto-char (point-max)) (insert "Content-type: text/plain\n\n"))) - (setq parts (mm-dissect-buffer t))))) + (setq parts + (if (equal smime-type "signed-data") + (list (propertize + "multipart/signed" + 'protocol "application/pkcs7-signature" + 'gnus-info + (format + "%s:%s" + (get-text-property 0 'gnus-info + (car mm-security-handle)) + (get-text-property 0 'gnus-details + (car mm-security-handle)))) + (mm-dissect-buffer t) + parts) + (mm-dissect-buffer t)))))) ((equal subtype "signed") (unless (and (setq protocol (mm-handle-multipart-ctl-parameter ctl 'protocol)) |