Return of the ZipCache now using last modified time.

Treat jars as zips in ZipCache which maintains an cache of all
ZipFiles accessed via Pathname jars (which should be the entire system
as Load now uses Pathname).  ZipCache currently does not invalidate
entries for any non-file resources due to deficiencies in the JVM that
need to be corrected on a per-protocol basis.  For instance, for HTTP
we need an implementation that uses HTTP HEAD requests to get the
Last-Modified header as opposed to re-fetching the entire resource as
the JVM URLConnection does.

SYS:REMOVE-ZIP-CACHE-ENTRY implements a way to invalidate ZipCache
entries from Lisp.  Used it in COMPILE-FILE to successfully recompile
FASLs under Windows.

Rewrite remaining Pathname Primtives in the informative stack trace style.

Implement Debug.warn() which can be shut off with SYS::*DEBUG-WARN*.
The intent here is to have a way to warn about Java side events which
having potentially worrying side-effects during development which is
by default not visible to end users (although it can be).

Removed unused EXT:LAST-MODIFIED in favor of existing ANSI FILE-WRITE-DATE.
parent 2c9492a9
......@@ -644,6 +644,7 @@ public class Autoload extends Function
autoload(PACKAGE_SYS, "psxhash", "HashTableFunctions");
autoload(PACKAGE_SYS, "puthash", "HashTableFunctions");
autoload(PACKAGE_SYS, "puthash", "HashTableFunctions");
autoload(PACKAGE_SYS, "remove-zip-cache-entry", "ZipCache");
autoload(PACKAGE_SYS, "set-function-info-value", "function_info");
autoload(PACKAGE_SYS, "set-generic-function-argument-precedence-order","StandardGenericFunction", true);
autoload(PACKAGE_SYS, "set-generic-function-classes-to-emf-table","StandardGenericFunction", true);
......
......@@ -33,8 +33,11 @@
package org.armedbear.lisp;
import static org.armedbear.lisp.Lisp.*;
public final class Debug
{
public static final void assertTrue(boolean b)
{
if (!b) {
......@@ -60,4 +63,21 @@ public final class Debug
{
t.printStackTrace();
}
public static final Symbol _DEBUG_WARN_
= exportSpecial("*DEBUG-WARN*", PACKAGE_SYS, NIL);
public static void setDebugWarnings(boolean flag) {
if (flag) {
_DEBUG_WARN_.setSymbolValue(T);
} else {
_DEBUG_WARN_.setSymbolValue(NIL);
}
}
public static final void warn(String s) {
if (_DEBUG_WARN_.getSymbolValue() != null) {
trace(s);
}
}
}
......@@ -43,11 +43,14 @@ import java.net.MalformedURLException;
import java.net.URL;
import java.net.URLConnection;
import java.net.URLDecoder;
import java.util.HashMap;
import java.util.StringTokenizer;
import java.util.jar.JarEntry;
import java.util.jar.JarFile;
import java.util.zip.ZipEntry;
import java.util.zip.ZipFile;
import java.util.zip.ZipInputStream;
import java.util.zip.ZipException;
public class Pathname extends LispObject {
......@@ -1640,7 +1643,7 @@ public class Pathname extends LispObject {
// 2. JAR in JAR
// 3. JAR with Entry
// 4. JAR in JAR with Entry
JarFile jarFile = getJarFile(jars.car());
ZipFile jarFile = ZipCache.get(jars.car());
String entryPath = pathname.asEntryPath();
if (jarFile != null) {
if (jars.cdr() instanceof Cons) {
......@@ -1707,54 +1710,18 @@ public class Pathname extends LispObject {
return result;
}
/** Make a JarURL from a generic URL reference. */
private static URL makeJarURL(String url) {
String jarURL = "jar:" + url + "!/";
protected static URL makeURL(LispObject device) {
URL result = null;
try {
result = new URL(jarURL);
} catch (MalformedURLException ex) {
// XXX
Debug.trace("Could not form jar URL from "
+ "'" + jarURL + "'"
+ " because " + ex);
}
return result;
}
private static JarFile getJarFile(LispObject device) {
URL url = null;
if (device instanceof SimpleString) {
url = makeJarURL(((SimpleString) device).getStringValue());
result = new URL(((SimpleString)device).getStringValue());
} else {
url = makeJarURL((Pathname) device);
}
if (url == null) {
return null;
}
URLConnection connection;
try {
connection = url.openConnection();
} catch (IOException ex) {
Debug.trace("Failed to open "
+ "'" + url + "'");
return null;
// XXX ensure that we have cannonical path.
Pathname p = (Pathname)device;
result = new URL("file:" + p.getNamestring());
}
if (!(connection instanceof JarURLConnection)) {
// XXX
Debug.trace("Could not get a URLConnection from " + url);
return null;
}
JarURLConnection jarURLConnection = (JarURLConnection) connection;
// XXX implement custom protocol handler that actual does the necessary caching
connection.setUseCaches(false);
JarFile result;
try {
result = jarURLConnection.getJarFile();
} catch (IOException ex) {
Debug.trace("Could not get a JarURLConnection from "
+ "'" + jarURLConnection + "'");
return null;
} catch (MalformedURLException e) {
Debug.trace("Could not form URL from " + device);
}
return result;
}
......@@ -1765,7 +1732,7 @@ public class Pathname extends LispObject {
String entryPath = asEntryPath();
// XXX We only return the bytes of an entry in a JAR
Debug.assertTrue(entryPath != null);
JarFile jarFile = Pathname.getJarFile(device.car());
ZipFile jarFile = ZipCache.get(device.car());
Debug.assertTrue(jarFile != null);
// Is this a JAR within a JAR?
if (device.cdr() instanceof Cons) {
......@@ -1802,22 +1769,6 @@ public class Pathname extends LispObject {
return result;
}
// ### last-modified pathname => time-in-milliseconds
public static final Primitive LAST_MODIFIED
= new Primitive("LAST-MODIFIED", PACKAGE_EXT, true, "pathname",
"If PATHNAME exists, returns the last modified time in miliseconds since the UNIX epoch.")
{
@Override
public LispObject execute(LispObject arg) {
final Pathname p = coerceToPathname(arg);
if (p.isWild()) {
error(new FileError("Bad place for a wild pathname.", p));
}
long time = p.getLastModified();
return LispInteger.getInstance(time);
}
};
/** @return Time in milliseconds since the UNIX epoch at which the
* resource was last modified, or 0 if the time is unknown.
*/
......@@ -1839,23 +1790,26 @@ public class Pathname extends LispObject {
LispObject o = d.car();
if (o instanceof SimpleString) {
// 0. JAR from URL
URL u = makeJarURL(o.getStringValue());
URLConnection c = null;
try {
c = u.openConnection();
} catch(IOException e) {
Debug.trace("Failed to open Connection for URL "
+ "'" + u + "'");
return 0;
}
c.getLastModified();
// 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 JarEntry entry = getJarFile(device.car()).getJarEntry(entryPath);
final ZipEntry entry
= ZipCache.get(device.car()).getEntry(entryPath);
if (entry == null) {
return 0;
}
......@@ -1866,11 +1820,11 @@ public class Pathname extends LispObject {
return time;
}
} else {
JarFile outerJar = getJarFile(d.car());
ZipFile outerJar = ZipCache.get(d.car());
if (entryPath.length() == 0) {
// 4. JAR in JAR
String jarPath = ((Pathname)d.cdr()).asEntryPath();
final JarEntry entry = outerJar.getJarEntry(jarPath);
final ZipEntry entry = outerJar.getEntry(jarPath);
final long time = entry.getTime();
if (time == -1) {
return 0;
......@@ -1894,96 +1848,107 @@ public class Pathname extends LispObject {
return 0;
}
// ### mkdir
private static final Primitive MKDIR =
new Primitive("mkdir", PACKAGE_SYS, false) {
// ### mkdir pathname
private static final Primitive MKDIR = new mkdir();
private static class mkdir extends Primitive {
mkdir() {
super("mkdir", PACKAGE_SYS, false, "pathname");
}
@Override
public LispObject execute(LispObject arg) {
final Pathname pathname = coerceToPathname(arg);
if (pathname.isWild()) {
error(new FileError("Bad place for a wild pathname.", pathname));
}
Pathname defaultedPathname =
@Override
public LispObject execute(LispObject arg) {
final Pathname pathname = coerceToPathname(arg);
if (pathname.isWild()) {
error(new FileError("Bad place for a wild pathname.", pathname));
}
Pathname defaultedPathname =
mergePathnames(pathname,
coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
NIL);
File file = Utilities.getFile(defaultedPathname);
return file.mkdir() ? T : NIL;
}
};
coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
NIL);
File file = Utilities.getFile(defaultedPathname);
return file.mkdir() ? T : NIL;
}
}
// ### rename-file filespec new-name => defaulted-new-name, old-truename, new-truename
public static final Primitive RENAME_FILE =
new Primitive("rename-file", "filespec new-name") {
private static final Primitive RENAME_FILE = new rename_file();
private static class rename_file extends Primitive {
rename_file() {
super("rename-file", "filespec new-name");
}
@Override
public LispObject execute(LispObject first, LispObject second) {
final Pathname original = (Pathname) truename(first, true);
final String originalNamestring = original.getNamestring();
Pathname newName = coerceToPathname(second);
if (newName.isWild()) {
error(new FileError("Bad place for a wild pathname.", newName));
}
newName = mergePathnames(newName, original, NIL);
final String newNamestring;
if (newName instanceof LogicalPathname) {
newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname) newName).getNamestring();
} else {
newNamestring = newName.getNamestring();
}
if (originalNamestring != null && newNamestring != null) {
final File source = new File(originalNamestring);
final File destination = new File(newNamestring);
if (Utilities.isPlatformWindows) {
if (destination.isFile()) {
destination.delete();
}
}
if (source.renameTo(destination)) { // Success!
return LispThread.currentThread().setValues(newName, original,
truename(newName, true));
}
}
return error(new FileError("Unable to rename "
+ original.writeToString()
+ " to " + newName.writeToString()
+ "."));
}
}
@Override
public LispObject execute(LispObject first, LispObject second) {
final Pathname original = (Pathname) truename(first, true);
final String originalNamestring = original.getNamestring();
Pathname newName = coerceToPathname(second);
if (newName.isWild()) {
error(new FileError("Bad place for a wild pathname.", newName));
}
newName = mergePathnames(newName, original, NIL);
final String newNamestring;
if (newName instanceof LogicalPathname) {
newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname) newName).getNamestring();
} else {
newNamestring = newName.getNamestring();
}
if (originalNamestring != null && newNamestring != null) {
final File source = new File(originalNamestring);
final File destination = new File(newNamestring);
if (Utilities.isPlatformWindows) {
if (destination.isFile()) {
destination.delete();
}
}
if (source.renameTo(destination)) // Success!
{
return LispThread.currentThread().setValues(newName, original,
truename(newName, true));
}
}
return error(new FileError("Unable to rename "
+ original.writeToString()
+ " to " + newName.writeToString()
+ "."));
}
};
// ### file-namestring pathname => namestring
private static final Primitive FILE_NAMESTRING =
new Primitive("file-namestring", "pathname") {
private static final Primitive FILE_NAMESTRING = new file_namestring();
private static class file_namestring extends Primitive {
file_namestring() {
super("file-namestring", "pathname");
}
@Override
public LispObject execute(LispObject arg) {
Pathname p = coerceToPathname(arg);
StringBuilder sb = new StringBuilder();
if (p.name instanceof AbstractString) {
sb.append(p.name.getStringValue());
} else if (p.name == Keyword.WILD) {
sb.append('*');
} else {
return NIL;
}
if (p.type instanceof AbstractString) {
sb.append('.');
sb.append(p.type.getStringValue());
} else if (p.type == Keyword.WILD) {
sb.append(".*");
}
return new SimpleString(sb);
}
}
@Override
public LispObject execute(LispObject arg) {
Pathname p = coerceToPathname(arg);
StringBuilder sb = new StringBuilder();
if (p.name instanceof AbstractString) {
sb.append(p.name.getStringValue());
} else if (p.name == Keyword.WILD) {
sb.append('*');
} else {
return NIL;
}
if (p.type instanceof AbstractString) {
sb.append('.');
sb.append(p.type.getStringValue());
} else if (p.type == Keyword.WILD) {
sb.append(".*");
}
return new SimpleString(sb);
}
};
// ### host-namestring pathname => namestring
private static final Primitive HOST_NAMESTRING =
new Primitive("host-namestring", "pathname") {
@Override
public LispObject execute(LispObject arg) {
return coerceToPathname(arg).host;
}
};
private static final Primitive HOST_NAMESTRING = new host_namestring();
private static class host_namestring extends Primitive {
host_namestring() {
super("host-namestring", "pathname");
}
@Override
public LispObject execute(LispObject arg) {
return coerceToPathname(arg).host;
}
}
public String toString() {
return getNamestring();
......
......@@ -229,7 +229,7 @@ public final class Utilities
}
}
static InputStream getInputStream(JarFile jarFile, Pathname inner) {
static InputStream getInputStream(ZipFile jarFile, Pathname inner) {
String entryPath = inner.asEntryPath();
ZipEntry entry = jarFile.getEntry(entryPath);
if (entry == null) {
......
/*
* ZipCache.java
*
* Copyright (C) 2003-2007 Peter Graves
* $Id: Pathname.java 12435 2010-02-09 15:42:58Z 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, 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.IOException;
import java.net.JarURLConnection;
import java.net.MalformedURLException;
import java.net.URL;
import java.net.URLConnection;
import java.util.HashMap;
import java.util.zip.ZipException;
import java.util.zip.ZipFile;
/**
* A cache for all zip/jar file accesses by URL that uses the last
* modified time of the cached resource.
*/
public class ZipCache {
static class Entry {
long lastModified;
ZipFile file;
}
static HashMap<URL, Entry> zipCache = new HashMap<URL, Entry>();
public static ZipFile get(LispObject arg) {
return get(Pathname.makeURL(arg));
}
public static ZipFile get(URL url) {
Entry entry = zipCache.get(url);
if (entry != null) {
if (url.getProtocol().equals("file")) {
File f = new File(url.getPath());
long current = f.lastModified();
if (current > entry.lastModified) {
try {
entry.file.close();
entry.file = new ZipFile(f);
entry.lastModified = current;
} catch (IOException e) {
Debug.trace(e.toString()); // XXX
}
}
} else {
// Unfortunately, the Apple JDK under OS X doesn't do
// HTTP HEAD requests, instead refetching the entire
// resource, so the following code is a waste. I assume
// this is the case in all Sun-dervied JVMs. We'll have
// to implement a custom HTTP lastModified checker.
// URLConnection connection;
// try {
// connection = url.openConnection();
// } catch (IOException ex) {
// Debug.trace("Failed to open "
// + "'" + url + "'");
// return null;
// }
// long current = connection.getLastModified();
// if (current > entry.lastModified) {
// try {
// entry.file.close();
// } catch (IOException ex) {}
// entry = fetchURL(url, false);
// }
}
} else {
if (url.getProtocol().equals("file")) {
entry = new Entry();
File f = new File(url.getPath());
entry.lastModified = f.lastModified();
try {
entry.file = new ZipFile(f);
} catch (ZipException e) {
Debug.trace(e); // XXX
return null;
} catch (IOException e) {
Debug.trace(e); // XXX
return null;
}
} else {
entry = fetchURL(url, true);
}
zipCache.put(url, entry);
}
return entry.file;
}
static private Entry fetchURL(URL url, boolean cached) {
Entry result = new Entry();
URL jarURL = null;
try {
jarURL = new URL("jar:" + url + "!/");
} catch (MalformedURLException e) {
Debug.trace(e);
Debug.assertTrue(false); // XXX
}
URLConnection connection;
try {
connection = jarURL.openConnection();
} catch (IOException ex) {
Debug.trace("Failed to open "
+ "'" + jarURL + "'");
return null;
}
if (!(connection instanceof JarURLConnection)) {
// XXX
Debug.trace("Could not get a URLConnection from " + jarURL);
return null;
}
JarURLConnection jarURLConnection = (JarURLConnection) connection;
jarURLConnection.setUseCaches(cached);
try {
result.file = jarURLConnection.getJarFile();
} catch (IOException e) {
Debug.trace(e);
Debug.assertTrue(false); // XXX
}
result.lastModified = jarURLConnection.getLastModified();
return result;
}
// ## remove-zip-cache-entry pathname => boolean
private static final Primitive REMOVE_ZIP_CACHE_ENTRY = new remove_zip_cache_entry();
private static class remove_zip_cache_entry extends Primitive {
remove_zip_cache_entry() {
super("remove-zip-cache-entry", PACKAGE_SYS, true, "pathname");
}
@Override
public LispObject execute(LispObject arg) {
Pathname p = coerceToPathname(arg);
URL url = Pathname.makeURL(p);
boolean result = ZipCache.remove(url);
return result ? T : NIL;
}
}
public static boolean remove(URL url) {
Entry entry = zipCache.get(url);
if (entry != null) {
try {
entry.file.close();
} catch (IOException e) {}
zipCache.remove(entry);
return true;
}
return false;
}
}
\ No newline at end of file
......@@ -567,6 +567,7 @@ interpreted toplevel form, non-NIL if it is 'simple enough'."
while (not (eq line :eof))
do (write-line line out))))
(delete-file temp-file)
(remove-zip-cache-entry output-file) ;; Necessary under windows
(rename-file temp-file2 output-file)
(when *compile-file-zip*
......
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