X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=c76682842ff54fd263506f9b5a74080716a8ffe9;hb=be8e91e7faa4f308b99366bf9ad88fab1cb3a994;hp=300640de7eecce00a6c191b1ad920c5871d4a09c;hpb=4a1a312dd40669d015dbe8a599bc51b4f1a12055;p=elisp%2Fsemi.git

diff --git a/mime-play.el b/mime-play.el
index 300640d..c766828 100644
--- 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,22 @@ 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 ((orig-modes (default-file-modes)))
+    (if (file-directory-p dir)
+	(unless (or (memq system-type '(windows-nt ms-dos OS/2 emx))
+		    (eq (file-modes dir) 448))
+	  (error "Invalid 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 +370,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 +500,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 +510,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)))