bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#18063: 24.3; gnus-recursive-directory-files is fooled by upward syml


From: Katsumi Yamaoka
Subject: bug#18063: 24.3; gnus-recursive-directory-files is fooled by upward symlinks
Date: Tue, 22 Jul 2014 08:45:15 +0900
User-agent: Gnus/5.130012 (真 Gnus v0.12) Emacs/24.4.50 (i686-pc-cygwin)

On Sun, 20 Jul 2014 11:14:53 -0300, David Bremner wrote:
> Hi Emacs Maintainers;

Hi,

Hmm, why has your original message not been accepted as a bug in
the Emacs bug list? (I found it in the gmane.emacs.bugs newsgroup,
so I'm cc'ing this to the group.)

> A notmuch-emacs user reported a bug with emacs "hanging" on unpacking a
> tar file.  After some debugging I believe have narrowed the problem down
> to the following test case, which can be run with e.g.

> % emacs -Q --script bug.el

> (require 'gnus-util)

> (let* ((temp-dir (make-temp-file "/tmp/loop-test" t))
>        (dir (concat temp-dir "/test"))
>        (target (concat dir "/parent")))
>   (make-temp-file dir)
>   (make-directory dir)
>   (make-symbolic-link ".." target)
>   (message "%s" (gnus-recursive-directory-files dir)))

> On my system, this reports some 40 spurious paths created by following
> the symlink.  In the actual case, it reported some 70,000 paths, which
> caused further processing by the mm- libraries to grind to take an
> apparently infinite time.

The following patch fixes the problem at least on Cygwin.  Is it
ok for yours, too?  If so, I'll install it in the Emacs trunk (i.e.
the one that will become Emacs 24.5) and also the Gnus Git master.

--- gnus-util.el~       2014-03-23 23:08:55.000000000 +0000
+++ gnus-util.el        2014-07-21 23:43:08.029233200 +0000
@@ -1910,7 +1910,7 @@
                    image)))
       image)))
 
-(defun gnus-recursive-directory-files (dir)
+(defun gnus-recursive-directory-files (dir &optional inodes)
   "Return all regular files below DIR."
   (let (files)
     (dolist (file (directory-files dir t))
@@ -1920,7 +1920,11 @@
         ((file-regular-p file)
          (push file files))
         ((file-directory-p file)
-         (setq files (append (gnus-recursive-directory-files file) files))))))
+         (let ((inode (nth 10 (file-attributes file))))
+           (unless (member inode inodes)
+             (setq files (append (gnus-recursive-directory-files
+                                  file (cons inode inodes))
+                                 files))))))))
     files))
 
 (defun gnus-list-memq-of-list (elements list)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]