bug#3911: get-free-disk-space when default-directory doesn't exist

[Kevin Ryde]

reopen 3911
retitle 3911 get-free-disk-space race condition on default-directory test
tags 3911 +patch
thanks

If the default-directory is flicking in and out of existence then the
code in get-free-disk-space which chooses between default-directory and
"/" can suffer a race condition.  default-directory can exist for the
test, but then be gone by the time call-process tries to use it.

I can provoke this on my pc with one emacs making a directory flicker,

    (while t
      (make-directory "/tmp/somedir")
      (delete-directory "/tmp/somedir"))

And in another emacs a loop

    (while t
      (let ((default-directory "/tmp/somedir/"))
        (get-free-disk-space "/")))

The latter loop errors out after 5 or 10 minutes.  I hoped that asking
get-free-disk-space about the space on some directory would not depend
on the value of default-directory.

The problem can be provoked much quicker with a (sit-for 0.1) between
the test and the call-process.  Otherwise I presume it requires a random
context switch just at the inopportune time.


The perils of "test before use" come up in shell scripts often (because
it's hard to do better), and in sloppy perl code.  Alas the tendency is
to work most of the time, but lack robustness in special circumstances.

I suppose the rule for call-process would be: if the operation is not
related to default-directory then go to "/" so as to be independent of
default-directory's existence, or bouncing in and out of existence.  I
expect that's why other places have "/".  It sounds fairly simple, dunno
if that's too obvious to have a crib in the manual (under "Subprocess
Creation").

At any rate, umm, third time lucky with what I posted first ...


2009-08-20  Kevin Ryde  <user42@zip.com.au>

        * files.el (get-free-disk-space): Bind default-directory to "/", to be
        independent of default-directory existence.  (Cannot test usability of
        default-directory first since it may disappear in between the test and
        the call-process.)

*** files.el    18 Aug 2009 08:51:19 +1000      1.1068
--- files.el    20 Aug 2009 08:03:13 +1000      
***************
*** 5398,5409 ****
          (when (and directory-free-space-program
                     ;; Avoid failure if the default directory does
                     ;; not exist (Bug#2631, Bug#3911).
!                    (let ((default-directory default-directory))
!                      (setq dir (expand-file-name dir))
!                      (unless (and (not (file-remote-p default-directory))
!                                   (file-directory-p default-directory)
!                                   (file-readable-p default-directory))
!                        (setq default-directory "/"))
                       (eq (call-process directory-free-space-program
                                         nil t nil
                                         directory-free-space-args
--- 5398,5405 ----
          (when (and directory-free-space-program
                     ;; Avoid failure if the default directory does
                     ;; not exist (Bug#2631, Bug#3911).
!                    (setq dir (expand-file-name dir))
!                    (let ((default-directory "/"))
                       (eq (call-process directory-free-space-program
                                         nil t nil
                                         directory-free-space-args