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.

19 files changed, 51 insertions, 38 deletions

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 0069c1744dc..8f00317c2b0 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -409,7 +409,8 @@ has no effect on MS-Windows."
       (set-file-modes
        file
        (if num-modes num-modes
-         (file-modes-symbolic-to-number modes (file-modes file)))))
+         (file-modes-symbolic-to-number modes (file-modes file 'nofollow)))
+       'nofollow))
     (dired-do-redisplay arg)))
 
 ;;;###autoload
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 3788d797258..8b3d5527f08 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -683,8 +683,6 @@ at the top edge of the page moves to the previous page."
       ;; 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))
      ;; In case it was created earlier with looser rights.
      ;; We could check the mode info returned by file-attributes, but it's
      ;; a pain to parse and it may not tell you what we want under
@@ -694,7 +692,7 @@ at the top edge of the page moves to the previous page."
      ;; sure we have write-access to the directory and that we own it, thus
      ;; closing a bunch of security holes.
      (condition-case error
-         (set-file-modes dir #o0700)
+         (set-file-modes dir #o0700 'nofollow)
        (file-error
         (error
          (format "Unable to use temporary directory %s: %s"
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 785e350e0e5..e9f76583272 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -895,7 +895,7 @@ FILE's modification time."
           (cons (lambda () (ignore-errors (delete-file tempfile)))
                 kill-emacs-hook)))
     (unless (= temp-modes desired-modes)
-      (set-file-modes tempfile desired-modes))
+      (set-file-modes tempfile desired-modes 'nofollow))
     (write-region (point-min) (point-max) tempfile nil 1)
     (backup-buffer)
     (rename-file tempfile buffer-file-name t))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index fce5e4aed6d..24a36393b2e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2008,7 +2008,7 @@ The value is non-nil if there were no errors, nil if errors."
                                            (delete-file tempfile)))
                               kill-emacs-hook)))
                   (unless (= temp-modes desired-modes)
-                    (set-file-modes tempfile desired-modes))
+                    (set-file-modes tempfile desired-modes 'nofollow))
                   (write-region (point-min) (point-max) tempfile nil 1)
                   ;; This has the intentional side effect that any
                   ;; hard-links to target-file continue to
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 04bf3ff8998..7219af45f54 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -478,7 +478,7 @@ that `ls -l' will show in the first column of its display."
 (defsubst eshell-pred-file-mode (mode)
   "Return a test which tests that MODE pertains to the file."
   `(lambda (file)
-     (let ((modes (file-modes file)))
+     (let ((modes (file-modes file 'nofollow)))
        (if modes
            (logand ,mode modes)))))
 
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))))))
 
 
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index eb0fd2522d3..83a85161aa0 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1601,10 +1601,10 @@ empty directories from OLD-PATH."
                          (file-truename
                           (concat old-dir "..")))))))))
 
