procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add with-file-modes macro, and use it

Browse source 
* lisp/subr.el (with-file-modes): New macro.

* lisp/printing.el (pr-save-file-modes):
* lisp/eshell/esh-util.el (eshell-with-file-modes): Make obsolete.

* lisp/emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2):
Add with-file-modes.

* lisp/doc-view.el (doc-view-make-safe-dir):
* lisp/epg.el (epg--start):
* lisp/files.el (locate-user-emacs-file, make-temp-file)
(backup-buffer-copy, move-file-to-trash):
* printing.el (pr-despool-print, pr-call-process, pr-text2ps):
* eshell/esh-util.el (eshell-with-private-file-modes)
(eshell-make-private-directory):
* lisp/net/browse-url.el (browse-url-mosaic):
* lisp/obsolete/mailpost.el (post-mail-send-it):
* lisp/obsolete/pgg-pgp.el (pgg-pgp-verify-region):
* lisp/obsolete/pgg-pgp5.el (pgg-pgp5-verify-region):
* lisp/url/url-util.el (url-make-private-file):
Use with-file-modes.

* doc/lispref/files.texi (Changing Files): Mention with-file-modes.

* etc/NEWS: Mention this.
This commit is contained in:
Glenn Morris 2014-05-14 10:15:15 -07:00
parent abad7b05fa
commit d63d883a97
17 changed files with 191 additions and 195 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
doc/lispref/ChangeLog
View file

@ -1,3 +1,7 @@
2014-05-14 Glenn Morris <rgm@gnu.org>
* files.texi (Changing Files): Mention with-file-modes.
2014-05-08 Paul Eggert <eggert@cs.ucla.edu>
* internals.texi (C Dialect): New section.

10
doc/lispref/files.texi
View file

@ -1688,6 +1688,16 @@ version of an existing file; saving a file preserves its existing
permissions.
@end defun
@defmac with-file-modes mode body@dots{}
This macro evaluates the @var{body} forms with the default
permissions for new files temporarily set to @var{modes} (whose value
is as for @code{set-file-modes} above). When finished, it restores
the original default file permissions, and returns the value of the
last form in @var{body}.
This is useful for creating private files, for example.
@end defmac
@defun default-file-modes
This function returns the default file permissions, as an integer.
@end defun

4
etc/NEWS
View file

@ -122,6 +122,10 @@ active region handling.
*** (side-effect-free VAL), if VAL is non-nil, indicates the function does not
have side effects.
+++
** New macro `with-file-modes', for evaluating expressions with default file
permissions set to temporary values (e.g., for creating private files).
** You can access the slots of structures using `cl-struct-slot-value'.

18
lisp/ChangeLog
View file

@ -1,5 +1,23 @@
2014-05-14 Glenn Morris <rgm@gnu.org>
* subr.el (with-file-modes): New macro.
* printing.el (pr-save-file-modes): Make obsolete.
* eshell/esh-util.el (eshell-with-file-modes): Make obsolete.
* emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2):
Add with-file-modes.
* doc-view.el (doc-view-make-safe-dir):
* epg.el (epg--start):
* files.el (locate-user-emacs-file, make-temp-file)
(backup-buffer-copy, move-file-to-trash):
* printing.el (pr-despool-print, pr-call-process, pr-text2ps):
* eshell/esh-util.el (eshell-with-private-file-modes)
(eshell-make-private-directory):
* net/browse-url.el (browse-url-mosaic):
* obsolete/mailpost.el (post-mail-send-it):
* obsolete/pgg-pgp.el (pgg-pgp-verify-region):
* obsolete/pgg-pgp5.el (pgg-pgp5-verify-region):
Use with-file-modes.
* vc/emerge.el (emerge-make-temp-file): Simplify.
2014-05-14 Stephen Berman <stephen.berman@gmx.net>

14
lisp/doc-view.el
View file

