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

17 files changed, 153 insertions, 43 deletions

diff --git a/ChangeLog b/ChangeLog
index 498bc328714..f60ac180f6b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * configure.ac (BSD4_2): Remove; no longer needed.
+
 2012-12-13  Glenn Morris  <rgm@gnu.org>
 
         * info/dir: Add bovine, srecode, wisent.
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 13c3da1745a..393cf56e993 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -9,7 +9,6 @@ documented in config.in, and this file would not be necessary.
 
 AIX
 _AIX
-BSD4_2
 BSD_SYSTEM
 CYGWIN          Compiling the Cygwin port.
 __CYGWIN__      Ditto
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 9c6413aa14f..6a6b1bd8da6 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,8 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * CPP-DEFINES (BSD4_2): Remove.
+
 2012-12-08  Paul Eggert  <eggert@cs.ucla.edu>
 
         Use putenv+unsetenv instead of modifying environ directly (Bug#13070).
diff --git a/configure.ac b/configure.ac
index f721c02f71f..1a7f78326eb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3841,7 +3841,6 @@ esac
 
 dnl Define symbols to identify the version of Unix this is.
 dnl Define all the symbols that apply correctly.
-AH_TEMPLATE(BSD4_2, [Define if the system is compatible with BSD 4.2.])
 AH_TEMPLATE(BSD_SYSTEM, [Define if the system is compatible with BSD 4.2.])
 AH_TEMPLATE(DOS_NT, [Define if the system is MS DOS or MS Windows.])
 AH_TEMPLATE(MSDOS, [Define if the system is MS DOS.])
@@ -3867,7 +3866,6 @@ case $opsys in
 
   darwin)
     dnl BSD4_3 and BSD4_4 are already defined in sys/param.h.
-    AC_DEFINE(BSD4_2, [])
     AC_DEFINE(BSD_SYSTEM, [])
     dnl More specific than the above two.  We cannot use __APPLE__ as this
     dnl may not be defined on non-OSX Darwin, and we cannot define DARWIN
@@ -3877,7 +3875,6 @@ case $opsys in
     ;;
 
   freebsd)
-    AC_DEFINE(BSD4_2, [])
     dnl Hack to avoid calling AC_PREPROC_IFELSE multiple times.
     dnl Would not be needed with autoconf >= 2.67, where the
     dnl preprocessed output is accessible in "conftest.i".
@@ -3885,7 +3882,6 @@ case $opsys in
     ;;
 
   gnu | netbsd | openbsd )
-    AC_DEFINE(BSD4_2, [])
     AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
 #ifndef BSD_SYSTEM
 # error "BSD_SYSTEM not defined"
diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog
index 51c6a53fcd8..8e7278ee2ee 100644
--- a/doc/lispintro/ChangeLog
+++ b/doc/lispintro/ChangeLog
@@ -1,3 +1,10 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * emacs-lisp-intro.texi (Files List):
+        directory-files-and-attributes now outputs t for attribute that's
+        now a placeholder.
+
 2012-12-06  Paul Eggert  <eggert@cs.ucla.edu>
 
         * doclicense.texi: Update to latest version from FSF.
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index 34ef7cc093c..5111ee116a3 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -15687,7 +15687,7 @@ nil
 "-rw-r--r--"
 @end group
 @group
-nil
+t
 2971624
 773)
 @end group
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index b0727694b3d..8a99f8c9c40 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,13 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * files.texi (Testing Accessibility): Document GROUP arg
+        of file-ownership-preserved-p.
+        (File Attributes): Document that 9th element is now
+        just a placeholder.
+        * os.texi (User Identification): Document new functions group-gid,
+        group-real-gid.
+
 2012-12-11  Paul Eggert  <eggert@cs.ucla.edu>
 
         * internals.texi (C Integer Types): New section.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 863acbe3949..c0c2221a394 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -895,11 +895,14 @@ returns @code{nil}.  However, if the open fails, it signals an error
 using @var{string} as the error message text.
 @end defun
 
-@defun file-ownership-preserved-p filename
+@defun file-ownership-preserved-p filename &optional group
 This function returns @code{t} if deleting the file @var{filename} and
 then creating it anew would keep the file's owner unchanged.  It also
 returns @code{t} for nonexistent files.
 
+If the optional argument @var{group} is non-@code{nil}, this function
+also checks that the file's group would be unchanged.
+
 If @var{filename} is a symbolic link, then, unlike the other functions
 discussed here, @code{file-ownership-preserved-p} does @emph{not}
 replace @var{filename} with its target.  However, it does recursively
@@ -1246,8 +1249,7 @@ The file's modes, as a string of ten letters or dashes,
 as in @samp{ls -l}.
 
 @item
-@code{t} if the file's @acronym{GID} would change if file were
-deleted and recreated; @code{nil} otherwise.
+An unspecified value, present for backward compatibility.
 
 @item
 The file's inode number.  If possible, this is an integer.  If the
@@ -1279,7 +1281,7 @@ For example, here are the file attributes for @file{files.texi}:
           (20000 23 0 0)
           (20614 64555 902289 872000)
           122295 "-rw-rw-rw-"
-          nil  (5888 2 . 43978)
+          t (5888 2 . 43978)
           (15479 . 46724))
 @end group
 @end example
@@ -1318,8 +1320,8 @@ end-of-line format is CR-LF.)
 @item "-rw-rw-rw-"
 has a mode of read and write access for the owner, group, and world.
 
