Use connection-aware functions when getting the UID/GID in Eshell

This means, for example, that when using Tramp to sudo in Eshell, "rm"
queries the user before deleting anything (bug#63221).

* lisp/eshell/esh-util.el (eshell-user-login-name): New function...
* lisp/eshell/em-unix.el (eshell/whoami): ... use it.

* lisp/eshell/em-ls.el (eshell-ls-applicable): Use 'file-user-uid' and
'eshell-user-login-name'.
(eshell-ls-decorated-name): Use 'file-user-uid'.

* lisp/eshell/em-pred.el (eshell-predicate-alist): Use 'file-user-uid'
and 'file-group-gid'.

* lisp/eshell/em-unix.el (eshell-interactive-query): New widget...
(eshell-rm-interactive-query, eshell-mv-interactive-query)
(eshell-cp-interactive-query, eshell-ln-interactive-query): ... use
it.
(eshell-interactive-query-p): New function...
(eshell/rm, eshell/mv, eshell/cp, eshell/ln): ... use it.

* lisp/simple.el (file-group-gid): New function.

* lisp/net/ange-ftp.el (ange-ftp-file-group-gid): New function...
(file-group-gid): ... use it.

* lisp/net/tramp.el (tramp-handle-file-group-gid):
* lisp/net/tramp-archive.el (tramp-archive-handle-file-group-gid): New
functions.

* lisp/net/tramp.el (tramp-file-name-for-operation): Add
'file-group-gid'.

* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
* lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
* lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add 'file-group-gid' mapping.

* test/lisp/net/tramp-tests.el (tramp-test44-file-user-group-ids):
* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test44-file-user-group-ids): Add tests for
'file-group-gid'.

* doc/lispref/files.texi (Magic File Names): Mention 'file-group-gid'.

* doc/lispref/os.texi (User Identification): Document
'file-group-gid', and move 'group-real-gid' to match the order of
'user-real-uid'.

* etc/NEWS: Announce 'file-group-gid'.

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b15f2ab4d297c3bab6c65913a72d8c3b8eab61a7..6e1aae5d63b25666c9c7f6bdeada7807985dc0b7 100644 (file)
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3405,7 +3405,7 @@ first, before handlers for jobs such as remote file access.
 @code{file-readable-p}, @code{file-regular-p},
 @code{file-remote-p}, @code{file-selinux-context},
 @code{file-symlink-p}, @code{file-system-info},
-@code{file-truename}, @code{file-user-uid},
+@code{file-truename}, @code{file-user-uid}, @code{file-group-gid},
 @code{file-writable-p},
 @code{find-backup-file-name},@*
 @code{get-file-buffer},
@@ -3467,7 +3467,7 @@ first, before handlers for jobs such as remote file access.
 @code{file-readable-p}, @code{file-regular-p},
 @code{file-remote-p}, @code{file-selinux-context},
 @code{file-symlink-p}, @code{file-system-info},
-@code{file-truename}, @code{file-user-uid},
+@code{file-truename}, @code{file-user-uid}, @code{file-group-gid},
 @code{file-writable-p},
 @code{find-backup-file-name},
 @code{get-file-buffer},

diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 91143f77551402fa06bbe9e43464c9e1da748d49..4bcc9d5fea636cc94a7b9b79b3382819d1905e26 100644 (file)
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1290,12 +1290,22 @@ the remote connection has no associated user, it will instead return
 @end defun
 
 @cindex GID
+@defun group-real-gid
+This function returns the real @acronym{GID} of the Emacs process.
+@end defun
+
 @defun group-gid
 This function returns the effective @acronym{GID} of the Emacs process.
 @end defun
 
-@defun group-real-gid
-This function returns the real @acronym{GID} of the Emacs process.
+@defun file-group-gid
+This function returns the connection-local value for the user's
+effective @acronym{GID}.  Similar to @code{file-user-uid}, if
+@code{default-directory} is local, this is equivalent to
+@code{group-gid}, but for remote files (@pxref{Remote Files, , ,
+emacs, The GNU Emacs Manual}), it will return the @acronym{GID} for
+the user associated with that remote connection; if the remote
+connection has no associated user, it will instead return -1.
 @end defun
 
 @defun system-users

diff --git a/etc/NEWS b/etc/NEWS
index b989f80f3c3df31c2bea65626a58a2c2ee983b41..3c71e52fff470ca283afe55585cd90b8de3ca2fc 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -529,10 +529,10 @@ The declaration '(important-return-value t)' sets the
 return value should probably not be thrown away implicitly.
 
 +++
