bug#6953: 24.0.50; serious security bug in create backup files

[Glenn Morris]

An attempt at a proper fix (the manual would also need updating):

*** lisp/files.el       2010-09-05 22:03:56 +0000
--- lisp/files.el       2010-09-07 23:58:21 +0000
***************
*** 3561,3566 ****
--- 3561,3610 ----
          (set-auto-mode t))
      (error nil)))
  
+ (defcustom backup-fallback-directory
+   (expand-file-name "backups" user-emacs-directory)
+   "In case of error writing a backup file, write it here instead.
+ Formerly such backups were written to a file \"~/%backup%~\"."
+   :type 'directory
+   :initialize 'custom-initialize-delay
+   :version "23.3")
+ 
+ (defun backup-buffer-fallback (from-name dir)
+   "Backup FROM-NAME in private directory DIR."
+   ;; Copied from doc-view-make-safe-dir.
+   ;; FIXME should be a general function make-directory-secure?
+   ;; See http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg02087.html
+   (condition-case nil
+       (let ((umask (default-file-modes)))
+         (unwind-protect
+             (progn
+               ;; Create temp files with strict access rights.  It's easy to
+               ;; loosen them later, whereas it's impossible to close the
+               ;; time-window of loose permissions otherwise.
+               (set-default-file-modes #o0700)
+               (make-directory dir))
+           ;; Reset the umask.
+           (set-default-file-modes umask)))
+     (file-already-exists
+      (if (file-symlink-p dir)
+          (error "Danger: %s points to a symbolic link" dir))
+      ;; In case it was created earlier with looser rights.
+      ;; We could check the mode info returned by file-attributes, but it's
+      ;; a pain to parse and it may not tell you what we want under
+      ;; non-standard file-systems.  So let's just say what we want and let
+      ;; the underlying C code and file-system figure it out.
+      ;; This also ends up checking a bunch of useful conditions: it makes
+      ;; sure we have write-access to the directory and that we own it, thus
+      ;; closing a bunch of security holes.
+      (set-file-modes dir #o0700)))
+   (backup-buffer-copy from-name
+                     (expand-file-name
+                      ;; cf make-backup-file-name-1.
+                      (subst-char-in-string
+                       ?/ ?!
+                       (replace-regexp-in-string "!" "!!" from-name))
+                      dir) nil))
+ 
  (defun write-file (filename &optional confirm)
    "Write current buffer into file FILENAME.
  This makes the buffer visit that file, and marks it as not modified.
***************
*** 3674,3687 ****
                        (rename-file real-file-name backupname t)
                        (setq setmodes (cons modes backupname)))
                    (file-error
!                    ;; If trouble writing the backup, write it in ~.
!                    (setq backupname (expand-file-name
!                                      (convert-standard-filename
!                                       "~/%backup%~")))
                     (message "Cannot write backup file; backing up in %s"
!                             backupname)
                     (sleep-for 1)
!                    (backup-buffer-copy real-file-name backupname modes)))
                  (setq buffer-backed-up t)
                  ;; Now delete the old versions, if desired.
                  (if delete-old-versions
--- 3718,3729 ----
                        (rename-file real-file-name backupname t)
                        (setq setmodes (cons modes backupname)))
                    (file-error
!                    ;; Trouble writing the backup.
                     (message "Cannot write backup file; backing up in %s"
!                             backup-fallback-directory)
                     (sleep-for 1)
!                    (backup-buffer-fallback real-file-name
!                                            backup-fallback-directory)))
                  (setq buffer-backed-up t)
                  ;; Now delete the old versions, if desired.
                  (if delete-old-versions