changeset 47630:e437df73c5bd

(backup-buffer): Bind local var MODES. Don't use renaming for a suid or sgid file. Use backup-buffer-copy to do copying. (backup-buffer-copy): New subroutine. Clear suid and sgid bits for the copy.

--- a/lisp/files.el	Thu Sep 26 21:57:53 2002 +0000
+++ b/lisp/files.el	Thu Sep 26 22:00:22 2002 +0000
@@ -2365,12 +2365,15 @@
 			    (or (eq delete-old-versions t) (eq delete-old-versions nil))
 			    (or delete-old-versions
 				(y-or-n-p (format "Delete excess backup versions of %s? "
-						  real-file-name))))))
+						  real-file-name)))))
+		      (modes (file-modes buffer-file-name)))
 		  ;; Actually write the back up file.
 		  (condition-case ()
 		      (if (or file-precious-flag
     ;			      (file-symlink-p buffer-file-name)
 			      backup-by-copying
+			      ;; Don't rename a suid or sgid file.
+			      (< 0 (logand modes #o6000))
 			      (and backup-by-copying-when-linked
 				   (> (file-nlinks real-file-name) 1))
 			      (and (or backup-by-copying-when-mismatch
@@ -2382,19 +2385,10 @@
 						   (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
 					  (or (nth 9 attr)
 					      (not (file-ownership-preserved-p real-file-name)))))))
-			  (condition-case ()
-			      (copy-file real-file-name backupname t t)
-			    (file-error
-			     ;; If copying fails because file BACKUPNAME
-			     ;; is not writable, delete that file and try again.
-			     (if (and (file-exists-p backupname)
-				      (not (file-writable-p backupname)))
-				 (delete-file backupname))
-			     (copy-file real-file-name backupname t t)))
+			  (backup-buffer-copy real-file-name backupname modes)
 			;; rename-file should delete old backup.
 			(rename-file real-file-name backupname t)
-			(setq setmodes
-			      (cons (file-modes backupname) backupname)))
+			(setq setmodes (cons modes backupname)))
 		    (file-error
 		     ;; If trouble writing the backup, write it in ~.
 		     (setq backupname (expand-file-name
@@ -2403,15 +2397,7 @@
 		     (message "Cannot write backup file; backing up in %s"
 			      (file-name-nondirectory backupname))
 		     (sleep-for 1)
-		     (condition-case ()
-			 (copy-file real-file-name backupname t t)
-		       (file-error
-			;; If copying fails because file BACKUPNAME
-			;; is not writable, delete that file and try again.
-			(if (and (file-exists-p backupname)
-				 (not (file-writable-p backupname)))
-			    (delete-file backupname))
-			(copy-file real-file-name backupname t t)))))
+		     (backup-buffer-copy real-file-name backupname modes)))
 		  (setq buffer-backed-up t)
 		  ;; Now delete the old versions, if desired.
 		  (if delete-old-versions
@@ -2423,6 +2409,18 @@
 		  setmodes)
 	    (file-error nil))))))
 
+(defun backup-buffer-copy (from-name to-name modes)
+  (condition-case ()
+      (copy-file from-name to-name t t)
+    (file-error
+     ;; If copying fails because file TO-NAME
+     ;; is not writable, delete that file and try again.
+     (if (and (file-exists-p to-name)
+	      (not (file-writable-p to-name)))
+	 (delete-file to-name))
+     (copy-file from-name to-name t t)))
+  (set-file-modes to-name (logand modes #o1777)))
+
 (defun file-name-sans-versions (name &optional keep-backup-version)
   "Return file NAME sans backup versions or strings.
 This is a separate procedure so your site-init or startup file can