bug#13125: Fix permissions bugs with setgid directories etc.

[Wolfgang Jenkner <wjenkner@inode.at>]

On Sun, Dec 09 2012, Paul Eggert wrote:

> In several places Emacs assumes that on 4.2BSD hosts, a newly created
> file is given a group ID equal to its parent directory, and that on
> non-4.2BSD hosts the new files are given Emacs's group ID.  Although
> this was true long ago, it hasn't been true for many years.  Most
> commonly, the old 4.2BSD behavior is now selected by the setgid bit on
> directories.

I understand you are describing here the most common behaviour only for
non-4.2BSD descendants?

I've tested your patch by typing the following in a *shell* buffer.

[[1 ~]]$ uname -rs
FreeBSD 9.1-PRERELEASE
[[2 ~]]$ id
uid=1002(wolfgang) gid=20(staff) groups=20(staff),0(wheel),5(operator)
[[3 ~]]$ ls -ld /tmp
drwxrwxrwt  8 root  wheel  512 Dec  9 16:59 /tmp/
[[4 ~]]$ rm -f /tmp/foo && touch $_
[[5 ~]]$ ls -l $_
-rw-r--r--  1 wolfgang  wheel  0 Dec  9 17:01 /tmp/foo
[[6 ~]]$ 

Then, in the same emacs process, I evaluate

(file-ownership-preserved-p "/tmp/foo")
=> t

which is fine, but

(file-ownership-preserved-p "/tmp/foo" t)
=> nil

is not since /tmp/foo will always be created in the wheel group.
Indeed, in an unpatched emacs, I get the expected

(nth 9 (file-attributes "/tmp/foo"))
=> nil

Now, open(2) on all free BSD descendants invariably, literally and
unconditionally states

     When a new file is created it is given the group of the directory which
     contains it.

So I wonder if the following lightly tested patch (on top of yours)
would give better results in this case (in the absence of races with
other processes).

Wolfgang

=== modified file 'lisp/files.el'
--- lisp/files.el	2012-12-09 15:29:12 +0000
+++ lisp/files.el	2012-12-09 16:25:09 +0000
@@ -4039,6 +4039,7 @@
 		     (and (eq system-type 'windows-nt)
 			  (= (user-uid) 500) (= (nth 2 attributes) 544)))
 		 (or (not group)
+		     (memq system-type '(berkeley-unix darwin))
 		     (= (nth 3 attributes) (group-gid)))
 		 (let* ((parent (or (file-name-directory file) "."))
 			(parent-attributes (file-attributes parent 'integer)))
@@ -4052,7 +4053,10 @@
 			;; 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) (group-gid)))))))))))
+			    (= (nth 3 parent-attributes)
+			       (if (memq system-type '(berkeley-unix darwin))
+				   (nth 3 attributes)
+				 (group-gid))))))))))))
 
 (defun file-name-sans-extension (filename)
   "Return FILENAME sans final \"extension\".