From 1e8bacb74421b05d2453e8c359907fc4ccd22b48 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Wed, 23 Aug 2000 15:52:46 +0000
Subject: [PATCH] o Rework %enumerate-directories to handle :wild and
 :wild-inferiors   within the pathname; noted by Christophe Rhodes. Further
 maintain a   list of the directory inode and device numbers which are used to
 avoid   paths loops during :wild-inferiors searches.

o Enhance %enumerate-directories to accept a new follow-links argument to
  allow the following of symbolic links to be disabled. Similarly add
  follow-links keyword argument to interface macro enumerate-matches.
---
 code/filesys.lisp | 132 ++++++++++++++++++++++++++++++++--------------
 1 file changed, 92 insertions(+), 40 deletions(-)

diff --git a/code/filesys.lisp b/code/filesys.lisp
index 5d1e67ab7..44c4aa60b 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.56 1999/06/03 15:55:49 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.57 2000/08/23 15:52:46 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -499,18 +499,18 @@
 ;;;; Wildcard matching stuff.
 
 (defmacro enumerate-matches ((var pathname &optional result
-				  &key (verify-existance t))
+				  &key (verify-existance t) (follow-links t))
 			     &body body)
   (let ((body-name (gensym)))
     `(block nil
        (flet ((,body-name (,var)
 		,@body))
 	 (%enumerate-matches (pathname ,pathname)
-			     ,verify-existance
+			     ,verify-existance ,follow-links
 			     #',body-name)
 	 ,result))))
 
-(defun %enumerate-matches (pathname verify-existance function)
+(defun %enumerate-matches (pathname verify-existance follow-links function)
   (when (pathname-type pathname)
     (unless (pathname-name pathname)
       (error "Cannot supply a type without a name:~%  ~S" pathname)))
@@ -522,45 +522,96 @@
 	(ecase (car directory)
 	  (:absolute
 	   (%enumerate-directories "/" (cdr directory) pathname
-				   verify-existance function))
+				   verify-existance follow-links
+				   nil function))
 	  (:relative
 	   (%enumerate-directories "" (cdr directory) pathname
-				   verify-existance function)))
+				   verify-existance follow-links
+				   nil function)))
 	(%enumerate-files "" pathname verify-existance function))))
 
-(defun %enumerate-directories (head tail pathname verify-existance function)
+;;; %enumerate-directories  --   Internal
+;;;
+;;; The directory node and device numbers are maintained for the current path
+;;; during the search for the detection of paths loops upon :wild-inferiors.
+;;;
+(defun %enumerate-directories (head tail pathname verify-existance
+			       follow-links nodes function)
   (declare (simple-string head))
-  (if tail
-      (let ((piece (car tail)))
-	(etypecase piece
-	  (simple-string
-	   (%enumerate-directories (concatenate 'string head piece "/")
-				   (cdr tail) pathname verify-existance
-				   function))
-	  ((or pattern (member :wild :wild-inferiors))
-	   (let ((dir (unix:open-dir head)))
-	     (when dir
-	       (unwind-protect
-		   (loop
-		     (let ((name (unix:read-dir dir)))
-		       (cond ((null name)
-			      (return))
-			     ((string= name "."))
-			     ((string= name ".."))
-			     ((pattern-matches piece name)
-			      (let ((subdir (concatenate 'string
-							 head name "/")))
-				(when (eq (unix:unix-file-kind subdir)
-					  :directory)
-				  (%enumerate-directories
-				   subdir (cdr tail) pathname verify-existance
-				   function)))))))
-		 (unix:close-dir dir)))))
-	  ((member :up)
-	   (%enumerate-directories (concatenate 'string head "../")
-				   (cdr tail) pathname verify-existance
-				   function))))
-      (%enumerate-files head pathname verify-existance function)))
+  (macrolet ((unix-xstat (name)
+	       `(if follow-links
+		    (unix:unix-stat ,name)
+		    (unix:unix-lstat ,name)))
+	     (with-directory-node-noted ((head) &body body)
+	       `(multiple-value-bind (res dev ino mode)
+		    (unix-xstat ,head)
+		  (when (and res (eql (logand mode unix:s-ifmt) unix:s-ifdir))
+		    (let ((nodes (cons (cons dev ino) nodes)))
+		      ,@body))))
+	     (do-directory-entries ((name directory) &body body)
+	       `(let ((dir (unix:open-dir ,directory)))
+		  (when dir
+		    (unwind-protect
+			 (loop
+			  (let ((,name (unix:read-dir dir)))
+			    (cond ((null ,name)
+				   (return))
+				  ((string= ,name "."))
+				  ((string= ,name ".."))
+				  (t
+				   ,@body))))
+		      (unix:close-dir dir))))))
+    (if tail
+	(let ((piece (car tail)))
+	  (etypecase piece
+	    (simple-string
+	     (let ((head (concatenate 'string head piece)))
+	       (with-directory-node-noted (head)
+		 (%enumerate-directories (concatenate 'string head "/")
+					 (cdr tail) pathname
+					 verify-existance follow-links
+					 nodes function))))
+	    ((member :wild-inferiors)
+	     (%enumerate-directories head (rest tail) pathname
+				     verify-existance follow-links
+				     nodes function)
+	     (do-directory-entries (name head)
+	       (let ((subdir (concatenate 'string head name)))
+		 (multiple-value-bind (res dev ino mode)
+		     (unix-xstat subdir)
+		   (declare (type (or fixnum null) mode))
+		   (when (and res (eql (logand mode unix:s-ifmt) unix:s-ifdir))
+		     (unless (dolist (dir nodes nil)
+			       (when (and (eql (car dir) dev)
+					  (eql (cdr dir) ino))
+				 (return t)))
+		       (let ((nodes (cons (cons dev ino) nodes))
+			     (subdir (concatenate 'string subdir "/")))
+			 (%enumerate-directories subdir tail pathname
+						 verify-existance follow-links
+						 nodes function))))))))
+	    ((or pattern (member :wild))
+	     (do-directory-entries (name head)
+	       (when (or (eq piece :wild) (pattern-matches piece name))
+		 (let ((subdir (concatenate 'string head name)))
+		   (multiple-value-bind (res dev ino mode)
+		       (unix-xstat subdir)
+		     (declare (type (or fixnum null) mode))
+		     (when (and res
+				(eql (logand mode unix:s-ifmt) unix:s-ifdir))
+		       (let ((nodes (cons (cons dev ino) nodes))
+			     (subdir (concatenate 'string subdir "/")))
+			 (%enumerate-directories subdir (rest tail) pathname
+						 verify-existance follow-links
+						 nodes function))))))))
+	    ((member :up)
+	     (let ((head (concatenate 'string head "..")))
+	       (with-directory-node-noted (head)
+		 (%enumerate-directories (concatenate 'string head "/")
+					 (rest tail) pathname
+					 verify-existance follow-links
+					 nodes function))))))
+	(%enumerate-files head pathname verify-existance function))))
 
 (defun %enumerate-files (directory pathname verify-existance function)
   (declare (simple-string directory))
@@ -651,7 +702,8 @@
   (enumerate-search-list
       (pathname path)
     (collect ((names))
-      (enumerate-matches (name pathname nil :verify-existance for-input)
+      (enumerate-matches (name pathname nil :verify-existance for-input
+			       :follow-links t)
 	(when (or (not executable-only)
 		  (and (eq (unix:unix-file-kind name) :file)
 		       (unix:unix-access name unix:x_ok)))
@@ -831,7 +883,7 @@
 				   (make-pathname :name :wild
 						  :type :wild
 						  :version :wild)))
-      (enumerate-matches (name pathname)
+      (enumerate-matches (name pathname nil :follow-links follow-links)
 	(when (or all
 		  (let ((slash (position #\/ name :from-end t)))
 		    (or (null slash)
-- 
GitLab