From 013ab7e2a83afa7fb577c356ae686439a2906f34 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 17 Jan 2023 16:00:08 +0100 Subject: [PATCH] Complete implementation of `file-user-id' * lisp/net/ange-ftp.el (ange-ftp-file-user-uid): New defun. Mark it as file name handler for `file-user-uid'. * lisp/net/tramp-archive.el (tramp-archive-handle-file-user-uid): Move up. Protect `file-user-id' call for older Emacs versions. * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): Remove 'file-user-uid'. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test44-file-user-uid): New test. (tramp-archive-test48-auto-load) (tramp-archive-test48-delay-load): Rename. * test/lisp/net/tramp-tests.el (tramp-test44-file-user-uid): New test. (tramp--test-asynchronous-requests-timeout): Adapt docstring. (tramp-test45-asynchronous-requests) (tramp-test46-dired-compress-file) (tramp-test46-dired-compress-dir, tramp-test47-read-password) (tramp-test48-auto-load, tramp-test48-delay-load) (tramp-test48-recursive-load, tramp-test48-remote-load-path) (tramp-test49-unload): Rename. --- lisp/net/ange-ftp.el | 7 +++ lisp/net/tramp-archive.el | 13 +++--- lisp/net/tramp-crypt.el | 2 +- test/lisp/net/tramp-archive-tests.el | 15 ++++++- test/lisp/net/tramp-tests.el | 67 ++++++++++++++++++++-------- 5 files changed, 76 insertions(+), 28 deletions(-) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index a14122f815a..e21367135d3 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4379,6 +4379,10 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; or return nil meaning don't make a backup. (if ange-ftp-make-backup-files (ange-ftp-real-find-backup-file-name fn))) + +(defun ange-ftp-file-user-uid () + ;; Return "don't know" value. + -1) ;;; Define the handler for special file names ;;; that causes ange-ftp to be invoked. @@ -4519,6 +4523,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (put 'file-notify-add-watch 'ange-ftp 'ignore) (put 'file-notify-rm-watch 'ange-ftp 'ignore) (put 'file-notify-valid-p 'ange-ftp 'ignore) + +;; Return the "don't know' value for remote user uid. +(put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid) ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index b9cf85bd843..7c1f578d085 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -670,6 +670,13 @@ offered." (setq local (expand-file-name local (file-name-directory localname)))) (concat (file-truename archive) local)))) +(defun tramp-archive-handle-file-user-uid () + "Like `user-uid' for file archives." + (with-parsed-tramp-archive-file-name default-directory nil + (let ((default-directory (file-name-directory archive))) + ;; `file-user-uid' exists since Emacs 30.1. + (tramp-compat-funcall 'file-user-uid)))) + (defun tramp-archive-handle-insert-directory (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for file archives." @@ -702,12 +709,6 @@ offered." (let ((default-directory (file-name-directory archive))) (temporary-file-directory)))) -(defun tramp-archive-handle-file-user-uid () - "Like `user-uid' for file archives." - (with-parsed-tramp-archive-file-name default-directory nil - (let ((default-directory (file-name-directory archive))) - (file-user-uid)))) - (defun tramp-archive-handle-not-implemented (operation &rest args) "Generic handler for operations not implemented for file archives." (let ((v (ignore-errors diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index b9d0d96eccc..afd3166d161 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -204,7 +204,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-crypt-handle-file-system-info) ;; `file-truename' performed by default handler. - (file-user-uid . tramp-handle-file-user-uid) + ;; `file-user-uid' performed by default-handler. (file-writable-p . tramp-crypt-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 59b7ed9cf7c..8fe1dbd8d0b 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -878,7 +878,18 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test47-auto-load () +;; `file-user-uid' was introduced in Emacs 30.1. +(ert-deftest tramp-archive-test44-file-user-uid () + "Check that `file-user-uid' returns proper values." + (skip-unless tramp-archive-enabled) + (skip-unless (fboundp 'file-user-uid)) + + (let ((default-directory tramp-archive-test-archive)) + ;; `file-user-uid' exists since Emacs 30.1. We don't want to see + ;; compiler warnings for older Emacsen. + (should (integerp (with-no-warnings (file-user-uid)))))) + +(ert-deftest tramp-archive-test48-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) @@ -923,7 +934,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (format "(setq tramp-archive-enabled %s)" enabled)) (shell-quote-argument (format code file))))))))))) -(ert-deftest tramp-archive-test47-delay-load () +(ert-deftest tramp-archive-test48-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 168933b6b46..0932a53f4b1 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -33,7 +33,7 @@ ;; remote host, set this environment variable to "/dev/null" or ;; whatever is appropriate on your system. -;; For slow remote connections, `tramp-test44-asynchronous-requests' +;; For slow remote connections, `tramp-test45-asynchronous-requests' ;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper ;; value less than 10 could help. @@ -6297,7 +6297,7 @@ INPUT, if non-nil, is a string sent to the process." (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 + ;; `make-lock-file-name' exist since Emacs 28.1. We don't want to ;; see compiler warnings for older Emacsen. (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) @@ -7076,11 +7076,40 @@ This requires restrictions of file name syntax." (dotimes (i (length fsi)) (should (natnump (or (nth i fsi) 0)))))) -;; `tramp-test44-asynchronous-requests' could be blocked. So we set a +;; `file-user-uid' was introduced in Emacs 30.1. +(ert-deftest tramp-test44-file-user-uid () + "Check that `file-user-uid' and `tramp-get-remote-*' return proper values." + (skip-unless (tramp--test-enabled)) + + (let ((default-directory ert-remote-temporary-file-directory)) + ;; `file-user-uid' exists since Emacs 30.1. We don't want to see + ;; compiler warnings for older Emacsen. + (when (fboundp 'file-user-uid) + (should (integerp (with-no-warnings (file-user-uid))))) + + (with-parsed-tramp-file-name default-directory nil + (should (or (integerp (tramp-get-remote-uid v 'integer)) + (null (tramp-get-remote-uid v 'integer)))) + (should (or (stringp (tramp-get-remote-uid v 'string)) + (null (tramp-get-remote-uid v 'string)))) + + (should (or (integerp (tramp-get-remote-gid v 'integer)) + (null (tramp-get-remote-gid v 'integer)))) + (should (or (stringp (tramp-get-remote-gid v 'string)) + (null (tramp-get-remote-gid v 'string)))) + + (when-let ((groups (tramp-get-remote-groups v 'integer))) + (should (consp groups)) + (dolist (group groups) (should (integerp group)))) + (when-let ((groups (tramp-get-remote-groups v 'string))) + (should (consp groups)) + (dolist (group groups) (should (stringp group))))))) + +;; `tramp-test45-asynchronous-requests' could be blocked. So we set a ;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300 ;; seconds. Similar check is performed in the timer function. (defconst tramp--test-asynchronous-requests-timeout 300 - "Timeout for `tramp-test44-asynchronous-requests'.") + "Timeout for `tramp-test45-asynchronous-requests'.") (defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body) "Set \"process-name\" and \"process-buffer\" connection properties. @@ -7116,7 +7145,7 @@ This is needed in timer functions as well as process filters and sentinels." (tramp-flush-connection-property v "process-buffer"))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test44-asynchronous-requests () +(ert-deftest tramp-test45-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -7283,7 +7312,7 @@ process sentinels. They shall not disturb each other." (unless (process-live-p proc) (setq buffers (delq buf buffers)))))) - ;; Checks. All process output shall exists in the + ;; Checks. All process output shall exist in the ;; respective buffers. All created files shall be ;; deleted. (tramp--test-message "Check %s" (current-time-string)) @@ -7309,10 +7338,10 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive)))))) -;; (tramp--test-deftest-direct-async-process tramp-test44-asynchronous-requests +;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests ;; 'unstable) -(ert-deftest tramp-test45-dired-compress-file () +(ert-deftest tramp-test46-dired-compress-file () "Check that Tramp (un)compresses normal files." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) @@ -7333,7 +7362,7 @@ process sentinels. They shall not disturb each other." (should (string= tmp-name (dired-get-filename))) (delete-file tmp-name))) -(ert-deftest tramp-test45-dired-compress-dir () +(ert-deftest tramp-test46-dired-compress-dir () "Check that Tramp (un)compresses directories." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) @@ -7355,7 +7384,7 @@ process sentinels. They shall not disturb each other." (delete-directory tmp-name) (delete-file (concat tmp-name ".tar.gz")))) -(ert-deftest tramp-test46-read-password () +(ert-deftest tramp-test47-read-password () "Check Tramp password handling." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -7415,7 +7444,7 @@ process sentinels. They shall not disturb each other." (should (file-exists-p ert-remote-temporary-file-directory))))))))) ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test47-auto-load () +(ert-deftest tramp-test48-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -7440,7 +7469,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test47-delay-load () +(ert-deftest tramp-test48-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -7470,7 +7499,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test47-recursive-load () +(ert-deftest tramp-test48-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -7494,7 +7523,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test47-remote-load-path () +(ert-deftest tramp-test48-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -7519,7 +7548,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test48-unload () +(ert-deftest tramp-test49-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -7620,19 +7649,19 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * file-name-case-insensitive-p ;; * memory-info ;; * tramp-get-home-directory -;; * tramp-get-remote-gid -;; * tramp-get-remote-groups -;; * tramp-get-remote-uid ;; * tramp-set-file-uid-gid ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * Check, why a process filter t doesn't work in +;; `tramp-test29-start-file-process' and +;; `tramp-test30-make-process'. ;; * Implement `tramp-test31-interrupt-process' and ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct ;; async processes. Check, why they don't run stable. ;; * Check, why direct async processes do not work for -;; `tramp-test44-asynchronous-requests'. +;; `tramp-test45-asynchronous-requests'. (provide 'tramp-tests) -- 2.39.5