-(defun gnus-set-file-modes (filename mode)
+(defun gnus-set-file-modes (filename mode &optional flag)
   "Wrapper for set-file-modes."
   (ignore-errors
-    (set-file-modes filename mode)))
+    (set-file-modes filename mode flag)))
 
 (defun gnus-rescale-image (image size)
   "Rescale IMAGE to SIZE if possible.
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index f5b68789b85..acf35a376a9 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -695,7 +695,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
                          mail-source-movemail-program
                          nil errors nil from to)))))
               (when (file-exists-p to)
-                (set-file-modes to mail-source-default-file-modes))
+                (set-file-modes to mail-source-default-file-modes 'nofollow))
               (if (and (or (not (buffer-modified-p errors))
                            (zerop (buffer-size errors)))
                        (and (numberp result)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 2dab278b373..96695aabfde 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -948,7 +948,7 @@ external if displayed external."
           ;; The file is deleted after the viewer exists.  If the users edits
           ;; the file, changes will be lost.  Set file to read-only to make it
           ;; clear.
-          (set-file-modes file #o400)
+          (set-file-modes file #o400 'nofollow)
           (message "Viewing with %s" method)
           (cond
            (needsterm
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 6e01b5c4d0b..93e4b0e7a8f 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1958,7 +1958,7 @@ If TIME is nil, then return the cutoff time for oldness instead."
   (let ((coding-system-for-write nnmail-file-coding-system)
         (file-name-coding-system nnmail-pathname-coding-system))
     (write-region start end filename append visit lockname)
-    (set-file-modes filename nnmail-default-file-modes)))
+    (set-file-modes filename nnmail-default-file-modes 'nofollow)))
 
 ;;;
 ;;; Status functions
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index f28394260dd..e2d4d7dd057 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4740,7 +4740,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
   (setq ange-ftp-ls-cache-file nil)     ;Stop confusing Dired.
   0)
 
-(defun ange-ftp-set-file-modes (filename mode)
+(defun ange-ftp-set-file-modes (filename mode &optional flag)
+  flag ;; FIXME: Support 'nofollow'.
   (ange-ftp-call-chmod (list (format "%o" mode) filename)))
 
 (defun ange-ftp-make-symbolic-link (&rest _arguments)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index aa7fe147c20..96ef95dbe30 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -591,7 +591,8 @@ Emacs dired can't find files."
           (ignore-errors (delete-file tmpfile))
           (tramp-error
            v 'file-error "Cannot make local copy of file `%s'" filename))
-        (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
+        (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)
+                        'nofollow))
       tmpfile)))
 
 (defun tramp-adb-handle-file-writable-p (filename)
@@ -636,7 +637,8 @@ But handle the case, if the \"test\" command is not available."
            (tmpfile (tramp-compat-make-temp-file filename)))
       (when (and append (file-exists-p filename))
         (copy-file filename tmpfile 'ok)
-        (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
+        (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)
+                        'nofollow))
       (tramp-run-real-handler
        #'write-region (list start end tmpfile append 'no-message lockname))
       (with-tramp-progress-reporter
@@ -665,8 +667,9 @@ But handle the case, if the \"test\" command is not available."
         (tramp-message v 0 "Wrote %s" filename))
       (run-hooks 'tramp-handle-write-region-hook))))
 
-(defun tramp-adb-handle-set-file-modes (filename mode)
+(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
+  flag ;; FIXME: Support 'nofollow'.
   (with-parsed-tramp-file-name filename nil
     (tramp-flush-file-properties v localname)
     (tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 762c4fe4b3b..79835804bc0 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1562,12 +1562,12 @@ If FILE-SYSTEM is non-nil, return file system attributes."
     (tramp-run-real-handler
      #'rename-file (list filename newname ok-if-already-exists))))
 
-(defun tramp-gvfs-handle-set-file-modes (filename mode)
+(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
   (with-parsed-tramp-file-name filename nil
     (tramp-flush-file-properties v localname)
     (tramp-gvfs-send-command
-     v "gvfs-set-attribute" "-t" "uint32"
+     v "gvfs-set-attribute" (if flag "-nt" "-t") "uint32"
      (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
      "unix::mode" (number-to-string mode))))
 
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 5a3abc31ea6..f31d3615884 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1478,10 +1478,11 @@ of."
              ;; only if that agrees with the buffer's record.
              (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))))
 
-(defun tramp-sh-handle-set-file-modes (filename mode)
+(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
   (with-parsed-tramp-file-name filename nil
     (tramp-flush-file-properties v localname)
+    flag ;; FIXME: Support 'nofollow'.
     ;; FIXME: extract the proper text from chmod's stderr.
     (tramp-barf-unless-okay
      v
@@ -2279,7 +2280,7 @@ the uid and gid from FILENAME."
                       ;; We must change the ownership as local user.
                       ;; Since this does not work reliable, we also
                       ;; give read permissions.
-                      (set-file-modes tmpfile #o0777)
+                      (set-file-modes tmpfile #o0777 'nofollow)
                       (tramp-set-file-uid-gid
                        tmpfile
                        (tramp-get-remote-uid v 'integer)
@@ -3221,7 +3222,8 @@ STDERR can also be a file name."
                     (delete-file tmpfile2)))))
 
             ;; Set proper permissions.
-            (set-file-modes tmpfile (tramp-default-file-modes filename))
+            (set-file-modes tmpfile (tramp-default-file-modes filename)
+                            'nofollow)
             ;; Set local user ownership.
             (tramp-set-file-uid-gid tmpfile))
 
@@ -3320,7 +3322,7 @@ STDERR can also be a file name."
           ;; handles permissions.
           ;; Ensure that it is still readable.
           (when modes
-            (set-file-modes tmpfile (logior (or modes 0) #o0400)))
+            (set-file-modes tmpfile (logior (or modes 0) #o0400) 'nofollow))
 
           ;; This is a bit lengthy due to the different methods
           ;; possible for file transfer.  First, we check whether the
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f02be394a7b..95505ea101f 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1464,8 +1464,9 @@ component is used as the target of the symlink."
             (tramp-flush-connection-property v "process-name")
             (tramp-flush-connection-property v "process-buffer")))))))
 
-(defun tramp-smb-handle-set-file-modes (filename mode)
+(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
+  flag ;; FIXME: Support 'nofollow'.
   (with-parsed-tramp-file-name filename nil
     (when (tramp-smb-get-cifs-capabilities v)
       (tramp-flush-file-properties v localname)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index f258ad6b931..4654d633fab 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -463,8 +463,9 @@ the result will be a local, non-Tramp, file name."
       (tramp-sudoedit-send-command
        v "test" "-r" (tramp-compat-file-name-unquote localname)))))
 
-(defun tramp-sudoedit-handle-set-file-modes (filename mode)
+(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
+  flag ;; FIXME: Support 'nofollow'.
   (with-parsed-tramp-file-name filename nil
     (tramp-flush-file-properties v localname)
     (unless (tramp-sudoedit-send-command
@@ -735,7 +736,8 @@ ID-FORMAT valid values are `string' and `integer'."
                          (file-attributes filename 'integer))
                         gid))
           (tramp-set-file-uid-gid filename uid gid))
-        (set-file-modes filename modes)))))
+        (set-file-modes filename modes
+                        (when (eq mustbenew 'excl) 'nofollow))))))
 
 
 ;; Internal functions.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 409e1f7499a..64acaa95d47 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3179,10 +3179,13 @@ User is always nil."
       (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
       tmpfile)))
 
-(defun tramp-handle-file-modes (filename)
+(defun tramp-handle-file-modes (filename &optional flag)
   "Like `file-modes' for Tramp files."
-  (when-let ((attrs (file-attributes (or (file-truename filename) filename))))
-    (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs))))
+  (when-let ((attrs (file-attributes filename)))
+    (let ((mode-string (tramp-compat-file-attribute-modes attrs)))
+      (if (and (not flag) (eq ?l (aref mode-string 0)))
+          (tramp-handle-file-modes (file-chase-links filename) 'nofollow)
+        (tramp-mode-string-to-int mode-string)))))
 
 ;; Localname manipulation functions that grok Tramp localnames...
 (defun tramp-handle-file-name-as-directory (file)
@@ -3884,7 +3887,7 @@ of."
       ;; renamed to the backup file.  This case `save-buffer'
       ;; handles permissions.
       ;; Ensure that it is still readable.
-      (set-file-modes tmpfile (logior (or modes 0) #o0400))
+      (set-file-modes tmpfile (logior (or modes 0) #o0400) 'nofollow)
       ;; We say `no-message' here because we don't want the visited file
       ;; modtime data to be clobbered from the temp file.  We call
       ;; `set-visited-file-modtime' ourselves later on.
@@ -4664,7 +4667,7 @@ Return the local name of the temporary file."
           (setq result nil)
         ;; This creates the file by side effect.
         (set-file-times result)
-        (set-file-modes result #o0700)))
+        (set-file-modes result #o0700 'nofollow)))
 
     ;; Return the local part.
     (tramp-file-local-name result)))
diff --git a/lisp/server.el b/lisp/server.el
index e6d8b1783c9..18612181477 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -563,7 +563,7 @@ See variable `server-auth-dir' for details."
                      (format "it is not owned by you (owner = %s (%d))"
                              (user-full-name uid) uid))
                     (w32 nil)           ; on NTFS?
-                    ((let ((modes (file-modes dir)))
+                    ((let ((modes (file-modes dir 'nofollow)))
                        (unless (zerop (logand (or modes 0) #o077))
                          (format "it is accessible by others (%03o)" modes))))
                     (t nil))))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 645011a5783..6dd7a9c2aac 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -615,9 +615,7 @@ Creates FILE and its parent directories if they do not exist."
         (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))
-     (set-file-modes file #o0600))))
+     (set-file-modes file #o0600 'nofollow))))
 
 (autoload 'puny-encode-domain "puny")
 (autoload 'url-domsuf-cookie-allowed-p "url-domsuf")