From: Michael Albinus Date: Wed, 14 Jul 2021 16:36:14 +0000 (+0200) Subject: Preserve backward compatibility in Tramp X-Git-Tag: emacs-28.0.90~1867 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=525d5cab36fe7e719ecc49b88a1ac68abbe7924c;p=emacs.git Preserve backward compatibility in Tramp * lisp/net/tramp-crypt.el (tramp-crypt-handle-lock-file) (tramp-crypt-handle-unlock-file): Preserve backward compatibility. * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): Do not create lock file twice. * lisp/net/tramp.el (tramp-handle-make-lock-file-name): Move lock file security check ... (tramp-handle-lock-file): ... here. (tramp-handle-unlock-file): Preserve backward compatibility. * test/lisp/net/tramp-tests.el (lock-file-name-transforms) (remote-file-name-inhibit-locks): Declare. (tramp-allow-unsafe-temporary-files): Set to t. (tramp-test37-make-auto-save-file-name) (tramp-test38-find-backup-file-name): Move binding of `tramp-allow-unsafe-temporary-files' up. (tramp-test39-lock-file): Bind `tramp-allow-unsafe-temporary-files'. Preserve backward compatibility. Extend test. --- diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 109db3b1d7b..fdb2907ec32 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -809,7 +809,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-lock-file (filename) "Like `lock-file' for Tramp files." (let (tramp-crypt-enabled) - (lock-file (tramp-crypt-encrypt-file-name filename)))) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall + 'lock-file (tramp-crypt-encrypt-file-name filename)))) (defun tramp-crypt-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -865,7 +867,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-unlock-file (filename) "Like `unlock-file' for Tramp files." (let (tramp-crypt-enabled) - (unlock-file (tramp-crypt-encrypt-file-name filename)))) + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall + 'unlock-file (tramp-crypt-encrypt-file-name filename)))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 760320d7ed4..e6bd42a83ae 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3272,7 +3272,8 @@ implementation will be used." (or (file-directory-p localname) (file-writable-p localname))) ;; Short track: if we are on the local host, we can run directly. - (write-region start end localname append 'no-message lockname) + (let ((create-lockfiles (not file-locked))) + (write-region start end localname append 'no-message lockname)) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3f586c62170..736c7efd242 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3873,43 +3873,44 @@ Return nil when there is no lockfile." (format "%s@%s.%s" (user-login-name) (system-name) (tramp-get-lock-pid file)))) + + ;; Protect against security hole. + (with-parsed-tramp-file-name file nil + (when (and (not tramp-allow-unsafe-temporary-files) + (file-in-directory-p lockname temporary-file-directory) + (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes file 'integer)) + tramp-unknown-id-integer)) + (not (with-tramp-connection-property + (tramp-get-process v) "unsafe-temporary-file" + (yes-or-no-p + (concat + "Lock file on local temporary directory, " + "do you want to continue? "))))) + (tramp-error v 'file-error "Unsafe lock file name"))) + + ;; Do the lock. (let (create-lockfiles signal-hook-function) (condition-case nil (make-symbolic-link info lockname 'ok-if-already-exists) (error - (write-region info nil lockname) - (set-file-modes lockname #o0644)))))))) + (with-file-modes #o0644 + (write-region info nil lockname))))))))) (defun tramp-handle-make-lock-file-name (file) "Like `make-lock-file-name' for Tramp files." - (when (and create-lockfiles - ;; This variable has been introduced with Emacs 28.1. - (not (bound-and-true-p remote-file-name-inhibit-locks))) - (with-parsed-tramp-file-name file nil - (let ((result - ;; Run plain `make-lock-file-name'. - (tramp-run-real-handler #'make-lock-file-name (list file)))) - ;; Protect against security hole. - (when (and (not tramp-allow-unsafe-temporary-files) - (file-in-directory-p result temporary-file-directory) - (zerop (or (tramp-compat-file-attribute-user-id - (file-attributes file 'integer)) - tramp-unknown-id-integer)) - (not (with-tramp-connection-property - (tramp-get-process v) "unsafe-temporary-file" - (yes-or-no-p - (concat - "Lock file on local temporary directory, " - "do you want to continue? "))))) - (tramp-error v 'file-error "Unsafe lock file name")) - result)))) + (and create-lockfiles + ;; This variable has been introduced with Emacs 28.1. + (not (bound-and-true-p remote-file-name-inhibit-locks)) + (tramp-run-real-handler 'make-lock-file-name (list file)))) (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." (when-let ((lockname (tramp-compat-make-lock-file-name file))) (condition-case err (delete-file lockname) - (error (userlock--handle-unlock-error err))))) + ;; `userlock--handle-unlock-error' exists since Emacs 28.1. + (error (tramp-compat-funcall 'userlock--handle-unlock-error err))))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index bc05db8095b..3dd22acea51 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -63,6 +63,8 @@ (declare-function tramp-smb-get-localname "tramp-smb") (defvar ange-ftp-make-backup-files) (defvar auto-save-file-name-transforms) +(defvar lock-file-name-transforms) +(defvar remote-file-name-inhibit-locks) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) (defvar tramp-display-escape-sequence-regexp) @@ -122,6 +124,7 @@ (setq auth-source-save-behavior nil password-cache-expiry nil remote-file-name-inhibit-cache nil + tramp-allow-unsafe-temporary-files t tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil tramp-persistency-file-name nil @@ -5481,7 +5484,8 @@ Use direct async.") (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) - (tmp-name2 (tramp--test-make-temp-name nil quoted))) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + tramp-allow-unsafe-temporary-files) (unwind-protect (progn @@ -5569,8 +5573,7 @@ Use direct async.") ;; Create temporary file. This shall check for sensible ;; files, owned by root. - (let ((tramp-auto-save-directory temporary-file-directory) - tramp-allow-unsafe-temporary-files) + (let ((tramp-auto-save-directory temporary-file-directory)) (write-region "foo" nil tmp-name1) (when (zerop (or (tramp-compat-file-attribute-user-id (file-attributes tmp-name1)) @@ -5606,6 +5609,7 @@ Use direct async.") (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (ange-ftp-make-backup-files t) + tramp-allow-unsafe-temporary-files ;; These settings are not used by Tramp, so we ignore them. version-control delete-old-versions (kept-old-versions (default-toplevel-value 'kept-old-versions)) @@ -5716,7 +5720,6 @@ Use direct async.") ;; Create temporary file. This shall check for sensible ;; files, owned by root. (let ((backup-directory-alist `(("." . ,temporary-file-directory))) - tramp-allow-unsafe-temporary-files tramp-backup-directory-alist) (write-region "foo" nil tmp-name1) (when (zerop (or (tramp-compat-file-attribute-user-id @@ -5749,13 +5752,18 @@ Use direct async.") (skip-unless (not (tramp--test-ange-ftp-p))) ;; Since Emacs 28.1. (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file))) + (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name))) + ;; `lock-file', `unlock-file', `file-locked-p' and + ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to + ;; see compiler warnings for older Emacsen. (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (remote-file-name-inhibit-cache t) (remote-file-name-inhibit-locks nil) (create-lockfiles t) + tramp-allow-unsafe-temporary-files (inhibit-message t) ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files. (tramp-cleanup-connection-hook @@ -5767,24 +5775,24 @@ Use direct async.") (unwind-protect (progn ;; A simple file lock. - (should-not (file-locked-p tmp-name1)) - (lock-file tmp-name1) - (should (eq (file-locked-p tmp-name1) t)) + (should-not (with-no-warnings (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) ;; If it is locked already, nothing changes. - (lock-file tmp-name1) - (should (eq (file-locked-p tmp-name1) t)) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) ;; A new connection changes process id, and also the ;; lockname contents. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (should (stringp (file-locked-p tmp-name1))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) ;; When `remote-file-name-inhibit-locks' is set, nothing happens. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (let ((remote-file-name-inhibit-locks t)) - (lock-file tmp-name1) - (should-not (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1)) + (should-not (with-no-warnings (file-locked-p tmp-name1)))) ;; When `lock-file-name-transforms' is set, another lock ;; file is used. @@ -5792,48 +5800,77 @@ Use direct async.") (let ((lock-file-name-transforms `((".*" ,tmp-name2)))) (should (string-equal - (make-lock-file-name tmp-name1) - (make-lock-file-name tmp-name2))) - (lock-file tmp-name1) - (should (eq (file-locked-p tmp-name1) t)) - (unlock-file tmp-name1) - (should-not (file-locked-p tmp-name1))) + (with-no-warnings (make-lock-file-name tmp-name1)) + (with-no-warnings (make-lock-file-name tmp-name2)))) + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) + (with-no-warnings (unlock-file tmp-name1)) + (should-not (with-no-warnings (file-locked-p tmp-name1)))) ;; Steal the file lock. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s))) - (lock-file tmp-name1)) - (should (eq (file-locked-p tmp-name1) t)) + (with-no-warnings (lock-file tmp-name1))) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) ;; Ignore the file lock. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p))) - (lock-file tmp-name1)) - (should (stringp (file-locked-p tmp-name1))) + (with-no-warnings (lock-file tmp-name1))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) ;; Quit the file lock machinery. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q))) - (should-error (lock-file tmp-name1) :type 'file-locked) + (with-no-warnings + (should-error + (lock-file tmp-name1) + :type 'file-locked)) ;; The same for `write-region'. (should-error - (write-region "foo" nil tmp-name1) :type 'file-locked) + (write-region "foo" nil tmp-name1) + :type 'file-locked) (should-error (write-region "foo" nil tmp-name1 nil nil tmp-name1) :type 'file-locked) ;; The same for `set-visited-file-name'. (with-temp-buffer (should-error - (set-visited-file-name tmp-name1) :type 'file-locked))) - (should (stringp (file-locked-p tmp-name1))) + (set-visited-file-name tmp-name1) + :type 'file-locked))) + (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) (should-not (file-exists-p tmp-name1))) ;; Cleanup. (ignore-errors (delete-file tmp-name1)) - (unlock-file tmp-name1) - (unlock-file tmp-name2) - (should-not (file-locked-p tmp-name1)) - (should-not (file-locked-p tmp-name2)))))) + (with-no-warnings (unlock-file tmp-name1)) + (with-no-warnings (unlock-file tmp-name2)) + (should-not (with-no-warnings (file-locked-p tmp-name1))) + (should-not (with-no-warnings (file-locked-p tmp-name2)))) + + (unwind-protect + ;; Create temporary file. This shall check for sensible + ;; files, owned by root. + (let ((lock-file-name-transforms auto-save-file-name-transforms)) + (write-region "foo" nil tmp-name1) + (when (zerop (or (tramp-compat-file-attribute-user-id + (file-attributes tmp-name1)) + tramp-unknown-id-integer)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) + (should-error + (write-region "foo" nil tmp-name1) + :type 'file-error)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'yes-or-no-p) + #'tramp--test-always)) + (write-region "foo" nil tmp-name1)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) ;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test40-make-nearby-temp-file ()