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: Revision: 4666 Author: hans URL: http://bknr.net/trac/changeset/4666 commit files from test system A deployed/bos/projects/bos/payment-website/ge A deployed/bos/projects/bos/payment-website/images/blueten.jpg Added: deployed/bos/projects/bos/payment-website/ge =================================================================== --- deployed/bos/projects/bos/payment-website/ge (rev 0) +++ deployed/bos/projects/bos/payment-website/ge 2011-05-01 07:30:43 UTC (rev 4666) @@ -0,0 +1 @@ +link /home/bknr/ge \ No newline at end of file Property changes on: deployed/bos/projects/bos/payment-website/ge ___________________________________________________________________ Added: svn:special + * Added: deployed/bos/projects/bos/payment-website/images/blueten.jpg =================================================================== (Binary files differ) Property changes on: deployed/bos/projects/bos/payment-website/images/blueten.jpg ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From bknr at bknr.net Wed May 25 14:40:41 2011 From: bknr at bknr.net (BKNR Commits) Date: Wed, 25 May 2011 16:40:41 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/cl-fad/ Message-ID: Revision: 4667 Author: edi URL: http://bknr.net/trac/changeset/4667 Symlink behavior U trunk/thirdparty/cl-fad/CHANGELOG U trunk/thirdparty/cl-fad/doc/index.html U trunk/thirdparty/cl-fad/fad.lisp U trunk/thirdparty/cl-fad/openmcl.lisp Modified: trunk/thirdparty/cl-fad/CHANGELOG =================================================================== --- trunk/thirdparty/cl-fad/CHANGELOG 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/CHANGELOG 2011-05-25 14:40:41 UTC (rev 4667) @@ -1,3 +1,7 @@ +Version 0.6.5 +xxx +Fix symlink behaviour for some platforms (Mihai Bazon and Janis Dzerins) + Version 0.6.4 2010-11-18 Adapt to newer ClozureCL version (patch from Zach Beane, thanks to Chun Tian and Ralph Moritz as well) Modified: trunk/thirdparty/cl-fad/doc/index.html =================================================================== --- trunk/thirdparty/cl-fad/doc/index.html 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/doc/index.html 2011-05-25 14:40:41 UTC (rev 4667) @@ -164,18 +164,31 @@


[Function] -
list-directory dirname => list +
list-directory dirname &key follow-symlinks => list


-Returns a fresh list of pathnames corresponding to the truenames of +

+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 (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. +

+

+ When 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 => |


+

Recursively applies the function designated by the function designator 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.

+ 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 including dirname 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 directory dirname 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 "~@" - file (unix:get-unix-error-msg errno)))) - #+:sbcl (sb-posix:rmdir file) - #+:clisp (ext:delete-dir file) - #+:openmcl (cl-fad-ccl:delete-directory file) - #+:cormanlisp (win32:delete-directory file) - #+:ecl (si:rmdir file) - #+(or :abcl :digitool) (delete-file file)) - (t (delete-file file)))) - :directories t - :if-does-not-exist if-does-not-exist) + + #+:sbcl + (if (directory-exists-p dirname) + (sb-ext:delete-directory dirname :recursive t) + (ecase if-does-not-exist + (:error (error "~S is not a directory" dirname)) + (:ignore nil))) + + #+:ccl-has-delete-directory + (if (directory-exists-p dirname) + (ccl:delete-directory dirname) + (ecase if-does-not-exist + (:error (error "~S is not a directory" dirname)) + (:ignore nil))) + + #-(or :allegro :sbcl :ccl-has-delete-directory) + (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 "~@" + file (unix:get-unix-error-msg errno)))) + #+:clisp (ext:delete-dir file) + #+:openmcl (cl-fad-ccl:delete-directory file) + #+:cormanlisp (win32:delete-directory file) + #+:ecl (si:rmdir file) + #+(or :abcl :digitool) (delete-file file)) + (t (delete-file file)))) + :follow-symlinks nil + :directories t + :if-does-not-exist if-does-not-exist) (values)) (pushnew :cl-fad *features*) Modified: trunk/thirdparty/cl-fad/openmcl.lisp =================================================================== --- trunk/thirdparty/cl-fad/openmcl.lisp 2011-05-01 07:30:43 UTC (rev 4666) +++ trunk/thirdparty/cl-fad/openmcl.lisp 2011-05-25 14:40:41 UTC (rev 4667) @@ -59,6 +59,9 @@ ;;; ClozureCL 1.6 introduced ccl:delete-directory with semantics that ;;; are acceptably similar to this "legacy" definition. +;;; +;;; Except this legacy definition is not recursive, hence this function is +;;; used only if there is no :CCL-HAS-DELETE-DIRECTORY feature. #-ccl-has-delete-directory (defun delete-directory (path) From bknr at bknr.net Mon May 30 12:15:18 2011 From: bknr at bknr.net (BKNR Commits) Date: Mon, 30 May 2011 14:15:18 +0200 Subject: [bknr-cvs] edi changed trunk/thirdparty/cl-fad/fad.lisp Message-ID: Revision: 4668 Author: edi URL: http://bknr.net/trac/changeset/4668 Make argument ignorable U trunk/thirdparty/cl-fad/fad.lisp Modified: trunk/thirdparty/cl-fad/fad.lisp =================================================================== --- trunk/thirdparty/cl-fad/fad.lisp 2011-05-25 14:40:41 UTC (rev 4667) +++ trunk/thirdparty/cl-fad/fad.lisp 2011-05-30 12:15:18 UTC (rev 4668) @@ -94,6 +94,7 @@ When FOLLOW-SYMLINKS is NIL, it should return the actual directory contents, which might include symlinks. Currently this works on SBCL and CCL." + (declare (ignorable follow-symlinks)) (when (wild-pathname-p dirname) (error "Can only list concrete directory names.")) #+:ecl