@ -654,16 +654,10 @@ at the top edge of the page moves to the previous page."
(defun doc-view-make-safe-dir (dir)
(condition-case nil
(let ((umask (default-file-modes)))
(unwind-protect
(progn
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(set-default-file-modes #o0700)
(make-directory dir))
;; Reset the umask.
(set-default-file-modes umask)))
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(with-file-modes #o0700 (make-directory dir))
(file-already-exists
(when (file-symlink-p dir)
(error "Danger: %s points to a symbolic link" dir))

1
lisp/emacs-lisp/lisp-mode.el
View file

@ -208,6 +208,7 @@ It has `lisp-mode-abbrev-table' as its parent."
"with-category-table" "with-coding-priority"
"with-current-buffer" "with-demoted-errors"
"with-electric-help" "with-eval-after-load"
"with-file-modes"
"with-local-quit" "with-no-warnings"
"with-output-to-temp-buffer" "with-selected-window"
"with-selected-frame" "with-silent-modifications"

12
lisp/epg.el
View file

@ -1206,7 +1206,6 @@ This function is for internal use only."
(coding-system-for-read 'binary)
process-connection-type
(process-environment process-environment)
(orig-mode (default-file-modes))
(buffer (generate-new-buffer " *epg*"))
process
terminal-name
@ -1265,14 +1264,9 @@ This function is for internal use only."
(setq epg-agent-file agent-file)
(make-local-variable 'epg-agent-mtime)
(setq epg-agent-mtime agent-mtime))
(unwind-protect
(progn
(set-default-file-modes 448)
(setq process
(apply #'start-process "epg" buffer
(epg-context-program context)
args)))
(set-default-file-modes orig-mode))
(with-file-modes 448
(setq process (apply #'start-process "epg" buffer
(epg-context-program context) args)))
(set-process-filter process #'epg--process-filter)
(epg-context-set-process context process)))

13
lisp/eshell/esh-util.el
View file

@ -539,20 +539,17 @@ Unless optional argument INPLACE is non-nil, return a new string."
(defmacro eshell-with-file-modes (modes &rest forms)
"Evaluate, with file-modes set to MODES, the given FORMS."
`(let ((modes (default-file-modes)))
(set-default-file-modes ,modes)
(unwind-protect
(progn ,@forms)
(set-default-file-modes modes))))
(declare (obsolete with-file-modes "24.5"))
`(with-file-modes ,modes ,@forms))
(defmacro eshell-with-private-file-modes (&rest forms)
"Evaluate FORMS with private file modes set."
`(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
`(with-file-modes ,eshell-private-file-modes ,@forms))
(defsubst eshell-make-private-directory (dir &optional parents)
"Make DIR with file-modes set to `eshell-private-directory-modes'."
(eshell-with-file-modes eshell-private-directory-modes
(make-directory dir parents)))
(with-file-modes eshell-private-directory-modes
(make-directory dir parents)))
(defsubst eshell-substring (string sublen)
"Return the beginning of STRING, up to SUBLEN bytes."

126
lisp/files.el
View file

@ -941,14 +941,10 @@ directory if it does not exist."
(if (file-directory-p user-emacs-directory)
(or (file-accessible-directory-p user-emacs-directory)
(setq errtype "access"))
(let ((umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes ?\700)
(condition-case nil
(make-directory user-emacs-directory)
(error (setq errtype "create"))))
(set-default-file-modes umask))))
(with-file-modes ?\700
(condition-case nil
(make-directory user-emacs-directory)
(error (setq errtype "create")))))
(when (and errtype
user-emacs-directory-warning
(not (get 'user-emacs-directory-warning 'this-session)))
@ -1273,36 +1269,31 @@ You can then use `write-region' to write new data into the file.
If DIR-FLAG is non-nil, create a new empty directory instead of a file.
If SUFFIX is non-nil, add that at the end of the file name."
(let ((umask (default-file-modes))
file)
(unwind-protect
(progn
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(set-default-file-modes ?\700)
(while (condition-case ()
(progn
(setq file
(make-temp-name
(if (zerop (length prefix))
(file-name-as-directory
temporary-file-directory)
(expand-file-name prefix
temporary-file-directory))))
(if suffix
(setq file (concat file suffix)))
(if dir-flag
(make-directory file)
(write-region "" nil file nil 'silent nil 'excl))
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
;; `make-temp-name' and `write-region', let's try again.
nil)
file)
;; Reset the umask.
(set-default-file-modes umask))))
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(with-file-modes ?\700
(let (file)
(while (condition-case ()
(progn
(setq file
(make-temp-name
(if (zerop (length prefix))
(file-name-as-directory
temporary-file-directory)
(expand-file-name prefix
temporary-file-directory))))
(if suffix
(setq file (concat file suffix)))
(if dir-flag
(make-directory file)
(write-region "" nil file nil 'silent nil 'excl))
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
;; `make-temp-name' and `write-region', let's try again.
nil)
file)))
(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
"Change the encoding of FILE's name from CODING to NEW-CODING.
@ -4071,31 +4062,26 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(file-error nil))))))
(defun backup-buffer-copy (from-name to-name modes extended-attributes)
(let ((umask (default-file-modes)))
(unwind-protect
(progn
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(set-default-file-modes ?\700)
(when (condition-case nil
;; Try to overwrite old backup first.
(copy-file from-name to-name t t t)
(error t))
(while (condition-case nil
(progn
(when (file-exists-p to-name)
(delete-file to-name))
(copy-file from-name to-name nil t t)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
;; `delete-file' and `copy-file', so let's try again.
;; rms says "I think there is also a possible race
;; condition for making backup files" (emacs-devel 20070821).
nil)))
;; Reset the umask.
(set-default-file-modes umask)))
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(with-file-modes ?\700
(when (condition-case nil
;; Try to overwrite old backup first.
(copy-file from-name to-name t t t)
(error t))
(while (condition-case nil
(progn
(when (file-exists-p to-name)
(delete-file to-name))
(copy-file from-name to-name nil t t)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
;; `delete-file' and `copy-file', so let's try again.
;; rms says "I think there is also a possible race
;; condition for making backup files" (emacs-devel 20070821).
nil)))
;; If set-file-extended-attributes fails, fall back on set-file-modes.
(unless (and extended-attributes
(with-demoted-errors
@ -6863,15 +6849,11 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
trash-info-dir filename))
;; Ensure that the trash directory exists; otherwise, create it.
(let ((saved-default-file-modes (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes #o700)
(unless (file-exists-p trash-files-dir)
(make-directory trash-files-dir t))
(unless (file-exists-p trash-info-dir)
(make-directory trash-info-dir t)))
(set-default-file-modes saved-default-file-modes)))
(with-file-modes #o700
(unless (file-exists-p trash-files-dir)
(make-directory trash-files-dir t))
(unless (file-exists-p trash-info-dir)
(make-directory trash-info-dir t)))
;; Try to move to trash with .trashinfo undo information
(save-excursion

16
lisp/net/browse-url.el
View file

@ -1343,16 +1343,12 @@ used instead of `browse-url-new-window-flag'."
"newwin\n"
"goto\n")
url "\n")
(let ((umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes ?\700)
(if (file-exists-p
(setq pidfile (format "/tmp/Mosaic.%d" pid)))
(delete-file pidfile))
;; http://debbugs.gnu.org/17428. Use O_EXCL.
(write-region nil nil pidfile nil 'silent nil 'excl))
(set-default-file-modes umask))))
(with-file-modes ?\700
(if (file-exists-p
(setq pidfile (format "/tmp/Mosaic.%d" pid)))
(delete-file pidfile))
;; http://debbugs.gnu.org/17428. Use O_EXCL.
(write-region nil nil pidfile nil 'silent nil 'excl)))
;; Send signal SIGUSR to Mosaic
(message "Signaling Mosaic...")
(signal-process pid 'SIGUSR1)

7
lisp/obsolete/mailpost.el
View file

@ -75,12 +75,7 @@ site-init."
(if mail-interactive
(with-current-buffer errbuf
(erase-buffer))))
(let ((m (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 384)
(setq temfile (make-temp-file ",rpost")))
(set-default-file-modes m)))
(with-file-modes 384 (setq temfile (make-temp-file ",rpost")))
(apply 'call-process
(append (list (if (boundp 'post-mail-program)
post-mail-program

14
lisp/obsolete/pgg-pgp.el
View file

@ -202,15 +202,11 @@ passphrase cache or user."
(defun pgg-pgp-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let* ((orig-file (pgg-make-temp-file "pgg"))
(args "+verbose=1 +batchmode +language=us")
(orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
(set-default-file-modes orig-mode))
(args "+verbose=1 +batchmode +language=us"))
(with-file-modes 448
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
(if (stringp signature)
(progn
(copy-file signature (setq signature (concat orig-file ".asc")))

14
lisp/obsolete/pgg-pgp5.el
View file

@ -208,15 +208,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(defun pgg-pgp5-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let ((orig-file (pgg-make-temp-file "pgg"))
(args '("+verbose=1" "+batchmode=1" "+language=us"))
(orig-mode (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes 448)
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
(set-default-file-modes orig-mode))
(args '("+verbose=1" "+batchmode=1" "+language=us")))
(with-file-modes 448
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
(when (stringp signature)
(copy-file signature (setq signature (concat orig-file ".asc")))
(setq args (append args (list signature))))

105
lisp/printing.el
View file

@ -3171,12 +3171,9 @@ See `pr-ps-printer-alist'.")
(defmacro pr-save-file-modes (&rest body)
"Set temporally file modes to `pr-file-modes'."
`(let ((pr--default-file-modes (default-file-modes))) ; save default
(set-default-file-modes pr-file-modes)
,@body
(set-default-file-modes pr--default-file-modes))) ; restore default
"Execute BODY with file permissions temporarily set to `pr-file-modes'."
(declare (obsolete with-file-modes "24.5"))
`(with-file-modes pr-file-modes ,@body))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keys & Menus
@ -4372,12 +4369,12 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name."
(interactive (list (ps-print-preprint current-prefix-arg)))
(pr-save-file-modes
(let ((ps-lpr-command (pr-command pr-ps-command))
(ps-lpr-switches pr-ps-switches)
(ps-printer-name-option pr-ps-printer-switch)
(ps-printer-name pr-ps-printer))
(ps-despool filename))))
(with-file-modes pr-file-modes
(let ((ps-lpr-command (pr-command pr-ps-command))
(ps-lpr-switches pr-ps-switches)
(ps-printer-name-option pr-ps-printer-switch)
(ps-printer-name pr-ps-printer))
(ps-despool filename))))
;;;###autoload
@ -5640,12 +5637,12 @@ If menu binding was not done, calls `pr-menu-bind'."
(goto-char (point-max))
(insert (format "%s %S\n" cmd args)))
;; *Printing Command Output* == show any return message from command
(pr-save-file-modes
(setq status
(condition-case data
(apply 'call-process cmd nil buffer nil args)
((quit error)
(error-message-string data)))))
(with-file-modes pr-file-modes
(setq status
(condition-case data
(apply 'call-process cmd nil buffer nil args)
((quit error)
(error-message-string data)))))
;; *Printing Command Output* == show exit status
(with-current-buffer buffer
(goto-char (point-max))
@ -5890,42 +5887,42 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-text2ps (kind n-up filename &optional from to)
(pr-save-file-modes
(let ((ps-n-up-printing n-up)
(ps-spool-config (and (eq ps-spool-config 'setpagedevice)
'setpagedevice)))
(pr-delete-file-if-exists filename)
(cond (pr-faces-p
(cond (pr-spool-p
;; pr-faces-p and pr-spool-p
;; here FILENAME arg is ignored
(cond ((eq kind 'buffer)
(ps-spool-buffer-with-faces))
((eq kind 'region)
(ps-spool-region-with-faces (or from (point))
(or to (mark))))
))
;; pr-faces-p and not pr-spool-p
((eq kind 'buffer)
(ps-print-buffer-with-faces filename))
((eq kind 'region)
(ps-print-region-with-faces (or from (point))
(or to (mark)) filename))
))
(pr-spool-p
;; not pr-faces-p and pr-spool-p
;; here FILENAME arg is ignored
(cond ((eq kind 'buffer)
(ps-spool-buffer))
((eq kind 'region)
(ps-spool-region (or from (point)) (or to (mark))))
))
;; not pr-faces-p and not pr-spool-p
((eq kind 'buffer)
(ps-print-buffer filename))
((eq kind 'region)
(ps-print-region (or from (point)) (or to (mark)) filename))
))))
(with-file-modes pr-file-modes
(let ((ps-n-up-printing n-up)
(ps-spool-config (and (eq ps-spool-config 'setpagedevice)
'setpagedevice)))
(pr-delete-file-if-exists filename)
(cond (pr-faces-p
(cond (pr-spool-p
;; pr-faces-p and pr-spool-p
;; here FILENAME arg is ignored
(cond ((eq kind 'buffer)
(ps-spool-buffer-with-faces))
((eq kind 'region)
(ps-spool-region-with-faces (or from (point))
(or to (mark))))
))
;; pr-faces-p and not pr-spool-p
((eq kind 'buffer)
(ps-print-buffer-with-faces filename))
((eq kind 'region)
(ps-print-region-with-faces (or from (point))
(or to (mark)) filename))
))
(pr-spool-p
;; not pr-faces-p and pr-spool-p
;; here FILENAME arg is ignored
(cond ((eq kind 'buffer)
(ps-spool-buffer))
((eq kind 'region)
(ps-spool-region (or from (point)) (or to (mark))))
))
;; not pr-faces-p and not pr-spool-p
((eq kind 'buffer)
(ps-print-buffer filename))
((eq kind 'region)
(ps-print-region (or from (point)) (or to (mark)) filename))
))))
(defun pr-command (command)

13
lisp/subr.el
View file

@ -3292,6 +3292,19 @@ The value returned is the value of the last form in BODY."
,@body)
(with-current-buffer ,old-buffer
(set-case-table ,old-case-table))))))
(defmacro with-file-modes (modes &rest body)
"Execute BODY with default file permissions temporarily set to MODES.
MODES is as for `set-default-file-modes'."
(declare (indent 1) (debug t))
(let ((umask (make-symbol "umask")))
`(let ((,umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes ,modes)
,@body)
(set-default-file-modes ,umask)))))
;;; Matching and match data.

4
lisp/url/ChangeLog
View file

@ -1,3 +1,7 @@
2014-05-14 Glenn Morris <rgm@gnu.org>
* url-util.el (url-make-private-file): Use with-file-modes.
2014-05-12 Michael Albinus <michael.albinus@gmx.de>
* url-handlers.el (url-file-handler-load-in-progress): New defvar.

11
lisp/url/url-util.el
View file

@ -628,14 +628,9 @@ Creates FILE and its parent directories if they do not exist."
(make-directory dir t)))
;; Based on doc-view-make-safe-dir.
(condition-case nil
(let ((umask (default-file-modes)))
(unwind-protect
(progn
(set-default-file-modes #o0600)
(with-temp-buffer
(write-region (point-min) (point-max)
file nil 'silent nil 'excl)))
(set-default-file-modes umask)))
(with-file-modes #o0600
(with-temp-buffer
(write-region (point-min) (point-max) file nil 'silent nil 'excl)))
(file-already-exists
(if (file-symlink-p file)
(error "Danger: `%s' is a symbolic link" file))