add iso-8859-14 also

[elisp/semi.git] / mime-play.el

diff --git a/mime-play.el b/mime-play.el
index 300640d..a96934e 100644 (file)
--- a/mime-play.el
+++ b/mime-play.el
@@ -96,7 +96,7 @@ specified, play as it.  Default MODE is \"play\"."
     (setq mime-acting-situation-example-list (cdr ret)
          ret (car ret))
     (cond ((cdr ret)
-          (setq ret (select-menu-alist
+          (setq ret (mime-select-menu-alist
                      "Methods"
                      (mapcar (function
                               (lambda (situation)
@@ -141,11 +141,10 @@ specified, play as it.  Default MODE is \"play\"."
 (defun mime-activate-mailcap-method (entity situation)
   (let ((method (cdr (assoc 'method situation)))
        (name (mime-entity-safe-filename entity)))
-    (setq name
-         (if (and name (not (string= name "")))
-             (expand-file-name name temporary-file-directory)
-           (make-temp-name
-            (expand-file-name "EMI" temporary-file-directory))))
+    (setq name (expand-file-name (if (and name (not (string= name "")))
+                                    name
+                                  (make-temp-name "EMI"))
+                                (make-temp-file "EMI" 'directory)))
     (mime-write-entity-content entity name)
     (message "External method is starting...")
     (let ((process
@@ -162,11 +161,12 @@ specified, play as it.  Default MODE is \"play\"."
 
 (defun mime-mailcap-method-sentinel (process event)
   (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
-    (if (file-exists-p file)
+    (when (file-exists-p file)
+      (ignore-errors
        (delete-file file)
-      ))
+       (delete-directory (file-name-directory file)))))
   (remove-alist 'mime-mailcap-method-filename-alist process)
-  (message (format "%s %s" process event)))
+  (message "%s %s" process event))
 
 (defvar mime-echo-window-is-shared-with-bbdb
   (module-installed-p 'bbdb)
@@ -346,6 +346,24 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 ;;; @ message/partial
 ;;;
 
+(defun mime-require-safe-directory (dir)
+  "Create a directory DIR safely.
+The permission of the created directory becomes `700' (for the owner only).
+If the directory already exists and is writable by other users, an error
+occurs."
+  (let ((attr (file-attributes dir))
+       (orig-modes (default-file-modes)))
+    (if (and attr (eq (car attr) t)) ; directory already exists.
+       (unless (or (memq system-type '(windows-nt ms-dos OS/2 emx))
+                   (and (eq (nth 2 attr) (user-real-uid))
+                        (eq (file-modes dir) 448)))
+         (error "Invalid owner or permission for %s" dir))
+      (unwind-protect
+         (progn
+           (set-default-file-modes 448)
+           (make-directory dir))
+       (set-default-file-modes orig-modes)))))
+
 (defun mime-store-message/partial-piece (entity cal)
   (let* ((root-dir
          (expand-file-name
@@ -354,13 +372,25 @@ It is registered to variable `mime-preview-quitting-method-alist'."
         (number (cdr (assoc "number" cal)))
         (total (cdr (assoc "total" cal)))
         file
-        (mother (current-buffer)))
+        (mother (current-buffer))
+        (orig-modes (default-file-modes)))
+    (mime-require-safe-directory root-dir)
     (or (file-exists-p root-dir)
-       (make-directory root-dir))
+       (unwind-protect
+           (progn
+             (set-default-file-modes 448)
+             (make-directory root-dir))
+         (set-default-file-modes orig-modes)))
     (setq id (replace-as-filename id))
     (setq root-dir (concat root-dir "/" id))
+
     (or (file-exists-p root-dir)
-       (make-directory root-dir))
+       (unwind-protect
+           (progn
+             (set-default-file-modes 448)
+             (make-directory root-dir))
+         (set-default-file-modes orig-modes)))
+
     (setq file (concat root-dir "/FULL"))
     (if (file-exists-p file)
        (let ((full-buf (get-buffer-create "FULL"))
@@ -472,7 +502,7 @@ It is registered to variable `mime-preview-quitting-method-alist'."
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
         (pathname (concat "/anonymous@" site ":" directory)))
-    (message (concat "Accessing " (expand-file-name name pathname) "..."))
+    (message "%s" (concat "Accessing " (expand-file-name name pathname) "..."))
     (funcall mime-raw-dired-function pathname)
     (goto-char (point-min))
     (search-forward name)
@@ -482,7 +512,7 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 
 (defun mime-view-message/external-url (entity cal)
   (let ((url (cdr (assoc "url" cal))))
-    (message (concat "Accessing " url "..."))
+    (message "%s" (concat "Accessing " url "..."))
     (funcall mime-raw-browse-url-function url)))