From 6d580b00e48e567ac92645e2d120769475d196ad Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 8 Jul 2021 07:48:40 +0200 Subject: [PATCH] Some further adaptions wrt Tramp file name locks * lisp/files.el (files--transform-file-name): Rename from `auto-save--transform-file-name'. Wrap with `save-match-data'. (make-auto-save-file-name): Use it. (make-lock-file-name): Use it. Call file name handler. * lisp/net/tramp.el (tramp-handle-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Suppress file lock for temporary file. * lisp/net/tramp-compat.el (tramp-compat-make-lock-file-name): New defalias. * lisp/net/tramp.el (tramp-get-lock-file) (tramp-handle-lock-file, tramp-handle-unlock-file): Use it. (tramp-make-lock-name): Remove. * test/lisp/filenotify-tests.el (file-notify-test03-events-remote): Tag it :unstable temporarily. --- lisp/files.el | 122 +++++++++++++++++----------------- lisp/net/tramp-adb.el | 3 +- lisp/net/tramp-compat.el | 10 +++ lisp/net/tramp-sh.el | 7 +- lisp/net/tramp-smb.el | 3 +- lisp/net/tramp.el | 15 ++--- test/lisp/filenotify-tests.el | 2 +- 7 files changed, 87 insertions(+), 75 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index c1377320b35..da8598f1502 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6679,12 +6679,12 @@ Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. See also `auto-save-file-name-p'." (if buffer-file-name - (let ((handler (find-file-name-handler buffer-file-name - 'make-auto-save-file-name))) + (let ((handler (find-file-name-handler + buffer-file-name 'make-auto-save-file-name))) (if handler (funcall handler 'make-auto-save-file-name) - (auto-save--transform-file-name buffer-file-name - auto-save-file-name-transforms + (files--transform-file-name + buffer-file-name auto-save-file-name-transforms "#" "#"))) ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) @@ -6735,73 +6735,73 @@ See also `auto-save-file-name-p'." (file-error nil)) file-name))) -(defun auto-save--transform-file-name (filename transforms - prefix suffix) +(defun files--transform-file-name (filename transforms prefix suffix) "Transform FILENAME according to TRANSFORMS. See `auto-save-file-name-transforms' for the format of TRANSFORMS. PREFIX is prepended to the non-directory portion of the resulting file name, and SUFFIX is appended." - (let (result uniq) - ;; Apply user-specified translations - ;; to the file name. - (while (and transforms (not result)) - (if (string-match (car (car transforms)) filename) - (setq result (replace-match (cadr (car transforms)) t nil - filename) - uniq (car (cddr (car transforms))))) - (setq transforms (cdr transforms))) - (when result - (setq filename - (cond - ((memq uniq (secure-hash-algorithms)) - (concat - (file-name-directory result) - (secure-hash uniq filename))) - (uniq - (concat - (file-name-directory result) - (subst-char-in-string - ?/ ?! - (replace-regexp-in-string - "!" "!!" filename)))) - (t result)))) - (setq result - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - ;; We truncate the file name to DOS 8+3 limits - ;; before doing anything else, because the regexp - ;; passed to string-match below cannot handle - ;; extensions longer than 3 characters, multiple - ;; dots, and other atrocities. - (let ((fn (dos-8+3-filename - (file-name-nondirectory buffer-file-name)))) - (string-match - "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" - fn) - (concat (file-name-directory buffer-file-name) - prefix (match-string 1 fn) - "." (match-string 3 fn) suffix)) - (concat (file-name-directory filename) - prefix - (file-name-nondirectory filename) - suffix))) - ;; Make sure auto-save file names don't contain characters - ;; invalid for the underlying filesystem. - (expand-file-name - (if (and (memq system-type '(ms-dos windows-nt cygwin)) - ;; Don't modify remote filenames - (not (file-remote-p result))) - (convert-standard-filename result) - result)))) + (save-match-data + (let (result uniq) + ;; Apply user-specified translations to the file name. + (while (and transforms (not result)) + (if (string-match (car (car transforms)) filename) + (setq result (replace-match (cadr (car transforms)) t nil + filename) + uniq (car (cddr (car transforms))))) + (setq transforms (cdr transforms))) + (when result + (setq filename + (cond + ((memq uniq (secure-hash-algorithms)) + (concat + (file-name-directory result) + (secure-hash uniq filename))) + (uniq + (concat + (file-name-directory result) + (subst-char-in-string + ?/ ?! + (replace-regexp-in-string + "!" "!!" filename)))) + (t result)))) + (setq result + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + ;; We truncate the file name to DOS 8+3 limits before + ;; doing anything else, because the regexp passed to + ;; string-match below cannot handle extensions longer + ;; than 3 characters, multiple dots, and other + ;; atrocities. + (let ((fn (dos-8+3-filename + (file-name-nondirectory buffer-file-name)))) + (string-match + "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" + fn) + (concat (file-name-directory buffer-file-name) + prefix (match-string 1 fn) + "." (match-string 3 fn) suffix)) + (concat (file-name-directory filename) + prefix + (file-name-nondirectory filename) + suffix))) + ;; Make sure auto-save file names don't contain characters + ;; invalid for the underlying filesystem. + (expand-file-name + (if (and (memq system-type '(ms-dos windows-nt cygwin)) + ;; Don't modify remote filenames + (not (file-remote-p result))) + (convert-standard-filename result) + result))))) (defun make-lock-file-name (filename) "Make a lock file name for FILENAME. By default, this just prepends \".*\" to the non-directory part of FILENAME, but the transforms in `lock-file-name-transforms' are done first." - (save-match-data - (auto-save--transform-file-name - filename lock-file-name-transforms ".#" ""))) + (let ((handler (find-file-name-handler filename 'make-lock-file-name))) + (if handler + (funcall handler 'make-lock-file-name filename) + (files--transform-file-name filename lock-file-name-transforms ".#" "")))) (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 9c1c8aca1ca..2bd13671458 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -564,7 +564,8 @@ But handle the case, if the \"test\" command is not available." (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) - (write-region start end tmpfile append 'no-message) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (with-tramp-progress-reporter v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 54cfb6fb4a4..9d5e5f787b6 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -353,6 +353,16 @@ A nil value for either argument stands for the current time." (lambda (fromstring tostring instring) (replace-regexp-in-string (regexp-quote fromstring) tostring instring)))) +;; Function `make-lock-file-name' is new in Emacs 28.1. +(defalias 'tramp-compat-make-lock-file-name + (if (fboundp 'make-lock-file-name) + #'make-lock-file-name + (lambda (filename) + (expand-file-name + (concat + ".#" (file-name-nondirectory filename)) + (file-name-directory filename))))) + (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 11037227790..c65800bb0ea 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3274,7 +3274,9 @@ 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) + (write-region + start end localname append 'no-message + (and lockname (file-local-name lockname))) (let* ((modes (tramp-default-file-modes filename (and (eq mustbenew 'excl) 'nofollow))) @@ -3308,7 +3310,8 @@ implementation will be used." ;; on. We must ensure that `file-coding-system-alist' ;; matches `tmpfile'. (let ((file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile))) + (tramp-find-file-name-coding-system-alist filename tmpfile)) + create-lockfiles) (condition-case err (write-region start end tmpfile append 'no-message) ((error quit) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 500245b3e19..01192db920a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1606,7 +1606,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." ;; 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. - (write-region start end tmpfile append 'no-message) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 37d60e854f2..e9e08265fed 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3818,15 +3818,10 @@ User is always nil." ;; Result. (cons (expand-file-name filename) (cdr result))))) -(defun tramp-make-lock-name (file) - "Implement MAKE_LOCK_NAME of filelock.c." - (expand-file-name - (concat ".#" (file-name-nondirectory file)) (file-name-directory file))) - (defun tramp-get-lock-file (file) "Read lockfile of FILE. Return nil when there is no lockfile" - (let ((lockname (tramp-make-lock-name file))) + (let ((lockname (tramp-compat-make-lock-file-name file))) (or (file-symlink-p lockname) (and (file-readable-p lockname) (with-temp-buffer @@ -3873,7 +3868,7 @@ Return nil when there is no lockfile" (match-string 2 contents) (match-string 3 contents))) (throw 'dont-lock nil))) - (let ((lockname (tramp-make-lock-name file)) + (let ((lockname (tramp-compat-make-lock-file-name file)) ;; USER@HOST.PID[:BOOT_TIME] (contents (format @@ -3886,7 +3881,8 @@ Return nil when there is no lockfile" (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." - (delete-file (tramp-make-lock-name file))) + (ignore-errors + (delete-file (tramp-compat-make-lock-file-name file)))) (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix) "Like `load' for Tramp files." @@ -4470,7 +4466,8 @@ of." ;; 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. - (write-region start end tmpfile append 'no-message) + (let (create-lockfiles) + (write-region start end tmpfile append 'no-message)) (condition-case nil (rename-file tmpfile filename 'ok-if-already-exists) (error diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index e0fa66a5d99..6125069c6b3 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -927,7 +927,7 @@ delivered." (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test03-events - "Check file creation/change/removal notifications for remote files.") + "Check file creation/change/removal notifications for remote files." t) (require 'autorevert) (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" -- 2.39.2