-** New function 'file-user-uid'.
-This function is like 'user-uid', but is aware of file name handlers,
-so it will return the remote UID for remote files (or -1 if the
-connection has no associated user).
+** New functions 'file-user-uid' and 'file-group-gid'.
+These functions are like 'user-uid' and 'group-gid', respectively, but
+are aware of file name handlers, so they will return the remote UID or
+GID for remote files (or -1 if the connection has no associated user).
 
 +++
 ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases.

diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 56c5f262789973517b4639ea6d71b23faeede8f1..9b53bf29559ac17065c7e01c75924cfd3c917e10 100644 (file)
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -199,9 +199,9 @@ calling FUNC with FILE as an argument."
   `(let ((owner (file-attribute-user-id ,attrs))
         (modes (file-attribute-modes ,attrs)))
      (cond ((cond ((numberp owner)
-                  (= owner (user-uid)))
+                   (= owner (file-user-uid)))
                  ((stringp owner)
-                  (or (string-equal owner (user-login-name))
+                   (or (string-equal owner (eshell-user-login-name))
                       (member owner (eshell-current-ange-uids)))))
            ;; The user owns this file.
            (not (eq (aref modes ,index) ?-)))
@@ -919,7 +919,7 @@ to use, and each member of which is the width of that column
              ((not (eshell-ls-filetype-p (cdr file) ?-))
               'eshell-ls-special)
 
-             ((and (/= (user-uid) 0) ; root can execute anything
+              ((and (/= (file-user-uid) 0) ; root can execute anything
                    (eshell-ls-applicable (cdr file) 3
                                          'file-executable-p (car file)))
               'eshell-ls-executable)

diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 2ccca092b866d271ab32243d4b85f0d06ef03cf9..bfb0dad60ef37ec4b3ef1b94cca3eaaa971831e5 100644 (file)
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -87,11 +87,11 @@ ordinary strings."
     (?U . (lambda (file)                   ; owned by effective uid
             (if (file-exists-p file)
                 (= (file-attribute-user-id (file-attributes file))
-                   (user-uid)))))
+                   (file-user-uid)))))
     (?G . (lambda (file)               ; owned by effective gid
             (if (file-exists-p file)
                 (= (file-attribute-group-id (file-attributes file))
-                   (group-gid)))))
+                   (file-group-gid)))))
     (?* . (lambda (file)
             (and (file-regular-p file)
                  (not (file-symlink-p file))

diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index a792493e071280c76d9da1c9498b286e47e47fce..b7ef0f0c40cad51ed968335eb0665b4d6e9ca786 100644 (file)
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -91,14 +91,29 @@ Otherwise, `rmdir' is required."
   :type 'boolean
   :group 'eshell-unix)
 
-(defcustom eshell-rm-interactive-query (= (user-uid) 0)
-  "If non-nil, `rm' will query before removing anything."
-  :type 'boolean
+(define-widget 'eshell-interactive-query 'radio
+  "When to interatively query the user about a particular operation.
+If t, always query.  If nil, never query.  If `root', query when
+the user is logged in as root (including when `default-directory'
+is remote with a root user)."
+  :args '((const :tag "Never" nil)
+          (const :tag "Always" t)
+          (const :tag "When root" root)))
+
+(defcustom eshell-rm-interactive-query 'root
+  "When `rm' should query before removing anything.
+If t, always query.  If nil, never query.  If `root', query when
+the user is logged in as root (including when `default-directory'
+is remote with a root user)."
+  :type 'eshell-interactive-query
   :group 'eshell-unix)
 
