[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 013ab7e2a8: Complete implementation of `file-user-id'
From: |
Michael Albinus |
Subject: |
master 013ab7e2a8: Complete implementation of `file-user-id' |
Date: |
Tue, 17 Jan 2023 10:00:21 -0500 (EST) |
branch: master
commit 013ab7e2a83afa7fb577c356ae686439a2906f34
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
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 a14122f815..e21367135d 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 b9cf85bd84..7c1f578d08 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 b9d0d96ecc..afd3166d16 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 59b7ed9cf7..8fe1dbd8d0 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 168933b6b4..0932a53f4b 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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 013ab7e2a8: Complete implementation of `file-user-id',
Michael Albinus <=