procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Preserve backward compatibility in Tramp

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2021-07-14 18:36:14 +02:00
parent f45710e1dd
commit 525d5cab36
4 changed files with 100 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/net/tramp-crypt.el
View file

@ -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 ()

3
lisp/net/tramp-sh.el
View file

@ -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)))

49
lisp/net/tramp.el
View file

@ -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."

97
test/lisp/net/tramp-tests.el
View file

@ -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 ()