bknr-cvs May 2011

bknr-cvs@common-lisp.net

1 participants
3 discussions

[bknr-cvs] edi changed trunk/thirdparty/cl-fad/fad.lisp
by BKNR Commits 30 May '11

30 May '11

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

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-fad/
by BKNR Commits 25 May '11

25 May '11

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 @@ </blockquote> [Function] - <a class=none name="list-directory">list-directory dirname => list</a> + <a class=none name="list-directory">list-directory dirname <tt>&key</tt> follow-symlinks => list</a> <blockquote> -Returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm#fresh">fresh</a> list of pathnames corresponding to the truenames of + +Returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm#fresh">fresh</a> list of pathnames corresponding to all files within the directory named by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname…">pathname designator</a> <code>dirname</code>. The pathnames of sub-directories are returned in directory form - see <a href="#pathname-as-directory"><code>PATHNAME-AS-DIRECTORY</code></a>. + + + If <code>follow-symlinks</code> 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 <code>follow-symlinks</code> is <code>NIL</code>, it should return the actual directory + contents, which might include symlinks. (This is currently implemented only on SBCL and CCL.) + </blockquote> [Function] - <a class=none name="walk-directory">walk-directory dirname fn <tt>&key</tt> directories if-does-not-exist test => |</a> + <a class=none name="walk-directory">walk-directory dirname fn <tt>&key</tt> directories if-does-not-exist test follow-symlinks => |</a> <blockquote> + Recursively applies the function designated by the <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_f.htm#function…">function designator</a> <code>fn</code> to all files within the directory named by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname…">pathname @@ -190,17 +203,33 @@ directory's content will be skipped. <code>if-does-not-exist</code> must be one of <code>:ERROR</code> or <code>:IGNORE</code> where <code>:ERROR</code> (the default) means that an error will be signaled if the directory <code>dirname</code> - does not exist. </blockquote> + does not exist. + + + If <code>follow-symlinks</code> 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 + <a href="#list-directory"><code>LIST-DIRECTORY</code></a>. + +</blockquote> [Function] <a class=none name="delete-directory-and-files">delete-directory-and-files dirname<tt>&key</tt> if-does-not-exist => |</a> <blockquote> + Recursively deletes all files and directories within the directory designated by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname…">pathname designator</a> <code>dirname</code> including <code>dirname</code> itself. <code>if-does-not-exist</code> must be one of <code>:ERROR</code> or <code>:IGNORE</code> where <code>:ERROR</code> (the default) means that an error will be signaled if the directory <code>dirname</code> 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. + </blockquote> [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 "~@<Error deleting ~S: ~A~@:>" - 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 "~@<Error deleting ~S: ~A~@:>" + 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)

1 0

[bknr-cvs] hans changed deployed/bos/projects/bos/payment-website/
by BKNR Commits 01 May '11

01 May '11

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

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs May 2011