diff options
| author | Jim Porter | 2023-05-01 09:49:00 -0700 |
|---|---|---|
| committer | Jim Porter | 2023-05-02 21:28:34 -0700 |
| commit | 40d66095635ead025b33dc693a19b463f70eb9ce (patch) | |
| tree | 75459d0d63878ddda41018cba4bc9dad0b6136bc | |
| parent | fa33a14ebe56aa1726df9c8ad93106966c5b6eae (diff) | |
| download | emacs-40d66095635ead025b33dc693a19b463f70eb9ce.tar.gz emacs-40d66095635ead025b33dc693a19b463f70eb9ce.zip | |
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'.
| -rw-r--r-- | doc/lispref/files.texi | 4 | ||||
| -rw-r--r-- | doc/lispref/os.texi | 14 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/eshell/em-ls.el | 6 | ||||
| -rw-r--r-- | lisp/eshell/em-pred.el | 4 | ||||
| -rw-r--r-- | lisp/eshell/em-unix.el | 70 | ||||
| -rw-r--r-- | lisp/eshell/esh-util.el | 5 | ||||
| -rw-r--r-- | lisp/net/ange-ftp.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-archive.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp-crypt.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-rclone.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-sshfs.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp-sudoedit.el | 1 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 11 | ||||
| -rw-r--r-- | lisp/simple.el | 12 | ||||
| -rw-r--r-- | test/lisp/net/tramp-archive-tests.el | 14 | ||||
| -rw-r--r-- | 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 @@ first, before handlers for jobs such as remote file access. | |||
| 3405 | @code{file-readable-p}, @code{file-regular-p}, | 3405 | @code{file-readable-p}, @code{file-regular-p}, |
| 3406 | @code{file-remote-p}, @code{file-selinux-context}, | 3406 | @code{file-remote-p}, @code{file-selinux-context}, |
| 3407 | @code{file-symlink-p}, @code{file-system-info}, | 3407 | @code{file-symlink-p}, @code{file-system-info}, |
| 3408 | @code{file-truename}, @code{file-user-uid}, | 3408 | @code{file-truename}, @code{file-user-uid}, @code{file-group-gid}, |
| 3409 | @code{file-writable-p}, | 3409 | @code{file-writable-p}, |
| 3410 | @code{find-backup-file-name},@* | 3410 | @code{find-backup-file-name},@* |
| 3411 | @code{get-file-buffer}, | 3411 | @code{get-file-buffer}, |
| @@ -3467,7 +3467,7 @@ first, before handlers for jobs such as remote file access. | |||
| 3467 | @code{file-readable-p}, @code{file-regular-p}, | 3467 | @code{file-readable-p}, @code{file-regular-p}, |
| 3468 | @code{file-remote-p}, @code{file-selinux-context}, | 3468 | @code{file-remote-p}, @code{file-selinux-context}, |
| 3469 | @code{file-symlink-p}, @code{file-system-info}, | 3469 | @code{file-symlink-p}, @code{file-system-info}, |
| 3470 | @code{file-truename}, @code{file-user-uid}, | 3470 | @code{file-truename}, @code{file-user-uid}, @code{file-group-gid}, |
| 3471 | @code{file-writable-p}, | 3471 | @code{file-writable-p}, |
| 3472 | @code{find-backup-file-name}, | 3472 | @code{find-backup-file-name}, |
| 3473 | @code{get-file-buffer}, | 3473 | @code{get-file-buffer}, |
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 91143f77551..4bcc9d5fea6 100644 --- 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 | |||
| 1290 | @end defun | 1290 | @end defun |
| 1291 | 1291 | ||
| 1292 | @cindex GID | 1292 | @cindex GID |
| 1293 | @defun group-real-gid | ||
| 1294 | This function returns the real @acronym{GID} of the Emacs process. | ||
| 1295 | @end defun | ||
| 1296 | |||
| 1293 | @defun group-gid | 1297 | @defun group-gid |
| 1294 | This function returns the effective @acronym{GID} of the Emacs process. | 1298 | This function returns the effective @acronym{GID} of the Emacs process. |
| 1295 | @end defun | 1299 | @end defun |
| 1296 | 1300 | ||
| 1297 | @defun group-real-gid | 1301 | @defun file-group-gid |
| 1298 | This function returns the real @acronym{GID} of the Emacs process. | 1302 | This function returns the connection-local value for the user's |
| 1303 | effective @acronym{GID}. Similar to @code{file-user-uid}, if | ||
| 1304 | @code{default-directory} is local, this is equivalent to | ||
| 1305 | @code{group-gid}, but for remote files (@pxref{Remote Files, , , | ||
| 1306 | emacs, The GNU Emacs Manual}), it will return the @acronym{GID} for | ||
| 1307 | the user associated with that remote connection; if the remote | ||
| 1308 | connection has no associated user, it will instead return -1. | ||
| 1299 | @end defun | 1309 | @end defun |
| 1300 | 1310 | ||
| 1301 | @defun system-users | 1311 | @defun system-users |
| @@ -529,10 +529,10 @@ The declaration '(important-return-value t)' sets the | |||
| 529 | return value should probably not be thrown away implicitly. | 529 | return value should probably not be thrown away implicitly. |
| 530 | 530 | ||
| 531 | +++ | 531 | +++ |
| 532 | ** New function 'file-user-uid'. | 532 | ** New functions 'file-user-uid' and 'file-group-gid'. |
| 533 | This function is like 'user-uid', but is aware of file name handlers, | 533 | These functions are like 'user-uid' and 'group-gid', respectively, but |
| 534 | so it will return the remote UID for remote files (or -1 if the | 534 | are aware of file name handlers, so they will return the remote UID or |
| 535 | connection has no associated user). | 535 | GID for remote files (or -1 if the connection has no associated user). |
| 536 | 536 | ||
| 537 | +++ | 537 | +++ |
| 538 | ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases. | 538 | ** '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 @@ calling FUNC with FILE as an argument." | |||
| 199 | `(let ((owner (file-attribute-user-id ,attrs)) | 199 | `(let ((owner (file-attribute-user-id ,attrs)) |
| 200 | (modes (file-attribute-modes ,attrs))) | 200 | (modes (file-attribute-modes ,attrs))) |
| 201 | (cond ((cond ((numberp owner) | 201 | (cond ((cond ((numberp owner) |
| 202 | (= owner (user-uid))) | 202 | (= owner (file-user-uid))) |
| 203 | ((stringp owner) | 203 | ((stringp owner) |
| 204 | (or (string-equal owner (user-login-name)) | 204 | (or (string-equal owner (eshell-user-login-name)) |
| 205 | (member owner (eshell-current-ange-uids))))) | 205 | (member owner (eshell-current-ange-uids))))) |
| 206 | ;; The user owns this file. | 206 | ;; The user owns this file. |
| 207 | (not (eq (aref modes ,index) ?-))) | 207 | (not (eq (aref modes ,index) ?-))) |
| @@ -919,7 +919,7 @@ to use, and each member of which is the width of that column | |||
| 919 | ((not (eshell-ls-filetype-p (cdr file) ?-)) | 919 | ((not (eshell-ls-filetype-p (cdr file) ?-)) |
| 920 | 'eshell-ls-special) | 920 | 'eshell-ls-special) |
| 921 | 921 | ||
| 922 | ((and (/= (user-uid) 0) ; root can execute anything | 922 | ((and (/= (file-user-uid) 0) ; root can execute anything |
| 923 | (eshell-ls-applicable (cdr file) 3 | 923 | (eshell-ls-applicable (cdr file) 3 |
| 924 | 'file-executable-p (car file))) | 924 | 'file-executable-p (car file))) |
| 925 | 'eshell-ls-executable) | 925 | '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 @@ ordinary strings." | |||
| 87 | (?U . (lambda (file) ; owned by effective uid | 87 | (?U . (lambda (file) ; owned by effective uid |
| 88 | (if (file-exists-p file) | 88 | (if (file-exists-p file) |
| 89 | (= (file-attribute-user-id (file-attributes file)) | 89 | (= (file-attribute-user-id (file-attributes file)) |
| 90 | (user-uid))))) | 90 | (file-user-uid))))) |
| 91 | (?G . (lambda (file) ; owned by effective gid | 91 | (?G . (lambda (file) ; owned by effective gid |
| 92 | (if (file-exists-p file) | 92 | (if (file-exists-p file) |
| 93 | (= (file-attribute-group-id (file-attributes file)) | 93 | (= (file-attribute-group-id (file-attributes file)) |
| 94 | (group-gid))))) | 94 | (file-group-gid))))) |
| 95 | (?* . (lambda (file) | 95 | (?* . (lambda (file) |
| 96 | (and (file-regular-p file) | 96 | (and (file-regular-p file) |
| 97 | (not (file-symlink-p file)) | 97 | (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 @@ Otherwise, `rmdir' is required." | |||
| 91 | :type 'boolean | 91 | :type 'boolean |
| 92 | :group 'eshell-unix) | 92 | :group 'eshell-unix) |
| 93 | 93 | ||
| 94 | (defcustom eshell-rm-interactive-query (= (user-uid) 0) | 94 | (define-widget 'eshell-interactive-query 'radio |
| 95 | "If non-nil, `rm' will query before removing anything." | 95 | "When to interatively query the user about a particular operation. |
| 96 | :type 'boolean | 96 | If t, always query. If nil, never query. If `root', query when |
| 97 | the user is logged in as root (including when `default-directory' | ||
| 98 | is remote with a root user)." | ||
| 99 | :args '((const :tag "Never" nil) | ||
| 100 | (const :tag "Always" t) | ||
| 101 | (const :tag "When root" root))) | ||
| 102 | |||
| 103 | (defcustom eshell-rm-interactive-query 'root | ||
| 104 | "When `rm' should query before removing anything. | ||
| 105 | If t, always query. If nil, never query. If `root', query when | ||
| 106 | the user is logged in as root (including when `default-directory' | ||
| 107 | is remote with a root user)." | ||
| 108 | :type 'eshell-interactive-query | ||
| 97 | :group 'eshell-unix) | 109 | :group 'eshell-unix) |
| 98 | 110 | ||
| 99 | (defcustom eshell-mv-interactive-query (= (user-uid) 0) | 111 | (defcustom eshell-mv-interactive-query 'root |
| 100 | "If non-nil, `mv' will query before overwriting anything." | 112 | "When `mv' should query before overwriting anything. |
| 101 | :type 'boolean | 113 | If t, always query. If nil, never query. If `root', query when |
| 114 | the user is logged in as root (including when `default-directory' | ||
| 115 | is remote with a root user)." | ||
| 116 | :type 'eshell-interactive-query | ||
| 102 | :group 'eshell-unix) | 117 | :group 'eshell-unix) |
| 103 | 118 | ||
| 104 | (defcustom eshell-mv-overwrite-files t | 119 | (defcustom eshell-mv-overwrite-files t |
| @@ -106,9 +121,12 @@ Otherwise, `rmdir' is required." | |||
| 106 | :type 'boolean | 121 | :type 'boolean |
| 107 | :group 'eshell-unix) | 122 | :group 'eshell-unix) |
| 108 | 123 | ||
| 109 | (defcustom eshell-cp-interactive-query (= (user-uid) 0) | 124 | (defcustom eshell-cp-interactive-query 'root |
| 110 | "If non-nil, `cp' will query before overwriting anything." | 125 | "When `cp' should query before overwriting anything. |
| 111 | :type 'boolean | 126 | If t, always query. If nil, never query. If `root', query when |
| 127 | the user is logged in as root (including when `default-directory' | ||
| 128 | is remote with a root user)." | ||
| 129 | :type 'eshell-interactive-query | ||
| 112 | :group 'eshell-unix) | 130 | :group 'eshell-unix) |
| 113 | 131 | ||
| 114 | (defcustom eshell-cp-overwrite-files t | 132 | (defcustom eshell-cp-overwrite-files t |
| @@ -116,9 +134,12 @@ Otherwise, `rmdir' is required." | |||
| 116 | :type 'boolean | 134 | :type 'boolean |
| 117 | :group 'eshell-unix) | 135 | :group 'eshell-unix) |
| 118 | 136 | ||
| 119 | (defcustom eshell-ln-interactive-query (= (user-uid) 0) | 137 | (defcustom eshell-ln-interactive-query 'root |
| 120 | "If non-nil, `ln' will query before overwriting anything." | 138 | "When `ln' should query before overwriting anything. |
| 121 | :type 'boolean | 139 | If t, always query. If nil, never query. If `root', query when |
| 140 | the user is logged in as root (including when `default-directory' | ||
| 141 | is remote with a root user)." | ||
| 142 | :type 'eshell-interactive-query | ||
| 122 | :group 'eshell-unix) | 143 | :group 'eshell-unix) |
| 123 | 144 | ||
| 124 | (defcustom eshell-ln-overwrite-files nil | 145 | (defcustom eshell-ln-overwrite-files nil |
| @@ -159,6 +180,17 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." | |||
| 159 | (defvar em-recursive) | 180 | (defvar em-recursive) |
| 160 | (defvar em-verbose) | 181 | (defvar em-verbose) |
| 161 | 182 | ||
| 183 | (defun eshell-interactive-query-p (value) | ||
| 184 | "Return non-nil if a command should query the user according to VALUE. | ||
| 185 | If VALUE is nil, return nil (never query). If `root', return | ||
| 186 | non-nil if the user is logged in as root (including when | ||
| 187 | `default-directory' is remote with a root user; see | ||
| 188 | `file-user-uid'). If VALUE is any other non-nil value, return | ||
| 189 | non-nil (always query)." | ||
| 190 | (if (eq value 'root) | ||
| 191 | (= (file-user-uid) 0) | ||
| 192 | value)) | ||
| 193 | |||
| 162 | (defun eshell/man (&rest args) | 194 | (defun eshell/man (&rest args) |
| 163 | "Invoke man, flattening the arguments appropriately." | 195 | "Invoke man, flattening the arguments appropriately." |
| 164 | (funcall 'man (apply 'eshell-flatten-and-stringify args))) | 196 | (funcall 'man (apply 'eshell-flatten-and-stringify args))) |
| @@ -249,7 +281,8 @@ argument." | |||
| 249 | :usage "[OPTION]... FILE... | 281 | :usage "[OPTION]... FILE... |
| 250 | Remove (unlink) the FILE(s).") | 282 | Remove (unlink) the FILE(s).") |
| 251 | (unless em-interactive | 283 | (unless em-interactive |
| 252 | (setq em-interactive eshell-rm-interactive-query)) | 284 | (setq em-interactive (eshell-interactive-query-p |
| 285 | eshell-rm-interactive-query))) | ||
| 253 | (if (and force-removal em-interactive) | 286 | (if (and force-removal em-interactive) |
| 254 | (setq em-interactive nil)) | 287 | (setq em-interactive nil)) |
| 255 | (while args | 288 | (while args |
| @@ -523,7 +556,8 @@ Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY. | |||
| 523 | [OPTION] DIRECTORY...") | 556 | [OPTION] DIRECTORY...") |
| 524 | (let ((no-dereference t)) | 557 | (let ((no-dereference t)) |
| 525 | (eshell-mvcpln-template "mv" "moving" 'rename-file | 558 | (eshell-mvcpln-template "mv" "moving" 'rename-file |
| 526 | eshell-mv-interactive-query | 559 | (eshell-interactive-query-p |
| 560 | eshell-mv-interactive-query) | ||
| 527 | eshell-mv-overwrite-files)))) | 561 | eshell-mv-overwrite-files)))) |
| 528 | 562 | ||
| 529 | (put 'eshell/mv 'eshell-no-numeric-conversions t) | 563 | (put 'eshell/mv 'eshell-no-numeric-conversions t) |
| @@ -561,7 +595,8 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.") | |||
| 561 | (if archive | 595 | (if archive |
| 562 | (setq preserve t no-dereference t em-recursive t)) | 596 | (setq preserve t no-dereference t em-recursive t)) |
| 563 | (eshell-mvcpln-template "cp" "copying" 'copy-file | 597 | (eshell-mvcpln-template "cp" "copying" 'copy-file |
| 564 | eshell-cp-interactive-query | 598 | (eshell-interactive-query-p |
| 599 | eshell-cp-interactive-query) | ||
| 565 | eshell-cp-overwrite-files preserve))) | 600 | eshell-cp-overwrite-files preserve))) |
| 566 | 601 | ||
| 567 | (put 'eshell/cp 'eshell-no-numeric-conversions t) | 602 | (put 'eshell/cp 'eshell-no-numeric-conversions t) |
| @@ -594,7 +629,8 @@ with `--symbolic'. When creating hard links, each TARGET must exist.") | |||
| 594 | (if symbolic | 629 | (if symbolic |
| 595 | 'make-symbolic-link | 630 | 'make-symbolic-link |
| 596 | 'add-name-to-file) | 631 | 'add-name-to-file) |
| 597 | eshell-ln-interactive-query | 632 | (eshell-interactive-query-p |
| 633 | eshell-ln-interactive-query) | ||
| 598 | eshell-ln-overwrite-files)))) | 634 | eshell-ln-overwrite-files)))) |
| 599 | 635 | ||
| 600 | (put 'eshell/ln 'eshell-no-numeric-conversions t) | 636 | (put 'eshell/ln 'eshell-no-numeric-conversions t) |
| @@ -960,7 +996,7 @@ Show wall-clock time elapsed during execution of COMMAND.") | |||
| 960 | 996 | ||
| 961 | (defun eshell/whoami (&rest _args) | 997 | (defun eshell/whoami (&rest _args) |
| 962 | "Make \"whoami\" Tramp aware." | 998 | "Make \"whoami\" Tramp aware." |
| 963 | (or (file-remote-p default-directory 'user) (user-login-name))) | 999 | (eshell-user-login-name)) |
| 964 | 1000 | ||
| 965 | (defvar eshell-diff-window-config nil) | 1001 | (defvar eshell-diff-window-config nil) |
| 966 | 1002 | ||
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 @@ list." | |||
| 502 | (sit-for 0) | 502 | (sit-for 0) |
| 503 | (error nil))) | 503 | (error nil))) |
| 504 | 504 | ||
| 505 | (defun eshell-user-login-name () | ||
| 506 | "Return the connection-aware value of the user's login name. | ||
| 507 | See also `user-login-name'." | ||
| 508 | (or (file-remote-p default-directory 'user) (user-login-name))) | ||
| 509 | |||
| 505 | (defun eshell-read-passwd-file (file) | 510 | (defun eshell-read-passwd-file (file) |
| 506 | "Return an alist correlating gids to group names in FILE." | 511 | "Return an alist correlating gids to group names in FILE." |
| 507 | (let (names) | 512 | (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 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") | |||
| 4381 | (ange-ftp-real-find-backup-file-name fn))) | 4381 | (ange-ftp-real-find-backup-file-name fn))) |
| 4382 | 4382 | ||
| 4383 | (defun ange-ftp-file-user-uid () | 4383 | (defun ange-ftp-file-user-uid () |
| 4384 | ;; Return "don't know" value. | 4384 | ;; Return "don't know" value. |
| 4385 | -1) | ||
| 4386 | |||
| 4387 | (defun ange-ftp-file-group-gid () | ||
| 4388 | ;; Return "don't know" value. | ||
| 4385 | -1) | 4389 | -1) |
| 4386 | 4390 | ||
| 4387 | ;;; Define the handler for special file names | 4391 | ;;; Define the handler for special file names |
| @@ -4524,8 +4528,9 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") | |||
| 4524 | (put 'file-notify-rm-watch 'ange-ftp 'ignore) | 4528 | (put 'file-notify-rm-watch 'ange-ftp 'ignore) |
| 4525 | (put 'file-notify-valid-p 'ange-ftp 'ignore) | 4529 | (put 'file-notify-valid-p 'ange-ftp 'ignore) |
| 4526 | 4530 | ||
| 4527 | ;; Return the "don't know' value for remote user uid. | 4531 | ;; Return the "don't know" value for remote user uid and group gid. |
| 4528 | (put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid) | 4532 | (put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid) |
| 4533 | (put 'file-group-gid 'ange-ftp 'ange-ftp-file-group-gid) | ||
| 4529 | 4534 | ||
| 4530 | ;;; Define ways of getting at unmodified Emacs primitives, | 4535 | ;;; Define ways of getting at unmodified Emacs primitives, |
| 4531 | ;;; turning off our handler. | 4536 | ;;; 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 @@ It is used for TCP/IP devices." | |||
| 154 | (file-system-info . tramp-adb-handle-file-system-info) | 154 | (file-system-info . tramp-adb-handle-file-system-info) |
| 155 | (file-truename . tramp-handle-file-truename) | 155 | (file-truename . tramp-handle-file-truename) |
| 156 | (file-user-uid . tramp-handle-file-user-uid) | 156 | (file-user-uid . tramp-handle-file-user-uid) |
| 157 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 157 | (file-writable-p . tramp-adb-handle-file-writable-p) | 158 | (file-writable-p . tramp-adb-handle-file-writable-p) |
| 158 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 159 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 159 | ;; `get-file-buffer' performed by default handler. | 160 | ;; `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 @@ It must be supported by libarchive(3).") | |||
| 266 | (file-system-info . tramp-archive-handle-file-system-info) | 266 | (file-system-info . tramp-archive-handle-file-system-info) |
| 267 | (file-truename . tramp-archive-handle-file-truename) | 267 | (file-truename . tramp-archive-handle-file-truename) |
| 268 | (file-user-uid . tramp-archive-handle-file-user-uid) | 268 | (file-user-uid . tramp-archive-handle-file-user-uid) |
| 269 | (file-group-gid . tramp-archive-handle-file-group-gid) | ||
| 269 | (file-writable-p . ignore) | 270 | (file-writable-p . ignore) |
| 270 | (find-backup-file-name . ignore) | 271 | (find-backup-file-name . ignore) |
| 271 | ;; `get-file-buffer' performed by default handler. | 272 | ;; `get-file-buffer' performed by default handler. |
| @@ -678,6 +679,13 @@ offered." | |||
| 678 | ;; `file-user-uid' exists since Emacs 30.1. | 679 | ;; `file-user-uid' exists since Emacs 30.1. |
| 679 | (tramp-compat-funcall 'file-user-uid)))) | 680 | (tramp-compat-funcall 'file-user-uid)))) |
| 680 | 681 | ||
| 682 | (defun tramp-archive-handle-file-group-gid () | ||
| 683 | "Like `group-gid' for file archives." | ||
| 684 | (with-parsed-tramp-archive-file-name default-directory nil | ||
| 685 | (let ((default-directory (file-name-directory archive))) | ||
| 686 | ;; `file-group-gid' exists since Emacs 30.1. | ||
| 687 | (tramp-compat-funcall 'file-group-gid)))) | ||
| 688 | |||
| 681 | (defun tramp-archive-handle-insert-directory | 689 | (defun tramp-archive-handle-insert-directory |
| 682 | (filename switches &optional wildcard full-directory-p) | 690 | (filename switches &optional wildcard full-directory-p) |
| 683 | "Like `insert-directory' for file archives." | 691 | "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 @@ If NAME doesn't belong to an encrypted remote directory, return nil." | |||
| 205 | (file-system-info . tramp-crypt-handle-file-system-info) | 205 | (file-system-info . tramp-crypt-handle-file-system-info) |
| 206 | ;; `file-truename' performed by default handler. | 206 | ;; `file-truename' performed by default handler. |
| 207 | ;; `file-user-uid' performed by default-handler. | 207 | ;; `file-user-uid' performed by default-handler. |
| 208 | ;; `file-group-gid' performed by default-handler. | ||
| 208 | (file-writable-p . tramp-crypt-handle-file-writable-p) | 209 | (file-writable-p . tramp-crypt-handle-file-writable-p) |
| 209 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 210 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 210 | ;; `get-file-buffer' performed by default handler. | 211 | ;; `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 @@ It has been changed in GVFS 1.14.") | |||
| 831 | (file-system-info . tramp-gvfs-handle-file-system-info) | 831 | (file-system-info . tramp-gvfs-handle-file-system-info) |
| 832 | (file-truename . tramp-handle-file-truename) | 832 | (file-truename . tramp-handle-file-truename) |
| 833 | (file-user-uid . tramp-handle-file-user-uid) | 833 | (file-user-uid . tramp-handle-file-user-uid) |
| 834 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 834 | (file-writable-p . tramp-handle-file-writable-p) | 835 | (file-writable-p . tramp-handle-file-writable-p) |
| 835 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 836 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 836 | ;; `get-file-buffer' performed by default handler. | 837 | ;; `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 @@ | |||
| 119 | (file-system-info . tramp-rclone-handle-file-system-info) | 119 | (file-system-info . tramp-rclone-handle-file-system-info) |
| 120 | (file-truename . tramp-handle-file-truename) | 120 | (file-truename . tramp-handle-file-truename) |
| 121 | (file-user-uid . tramp-handle-file-user-uid) | 121 | (file-user-uid . tramp-handle-file-user-uid) |
| 122 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 122 | (file-writable-p . tramp-handle-file-writable-p) | 123 | (file-writable-p . tramp-handle-file-writable-p) |
| 123 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 124 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 124 | ;; `get-file-buffer' performed by default handler. | 125 | ;; `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 @@ Format specifiers \"%s\" are replaced before the script is used.") | |||
| 1097 | (file-system-info . tramp-sh-handle-file-system-info) | 1097 | (file-system-info . tramp-sh-handle-file-system-info) |
| 1098 | (file-truename . tramp-sh-handle-file-truename) | 1098 | (file-truename . tramp-sh-handle-file-truename) |
| 1099 | (file-user-uid . tramp-handle-file-user-uid) | 1099 | (file-user-uid . tramp-handle-file-user-uid) |
| 1100 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 1100 | (file-writable-p . tramp-sh-handle-file-writable-p) | 1101 | (file-writable-p . tramp-sh-handle-file-writable-p) |
| 1101 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 1102 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 1102 | ;; `get-file-buffer' performed by default handler. | 1103 | ;; `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 @@ See `tramp-actions-before-shell' for more info.") | |||
| 270 | (file-system-info . tramp-smb-handle-file-system-info) | 270 | (file-system-info . tramp-smb-handle-file-system-info) |
| 271 | (file-truename . tramp-handle-file-truename) | 271 | (file-truename . tramp-handle-file-truename) |
| 272 | (file-user-uid . tramp-handle-file-user-uid) | 272 | (file-user-uid . tramp-handle-file-user-uid) |
| 273 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 273 | (file-writable-p . tramp-smb-handle-file-writable-p) | 274 | (file-writable-p . tramp-smb-handle-file-writable-p) |
| 274 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 275 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 275 | ;; `get-file-buffer' performed by default handler. | 276 | ;; `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 @@ | |||
| 125 | (file-system-info . tramp-sshfs-handle-file-system-info) | 125 | (file-system-info . tramp-sshfs-handle-file-system-info) |
| 126 | (file-truename . tramp-handle-file-truename) | 126 | (file-truename . tramp-handle-file-truename) |
| 127 | (file-user-uid . tramp-handle-file-user-uid) | 127 | (file-user-uid . tramp-handle-file-user-uid) |
| 128 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 128 | (file-writable-p . tramp-sshfs-handle-file-writable-p) | 129 | (file-writable-p . tramp-sshfs-handle-file-writable-p) |
| 129 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 130 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 130 | ;; `get-file-buffer' performed by default handler. | 131 | ;; `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 @@ See `tramp-actions-before-shell' for more info.") | |||
| 115 | (file-system-info . tramp-sudoedit-handle-file-system-info) | 115 | (file-system-info . tramp-sudoedit-handle-file-system-info) |
| 116 | (file-truename . tramp-sudoedit-handle-file-truename) | 116 | (file-truename . tramp-sudoedit-handle-file-truename) |
| 117 | (file-user-uid . tramp-handle-file-user-uid) | 117 | (file-user-uid . tramp-handle-file-user-uid) |
| 118 | (file-group-gid . tramp-handle-file-group-gid) | ||
| 118 | (file-writable-p . tramp-sudoedit-handle-file-writable-p) | 119 | (file-writable-p . tramp-sudoedit-handle-file-writable-p) |
| 119 | (find-backup-file-name . tramp-handle-find-backup-file-name) | 120 | (find-backup-file-name . tramp-handle-find-backup-file-name) |
| 120 | ;; `get-file-buffer' performed by default handler. | 121 | ;; `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 @@ Must be handled by the callers." | |||
| 2650 | ;; Emacs 29+ only. | 2650 | ;; Emacs 29+ only. |
| 2651 | list-system-processes memory-info process-attributes | 2651 | list-system-processes memory-info process-attributes |
| 2652 | ;; Emacs 30+ only. | 2652 | ;; Emacs 30+ only. |
| 2653 | file-user-uid)) | 2653 | file-user-uid file-group-gid)) |
| 2654 | default-directory) | 2654 | default-directory) |
| 2655 | ;; PROC. | 2655 | ;; PROC. |
| 2656 | ((member operation '(file-notify-rm-watch file-notify-valid-p)) | 2656 | ((member operation '(file-notify-rm-watch file-notify-valid-p)) |
| @@ -3939,6 +3939,15 @@ Let-bind it when necessary.") | |||
| 3939 | ;; consistency. | 3939 | ;; consistency. |
| 3940 | tramp-unknown-id-integer))) | 3940 | tramp-unknown-id-integer))) |
| 3941 | 3941 | ||
| 3942 | (defun tramp-handle-file-group-gid () | ||
| 3943 | "Like `group-gid' for Tramp files." | ||
| 3944 | (let ((v (tramp-dissect-file-name default-directory))) | ||
| 3945 | (or (tramp-get-remote-gid v 'integer) | ||
| 3946 | ;; Some handlers for `tramp-get-remote-gid' return nil if they | ||
| 3947 | ;; can't get the GID; always return -1 in this case for | ||
| 3948 | ;; consistency. | ||
| 3949 | tramp-unknown-id-integer))) | ||
| 3950 | |||
| 3942 | (defun tramp-handle-access-file (filename string) | 3951 | (defun tramp-handle-access-file (filename string) |
| 3943 | "Like `access-file' for Tramp files." | 3952 | "Like `access-file' for Tramp files." |
| 3944 | (setq filename (file-truename filename)) | 3953 | (setq filename (file-truename filename)) |
diff --git a/lisp/simple.el b/lisp/simple.el index 8d772eee8a8..c9960ed5e13 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -4753,6 +4753,18 @@ this function will instead return -1." | |||
| 4753 | (funcall handler 'file-user-uid) | 4753 | (funcall handler 'file-user-uid) |
| 4754 | (user-uid))) | 4754 | (user-uid))) |
| 4755 | 4755 | ||
| 4756 | (defun file-group-gid () | ||
| 4757 | "Return the connection-local effective gid. | ||
| 4758 | This is similar to `group-gid', but may invoke a file name handler | ||
| 4759 | based on `default-directory'. See Info node `(elisp)Magic File | ||
| 4760 | Names'. | ||
| 4761 | |||
| 4762 | If a file name handler is unable to retrieve the effective gid, | ||
| 4763 | this function will instead return -1." | ||
| 4764 | (if-let ((handler (find-file-name-handler default-directory 'file-group-gid))) | ||
| 4765 | (funcall handler 'file-group-gid) | ||
| 4766 | (group-gid))) | ||
| 4767 | |||
| 4756 | (defun max-mini-window-lines (&optional frame) | 4768 | (defun max-mini-window-lines (&optional frame) |
| 4757 | "Compute maximum number of lines for echo area in FRAME. | 4769 | "Compute maximum number of lines for echo area in FRAME. |
| 4758 | As defined by `max-mini-window-height'. FRAME defaults to the | 4770 | 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 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." | |||
| 881 | (zerop (nth 1 fsi)) | 881 | (zerop (nth 1 fsi)) |
| 882 | (zerop (nth 2 fsi)))))) | 882 | (zerop (nth 2 fsi)))))) |
| 883 | 883 | ||
| 884 | ;; `file-user-uid' was introduced in Emacs 30.1. | 884 | ;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1. |
| 885 | (ert-deftest tramp-archive-test44-file-user-uid () | 885 | (ert-deftest tramp-archive-test44-user-group-ids () |
| 886 | "Check that `file-user-uid' returns proper values." | 886 | "Check that `file-user-uid' returns proper values." |
| 887 | (skip-unless tramp-archive-enabled) | 887 | (skip-unless tramp-archive-enabled) |
| 888 | (skip-unless (fboundp 'file-user-uid)) | 888 | (skip-unless (and (fboundp 'file-user-uid) |
| 889 | (fboundp 'file-group-gid))) | ||
| 889 | 890 | ||
| 890 | (let ((default-directory tramp-archive-test-archive)) | 891 | (let ((default-directory tramp-archive-test-archive)) |
| 891 | ;; `file-user-uid' exists since Emacs 30.1. We don't want to see | 892 | ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1. |
| 892 | ;; compiler warnings for older Emacsen. | 893 | ;; We don't want to see compiler warnings for older Emacsen. |
| 893 | (should (integerp (with-no-warnings (file-user-uid)))))) | 894 | (should (integerp (with-no-warnings (file-user-uid)))) |
| 895 | (should (integerp (with-no-warnings (file-group-gid)))))) | ||
| 894 | 896 | ||
| 895 | (ert-deftest tramp-archive-test48-auto-load () | 897 | (ert-deftest tramp-archive-test48-auto-load () |
| 896 | "Check that `tramp-archive' autoloads properly." | 898 | "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 @@ This requires restrictions of file name syntax." | |||
| 7367 | (dotimes (i (length fsi)) | 7367 | (dotimes (i (length fsi)) |
| 7368 | (should (natnump (or (nth i fsi) 0)))))) | 7368 | (should (natnump (or (nth i fsi) 0)))))) |
| 7369 | 7369 | ||
| 7370 | ;; `file-user-uid' was introduced in Emacs 30.1. | 7370 | ;; `file-user-uid' and `file-group-gid' were introduced in Emacs 30.1. |
| 7371 | (ert-deftest tramp-test44-file-user-uid () | 7371 | (ert-deftest tramp-test44-file-user-group-ids () |
| 7372 | "Check that `file-user-uid' and `tramp-get-remote-*' return proper values." | 7372 | "Check results of user/group functions. |
| 7373 | `file-user-uid', `file-group-gid', and `tramp-get-remote-*' | ||
| 7374 | should all return proper values." | ||
| 7373 | (skip-unless (tramp--test-enabled)) | 7375 | (skip-unless (tramp--test-enabled)) |
| 7374 | 7376 | ||
| 7375 | (let ((default-directory ert-remote-temporary-file-directory)) | 7377 | (let ((default-directory ert-remote-temporary-file-directory)) |
| 7376 | ;; `file-user-uid' exists since Emacs 30.1. We don't want to see | 7378 | ;; `file-user-uid' and `file-group-gid' exist since Emacs 30.1. |
| 7377 | ;; compiler warnings for older Emacsen. | 7379 | ;; We don't want to see compiler warnings for older Emacsen. |
| 7378 | (when (fboundp 'file-user-uid) | 7380 | (when (fboundp 'file-user-uid) |
| 7379 | (should (integerp (with-no-warnings (file-user-uid))))) | 7381 | (should (integerp (with-no-warnings (file-user-uid))))) |
| 7382 | (when (fboundp 'file-group-gid) | ||
| 7383 | (should (integerp (with-no-warnings (file-group-gid))))) | ||
| 7380 | 7384 | ||
| 7381 | (with-parsed-tramp-file-name default-directory nil | 7385 | (with-parsed-tramp-file-name default-directory nil |
| 7382 | (should (or (integerp (tramp-get-remote-uid v 'integer)) | 7386 | (should (or (integerp (tramp-get-remote-uid v 'integer)) |