master 284bc6a9127: Fix a few bugs in 'make-empty-file'

branch: master
commit 284bc6a9127cd3cb20148850ededd7d70e444c60
Author: Philipp Stephani <[email protected]>
Commit: Philipp Stephani <[email protected]>

    Fix a few bugs in 'make-empty-file'
    
    Crucially, we need to pass 'excl' to 'write-region' so that the file is
    opened in exclusive mode; this is the only way to avoid TOCTTOU errors.
    
    Furthermore, the command errorneously created a parent directory even if
    the PARENT argument is nil.
    
    Add unit tests to cover these cases, including a TOCTTOU test.
    
    * lisp/files.el (make-empty-file): Only create parent directories
    when requested.  Open output file in exclusive mode.
    
    * test/lisp/files-tests.el (files-tests--make-empty-file--exists)
    (files-tests--make-empty-file--parent-missing)
    (files-tests--make-empty-file--tocttou): New unit tests.
---
 lisp/files.el            | 11 +++++++----
 test/lisp/files-tests.el | 26 ++++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 4 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 8f2d8e97e4b..c2f030e0b77 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6759,10 +6759,13 @@ If called interactively, then PARENTS is non-nil."
      (list filename t)))
   (when (and (file-exists-p filename) (null parents))
     (signal 'file-already-exists `("File exists" ,filename)))
-  (let ((paren-dir (file-name-directory filename)))
-    (when (and paren-dir (not (file-exists-p paren-dir)))
-      (make-directory paren-dir parents)))
-  (write-region "" nil filename nil 0))
+  (when parents
+    (let ((paren-dir (file-name-directory filename)))
+      (when (and paren-dir (not (file-exists-p paren-dir)))
+        (make-directory paren-dir parents))))
+  ;; The `excl' is crucial, in case someone else has created the file in
+  ;; the meantime (TOCTTOU).
+  (write-region "" nil filename nil 0 nil 'excl))
 
 (defconst directory-files-no-dot-files-regexp
   "[^.]\\|\\.\\.\\."
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index fdfc1f92b47..9f657cf7b26 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -2302,5 +2302,31 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil."
   (should (file-expand-wildcards
            (concat (directory-file-name default-directory) "*/"))))
 
+(ert-deftest files-tests--make-empty-file--exists ()
+  (ert-with-temp-directory base
+    (let ((file (file-name-concat base "file.txt")))
+      (write-region "" nil file nil nil nil 'excl)
+      (should-error (make-empty-file file)
+                    :type 'file-already-exists))))
+
+(ert-deftest files-tests--make-empty-file--parent-missing ()
+  (ert-with-temp-directory base
+    (let ((file (file-name-concat base "dir" "file.txt")))
+      (should-error (make-empty-file file) :type 'file-missing))))
+
+(ert-deftest files-tests--make-empty-file--tocttou ()
+  (ert-with-temp-directory base
+    (let ((file (file-name-concat base "one" "two" "file.txt")))
+      (cl-flet ((advice (&rest args)
+                  (write-region "" nil file nil nil nil 'excl)))
+        (unwind-protect
+            (progn
+              ;; Simulate that someone else has created the file after
+              ;; checking for its existence.
+              (advice-add #'make-directory :after #'advice)
+              (should-error (make-empty-file file :parents)
+                            :type 'file-already-exists))
+          (advice-remove #'make-directory #'advice))))))
+
 (provide 'files-tests)
 ;;; files-tests.el ends here