Commit bc1c2cf0 authored by Paul Eggert's avatar Paul Eggert

Fix some file-mode races

* lisp/emacs-lisp/autoload.el (autoload-ensure-file-writeable):
* lisp/files.el (after-find-file):
* lisp/gnus/gnus-start.el (gnus-dribble-read-file):
* lisp/htmlfontify.el (hfy-copy-and-fontify-file):
* lisp/server.el (server-ensure-safe-dir):
Avoid a race when getting file permissions.
parent b124cb8f
Pipeline #3171 passed with stage
in 55 minutes and 34 seconds
...@@ -398,9 +398,8 @@ FILE's name." ...@@ -398,9 +398,8 @@ FILE's name."
;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
;; which was designed to handle CVSREAD=1 and equivalent. ;; which was designed to handle CVSREAD=1 and equivalent.
(and autoload-ensure-writable (and autoload-ensure-writable
(file-exists-p file)
(let ((modes (file-modes file))) (let ((modes (file-modes file)))
(if (zerop (logand modes #o0200)) (if (and modes (zerop (logand modes #o0200)))
;; Ignore any errors here, and let subsequent attempts ;; Ignore any errors here, and let subsequent attempts
;; to write the file raise any real error. ;; to write the file raise any real error.
(ignore-errors (set-file-modes file (logior modes #o0200)))))) (ignore-errors (set-file-modes file (logior modes #o0200))))))
......
...@@ -2554,13 +2554,13 @@ unless NOMODES is non-nil." ...@@ -2554,13 +2554,13 @@ unless NOMODES is non-nil."
(auto-save-mode 1))) (auto-save-mode 1)))
;; Make people do a little extra work (C-x C-q) ;; Make people do a little extra work (C-x C-q)
;; before altering a backup file. ;; before altering a backup file.
(when (backup-file-name-p buffer-file-name)
(setq buffer-read-only t))
;; When a file is marked read-only, ;; When a file is marked read-only,
;; make the buffer read-only even if root is looking at it. ;; make the buffer read-only even if root is looking at it.
(when (and (file-modes (buffer-file-name)) (unless buffer-read-only
(zerop (logand (file-modes (buffer-file-name)) #o222))) (when (or (backup-file-name-p buffer-file-name)
(setq buffer-read-only t)) (let ((modes (file-modes (buffer-file-name))))
(and modes (zerop (logand modes #o222)))))
(setq buffer-read-only t)))
(unless nomodes (unless nomodes
(when (and view-read-only view-mode) (when (and view-read-only view-mode)
(view-mode -1)) (view-mode -1))
......
...@@ -897,9 +897,8 @@ If REGEXP is given, lines that match it will be deleted." ...@@ -897,9 +897,8 @@ If REGEXP is given, lines that match it will be deleted."
(set-buffer-modified-p t)) (set-buffer-modified-p t))
;; Set the file modes to reflect the .newsrc file modes. ;; Set the file modes to reflect the .newsrc file modes.
(save-buffer) (save-buffer)
(when (and (file-exists-p gnus-current-startup-file) (when (and (setq modes (file-modes gnus-current-startup-file))
(file-exists-p dribble-file) (file-exists-p dribble-file))
(setq modes (file-modes gnus-current-startup-file)))
(gnus-set-file-modes dribble-file modes)) (gnus-set-file-modes dribble-file modes))
(goto-char (point-min)) (goto-char (point-min))
(when (search-forward "Gnus was exited on purpose" nil t) (when (search-forward "Gnus was exited on purpose" nil t)
......
...@@ -1938,9 +1938,9 @@ adding an extension of `hfy-extn'. Fontification is actually done by ...@@ -1938,9 +1938,9 @@ adding an extension of `hfy-extn'. Fontification is actually done by
(set-buffer html) (set-buffer html)
(write-file (concat target hfy-extn)) (write-file (concat target hfy-extn))
(kill-buffer html)) (kill-buffer html))
;; #o0200 == 128, but emacs20 doesn't know that (let ((modes (file-modes target)))
(if (and (file-exists-p target) (not (file-writable-p target))) (if (and modes (not (file-writable-p target)))
(set-file-modes target (logior (file-modes target) 128))) (set-file-modes target (logior modes #o0200))))
(copy-file (buffer-file-name source) target 'overwrite)) (copy-file (buffer-file-name source) target 'overwrite))
(kill-buffer source)) )) (kill-buffer source)) ))
......
...@@ -563,9 +563,9 @@ See variable `server-auth-dir' for details." ...@@ -563,9 +563,9 @@ See variable `server-auth-dir' for details."
(format "it is not owned by you (owner = %s (%d))" (format "it is not owned by you (owner = %s (%d))"
(user-full-name uid) uid)) (user-full-name uid) uid))
(w32 nil) ; on NTFS? (w32 nil) ; on NTFS?
((/= 0 (logand ?\077 (file-modes dir))) ((let ((modes (file-modes dir)))
(format "it is accessible by others (%03o)" (unless (zerop (logand (or modes 0) #o077))
(file-modes dir))) (format "it is accessible by others (%03o)" modes))))
(t nil)))) (t nil))))
(when unsafe (when unsafe
(error "`%s' is not a safe directory because %s" (error "`%s' is not a safe directory because %s"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment