unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Stephen Gildea <stepheng+emacs@gildea.com>
To: 50410@debbugs.gnu.org
Cc: michael.albinus@gmx.de
Subject: bug#50410: Tramp does not honor default file modes in make-directory
Date: Sun, 05 Sep 2021 11:17:15 -0700	[thread overview]
Message-ID: <1505932.1630865835@pental> (raw)

[-- Attachment #1: Type: text/plain, Size: 82 bytes --]

Package: emacs
Version: 28.0.50
Tags: patch
X-Debbugs-CC: michael.albinus@gmx.de


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Tramp: honor default file modes in make-directory --]
[-- Type: text/x-diff, Size: 6148 bytes --]

Tramp: honor default file modes in make-directory

* lisp/net/tramp-sh.el:
* lisp/net/tramp-adb.el:
* lisp/net/tramp-sudoedit.el:
* lisp/net/tramp-gvfs.el: Add support for default file modes to
relevant Tramp back ends for make-directory.
* test/lisp/net/tramp-tests.el (tramp-test13-make-directory-with-file-modes):
New test.

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a2bf0afbf5..e57145e8e7 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2449,8 +2449,9 @@ tramp-sh-handle-make-directory
     (tramp-flush-directory-properties
      v (if parents "/" (file-name-directory localname)))
     (tramp-barf-unless-okay
-     v (format "%s %s"
+     v (format "%s -m %#o %s"
 	       (if parents "mkdir -p" "mkdir")
+	       (default-file-modes)
 	       (tramp-shell-quote-argument localname))
      "Couldn't make directory %s" dir)))
 
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 70dbfdb947..a35ac37a20 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -442,7 +442,9 @@ tramp-adb-handle-make-directory
 	  (make-directory par parents))))
     (tramp-flush-directory-properties v localname)
     (unless (or (tramp-adb-send-command-and-check
-		 v (format "mkdir %s" (tramp-shell-quote-argument localname)))
+		 v (format "mkdir -m %#o %s"
+			   (default-file-modes)
+			   (tramp-shell-quote-argument localname)))
 		(and parents (file-directory-p dir)))
       (tramp-error v 'file-error "Couldn't make directory %s" dir))))
 
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 5895f1d25b..051d145c2a 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -597,6 +597,7 @@ tramp-sudoedit-handle-make-directory
      v (if parents "/" (file-name-directory localname)))
     (unless (tramp-sudoedit-send-command
 	     v (if parents '("mkdir" "-p") "mkdir")
+	     "-m" (format "%#o" (default-file-modes))
 	     (tramp-compat-file-name-unquote localname))
       (tramp-error v 'file-error "Couldn't make directory %s" dir))))
 
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e4f54cf4c4..eb889bb4f2 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1574,10 +1574,13 @@ tramp-gvfs-handle-make-directory
 	(when (and parents (not (file-directory-p ldir)))
 	  (make-directory ldir parents))
 	;; Just do it.
-	(unless (or (tramp-gvfs-send-command
-		     v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
-		    (and parents (file-directory-p dir)))
-	  (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
+	(or (let ((mkdir-succeeded
+		   (tramp-gvfs-send-command
+		    v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))))
+	      (if mkdir-succeeded (set-file-modes dir (default-file-modes)))
+	      mkdir-succeeded)
+	    (and parents (file-directory-p dir))
+	    (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
 
 (defun tramp-gvfs-handle-rename-file
   (filename newname &optional ok-if-already-exists)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9a9684dd73..249ee9e94d 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2765,28 +2765,38 @@ tramp-test12-rename-file
 	    (ignore-errors (delete-directory source 'recursive))
 	    (ignore-errors (delete-directory target 'recursive))))))))
 
-(ert-deftest tramp-test13-make-directory ()
-  "Check `make-directory'.
-This tests also `file-directory-p' and `file-accessible-directory-p'."
-  (skip-unless (tramp--test-enabled))
-
-  (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
+(defun tramp-test-make-directory-helper (test-default-file-modes-p)
+  "Helper test used by tramp-test13-make-directory* tests."
+  (dolist (quoted (if (and (tramp--test-expensive-test)
+                           (not test-default-file-modes-p))
+                      '(nil t)
+                    '(nil)))
     (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
-	   (tmp-name2 (expand-file-name "foo/bar" tmp-name1)))
+	   (tmp-name2 (expand-file-name "foo/bar" tmp-name1))
+	   (unusual-file-mode-1 #o740)
+	   (unusual-file-mode-2 #o710))
       (unwind-protect
 	  (progn
-	    (make-directory tmp-name1)
+	    (with-file-modes unusual-file-mode-1
+	      (make-directory tmp-name1))
 	    (should-error
 	     (make-directory tmp-name1)
 	     :type 'file-already-exists)
 	    (should (file-directory-p tmp-name1))
 	    (should (file-accessible-directory-p tmp-name1))
+	    (and test-default-file-modes-p
+		 (should (equal (format "%#o" unusual-file-mode-1)
+				(format "%#o" (file-modes tmp-name1)))))
 	    (should-error
 	     (make-directory tmp-name2)
 	     :type 'file-error)
-	    (make-directory tmp-name2 'parents)
+	    (with-file-modes unusual-file-mode-2
+	      (make-directory tmp-name2 'parents))
 	    (should (file-directory-p tmp-name2))
 	    (should (file-accessible-directory-p tmp-name2))
+	    (and test-default-file-modes-p
+		 (should (equal (format "%#o" unusual-file-mode-2)
+				(format "%#o" (file-modes tmp-name2)))))
 	    ;; If PARENTS is non-nil, `make-directory' shall not
 	    ;; signal an error when DIR exists already.
 	    (make-directory tmp-name2 'parents))
@@ -2794,6 +2804,21 @@ tramp-test13-make-directory
 	;; Cleanup.
 	(ignore-errors (delete-directory tmp-name1 'recursive))))))
 
+(ert-deftest tramp-test13-make-directory ()
+  "Check `make-directory'.
+This tests also `file-directory-p' and `file-accessible-directory-p'."
+  (skip-unless (tramp--test-enabled))
+  (tramp-test-make-directory-helper nil))
+
+(ert-deftest tramp-test13-make-directory-with-file-modes ()
+  "Check that `make-directory' honors `default-file-modes'.
+This is a separate test from `tramp-test13-make-directory' because
+some backends cannot pass this test.  The \"smb\" backend fails
+unless the SMB server supports \"posix\" extensions.
+The \"adb\" backend fails on the /sdcard filesystem."
+  (skip-unless (tramp--test-enabled))
+  (tramp-test-make-directory-helper t))
+
 (ert-deftest tramp-test14-delete-directory ()
   "Check `delete-directory'."
   (skip-unless (tramp--test-enabled))

             reply	other threads:[~2021-09-05 18:17 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-09-05 18:17 Stephen Gildea [this message]
2021-09-06 13:39 ` bug#50410: Tramp does not honor default file modes in make-directory Michael Albinus
2021-09-08 16:59   ` Michael Albinus
2021-09-10 13:51     ` Stephen Gildea
2021-09-10 16:55       ` Michael Albinus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1505932.1630865835@pental \
    --to=stepheng+emacs@gildea.com \
    --cc=50410@debbugs.gnu.org \
    --cc=michael.albinus@gmx.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).