emacs-diffs
[Top][All Lists]
Advanced

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]