diff -r 7bd8782b9bb6 abcl.asd --- a/abcl.asd Sun Mar 28 23:41:27 2010 +0200 +++ b/abcl.asd Mon Apr 05 14:45:58 2010 +0200 @@ -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") diff -r 7bd8782b9bb6 doc/design/pathnames/jar-pathnames.markdown --- a/doc/design/pathnames/jar-pathnames.markdown Sun Mar 28 23:41:27 2010 +0200 +++ b/doc/design/pathnames/jar-pathnames.markdown Mon Apr 05 14:45:58 2010 +0200 @@ -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:" for all strings 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 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 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. +A jar Pathname has type JAR-PATHNAME, derived from PATHNAME. BNF --- diff -r 7bd8782b9bb6 doc/design/pathnames/url-pathnames.markdown --- a/doc/design/pathnames/url-pathnames.markdown Sun Mar 28 23:41:27 2010 +0200 +++ b/doc/design/pathnames/url-pathnames.markdown Mon Apr 05 14:45:58 2010 +0200 @@ -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 ------ diff -r 7bd8782b9bb6 src/org/armedbear/lisp/BuiltInClass.java --- a/src/org/armedbear/lisp/BuiltInClass.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/BuiltInClass.java Mon Apr 05 14:45:58 2010 +0200 @@ -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); diff -r 7bd8782b9bb6 src/org/armedbear/lisp/Cons.java --- a/src/org/armedbear/lisp/Cons.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/Cons.java Mon Apr 05 14:45:58 2010 +0200 @@ -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() { diff -r 7bd8782b9bb6 src/org/armedbear/lisp/FileStream.java --- a/src/org/armedbear/lisp/FileStream.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/FileStream.java Mon Apr 05 14:45:58 2010 +0200 @@ -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)); + } } } }; diff -r 7bd8782b9bb6 src/org/armedbear/lisp/JarStream.java --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/org/armedbear/lisp/JarStream.java Mon Apr 05 14:45:58 2010 +0200 @@ -0,0 +1,150 @@ +/* + * JarStream.java + * + * Copyright (C) 2010 Mark Evenson + * $Id: FileStream.java 12422 2010-02-06 10:52:32Z mevenson $ + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + * + * As a special exception, the copyright holders of this library give you + * permission to link this library with independent modules to produce an + * executable, regardless of the license terms of these independent + * modules, and to copy and distribute the resulting executable under + * terms of your choice, provided that you also meet, for each linked + * independent module, the terms and conditions of the license of that + * module. An independent module is a module which is not derived from + * or based on this library. If you modify this library, you may extend + * this exception to your version of the library, but you are not + * obligated to do so. If you do not wish to do so, delete this + * exception statement from your version. + */ + +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +import java.io.File; +import java.io.InputStream; +import java.io.Reader; +import java.io.FileNotFoundException; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.BufferedReader; + +/** + * Stream interface for an entry in a jar pathname. + * + * This only supports reading from the stream. + */ +public final class JarStream extends Stream +{ + private final Pathname pathname; + private final InputStream input; + private final Reader reader; + private final int bytesPerUnit; + + public JarStream(Pathname pathname, String namestring, + LispObject elementType, LispObject direction, + LispObject ifExists, LispObject format) + throws IOException + { + super(Symbol.JAR_STREAM); + Debug.assertTrue(direction == Keyword.INPUT); + Debug.assertTrue(pathname.name != NIL); + isInputStream = true; + + super.setExternalFormat(format); + + this.pathname = pathname; + this.elementType = elementType; + + this.input = pathname.getInputStream(); + if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) { + isCharacterStream = true; + bytesPerUnit = 1; + InputStreamReader isr = new InputStreamReader(input); + this.reader = (Reader) new BufferedReader(isr); + initAsCharacterInputStream(this.reader); + } else { + isBinaryStream = true; + int width = Fixnum.getValue(elementType.cadr()); + bytesPerUnit = width / 8; + this.reader = null; + initAsBinaryInputStream(this.input); + } + } + + @Override + public LispObject typeOf() + { + return Symbol.JAR_STREAM; + } + + @Override + public LispObject classOf() + { + return BuiltInClass.JAR_STREAM; + } + + @Override + public LispObject typep(LispObject typeSpecifier) + { + if (typeSpecifier == Symbol.JAR_STREAM) + return T; + if (typeSpecifier == BuiltInClass.JAR_STREAM) + return T; + return super.typep(typeSpecifier); + } + + @Override + public void setExternalFormat(LispObject format) { + super.setExternalFormat(format); + } + + public Pathname getPathname() + { + return pathname; + } + + @Override + public void _close() + { + try { + if (input != null) { + input.close(); + } + if (reader != null) { + reader.close(); + } + setOpen(false); + } + catch (IOException e) { + error(new StreamError(this, e)); + } + } + + @Override + public String writeToString() + { + StringBuffer sb = new StringBuffer(); + sb.append(Symbol.JAR_STREAM.writeToString()); + String namestring = pathname.getNamestring(); + if (namestring != null) { + sb.append(" "); + sb.append(namestring); + } + return unreadableString(sb.toString()); + } +} diff -r 7bd8782b9bb6 src/org/armedbear/lisp/Lisp.java --- a/src/org/armedbear/lisp/Lisp.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/Lisp.java Mon Apr 05 14:45:58 2010 +0200 @@ -1740,8 +1740,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; } diff -r 7bd8782b9bb6 src/org/armedbear/lisp/Load.java --- a/src/org/armedbear/lisp/Load.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/Load.java Mon Apr 05 14:45:58 2010 +0200 @@ -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 diff -r 7bd8782b9bb6 src/org/armedbear/lisp/Pathname.java --- a/src/org/armedbear/lisp/Pathname.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/Pathname.java Mon Apr 05 14:45:58 2010 +0200 @@ -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(':'); + 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 { - sb.append(File.separatorChar); + 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); @@ -1381,10 +1543,13 @@ jarPathname.name = NIL; jarPathname.type = NIL; jarPathname.invalidateNamestring(); - // will propagate an appropiate Lisp error if jarPathname - // doesn't exist. - LispObject jarTruename = truename(jarPathname, true); - + LispObject jarTruename = truename(jarPathname, false); + + // We can't match anything in a non-existent jar + if (jarTruename == NIL) { + return NIL; + } + LispObject result = NIL; String wild = "/" + pathname.asEntryPath(); @@ -1441,10 +1606,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 +1787,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 +1896,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 +1919,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 +2058,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,77 +2085,83 @@ * 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(); + + 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; } } else { - // 3. Entry in JAR - final ZipEntry entry - = ZipCache.get(device.car()).getEntry(entryPath); - if (entry == null) { - return 0; + 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; } - final long time = entry.getTime(); - if (time == -1) { - return 0; - } - 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; - } - return time; - } + } + if (isURL()) { + return getURLConnection().getLastModified(); } return 0; } @@ -1994,6 +2183,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 +2284,6 @@ LispObject obj = Symbol.DEFAULT_PATHNAME_DEFAULTS.getSymbolValue(); Symbol.DEFAULT_PATHNAME_DEFAULTS.setSymbolValue(coerceToPathname(obj)); } + } diff -r 7bd8782b9bb6 src/org/armedbear/lisp/Symbol.java --- a/src/org/armedbear/lisp/Symbol.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/Symbol.java Mon Apr 05 14:45:58 2010 +0200 @@ -3010,6 +3010,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 = @@ -3066,6 +3071,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_ = diff -r 7bd8782b9bb6 src/org/armedbear/lisp/URLStream.java --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/org/armedbear/lisp/URLStream.java Mon Apr 05 14:45:58 2010 +0200 @@ -0,0 +1,149 @@ +/* + * URLStream.java + * + * Copyright (C) 2010 Mark Evenson + * $Id: FileStream.java 12422 2010-02-06 10:52:32Z mevenson $ + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + * + * As a special exception, the copyright holders of this library give you + * permission to link this library with independent modules to produce an + * executable, regardless of the license terms of these independent + * modules, and to copy and distribute the resulting executable under + * terms of your choice, provided that you also meet, for each linked + * independent module, the terms and conditions of the license of that + * module. An independent module is a module which is not derived from + * or based on this library. If you modify this library, you may extend + * this exception to your version of the library, but you are not + * obligated to do so. If you do not wish to do so, delete this + * exception statement from your version. + */ + +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +import java.io.File; +import java.io.InputStream; +import java.io.Reader; +import java.io.FileNotFoundException; +import java.io.IOException; +import java.io.InputStreamReader; +import java.io.BufferedReader; + +/** + * Stream interface for a URL. + * + * This only supports reading from the stream. + */ +public final class URLStream extends Stream +{ + private final Pathname pathname; + private final InputStream input; + private final Reader reader; + private final int bytesPerUnit; + + public URLStream(Pathname pathname, String namestring, + LispObject elementType, LispObject direction, + LispObject ifExists, LispObject format) + throws IOException + { + super(Symbol.URL_STREAM); + Debug.assertTrue(direction == Keyword.INPUT); + isInputStream = true; + + super.setExternalFormat(format); + + this.pathname = pathname; + this.elementType = elementType; + + this.input = pathname.getInputStream(); + if (elementType == Symbol.CHARACTER || elementType == Symbol.BASE_CHAR) { + isCharacterStream = true; + bytesPerUnit = 1; + InputStreamReader isr = new InputStreamReader(input); + this.reader = (Reader) new BufferedReader(isr); + initAsCharacterInputStream(this.reader); + } else { + isBinaryStream = true; + int width = Fixnum.getValue(elementType.cadr()); + bytesPerUnit = width / 8; + this.reader = null; + initAsBinaryInputStream(this.input); + } + } + + @Override + public LispObject typeOf() + { + return Symbol.URL_STREAM; + } + + @Override + public LispObject classOf() + { + return BuiltInClass.URL_STREAM; + } + + @Override + public LispObject typep(LispObject typeSpecifier) + { + if (typeSpecifier == Symbol.URL_STREAM) + return T; + if (typeSpecifier == BuiltInClass.URL_STREAM) + return T; + return super.typep(typeSpecifier); + } + + @Override + public void setExternalFormat(LispObject format) { + super.setExternalFormat(format); + } + + public Pathname getPathname() + { + return pathname; + } + + @Override + public void _close() + { + try { + if (input != null) { + input.close(); + } + if (reader != null) { + reader.close(); + } + setOpen(false); + } + catch (IOException e) { + error(new StreamError(this, e)); + } + } + + @Override + public String writeToString() + { + StringBuffer sb = new StringBuffer(); + sb.append(Symbol.URL_STREAM.writeToString()); + String namestring = pathname.getNamestring(); + if (namestring != null) { + sb.append(" "); + sb.append(namestring); + } + return unreadableString(sb.toString()); + } +} diff -r 7bd8782b9bb6 src/org/armedbear/lisp/Utilities.java --- a/src/org/armedbear/lisp/Utilities.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/Utilities.java Mon Apr 05 14:45:58 2010 +0200 @@ -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("~", "~~"); + } } diff -r 7bd8782b9bb6 src/org/armedbear/lisp/ZipCache.java --- a/src/org/armedbear/lisp/ZipCache.java Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/ZipCache.java Mon Apr 05 14:45:58 2010 +0200 @@ -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; diff -r 7bd8782b9bb6 src/org/armedbear/lisp/pathnames.lisp --- a/src/org/armedbear/lisp/pathnames.lisp Sun Mar 28 23:41:27 2010 +0200 +++ b/src/org/armedbear/lisp/pathnames.lisp Mon Apr 05 14:45:58 2010 +0200 @@ -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 diff -r 7bd8782b9bb6 test/lisp/abcl/bar.lisp --- a/test/lisp/abcl/bar.lisp Sun Mar 28 23:41:27 2010 +0200 +++ b/test/lisp/abcl/bar.lisp Mon Apr 05 14:45:58 2010 +0200 @@ -1,6 +1,11 @@ +(defvar *pathname* *load-pathname*) +(defvar *truename* *load-truename*) + (defun bar () (labels - ((output () (format t "Some BAR"))) + ((output () + (format t "Some BAR~%*load-pathname* ~S~%*load-truename* ~S~%" + *pathname* *truename*))) (output))) (defvar *bar* t) diff -r 7bd8782b9bb6 test/lisp/abcl/bugs.lisp --- a/test/lisp/abcl/bugs.lisp Sun Mar 28 23:41:27 2010 +0200 +++ b/test/lisp/abcl/bugs.lisp Mon Apr 05 14:45:58 2010 +0200 @@ -25,7 +25,7 @@ "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/**/*.*")) #P"/users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/") -(deftest bugs.logical.pathname.2 +(deftest bugs.logical-pathname.2 #| Message-Id: From: Thomas Russ diff -r 7bd8782b9bb6 test/lisp/abcl/jar-file.lisp --- a/test/lisp/abcl/jar-file.lisp Sun Mar 28 23:41:27 2010 +0200 +++ b/test/lisp/abcl/jar-file.lisp Mon Apr 05 14:45:58 2010 +0200 @@ -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)) + - - -