Fix permissions bugs with setgid directories etc.

[bpt/emacs.git] / lisp / files.el

diff --git a/lisp/files.el b/lisp/files.el
index c8a75f6..7974f73 100644 (file)
--- 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\".