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

[Katsumi Yamaoka <yamaoka@jpl.org>]

[-- Attachment #1: Type: text/plain, Size: 1244 bytes --]

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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 822 bytes --]

--- 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)