Fix permissions bugs with setgid directories etc.

* configure.ac (BSD4_2): Remove; no longer needed.
* admin/CPP-DEFINES (BSD4_2): Remove.
* doc/lispintro/emacs-lisp-intro.texi (Files List):
directory-files-and-attributes now outputs t for attribute that's
now a placeholder.
* doc/lispref/files.texi (Testing Accessibility): Document GROUP arg
of file-ownership-preserved-p.
(File Attributes): Document that 9th element is now
just a placeholder.
* doc/lispref/os.texi (User Identification): Document new functions group-gid,
group-real-gid.
* etc/NEWS: Document changes to file-attributes,
file-ownership-preserved-p.
Mention new functions group-gid, group-real-gid.
* lisp/files.el (backup-buffer): Don't rely on 9th output of
file-attributes, as it's now a placeholder.  Instead, use the new
optional arg of file-ownership-preserved-p.
(file-ownership-preserved-p): New optional arg GROUP.
Fix mishandling of setuid directories that would cause this
function to return t when it should have returned nil.
Document what happens if the file does not exist, and when
it's not known whether the ownership will be preserved.
* lisp/net/tramp-sh.el (tramp-sh-handle-file-ownership-preserved-p):
Likewise.
(tramp-get-local-gid): Use group-gid for integer, as that's
faster and more reliable.
* src/dired.c (Ffile_attributes): Return t as the 9th attribute,
to mark it as a placeholder.  The old value was often wrong.
The only user of this attribute has been changed to use
file-ownership-preserved-p instead, with its new group arg.
* src/editfns.c (Fgroup_gid, Fgroup_real_gid): New functions.

Fixes: debbugs:13125

3 files changed, 58 insertions, 15 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 75387673f76..15cdb5cb879 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,19 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * files.el (backup-buffer): Don't rely on 9th output of
+        file-attributes, as it's now a placeholder.  Instead, use the new
+        optional arg of file-ownership-preserved-p.
+        (file-ownership-preserved-p): New optional arg GROUP.
+        Fix mishandling of setuid directories that would cause this
+        function to return t when it should have returned nil.
+        Document what happens if the file does not exist, and when
+        it's not known whether the ownership will be preserved.
+        * net/tramp-sh.el (tramp-sh-handle-file-ownership-preserved-p):
+        Likewise.
+        (tramp-get-local-gid): Use group-gid for integer, as that's
+        faster and more reliable.
+
 2012-12-14  Julien Danjou  <julien@danjou.info>
 
         * progmodes/sql.el (sql-mode-postgres-font-lock-keywords): Update
diff --git a/lisp/files.el b/lisp/files.el
index c8a75f67820..7974f73a248 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3941,8 +3941,8 @@ BACKUPNAME is the backup file name, which is the old file renamed."
                                               (and (integerp (nth 2 attr))
                                                    (integerp backup-by-copying-when-privileged-mismatch)
                                                    (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
-                                          (or (nth 9 attr)
-                                              (not (file-ownership-preserved-p real-file-name)))))))
+                                          (not (file-ownership-preserved-p
+                                                real-file-name t))))))
                           (backup-buffer-copy real-file-name backupname modes context)
                         ;; rename-file should delete old backup.
                         (rename-file real-file-name backupname t)
@@ -4019,22 +4019,44 @@ See also `file-name-version-regexp'."
                    (string-match (concat file-name-version-regexp "\\'")
                                  name))))))
 
-(defun file-ownership-preserved-p (file)
-  "Return t if deleting FILE and rewriting it would preserve the owner."
+(defun file-ownership-preserved-p (file &optional group)
+  "Return t if deleting FILE and rewriting it would preserve the owner.
+Return nil if FILE does not exist, or if deleting and recreating it
+might not preserve the owner.  If GROUP is non-nil, check whether
+the group would be preserved too."
   (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
     (if handler
-        (funcall handler 'file-ownership-preserved-p file)
+        (funcall handler 'file-ownership-preserved-p file group)
       (let ((attributes (file-attributes file 'integer)))
         ;; Return t if the file doesn't exist, since it's true that no
         ;; information would be lost by an (attempted) delete and create.
         (or (null attributes)
-            (= (nth 2 attributes) (user-uid))
-            ;; Files created on Windows by Administrator (RID=500)
-            ;; have the Administrators group (RID=544) recorded as
-            ;; their owner.  Rewriting them will still preserve the
-            ;; owner.
-            (and (eq system-type 'windows-nt)
-                 (= (user-uid) 500) (= (nth 2 attributes) 544)))))))
+            (and (or (= (nth 2 attributes) (user-uid))
+                     ;; Files created on Windows by Administrator (RID=500)
+                     ;; have the Administrators group (RID=544) recorded as
+                     ;; their owner.  Rewriting them will still preserve the
+                     ;; owner.
+                     (and (eq system-type 'windows-nt)
+                          (= (user-uid) 500) (= (nth 2 attributes) 544)))
+                 (or (not group)
+                     ;; On BSD-derived systems files always inherit the parent
+                     ;; directory's group, so skip the group-gid test.
+                     (memq system-type '(berkeley-unix darwin gnu/kfreebsd))
+                     (= (nth 3 attributes) (group-gid)))
+                 (let* ((parent (or (file-name-directory file) "."))
+                        (parent-attributes (file-attributes parent 'integer)))
+                   (and parent-attributes
+                        ;; On some systems, a file created in a setuid directory
+                        ;; inherits that directory's owner.
+                        (or
+                         (= (nth 2 parent-attributes) (user-uid))
+                         (string-match "^...[^sS]" (nth 8 parent-attributes)))
+                        ;; On many systems, a file created in a setgid directory
+                        ;; inherits that directory's group.  On some systems
+                        ;; this happens even if the setgid bit is not set.
+                        (or (not group)
+                            (= (nth 3 parent-attributes)
+                               (nth 3 attributes)))))))))))
 
 (defun file-name-sans-extension (filename)
   "Return FILENAME sans final \"extension\".
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 55af0f0d96b..3008601d9ca 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1616,7 +1616,7 @@ and gid of the corresponding user is taken.  Both parameters must be integers."
         (and (tramp-run-test "-d" (file-name-directory filename))
              (tramp-run-test "-w" (file-name-directory filename)))))))
 
-(defun tramp-sh-handle-file-ownership-preserved-p (filename)
+(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
   "Like `file-ownership-preserved-p' for Tramp files."
   (with-parsed-tramp-file-name filename nil
     (with-tramp-file-property v localname "file-ownership-preserved-p"
@@ -1624,7 +1624,10 @@ and gid of the corresponding user is taken.  Both parameters must be integers."
         ;; Return t if the file doesn't exist, since it's true that no
         ;; information would be lost by an (attempted) delete and create.
         (or (null attributes)
-            (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
+            (and
+             (= (nth 2 attributes) (tramp-get-remote-uid v 'integer))
+             (or (not group)
+                 (= (nth 3 attributes) (tramp-get-remote-gid v 'integer)))))))))
 
 ;; Directory listings.
 
@@ -5021,7 +5024,9 @@ This is used internally by `tramp-file-mode-from-int'."
   (if (equal id-format 'integer) (user-uid) (user-login-name)))
 
 (defun tramp-get-local-gid (id-format)
-  (nth 3 (tramp-compat-file-attributes "~/" id-format)))
+  (if (and (fboundp 'group-gid) (equal id-format 'integer))
+      (tramp-compat-funcall 'group-gid)
+    (nth 3 (tramp-compat-file-attributes "~/" id-format))))
 
 ;; Some predefined connection properties.
 (defun tramp-get-inline-compress (vec prop size)