* bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion
@ 2023-05-02 5:42 Jim Porter
2023-05-02 11:58 ` Eli Zaretskii
0 siblings, 1 reply; 5+ messages in thread
From: Jim Porter @ 2023-05-02 5:42 UTC (permalink / raw)
To: 63221
[-- Attachment #1: Type: text/plain, Size: 748 bytes --]
This is sort of a continuation from bug#60722. Eshell gets the user's
UID/GID in a few places, e.g. to decide when to prompt before deleting a
file with "rm" (if you're root, it should prompt). However, these aren't
connection-aware. That means that if you start Emacs as a normal user
and then run "cd /sudo::", it doesn't recognize that you're now root, so
it doesn't prompt.
Similarly, Eshell's "ls" implementation doesn't check for the
connection-aware UID/username for ownership. And likewise for the "U"
and "G" Eshell predicate operators.
Attached is a patch to fix this, which also adds a new utility function
'file-group-gid'. Similar to 'file-user-uid' (added in bug#60722), it's
just a connection-aware version of 'group-gid'.
[-- Attachment #2: 0001-Use-connection-aware-functions-when-getting-the-UID-.patch --]
[-- Type: text/plain, Size: 24865 bytes --]
From 9073125b21f6414cbdf5e03a75967ea7f5cc1ae6 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Mon, 1 May 2023 09:49:00 -0700
Subject: [PATCH] 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.
* 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'.
---
doc/lispref/files.texi | 4 +--
doc/lispref/os.texi | 14 ++++++--
etc/NEWS | 8 ++---
lisp/eshell/em-ls.el | 6 ++--
lisp/eshell/em-pred.el | 4 +--
lisp/eshell/em-unix.el | 53 +++++++++++++++++++---------
lisp/eshell/esh-util.el | 5 +++
lisp/net/ange-ftp.el | 9 +++--
lisp/net/tramp-adb.el | 1 +
lisp/net/tramp-archive.el | 8 +++++
lisp/net/tramp-crypt.el | 1 +
lisp/net/tramp-gvfs.el | 1 +
lisp/net/tramp-rclone.el | 1 +
lisp/net/tramp-sh.el | 1 +
lisp/net/tramp-smb.el | 1 +
lisp/net/tramp-sshfs.el | 1 +
lisp/net/tramp-sudoedit.el | 1 +
lisp/net/tramp.el | 11 +++++-
lisp/simple.el | 12 +++++++
test/lisp/net/tramp-archive-tests.el | 14 ++++----
test/lisp/net/tramp-tests.el | 14 +++++---
21 files changed, 126 insertions(+), 44 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b15f2ab4d29..6e1aae5d63b 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3405,7 +3405,7 @@ Magic File Names
@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 @@ Magic File Names
@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 bca62a7a8de..23731148749 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1288,12 +1288,22 @@ User Identification
@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 b989f80f3c3..3c71e52fff4 100644
--- 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 56c5f262789..9b53bf29559 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -199,9 +199,9 @@ eshell-ls-applicable
`(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 @@ eshell-ls-decorated-name
((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 2ccca092b86..bfb0dad60ef 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -87,11 +87,11 @@ eshell-predicate-alist
(?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 a792493e071..bb38fbf18e6 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -91,14 +91,21 @@ eshell-rm-removes-directories
: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 'lazy
+ "When to interatively query the user about a particular operation."
+ :tag "Query"
+ :type '(choice (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."
+ :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."
+ :type 'eshell-interactive-query
:group 'eshell-unix)
(defcustom eshell-mv-overwrite-files t
@@ -106,9 +113,9 @@ eshell-mv-overwrite-files
: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."
+ :type 'eshell-interactive-query
:group 'eshell-unix)
(defcustom eshell-cp-overwrite-files t
@@ -116,9 +123,9 @@ eshell-cp-overwrite-files
: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."
+ :type 'eshell-interactive-query
:group 'eshell-unix)
(defcustom eshell-ln-overwrite-files nil
@@ -159,6 +166,14 @@ em-preview
(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 `root', return non-nil when evaluated as root (see
+`file-user-uid'). Otherwise, simply return VALUE."
+ (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 +264,8 @@ eshell/rm
: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 +539,8 @@ eshell/mv
[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 +578,8 @@ eshell/cp
(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 +612,8 @@ eshell/ln
(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 +979,7 @@ eshell/time
(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 c0685757789..3608c78ba2b 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -502,6 +502,11 @@ eshell-redisplay
(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 e21367135d3..1c20a27801d 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4381,7 +4381,11 @@ ange-ftp-find-backup-file-name
(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 @@ ange-ftp-hook-function
(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 5a8044f8a53..6c668640ba4 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -154,6 +154,7 @@ tramp-adb-file-name-handler-alist
(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 c2175612fa8..8de6d406817 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -266,6 +266,7 @@ tramp-archive-file-name-handler-alist
(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 @@ tramp-archive-handle-file-user-uid
;; `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 ea27c704587..4acf6938b84 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -205,6 +205,7 @@ tramp-crypt-file-name-handler-alist
(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 859f4870b80..cce34889000 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -831,6 +831,7 @@ tramp-gvfs-file-name-handler-alist
(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 74295de4c29..aa869460589 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -119,6 +119,7 @@ tramp-rclone-file-name-handler-alist
(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 0369e19378c..eacf7084fd1 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1097,6 +1097,7 @@ tramp-sh-file-name-handler-alist
(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 9a24403bb18..93e6266313d 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -270,6 +270,7 @@ tramp-smb-file-name-handler-alist
(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 fe126361ac3..d552f6c83fa 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -125,6 +125,7 @@ tramp-sshfs-file-name-handler-alist
(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 941c1e8dd24..531a1591a16 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -115,6 +115,7 @@ tramp-sudoedit-file-name-handler-alist
(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 ca95b6b6971..9729baeb0d4 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2650,7 +2650,7 @@ tramp-file-name-for-operation
;; 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 @@ tramp-handle-file-user-uid
;; 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 b621e1603bd..65ad48986d5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4753,6 +4753,18 @@ file-user-uid
(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 94ef40a1116..5fa727a13e5 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -881,16 +881,18 @@ tramp-archive-test43-file-system-info
(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 5fde783087e..8e4e7122a27 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -7367,16 +7367,20 @@ tramp-test43-file-system-info
(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))
--
2.25.1
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion
2023-05-02 5:42 bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion Jim Porter
@ 2023-05-02 11:58 ` Eli Zaretskii
2023-05-02 18:36 ` Jim Porter
0 siblings, 1 reply; 5+ messages in thread
From: Eli Zaretskii @ 2023-05-02 11:58 UTC (permalink / raw)
To: Jim Porter; +Cc: 63221
> Date: Mon, 1 May 2023 22:42:53 -0700
> From: Jim Porter <jporterbugs@gmail.com>
>
> -(defcustom eshell-rm-interactive-query (= (user-uid) 0)
> - "If non-nil, `rm' will query before removing anything."
> - :type 'boolean
> +(define-widget 'eshell-interactive-query 'lazy
> + "When to interatively query the user about a particular operation."
This terse sentence needs to be explained in the rest of the doc
string, because, unlike "If non-nil", "When" does not explain itself.
The doc string should explain how to specify "when". It should also
explain the different supported values.
> + :tag "Query"
> + :type '(choice (const :tag "Never" nil)
> + (const :tag "Always" t)
> + (const :tag "When root" root)))
Also, the default value is not one of the possible optional values.
Same comment to the other similar defcustoms where you changed a
boolean option to something else: their doc strings are now
obfuscated.
> +(defun eshell-interactive-query-p (value)
> + "Return non-nil if a command should query the user according to VALUE.
> +If VALUE is `root', return non-nil when evaluated as root (see
> +`file-user-uid'). Otherwise, simply return VALUE."
You assume here that "evaluated as root" explains itself? I wouldn't
rely on that.
Thanks.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion
2023-05-02 11:58 ` Eli Zaretskii
@ 2023-05-02 18:36 ` Jim Porter
2023-05-02 18:44 ` Eli Zaretskii
0 siblings, 1 reply; 5+ messages in thread
From: Jim Porter @ 2023-05-02 18:36 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 63221
[-- Attachment #1: Type: text/plain, Size: 1540 bytes --]
On 5/2/2023 4:58 AM, Eli Zaretskii wrote:
>> Date: Mon, 1 May 2023 22:42:53 -0700
>> From: Jim Porter <jporterbugs@gmail.com>
>>
>> -(defcustom eshell-rm-interactive-query (= (user-uid) 0)
>> - "If non-nil, `rm' will query before removing anything."
>> - :type 'boolean
>> +(define-widget 'eshell-interactive-query 'lazy
>> + "When to interatively query the user about a particular operation."
>
> This terse sentence needs to be explained in the rest of the doc
> string, because, unlike "If non-nil", "When" does not explain itself.
> The doc string should explain how to specify "when". It should also
> explain the different supported values.
Thanks, fixed.
>> + :tag "Query"
>> + :type '(choice (const :tag "Never" nil)
>> + (const :tag "Always" t)
>> + (const :tag "When root" root)))
>
> Also, the default value is not one of the possible optional values.
I changed how this works so now the widget inherits from 'radio' instead
of 'lazy', and I think it should work better overall now.
> Same comment to the other similar defcustoms where you changed a
> boolean option to something else: their doc strings are now
> obfuscated.
Fixed.
>> +(defun eshell-interactive-query-p (value)
>> + "Return non-nil if a command should query the user according to VALUE.
>> +If VALUE is `root', return non-nil when evaluated as root (see
>> +`file-user-uid'). Otherwise, simply return VALUE."
>
> You assume here that "evaluated as root" explains itself? I wouldn't
> rely on that.
Also fixed.
[-- Attachment #2: 0001-Use-connection-aware-functions-when-getting-the-UID-.patch --]
[-- Type: text/plain, Size: 25777 bytes --]
From ccc394c3eec10961e37e86e622ab72a356daa923 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Mon, 1 May 2023 09:49:00 -0700
Subject: [PATCH] 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.
* 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'.
---
doc/lispref/files.texi | 4 +-
doc/lispref/os.texi | 14 +++++-
etc/NEWS | 8 ++--
lisp/eshell/em-ls.el | 6 +--
lisp/eshell/em-pred.el | 4 +-
lisp/eshell/em-unix.el | 70 +++++++++++++++++++++-------
lisp/eshell/esh-util.el | 5 ++
lisp/net/ange-ftp.el | 9 +++-
lisp/net/tramp-adb.el | 1 +
lisp/net/tramp-archive.el | 8 ++++
lisp/net/tramp-crypt.el | 1 +
lisp/net/tramp-gvfs.el | 1 +
lisp/net/tramp-rclone.el | 1 +
lisp/net/tramp-sh.el | 1 +
lisp/net/tramp-smb.el | 1 +
lisp/net/tramp-sshfs.el | 1 +
lisp/net/tramp-sudoedit.el | 1 +
lisp/net/tramp.el | 11 ++++-
lisp/simple.el | 12 +++++
test/lisp/net/tramp-archive-tests.el | 14 +++---
test/lisp/net/tramp-tests.el | 14 ++++--
21 files changed, 143 insertions(+), 44 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b15f2ab4d29..6e1aae5d63b 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -3405,7 +3405,7 @@ Magic File Names
@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 @@ Magic File Names
@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 bca62a7a8de..23731148749 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1288,12 +1288,22 @@ User Identification
@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 b989f80f3c3..3c71e52fff4 100644
--- 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 56c5f262789..9b53bf29559 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -199,9 +199,9 @@ eshell-ls-applicable
`(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 @@ eshell-ls-decorated-name
((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 2ccca092b86..bfb0dad60ef 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -87,11 +87,11 @@ eshell-predicate-alist
(?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 a792493e071..b7ef0f0c40c 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -91,14 +91,29 @@ eshell-rm-removes-directories
: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 @@ eshell-mv-overwrite-files
: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 @@ eshell-cp-overwrite-files
: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 @@ em-preview
(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 @@ eshell/rm
: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 @@ eshell/mv
[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 @@ eshell/cp
(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 @@ eshell/ln
(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 @@ eshell/time
(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 c0685757789..3608c78ba2b 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -502,6 +502,11 @@ eshell-redisplay
(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 e21367135d3..1c20a27801d 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4381,7 +4381,11 @@ ange-ftp-find-backup-file-name
(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 @@ ange-ftp-hook-function
(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 5a8044f8a53..6c668640ba4 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -154,6 +154,7 @@ tramp-adb-file-name-handler-alist
(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 c2175612fa8..8de6d406817 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -266,6 +266,7 @@ tramp-archive-file-name-handler-alist
(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 @@ tramp-archive-handle-file-user-uid
;; `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 ea27c704587..4acf6938b84 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -205,6 +205,7 @@ tramp-crypt-file-name-handler-alist
(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 859f4870b80..cce34889000 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -831,6 +831,7 @@ tramp-gvfs-file-name-handler-alist
(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 74295de4c29..aa869460589 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -119,6 +119,7 @@ tramp-rclone-file-name-handler-alist
(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 0369e19378c..eacf7084fd1 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1097,6 +1097,7 @@ tramp-sh-file-name-handler-alist
(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 9a24403bb18..93e6266313d 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -270,6 +270,7 @@ tramp-smb-file-name-handler-alist
(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 fe126361ac3..d552f6c83fa 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -125,6 +125,7 @@ tramp-sshfs-file-name-handler-alist
(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 941c1e8dd24..531a1591a16 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -115,6 +115,7 @@ tramp-sudoedit-file-name-handler-alist
(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 ca95b6b6971..9729baeb0d4 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2650,7 +2650,7 @@ tramp-file-name-for-operation
;; 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 @@ tramp-handle-file-user-uid
;; 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 b621e1603bd..65ad48986d5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4753,6 +4753,18 @@ file-user-uid
(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 94ef40a1116..5fa727a13e5 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -881,16 +881,18 @@ tramp-archive-test43-file-system-info
(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 5fde783087e..8e4e7122a27 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -7367,16 +7367,20 @@ tramp-test43-file-system-info
(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))
--
2.25.1
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion
2023-05-02 18:36 ` Jim Porter
@ 2023-05-02 18:44 ` Eli Zaretskii
2023-05-03 4:30 ` Jim Porter
0 siblings, 1 reply; 5+ messages in thread
From: Eli Zaretskii @ 2023-05-02 18:44 UTC (permalink / raw)
To: Jim Porter; +Cc: 63221
> Date: Tue, 2 May 2023 11:36:16 -0700
> Cc: 63221@debbugs.gnu.org
> From: Jim Porter <jporterbugs@gmail.com>
>
> > This terse sentence needs to be explained in the rest of the doc
> > string, because, unlike "If non-nil", "When" does not explain itself.
> > The doc string should explain how to specify "when". It should also
> > explain the different supported values.
>
> Thanks, fixed.
>
> >> + :tag "Query"
> >> + :type '(choice (const :tag "Never" nil)
> >> + (const :tag "Always" t)
> >> + (const :tag "When root" root)))
> >
> > Also, the default value is not one of the possible optional values.
>
> I changed how this works so now the widget inherits from 'radio' instead
> of 'lazy', and I think it should work better overall now.
>
> > Same comment to the other similar defcustoms where you changed a
> > boolean option to something else: their doc strings are now
> > obfuscated.
>
> Fixed.
>
> >> +(defun eshell-interactive-query-p (value)
> >> + "Return non-nil if a command should query the user according to VALUE.
> >> +If VALUE is `root', return non-nil when evaluated as root (see
> >> +`file-user-uid'). Otherwise, simply return VALUE."
> >
> > You assume here that "evaluated as root" explains itself? I wouldn't
> > rely on that.
>
> Also fixed.
Thanks, LGTM.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion
2023-05-02 18:44 ` Eli Zaretskii
@ 2023-05-03 4:30 ` Jim Porter
0 siblings, 0 replies; 5+ messages in thread
From: Jim Porter @ 2023-05-03 4:30 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 63221-done
On 5/2/2023 11:44 AM, Eli Zaretskii wrote:
> Thanks, LGTM.
Thanks. Merged as 40d66095635; closing this bug now.
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2023-05-03 4:30 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-02 5:42 bug#63221: 30.0.50; [PATCH] Eshell should get user (and group) IDs in a connection-aware fashion Jim Porter
2023-05-02 11:58 ` Eli Zaretskii
2023-05-02 18:36 ` Jim Porter
2023-05-02 18:44 ` Eli Zaretskii
2023-05-03 4:30 ` Jim Porter
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).