-(defcustom eshell-mv-interactive-query (= (user-uid) 0)
-  "If non-nil, `mv' will query before overwriting anything."
-  :type 'boolean
+(defcustom eshell-mv-interactive-query 'root
+  "When `mv' should query before overwriting anything.
+If t, always query.  If nil, never query.  If `root', query when
+the user is logged in as root (including when `default-directory'
+is remote with a root user)."
+  :type 'eshell-interactive-query
   :group 'eshell-unix)
 
 (defcustom eshell-mv-overwrite-files t
@@ -106,9 +121,12 @@ Otherwise, `rmdir' is required."
   :type 'boolean
   :group 'eshell-unix)
 
-(defcustom eshell-cp-interactive-query (= (user-uid) 0)
-  "If non-nil, `cp' will query before overwriting anything."
-  :type 'boolean
+(defcustom eshell-cp-interactive-query 'root
+  "When `cp' should query before overwriting anything.
+If t, always query.  If nil, never query.  If `root', query when
+the user is logged in as root (including when `default-directory'
+is remote with a root user)."
+  :type 'eshell-interactive-query
   :group 'eshell-unix)
 
 (defcustom eshell-cp-overwrite-files t
@@ -116,9 +134,12 @@ Otherwise, `rmdir' is required."
   :type 'boolean
   :group 'eshell-unix)
 
-(defcustom eshell-ln-interactive-query (= (user-uid) 0)
-  "If non-nil, `ln' will query before overwriting anything."
-  :type 'boolean
+(defcustom eshell-ln-interactive-query 'root
+  "When `ln' should query before overwriting anything.
+If t, always query.  If nil, never query.  If `root', query when
+the user is logged in as root (including when `default-directory'
+is remote with a root user)."
+  :type 'eshell-interactive-query
   :group 'eshell-unix)
 
 (defcustom eshell-ln-overwrite-files nil
@@ -159,6 +180,17 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
 (defvar em-recursive)
 (defvar em-verbose)
 
+(defun eshell-interactive-query-p (value)
+  "Return non-nil if a command should query the user according to VALUE.
+If VALUE is nil, return nil (never query).  If `root', return
+non-nil if the user is logged in as root (including when
+`default-directory' is remote with a root user; see
+`file-user-uid').  If VALUE is any other non-nil value, return
+non-nil (always query)."
+  (if (eq value 'root)
+      (= (file-user-uid) 0)
+    value))
+
 (defun eshell/man (&rest args)
   "Invoke man, flattening the arguments appropriately."
   (funcall 'man (apply 'eshell-flatten-and-stringify args)))
@@ -249,7 +281,8 @@ argument."
      :usage "[OPTION]... FILE...
 Remove (unlink) the FILE(s).")
    (unless em-interactive
-     (setq em-interactive eshell-rm-interactive-query))
+     (setq em-interactive (eshell-interactive-query-p
+                           eshell-rm-interactive-query)))
    (if (and force-removal em-interactive)
        (setq em-interactive nil))
    (while args
@@ -523,7 +556,8 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
 [OPTION] DIRECTORY...")
    (let ((no-dereference t))
      (eshell-mvcpln-template "mv" "moving" 'rename-file
-                            eshell-mv-interactive-query
+                             (eshell-interactive-query-p
+                              eshell-mv-interactive-query)
                             eshell-mv-overwrite-files))))
 
 (put 'eshell/mv 'eshell-no-numeric-conversions t)
@@ -561,7 +595,8 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
    (if archive
        (setq preserve t no-dereference t em-recursive t))
    (eshell-mvcpln-template "cp" "copying" 'copy-file
-                          eshell-cp-interactive-query
+                           (eshell-interactive-query-p
+                            eshell-cp-interactive-query)
                           eshell-cp-overwrite-files preserve)))
 
 (put 'eshell/cp 'eshell-no-numeric-conversions t)
@@ -594,7 +629,8 @@ with `--symbolic'.  When creating hard links, each TARGET must exist.")
                             (if symbolic
                                 'make-symbolic-link
                               'add-name-to-file)
-                            eshell-ln-interactive-query
+                             (eshell-interactive-query-p
+                              eshell-ln-interactive-query)
                             eshell-ln-overwrite-files))))
 
 (put 'eshell/ln 'eshell-no-numeric-conversions t)
@@ -960,7 +996,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
 
 (defun eshell/whoami (&rest _args)
   "Make \"whoami\" Tramp aware."
-  (or (file-remote-p default-directory 'user) (user-login-name)))
+  (eshell-user-login-name))
 
 (defvar eshell-diff-window-config nil)
 

diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index c06857577899feb65a738912887bad8a4ba5d07a..3608c78ba2bc04ed5464adfcb5368129c997cc37 100644 (file)
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -502,6 +502,11 @@ list."
       (sit-for 0)
     (error nil)))
 
+(defun eshell-user-login-name ()
+  "Return the connection-aware value of the user's login name.
+See also `user-login-name'."
+  (or (file-remote-p default-directory 'user) (user-login-name)))
+
 (defun eshell-read-passwd-file (file)
   "Return an alist correlating gids to group names in FILE."
   (let (names)

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index e21367135d3545bdfab72bc1ac41627b788333f2..1c20a27801db8b17a228e4f98c00b79deb1aa476 100644 (file)
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4381,7 +4381,11 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
       (ange-ftp-real-find-backup-file-name fn)))
 
 (defun ange-ftp-file-user-uid ()
-  ;; Return "don't  know" value.
+  ;; Return "don't know" value.
+  -1)
+
+(defun ange-ftp-file-group-gid ()
+  ;; Return "don't know" value.
   -1)
 \f
 ;;; Define the handler for special file names
@@ -4524,8 +4528,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
 (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.
+;; Return the "don't know" value for remote user uid and group gid.
 (put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid)
+(put 'file-group-gid 'ange-ftp 'ange-ftp-file-group-gid)
 \f
 ;;; Define ways of getting at unmodified Emacs primitives,
 ;;; turning off our handler.

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 5a8044f8a53e5dd33f6e7a967fd70cbe4c924640..6c668640ba4996d1215da0e3d33e1b9db1f05bca 100644 (file)
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -154,6 +154,7 @@ It is used for TCP/IP devices."
     (file-system-info . tramp-adb-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-adb-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index c2175612fa8edf40b6b97f49ab35a96261272993..8de6d4068171a813573bcc4517975a53859bbed3 100644 (file)
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -266,6 +266,7 @@ It must be supported by libarchive(3).")
     (file-system-info . tramp-archive-handle-file-system-info)
     (file-truename . tramp-archive-handle-file-truename)
     (file-user-uid . tramp-archive-handle-file-user-uid)
+    (file-group-gid . tramp-archive-handle-file-group-gid)
     (file-writable-p . ignore)
     (find-backup-file-name . ignore)
     ;; `get-file-buffer' performed by default handler.
@@ -678,6 +679,13 @@ offered."
       ;; `file-user-uid' exists since Emacs 30.1.
       (tramp-compat-funcall 'file-user-uid))))
 
+(defun tramp-archive-handle-file-group-gid ()
+  "Like `group-gid' for file archives."
+  (with-parsed-tramp-archive-file-name default-directory nil
+    (let ((default-directory (file-name-directory archive)))
+      ;; `file-group-gid' exists since Emacs 30.1.
+      (tramp-compat-funcall 'file-group-gid))))
+
 (defun tramp-archive-handle-insert-directory
   (filename switches &optional wildcard full-directory-p)
   "Like `insert-directory' for file archives."

diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index ea27c704587c5b9d516b48270902b862e4e87c24..4acf6938b8465e109652fc75bace9aecfd5d5dfb 100644 (file)
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -205,6 +205,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil."
     (file-system-info . tramp-crypt-handle-file-system-info)
     ;; `file-truename' performed by default handler.
     ;; `file-user-uid' performed by default-handler.
+    ;; `file-group-gid' 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/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 859f4870b803bd04f1a13da94a24fcb376190167..cce34889000b951567c726443f76f0b0cc2b1c92 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -831,6 +831,7 @@ It has been changed in GVFS 1.14.")
     (file-system-info . tramp-gvfs-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 74295de4c2982accbc39ab070448399b78774b8f..aa86946058919b49289772e0a40f111ee722bf7f 100644 (file)
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -119,6 +119,7 @@
     (file-system-info . tramp-rclone-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 0369e19378c39288027600a0b2ab8761858942b2..eacf7084fd16df15e1cbc4ee66c44868283085dd 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1097,6 +1097,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
     (file-system-info . tramp-sh-handle-file-system-info)
     (file-truename . tramp-sh-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-sh-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 9a24403bb18f6100fb3fd8d18c588f437c9dcc16..93e6266313d0f475a7c86db120a2f64fa9e92bef 100644 (file)
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -270,6 +270,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-system-info . tramp-smb-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-smb-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index fe126361ac3f2fcf54009fc9572ded988ceb4c83..d552f6c83fa521b34aa7865e27b3393b6a2434bc 100644 (file)
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -125,6 +125,7 @@
     (file-system-info . tramp-sshfs-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-sshfs-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 941c1e8dd24c44d4e1a165bd182de21efba6b373..531a1591a168c371858c485a09e7272dfa2baab1 100644 (file)
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -115,6 +115,7 @@ See `tramp-actions-before-shell' for more info.")
     (file-system-info . tramp-sudoedit-handle-file-system-info)
     (file-truename . tramp-sudoedit-handle-file-truename)
     (file-user-uid . tramp-handle-file-user-uid)
+    (file-group-gid . tramp-handle-file-group-gid)
     (file-writable-p . tramp-sudoedit-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ca95b6b69716110569a891f9a08ee30e1376225a..9729baeb0d454c18dc77b09bc8be3fac434b7063 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2650,7 +2650,7 @@ Must be handled by the callers."
              ;; Emacs 29+ only.
               list-system-processes memory-info process-attributes
               ;; Emacs 30+ only.
-             file-user-uid))
+             file-user-uid file-group-gid))
     default-directory)
    ;; PROC.
    ((member operation '(file-notify-rm-watch file-notify-valid-p))
@@ -3939,6 +3939,15 @@ Let-bind it when necessary.")
         ;; consistency.
         tramp-unknown-id-integer)))
 
