[armedbear-cvs] r12607 - in trunk/abcl: . doc/design/pathnames src/org/armedbear/lisp test/lisp/abcl
Mark Evenson
mevenson at common-lisp.net
Thu Apr 15 14:27:10 UTC 2010
Author: mevenson
Date: Thu Apr 15 10:27:09 2010
New Revision: 12607
Log:
URL pathnames working for OPEN for built-in schemas.
Still need to decide with URI escaping issues, as we currently rely on
the URL Stream handlers to do the right thing. And we still need to
retrofit jar pathname's use of a string to represent a URL.
Updates for URL and jar pathname design documents.
Implemented URL-PATHNAME and JAR-PATHNAME as subtypes of PATHNAME.
Adjusted ABCL-TEST-LISP to use functions provided in
"pathname-test.lisp" in "jar-file.lisp". Added one test for url
pathnames.
Constructor in Java added for a Cons by copying references from the
orignal Cons.
Modified:
trunk/abcl/abcl.asd
trunk/abcl/doc/design/pathnames/jar-pathnames.markdown
trunk/abcl/doc/design/pathnames/url-pathnames.markdown
trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java
trunk/abcl/src/org/armedbear/lisp/Cons.java
trunk/abcl/src/org/armedbear/lisp/FileStream.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/Pathname.java
trunk/abcl/src/org/armedbear/lisp/Symbol.java
trunk/abcl/src/org/armedbear/lisp/Utilities.java
trunk/abcl/src/org/armedbear/lisp/ZipCache.java
trunk/abcl/src/org/armedbear/lisp/pathnames.lisp
trunk/abcl/test/lisp/abcl/jar-file.lisp
Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd (original)
+++ trunk/abcl/abcl.asd Thu Apr 15 10:27:09 2010
@@ -35,7 +35,7 @@
(:file "mop-tests-setup")
(:file "mop-tests" :depends-on ("mop-tests-setup"))
(:file "file-system-tests")
- (:file "jar-file")
+ (:file "jar-file" :depend-on ("pathname-test"))
(:file "math-tests")
(:file "misc-tests")
(:file "bugs")
Modified: trunk/abcl/doc/design/pathnames/jar-pathnames.markdown
==============================================================================
--- trunk/abcl/doc/design/pathnames/jar-pathnames.markdown (original)
+++ trunk/abcl/doc/design/pathnames/jar-pathnames.markdown Thu Apr 15 10:27:09 2010
@@ -3,10 +3,10 @@
Mark Evenson
Created: 09 JAN 2010
- Modified: 16 MAR 2010
+ Modified: 25 MAR 2010
-Notes towards sketching an implementation of "jar:" references to be
-contained in Common Lisp `PATHNAMEs` within ABCL.
+Notes towards an implementation of "jar:" references to be contained
+in Common Lisp `PATHNAME`s within ABCL.
Goals
-----
@@ -51,54 +51,60 @@
6. References "jar:<URL>" for all strings <URL> that java.net.URL can
resolve works.
-7. Make jar pathnames work as a valid argument for OPEN.
+7. Make jar pathnames work as a valid argument for OPEN with
+:DIRECTION :INPUT.
8. Enable the loading of ASDF systems packaged within jar files.
+9. Enable the matching of jar pathnames with PATHNAME-MATCH-P
+
+ (pathname-match-p
+ "jar:file:/a/b/some.jar!/a/system/def.asd"
+ "jar:file:/**/*.jar!/**/*.asd")
+ ==> t
+
Status
------
-As of svn r12501, all the above goals have been implemented and tested
-*except* for:
-
-7. Make jar pathnames work as a valid argument for OPEN.
+As of svn r125??, all the above goals have been implemented and
+tested.
Implementation
--------------
-Using PATHNAMES
+A PATHNAME refering to a file within a JAR is known as a JAR PATHNAME.
+It can either refer to the entire JAR file or an entry within the JAR
+file.
-* A PATHNAME refering to a file within a JAR is known as a JAR
- PATHNAME. It can either refer to the entire JAR file or an entry
- within the JAR file.
+A JAR PATHNAME always has a DEVICE which is a proper list. This
+distinguishes it from other uses of Pathname.
-* A JAR PATHNAME always has a DEVICE which is a proper list. This
- distinguishes it from other uses of Pathname.
+The DEVICE of a JAR PATHNAME will be a list with either one or two
+elements. The first element of the JAR PATHNAME can be either a
+PATHNAME representing a JAR on the filesystem, or a SimpleString
+representing a URL.
-* The DEVICE of a JAR PATHNAME will be a list with either one or two
- elements. The first element of the JAR PATHNAME can be either a
- PATHNAME representing a JAR on the filesystem, or a SimpleString
- representing a URL.
+A PATHNAME occuring in the list in the DEVICE of a JAR PATHNAME is
+known as a DEVICE PATHNAME.
-* a PATHNAME occuring in the list in the DEVICE of a JAR PATHNAME is
- known as a DEVICE PATHNAME.
+If the DEVICE is a String it must be a String that successfully
+references a URL via the java.net.URL(String) constructor
-* If the DEVICE is a String it must be a String that successfully
- references a URL via the java.net.URL(String) constructor
+Only the first entry in the the DEVICE list may be a String.
-* Only the first entry in the the DEVICE list may be a String.
+Otherwise the the DEVICE PATHAME denotes the PATHNAME of the JAR file.
-* Otherwise the the DEVICE PATHAME denotes the PATHNAME of the JAR file
-
-* The DEVICE PATHNAME list of enclosing JARs runs from outermost to
- innermost.
+The DEVICE PATHNAME list of enclosing JARs runs from outermost to
+innermost.
-* The DIRECTORY component of a JAR PATHNAME should be a list starting
- with the :ABSOLUTE keyword. Even though hierarchial entries in
- jar files are stored in the form "foo/bar/a.lisp" not
- "/foo/bar/a.lisp", the meaning of DIRECTORY component better
- represented as an absolute path.
+The DIRECTORY component of a JAR PATHNAME should be a list starting
+with the :ABSOLUTE keyword. Even though hierarchial entries in jar
+files are stored in the form "foo/bar/a.lisp" not "/foo/bar/a.lisp",
+the meaning of DIRECTORY component better represented as an absolute
+path.
+
+A jar Pathname has type JAR-PATHNAME, derived from PATHNAME.
BNF
---
Modified: trunk/abcl/doc/design/pathnames/url-pathnames.markdown
==============================================================================
--- trunk/abcl/doc/design/pathnames/url-pathnames.markdown (original)
+++ trunk/abcl/doc/design/pathnames/url-pathnames.markdown Thu Apr 15 10:27:09 2010
@@ -110,6 +110,7 @@
The namestring of a URL pathname shall be formed by the usual
conventions of a URL.
+A URL Pathname has type URL-PATHNAME, derived from PATHNAME.
Status
------
Modified: trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/BuiltInClass.java Thu Apr 15 10:27:09 2010
@@ -113,6 +113,8 @@
public static final BuiltInClass NUMBER = addClass(Symbol.NUMBER);
public static final BuiltInClass PACKAGE = addClass(Symbol.PACKAGE);
public static final BuiltInClass PATHNAME = addClass(Symbol.PATHNAME);
+ public static final BuiltInClass JAR_PATHNAME = addClass(Symbol.JAR_PATHNAME);
+ public static final BuiltInClass URL_PATHNAME = addClass(Symbol.URL_PATHNAME);
public static final BuiltInClass RANDOM_STATE = addClass(Symbol.RANDOM_STATE);
public static final BuiltInClass RATIO = addClass(Symbol.RATIO);
public static final BuiltInClass RATIONAL = addClass(Symbol.RATIONAL);
@@ -178,6 +180,12 @@
public static final LispClass FILE_STREAM =
addClass(Symbol.FILE_STREAM,
new StructureClass(Symbol.FILE_STREAM, list(SYSTEM_STREAM)));
+ public static final LispClass JAR_STREAM =
+ addClass(Symbol.JAR_STREAM,
+ new StructureClass(Symbol.JAR_STREAM, list(SYSTEM_STREAM)));
+ public static final LispClass URL_STREAM =
+ addClass(Symbol.URL_STREAM,
+ new StructureClass(Symbol.URL_STREAM, list(SYSTEM_STREAM)));
public static final LispClass CONCATENATED_STREAM =
addClass(Symbol.CONCATENATED_STREAM,
new StructureClass(Symbol.CONCATENATED_STREAM, list(SYSTEM_STREAM)));
@@ -230,6 +238,10 @@
FIXNUM.setCPL(FIXNUM, INTEGER, RATIONAL, REAL, NUMBER, CLASS_T);
FILE_STREAM.setCPL(FILE_STREAM, SYSTEM_STREAM, STREAM,
STRUCTURE_OBJECT, CLASS_T);
+ JAR_STREAM.setCPL(JAR_STREAM, SYSTEM_STREAM, STREAM,
+ STRUCTURE_OBJECT, CLASS_T);
+ URL_STREAM.setCPL(URL_STREAM, SYSTEM_STREAM, STREAM,
+ STRUCTURE_OBJECT, CLASS_T);
FLOAT.setDirectSuperclass(REAL);
FLOAT.setCPL(FLOAT, REAL, NUMBER, CLASS_T);
FUNCTION.setDirectSuperclass(CLASS_T);
@@ -260,6 +272,10 @@
PACKAGE.setCPL(PACKAGE, CLASS_T);
PATHNAME.setDirectSuperclass(CLASS_T);
PATHNAME.setCPL(PATHNAME, CLASS_T);
+ JAR_PATHNAME.setDirectSuperclass(PATHNAME);
+ JAR_PATHNAME.setCPL(JAR_PATHNAME, PATHNAME, CLASS_T);
+ URL_PATHNAME.setDirectSuperclass(PATHNAME);
+ URL_PATHNAME.setCPL(URL_PATHNAME, PATHNAME, CLASS_T);
RANDOM_STATE.setDirectSuperclass(CLASS_T);
RANDOM_STATE.setCPL(RANDOM_STATE, CLASS_T);
RATIO.setDirectSuperclass(RATIONAL);
Modified: trunk/abcl/src/org/armedbear/lisp/Cons.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Cons.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Cons.java Thu Apr 15 10:27:09 2010
@@ -61,6 +61,24 @@
++count;
}
+ public Cons(Cons original)
+ {
+ Cons rest = original;
+ LispObject result = NIL;
+ while (rest.car() != NIL) {
+ result = result.push(rest.car());
+ if (rest.cdr() == NIL) {
+ result = result.push(NIL);
+ break;
+ }
+ rest = (Cons) rest.cdr();
+ }
+ result = result.nreverse();
+ this.car = result.car();
+ this.cdr = result.cdr();
+ ++count;
+ }
+
@Override
public LispObject typeOf()
{
Modified: trunk/abcl/src/org/armedbear/lisp/FileStream.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FileStream.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/FileStream.java Thu Apr 15 10:27:09 2010
@@ -286,11 +286,6 @@
else {
return type_error(first, Symbol.PATHNAME);
}
- if (pathname.isJar()) {
- error(new FileError("Direct stream input/output on entries in JAR files no currently supported.",
- pathname));
- }
-
final LispObject namestring = checkString(second);
LispObject elementType = third;
LispObject direction = fourth;
@@ -300,16 +295,41 @@
if (direction != Keyword.INPUT && direction != Keyword.OUTPUT &&
direction != Keyword.IO)
error(new LispError("Direction must be :INPUT, :OUTPUT, or :IO."));
- try {
- return new FileStream(pathname, namestring.getStringValue(),
- elementType, direction, ifExists,
- externalFormat);
- }
- catch (FileNotFoundException e) {
- return NIL;
- }
- catch (IOException e) {
- return error(new StreamError(null, e));
+
+ if (pathname.isJar()) {
+ if (direction != Keyword.INPUT) {
+ error(new FileError("Only direction :INPUT is supported for jar files.", pathname));
+ }
+ try {
+ return new JarStream(pathname, namestring.getStringValue(),
+ elementType, direction, ifExists,
+ externalFormat);
+ } catch (IOException e) {
+ return error(new StreamError(null, e));
+ }
+ } else if (pathname.isURL()) {
+ if (direction != Keyword.INPUT) {
+ error(new FileError("Only direction :INPUT is supported for URLs.", pathname));
+ }
+ try {
+ return new URLStream(pathname, namestring.getStringValue(),
+ elementType, direction, ifExists,
+ externalFormat);
+ } catch (IOException e) {
+ return error(new StreamError(null, e));
+ }
+ } else {
+ try {
+ return new FileStream(pathname, namestring.getStringValue(),
+ elementType, direction, ifExists,
+ externalFormat);
+ }
+ catch (FileNotFoundException e) {
+ return NIL;
+ }
+ catch (IOException e) {
+ return error(new StreamError(null, e));
+ }
}
}
};
Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Thu Apr 15 10:27:09 2010
@@ -1741,8 +1741,13 @@
return Pathname.parseNamestring((AbstractString)arg);
if (arg instanceof FileStream)
return ((FileStream)arg).getPathname();
+ if (arg instanceof JarStream)
+ return ((JarStream)arg).getPathname();
+ if (arg instanceof URLStream)
+ return ((URLStream)arg).getPathname();
type_error(arg, list(Symbol.OR, Symbol.PATHNAME,
- Symbol.STRING, Symbol.FILE_STREAM));
+ Symbol.STRING, Symbol.FILE_STREAM,
+ Symbol.JAR_STREAM, Symbol.URL_STREAM));
// Not reached.
return null;
}
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Thu Apr 15 10:27:09 2010
@@ -462,17 +462,24 @@
String type = truePathname.type.getStringValue();
if (type.equals(COMPILE_FILE_TYPE)
|| type.equals(COMPILE_FILE_INIT_FASL_TYPE.toString())) {
- thread.bindSpecial(Symbol.LOAD_TRUENAME_FASL, truePathname);
+ Pathname truenameFasl = new Pathname(truePathname);
+ thread.bindSpecial(Symbol.LOAD_TRUENAME_FASL, truenameFasl);
}
if (truePathname.type.getStringValue()
.equals(COMPILE_FILE_INIT_FASL_TYPE.getStringValue())
&& truePathname.isJar()) {
if (truePathname.device.cdr() != NIL ) {
- // set truename to the enclosing JAR
+ // We set *LOAD-TRUENAME* to the argument that
+ // a user would pass to LOAD.
+ Pathname enclosingJar = (Pathname)truePathname.device.cdr().car();
+ truePathname.device = new Cons(truePathname.device.car(), NIL);
truePathname.host = NIL;
- truePathname.directory = NIL;
- truePathname.name = NIL;
- truePathname.type = NIL;
+ truePathname.directory = enclosingJar.directory;
+ if (truePathname.directory.car().equals(Keyword.RELATIVE)) {
+ truePathname.directory.setCar(Keyword.ABSOLUTE);
+ }
+ truePathname.name = enclosingJar.name;
+ truePathname.type = enclosingJar.type;
truePathname.invalidateNamestring();
} else {
// XXX There is something fishy in the asymmetry
Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Pathname.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Pathname.java Thu Apr 15 10:27:09 2010
@@ -39,8 +39,11 @@
import java.io.InputStream;
import java.io.FileInputStream;
import java.net.MalformedURLException;
+import java.net.URI;
+import java.net.URISyntaxException;
import java.net.URL;
import java.net.URLDecoder;
+import java.net.URLConnection;
import java.util.Enumeration;
import java.util.StringTokenizer;
import java.util.zip.ZipEntry;
@@ -64,6 +67,9 @@
* is to call this method after changing the field to recompute the namestring.
* We could do this with setter/getters, but that choose not to in order to avoid the
* performance indirection penalty.
+ *
+ * Although, given the number of bugs that crop up when this
+ * protocol is not adhered to, maybe we should consider it.
*/
public void invalidateNamestring() {
namestring = null;
@@ -78,6 +84,8 @@
host = new SimpleString(((SimpleString)p.host).getStringValue());
} else if (p.host instanceof Symbol) {
host = p.host;
+ } else if (p.host instanceof Cons) {
+ host = new Cons((Cons)p.host);
} else {
Debug.assertTrue(false);
}
@@ -152,19 +160,26 @@
}
public static boolean isSupportedProtocol(String protocol) {
- return "jar".equals(protocol) || "file".equals(protocol);
+ // There is no programmatic way to know what protocols will
+ // sucessfully construct a URL, so we check for well known ones...
+ if ("jar".equals(protocol)
+ || "file".equals(protocol))
+ // || "http".equals(protocol)) XXX remove this as an optimization
+ {
+ return true;
+ }
+ // ... and try the entire constructor with some hopefully
+ // reasonable parameters for everything else.
+ try {
+ new URL(protocol, "example.org", "foo");
+ return true;
+ } catch (MalformedURLException e) {
+ return false;
+ }
}
public Pathname(URL url) {
- String protocol = url.getProtocol();
- if (!isSupportedProtocol(protocol)) {
- error(new LispError("Unsupported URL: '" + url.toString() + "'"));
- }
-
- if ("jar".equals(protocol)) {
- init(url.toString());
- return;
- } else if ("file".equals(protocol)) {
+ if ("file".equals(url.getProtocol())) {
String s;
try {
s = URLDecoder.decode(url.getPath(), "UTF-8");
@@ -188,11 +203,17 @@
init(s);
return;
}
+ } else {
+ init(url.toString());
+ return;
}
error(new LispError("Failed to construct Pathname from URL: "
+ "'" + url.toString() + "'"));
}
+ static final Symbol SCHEME = internKeyword("SCHEME");
+ static final Symbol AUTHORITY = internKeyword("AUTHORITY");
+
static final private String jarSeparator = "!/";
private final void init(String s) {
if (s == null) {
@@ -230,7 +251,7 @@
return;
}
}
-
+
// A JAR file
if (s.startsWith("jar:") && s.endsWith(jarSeparator)) {
LispObject jars = NIL;
@@ -305,6 +326,59 @@
return;
}
+ // A URL
+ if (isValidURL(s)) {
+ URL url = null;
+ try {
+ url = new URL(s);
+ } catch (MalformedURLException e) {
+ Debug.assertTrue(false);
+ }
+ String scheme = url.getProtocol();
+ Debug.assertTrue(scheme != null);
+ String authority = url.getAuthority();
+ Debug.assertTrue(authority != null);
+
+ host = NIL;
+ host = host.push(SCHEME);
+ host = host.push(new SimpleString(scheme));
+ host = host.push(AUTHORITY);
+ host = host.push(new SimpleString(authority));
+ host = host.nreverse();
+
+ device = NIL;
+
+ // URI encode necessary characters
+ URI uri = null;
+ try {
+ uri = url.toURI().normalize();
+ } catch (URISyntaxException e) {
+ error(new LispError("Could not URI escape characters in "
+ + "'" + url + "'"
+ + " because: " + e));
+ }
+
+ String path = uri.getRawPath();
+ if (path == null) {
+ path = "";
+ }
+ String query = uri.getRawQuery();
+ if (query != null) {
+ path += "?" + query;
+ }
+ String fragment = uri.getRawFragment();
+ if (fragment != null) {
+ path += "#" + fragment;
+ }
+ Pathname p = new Pathname(path != null ? path : "");
+
+ directory = p.directory;
+ name = p.name;
+ type = p.type;
+
+ return;
+ }
+
if (Utilities.isPlatformWindows) {
if (!s.contains(jarSeparator)) {
s = s.replace("/", "\\");
@@ -446,11 +520,23 @@
@Override
public LispObject typeOf() {
+ if (isURL()) {
+ return Symbol.URL_PATHNAME;
+ }
+ if (isJar()) {
+ return Symbol.JAR_PATHNAME;
+ }
return Symbol.PATHNAME;
}
@Override
public LispObject classOf() {
+ if (isURL()) {
+ return BuiltInClass.URL_PATHNAME;
+ }
+ if (isJar()) {
+ return BuiltInClass.JAR_PATHNAME;
+ }
return BuiltInClass.PATHNAME;
}
@@ -459,9 +545,21 @@
if (type == Symbol.PATHNAME) {
return T;
}
+ if (type == Symbol.JAR_PATHNAME && isJar()) {
+ return T;
+ }
+ if (type == Symbol.URL_PATHNAME && isURL()) {
+ return T;
+ }
if (type == BuiltInClass.PATHNAME) {
return T;
}
+ if (type == BuiltInClass.JAR_PATHNAME && isJar()) {
+ return T;
+ }
+ if (type == BuiltInClass.URL_PATHNAME && isURL()) {
+ return T;
+ }
return super.typep(type);
}
@@ -486,15 +584,28 @@
// is, both NIL and :UNSPECIFIC cause the component not to appear in
// the namestring." 19.2.2.2.3.1
if (host != NIL) {
- Debug.assertTrue(host instanceof AbstractString);
- if (!(this instanceof LogicalPathname)) {
- sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path.
- }
- sb.append(host.getStringValue());
- if (this instanceof LogicalPathname) {
- sb.append(':');
- } else {
- sb.append(File.separatorChar);
+ Debug.assertTrue(host instanceof AbstractString
+ || host instanceof Cons);
+ if (host instanceof Cons) {
+ LispObject scheme = Symbol.GETF.execute(host, SCHEME, NIL);
+ LispObject authority = Symbol.GETF.execute(host, AUTHORITY, NIL);
+ Debug.assertTrue(scheme != NIL);
+ sb.append(scheme.getStringValue());
+ sb.append(":");
+ if (authority != NIL) {
+ sb.append("//");
+ sb.append(authority.getStringValue());
+ }
+ } else {
+ if (!(this instanceof LogicalPathname)) {
+ sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path.
+ }
+ sb.append(host.getStringValue());
+ if (this instanceof LogicalPathname) {
+ sb.append(':');
+ } else {
+ sb.append(File.separatorChar);
+ }
}
}
if (device == NIL) {
@@ -582,7 +693,11 @@
sb.append(".NEWEST");
}
}
- return namestring = sb.toString();
+ namestring = sb.toString();
+ if (isURL()) {
+ namestring = Utilities.uriEncode(namestring);
+ }
+ return namestring;
}
protected String getDirectoryNamestring() {
@@ -643,6 +758,7 @@
p.directory = directory;
p.name = name;
p.type = type;
+ p.invalidateNamestring();
String path = p.getNamestring();
StringBuilder result = new StringBuilder();
if (Utilities.isPlatformWindows) {
@@ -745,7 +861,9 @@
if (printReadably) {
// We have a namestring. Check for pathname components that
// can't be read from the namestring.
- if (host != NIL || version != NIL) {
+ if ((host != NIL && !isURL())
+ || version != NIL)
+ {
useNamestring = false;
} else if (name instanceof AbstractString) {
String n = name.getStringValue();
@@ -828,21 +946,61 @@
return new Pathname(s);
}
+ public static boolean isValidURL(String s) {
+ try {
+ URL url = new URL(s);
+ } catch (MalformedURLException e) {
+ return false;
+ }
+ return true;
+ }
+
+ public static URL toURL(Pathname p) {
+ URL url = null;
+ if (!(p.host instanceof Cons)) {
+ Debug.assertTrue(false); // XXX
+ }
+ try {
+ url = new URL(p.getNamestring());
+ } catch (MalformedURLException e) {
+ Debug.assertTrue(false); // XXX
+ }
+ return url;
+ }
+
+ URLConnection getURLConnection() {
+ Debug.assertTrue(isURL());
+ URL url = Pathname.toURL(this);
+ URLConnection result = null;
+ try {
+ result = url.openConnection();
+ } catch (IOException e) {
+ error(new FileError("Failed to open URL connection.",
+ this));
+ }
+ return result;
+ }
+
public static Pathname parseNamestring(AbstractString namestring) {
// Check for a logical pathname host.
String s = namestring.getStringValue();
- String h = getHostString(s);
- if (h != null && LOGICAL_PATHNAME_TRANSLATIONS.get(new SimpleString(h)) != null) {
- // A defined logical pathname host.
- return new LogicalPathname(h, s.substring(s.indexOf(':') + 1));
+ if (!isValidURL(s)) {
+ String h = getHostString(s);
+ if (h != null && LOGICAL_PATHNAME_TRANSLATIONS.get(new SimpleString(h)) != null) {
+ // A defined logical pathname host.
+ return new LogicalPathname(h, s.substring(s.indexOf(':') + 1));
+ }
}
return new Pathname(s);
}
- public static Pathname parseNamestring(AbstractString namestring,
- AbstractString host) {
- // Look for a logical pathname host in the namestring.
+ // XXX was @return Pathname
+ public static LogicalPathname parseNamestring(AbstractString namestring,
+ AbstractString host)
+ {
String s = namestring.getStringValue();
+
+ // Look for a logical pathname host in the namestring.
String h = getHostString(s);
if (h != null) {
if (!h.equals(host.getStringValue())) {
@@ -1262,7 +1420,7 @@
return new Pathname(s);
}
case 1:
- return NIL; // ??? huh? -- ME 20100206
+ return NIL;
default:
return error(new WrongNumberOfArgumentsException(this));
}
@@ -1328,6 +1486,10 @@
return result;
}
+ if (pathname.isURL()) {
+ return error(new LispError("Unimplemented.")); // XXX
+ }
+
String s = pathname.getNamestring();
if (s != null) {
File f = new File(s);
@@ -1441,10 +1603,25 @@
}
public boolean isJar() {
- if (device instanceof Cons) {
- return true;
+ return (device instanceof Cons);
+ }
+
+ // ### PATHNAME-URL-P
+ private static final Primitive PATHNAME_URL_P = new pf_pathname_url_p();
+ private static class pf_pathname_url_p extends Primitive {
+ pf_pathname_url_p() {
+ super("pathname-url-p", PACKAGE_SYS, true, "pathname",
+ "Predicate for whether PATHNAME references a URL.");
}
- return false;
+ @Override
+ public LispObject execute(LispObject arg) {
+ Pathname p = coerceToPathname(arg);
+ return p.isURL() ? T : NIL;
+ }
+ }
+
+ public boolean isURL() {
+ return (host instanceof Cons);
}
public boolean isWild() {
@@ -1607,17 +1784,6 @@
result.directory = mergeDirectories(p.directory, d.directory);
}
- // A JAR always has absolute directories
- // if (result.isJar()
- // && result.directory instanceof Cons
- // && result.directory.car().equals(Keyword.ABSOLUTE)) {
- // if (result.directory.cdr().equals(NIL)) {
- // result.directory = NIL;
- // } else {
- // ((Cons)result.directory).car = Keyword.RELATIVE;
- // }
- // }
-
if (pathname.name != NIL) {
result.name = p.name;
} else {
@@ -1727,7 +1893,7 @@
return error(new FileError("Bad place for a wild pathname.",
pathname));
}
- if (!(pathname.device instanceof Cons)) {
+ if (!(pathname.isJar() || pathname.isURL())) {
pathname
= mergePathnames(pathname,
coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
@@ -1750,6 +1916,10 @@
return error(new FileError(e.getMessage(), pathname));
}
}
+ } else if (pathname.isURL()) {
+ if (pathname.getInputStream() != null) {
+ return pathname;
+ }
} else
jarfile: {
// Possibly canonicalize jar file directory
@@ -1885,14 +2055,24 @@
+ ": " + e);
}
}
+ } else if (isURL()) {
+ URL url = toURL(this);
+ try {
+ result = url.openStream();
+ } catch (IOException e) {
+ error(new FileError("Failed to get InputStream from "
+ + "'" + Utilities.escapeFormat(getNamestring()) + "'"
+ + ": " + e,
+ this));
+ }
} else {
File file = Utilities.getFile(this);
try {
result = new FileInputStream(file);
} catch (IOException e) {
- Debug.trace("Failed to get InputStream for read from "
- + "'" + getNamestring() + "'"
- + ": " + e);
+ error(new FileError("Failed to get InputStream from "
+ + "'" + getNamestring() + "'"
+ + ": " + e, this));
}
}
return result;
@@ -1902,78 +2082,84 @@
* resource was last modified, or 0 if the time is unknown.
*/
public long getLastModified() {
- if (!(device instanceof Cons)) {
+ if (!(isJar() || isURL())) {
File f = Utilities.getFile(this);
return f.lastModified();
}
- // JAR cases
- // 0. JAR from URL
- // 1. JAR
- // 2. JAR in JAR
- // 3. Entry in JAR
- // 4. Entry in JAR in JAR
- String entryPath = asEntryPath();
- Cons d = (Cons)device;
- if (d.cdr().equals(NIL)) {
- if (entryPath.length() == 0) {
- LispObject o = d.car();
- if (o instanceof SimpleString) {
- // 0. JAR from URL
- // URL u = makeJarURL(o.getStringValue());
- // XXX unimplemented
- Debug.assertTrue(false);
- // URLConnection c = null;
- // try {
- // c = u.openConnection();
- // } catch(IOException e) {
- // Debug.trace("Failed to open Connection for URL "
- // + "'" + u + "'");
- // return 0;
- // }
- // c.getLastModified();
- } else {
- // 1. JAR
- return ((Pathname)o).getLastModified();
- }
- } else {
- // 3. Entry in JAR
- final ZipEntry entry
- = ZipCache.get(device.car()).getEntry(entryPath);
- if (entry == null) {
- return 0;
- }
- final long time = entry.getTime();
- if (time == -1) {
- return 0;
+
+ if (isJar()) {
+ // JAR cases
+ // 0. JAR from URL
+ // 1. JAR
+ // 2. JAR in JAR
+ // 3. Entry in JAR
+ // 4. Entry in JAR in JAR
+ String entryPath = asEntryPath();
+ Cons d = (Cons)device;
+ if (d.cdr().equals(NIL)) {
+ if (entryPath.length() == 0) {
+ LispObject o = d.car();
+ if (o instanceof SimpleString) {
+ // 0. JAR from URL
+ // URL u = makeJarURL(o.getStringValue());
+ // XXX unimplemented
+ Debug.assertTrue(false);
+ // URLConnection c = null;
+ // try {
+ // c = u.openConnection();
+ // } catch(IOException e) {
+ // Debug.trace("Failed to open Connection for URL "
+ // + "'" + u + "'");
+ // return 0;
+ // }
+ // c.getLastModified();
+ } else {
+ // 1. JAR
+ return ((Pathname)o).getLastModified();
+ }
+ } else {
+ // 3. Entry in JAR
+ final ZipEntry entry
+ = ZipCache.get(device.car()).getEntry(entryPath);
+ if (entry == null) {
+ return 0;
+ }
+ final long time = entry.getTime();
+ if (time == -1) {
+ return 0;
+ }
+ return time;
}
- return time;
- }
- } else {
- ZipFile outerJar = ZipCache.get(d.car());
- if (entryPath.length() == 0) {
- // 4. JAR in JAR
- String jarPath = ((Pathname)d.cdr()).asEntryPath();
- final ZipEntry entry = outerJar.getEntry(jarPath);
- final long time = entry.getTime();
- if (time == -1) {
- return 0;
- }
- return time;
- } else {
- // 5. Entry in JAR in JAR
- String innerJarPath = ((Pathname)d.cdr()).asEntryPath();
- ZipEntry entry = outerJar.getEntry(entryPath);
- ZipInputStream innerJarInputStream
- = Utilities.getZipInputStream(outerJar, innerJarPath);
- ZipEntry innerEntry = Utilities.getEntry(innerJarInputStream,
- entryPath);
- long time = innerEntry.getTime();
- if (time == -1) {
- return 0;
+ } else {
+ ZipFile outerJar = ZipCache.get(d.car());
+ if (entryPath.length() == 0) {
+ // 4. JAR in JAR
+ String jarPath = ((Pathname)d.cdr()).asEntryPath();
+ final ZipEntry entry = outerJar.getEntry(jarPath);
+ final long time = entry.getTime();
+ if (time == -1) {
+ return 0;
+ }
+ return time;
+ } else {
+ // 5. Entry in JAR in JAR
+ String innerJarPath = ((Pathname)d.cdr()).asEntryPath();
+ ZipEntry entry = outerJar.getEntry(entryPath);
+ ZipInputStream innerJarInputStream
+ = Utilities.getZipInputStream(outerJar, innerJarPath);
+ ZipEntry innerEntry = Utilities.getEntry(innerJarInputStream,
+ entryPath);
+ long time = innerEntry.getTime();
+ if (time == -1) {
+ return 0;
+ }
+ return time;
}
- return time;
}
}
+ if (isURL()) {
+ return getURLConnection().getLastModified();
+ }
return 0;
}
@@ -1994,6 +2180,13 @@
mergePathnames(pathname,
coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
NIL);
+ if (defaultedPathname.isURL() || defaultedPathname.isJar()) {
+ return new FileError("Cannot mkdir with a "
+ + (defaultedPathname.isURL() ? "URL" : "jar")
+ + " Pathname.",
+ defaultedPathname);
+ }
+
File file = Utilities.getFile(defaultedPathname);
return file.mkdir() ? T : NIL;
}
@@ -2088,5 +2281,6 @@
LispObject obj = Symbol.DEFAULT_PATHNAME_DEFAULTS.getSymbolValue();
Symbol.DEFAULT_PATHNAME_DEFAULTS.setSymbolValue(coerceToPathname(obj));
}
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java Thu Apr 15 10:27:09 2010
@@ -3004,6 +3004,11 @@
PACKAGE_SYS.addExternalSymbol("SET-CHAR");
public static final Symbol SET_SCHAR =
PACKAGE_SYS.addExternalSymbol("SET-SCHAR");
+ public static final Symbol JAR_STREAM =
+ PACKAGE_SYS.addExternalSymbol("JAR-STREAM");
+ public static final Symbol URL_STREAM =
+ PACKAGE_SYS.addExternalSymbol("URL-STREAM");
+
// Internal symbols in SYSTEM package.
public static final Symbol BACKQUOTE_MACRO =
@@ -3060,6 +3065,10 @@
PACKAGE_SYS.addInternalSymbol("LISP-STACK-FRAME");
public static final Symbol JAVA_STACK_FRAME =
PACKAGE_SYS.addInternalSymbol("JAVA-STACK-FRAME");
+ public static final Symbol JAR_PATHNAME =
+ PACKAGE_SYS.addExternalSymbol("JAR-PATHNAME");
+ public static final Symbol URL_PATHNAME =
+ PACKAGE_SYS.addExternalSymbol("URL-PATHNAME");
// CDR6
public static final Symbol _INSPECTOR_HOOK_ =
Modified: trunk/abcl/src/org/armedbear/lisp/Utilities.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Utilities.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Utilities.java Thu Apr 15 10:27:09 2010
@@ -40,6 +40,8 @@
import java.io.File;
import java.io.IOException;
import java.io.InputStream;
+import java.net.URI;
+import java.net.URISyntaxException;
import java.util.jar.JarFile;
import java.util.zip.ZipEntry;
import java.util.zip.ZipFile;
@@ -253,5 +255,23 @@
}
+ static String uriEncode(String s) {
+ try {
+ URI uri = new URI("?" + s);
+ return uri.getQuery();
+ } catch (URISyntaxException e) {}
+ return null;
+ }
+ static String uriDecode(String s) {
+ try {
+ URI uri = new URI(null, null, null, s, null);
+ return uri.toASCIIString().substring(1);
+ } catch (URISyntaxException e) {}
+ return null; // Error
+ }
+
+ static String escapeFormat(String s) {
+ return s.replace("~", "~~");
+ }
}
Modified: trunk/abcl/src/org/armedbear/lisp/ZipCache.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ZipCache.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/ZipCache.java Thu Apr 15 10:27:09 2010
@@ -111,11 +111,13 @@
try {
return new ZipFile(f);
} catch (ZipException e) {
- Debug.trace(e); // XXX
- return null;
+ error(new FileError("Failed to construct ZipFile"
+ + " because " + e,
+ Pathname.makePathname(f)));
} catch (IOException e) {
- Debug.trace(e); // XXX
- return null;
+ error(new FileError("Failed to contruct ZipFile"
+ + " because " + e,
+ Pathname.makePathname(f)));
}
} else {
Entry e = fetchURL(url, false);
@@ -185,11 +187,13 @@
try {
entry.file = new ZipFile(f);
} catch (ZipException e) {
- Debug.trace(e); // XXX
- return null;
+ error(new FileError("Failed to get cached ZipFile"
+ + " because " + e,
+ Pathname.makePathname(f)));
} catch (IOException e) {
- Debug.trace(e); // XXX
- return null;
+ error(new FileError("Failed to get cached ZipFile"
+ + " because " + e,
+ Pathname.makePathname(f)));
}
} else {
entry = fetchURL(url, true);
@@ -205,29 +209,31 @@
try {
jarURL = new URL("jar:" + url + "!/");
} catch (MalformedURLException e) {
- Debug.trace(e);
- Debug.assertTrue(false); // XXX
+ error(new LispError("Failed to form a jar: URL from "
+ + "'" + url + "'"
+ + " because " + e));
}
- URLConnection connection;
+ URLConnection connection = null;
try {
connection = jarURL.openConnection();
- } catch (IOException ex) {
- Debug.trace("Failed to open "
- + "'" + jarURL + "'");
- return null;
+ } catch (IOException e) {
+ error(new LispError("Failed to open "
+ + "'" + jarURL + "'"
+ + " with exception "
+ + e));
}
if (!(connection instanceof JarURLConnection)) {
- // XXX
- Debug.trace("Could not get a URLConnection from " + jarURL);
- return null;
+ error(new LispError("Could not get a URLConnection from "
+ + "'" + jarURL + "'"));
}
JarURLConnection jarURLConnection = (JarURLConnection) connection;
jarURLConnection.setUseCaches(cached);
try {
result.file = jarURLConnection.getJarFile();
} catch (IOException e) {
- Debug.trace(e);
- Debug.assertTrue(false); // XXX
+ error(new LispError("Failed to fetch URL "
+ + "'" + jarURLConnection + "'"
+ + " because " + e));
}
result.lastModified = jarURLConnection.getLastModified();
return result;
Modified: trunk/abcl/src/org/armedbear/lisp/pathnames.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/pathnames.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/pathnames.lisp Thu Apr 15 10:27:09 2010
@@ -134,9 +134,24 @@
wildcard (pathname wildcard))
(unless (component-match-p (pathname-host pathname) (pathname-host wildcard) nil)
(return-from pathname-match-p nil))
+ (when (and (pathname-jar-p pathname)
+ (pathname-jar-p wildcard))
+ (unless
+ (every (lambda (value) (not (null value)))
+ (mapcar #'pathname-match-p
+ (pathname-device pathname)
+ (pathname-device wildcard)))
+ (return-from pathname-match-p nil)))
+ (when (or (and (pathname-jar-p pathname)
+ (not (pathname-jar-p wildcard)))
+ (and (not (pathname-jar-p pathname))
+ (pathname-jar-p wildcard)))
+ (return-from pathname-match-p nil))
(let* ((windows-p (featurep :windows))
(ignore-case (or windows-p (typep pathname 'logical-pathname))))
(cond ((and windows-p
+ (not (pathname-jar-p pathname))
+ (not (pathname-jar-p wildcard))
(not (component-match-p (pathname-device pathname)
(pathname-device wildcard)
ignore-case)))
@@ -195,6 +210,16 @@
;; FIXME
(error "Unsupported wildcard pattern: ~S" to))))
+(defun translate-jar-device (source from to &optional case)
+ (declare (ignore case)) ; FIXME
+ (unless to
+ (return-from translate-jar-device nil))
+ (when (not (= (length source)
+ (length from)
+ (length to)))
+ (error "Unsupported pathname translation for unequal jar ~
+ references: ~S != ~S != ~S" source from to))
+ (mapcar #'translate-pathname source from to))
(defun translate-directory-components-aux (src from to case)
(cond
@@ -268,9 +293,13 @@
(to (pathname to-wildcard))
(device (if (typep 'to 'logical-pathname)
:unspecific
- (translate-component (pathname-device source)
- (pathname-device from)
- (pathname-device to))))
+ (if (pathname-jar-p source)
+ (translate-jar-device (pathname-device source)
+ (pathname-device from)
+ (pathname-device to))
+ (translate-component (pathname-device source)
+ (pathname-device from)
+ (pathname-device to)))))
(case (and (typep source 'logical-pathname)
(or (featurep :unix) (featurep :windows))
:downcase)))
@@ -388,6 +417,7 @@
(declare (ignore junk-allowed)) ; FIXME
(cond ((eq host :unspecific)
(setf host nil))
+ ((consp host)) ;; A URL
(host
(setf host (canonicalize-logical-host host))))
(typecase thing
Modified: trunk/abcl/test/lisp/abcl/jar-file.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/jar-file.lisp (original)
+++ trunk/abcl/test/lisp/abcl/jar-file.lisp Thu Apr 15 10:27:09 2010
@@ -320,11 +320,43 @@
(:relative "a" "b") "foo" "jar"
(:absolute "c" "d") "foo" "lisp")
+(deftest jar-file.pathname-match-p.1
+ (pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
+ "jar:file:/**/*.jar!/**/*.asd")
+ t)
+
+(deftest jar-file.pathname-match-p.2
+ (pathname-match-p "/a/system/def.asd"
+ "jar:file:/**/*.jar!/**/*.asd")
+ nil)
+
+(deftest jar-file.pathname-match-p.3
+ (pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
+ "/**/*.asd")
+ nil)
+
+(deftest jar-file.translate-pathname.1
+ (namestring
+ (translate-pathname "jar:file:/a/b/c.jar!/d/e/f.lisp"
+ "jar:file:/**/*.jar!/**/*.*"
+ "/foo/**/*.*"))
+ "/foo/d/e/f.lisp")
+
+;; URL Pathname tests
+(deftest pathname-url.1
+ (let* ((p #p"http://example.org/a/b/foo.lisp")
+ (host (pathname-host p)))
+ (values
+ (check-physical-pathname p '(:absolute "a" "b") "foo" "lisp")
+ (and (consp host)
+ (equal (getf host :scheme)
+ "http")
+ (equal (getf host :authority)
+ "example.org"))))
+ (t t))
+
-
-
-
More information about the armedbear-cvs
mailing list