diff -r a9813719dfba doc/design/pathnames/jar-pathnames.markdown --- a/doc/design/pathnames/jar-pathnames.markdown Tue Mar 23 13:59:08 2010 +0100 +++ b/doc/design/pathnames/jar-pathnames.markdown Thu Mar 25 16:18:18 2010 +0100 @@ -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,17 +51,23 @@ 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 @@ -81,7 +87,7 @@ 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 +* 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 diff -r a9813719dfba doc/design/pathnames/url-pathnames.markdown --- a/src/org/armedbear/lisp/BuiltInClass.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/BuiltInClass.java Thu Mar 25 16:18:18 2010 +0100 @@ -181,6 +181,9 @@ 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 CONCATENATED_STREAM = addClass(Symbol.CONCATENATED_STREAM, new StructureClass(Symbol.CONCATENATED_STREAM, list(SYSTEM_STREAM))); @@ -233,6 +236,8 @@ 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); FLOAT.setDirectSuperclass(REAL); FLOAT.setCPL(FLOAT, REAL, NUMBER, CLASS_T); FUNCTION.setDirectSuperclass(CLASS_T); diff -r a9813719dfba src/org/armedbear/lisp/FileStream.java --- a/src/org/armedbear/lisp/FileStream.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/FileStream.java Thu Mar 25 16:18:18 2010 +0100 @@ -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,30 @@ 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 { + 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 a9813719dfba src/org/armedbear/lisp/JarStream.java --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/org/armedbear/lisp/JarStream.java Thu Mar 25 16:18:18 2010 +0100 @@ -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 a9813719dfba src/org/armedbear/lisp/Lisp.java --- a/src/org/armedbear/lisp/Lisp.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/Lisp.java Thu Mar 25 16:18:18 2010 +0100 @@ -1749,8 +1749,11 @@ return Pathname.parseNamestring((AbstractString)arg); if (arg instanceof FileStream) return ((FileStream)arg).getPathname(); + if (arg instanceof JarStream) + return ((JarStream)arg).getPathname(); type_error(arg, list(Symbol.OR, Symbol.PATHNAME, - Symbol.STRING, Symbol.FILE_STREAM)); + Symbol.STRING, Symbol.FILE_STREAM, + Symbol.JAR_STREAM)); // Not reached. return null; } diff -r a9813719dfba src/org/armedbear/lisp/Load.java --- a/src/org/armedbear/lisp/Load.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/Load.java Thu Mar 25 16:18:18 2010 +0100 @@ -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 a9813719dfba src/org/armedbear/lisp/Pathname.java --- a/src/org/armedbear/lisp/Pathname.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/Pathname.java Thu Mar 25 16:18:18 2010 +0100 @@ -643,6 +643,7 @@ p.directory = directory; p.name = name; p.type = type; + p.invalidateNamestring(); String path = p.getNamestring(); StringBuilder result = new StringBuilder(); if (Utilities.isPlatformWindows) { diff -r a9813719dfba src/org/armedbear/lisp/Symbol.java --- a/src/org/armedbear/lisp/Symbol.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/Symbol.java Thu Mar 25 16:18:18 2010 +0100 @@ -2999,6 +2999,9 @@ 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"); + // Internal symbols in SYSTEM package. public static final Symbol BACKQUOTE_MACRO = diff -r a9813719dfba src/org/armedbear/lisp/ZipCache.java --- a/src/org/armedbear/lisp/ZipCache.java Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/ZipCache.java Thu Mar 25 16:18:18 2010 +0100 @@ -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 a9813719dfba src/org/armedbear/lisp/pathnames.lisp --- a/src/org/armedbear/lisp/pathnames.lisp Tue Mar 23 13:59:08 2010 +0100 +++ b/src/org/armedbear/lisp/pathnames.lisp Thu Mar 25 16:18:18 2010 +0100 @@ -134,9 +134,19 @@ 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))) (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 +205,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 +288,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))) diff -r a9813719dfba test/lisp/abcl/bar.lisp --- a/test/lisp/abcl/jar-file.lisp Tue Mar 23 13:59:08 2010 +0100 +++ b/test/lisp/abcl/jar-file.lisp Thu Mar 25 16:18:18 2010 +0100 @@ -320,11 +320,20 @@ (: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.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") + + +