Commit 32563d28 authored by mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

CL:DIRECTORY semantics for symbolic link resolution inverted and fixed.

The default for the :RESOLVE-SYMLINKS keyword to CL:DIRECTORY has
changed from T to nil, meaning that naked DIRECTORY calls should never
return an error for dangling symlinks.

Thanks to Marco Antoniotti, Alan Ruttenberg, and Alessio Stallo for
clarifying a reasonable position vis a vis ANSI.

Addresses <http://abcl.org/trac/ticket/340>.
parent 5796cfe8
......@@ -1564,7 +1564,7 @@ public class Pathname extends LispObject {
private static final Primitive LIST_DIRECTORY = new pf_list_directory();
@DocString(name="list-directory",
args="directory &optional (resolve-symlinks t)",
args="directory &optional (resolve-symlinks nil)",
returns="pathnames",
doc="Lists the contents of DIRECTORY, optionally resolving symbolic links.")
private static class pf_list_directory extends Primitive {
......@@ -1576,7 +1576,7 @@ public class Pathname extends LispObject {
return execute(arg, T);
}
@Override
public LispObject execute(LispObject arg, LispObject arg2) {
public LispObject execute(LispObject arg, LispObject resolveSymlinks) {
Pathname pathname = coerceToPathname(arg);
if (pathname instanceof LogicalPathname) {
pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
......@@ -1641,19 +1641,14 @@ public class Pathname extends LispObject {
for (int i = files.length; i-- > 0;) {
File file = files[i];
Pathname p;
if (file.isDirectory()) {
if (arg2 != NIL) {
p = Pathname.getDirectoryPathname(file);
} else {
p = new Pathname(file.getAbsolutePath());
}
} else {
if (arg2 != NIL) {
p = new Pathname(file.getCanonicalPath());
} else {
p = new Pathname(file.getAbsolutePath());
}
}
String path;
if (resolveSymlinks == NIL) {
path = file.getAbsolutePath();
} else {
path = file.getCanonicalPath();
}
URI pathURI = (new File(path)).toURI();
p = new Pathname(pathURI.toString());
result = new Cons(p, result);
}
} catch (IOException e) {
......
......@@ -96,8 +96,27 @@
resolve-symlinks)))))))
entries))))))
;;; XXX Kludge for compatibilty: hope no one uses.
(defun directory-old (pathspec &key (resolve-symlinks t))
(warn "Deprecated: Please use CL:DIRECTORY which has a NIL default for :RESOLVE-SYMLINKS.")
(directory pathspec :resolve-symlinks resolve-symlinks))
(defun directory (pathspec &key (resolve-symlinks nil))
"Determines which, if any, files that are present in the file system have names matching PATHSPEC, and returns
a fresh list of pathnames corresponding to the potential truenames of those files.
With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may
correspond to an existing file. Symbolic links are considered to be
be valid entries even if they do not currently have a valid file or
directory as a target. Therefore, subsequent CL:TRUENAME call on
individual pathnames in the list may signal an error, i.e. the
pathnames have been constructed as truenames, without calling the
entire resolution routine of CL:TRUENAME.
If called with :RESOLVE-SYMLINKS set to T, and any of the pathnames
have truenames which do not exist, this routine will signal a file
error to its caller."
(defun directory (pathspec &key (resolve-symlinks t))
(let ((pathname (merge-pathnames pathspec)))
(when (logical-pathname-p pathname)
(setq pathname (translate-logical-pathname pathname)))
......@@ -115,11 +134,18 @@
namestring nil resolve-symlinks))
(matching-entries ()))
(dolist (entry entries)
(cond ((file-directory-p entry)
(when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
(push (truename entry) matching-entries)))
((pathname-match-p (or (file-namestring entry) "") (file-namestring pathname))
(push (truename entry) matching-entries))))
(when
(or
(and
(file-directory-p entry)
(pathname-match-p (file-namestring (pathname-as-file entry))
(file-namestring pathname)))
(pathname-match-p (or (file-namestring entry) "") (file-namestring pathname)))
(push
(if resolve-symlinks
(truename entry)
entry)
matching-entries)))
matching-entries))))
;; Not wild.
(let ((truename (probe-file pathname)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment