From bknr at bknr.net Sun May 1 07:30:43 2011
From: bknr at bknr.net (BKNR Commits)
Date: Sun, 01 May 2011 09:30:43 +0200
Subject: [bknr-cvs] hans changed deployed/bos/projects/bos/payment-website/
Message-ID:
+Returns a fresh list of pathnames corresponding to
all files within the directory named by the non-wild pathname designator
+ If
+ When
Recursively applies the function designated by the function
designator
[Function]
-
list-directory dirname => list
+
list-directory dirname &key follow-symlinks => list
-Returns a fresh list of pathnames corresponding to the truenames of
+dirname
. The pathnames of sub-directories are returned in
directory form - see PATHNAME-AS-DIRECTORY
.
+follow-symlinks
is true (which is the
+ default), then the returned list contains truenames (symlinks will
+ be resolved) which essentially means that it might also return files
+ from outside the directory. This works on all platforms.
+follow-symlinks
is NIL
, it should return the actual directory
+ contents, which might include symlinks. (This is currently implemented only on SBCL and CCL.)
+
[Function]
-
walk-directory dirname fn &key directories if-does-not-exist test => |
+
walk-directory dirname fn &key directories if-does-not-exist test follow-symlinks => |
+ does not exist.
+
+fn
to all files within the directory named
by the non-wild pathname
@@ -190,17 +203,33 @@
directory's content will be skipped. if-does-not-exist
must
be one of :ERROR
or :IGNORE
where :ERROR
(the default) means that an error will be signaled if the directory dirname
- does not exist.
+ If follow-symlinks
is true (which is
+ the default), then your callback will receive truenames. Otherwise
+ you should get the actual directory contents, which might include
+ symlinks. This might not be supported on all platforms. See
+ LIST-DIRECTORY
.
+
[Function]
delete-directory-and-files dirname&key if-does-not-exist => |
+Recursively deletes all files and directories within the directory designated by the non-wild pathname designator
+dirname
includingdirname
itself.if-does-not-exist
must be one of:ERROR
or:IGNORE
where:ERROR
(the default) means that an error will be signaled if the directorydirname
does not exist. ++ Warning: this function might remove files from outside the + directory, if the directory that you are deleting contains links to + external files. This is currently fixed for SBCL and CCL. +
[Function]
Modified: trunk/thirdparty/cl-fad/fad.lisp
===================================================================
--- trunk/thirdparty/cl-fad/fad.lisp 2011-05-01 07:30:43 UTC (rev 4666)
+++ trunk/thirdparty/cl-fad/fad.lisp 2011-05-25 14:40:41 UTC (rev 4667)
@@ -39,7 +39,7 @@
"Returns NIL if PATHSPEC \(a pathname designator) does not designate
a directory, PATHSPEC otherwise. It is irrelevant whether file or
directory designated by PATHSPEC does actually exist."
- (and
+ (and
(not (component-present-p (pathname-name pathspec)))
(not (component-present-p (pathname-type pathspec)))
pathspec))
@@ -80,23 +80,33 @@
:type nil
:defaults wildcard))
-(defun list-directory (dirname)
- "Returns a fresh list of pathnames corresponding to the truenames of
-all files within the directory named by the non-wild pathname
-designator DIRNAME. The pathnames of sub-directories are returned in
-directory form - see PATHNAME-AS-DIRECTORY."
+(defun list-directory (dirname &key (follow-symlinks t))
+ "Returns a fresh list of pathnames corresponding to all files within
+the directory named by the non-wild pathname designator DIRNAME. The
+pathnames of sub-directories are returned in directory form - see
+PATHNAME-AS-DIRECTORY.
+
+If FOLLOW-SYMLINKS is true, then the returned list contains
+truenames (symlinks will be resolved) which essentially means that it
+might also return files from *outside* the directory. This works on
+all platforms.
+
+When FOLLOW-SYMLINKS is NIL, it should return the actual directory
+contents, which might include symlinks. Currently this works on SBCL
+and CCL."
(when (wild-pathname-p dirname)
(error "Can only list concrete directory names."))
- #+:ecl
+ #+:ecl
(let ((dir (pathname-as-directory dirname)))
(concatenate 'list
(directory (merge-pathnames (pathname "*/") dir))
(directory (merge-pathnames (pathname "*.*") dir))))
- #-:ecl
+ #-:ecl
(let ((wildcard (directory-wildcard dirname)))
#+:abcl (system::list-directory dirname)
- #+(or :sbcl :cmu :scl :lispworks) (directory wildcard)
- #+(or :openmcl :digitool) (directory wildcard :directories t)
+ #+:sbcl (directory wildcard :resolve-symlinks follow-symlinks)
+ #+(or :cmu :scl :lispworks) (directory wildcard)
+ #+(or :openmcl :digitool) (directory wildcard :directories t :follow-links follow-symlinks)
#+:allegro (directory wildcard :directories-are-files nil)
#+:clisp (nconc (directory wildcard :if-does-not-exist :keep)
(directory (clisp-subdirectories-wildcard wildcard)))
@@ -160,32 +170,36 @@
(defun walk-directory (dirname fn &key directories
(if-does-not-exist :error)
- (test (constantly t)))
+ (test (constantly t))
+ (follow-symlinks t))
"Recursively applies the function FN to all files within the
directory named by the non-wild pathname designator DIRNAME and all of
its sub-directories. FN will only be applied to files for which the
function TEST returns a true value. If DIRECTORIES is not NIL, FN and
-TEST are applied to directories as well. If DIRECTORIES is :DEPTH-FIRST,
-FN will be applied to the directory's contents first. If
-DIRECTORIES is :BREADTH-FIRST and TEST returns NIL, the
-directory's content will be skipped. IF-DOES-NOT-EXIST must be
-one of :ERROR or :IGNORE where :ERROR means that an error will be
-signaled if the directory DIRNAME does not exist."
+TEST are applied to directories as well. If DIRECTORIES
+is :DEPTH-FIRST, FN will be applied to the directory's contents first.
+If DIRECTORIES is :BREADTH-FIRST and TEST returns NIL, the directory's
+content will be skipped. IF-DOES-NOT-EXIST must be one of :ERROR
+or :IGNORE where :ERROR means that an error will be signaled if the
+directory DIRNAME does not exist. If FOLLOW-SYMLINKS is T, then your
+callback will receive truenames. Otherwise you should get the actual
+directory contents, which might include symlinks. This might not be
+supported on all platforms. See LIST-DIRECTORY."
(labels ((walk (name)
(cond
((directory-pathname-p name)
;; the code is written in a slightly awkward way for
;; backward compatibility
(cond ((not directories)
- (dolist (file (list-directory name))
+ (dolist (file (list-directory name :follow-symlinks follow-symlinks))
(walk file)))
((eql directories :breadth-first)
(when (funcall test name)
(funcall fn name)
- (dolist (file (list-directory name))
+ (dolist (file (list-directory name :follow-symlinks follow-symlinks))
(walk file))))
;; :DEPTH-FIRST is implicit
- (t (dolist (file (list-directory name))
+ (t (dolist (file (list-directory name :follow-symlinks follow-symlinks))
(walk file))
(when (funcall test name)
(funcall fn name)))))
@@ -253,32 +267,53 @@
designated by the non-wild pathname designator DIRNAME including
DIRNAME itself. IF-DOES-NOT-EXIST must be one of :ERROR or :IGNORE
where :ERROR means that an error will be signaled if the directory
-DIRNAME does not exist."
+DIRNAME does not exist.
+
+NOTE: this function is dangerous if the directory that you are
+removing contains symlinks to files outside of it - the target files
+might be removed instead! This is currently fixed for SBCL and CCL."
+
#+:allegro (excl.osi:delete-directory-and-files dirname
:if-does-not-exist if-does-not-exist)
- #-:allegro (walk-directory dirname
- (lambda (file)
- (cond ((directory-pathname-p file)
- #+:lispworks (lw:delete-directory file)
- #+:cmu (multiple-value-bind (ok err-number)
- (unix:unix-rmdir (namestring (truename file)))
- (unless ok
- (error "Error number ~A when trying to delete ~A"
- err-number file)))
- #+:scl (multiple-value-bind (ok errno)
- (unix:unix-rmdir (ext:unix-namestring (truename file)))
- (unless ok
- (error "~@