+(defun tramp-handle-file-group-gid ()
+  "Like `group-gid' for Tramp files."
+  (let ((v (tramp-dissect-file-name default-directory)))
+    (or (tramp-get-remote-gid v 'integer)
+        ;; Some handlers for `tramp-get-remote-gid' return nil if they
+        ;; can't get the GID; always return -1 in this case for
+        ;; consistency.
+        tramp-unknown-id-integer)))
+
 (defun tramp-handle-access-file (filename string)
   "Like `access-file' for Tramp files."
   (setq filename (file-truename filename))

diff --git a/lisp/simple.el b/lisp/simple.el
index 8d772eee8a8077347acfc80cd2f53f27d809a5ef..c9960ed5e13adfd57b88036ee4928a12ba67899b 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4753,6 +4753,18 @@ this function will instead return -1."
       (funcall handler 'file-user-uid)
     (user-uid)))
 
+(defun file-group-gid ()
+  "Return the connection-local effective gid.
+This is similar to `group-gid', but may invoke a file name handler
+based on `default-directory'.  See Info node `(elisp)Magic File
+Names'.
+
+If a file name handler is unable to retrieve the effective gid,
+this function will instead return -1."
+  (if-let ((handler (find-file-name-handler default-directory 'file-group-gid)))
+      (funcall handler 'file-group-gid)
+    (group-gid)))
+
 (defun max-mini-window-lines (&optional frame)
   "Compute maximum number of lines for echo area in FRAME.
 As defined by `max-mini-window-height'.  FRAME defaults to the

diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 94ef40a1116c5d3fb80bed581366f95c03c53be9..5fa727a13e525c5c80223fff48b5a04bbf33a28a 100644 (file)
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -881,16 +881,18 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
                 (zerop (nth 1 fsi))
                 (zerop (nth 2 fsi))))))
 
-;; `file-user-uid' was introduced in Emacs 30.1.
-(ert-deftest tramp-archive-test44-file-user-uid ()
+;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1.
+(ert-deftest tramp-archive-test44-user-group-ids ()
   "Check that `file-user-uid' returns proper values."
   (skip-unless tramp-archive-enabled)
-  (skip-unless (fboundp 'file-user-uid))
+  (skip-unless (and (fboundp 'file-user-uid)
+                    (fboundp 'file-group-gid)))
 
   (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))))))
+    ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1.
+    ;; We don't want to see compiler warnings for older Emacsen.
+    (should (integerp (with-no-warnings (file-user-uid))))
+    (should (integerp (with-no-warnings (file-group-gid))))))
 
 (ert-deftest tramp-archive-test48-auto-load ()
   "Check that `tramp-archive' autoloads properly."

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5fde783087e0c8cc2538befc0f10f7fe35fc496e..8e4e7122a2789e2f82a1aedd06b82cd229a30d40 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -7367,16 +7367,20 @@ This requires restrictions of file name syntax."
     (dotimes (i (length fsi))
       (should (natnump (or (nth i fsi) 0))))))
 
-;; `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."
+;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1.
+(ert-deftest tramp-test44-file-user-group-ids ()
+  "Check results of user/group functions.
+`file-user-uid', `file-group-gid', and `tramp-get-remote-*'
+should all 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.
+    ;; `file-user-uid' and `file-group-gid' exist 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)))))
+    (when (fboundp 'file-group-gid)
+      (should (integerp (with-no-warnings (file-group-gid)))))
 
     (with-parsed-tramp-file-name default-directory nil
       (should (or (integerp (tramp-get-remote-uid v 'integer))