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.
parent 93ec8f75
......@@ -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")
......
......@@ -3,10 +3,10 @@ JARs and JAR entries in ABCL
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 @@ Goals
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
---
......
......@@ -110,6 +110,7 @@ absolute.
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
------
......
......@@ -113,6 +113,8 @@ public class BuiltInClass extends LispClass
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 class BuiltInClass extends LispClass
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 @@ public class BuiltInClass extends LispClass
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 @@ public class BuiltInClass extends LispClass
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);
......
......@@ -61,6 +61,24 @@ public final class Cons extends LispObject
++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()
{
......
......@@ -286,11 +286,6 @@ public final class FileStream extends Stream
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 @@ public final class FileStream extends Stream
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));
}
}
}
};
......
......@@ -1741,8 +1741,13 @@ public final class Lisp
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;
}
......
......@@ -462,17 +462,24 @@ public final class Load
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
......
This diff is collapsed.
......@@ -3004,6 +3004,11 @@ public class Symbol extends LispObject
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 @@ public class Symbol extends LispObject
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_ =
......
......@@ -40,6 +40,8 @@ import java.io.ByteArrayOutputStream;
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 @@ public final class Utilities
}
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("~", "~~");
}
}
......@@ -111,11 +111,13 @@ public class ZipCache {
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 @@ public class ZipCache {
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 @@ public class ZipCache {
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;
......
......@@ -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
......
......@@ -320,11 +320,43 @@ OVERWRITE is true overwrites the file designtated by TO if it exists."
(: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))
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