Synch to Gnus 200311130835.
[elisp/gnus.git-] / lisp / mm-decode.el
index 90701b6..d87ec5b 100644 (file)
@@ -127,21 +127,24 @@ nil    : using external viewer."
 It is suggested to customize `mm-text-html-renderer' instead.")
 
 (defcustom mm-inline-text-html-with-images nil
-  "If non-nil, Gnus will allow retrieving images in the HTML contents
-with <img> tags.  It has no effect on Emacs/w3.  See also
-the documentation for the option `mm-w3m-safe-url-regexp'."
+  "If non-nil, Gnus will allow retrieving images in HTML contents with
+the <img> tags.  It has no effect on Emacs/w3.  See also the
+documentation for the `mm-w3m-safe-url-regexp' variable."
   :type 'boolean
   :group 'mime-display)
 
 (defcustom mm-w3m-safe-url-regexp "\\`cid:"
-  "Regexp that matches safe url names.
-Some HTML mails might have a trick of spammers using <img> tags.
-It is likely to be intended to verify whether you have read the
-mail.  You can prevent your personal informations from leaking by
-setting this to the regexp which matches the safe url names.  The
-value of the variable `w3m-safe-url-regexp' will be bound with
-this value.  You may set this value to nil if you consider all
-urls to be safe."
+  "Regexp matching URLs which are considered to be safe.
+Some HTML mails might contain a nasty trick used by spammers, using
+the <img> tag which is far more evil than the [Click Here!] button.
+It is most likely intended to check whether the ominous spam mail has
+reached your eyes or not, in which case the spammer knows for sure
+that your email address is valid.  It is done by embedding an
+identifier string into a URL that you might automatically retrieve
+when displaying the image.  The default value is \"\\\\`cid:\" which only
+matches parts embedded to the Multipart/Related type MIME contents and
+Gnus will never connect to the spammer's site arbitrarily.  You may
+set this variable to nil if you consider all urls to be safe."
   :type '(choice (regexp :tag "Regexp")
                 (const :tag "All URLs are safe" nil))
   :group 'mime-display)
@@ -152,7 +155,7 @@ urls to be safe."
   :group 'mime-display)
 
 (defcustom mm-inline-media-tests
-  '(("image/jpeg"
+  '(("image/p?jpeg"
      mm-inline-image
      (lambda (handle)
        (mm-valid-and-fit-image-p 'jpeg handle)))
@@ -238,7 +241,7 @@ urls to be safe."
     ;; Default to displaying as text
     (".*" mm-inline-text mm-readable-p))
   "Alist of media types/tests saying whether types can be displayed inline."
-  :type '(repeat (list (string :tag "MIME type")
+  :type '(repeat (list (regexp :tag "MIME type")
                       (function :tag "Display function")
                       (function :tag "Display test")))
   :group 'mime-display)
@@ -323,11 +326,14 @@ to:
   :type 'boolean
   :group 'mime-display)
 
-(defvar mm-file-name-rewrite-functions nil
+(defvar mm-file-name-rewrite-functions
+  '(mm-file-name-delete-control mm-file-name-delete-gotchas)
   "*List of functions used for rewriting file names of MIME parts.
 Each function takes a file name as input and returns a file name.
 
 Ready-made functions include
+`mm-file-name-delete-control'
+`mm-file-name-delete-gotchas'
 `mm-file-name-delete-whitespace',
 `mm-file-name-trim-whitespace',
 `mm-file-name-collapse-whitespace',
@@ -352,6 +358,11 @@ If not set, `default-directory' will be used."
   :type '(choice directory (const :tag "Default" nil))
   :group 'mime-display)
 
+(defcustom mm-attachment-file-modes 384
+  "Set the mode bits of saved attachments to this integer."
+  :type 'integer
+  :group 'mime-display)
+
 (defcustom mm-external-terminal-program "xterm"
   "The program to start an external terminal."
   :type 'string
@@ -517,7 +528,8 @@ Postpone undisplaying of viewers for types in
          ((equal type "multipart")
           (let ((mm-dissect-default-type (if (equal subtype "digest")
                                              "message/rfc822"
-                                           "text/plain")))
+                                           "text/plain"))
+                (start (cdr (assq 'start (cdr ctl)))))
             (add-text-properties 0 (length (car ctl))
                                  (mm-alist-to-plist (cdr ctl)) (car ctl))
 
@@ -527,10 +539,9 @@ Postpone undisplaying of viewers for types in
             ;; the mm-handle API so we simply store the multipart buffert
             ;; name as a text property of the "multipart/whatever" string.
             (add-text-properties 0 (length (car ctl))
-                                 (list 'buffer (mm-copy-to-buffer))
-                                 (car ctl))
-            (add-text-properties 0 (length (car ctl))
-                                 (list 'from from)
+                                 (list 'buffer (mm-copy-to-buffer)
+                                       'from from
+                                       'start start)
                                  (car ctl))
             (cons (car ctl) (mm-dissect-multipart ctl))))
          (t
@@ -1023,6 +1034,15 @@ string if you do not like underscores."
       (setq file-name (replace-match s t t file-name))))
   file-name)
 
+(defun mm-file-name-delete-control (filename)
+  "Delete control characters from FILENAME."
+  (gnus-replace-in-string filename "[\x00-\x1f\x7f]" ""))
+
+(defun mm-file-name-delete-gotchas (filename)
+  "Delete shell gotchas from FILENAME."
+  (setq filename (gnus-replace-in-string filename "[<>|]" ""))
+  (gnus-replace-in-string filename "^[.-]+" ""))
+
 (defun mm-save-part (handle)
   "Write HANDLE to a file."
   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
@@ -1048,13 +1068,17 @@ string if you do not like underscores."
   (mm-with-unibyte-buffer
     (mm-insert-part handle)
     (let ((coding-system-for-write 'binary)
+         (current-file-modes (default-file-modes))
          ;; Don't re-compress .gz & al.  Arguably we should make
          ;; `file-name-handler-alist' nil, but that would chop
          ;; ange-ftp, which is reasonable to use here.
          (inhibit-file-name-operation 'write-region)
          (inhibit-file-name-handlers
           (cons 'jka-compr-handler inhibit-file-name-handlers)))
-      (write-region (point-min) (point-max) file))))
+      (set-default-file-modes mm-attachment-file-modes)
+      (unwind-protect
+         (write-region (point-min) (point-max) file)
+       (set-default-file-modes current-file-modes)))))
 
 (defun mm-pipe-part (handle)
   "Pipe HANDLE to a process."