Add 'nofollow' flag to set-file-modes etc.

This avoids some race conditions (Bug#39683).  E.g., if some other
program changes a file to a symlink between the time Emacs creates
the file and the time it changes the file’s permissions, using the
new flag prevents Emacs from inadvertently changing the
permissions of a victim in some completely unrelated directory.
* admin/merge-gnulib (GNULIB_MODULES): Add fchmodat.
* doc/lispref/files.texi (Testing Accessibility, Changing Files):
* doc/lispref/os.texi (File Notifications):
* etc/NEWS:
Adjust documentation accordingly.
* lib/chmodat.c, lib/fchmodat.c, lib/lchmod.c, m4/fchmodat.m4:
* m4/lchmod.m4: New files, copied from Gnulib.
* lib/gnulib.mk.in: Regenerate.
* lisp/dired-aux.el (dired-do-chmod):
* lisp/doc-view.el (doc-view-make-safe-dir):
* lisp/emacs-lisp/autoload.el (autoload--save-buffer):
* lisp/emacs-lisp/bytecomp.el (byte-compile-file):
* lisp/eshell/em-pred.el (eshell-pred-file-mode):
* lisp/files.el (backup-buffer-copy, copy-directory):
* lisp/gnus/mail-source.el (mail-source-movemail):
* lisp/gnus/mm-decode.el (mm-display-external):
* lisp/gnus/nnmail.el (nnmail-write-region):
* lisp/net/tramp-adb.el (tramp-adb-handle-file-local-copy)
(tramp-adb-handle-write-region):
* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-directly):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-write-region):
* lisp/net/tramp.el (tramp-handle-write-region)
(tramp-make-tramp-temp-file):
* lisp/server.el (server-ensure-safe-dir):
* lisp/url/url-util.el (url-make-private-file):
When getting or setting file modes, avoid following symbolic links
when the file is not supposed to be a symbolic link.
* lisp/doc-view.el (doc-view-make-safe-dir):
Omit no-longer-needed separate symlink test.
* lisp/gnus/gnus-util.el (gnus-set-file-modes):
* lisp/net/tramp.el (tramp-handle-file-modes):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-set-file-modes):
* src/fileio.c (symlink_nofollow_flag): New function.
(Ffile_modes, Fset_file_modes):
Support an optional FLAG arg.  All C callers changed.
* lisp/net/ange-ftp.el (ange-ftp-set-file-modes):
* lisp/net/tramp-adb.el (tramp-adb-handle-set-file-modes):
* lisp/net/tramp-sh.el (tramp-sh-handle-set-file-modes):
* lisp/net/tramp-smb.el (tramp-smb-handle-set-file-modes):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-set-file-modes):
Accept an optional FLAG arg that is currently ignored,
and add a FIXME comment for it.
* m4/gnulib-comp.m4: Regenerate.

1 files changed, 8 insertions, 4 deletions

diff --git a/lisp/files.el b/lisp/files.el
index 683f4a8ce7c..2e7694d7677 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4672,6 +4672,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
   ;; 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.
+ (let (nofollow-flag)
   (with-file-modes ?\700
     (when (condition-case nil
 	      ;; Try to overwrite old backup first.
@@ -4682,6 +4683,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
 		   (when (file-exists-p to-name)
 		     (delete-file to-name))
 		   (copy-file from-name to-name nil t t)
+		   (setq nofollow-flag 'nofollow)
 		   nil)
 	       (file-already-exists t))
 	;; The file was somehow created by someone else between
@@ -4694,7 +4696,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
 	       (with-demoted-errors
 		 (set-file-extended-attributes to-name extended-attributes)))
     (and modes
-	 (set-file-modes to-name (logand modes #o1777)))))
+	 (set-file-modes to-name (logand modes #o1777) nofollow-flag)))))
 
 (defvar file-name-version-regexp
   "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
@@ -5900,7 +5902,8 @@ into NEWNAME instead."
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
-		     (find-file-name-handler newname 'copy-directory))))
+		     (find-file-name-handler newname 'copy-directory)))
+	(follow parents))
     (if handler
 	(funcall handler 'copy-directory directory
                  newname keep-time parents copy-contents)
@@ -5920,7 +5923,8 @@ into NEWNAME instead."
 		 (or parents (not (file-directory-p newname)))
 	       (setq newname (concat newname
 				     (file-name-nondirectory directory))))
-	     (make-directory (directory-file-name newname) parents)))
+	     (make-directory (directory-file-name newname) parents))
+	    (t (setq follow t)))
 
       ;; Copy recursively.
       (dolist (file
@@ -5941,7 +5945,7 @@ into NEWNAME instead."
       (let ((modes (file-modes directory))
 	    (times (and keep-time (file-attribute-modification-time
 				   (file-attributes directory)))))
-	(if modes (set-file-modes newname modes))
+	(if modes (set-file-modes newname modes (unless follow 'nofollow)))
 	(if times (set-file-times newname times))))))