-@item nil
-would retain the same @acronym{GID} if it were recreated.
+@item t
+is merely a placeholder; it carries no information.
 
 @item (5888 2 . 43978)
 has an inode number of 6473924464520138.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index e2161f51489..4b9cdfaae9e 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1157,6 +1157,16 @@ This function returns the effective @acronym{UID} of the user.
 The value may be a floating point number.
 @end defun
 
+@defun group-gid
+This function returns the effective @acronym{GID} of the Emacs process.
+The value may be a floating point number.
+@end defun
+
+@defun group-real-gid
+This function returns the real @acronym{GID} of the Emacs process.
+The value may be a floating point number.
+@end defun
+
 @defun system-users
 This function returns a list of strings, listing the user names on the
 system.  If Emacs cannot retrieve this information, the return value
diff --git a/etc/ChangeLog b/etc/ChangeLog
index ad0f9e9c7e8..7d58a670f80 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,10 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * NEWS: Document changes to file-attributes,
+        file-ownership-preserved-p.
+        Mention new functions group-gid, group-real-gid.
+
 2012-12-06  Andreas Schwab  <schwab@linux-m68k.org>
 
         * themes/leuven-theme.el: Convert to Unix format.
diff --git a/etc/NEWS b/etc/NEWS
index 9f61cff7342..d2a85507034 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -166,6 +166,17 @@ text-property on the first char.
 ** The `defalias-fset-function' property lets you catch calls to defalias
 and redirect them to your own function instead of `fset'.
 
+** The 9th element returned by `file-attributes' is now unspecified.
+Formerly, it was t if the file's gid would change if file were deleted
+and recreated.  This value has been inaccurate for years on many
+platforms, and nobody seems to have noticed or cared.
+
+** The function `file-ownership-preserved-p' now has an optional
+argument GROUP which causes it check for file group too.  This can be
+used in place of the 9th element of `file-attributes'.
+
+** New functions `group-gid' and `group-real-gid'.
+
 * Changes in Emacs 24.4 on non-free operating systems
 
 +++
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)
diff --git a/src/ChangeLog b/src/ChangeLog
index a35c51b8555..ff80763f351 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2012-12-14  Paul Eggert  <eggert@cs.ucla.edu>
+
+        Fix permissions bugs with setgid directories etc. (Bug#13125)
+        * 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.
+        * editfns.c (Fgroup_gid, Fgroup_real_gid): New functions.
+
 2012-12-14  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * xdisp.c (select_frame_for_redisplay, display_mode_lines):
diff --git a/src/dired.c b/src/dired.c
index 85af906c1da..1fda9e8b371 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -869,7 +869,7 @@ Elements of the attribute list are:
  7. Size in bytes.
   This is a floating point number if the size is too large for an integer.
  8. File modes, as a string of ten letters or dashes as in ls -l.
- 9. t if file's gid would change if file were deleted and recreated.
+ 9. An unspecified value, present only for backward compatibility.
 10. inode number.  If it is larger than what an Emacs integer can hold,
   this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
   If even HIGH is too large for an Emacs integer, this is instead of the form
@@ -891,10 +891,6 @@ so last access time will always be midnight of that day.  */)
   Lisp_Object values[12];
   Lisp_Object encoded;
   struct stat s;
-#ifdef BSD4_2
-  Lisp_Object dirname;
-  struct stat sdir;
-#endif /* BSD4_2 */
   int lstat_result;
 
   /* An array to hold the mode string generated by filemodestring,
@@ -974,17 +970,7 @@ so last access time will always be midnight of that day.  */)
 
   filemodestring (&s, modes);
   values[8] = make_string (modes, 10);
-#ifdef BSD4_2 /* file gid will be dir gid */
-  dirname = Ffile_name_directory (filename);
-  if (! NILP (dirname))
-    encoded = ENCODE_FILE (dirname);
-  if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
-    values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
-  else                                  /* if we can't tell, assume worst */
-    values[9] = Qt;
-#else                                   /* file gid will be egid */
-  values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
-#endif  /* not BSD4_2 */
+  values[9] = Qt;
   values[10] = INTEGER_TO_CONS (s.st_ino);
   values[11] = INTEGER_TO_CONS (s.st_dev);
 
diff --git a/src/editfns.c b/src/editfns.c
index eb909f73697..108c8b27187 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1272,6 +1272,24 @@ Value is an integer or a float, depending on the value.  */)
   return make_fixnum_or_float (uid);
 }
 
+DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0,
+       doc: /* Return the effective gid of Emacs.
+Value is an integer or a float, depending on the value.  */)
+  (void)
+{
+  gid_t egid = getegid ();
+  return make_fixnum_or_float (egid);
+}
+
+DEFUN ("group-real-gid", Fgroup_real_gid, Sgroup_real_gid, 0, 0, 0,
+       doc: /* Return the real gid of Emacs.
+Value is an integer or a float, depending on the value.  */)
+  (void)
+{
+  gid_t gid = getgid ();
+  return make_fixnum_or_float (gid);
+}
+
 DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0,
        doc: /* Return the full name of the user logged in, as a string.
 If the full name corresponding to Emacs's userid is not known,
@@ -4899,6 +4917,8 @@ functions if all the text being accessed has this property.  */);
   defsubr (&Suser_real_login_name);
   defsubr (&Suser_uid);
   defsubr (&Suser_real_uid);
+  defsubr (&Sgroup_gid);
+  defsubr (&Sgroup_real_gid);
   defsubr (&Suser_full_name);
   defsubr (&Semacs_pid);
   defsubr (&Scurrent_time);