+2004-08-29 Yoichi NAKAYAMA <yoichi@geiin.org>
+
+ Merge following changes from semi-1_14 branch:
+
+ * pgg-gpg.el (pgg-gpg-process-region): Use `make-temp-file' instead of
+ `make-temp-name'.
+ Add --yes option to overwrite existing output file;
+ Remove needless set-default-file-modes.
+ * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
+ (pgg-scheme-verify-region): Ditto.
+ (pgg-scheme-snarf-keys-region): Ditto.
+ * pgg-pgp.el (pgg-pgp-process-region): Ditto.
+ (pgg-scheme-verify-region): Ditto.
+ (pgg-scheme-snarf-keys-region): Ditto.
+ * mime-pgp.el (mime-verify-application/pgp-signature): Ditto.
+ * mime-play.el (mime-activate-mailcap-method): Make a temporary
+ directory of a temporary file for the mailcap application.
+ (mime-mailcap-method-sentinel): Follow the change above.
+ (mime-require-safe-directory): New function.
+ (mime-store-message/partial-piece): Use it.
+ Set `default-file-modes' for `make-directory'.
+ * mime-edit.el (mime-edit-split-and-send): Remove local variable
+ `mime-edit-draft-file-name'.
+
+ * mime-play.el (mime-play-delete-file-immediately): New user option.
+ (mime-mailcap-method-sentinel): Use it.
+ (mime-mailcap-delete-played-files): New function; set up for
+ `kill-emacs-hook'.
+
2004-08-03 Yoichi NAKAYAMA <yoichi@geiin.org>
* mime-edit.el (mime-edit-mime-version-field-for-message/partial):
(setq mime-edit-message-max-length
(or (cdr (assq major-mode mime-edit-message-max-lines-alist))
mime-edit-message-default-max-lines)))
- (let* ((mime-edit-draft-file-name
- (or (buffer-file-name)
- (make-temp-name
- (expand-file-name "mime-draft" temporary-file-directory))))
- (separator mail-header-separator)
- (id (concat "\""
- (replace-space-with-underline (current-time-string))
- "@" (system-name) "\"")))
+ (let ((separator mail-header-separator)
+ (id (concat "\""
+ (replace-space-with-underline (current-time-string))
+ "@" (system-name) "\"")))
(run-hooks 'mime-edit-before-split-hook)
(let ((the-buf (current-buffer))
(copy-buf (get-buffer-create " *Original Message*"))
(1- knum)
(1+ knum)))
(orig-entity (nth onum (mime-entity-children mother)))
- (basename (expand-file-name "tm" temporary-file-directory))
- (sig-file (concat (make-temp-name basename) ".asc"))
+ (sig-file (make-temp-file "tm" nil ".asc"))
status)
(save-excursion
(mime-show-echo-buffer)
:type '(choice (const :tag "Current directory" t)
(directory)))
+(defcustom mime-play-delete-file-immediately t
+ "If non-nil, delete played file immediately."
+ :group 'mime-view
+ :type 'boolean)
+
(defvar mime-play-find-every-situations t
"*Find every available situations if non-nil.")
(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
(set-process-sentinel process 'mime-mailcap-method-sentinel))))
(defun mime-mailcap-method-sentinel (process event)
- (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
- (if (file-exists-p file)
- (delete-file file)))
- (remove-alist 'mime-mailcap-method-filename-alist process)
+ (when mime-play-delete-file-immediately
+ (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
+ (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 "%s %s" process event))
+(defun mime-mailcap-delete-played-files ()
+ (dolist (elem mime-mailcap-method-filename-alist)
+ (when (file-exists-p (cdr elem))
+ (ignore-errors
+ (delete-file (cdr elem))
+ (delete-directory (file-name-directory (cdr elem)))))))
+
+(add-hook 'kill-emacs-hook 'mime-mailcap-delete-played-files)
+
(defvar mime-echo-window-is-shared-with-bbdb
(module-installed-p 'bbdb)
"*If non-nil, mime-echo window is shared with BBDB window.")
;;; @ 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
- (concat "m-prts-" (user-login-name)) temporary-file-directory))
- (id (cdr (assoc "id" cal)))
- (number (cdr (assoc "number" cal)))
- (total (cdr (assoc "total" cal)))
- file
- (mother (current-buffer)))
+ (let ((root-dir
+ (expand-file-name
+ (concat "m-prts-" (user-login-name)) temporary-file-directory))
+ (id (cdr (assoc "id" cal)))
+ (number (cdr (assoc "number" cal)))
+ (total (cdr (assoc "total" cal)))
+ file
+ (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"))
(luna-make-entity 'pgg-scheme-gpg))))
(defun pgg-gpg-process-region (start end passphrase program args)
- (let* ((output-file-name
- (concat temporary-file-directory (make-temp-name "pgg-output")))
+ (let* ((output-file-name (make-temp-file
+ (expand-file-name "pgg-output"
+ temporary-file-directory)))
(args
`("--status-fd" "2"
,@(if passphrase '("--passphrase-fd" "0"))
+ "--yes" ; overwrite
"--output" ,output-file-name
,@pgg-gpg-extra-args ,@args))
(output-buffer pgg-output-buffer)
(errors-buffer pgg-errors-buffer)
- (orig-mode (default-file-modes))
(process-connection-type nil)
process status exit-status)
(with-current-buffer (get-buffer-create errors-buffer)
(erase-buffer))
(unwind-protect
(progn
- (set-default-file-modes 448)
(let ((coding-system-for-write 'binary))
(setq process
(apply #'start-process "*GnuPG*" errors-buffer
(if (and process (eq 'run (process-status process)))
(interrupt-process process))
(if (file-exists-p output-file-name)
- (delete-file output-file-name))
- (set-default-file-modes orig-mode))))
+ (delete-file output-file-name)))))
(defun pgg-gpg-possibly-cache-passphrase (passphrase)
(if (and pgg-cache-passphrase
(luna-make-entity 'pgg-scheme-pgp))))
(defun pgg-pgp-process-region (start end passphrase program args)
- (let* ((errors-file-name
- (concat temporary-file-directory
- (make-temp-name "pgg-errors")))
+ (let* ((errors-file-name (make-temp-file "pgg-errors"))
(args
(append args
pgg-pgp-extra-args
(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp)
start end &optional signature)
- (let* ((basename (expand-file-name "pgg" temporary-file-directory))
- (orig-file (make-temp-name basename))
- (args '("+verbose=1" "+batchmode" "+language=us"))
- (orig-mode (default-file-modes)))
+ (let ((orig-file (make-temp-file "pgg"))
+ (args '("+verbose=1" "+batchmode" "+language=us"))
+ (orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-pgp)
start end)
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
- (basename (expand-file-name "pgg" temporary-file-directory))
- (key-file (make-temp-name basename))
+ (key-file (make-temp-file "pgg"))
(args
(list "+verbose=1" "+batchmode" "+language=us" "-kaf"
key-file)))
(luna-make-entity 'pgg-scheme-pgp5))))
(defun pgg-pgp5-process-region (start end passphrase program args)
- (let* ((errors-file-name
- (concat temporary-file-directory
- (make-temp-name "pgg-errors")))
+ (let* ((errors-file-name (make-temp-file "pgg-errors"))
(args
(append args
pgg-pgp5-extra-args
(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp5)
start end &optional signature)
- (let* ((basename (expand-file-name "pgg" temporary-file-directory))
- (orig-file (make-temp-name basename))
- (args '("+verbose=1" "+batchmode=1" "+language=us"))
- (orig-mode (default-file-modes)))
+ (let ((orig-file (make-temp-file "pgg"))
+ (args '("+verbose=1" "+batchmode=1" "+language=us"))
+ (orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-pgp5)
start end)
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
- (basename (expand-file-name "pgg" temporary-file-directory))
- (key-file (make-temp-name basename))
+ (key-file (make-temp-file "pgg"))
(args
(list "+verbose=1" "+batchmode=1" "+language=us" "-a"
key-file)))