(FILECREATED " 3-Sep-86 18:30:11" {PHYLUM}<LANNING>FILECACHE>FILECACHE.;28 152838
changes to: (VARS FILECACHECOMS)
(FNS FCACHE.EXPUNGE.DELETED.FILES FCACHE.DUMP FCACHE.RECOVER.DELETED.FILE
\FCACHE.HOSTUP? \FCACHE.DELETE.ENTRY \FCACHE.DELETE.ENTRY.FROM.LIST
\FCACHE.DELETEFILE \FCACHE.MAKEROOM FCACHE.EXPUNGE.DELTETED.FILES
\FCACHE.EXPUNGE.DELETED.ENTRY \FCACHE.INITIALIZE \FCACHE.GENERATE.FILEINFO
\FCACHE.VERIFY \FCACHE.FILEMATCH? \FCACHE.WRITEOUT.NEWFILENAME
\FCACHE.USELOCALDIRECTORY? \FCACHE.IGNOREDATECHECK?)
previous date: "30-Jul-86 18:55:05" {PHYLUM}<LANNING>FILECACHE>FILECACHE.;23)
(* Copyright (c) 1983, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILECACHECOMS)
(RPAQQ FILECACHECOMS [(* * The FileCache package, here before your eyes! * *)
(COMS (* * Public functions for manipulating the cache)
(FNS ADD.FILE.TO.CACHE? CACHE.FILE FCACHE.DELETE.CACHE.ENTRY FCACHE.DUMP.ALL
FCACHE.EXPUNGE.DELETED.FILES FCACHE.GENERIC.START FCACHE.GENERIC.STOP
FCACHE.GETPROP FCACHE.PRIVATE.FILE? FCACHE.PUTPROP FCACHE.RECOVER.DELETED.FILE
FCACHE.START FCACHE.STOP FCACHE.CACHELIST FCACHE.DIRTY? FCACHE.DUMP.FILE
FCACHE.DUMP)
(PROP SETFN FCACHE.GETPROP)
(TEMPLATES FCACHE.GETPROP FCACHE.PUTPROP)
(INITVARS (FCACHE.GENERIC.DEVICE.TYPES (QUOTE (LEAF NSFILING)))
(DON'T.CACHE.FILES NIL)
(PRIVATE.FILES NIL))
(ADDVARS (GLOBALVARS *FILE-CACHE-MESSAGE-STREAM* DON'T.CACHE.FILES PRIVATE.FILES
FCACHE.DEAD.HOSTS FCACHE.GENERIC.DEVICE.TYPES FCACHE.VERSION.DATE
FCACHE.VERSION.NUMBER)))
(COMS (* * Was public, but now isn't advertised)
(MACROS WITHOUT.FCACHE)
(PROP ARGNAMES WITHOUT.FCACHE))
(COMS (* * Status messages to the user)
(FNS \FCACHE.DONE.OR.ABORTED.MSG \FCACHE.PRINT.MESSAGE?)
(INITVARS (*FILE-CACHE-MESSAGE-STREAM* PROMPTWINDOW)))
(COMS (* * Unscheduled user interaction stuff)
(FNS \FCACHE.PRINT.PROMPT \FCACHE.CREATE.MSG.WINDOW)
(DECLARE: DONTCOPY (MACROS WITH.FCACHE.ABORT.WINDOW))
(INITVARS (\ABORT.WINDOW.LOCK (CREATE.MONITORLOCK (QUOTE \ABORT.WINDOW.LOCK)))
(\ABORT.WINDOW.LEFT 350)
(\ABORT.WINDOW.BOTTOM 200)
(\ABORT.WINDOW.WIDTH 425)
(\ABORT.WINDOW.HEIGHT 150)
(\FREE.ABORT.WINDOWS NIL)))
(COMS (* * Functions for producing the device given the name)
(FNS \GETUSERDEVICEFROMNAME \GETCACHEDEVICEFROMHOSTNAME \GETREALDEVICEFROMHOSTNAME
\FCACHE.CANONICAL.HOSTNAME \FCACHE.GENERIC.DEVICE.TYPE))
(COMS (* * Functions for loading or removing a file into the cache)
(FNS \FCACHE.DELETE.ENTRY \FCACHE.EXPUNGE.DELETED.ENTRY \FCACHE.INVENTNAME
\FCACHE.KEEPVERSIONS \FCACHE.LOAD \FCACHE.MAKE.LEGAL.FILENAME \FCACHE.MAKEROOM
\FCACHE.MAKEROOM.DELETEABLE?)
(INITVARS (\FCACHE.CACHELOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.CACHELOCK)))
(\FCACHE.CACHE.CHANGED.EVENT (CREATE.EVENT (QUOTE FCACHE.CHANGED)))
(\FCACHE.CACHING.FILES NIL)
(\FCACHE.DELETED.ENTRIES NIL)
(\FCACHE.LIST NIL)
(\FCACHE.LIST.CHANGED? NIL)
(\FCACHE.LOGFILE NIL)))
(COMS (* * Functions for creating or destroying a cache device)
(FNS \FCACHE.BUILD.DEVICE \FCACHE.OFF))
(COMS (* * Functions for dealing with device events, like LOGOUT)
(FNS \FCACHE.DEVICE.EVENTFN \FCACHE.INITIALIZE.PROPS)
(DECLARE: DONTCOPY (MACROS \FCACHE.CANT.DUMP.BREAK))
(* KLUDGE: Make sure the cache devices are at the top of the list of known devices
before we do any device event)
(FNS \FCACHE.GLOBAL.EVENT)
(APPENDVARS (AROUNDEXITFNS \FCACHE.GLOBAL.EVENT))
(* Before revalidating files, load the LOG file, if any -- in other words, a big HACK)
(FNS \FCACHE.AROUNDEXIT))
(COMS (* * Catch changes to the current user / password)
(* This is a HACK)
(FNS \FCACHE.BEFORELOGIN \FCACHE.ADVISED.LOGIN)
(ADDVARS (\BEFORELOGINFNS \FCACHE.BEFORELOGIN)))
(COMS (* * Methods for the {FCACHE} file device. Note that methods that are not defined are
not really needed since {FCACHE} is a specialization of the local device that holds
the cache, and inherits all bin/bout like methods)
(FNS \FCACHE.CLOSEFILE \FCACHE.DELETEFILE \FCACHE.DIRECTORYNAMEP \FCACHE.EVENTFN
\FCACHE.GENERATEFILES \FCACHE.GETFILEINFO \FCACHE.GETFILENAME \FCACHE.HOSTNAMEP
\FCACHE.OPENFILE \FCACHE.RENAMEFILE \FCACHE.REOPENFILE \FCACHE.SETFILEINFO)
(* Helper fns)
(FNS \FCACHE.ENTRYINFO))
(COMS (* * Directory enumeration functions)
(FNS \FCACHE.GENERATE.FILEINFO \FCACHE.GENERATE.FILES.DEPTH
\FCACHE.GENERATE.LOCAL.FILES \FCACHE.NEXT.LOCAL.FILE)
(DECLARE: DONTCOPY (RECORDS LocalFileGenerator)))
(COMS (* * Functions for finding a file in the cache)
(FNS \FCACHE.LOOKUP \FCACHE.PROMOTE \FCACHE.USECACHE? \FCACHE.VERIFY)
(MACROS MatchFileName))
(COMS (* * Try to figure out if a host is up)
(FNS \FCACHE.HOSTUP? \NSFILING.ADDRESS \FCACHE.IGNOREDATECHECK?
\FCACHE.USELOCALDIRECTORY? \FCACHE.HOSTDEAD.WHENSELECTEDFN)
(INITVARS (FCACHE.DEAD.HOSTS NIL)))
(COMS (* * Functions for dealing with overflow of the cache)
(FNS \FCACHE.RESOURCES.ERROR))
[COMS (* * Functions for writing out dirty files from the cache)
(FNS \FCACHE.ENTRYOPEN? \FCACHE.FLUSH \FCACHE.WRITEOUT \FCACHE.WRITEOUT.NEWFILENAME
\FCACHE.WRITEOUT.READNEWFILENAME \FCACHE.WRITEOUT.WHENSELECTEDFN)
(VARS (\FCACHE.DUMPLOCK (CREATE.MONITORLOCK "File cache writout"]
(COMS (* * Functions for dumping and restoring information about the contents of the cache)
(FNS \FCACHE.ADDENTRY \FCACHE.DUMP.ENTRY \FCACHE.FILEMATCH? \FCACHE.LOGENTRY
\FCACHE.RESTORE \FCACHE.RESTORE.ENTRY)
(VARS (\FCACHE.DIR.READTABLE (COPYREADTABLE (QUOTE ORIG)))
(\FCACHE.LISTING.VERSION.NUMBER NIL)))
(COMS (* * Data access functions)
(FNS \FCACHE.DEVINFO \FCACHE.PUT.DEVINFO)
(ADDVARS (\SYSTEMCACHEVARS \FCACHE.LOCALDEVICE))
(INITVARS (\FCACHE.LOCALDEVICE NIL)
(\FCACHE.PROPERTIES (QUOTE (USECACHE T DEVICES NIL PREFIX NIL SIZE 0 MAXSIZE
10000 MAXFILEPAGES 600 UNSAFE ASK
UNSAFE.TIMEOUT 30 UNSAFE.DEFAULT NIL
TRUST.CACHELIST NIL SILENT NIL DUMPSLEEP
60000 DUMPIDLE 20 FASTDIR NIL
DELAY.DELETE NIL KEEPVERSIONS 2
TIMETOVERIFY 5 BADDEVICES NIL)))
(\FCACHE.PROMPT.WINDOW (CREATEW (CREATEREGION 200 200 500 100)
"File cache prompt window" 15 T))
(\FCACHE.GENERIC.DEVICES NIL)))
(* * Declarations and the like)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS REALDEVOP)
(FILES FILECACHE-DECLS)
DONTEVAL@LOAD
(FILES NSFILING LLNS))
(DECLARE: DONTEVAL@LOAD DOCOPY DONTEVAL@COMPILE (INITRECORDS CACHENTRY))
(* * Related files)
(FILES FILECACHE-BROWSER FILECACHE-SCAVENGE MERGE-FILEGEN)
(* * Initialize things)
(FNS \FCACHE.INITIALIZE FCACHE.VANQUISH)
[COMS * (BQUOTE ((VARS (FCACHE.VERSION.DATE , (DATE))
(FCACHE.VERSION.NUMBER 5.3]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\FCACHE.INITIALIZE])
(* * The FileCache package, here before your eyes! * *)
(* * Public functions for manipulating the cache)
(DEFINEQ
(ADD.FILE.TO.CACHE?
[LAMBDA (fileName) (* smL "30-Jan-86 17:06")
(* * Should the file be added to the cache?)
(NOT (for fileSpec in DON'T.CACHE.FILES thereis (\FCACHE.FILEMATCH? fileName
(
DIRECTORY.FILL.PATTERN
fileSpec "" "*"])
(CACHE.FILE
[LAMBDA (fileName) (* smL "11-Feb-86 18:58")
(* * Load the file into the cache)
(RESETLST (LET ((fullName (INFILEP fileName)))
(if (NULL fullName)
then NIL
elseif (\FCACHE.LOAD fullName)
then fullName
else NIL])
(FCACHE.DELETE.CACHE.ENTRY
[LAMBDA (fileName) (* smL "11-Feb-86 18:54")
(* * Delete the cache entry for the given file)
(LET ((fullName (FINDFILE fileName)))
(if fullName
then (RESETLST (LET ((entry (\FCACHE.LOOKUP (\GETUSERDEVICEFROMNAME fullName)
fullName)))
(if entry
then (\FCACHE.DELETE.ENTRY entry)
else NIL)))
else NIL])
(FCACHE.DUMP.ALL
[LAMBDA NIL (* smL " 8-Jul-86 16:54")
(* * Cause an immediate flush of all dirty files)
(ALLOW.BUTTON.EVENTS)
(FCACHE.DUMP T)
(LET ((msgStream (if (OPENWP *FILE-CACHE-MESSAGE-STREAM*)
then *FILE-CACHE-MESSAGE-STREAM*
else PROMPTWINDOW)))
(printout msgStream T "Done writing out cache"])
(FCACHE.EXPUNGE.DELETED.FILES
[LAMBDA NIL (* smL " 3-Sep-86 15:01")
(* * Expunge all the deleted files from the cache)
(while \FCACHE.DELETED.ENTRIES do (\FCACHE.EXPUNGE.DELETED.ENTRY (CAR
\FCACHE.DELETED.ENTRIES])
(FCACHE.GENERIC.START
[LAMBDA (deviceType) (* smL " 4-Feb-86 12:58")
(* * remember that cache devices for this device are to be created on the fly)
(DECLARE (GLOBALVARS \FILEDEVICES))
(LET [(genericDevice (for dev in \FILEDEVICES thereis (EQ (fetch DEVICENAME
of dev)
(U-CASE deviceType]
(if (NULL genericDevice)
then NIL
else (* Make this undoable)
(UNDOSAVE (LIST (FUNCTION FCACHE.GENERIC.STOP)
deviceType))
(pushnew \FCACHE.GENERIC.DEVICES genericDevice)
(for dev in \FILEDEVICES when (EQ (U-CASE deviceType)
(\FCACHE.GENERIC.DEVICE.TYPE dev))
do (FCACHE.START (fetch DEVICENAME of dev)))
genericDevice])
(FCACHE.GENERIC.STOP
[LAMBDA (deviceType) (* smL "12-Aug-85 11:48")
(* * undo the effect of an FCACHE.GENERIC.START)
(DECLARE (GLOBALVARS \FILEDEVICES))
(LET [(device (for dev in \FILEDEVICES thereis (EQ (fetch DEVICENAME of dev)
(U-CASE deviceType]
(if (NULL device)
then NIL
else (SETQ \FCACHE.GENERIC.DEVICES (DREMOVE device \FCACHE.GENERIC.DEVICES))
device])
(FCACHE.GETPROP
[LAMBDA (name) (* smL " 7-Jul-86 15:11")
(* * Public function for getting file cache properties)
(SELECTQ name
(DEAD.HOSTS FCACHE.DEAD.HOSTS)
(ENTRIES (LENGTH \FCACHE.LIST))
(DEVICES (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
collect (fetch REALDEVICENAME of info)))
(DUMPSLEEP (QUOTIENT (\FCACHE.PROPERTY name)
1000))
(\FCACHE.PROPERTY name])
(FCACHE.PRIVATE.FILE?
[LAMBDA (fullName) (* smL " 9-Aug-85 14:06")
(* * Is this a private file)
(for fileSpec in PRIVATE.FILES thereis (\FCACHE.FILEMATCH? fullName (DIRECTORY.FILL.PATTERN
fileSpec "" "*"])
(FCACHE.PUTPROP
[LAMBDA (name value) (* smL " 7-Jul-86 15:12")
(* * Public function for setting file cache properties)
(SELECTQ name
(DEAD.HOSTS (SETQ FCACHE.DEAD.HOSTS value))
((DEVICES ENTRIES)
(ERROR "Can't set that cache property " name))
[PREFIX (SETQ value (MKATOM value))
(if (for entry in \FCACHE.LIST thereis (NOT (\FCACHE.WRITEOUT
entry)))
then (ERROR "Can't flush a file, so can't switch cache prefix")
else (FCACHE.DUMP T)
(if (\FCACHE.RESTORE value)
then (* update the cache devices)
(for devInfo in (\FCACHE.PROPERTY (QUOTE DEVICES))
do (\FCACHE.EVENTFN (fetch CACHEDEV of devInfo)
(QUOTE AFTERLOGOUT)))
(* update the pointer file)
(RESETLST (RESETSAVE (SETREADTABLE
\FCACHE.DIR.READTABLE))
(LET [(file (OPENSTREAM (QUOTE
{DSK}FCache.pointer;1)
(QUOTE OUTPUT)
(QUOTE OLD/NEW]
(PRINT value file)
(CLOSEF file)))
else (ERROR "Bad prefix " value]
((MAXSIZE MAXFILEPAGES UNSAFE.TIMEOUT TIMETOVERIFY)
(if (NUMBERP value)
then (SETQ \FCACHE.LIST.CHANGED? T)
(\FCACHE.PROPERTY.PUT name value)
else (ERROR "Value not a number" value)))
(DUMPSLEEP (\FCACHE.PROPERTY.PUT name (TIMES value 1000)))
[BADDEVICES (\FCACHE.PROPERTY.PUT name (for devName in value
join (MKLIST (
\FCACHE.CANONICAL.HOSTNAME
devName]
(\FCACHE.PROPERTY.PUT name value))
value])
(FCACHE.RECOVER.DELETED.FILE
[LAMBDA NIL (* smL " 3-Sep-86 18:29")
(* * Recover a deleted file from the cache. Let the user select the file from a menu of all available deleted
files.)
(WITH.MONITOR
\FCACHE.CACHELOCK
(LET ((msgStream (if (OPENWP *FILE-CACHE-MESSAGE-STREAM*)
then *FILE-CACHE-MESSAGE-STREAM*
else PROMPTWINDOW)))
(if \FCACHE.DELETED.ENTRIES
then (LET [(entry (MENU (create
MENU
TITLE ← "Recover which file?"
ITEMS ←(for entry in \FCACHE.DELETED.ENTRIES
collect
(BQUOTE
([\, (PACKFILENAME.STRING
(QUOTE NAME)
(FILENAMEFIELD (fetch
REMOTEFILENAME
of entry)
(QUOTE NAME))
(QUOTE EXTENSION)
(FILENAMEFIELD (fetch
REMOTEFILENAME
of entry)
(QUOTE EXTENSION))
(QUOTE VERSION)
(FILENAMEFIELD (fetch
REMOTEFILENAME
of entry)
(QUOTE VERSION]
(QUOTE (\, entry))
(\, (CONCAT "Recover file "
(fetch REMOTEFILENAME
of entry)
" dated "
(GDATE (fetch
CACHEFILEDATE
of entry]
(if (NULL entry)
then (printout msgStream T "No file selected for recovery.")
elseif (NULL (FULLNAME (fetch LOCALFILENAME of entry)
(QUOTE OLD)))
then (\FCACHE.EXPUNGE.DELETED.ENTRY entry)
(printout msgStream T "Sorry, the file " (fetch
REMOTEFILENAME
of entry)
" cannot be recovered.")
else (change (fetch CACHEISDIRTY of entry)
T)
(change (fetch FILEXISTED of entry)
NIL)
(change \FCACHE.DELETED.ENTRIES (DREMOVE entry DATUM))
(push \FCACHE.LIST entry)
(printout msgStream T "File " (fetch REMOTEFILENAME
of entry)
" recovered.")))
else (printout msgStream T "No deleted files to recover."])
(FCACHE.START
[LAMBDA (devname) (* smL " 7-Jul-86 18:29")
(* * Turn on caching for the given device)
(if (NULL (\FCACHE.PROPERTY (QUOTE PREFIX)))
then (printout *FILE-CACHE-MESSAGE-STREAM* T "[No cache prefix, so can't start cache for "
devname "]")
NIL
else (LET ((canonicalName (\FCACHE.CANONICAL.HOSTNAME devname)))
(if (NULL canonicalName)
then (printout *FILE-CACHE-MESSAGE-STREAM* T "[No such host " devname "]")
NIL
elseif (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
canonicalName))
elseif (MEMB (GETHOSTINFO canonicalName (QUOTE OS))
(QUOTE (UNIX)))
then (* can't work with UNIX hosts.
Sorry.)
NIL
else (LET ((cacheDevice (\FCACHE.BUILD.DEVICE canonicalName)))
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"[Creating cache device for host "
canonicalName "]"))
(replace CACHEDEVINFO of cacheDevice
with (create CACHEDEVINFO
CACHEDEV ← cacheDevice
REALDEVICENAME ← canonicalName))
(\DEFINEDEVICE (PACK* canonicalName (QUOTE -CACHE))
cacheDevice)
(* Make this UNDOable)
(if (NOT (FIND.PROCESS (QUOTE DUMP-FCACHE)))
then (ADD.PROCESS (QUOTE (\FCACHE.FLUSH))
(QUOTE NAME)
(QUOTE DUMP-FCACHE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE INFOHOOK)
(QUOTE \FCACHE.FLUSH.INFOHOOK)))
(UNDOSAVE (LIST (FUNCTION FCACHE.STOP)
canonicalName))
(change (FCACHE.GETPROP (QUOTE BADDEVICES))
(DREMOVE canonicalName DATUM))
cacheDevice])
(FCACHE.STOP
[LAMBDA (devname) (* smL "14-Aug-85 14:01")
(* * Turn off caching for the given device)
(DECLARE (GLOBALVARS \OPENFILES))
(LET ((dev (\GETCACHEDEVICEFROMHOSTNAME devname T T))
stream entry)
(if (NULL dev)
then (* not turned on)
NIL
elseif [SETQ stream (for stream in \OPENFILES thereis (AND (EQ dev (fetch DEVICE
of stream))
(STREAMPROP stream (QUOTE
cacheEntry]
then (* there is an open stream on the cache, so you can't
turn off that device)
(ERROR "Can't turn off cache -- file is open " (fetch FULLFILENAME of stream))
elseif [SETQ entry (for entry in \FCACHE.LIST
thereis (AND (EQ dev (\GETCACHEDEVICEFROMHOSTNAME (FILENAMEFIELD
(fetch
REMOTEFILENAME
of entry)
(QUOTE HOST))
T T))
(NOT (\FCACHE.WRITEOUT entry]
then (* can't flush a file on that device)
(ERROR "Can't turn off cache because I can't write out the file "
(fetch REMOTEFILENAME of entry))
else (* really can turn off caching)
(pushnew (FCACHE.GETPROP (QUOTE BADDEVICES))
devname)
(\FCACHE.OFF dev])
(FCACHE.CACHELIST
[LAMBDA NIL (* smL "26-Apr-85 14:58")
(* * What files are cached for this device)
(for entry in \FCACHE.LIST collect (fetch REMOTEFILENAME of entry])
(FCACHE.DIRTY?
[LAMBDA (fileName) (* smL "11-Feb-86 18:54")
(* * Is the entry for this file dirty?)
(RESETLST (LET ((entry (\FCACHE.LOOKUP (\GETCACHEDEVICEFROMHOSTNAME (FILENAMEFIELD
fileName
(QUOTE HOST)))
fileName T)))
(if entry
then (fetch CACHEISDIRTY of entry)
else NIL])
(FCACHE.DUMP.FILE
[LAMBDA (fileName) (* smL "11-Feb-86 18:55")
(* * Flush a single file to the server)
(RESETLST (LET ((entry (\FCACHE.LOOKUP (\GETCACHEDEVICEFROMHOSTNAME (FILENAMEFIELD
fileName
(QUOTE HOST)))
fileName T)))
(if (AND entry (fetch CACHEISDIRTY of entry)
(NOT (\FCACHE.ENTRYOPEN? entry)))
then (\FCACHE.WRITEOUT entry)
fileName
else NIL])
(FCACHE.DUMP
[LAMBDA (onlyIfChanged) (* smL " 3-Sep-86 18:03")
(* * Dump out the cache info)
(* always dump out dirty files)
(WITH.MONITOR \FCACHE.DUMPLOCK [if (\FCACHE.PROPERTY (QUOTE PREFIX))
then (for entry in \FCACHE.LIST
do (if (NOT (\FCACHE.WRITEOUT entry))
then
(* could not dump the file, so warn the user)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout
*FILE-CACHE-MESSAGE-STREAM* T
"[Could not dump the file "
(fetch
REMOTEFILENAME
of entry)
"]"]
(* Expunge any deleted files from the cache)
(FCACHE.EXPUNGE.DELETED.FILES)
(if (AND onlyIfChanged (NOT \FCACHE.LIST.CHANGED?))
then (* nothing changed, so don't bother to dump)
NIL
elseif (\FCACHE.PROPERTY (QUOTE PREFIX))
then (RESETLST
(\FCACHE.DONE.OR.ABORTED.MSG "Dumping cache listing")
(LET [(stream (OPENSTREAM (PACK* (\FCACHE.PROPERTY (QUOTE PREFIX)
)
"FCache.Listing;1")
(QUOTE OUTPUT)
(QUOTE OLD/NEW]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
stream))
(* Put a warning message at the head of the info file)
(PRINT [BQUOTE (ERROR
"This file cannot be LOADed. Do not delete or alter this file!"
(QUOTE (FCacheVersion
, FCACHE.VERSION.NUMBER
MaxSize ,
(\FCACHE.PROPERTY
(QUOTE MAXSIZE))
MaxFilePages ,
(\FCACHE.PROPERTY
(QUOTE MAXFILEPAGES]
stream)
(for f in \FCACHE.LIST
do (\FCACHE.DUMP.ENTRY f stream)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* ".")
(FORCEOUTPUT *FILE-CACHE-MESSAGE-STREAM*)))
(* Print out a little msg so we can tell if the whole
file got written out.)
(PRINT (QUOTE STOP)
stream)
(CLOSEF? stream))
(if (AND (STREAMP \FCACHE.LOGFILE)
(OPENP \FCACHE.LOGFILE))
then (replace USERCLOSEABLE of \FCACHE.LOGFILE with T)
(DELFILE (CLOSEF \FCACHE.LOGFILE))
(SETQ \FCACHE.LOGFILE NIL))
(SETQ \FCACHE.LIST.CHANGED? NIL])
)
(PUTPROPS FCACHE.GETPROP SETFN FCACHE.PUTPROP)
(SETTEMPLATE (QUOTE FCACHE.GETPROP)
(QUOTE (EVAL PROP . PPE)))
(SETTEMPLATE (QUOTE FCACHE.PUTPROP)
(QUOTE (EVAL PROP EVAL . PPE)))
(RPAQ? FCACHE.GENERIC.DEVICE.TYPES (QUOTE (LEAF NSFILING)))
(RPAQ? DON'T.CACHE.FILES NIL)
(RPAQ? PRIVATE.FILES NIL)
(ADDTOVAR GLOBALVARS *FILE-CACHE-MESSAGE-STREAM* DON'T.CACHE.FILES PRIVATE.FILES FCACHE.DEAD.HOSTS
FCACHE.GENERIC.DEVICE.TYPES FCACHE.VERSION.DATE
FCACHE.VERSION.NUMBER)
(* * Was public, but now isn't advertised)
(DECLARE: EVAL@COMPILE
[PUTPROPS WITHOUT.FCACHE MACRO (...forms (BQUOTE (RESETLST [RESETSAVE (FCACHE.PUTPROP (QUOTE USECACHE)
NIL)
(LIST (QUOTE FCACHE.PUTPROP)
(QUOTE USECACHE)
(FCACHE.GETPROP
(QUOTE USECACHE]
,@ ...forms]
)
(PUTPROPS WITHOUT.FCACHE ARGNAMES (form1 ... formN))
(* * Status messages to the user)
(DEFINEQ
(\FCACHE.DONE.OR.ABORTED.MSG
[LAMBDA (entermsg) (* smL "11-Feb-86 18:21")
(* * Printout the entermsg when starting, then printout a "done" or "aborted" message in the FCache message window,
depending how we are unwinding. Assumes we are inside of a RESETLST)
(if (\FCACHE.PRINT.MESSAGE?)
then (RESETSAVE (printout *FILE-CACHE-MESSAGE-STREAM* T "[" entermsg "]")
(LIST (FUNCTION [LAMBDA (msg)
(printout *FILE-CACHE-MESSAGE-STREAM* T "["
(if RESETSTATE
then "Aborted"
else "Done")
": " msg "]"])
entermsg])
(\FCACHE.PRINT.MESSAGE?
[LAMBDA NIL (* smL " 6-Feb-86 16:26")
(* * Is printing to the file cache message stream enabled?)
(AND *FILE-CACHE-MESSAGE-STREAM* (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
(if (WINDOWP *FILE-CACHE-MESSAGE-STREAM*)
then (OPENWP *FILE-CACHE-MESSAGE-STREAM*)
elseif (STREAMP *FILE-CACHE-MESSAGE-STREAM*)
then (OPENP *FILE-CACHE-MESSAGE-STREAM* (QUOTE OUTPUT))
else NIL])
)
(RPAQ? *FILE-CACHE-MESSAGE-STREAM* PROMPTWINDOW)
(* * Unscheduled user interaction stuff)
(DEFINEQ
(\FCACHE.PRINT.PROMPT
[LAMBDA (window msgsLines) (* smL "10-Feb-86 18:07")
(* * Clears the windows promptwindow and prints the msgs to it. If the promptwindow isn't big enough, makes it grow
grow. Return the prompt window.)
(LET* [(pwindow (GETPROMPTWINDOW (MAINWINDOW window T)))
(font (DSPFONT NIL pwindow))
(width (WINDOWPROP pwindow (QUOTE WIDTH]
[SETQ pwindow (GETPROMPTWINDOW (MAINWINDOW window T)
(for line in msgsLines
sum (FIX (PLUS .9 (FQUOTIENT (STRINGWIDTH
line font)
width]
(CLEARW pwindow)
(for line in msgsLines do (printout pwindow T line))
pwindow])
(\FCACHE.CREATE.MSG.WINDOW
[LAMBDA NIL (* smL "13-Mar-86 14:16")
(* * Create a new window to display an error msg from the cacher)
(CREATEW (CREATEREGION 550 100 450 300)
"FileCache ERROR" 10])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(DEFMACRO WITH.FCACHE.ABORT.WINDOW (windowVar &REST forms)
(* * Evaluate the forms with the windowVar bound to an unused abort window - Note that this
assumes it is operating within a RESETLST)
(BQUOTE (LET [(, windowVar (WITH.MONITOR \ABORT.WINDOW.LOCK
(OR (pop \FREE.ABORT.WINDOWS)
(PROGN (SETQ \ABORT.WINDOW.LEFT
(MAX 0 (DIFFERENCE
\ABORT.WINDOW.LEFT 20))
)
(SETQ \ABORT.WINDOW.BOTTOM
(MAX 0 (DIFFERENCE
\ABORT.WINDOW.BOTTOM 20))
)
(CREATEW (CREATEREGION
\ABORT.WINDOW.LEFT
\ABORT.WINDOW.BOTTOM
\ABORT.WINDOW.WIDTH
\ABORT.WINDOW.HEIGHT)
NIL NIL T]
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (abortWindow)
(WINDOWPROP abortWindow (QUOTE TITLE)
NIL)
(for menu in (WINDOWPROP abortWindow
(QUOTE MENU))
do
(DELETEMENU menu NIL abortWindow))
(CLEARW abortWindow)
(CLOSEW abortWindow)
(push \FREE.ABORT.WINDOWS abortWindow])
, windowVar))
,@ forms)))
)
)
(RPAQ? \ABORT.WINDOW.LOCK (CREATE.MONITORLOCK (QUOTE \ABORT.WINDOW.LOCK)))
(RPAQ? \ABORT.WINDOW.LEFT 350)
(RPAQ? \ABORT.WINDOW.BOTTOM 200)
(RPAQ? \ABORT.WINDOW.WIDTH 425)
(RPAQ? \ABORT.WINDOW.HEIGHT 150)
(RPAQ? \FREE.ABORT.WINDOWS NIL)
(* * Functions for producing the device given the name)
(DEFINEQ
(\GETUSERDEVICEFROMNAME
[LAMBDA (name noError? dontCreate?) (* smL "16-Aug-85 16:04")
(* * Replaces the function \GETDEVICEFROMNAME so that generic file system code will go thru the cache)
(OR [if (AND (OR (LITATOM name)
(STRINGP name))
(\FCACHE.PROPERTY (QUOTE USECACHE))
(\FCACHE.PROPERTY (QUOTE PREFIX)))
then (LET ((hostName (OR (FILENAMEFIELD name (QUOTE HOST))
name)))
(OR (\GETCACHEDEVICEFROMHOSTNAME hostName T dontCreate?)
(\GETREALDEVICEFROMHOSTNAME hostName dontCreate? (\GETCACHEDEVICEFROMHOSTNAME
hostName T T]
(\GETDEVICEFROMNAME name noError? dontCreate?])
(\GETCACHEDEVICEFROMHOSTNAME
[LAMBDA (devname noError? dontCreate?) (* smL " 4-Feb-86 12:59")
(* * Return the cache device, if it exists, otherwise the real device)
(PROG (devInfo canonicalName realDevice)
(* * Works like this -
if there is already a cache device by the given name, use it -
if the canonical name is different, see if there is a cache device by that name -
if there is already a real device, use it -
it we are told to create a device and this is a genericly started cache device, start up the cache on it -
finally just create and return the real device)
(* If there is already a cache device, use it)
(SETQ devInfo (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
devname)))
[COND
(devInfo (RETURN (fetch (CACHEDEVINFO CACHEDEV) of devInfo]
(* See if there is a cache device for this host under
a different name)
(SETQ canonicalName (OR (\FCACHE.CANONICAL.HOSTNAME devname)
devname))
[COND
((AND canonicalName (NEQ devname canonicalName))
(SETQ devInfo (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME)
of info)
canonicalName)))
(COND
(devInfo (RETURN (fetch (CACHEDEVINFO CACHEDEV) of devInfo]
(* If we should generically start it, go ahead and
make a new cache devcie)
(SETQ realDevice (\GETDEVICEFROMNAME canonicalName T T))
[COND
([AND (NOT dontCreate?)
(NOT (for name in (\FCACHE.PROPERTY (QUOTE BADDEVICES))
thereis (EQ canonicalName name)))
(if realDevice
then (for dev in \FCACHE.GENERIC.DEVICES
thereis (EQ (\FCACHE.GENERIC.DEVICE.TYPE realDevice)
(fetch DEVICENAME of dev)))
else (for dev in \FCACHE.GENERIC.DEVICES thereis (FDEVOP
(QUOTE HOSTNAMEP)
dev canonicalName]
(* we should create the device on the fly)
(RETURN (OR (FCACHE.START canonicalName)
(\GETDEVICEFROMNAME canonicalName noError? dontCreate?]
(* nope, so just go with the generic system code)
(RETURN (OR realDevice (\GETDEVICEFROMNAME canonicalName noError? dontCreate?])
(\GETREALDEVICEFROMHOSTNAME
[LAMBDA (name dontCreate? ignoreDevice) (* smL " 7-Aug-85 17:06")
(* * Used by the cacher to get the REAL device for this name. This is a clone of the function
\GETDEVICEFROMHOSTNAME, except that this excludes the given device from consideration.)
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \FILEDEVICES))
(OR [CDR (for devNamePair in \DEVICENAMETODEVICE when (NEQ ignoreDevice (CDR devNamePair))
thereis (EQ name (CAR devNamePair]
[PROGN (SETQ name (U-CASE name))
(CDR (for devNamePair in \DEVICENAMETODEVICE when (NOT (EQ ignoreDevice (CDR
devNamePair)))
thereis (EQ name (CAR devNamePair]
(AND (NOT dontCreate?)
(for dev in \FILEDEVICES bind temp when (AND (NEQ ignoreDevice dev)
(SETQ temp (FDEVOP (QUOTE HOSTNAMEP)
dev name dev)))
do (if (type? FDEV temp)
then (SETQ dev temp))
(\DEFINEDEVICE name dev)
(RETURN dev])
(\FCACHE.CANONICAL.HOSTNAME
[LAMBDA (name) (* smL "11-Feb-86 16:25")
(* * Get the "canonical" hostname for the device)
(* * This is more or less what the standard CANONICAL.HOSTNAME function should be doing, but doesn't.
In fact, this is the same as CANONICAL.HOSTNAME except for the first test in the COND)
(* * NOTE that for "internal" predefined device, this will NOT talk on the net)
(U-CASE (MKATOM (LET ((dev (\GETDEVICEFROMNAME name T T)))
(if [AND dev (NOT (MEMB (fetch DEVICENAME of dev)
(QUOTE (DPUPFTP]
then (* It's a good bet that the device is an internal one)
(fetch DEVICENAME of dev)
elseif (STRPOS ":" (OR (FILENAMEFIELD name (QUOTE HOST))
name))
then (\CANONICAL.NSHOSTNAME (OR (FILENAMEFIELD name
(QUOTE
HOST))
name))
else (\CANONICAL.HOSTNAME (OR (FILENAMEFIELD name
(QUOTE HOST))
name])
(\FCACHE.GENERIC.DEVICE.TYPE
[LAMBDA (device) (* smL " 6-Feb-86 14:09")
(* * HACK: This tries to figure out what the "generic" type of a device is, either LEAF or NSFILING.
Should be a field in the device or something.)
(KLUDGE (SELECTQ (fetch OPENFILE of device)
(\LEAF.OPENFILE (QUOTE LEAF))
(\NSFILING.OPENFILE (QUOTE NSFILING))
NIL])
)
(* * Functions for loading or removing a file into the cache)
(DEFINEQ
(\FCACHE.DELETE.ENTRY
[LAMBDA (entry) (* smL " 3-Sep-86 14:51")
(* * Delete a cache entry)
(WITH.MONITOR \FCACHE.CACHELOCK (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(LET ((size (fetch CACHEFILELENGTH of entry)))
(* Flush the entry if it is dirty)
(if (\FCACHE.ENTRYOPEN? entry)
then (ERROR "Cached file is open, so can't delete entry for file "
(fetch REMOTEFILENAME of entry)))
(* Get rid of the file)
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Deleting entry "
(fetch REMOTEFILENAME of entry)))
(* A hack to make sure that the server is really
ready)
(CLEAR.LEAF.CACHE (FILENAMEFIELD (fetch REMOTEFILENAME of entry)
(QUOTE HOST)))
(DELFILE (fetch LOCALFILENAME of entry))
(* Now forget about the entry)
(change \FCACHE.LIST (DREMOVE entry DATUM))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE (\FCACHE.PROPERTY (QUOTE SIZE))
size])
(\FCACHE.EXPUNGE.DELETED.ENTRY
[LAMBDA (entry) (* smL " 3-Sep-86 14:55")
(* * Expunge a deleted file from the local cache)
(WITH.MONITOR \FCACHE.CACHELOCK (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Expunging deleted entry "
(fetch REMOTEFILENAME of entry)))
(DELFILE (fetch LOCALFILENAME of entry))
(change \FCACHE.DELETED.ENTRIES (DREMOVE entry DATUM))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE (\FCACHE.PROPERTY (QUOTE SIZE))
(fetch CACHEFILELENGTH of entry])
(\FCACHE.INVENTNAME
[LAMBDA (REMOTENAME) (* smL "22-Jul-85 10:35")
(* * Remote files are cached in a file with the same name)
(LET ((FIELDS (UNPACKFILENAME REMOTENAME)))
(PACK* (\FCACHE.PROPERTY (QUOTE PREFIX))
(OR (\FCACHE.MAKE.LEGAL.FILENAME (LISTGET FIELDS (QUOTE NAME)))
"")
(QUOTE ".")
(OR (\FCACHE.MAKE.LEGAL.FILENAME (LISTGET FIELDS (QUOTE EXTENSION)))
""])
(\FCACHE.KEEPVERSIONS
[LAMBDA (fullFileName keepVersions) (* smL "14-Aug-85 10:26")
(* * Take older versions of the file and put them at the end of the cache list)
(if [OR (NOT (NUMBERP keepVersions))
(LESSP keepVersions 1)
(NOT (NUMBERP (FILENAMEFIELD fullFileName (QUOTE VERSION]
then (* don't bother)
NIL
else (for e in (for entry in \FCACHE.LIST
bind (versionlessName ←(U-CASE (VersionlessFileName fullFileName)))
(oldestVersion ←(ADD1 (DIFFERENCE (FILENAMEFIELD fullFileName
(QUOTE VERSION))
keepVersions)))
when (AND (EQ versionlessName (VersionlessFileName (fetch MATCHFILENAME
of entry)))
(LESSP (OR (FILENAMEFIELD (fetch MATCHFILENAME of entry)
(QUOTE VERSION))
oldestVersion)
oldestVersion))
collect entry)
do (* move the entry to the end)
(SETQ \FCACHE.LIST (NCONC1 (DREMOVE e \FCACHE.LIST)
e])
(\FCACHE.LOAD
[LAMBDA (fullName) (* smL " 7-Jul-86 15:52")
(* * Load up a global file into the cache, returning the entry, or NIL if the load fails -
NOTE: This fn returns holding the entry's CACHELOCK. It should only be called within a RESETLST!)
(PROG (inStream remoteDevice outStream localFileName length idate entry inProgress?)
(* This first loop takes care of the possibility that
another process is already busy caching the file)
CheckCache
[WITH.MONITOR \FCACHE.CACHELOCK (SETQ entry (\FCACHE.LOOKUP (\GETUSERDEVICEFROMNAME
fullName)
fullName T))
(if (NULL entry)
then (SETQ inProgress? (MEMBER fullName \FCACHE.CACHING.FILES]
(if entry
then (GO Exit)
elseif inProgress?
then (AWAIT.EVENT \FCACHE.CACHE.CHANGED.EVENT)
(GO CheckCache)
else (RESETSAVE (push \FCACHE.CACHING.FILES fullName)
(LIST (FUNCTION [LAMBDA (file)
(change \FCACHE.CACHING.FILES (DREMOVE file DATUM))
(NOTIFY.EVENT \FCACHE.CACHE.CHANGED.EVENT])
fullName))) (* Try to open the remote file)
[SETQ inStream (OPENSTREAM fullName (QUOTE INPUT)
(QUOTE OLD)
(QUOTE (FCACHE.INTERNAL SEQUENTIAL]
(if (NULL inStream)
then (GO Exit))
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
inStream))
(replace USERVISIBLE of inStream with NIL)
(SETQ fullName (fetch FULLFILENAME of inStream))
(SETQ remoteDevice (fetch DEVICE of inStream))
(SETQ length (OR (GETFILEINFO inStream (QUOTE SIZE))
0)) (* See if the file is too big to cache)
(if (LET [(maxLength (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES]
(AND maxLength (IGREATERP length maxLength)))
then (CLOSEF? inStream)
(GO Exit)) (* Make sure there is enough room for the file)
(\FCACHE.KEEPVERSIONS fullName (\FCACHE.PROPERTY (QUOTE KEEPVERSIONS)))
(if (OR (NOT (ADD.FILE.TO.CACHE? fullName))
(NOT (\FCACHE.MAKEROOM length)))
then (CLOSEF? inStream)
(GO Exit))
(SETQ idate (FDEVOP (QUOTE GETFILEINFO)
remoteDevice inStream (QUOTE ICREATIONDATE)
remoteDevice))
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Caching " fullName " (" length " pages)"))
[SETQ outStream (OPENSTREAM (\FCACHE.INVENTNAME fullName)
(QUOTE OUTPUT)
(QUOTE NEW)
NIL
(BQUOTE (FCACHE.INTERNAL
SEQUENTIAL
(TYPE , (FDEVOP (QUOTE GETFILEINFO)
remoteDevice inStream
(QUOTE TYPE)
remoteDevice))
(ICREATIONDATE , idate)
(LENGTH , (OR (FDEVOP (QUOTE
GETFILEINFO)
remoteDevice
inStream
(QUOTE LENGTH)
remoteDevice)
0]
(if outStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
outStream))
(replace USERVISIBLE of outStream with NIL)
(SETQ localFileName (fetch FULLFILENAME of outStream))
(COPYCHARS inStream outStream)
(CLOSEF inStream)
(CLOSEF outStream)
(* this SETFILEINFO is needed in case the local device does not do the right thing with the ICREATIONDATE in the
OPENSTREAM above. This ensures that the date of the local file matches the remote file)
(SETFILEINFO outStream (QUOTE ICREATIONDATE)
idate)
(SETQ entry (\FCACHE.ADDENTRY localFileName fullName idate
(GETFILEINFO inStream (QUOTE PLIST))
length))
(replace TIMELASTVERIFIED of entry with (OR (IDATE)
0)))
Exit(if entry
then (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T))
(RETURN entry])
(\FCACHE.MAKE.LEGAL.FILENAME
[LAMBDA (file) (* smL "19-Feb-85 09:19")
(* * Convert a potential file name into something that the local file system will accept)
(PACK (for c inchars file
collect (SELCHARQ c
((A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h
i j k l m n o p q r s t u v w x y z 1 2 3 4 5 6 7 8 9 0 + - $
< >)
(CHARACTER c))
"$"])
(\FCACHE.MAKEROOM
[LAMBDA (length) (* smL " 3-Sep-86 15:00")
(* * Make sure that there is enough room in the cache to hold this file)
(SETQ length (OR length 0))
(LET [(cacheMaxTotal (\FCACHE.PROPERTY (QUOTE MAXSIZE)))
(cacheSize (\FCACHE.PROPERTY (QUOTE SIZE)))
(freePages (OR [CAR (NLSETQ (SELECTQ
(MACHINETYPE)
(DORADO (* \GETDEVICEFROMNAME is a hack to program around a
system bug)
(DIFFERENCE
[DISKFREEPAGES (\GETDEVICEFROMNAME
(\FCACHE.PROPERTY
(QUOTE PREFIX]
50))
(DIFFERENCE (DISKFREEPAGES (\FCACHE.PROPERTY
(QUOTE PREFIX)))
100]
(ADD1 length]
(SETQ cacheMaxTotal (if (NUMBERP cacheMaxTotal)
then (MIN cacheMaxTotal (PLUS freePages cacheSize))
else (PLUS freePages cacheSize)))
(if (ILESSP cacheMaxTotal length)
then (* the file wont ever fit, so dont even try)
NIL
elseif (ILESSP (PLUS length cacheSize)
cacheMaxTotal)
then (* the file will fit w/o having to get rid of any old
cached files)
T
else (* delete some old files until it fits)
(* NOTE: this is ugly -- perhaps I would be better off if I maintained the cache list in the other order? But then
looking up files would be slowed. Oh well...)
(RESETLST (\FCACHE.DONE.OR.ABORTED.MSG "Making some room in the cache")
(OR (for entry in (COPY \FCACHE.DELETED.ENTRIES)
bind (desiredLength ←(IDIFFERENCE cacheMaxTotal length))
do (\FCACHE.EXPUNGE.DELETED.ENTRY entry)
(if (ILESSP (\FCACHE.PROPERTY (QUOTE SIZE))
desiredLength)
then (RETURN T))
finally (RETURN NIL))
(for entry in (REVERSE \FCACHE.LIST)
bind (desiredLength ←(IDIFFERENCE cacheMaxTotal length))
do (WITH.MONITOR (fetch CACHELOCK of entry)
(if (AND (NOT (fetch CACHEISDIRTY
of entry))
(NOT (\FCACHE.ENTRYOPEN?
entry))
(\FCACHE.MAKEROOM.DELETEABLE?
(fetch REMOTEFILENAME
of entry)))
then (\FCACHE.DELETE.ENTRY entry)))
(if (ILESSP (\FCACHE.PROPERTY (QUOTE SIZE))
desiredLength)
then (RETURN T))
finally (RETURN NIL])
(\FCACHE.MAKEROOM.DELETEABLE?
[LAMBDA (fileName) (* smL "11-Sep-85 13:17")
(* * Is this cache entry deleteable to make room for some new cache entry?)
T])
)
(RPAQ? \FCACHE.CACHELOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.CACHELOCK)))
(RPAQ? \FCACHE.CACHE.CHANGED.EVENT (CREATE.EVENT (QUOTE FCACHE.CHANGED)))
(RPAQ? \FCACHE.CACHING.FILES NIL)
(RPAQ? \FCACHE.DELETED.ENTRIES NIL)
(RPAQ? \FCACHE.LIST NIL)
(RPAQ? \FCACHE.LIST.CHANGED? NIL)
(RPAQ? \FCACHE.LOGFILE NIL)
(* * Functions for creating or destroying a cache device)
(DEFINEQ
(\FCACHE.BUILD.DEVICE
[LAMBDA (devname) (* smL " 7-Aug-85 11:36")
(* * Build a cache device trying to inherit as much as possible from the local device)
(LET [(cacheDevice (create FDEV using (\FCACHE.LOCALDEVICE]
(replace DEVICENAME of cacheDevice with devname)
(replace NODIRECTORIES of cacheDevice with T)
(* other methods are special for the cache device)
(replace GENERATEFILES of cacheDevice with (QUOTE \FCACHE.GENERATEFILES))
(replace EVENTFN of cacheDevice with (QUOTE \FCACHE.EVENTFN))
(replace OPENFILE of cacheDevice with (QUOTE \FCACHE.OPENFILE))
(replace CLOSEFILE of cacheDevice with (QUOTE \FCACHE.CLOSEFILE))
(replace HOSTNAMEP of cacheDevice with (QUOTE \FCACHE.HOSTNAMEP))
(replace DIRECTORYNAMEP of cacheDevice with (QUOTE \FCACHE.DIRECTORYNAMEP))
(replace REOPENFILE of cacheDevice with (QUOTE \FCACHE.REOPENFILE))
(replace GETFILENAME of cacheDevice with (QUOTE \FCACHE.GETFILENAME))
(replace DELETEFILE of cacheDevice with (QUOTE \FCACHE.DELETEFILE))
(replace GETFILEINFO of cacheDevice with (QUOTE \FCACHE.GETFILEINFO))
(replace SETFILEINFO of cacheDevice with (QUOTE \FCACHE.SETFILEINFO))
(replace RENAMEFILE of cacheDevice with (QUOTE \FCACHE.RENAMEFILE))
cacheDevice])
(\FCACHE.OFF
[LAMBDA (device) (* lmm "22-Oct-85 16:05")
(* * Turn off the cache device)
(OR [\FCACHE.PROPERTY.PUT (QUOTE DEVICES)
(REMOVE (fetch (CACHEDEVICE CACHEDEVINFO) of device)
(\FCACHE.PROPERTY (QUOTE DEVICES]
(DEL.PROCESS (QUOTE DUMP-FCACHE)))
(\REMOVEDEVICE device])
)
(* * Functions for dealing with device events, like LOGOUT)
(DEFINEQ
(\FCACHE.DEVICE.EVENTFN
[LAMBDA (DEVICE EVENT) (* smL "30-Jul-86 16:24")
(* * The event fn for the dummy FCACHE device -
This is used to capture "global" events that shoudl effect the entire cache.)
(if (NULL (STKPOS (QUOTE \FCACHE.DEVICE.EVENTFN)
-2))
then
(* We need to do this check to prevent recursive device events. This can happen, say, if SAVEVM gets called inside
of FCACHE.DUMP. Ugh. This should really be taken care of by the system, but what can you do?)
(SELECTQ EVENT
((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM)
(if \FCACHE.LOGFILE
then (* the logfile was left open, so we had better get rid
of it quick -
this can only happen AFTERSAVEVM)
(SETQ \OPENFILES (DREMOVE \FCACHE.LOGFILE \OPENFILES))
(SETQ \FCACHE.LOGFILE NIL))
(* Restore the cache devices and info)
(\FCACHE.INITIALIZE.PROPS))
((AFTERDOMAKESYS AFTERDOSYSOUT AFTERDOSAVEVM)
(* Don't need to do anything here)
NIL)
((BEFORESYSOUT BEFOREMAKESYS BEFORESAVEVM)
(* Dump out the cache listings)
(FCACHE.DUMP T))
(BEFORELOGOUT (* Dump the cache info)
[for entry in \FCACHE.LIST bind fileName
when (fetch CACHEISDIRTY of entry)
do (SETQ fileName (fetch REMOTEFILENAME
of entry))
(if (\FCACHE.ENTRYOPEN? entry)
then (OR (\FCACHE.CANT.DUMP.BREAK fileName
"because the file is open"
"LOGOUT")
(ERROR "Can't dump file " fileName)
)
elseif (\FCACHE.WRITEOUT entry)
then
(* ok, the file was written out)
T
else (* can't dump the file!)
(OR (\FCACHE.CANT.DUMP.BREAK fileName
"do it"
"LOGOUT")
(ERROR "Can't dump file " fileName]
(for entry in \FCACHE.LIST
when (FCACHE.PRIVATE.FILE? (fetch REMOTEFILENAME
of entry))
do (\FCACHE.DELETE.ENTRY entry))
(FCACHE.DUMP T))
(\ILLEGAL.ARG EVENT])
(\FCACHE.INITIALIZE.PROPS
[LAMBDA NIL (* smL " 7-Jul-86 14:07")
(* * Reinitialize the cache properties.)
(RESETLST (RESETSAVE (SETREADTABLE \FCACHE.DIR.READTABLE))
(SETQ \FCACHE.LOGFILE NIL)
(if (INFILEP (QUOTE {DSK}FCache.pointer;1))
then (LET [(f (OPENSTREAM (QUOTE {DSK}FCache.pointer;1)
(QUOTE INPUT]
[\FCACHE.PROPERTY.PUT (QUOTE PREFIX)
(MKATOM (CAR (NLSETQ (READ f]
(CLOSEF f))
(OR (\FCACHE.RESTORE (\FCACHE.PROPERTY (QUOTE PREFIX)))
(\FCACHE.RESTORE NIL))
else (PROG ((f (OPENSTREAM (QUOTE {DSK}FCache.pointer;1)
(QUOTE OUTPUT)))
prefix)
(CLEARW \FCACHE.PROMPT.WINDOW)
TryAgain
[SETQ prefix (MKATOM (RESETBUFS (PROMPTFORWORD
"What should the file cache prefix be (NIL to disable)? "
(SELECTQ (MACHINETYPE)
(DORADO "{DSK1}")
"{DSK}<LispFiles>Cache>")
NIL \FCACHE.PROMPT.WINDOW
NIL T]
(if (\FCACHE.RESTORE prefix)
then (CLOSEW \FCACHE.PROMPT.WINDOW)
(printout f .P2 (\FCACHE.PROPERTY (QUOTE PREFIX))
T)
(CLOSEF f)
else (printout \FCACHE.PROMPT.WINDOW T
"Bad device specification: "
prefix T)
(GO TryAgain])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[DEFMACRO \FCACHE.CANT.DUMP.BREAK (file reason operation)
(BQUOTE (BREAK1 T T "Can't flush file" ((printout T "The cached version of the file "
(\, file)
.SP 1
"needs to be dumped to the fileserver, "
"but I can't "
(\, reason)
"." T
"If you continue with OK I will proceed with the "
(\, operation)
"." T
"If you RETURN NIL I will abort the "
(\, operation)
"." T]
)
)
(* KLUDGE: Make sure the cache devices are at the top of the list of known devices before we
do any device event)
(DEFINEQ
(\FCACHE.GLOBAL.EVENT
[LAMBDA (EVENT) (* lmm "14-Sep-85 19:03")
(* * Before doing a device event, make sure the cache devices are the last devices defined. The dummey one should be
positioned so that it gets the event first after a logout.)
(\REMOVEDEVICE \FCACHE.DEVICE)
(\DEFINEDEVICE (QUOTE FCACHE)
\FCACHE.DEVICE)
(for x in (\FCACHE.PROPERTY (QUOTE DEVICES)) do (LET ((device (fetch CACHEDEV of x)))
(\REMOVEDEVICE device)
(\DEFINEDEVICE (PACK* (fetch REALDEVICENAME
of x)
(QUOTE -CACHE))
device)))
(SELECTQ EVENT
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(\FCACHE.AROUNDEXIT))
NIL])
)
(APPENDTOVAR AROUNDEXITFNS \FCACHE.GLOBAL.EVENT)
(* Before revalidating files, load the LOG file, if any -- in other words, a big HACK)
(DEFINEQ
(\FCACHE.AROUNDEXIT
[LAMBDA NIL (* smL "11-Feb-86 18:17")
(* * Called before revalidating files after a logout -- make sure that the cache info is up to date.
In other words, after an event, check for a log file)
(RESETLST (PROG (prefix logfileName) (* forget it if there is no cache)
(SETQ prefix (\FCACHE.PROPERTY (QUOTE PREFIX)))
(if (NULL prefix)
then (RETURN NIL))
(SETQ logfileName (PACK* prefix "FCache.Log;1"))
(* close the log file if it is open)
(if (OPENP logfileName)
then (SETQ \FCACHE.LOGFILE (GETSTREAM logfileName))
(replace USERCLOSEABLE of \FCACHE.LOGFILE with T)
(CLOSEF? \FCACHE.LOGFILE))
(* skip loading the entries it if there is no log
file)
(if (NOT (INFILEP logfileName))
then (RETURN T)) (* load the entries from the log file)
(\FCACHE.DONE.OR.ABORTED.MSG "Restoring log entries")
(SETQ \FCACHE.LOGFILE (OPENSTREAM logfileName (QUOTE INPUT)))
[bind entrydef while (NOT (EOFP \FCACHE.LOGFILE))
do (SETQ entrydef (NLSETQ (READ \FCACHE.LOGFILE)))
(if entrydef
then (\FCACHE.RESTORE.ENTRY (CAR entrydef)
T)
else (LET ((errorWindow (CREATEW (create REGION
LEFT ← 250
BOTTOM ← 250
WIDTH ← 425
HEIGHT ← 120)
"File cache warning")))
(printout errorWindow
"WARNING: The file cache log file was not completly dumped."
"The cacher may have lost track of some files."
"If there were any files that needed to be dumped, "
"they may have been lost!" T T
"You should run FCACHE.SCAVENGE soon to clean up your disk."]
(FCACHE.DUMP)
(RETURN T])
)
(* * Catch changes to the current user / password)
(* This is a HACK)
(DEFINEQ
(\FCACHE.BEFORELOGIN
[LAMBDA (HOST FLG DIRECTORY MSG) (* smL " 7-Jul-86 19:22")
(* * The user is about to be changed. Make sure that all dirty files have been dumped.)
(if (NULL HOST)
then (for entry in \FCACHE.LIST bind fileName when (fetch CACHEISDIRTY
of entry)
do (SETQ fileName (fetch REMOTEFILENAME of entry))
(if (\FCACHE.ENTRYOPEN? entry)
then (OR (\FCACHE.CANT.DUMP.BREAK fileName "because the file is open"
"LOGIN")
(ERROR "Can't dump file " fileName))
elseif (\FCACHE.WRITEOUT entry)
then (* ok, the file was written out)
T
else (* can't dump the file!)
(OR (\FCACHE.CANT.DUMP.BREAK fileName "do it" "LOGIN")
(ERROR "Can't dump file " fileName])
(\FCACHE.ADVISED.LOGIN
[LAMBDA (HOST FLG DIRECTORY MSG) (* smL " 7-Jul-86 18:07")
(* * A replacement for \INTERNAL/SETPASSWORD)
(for fn in \BEFORELOGINFNS do (APPLY* fn HOST FLG DIRECTORY MSG))
(\OLD/LOGIN HOST FLG DIRECTORY MSG])
)
(ADDTOVAR \BEFORELOGINFNS \FCACHE.BEFORELOGIN)
(* * Methods for the {FCACHE} file device. Note that methods that are not defined are not
really needed since {FCACHE} is a specialization of the local device that holds the cache, and
inherits all bin/bout like methods)
(DEFINEQ
(\FCACHE.CLOSEFILE
[LAMBDA (STREAM) (* smL "11-Feb-86 18:55")
(* * Implements the CLOSEFILE method for the {FCACHE} device.)
(RESETLST (PROG (cacheDevice localDevice entry result)
(SETQ cacheDevice (fetch DEVICE of STREAM))
(SETQ localDevice (\FCACHE.LOCALDEVICE))
(if (NULL (SETQ entry (\FCACHE.LOOKUP cacheDevice STREAM NIL)))
then (ERROR "Lost the cache entry for " STREAM))
(if (SETQ result (FDEVOP (QUOTE CLOSEFILE)
localDevice STREAM))
then (* For some reason, if we don't do this OPENP thinks
the local file is still open)
(CLOSEF? (fetch LOCALFILENAME of entry))
(if (fetch CACHEISDIRTY of entry)
then (* Update the file size, since it probably changed)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE
(\FCACHE.PROPERTY (QUOTE
SIZE))
(fetch CACHEFILELENGTH
of entry)))
(replace CACHEFILELENGTH of entry
with (FDEVOP (QUOTE GETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
(QUOTE SIZE)
localDevice))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY
(QUOTE SIZE))
(fetch CACHEFILELENGTH
of entry)))
(\FCACHE.MAKEROOM))
(replace CACHETIMECLOSED of entry with (IDATE))
(RETURN result)
else (ERROR "Can't close the cache file " (fetch LOCALFILENAME
of entry])
(\FCACHE.DELETEFILE
[LAMBDA (NAME DEVICE) (* smL " 3-Sep-86 14:52")
(* * Implements the DELETEFILE method for the {FCACHE} device.)
(RESETLST (LET ((fullName (\FCACHE.GETFILENAME NAME (QUOTE OLDEST)
DEVICE))
entry)
(SETQ entry (if fullName
then (\FCACHE.LOOKUP DEVICE fullName)))
(if (OR (NULL fullName)
(AND entry (\FCACHE.ENTRYOPEN? entry)))
then NIL
else (* delete the cache entry, then the remote file)
(if (NULL entry)
then (* Nothing to delete)
NIL
elseif (\FCACHE.PROPERTY (QUOTE DELAY.DELETE))
then (* Don't delete the entry immediatly, but remove it
from the cache list and note that it is subject to
deletion)
(change \FCACHE.LIST (DREMOVE entry DATUM))
(change \FCACHE.DELETED.ENTRIES (NCONC1 DATUM entry))
else (* delete the cache entry)
(\FCACHE.DELETE.ENTRY entry))
(if (AND entry (fetch CACHEISDIRTY of entry)
(NOT (fetch FILEXISTED of entry)))
then fullName
else (REALDEVOP (QUOTE DELETEFILE)
DEVICE fullName DEVICE])
(\FCACHE.DIRECTORYNAMEP
[LAMBDA (HostAndDir DEVICE) (* smL " 8-Jul-86 18:07")
(* * Implements the DIRECTORYNAMEP method for the {FCACHE} device)
(RESETLST
(LET ((hostName (fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)))
(OR
(AND
(if (\FCACHE.HOSTUP? hostName)
then NIL
elseif (MEMB (U-CASE (MKATOM hostName))
(FCACHE.GETPROP (QUOTE DEAD.HOSTS)))
then T
else (SELECTQ
(\FCACHE.PROPERTY (QUOTE UNSAFE))
(T (* We are told to use the local cache)
T)
(NOTIFY (* Use the cache, but notify the user what is going
on)
(printout *FILE-CACHE-MESSAGE-STREAM* T (fetch (CACHEDEVICE
REALDEVICENAME)
of DEVICE)
,
"does not seem to be responding for directory name verification."
T "Trusting that" , HostAndDir , "is OK.")
T)
[ASK (* Ask to find out what to do)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
(CONCAT hostName " not responding..."))
(CLEARW msgWindow)
(printout msgWindow .FONT DEFAULTFONT "Can't verify if" T .FONT
BOLDFONT .TAB 10 HostAndDir .FONT DEFAULTFONT T
"is a valid directory name"
T T .TAB 10 "I'll keep trying...")
(WINDOWPROP msgWindow (QUOTE ItemPicked)
NIL)
(LET [(menu (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE (("Trust the cache" Use)
("Don't trust the cache"
Don'tUse)
("Add to DEAD.HOSTS"
MakeDead)))
WHENSELECTEDFN ←(FUNCTION
\FCACHE.HOSTDEAD.WHENSELECTEDFN]
(ADDMENU menu msgWindow
(create POSITION
XCOORD ←(IQUOTIENT
(DIFFERENCE (WINDOWPROP
msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 10)))
(during (\FCACHE.PROPERTY (QUOTE UNSAFE.TIMEOUT))
timerUnits (QUOTE SECONDS)
do (BLOCK)
(if (\FCACHE.HOSTUP? hostName)
then (RETURN NIL)
else (SELECTQ (WINDOWPROP msgWindow (QUOTE
ItemPicked))
(Use (RETURN T))
(Don'tUse (RETURN NIL))
(MakeDead (pushnew
(FCACHE.GETPROP
(QUOTE DEAD.HOSTS))
hostName)
(RETURN T))
NIL))
finally (RETURN (\FCACHE.PROPERTY (QUOTE UNSAFE.DEFAULT]
(NIL (* We are running in cautious mode)
NIL)
NIL))
HostAndDir)
(REALDEVOP (QUOTE DIRECTORYNAMEP)
DEVICE HostAndDir DEVICE])
(\FCACHE.EVENTFN
[LAMBDA (DEVICE EVENT) (* smL " 7-Jul-86 13:57")
(* * EVENT method for the cached device)
(SELECTQ EVENT
((BEFORESYSOUT BEFOREMAKESYS BEFORELOGOUT BEFORESAVEVM)
(* Don't need to do anything here)
NIL)
[(AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM)
(* Restore the device)
(if (NULL (\FCACHE.PROPERTY (QUOTE PREFIX)))
then (* no cache prefix, so delete this cache device)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"[No cache prefix, so turning off cache for "
(fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)
"]"))
(\FCACHE.OFF DEVICE)
elseif [NOT (for stream in \OPENFILES thereis (EQ DEVICE
(fetch DEVICE
of stream]
then (* there is no open file on this device, so forget it)
(\FCACHE.OFF DEVICE)
else (LET [(newDevice (\FCACHE.BUILD.DEVICE (fetch (CACHEDEVICE
REALDEVICENAME)
of DEVICE]
(if (type? FDEV newDevice)
then (for descr in (GETDESCRIPTORS (QUOTE FDEV))
do (REPLACEFIELD descr DEVICE (FETCHFIELD descr
newDevice)))
else (if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T "["
(fetch (CACHEDEVICE REALDEVICENAME)
of DEVICE)
" no longer a known host, do turning off its cache]"))
(\FCACHE.OFF DEVICE]
((AFTERDOMAKESYS AFTERDOSYSOUT AFTERDOSAVEVM)
(* Don't need to do anything here)
NIL)
(\ILLEGAL.ARG EVENT])
(\FCACHE.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* smL " 7-Aug-85 18:09")
(* * Implements the GENERATEFILES method for the {FCACHE} device.)
(if (\FCACHE.USELOCALDIRECTORY? (fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)
PATTERN)
then (\FCACHE.GENERATE.LOCAL.FILES DEVICE PATTERN DESIREDPROPS OPTIONS)
elseif (\FCACHE.PROPERTY (QUOTE FASTDIR))
then (REALDEVOP (QUOTE GENERATEFILES)
DEVICE DEVICE PATTERN DESIREDPROPS OPTIONS)
else (MERGE.FILEGENERATORS (REALDEVOP (QUOTE GENERATEFILES)
DEVICE DEVICE PATTERN DESIREDPROPS OPTIONS)
(\FCACHE.GENERATE.LOCAL.FILES DEVICE PATTERN DESIREDPROPS OPTIONS T)
(FMEMB (QUOTE SORT)
OPTIONS])
(\FCACHE.GETFILEINFO
[LAMBDA (NameOrStream Attribute Device) (* smL "12-Feb-86 11:33")
(* * Implements the GETFILEINFO method for {FCACHE}. If the file is cached, try to fetch the property locally.
Otherwise, pass on the the remote host.)
(RESETLST (LET ((entry (\FCACHE.LOOKUP Device NameOrStream T)))
(if entry
then (\FCACHE.ENTRYINFO Device entry Attribute)
else (REALDEVOP (QUOTE GETFILEINFO)
Device
(if (STREAMP NameOrStream)
then (fetch FULLFILENAME of NameOrStream)
else NameOrStream)
Attribute Device])
(\FCACHE.GETFILENAME
[LAMBDA (NAME RECOG DEVICE) (* smL " 7-Jul-86 13:52")
(* * Implements the GETFILENAME method for the {FCACHE} file device.)
(DECLARE (GLOBALVARS \CONNECTED.DIRECTORY))
(for entry in \FCACHE.LIST
bind (RECOG ←(OR RECOG (QUOTE OLD)))
(givenVersion ←(FILENAMEFIELD NAME (QUOTE VERSION)))
(hostName ←(fetch (CACHEDEVICE REALDEVICENAME) of DEVICE))
filter file fileVersion entryVersion
first
(* * Try to get the file from the remote host)
(if [AND givenVersion (MEMB RECOG (QUOTE (NEW OLD/NEW]
then (* we are given a full name, so return it)
(RETURN NAME)
elseif (NOT (\FCACHE.USELOCALDIRECTORY? hostName NAME))
then (SETQ file (REALDEVOP (QUOTE GETFILENAME)
DEVICE NAME RECOG DEVICE))
(if [AND file givenVersion (MEMB RECOG (QUOTE (OLDEST OLD]
then (* in this case, we don't need to check the local
files at all)
(RETURN file)))
(* * Now we need to check the local files to see if that would change the answer from the remote host.
Ugh.)
[SETQ filter (if givenVersion
then (MatchFileName (PACKFILENAME.STRING (QUOTE BODY)
NAME
(QUOTE HOST)
hostName
(QUOTE DIRECTORY)
\CONNECTED.DIRECTORY))
else (DIRECTORY.MATCH.SETUP (PACKFILENAME.STRING (QUOTE
VERSION)
"*"
(QUOTE
BODY)
NAME
(QUOTE
HOST)
hostName
(QUOTE
DIRECTORY)
\CONNECTED.DIRECTORY]
when [if givenVersion
then (EQ filter (fetch MATCHFILENAME of entry))
else (AND (DIRECTORY.MATCH filter (fetch MATCHFILENAME of entry))
(EQ hostName (\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD
(fetch MATCHFILENAME
of entry)
(QUOTE HOST]
do (if (WITH.MONITOR (fetch CACHELOCK of entry)
(if (NOT (\FCACHE.VERIFY entry DEVICE))
then (* oops, a bad entry!)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"[Invalid cache file: "
(fetch REMOTEFILENAME of entry)
"]"))
(\FCACHE.DELETE.ENTRY entry)
T
else NIL))
then (GO $$ITERATE))
(SETQ fileVersion (FILENAMEFIELD file (QUOTE VERSION)))
(SETQ entryVersion (FILENAMEFIELD (fetch REMOTEFILENAME of entry)
(QUOTE VERSION)))
(if (NULL givenVersion)
then (SELECTQ RECOG
[OLDEST (if (OR (NULL file)
(AND (NUMBERP fileVersion)
(NUMBERP entryVersion)
(LESSP entryVersion fileVersion)))
then (* this entry is an older one, so update the oldest)
(SETQ file (fetch REMOTEFILENAME
of entry]
[(OLD/NEW OLD)
(if (OR (NULL file)
(AND (NUMBERP fileVersion)
(NUMBERP entryVersion)
(LESSP fileVersion entryVersion)))
then (* this entry is newer than the current guess, so
update the guess)
(SETQ file (fetch REMOTEFILENAME of entry]
[NEW (if (OR (NULL file)
(AND (NUMBERP fileVersion)
(NUMBERP entryVersion)
(LEQ fileVersion entryVersion)))
then (* this entry is at least as new as the current guess,
so update the guess)
(SETQ file
(if (NUMBERP entryVersion)
then (PACK* (VersionlessFileName
(fetch REMOTEFILENAME
of entry))
";"
(ADD1 entryVersion))
else (fetch REMOTEFILENAME of entry]
(\ILLEGAL.ARG RECOG))
elseif (EQP entryVersion givenVersion)
then (* we have a match, so go with it)
(RETURN (fetch REMOTEFILENAME of entry))
else (* given an explicit version number, but this entry
doesn't match it, so do nothing)
NIL)
finally
(* * if we found no matching file, and RECOG is NEW or OLD/NEW, then create one with version = 1)
[if [AND (NULL file)
(MEMB RECOG (QUOTE (NEW OLD/NEW]
then (* no old file, so create a new one)
(SETQ file (if (STRPOS "." NAME)
then (PACK* (VersionlessFileName NAME)
";1")
else (PACK* (VersionlessFileName NAME)
".;1"]
(RETURN file])
(\FCACHE.HOSTNAMEP
[LAMBDA (hostName device) (* smL " 8-Aug-85 13:23")
(* * The HOSTNAMEP method of a cached device)
NIL])
(\FCACHE.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* smL "12-Mar-86 16:55")
(* * Implements the OPENFILE method for the {FCACHE-whatever} file device.)
(* Why is this RESETLST here, you ask? So that the cache lookup can return us a cache entry with the lock on that
entry in our possesion, knowing that the lock will be released in the enclosing RESETLST)
(RESETLST (LET ((localDevice (\FCACHE.LOCALDEVICE))
fullName cacheStream cacheEntry fileExisted? filePages)
(* * Set the default RECOG)
[SETQ RECOG (OR RECOG (SELECTQ ACCESS
(INPUT (QUOTE OLD))
(OUTPUT (QUOTE NEW))
((BOTH APPEND)
(QUOTE OLD/NEW))
(\ILLEGAL.ARG ACCESS]
(* * Try to get a cache entry)
(SETQ filePages (OR (CADR (ASSOC (QUOTE SIZE)
PARAMETERS))
(FOLDHI (OR (CADR (ASSOC (QUOTE LENGTH)
PARAMETERS))
0)
BYTESPERPAGE)))
(SETQ fullName (\FCACHE.USECACHE? NAME ACCESS RECOG PARAMETERS DEVICE
filePages))
(if (type? CACHENTRY fullName)
then (* We already have the cache entry, go ahead and use
it)
(SETQ fileExisted? T)
(SETQ cacheEntry fullName)
(SETQ fullName (fetch REMOTEFILENAME of cacheEntry))
elseif fullName
then (* We should use the cache, but there is no cache
entry available)
(SELECTQ ACCESS
(INPUT (SETQ cacheEntry (\FCACHE.LOAD fullName)))
[(OUTPUT BOTH APPEND)
(SETQ fileExisted? (FDEVOP (QUOTE GETFILENAME)
DEVICE fullName
(QUOTE OLD)
DEVICE))
(if fileExisted?
then (SETQ cacheEntry (\FCACHE.LOAD fullName))
else (* We get to add a brand new file to the cache)
(\FCACHE.KEEPVERSIONS fullName
(\FCACHE.PROPERTY
(QUOTE KEEPVERSIONS)
))
(SETQ cacheEntry (\FCACHE.ADDENTRY
(OUTFILEP (\FCACHE.INVENTNAME fullName))
fullName
(IDATE)
NIL filePages]
(\ILLEGAL.ARG ACCESS)))
(* * Now if we have a cache entry, try to open it)
(if cacheEntry
then (SETQ cacheStream (FDEVOP (QUOTE OPENFILE)
localDevice
(fetch LOCALFILENAME of cacheEntry)
ACCESS RECOG PARAMETERS localDevice)))
(* * If we are lucky and managed to cache, we have an open stream...)
(if cacheStream
then (* we succeeded in our attempts to cache the file.
Patch up the FULLFILENAME and DEVICE fields to fool
any consumers of this stream.)
(replace FULLFILENAME of cacheStream
with (fetch REMOTEFILENAME of cacheEntry))
(replace DEVICE of cacheStream with DEVICE)
(* Store a pointer on the cache stream back to the
cache entry)
(STREAMPROP cacheStream (QUOTE cacheEntry)
cacheEntry) (* Fill in appropriate fields in the cache entry)
(if (MEMB ACCESS (QUOTE (OUTPUT BOTH APPEND)))
then (replace CACHEISDIRTY of cacheEntry with T)
(replace CACHETIMECLOSED of cacheEntry with NIL)
(replace FILEXISTED of cacheEntry
with (AND fileExisted? T))
(\FCACHE.LOGENTRY cacheEntry))
(* Advance this entry to the head of the list)
(\FCACHE.PROMOTE cacheEntry DEVICE)
(* Return the cache stream)
cacheStream
else (* For one reason or another, we don't cache this
file)
(REALDEVOP (QUOTE OPENFILE)
DEVICE NAME ACCESS RECOG PARAMETERS DEVICE])
(\FCACHE.RENAMEFILE
[LAMBDA (OLDNAME NEWNAME DEVICE) (* smL "27-Feb-86 13:14")
(* * Impelments the RENAMEFILE method for the {FCACHE} file device.)
(RESETLST (PROG ((OldRemoteName (\FCACHE.GETFILENAME OLDNAME (QUOTE OLD)
DEVICE))
(fullNewName (FDEVOP (QUOTE GETFILENAME)
DEVICE NEWNAME (QUOTE NEW)
DEVICE))
(localDevice (\FCACHE.LOCALDEVICE))
entry newLocalName newRemoteName oldStream)
(* can't rename open files)
(if (SETQ oldStream (AND (OPENP OldRemoteName)
(GETSTREAM OldRemoteName)))
then (ERROR "File open, can't rename " OLDNAME))
(* flush the cache if it is dirty)
(if (AND (SETQ entry (\FCACHE.LOOKUP DEVICE OldRemoteName T))
(NOT (\FCACHE.WRITEOUT entry)))
then (ERROR "Can't flush file, so can't rename " OLDNAME))
(* Then do the rename on the remote host)
[SETQ newRemoteName (INFILEP (LET ((realDevice (fetch (CACHEDEVICE
REALDEVICE)
of DEVICE)))
(if (fetch RENAMEFILE of
realDevice)
then (REALDEVOP (QUOTE
RENAMEFILE)
DEVICE
OldRemoteName
fullNewName
DEVICE)
else (\GENERIC.RENAMEFILE
OldRemoteName
fullNewName]
(* Now fix up the cache -- recompute the entry in case
the rename of the file changed the cache -- like
\GENERIC.RENAMEFILE does)
(if (SETQ entry (\FCACHE.LOOKUP DEVICE OldRemoteName T))
then (SETQ newLocalName (\FCACHE.INVENTNAME newRemoteName))
(FDEVOP (QUOTE RENAMEFILE)
localDevice
(fetch LOCALFILENAME entry)
newLocalName localDevice)
(replace LOCALFILENAME of entry with (INFILEP newLocalName)
)
(replace REMOTEFILENAME of entry with newRemoteName)
(replace MATCHFILENAME of entry with (MatchFileName
newRemoteName)))
(RETURN newRemoteName])
(\FCACHE.REOPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM) (* smL "11-Feb-86 18:57")
(* * Implements the REOPENFILE method for the {FCACHE} file device.)
(if (NOT (STREAMPROP OLDSTREAM (QUOTE cacheEntry)))
then (* it was not a cached file, so we shouldn't be here.
But just to be safe...)
NIL
else (RESETLST (LET ((entry (\FCACHE.LOOKUP DEVICE (fetch FULLFILENAME of OLDSTREAM)
T))
(localDevice (\FCACHE.LOCALDEVICE))
newStream)
(if entry
then (STREAMPROP OLDSTREAM (QUOTE cacheEntry)
entry)
(OR (RESETLST (RESETSAVE
(replace DEVICE of OLDSTREAM
with localDevice)
(LIST (FUNCTION [LAMBDA (stream
device)
(replace DEVICE
of stream with device]
)
OLDSTREAM DEVICE))
(SETQ newStream
(FDEVOP (QUOTE REOPENFILE)
localDevice
(fetch LOCALFILENAME
of entry)
ACCESS RECOG PARAMETERS
localDevice OLDSTREAM))
(if newStream
then (replace DEVICE of
newStream
with DEVICE)
(STREAMPROP newStream
(QUOTE
cacheEntry)
entry))
newStream)
(\FCACHE.OPENFILE NAME ACCESS RECOG PARAMETERS
DEVICE))
else (* it wasn't -- so punt!)
NIL])
(\FCACHE.SETFILEINFO
[LAMBDA (NameOrStream attribute value device) (* smL "12-Feb-86 11:33")
(* * The SETFILEINFO method for a cached device)
(RESETLST (LET ((localDevice (\FCACHE.LOCALDEVICE))
(entry (\FCACHE.LOOKUP device NameOrStream T))
result)
(if (NULL entry)
then (* no cached copy, so do it on the remote one)
(SETQ result (REALDEVOP (QUOTE SETFILEINFO)
device
(if (STREAMP NameOrStream)
then (fetch FULLFILENAME
of NameOrStream)
else NameOrStream)
attribute value device))
elseif (AND (fetch CACHEISDIRTY of entry)
(NOT (fetch FILEXISTED of entry)))
then (* there is no remote file, so do it on the local one)
(SETQ result (FDEVOP (QUOTE SETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute value localDevice))
elseif (AND (fetch CACHEISDIRTY of entry)
(EQ attribute (QUOTE LENGTH)))
then (* we can get away with doing it on the local one
only, as long as we are careful)
(SETQ result (FDEVOP (QUOTE SETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute value localDevice))
else (* we really need to do it on the remote file)
(SETQ result (REALDEVOP (QUOTE SETFILEINFO)
device
(if (STREAMP NameOrStream)
then (fetch FULLFILENAME
of NameOrStream)
else NameOrStream)
attribute value device))
(if result
then (FDEVOP (QUOTE SETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute value localDevice)))
(* patch up any fields in the cache entry)
(if (AND result entry)
then (SELECTQ attribute
(LENGTH (replace CACHEFILELENGTH of entry
with value))
(CREATIONDATE (replace CACHEFILEDATE of entry
with (IDATE value)))
(ICREATIONDATE (replace CACHEFILEDATE of entry
with value))
(PLIST (replace CACHEFILEPROPS of entry with value))
NIL))
result])
)
(* Helper fns)
(DEFINEQ
(\FCACHE.ENTRYINFO
[LAMBDA (cacheDevice entry attribute) (* smL " 7-Aug-85 18:25")
(* * Get file information for a cache entry)
(SELECTQ attribute
(ICREATIONDATE (* this prop is stored in the entry)
(fetch CACHEFILEDATE of entry))
(CREATIONDATE (* this prop is stored in the entry)
(GDATE (fetch CACHEFILEDATE of entry)))
(SIZE (* this prop is stored in the entry)
(if (fetch CACHEISDIRTY of entry)
then (LET ((localDevice (\FCACHE.LOCALDEVICE)))
(FDEVOP (QUOTE GETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute localDevice))
else (fetch CACHEFILELENGTH of entry)))
(CACHEDIRTY (* Is the local cache dirty?)
(fetch CACHEISDIRTY of entry))
(CACHEFILE (* We add a file attribute, the CACHEFILE property
that tells where a given remote file is cached)
(fetch LOCALFILENAME of entry))
((TYPE LENGTH) (* For these file props, the local device holds the
info)
(LET ((localDevice (\FCACHE.LOCALDEVICE)))
(FDEVOP (QUOTE GETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute localDevice)))
(AND (REALDEVOP (QUOTE GETFILENAME)
cacheDevice
(fetch REMOTEFILENAME of entry)
(QUOTE OLD)
cacheDevice)
(REALDEVOP (QUOTE GETFILEINFO)
cacheDevice
(fetch REMOTEFILENAME of entry)
attribute cacheDevice])
)
(* * Directory enumeration functions)
(DEFINEQ
(\FCACHE.GENERATE.FILEINFO
[LAMBDA (genfilestate attribute) (* smL "21-Aug-86 19:57")
(* * FILEINFOFN for the local directory generator)
(if (fetch (LocalFileGenerator FileGenPrevEntry) of genfilestate)
then (RESETLST (LET ((entry (fetch (LocalFileGenerator FileGenPrevEntry) of
genfilestate)))
(\FCACHE.ENTRYINFO (LET [(hostName (FILENAMEFIELD (fetch
REMOTEFILENAME
of entry)
(QUOTE HOST]
(OR (\GETCACHEDEVICEFROMHOSTNAME
hostName T
NIL)
(ERROR
"Cache device has disappeared!"
hostName)))
entry attribute])
(\FCACHE.GENERATE.FILES.DEPTH
[LAMBDA (pattern) (* smL " 5-Feb-86 10:05")
(* * How many subdirectories are specified in the file pattern?)
(PROG ((count 0)
(pos 0))
LOOP(SETQ pos (STRPOS ">" pattern (ADD1 pos)))
(if (NULL pos)
then (RETURN count)
else (add count 1)
(GO LOOP])
(\FCACHE.GENERATE.LOCAL.FILES
[LAMBDA (device pattern desiredprops options dirtyOnly?) (* smL "10-Feb-86 19:15")
(* * Use the currently cached files to look up files)
(LET [(entries (for entry in \FCACHE.LIST
bind (filter ←(DIRECTORY.MATCH.SETUP pattern))
(hostName ←(fetch (CACHEDEVICE REALDEVICENAME) of device))
collect entry when (AND (OR (NOT dirtyOnly?)
(fetch CACHEISDIRTY of entry))
(DIRECTORY.MATCH filter (fetch REMOTEFILENAME
of entry))
[EQ hostName
(\FCACHE.CANONICAL.HOSTNAME
(FILENAMEFIELD (fetch REMOTEFILENAME
of entry)
(QUOTE HOST]
(if (NEQ (QUOTE NSFILING)
(\FCACHE.GENERIC.DEVICE.TYPE
(fetch (CACHEDEVICE REALDEVICE)
of device)))
then T
elseif (EQ FILING.ENUMERATION.DEPTH T)
then T
else (LESSP (\FCACHE.GENERATE.FILES.DEPTH
(fetch REMOTEFILENAME
of entry))
(PLUS (
\FCACHE.GENERATE.FILES.DEPTH
pattern)
FILING.ENUMERATION.DEPTH]
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \FCACHE.NEXT.LOCAL.FILE)
FILEINFOFN ←(FUNCTION \FCACHE.GENERATE.FILEINFO)
GENFILESTATE ←(create LocalFileGenerator
FileGenEntryList ←(if (MEMB (QUOTE SORT)
options)
then
[SORT
entries
(FUNCTION (LAMBDA (X Y)
(FMEMB (FILES.IN.ORDER?
(fetch
MATCHFILENAME
of X)
(fetch
MATCHFILENAME
of Y))
(QUOTE
(EQUAL LESSP]
else entries)
FileGenDirtyOnly? ← dirtyOnly?])
(\FCACHE.NEXT.LOCAL.FILE
[LAMBDA (genfilestate nameonly) (* smL " 5-Feb-86 11:18")
(* * The NEXTFILEFN for local file generation)
(LET [(entry (pop (fetch (LocalFileGenerator FileGenEntryList) of genfilestate]
(if (NULL entry)
then (* at the end)
(replace (LocalFileGenerator FileGenPrevEntry) of genfilestate with NIL)
NIL
elseif (AND (fetch (LocalFileGenerator FileGenDirtyOnly?) of genfilestate)
(NOT (fetch CACHEISDIRTY of entry)))
then (* skip this entry, it isn't dirty)
(\FCACHE.NEXT.LOCAL.FILE genfilestate nameonly)
else (* use this entry)
(replace (LocalFileGenerator FileGenPrevEntry) of genfilestate with entry)
(fetch REMOTEFILENAME of entry])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD LocalFileGenerator (FileGenEntryList FileGenDirtyOnly? FileGenPrevEntry)
(SYSTEM))
]
)
(* * Functions for finding a file in the cache)
(DEFINEQ
(\FCACHE.LOOKUP
[LAMBDA (DEVICE NAME/STREAM Verify?) (* smL " 7-Jul-86 13:52")
(* * Find the matching entry in the cache)
(* * NOTE: This fn returns holding the entries CACHELOCK. It should only be called from within a RESETLST!)
(OR (AND (STREAMP NAME/STREAM)
(STREAMPROP NAME/STREAM (QUOTE cacheEntry)))
(PROG ((ListOfEntries \FCACHE.LIST)
entry DAT verified?) (* First get the upper case file name)
(if (LITATOM NAME/STREAM)
then (SETQ NAME/STREAM (U-CASE NAME/STREAM))
elseif (STREAMP NAME/STREAM)
then (SETQ NAME/STREAM (U-CASE (fetch FULLFILENAME of NAME/STREAM)))
elseif (STRINGP NAME/STREAM)
then (SETQ NAME/STREAM (MKATOM (U-CASE NAME/STREAM)))
else (\ILLEGAL.ARG NAME/STREAM)) (* Now hunt for a cache entry that matches)
TryNextEntry
[SETQ entry (CAR (OR (LISTP ListOfEntries)
(RETURN NIL]
(if (EQ (fetch MATCHFILENAME of entry)
NAME/STREAM)
then (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(if (NOT (MEMB entry \FCACHE.LIST))
then (* The entry has been deleted by some other process!)
NIL
elseif (OR (NOT Verify?)
(\FCACHE.VERIFY entry DEVICE))
then (* it matches!)
(RETURN entry)
else (* The cache is invalid, so get rid of it)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"[Invalid cache file: "
(fetch REMOTEFILENAME of entry)
"]"))
(\FCACHE.DELETE.ENTRY entry)))
(SETQ ListOfEntries (CDR ListOfEntries))
(GO TryNextEntry])
(\FCACHE.PROMOTE
[LAMBDA (ENTRY DEVICE) (* smL "23-Sep-85 13:27")
(* * Promote ENTRY to head of cache so that is will be found faster the next time -- and won't be deleted to make
space for new files in the cache. It turns out that searching doing an \FCACHE.LOOKUP with about 200 entries in the
cache takes less than .4 seconds on a DTiger, even if the file is not found. This is quick enough that there no need
to try to speed up cache file lookup.)
[if (NEQ ENTRY (CAR \FCACHE.LIST))
then (for TAIL on \FCACHE.LIST when (EQ (CADR TAIL)
ENTRY)
do (RETURN (UNINTERRUPTABLY
(SETQ \FCACHE.LIST (CONS ENTRY \FCACHE.LIST))
(RPLACD TAIL (CDDR TAIL)))]
ENTRY])
(\FCACHE.USECACHE?
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE FILEPAGES) (* smL "13-Mar-86 10:02")
(* * Used by \FCACHE.OPENFILE to determine if opening a file should go thru the cache. -
Return NIL if the cache should be avoided -
a CACHENTRY if it is the entry that should be used -
the FULLNAME of the file if it is OK to cache it, but it isn't cached now)
(if (MEMB (QUOTE FCACHE.INTERNAL)
PARAMETERS)
then (* A FILECACHE internal call to OPENSTREAM)
NIL
else (LET* [[Don'tCacheFlag? (OR (MEMB (QUOTE DON'TCACHE)
PARAMETERS)
(CADR (ASSOC (QUOTE DON'TCACHE)
PARAMETERS]
(fullName (FDEVOP (QUOTE GETFILENAME)
DEVICE NAME RECOG DEVICE))
(cacheEntry (AND fullName (\FCACHE.LOOKUP DEVICE fullName T]
(if (NOT fullName)
then (* Can't even find the full file name)
NIL
elseif (AND cacheEntry (fetch CACHEISDIRTY of cacheEntry))
then (* The cache entry is the only valid copy of the file,
so we have to use it)
cacheEntry
elseif cacheEntry
then (SELECTQ ACCESS
(INPUT (* Perfectly safe to use the cache as we are not going
to be writing the file)
cacheEntry)
((OUTPUT BOTH APPEND)
(* Only use the cache entry if the cache is write
enabled.)
(if [AND (NOT Don'tCacheFlag?)
(MEMB (\FCACHE.PROPERTY (QUOTE USECACHE))
(QUOTE (T Write]
then cacheEntry
else NIL))
(\ILLEGAL.ARG ACCESS))
elseif [NOT (MEMB (\FCACHE.PROPERTY (QUOTE USECACHE))
(SELECTQ ACCESS
(INPUT (QUOTE (T Read)))
((OUTPUT BOTH APPEND)
(QUOTE (T Write)))
(\ILLEGAL.ARG ACCESS]
then (* Cache not enabled for the access mode)
NIL
elseif Don'tCacheFlag?
then (* We are told to not add the file to the cache)
NIL
elseif (NOT (ADD.FILE.TO.CACHE? fullName))
then (* The file is on the list of DONT.CACHE.FILES so
don't add it to the cache)
NIL
elseif [AND FILEPAGES (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES))
(GREATERP FILEPAGES (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES]
then (* File too big, don't bother)
NIL
else (* Go ahead and add it if you like)
fullName])
(\FCACHE.VERIFY
[LAMBDA (entry cacheDevice) (* smL "21-Aug-86 16:28")
(* * Verify that the entry is valid)
(* It is possible to pass in a name instead of a
device)
(if (OR (LITATOM cacheDevice)
(STRINGP cacheDevice))
then (SETQ cacheDevice (\GETCACHEDEVICEFROMHOSTNAME cacheDevice T)))
(AND (OR (\FCACHE.PROPERTY (QUOTE TRUST.CACHELIST))
(INFILEP (fetch LOCALFILENAME of entry)))
(OR [ILESSP (IDATE)
(PLUS (fetch TIMELASTVERIFIED of entry)
(TIMES (CONSTANT (DIFFERENCE (IDATE "1-JAN-80 12:00:01")
(IDATE "1-JAN-80 12:00:00")))
(\FCACHE.PROPERTY (QUOTE TIMETOVERIFY]
(\FCACHE.IGNOREDATECHECK? entry cacheDevice)
(WITH.MONITOR (fetch CACHELOCK of entry)
(if (OR (NOT (fetch CACHEISDIRTY of entry))
(fetch FILEXISTED of entry))
then (* entry is valid iff it matches the one out there)
(if [AND (REALDEVOP (QUOTE GETFILENAME)
cacheDevice
(fetch REMOTEFILENAME
of entry)
(QUOTE OLD)
cacheDevice)
(LET ((idate (REALDEVOP (QUOTE GETFILEINFO)
cacheDevice
(fetch
REMOTEFILENAME
of entry)
(QUOTE ICREATIONDATE)
cacheDevice)))
(AND (NUMBERP idate)
(IEQP idate
(fetch CACHEFILEDATE
of entry]
then (replace TIMELASTVERIFIED of entry
with (OR (IDATE)
0))
T)
else (* it is the most recent, so it is up to date)
T])
)
(DECLARE: EVAL@COMPILE
[DEFMACRO MatchFileName (fileName)
(* * Compute the match file name from a given filename)
(BQUOTE (MKATOM (U-CASE , fileName]
)
(* * Try to figure out if a host is up)
(DEFINEQ
(\FCACHE.HOSTUP?
[LAMBDA (name) (* smL " 3-Sep-86 16:04")
(* * Try to determine if the host if able to respond)
(if (MEMB (U-CASE (MKATOM name))
(FCACHE.GETPROP (QUOTE DEAD.HOSTS)))
then NIL
else (LET ((DEV (\GETDEVICEFROMNAME name T NIL))
(initialInterval 500)
(retryCount 5))
(SELECTQ (COND
(DEV (* use real DEV to determine the DEV type)
(SELECTQ (fetch OPENFILE of DEV)
((\LEAF.OPENFILE \FTP.OPENFILE)
(QUOTE LEAF))
(\NSFILING.OPENFILE (QUOTE NSFILING))
(fetch DEVICENAME of DEV)))
(T (* the FDEV doesn't exist, and we can't create one for
it, so it must be down)
(QUOTE NOFDEV)))
[LEAF (* We think its a LEAF server, so try PUP.ECHOUSER)
(RESETLST (PROG ((i 1)
(interval initialInterval)
(PORT (BESTPUPADDRESS name
*FILE-CACHE-MESSAGE-STREAM*))
(SOC (OPENPUPSOCKET))
echo OPUP IPUP ECHOPUPLENGTH)
(RESETSAVE NIL (LIST (QUOTE
CLOSEPUPSOCKET)
SOC))
(OR PORT (RETURN NIL))
TryAgain
(if (IGREATERP i retryCount)
then (RETURN NIL))
(SETQ OPUP (ALLOCATE.PUP))
(SETUPPUP OPUP PORT \PUPSOCKET.ECHO
\PT.ECHOME NIL SOC T)
(PUTPUPWORD OPUP 0 1)
(add (fetch PUPLENGTH of OPUP)
BYTESPERWORD)
(SETQ ECHOPUPLENGTH (fetch PUPLENGTH
of OPUP))
(SENDPUP SOC OPUP)
[COND
((SETQ IPUP (GETPUP SOC interval))
(COND
((PROG1 (AND (EQ (fetch PUPTYPE
of IPUP)
\PT.IAMECHO)
(EQ (fetch PUPIDHI
of IPUP)
(fetch PUPIDHI
of OPUP))
(EQ (fetch PUPIDLO
of IPUP)
(fetch PUPIDLO
of OPUP))
(EQ (fetch
PUPLENGTH
of IPUP)
ECHOPUPLENGTH)
(IEQP (GETPUPWORD
IPUP 0)
1))
(RELEASE.PUP IPUP))
(RETURN T]
(SETQ i (ADD1 i))
(SETQ interval (ITIMES interval 2))
(GO TryAgain]
[NSFILING (* We think its an NSFILING server, so try
NS.ECHOUSER)
(RESETLST (PROG ((i 1)
(interval initialInterval)
(ECHOADDRESS (if DEV
then (create NSADDRESS
using (
\NSFILING.ADDRESS
DEV)
NSSOCKET ←
\NS.WKS.Echo)
else (\COERCE.TO.NSADDRESS
name \NS.WKS.Echo)))
(NSOC (OPENNSOCKET))
echo OXIP IXIP ECHOXIPLENGTH XIPBASE NSOC)
(RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
NSOC))
(OR ECHOADDRESS (RETURN NIL))
TryAgain
(if (IGREATERP i retryCount)
then (RETURN NIL))
(SETQ OXIP (\FILLINXIP \XIPT.ECHO NSOC
ECHOADDRESS))
(XIPAPPEND.WORD OXIP \XECHO.OP.REQUEST)
(XIPAPPEND.WORD OXIP 1)
(SETQ ECHOXIPLENGTH (fetch XIPLENGTH
of OXIP))
(SENDXIP NSOC OXIP)
[COND
((SETQ IXIP (GETXIP NSOC interval))
(COND
((PROG1
(AND (EQ (fetch XIPTYPE
of IXIP)
\XIPT.ECHO)
(EQ (fetch XIPLENGTH
of IXIP)
ECHOXIPLENGTH)
(EQ (\GETBASE (SETQ XIPBASE
(fetch
XIPCONTENTS
of
IXIP))
0)
\XECHO.OP.REPLY))
(RELEASE.XIP IXIP))
(RETURN T]
(SETQ i (ADD1 i))
(SETQ interval (ITIMES interval 2))
(GO TryAgain]
(FLOPPY (* the FLOPPY disk)
(* Should be (FLOPPY.CAN.READP) but this triggers a
bug in the Floppy handler)
T)
(TCP (* A TCP device. Punt on them)
T)
(NOFDEV (* we can't create an FDEV for the device, so it can't
be up)
NIL)
T])
(\NSFILING.ADDRESS
[LAMBDA (DEV) (* lmm "14-Sep-85 16:27")
(CAR (fetch NSFSADDRESSES of (fetch NSFILESERVER of (fetch DEVICEINFO of DEV])
(\FCACHE.IGNOREDATECHECK?
[LAMBDA (entry cacheDevice) (* smL "21-Aug-86 17:42")
(* * Should we ignore the date check, or not?)
(RESETLST
(LET ((hostName (fetch (CACHEDEVICE REALDEVICENAME) of cacheDevice)))
(if (OR (fetch CACHEISDIRTY of entry)
(\FCACHE.ENTRYOPEN? entry))
then T
elseif (\FCACHE.HOSTUP? hostName)
then NIL
elseif (MEMB (U-CASE (MKATOM hostName))
(FCACHE.GETPROP (QUOTE DEAD.HOSTS)))
then T
else (SELECTQ (\FCACHE.PROPERTY (QUOTE UNSAFE))
(T (* We are told to use the local cache)
T)
(NOTIFY (* Use the cache, but notify the user what is going
on)
(printout *FILE-CACHE-MESSAGE-STREAM* T
"It doesn't look like I can check to see if"
,
(fetch LOCALFILENAME of entry)
, "is a valid cache for" , (fetch REMOTEFILENAME
of entry)
", but I'm using it anyway.")
T)
[ASK (* Ask to find out what to do)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
(CONCAT hostName " not responding..."))
(CLEARW msgWindow)
(printout msgWindow .FONT DEFAULTFONT "Can't verify if" T .FONT
BOLDFONT .TAB 10 (fetch LOCALFILENAME of entry)
.FONT DEFAULTFONT T "is a valid cache entry for"
.FONT BOLDFONT T .TAB 10 (fetch REMOTEFILENAME
of entry)
.FONT DEFAULTFONT T T .TAB 10 "I'll keep trying...")
(WINDOWPROP msgWindow (QUOTE ItemPicked)
NIL)
(LET [(menu (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE (("Trust the cache"
Use)
("Don't trust the cache"
Don'tUse)
("Add to DEAD.HOSTS"
MakeDead)))
WHENSELECTEDFN ←(FUNCTION
\FCACHE.HOSTDEAD.WHENSELECTEDFN]
(ADDMENU menu msgWindow
(create POSITION
XCOORD ←(IQUOTIENT
(DIFFERENCE (WINDOWPROP
msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 10)))
(ALLOW.BUTTON.EVENTS)
(during (\FCACHE.PROPERTY (QUOTE UNSAFE.TIMEOUT))
timerUnits (QUOTE SECONDS)
do (BLOCK)
(if (\FCACHE.HOSTUP? hostName)
then (RETURN NIL)
else (SELECTQ (WINDOWPROP msgWindow
(QUOTE ItemPicked))
(Use (RETURN T))
(Don'tUse (RETURN NIL))
(MakeDead
(pushnew (FCACHE.GETPROP
(QUOTE DEAD.HOSTS))
hostName)
(RETURN T))
NIL))
finally (RETURN (\FCACHE.PROPERTY (QUOTE
UNSAFE.DEFAULT]
(NIL (* We are running in cautious mode)
NIL)
NIL])
(\FCACHE.USELOCALDIRECTORY?
[LAMBDA (hostName filePattern) (* smL "21-Aug-86 17:42")
(* * The hostName is down, should we use the cached files to generate a directory?)
(RESETLST (if (\FCACHE.HOSTUP? hostName)
then NIL
elseif (MEMB (U-CASE (MKATOM hostName))
(FCACHE.GETPROP (QUOTE DEAD.HOSTS)))
then T
else (SELECTQ
(\FCACHE.PROPERTY (QUOTE UNSAFE))
(T (* We are told to use the local cache)
T)
(NOTIFY (* Use the cache, but notify the user what is going
on)
(printout *FILE-CACHE-MESSAGE-STREAM* T hostName ,
"does not seem to be responding for directory lookup "
"for file pattern " filePattern T
"Using local cache list instead.")
T)
[ASK (* Ask to find out what to do)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
(CONCAT hostName " not responding..."))
(CLEARW msgWindow)
(printout msgWindow .FONT DEFAULTFONT
"Can't use remote host for directory lookup for file"
T .FONT BOLDFONT .TAB 10 filePattern .FONT DEFAULTFONT T
T .TAB 10 "I'll keep trying...")
(WINDOWPROP msgWindow (QUOTE ItemPicked)
NIL)
(LET [(menu (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE (("Trust the cache" Use)
("Don't trust the cache"
Don'tUse)
("Add to DEAD.HOSTS"
MakeDead)))
WHENSELECTEDFN ←(FUNCTION
\FCACHE.HOSTDEAD.WHENSELECTEDFN]
(ADDMENU menu msgWindow
(create POSITION
XCOORD ←(IQUOTIENT
(DIFFERENCE (WINDOWPROP
msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 10)))
(ALLOW.BUTTON.EVENTS)
(during (\FCACHE.PROPERTY (QUOTE UNSAFE.TIMEOUT))
timerUnits (QUOTE SECONDS)
do (BLOCK)
(if (\FCACHE.HOSTUP? hostName)
then (RETURN NIL)
else (SELECTQ (WINDOWPROP msgWindow (QUOTE
ItemPicked))
(Use (RETURN T))
(Don'tUse (RETURN NIL))
(MakeDead (pushnew
(FCACHE.GETPROP
(QUOTE DEAD.HOSTS))
hostName)
(RETURN T))
NIL))
finally (RETURN (\FCACHE.PROPERTY (QUOTE UNSAFE.DEFAULT]
(NIL (* We are running in cautious mode)
NIL)
NIL])
(\FCACHE.HOSTDEAD.WHENSELECTEDFN
[LAMBDA (item menu button) (* smL " 5-Feb-86 13:51")
(* * The WHENSELECTEDFN for the abort windows used to prompt a user when a host is dead)
(LET ((msgWindow (WFROMMENU menu)))
(if [AND item (NOT (WINDOWPROP msgWindow (QUOTE ItemPicked]
then (SHADEITEM item menu GRAYSHADE)
(WINDOWPROP msgWindow (QUOTE ItemPicked)
(if (LITATOM item)
then item
else (CADR item])
)
(RPAQ? FCACHE.DEAD.HOSTS NIL)
(* * Functions for dealing with overflow of the cache)
(DEFINEQ
(\FCACHE.RESOURCES.ERROR
[LAMBDA (file) (* smL " 7-Jul-86 19:39")
(* * Called when there is a "FILE SYSTEM RESOURCES EXCEEDED" error.)
(* NOTE: this counts on the fact that there is only
one stream per file name!)
(LET [(stream (AND (OPENP file)
(GETSTREAM file]
(if [OR (AND (STREAMP stream)
(STREAMPROP stream (QUOTE cacheEntry)))
(for fn in (QUOTE (\FCACHE.LOAD \FCACHE.LOGENTRY \FCACHE.CLOSEFILE
FCACHE.DUMP))
thereis (STKPOS fn))
(EQ (\FCACHE.LOCALDEVICE)
(if stream
then (fetch DEVICE of stream)
else (\GETDEVICEFROMNAME file T]
then
(* Either: -
the error happened while trying to write to a cached file, -
the error happened inside of a cacher operation, -
Got the error on the local device -
in any case, make a bit of room and try again. There is nothing special about the number 10, it is just a
convienient number that is greater than zero.)
(\FCACHE.MAKEROOM 10)
else (* Not the cacher's problem)
NIL])
)
(* * Functions for writing out dirty files from the cache)
(DEFINEQ
(\FCACHE.ENTRYOPEN?
[LAMBDA (entry) (* smL "14-Jun-85 11:37")
(* * Is the file this entry describes open?)
(DECLARE (GLOBALVARS \OPENFILES))
(for stream in \OPENFILES thereis (EQ entry (STREAMPROP stream (QUOTE cacheEntry])
(\FCACHE.FLUSH
[LAMBDA NIL (* smL "30-Jul-86 16:35")
(* * Flushes dirty files out the the remote hosts -
intended to run as a background process.)
(while T
do (BLOCK (\FCACHE.PROPERTY (QUOTE DUMPSLEEP)))
(for entry in \FCACHE.LIST bind [time ←(DIFFERENCE (IDATE)
(\FCACHE.PROPERTY
(QUOTE DUMPIDLE]
eachtime (BLOCK) when (AND (fetch CACHEISDIRTY of entry)
(FIXP (fetch CACHETIMECLOSED of entry))
(GREATERP time (fetch CACHETIMECLOSED
of entry)))
do (\FCACHE.WRITEOUT entry])
(\FCACHE.WRITEOUT
[LAMBDA (entry) (* smL "30-Jul-86 17:59")
(* * Write a cache entry out to the remote host)
(RESETLST (OBTAIN.MONITORLOCK \FCACHE.DUMPLOCK NIL T)
(OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(PROG ((originalFileName (fetch REMOTEFILENAME of entry))
(fileName (fetch REMOTEFILENAME of entry))
(localDevice (\FCACHE.LOCALDEVICE))
newFileName remoteDevice inStream outStream errorN (errorCount 0)
idate localIDate)
(* * First make sure that we can and should write out the entry)
StartAgain
(if (NOT (fetch CACHEISDIRTY of entry))
then (* we don't need to flush it)
(RETURN T)
elseif (\FCACHE.ENTRYOPEN? entry)
then (* can't flush files that are open)
(RETURN NIL)
elseif (NOT (INFILEP (fetch LOCALFILENAME of entry)))
then (* Gad, the cached file has disappeared!)
(\FCACHE.DELETE.ENTRY entry)
(LET ((msgWindow (\FCACHE.CREATE.MSG.WINDOW)))
(printout msgWindow "WARNING: the cached version of the file"
T T .FONT BOLDFONT originalFileName .FONT
DEFAULTFONT T T
"was deleted from the cache before it "
"be written to its host!" T T
"The file has been lost forever!"
T T
"Some Interlisp-D utilities might get confused "
"because the file no longer exists."))
(RETURN NIL)
elseif [NOT (AND (\FCACHE.HOSTUP? (FILENAMEFIELD fileName
(QUOTE HOST)))
(type? FDEV (SETQ remoteDevice (
\GETDEVICEFROMNAME fileName T]
then (* can't find the server)
(RETURN NIL))
(* * verify that the state of this file on the server out there has not changed)
(if (fetch FILEXISTED of entry)
then (if (NOT (FDEVOP (QUOTE GETFILENAME)
remoteDevice fileName (QUOTE OLD)
remoteDevice))
then (WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"When the cached file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT
"was created, a remote version of the file existed."
T
"It is now time to write out the cached version,"
T "but the remote file has disappeared!" T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Write it out anyway"
Same)
(
"Write it out somewhere else" Other)
(
"Delete the cache file" Delete]
(Same (CLOSEW msgWindow)
(GO OpenFiles))
(Other (SETQ newFileName
(
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL))
elseif (NOT (EQUAL (fetch CACHEFILEDATE of entry)
(FDEVOP (QUOTE GETFILEINFO)
remoteDevice fileName
(QUOTE ICREATIONDATE)
remoteDevice)))
then (WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"The remote version of "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT
"has changed since you wrote the cached file."
T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Write it out anyway"
Same)
(
"Write it out somewhere else" Other)
(
"Delete the cache file" Delete]
(Same (CLOSEW msgWindow)
(GO OpenFiles))
(Other (SETQ newFileName
(
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL))
else (GO OpenFiles))
else (if (FDEVOP (QUOTE GETFILENAME)
remoteDevice fileName (QUOTE OLD)
remoteDevice)
then (WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"When the cached file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT
"was created, no remote version of the file existed."
T
"It is now time to write out the cached version,"
T
"but a remote version of the file has since appeared!")
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Write it out anyway"
Same)
(
"Write it out somewhere else" Other)
("Delete the cache file"
Delete]
(Same (CLOSEW msgWindow)
(GO OpenFiles))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL))
else (GO OpenFiles)))
SetDumpFileName
(if newFileName
then (SETQ fileName (FULLNAME newFileName (QUOTE OLD/NEW)))
(replace REMOTEFILENAME of entry with fileName)
(replace MATCHFILENAME of entry with (MatchFileName fileName)
)
(SETQ remoteDevice (\GETDEVICEFROMNAME fileName T)))
(* * open the streams for the copy)
OpenFiles
(if (NULL inStream)
then [SETQ inStream (OPENSTREAM (fetch LOCALFILENAME
of entry)
(QUOTE INPUT)
(QUOTE OLD)
(QUOTE (SEQUENTIAL T]
(if inStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
inStream))
(replace USERVISIBLE of inStream with NIL)
else (RETURN NIL)))
(SETQ idate (FDEVOP (QUOTE GETFILEINFO)
localDevice inStream (QUOTE ICREATIONDATE)
localDevice))
(SETQ localIDate (OR idate (IDATE)))
[SETQ outStream
(CAR (NLSETQ (OPENSTREAM
fileName
(QUOTE OUTPUT)
(QUOTE OLD/NEW)
(BQUOTE (FCACHE.INTERNAL
(TYPE (\, (FDEVOP (QUOTE GETFILEINFO)
localDevice inStream
(QUOTE TYPE)
localDevice)))
(CREATIONDATE (\, (GDATE idate)))
(SEQUENTIAL T)
(LENGTH (\, (FDEVOP (QUOTE GETFILEINFO)
localDevice inStream
(QUOTE LENGTH)
localDevice]
[if outStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
outStream))
(replace USERVISIBLE of outStream with NIL)
else (* ugh -- the remote file won't open!)
(add errorCount 1)
(SETQ errorN (ERRORN))
(SELECTQ
(CAR errorN)
(41 (* the current user does not have write access to the
directory)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"You do not have write privilege for the file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT DEFAULTFONT)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
("Write it out somewhere else"
Other)
("Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME fileName
msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL)))
(42 (* the file name was bad)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT "The cached file " T .FONT
BOLDFONT .TAB 10 fileName T .FONT DEFAULTFONT
"does not appear to have a legal file name."
T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
("Write it out somewhere else"
Other)
("Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME fileName
msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL)))
(22 (* there was no room for the file)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"There is not enough space on the server to write out the cached file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT DEFAULTFONT T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
("Write it out somewhere else"
Other)
("Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME fileName
msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL)))
[9 (* a generic "File Won't Open" error.
Possibly caused by the LEAF cache not having closed
the file yet. Try it again.)
(if (LESSP errorCount 4)
then (* try it again, after a delay to let the LEAF cache
get dumped)
(CLEAR.LEAF.CACHE (FILENAMEFIELD fileName
(QUOTE HOST)))
(BLOCK 1000)
(GO OpenFiles)
else (* we have already tried it 3 times, so give up)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT "The error '"
(ERRORSTRING (CAR ERRORN))
"'" ,
"occured while trying to write out the cache file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
(
"Write it out somewhere else" Other)
("Delete the cache file"
Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL]
(PROGN (* The default case -- an unknow error)
(if (LESSP errorCount 4)
then (CLEAR.LEAF.CACHE (FILENAMEFIELD fileName
(QUOTE HOST)))
(BLOCK 1000)
(GO OpenFiles)
else (* alter the user and then try again)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT "The error '"
(ERRORSTRING (CAR ERRORN))
"'" ,
"occured while trying to write out the cache file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE ((
"Try to write it out again" TryAgain)
(
"Write it out somewhere else" Other)
(
"Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName
(
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL]
(* * Copy it out)
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Writing out " fileName " ("
(fetch CACHEFILELENGTH
of entry)
" pages)"))
(COPYCHARS inStream outStream)
(CLOSEF? inStream)
(if [LET [(closed? (NLSETQ (CLOSEF? outStream]
(AND (NOT (NULL closed?))
(NOT (NULL (CAR closed?]
then (replace CACHEISDIRTY of entry with NIL)
(replace FILEXISTED of entry with NIL)
(replace CACHEFILEDATE of entry with idate)
(if (NOT (EQP localIDate idate))
then (SETFILEINFO (fetch LOCALFILENAME of entry)
(QUOTE ICREATIONDATE)
idate))
(\FCACHE.LOGENTRY entry)
(replace TIMELASTVERIFIED of entry with (IDATE))
(if (NEQ originalFileName fileName)
then (LET ((msgWindow (\FCACHE.CREATE.MSG.WINDOW)))
(printout msgWindow
"WARNING: the file that was supposed to be "
T .FONT BOLDFONT .TAB 10
originalFileName T .FONT DEFAULTFONT
"was actually stored as "
T .FONT BOLDFONT .TAB 10 fileName T
.FONT DEFAULTFONT
"Some Interlisp-D utilities might get "
"confused by the rename, since Lisp thought it wrote out "
originalFileName ,
"but it actually didn't. You should try to clean up "
"before accessing the file again. "
"Close TEdit windows and Get the files anew; "
"close Lafite folders and Browse them again; "
"or do an explicit LOADFROM again for Lisp source files.")))
(RETURN T)
else (RETURN NIL))
DeleteEntry
(CLOSEF? inStream)
(\FCACHE.DELETE.ENTRY entry)
(RETURN NIL])
(\FCACHE.WRITEOUT.NEWFILENAME
[LAMBDA (msgWindow items) (* smL "21-Aug-86 17:39")
(* * Put up a menu in the window and wait for the user to pick one of the items. Return the selected item)
(PROG [(event (CREATE.EVENT (QUOTE \FCACHE.WRITEOUT)))
(menu (create MENU
CENTERFLG ← T
MENUCOLUMNS ← 1
ITEMS ← items
WHENSELECTEDFN ←(FUNCTION \FCACHE.WRITEOUT.WHENSELECTEDFN]
(PUTMENUPROP menu (QUOTE event)
event)
(ADDMENU menu msgWindow (create POSITION
XCOORD ←(QUOTIENT (DIFFERENCE
(WINDOWPROP msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 5))
(ALLOW.BUTTON.EVENTS)
WAIT(AWAIT.EVENT event)
(if (NULL (GETMENUPROP menu (QUOTE selected)))
then (GO WAIT)
else (RETURN (GETMENUPROP menu (QUOTE selected])
(\FCACHE.WRITEOUT.READNEWFILENAME
[LAMBDA (file msgwindow) (* smL "24-Feb-86 13:45")
(* * Prompt the user for a new file name)
(LET [(pwindow (GETPROMPTWINDOW (MAINWINDOW msgWindow T)
(for line in (LIST "Write it out where >" fileName)
bind (font ←(DSPFONT NIL msgwindow))
(width ←(WINDOWPROP msgwindow (QUOTE WIDTH)))
sum (FIX (PLUS .9 (FQUOTIENT (STRINGWIDTH line
font)
width]
(CLEARW pwindow)
(PROMPTFORWORD "Write it out where >" fileName NIL pwindow])
(\FCACHE.WRITEOUT.WHENSELECTEDFN
[LAMBDA (item menu button) (* smL " 5-Feb-86 11:33")
(* * An item has been chosen from a msg window during an \FCACHE.WRITEOUT)
(SHADEITEM item menu GRAYSHADE)
(PUTMENUPROP menu (QUOTE selected)
item)
(NOTIFY.EVENT (GETMENUPROP menu (QUOTE event])
)
(RPAQ \FCACHE.DUMPLOCK (CREATE.MONITORLOCK "File cache writout"))
(* * Functions for dumping and restoring information about the contents of the cache)
(DEFINEQ
(\FCACHE.ADDENTRY
[LAMBDA (LOCALNAME REMOTENAME ICREATIONDATE PROPS PAGES) (* smL "27-Feb-86 13:15")
(* * Add an entry to the cache directory. This goes on the front of the directory so it will be found quickly in
the future.)
(* * NOTE: This code assumes that it is called within a RESETLST that will release the entry's CACHELOCK)
(LET ((ENTRY (create CACHENTRY
REMOTEFILENAME ← REMOTENAME
LOCALFILENAME ← LOCALNAME
MATCHFILENAME ←(MatchFileName REMOTENAME)
CACHEFILEPROPS ← PROPS
CACHEFILEDATE ← ICREATIONDATE
CACHEFILELENGTH ← PAGES)))
(OBTAIN.MONITORLOCK (fetch CACHELOCK of ENTRY)
NIL T)
(push \FCACHE.LIST ENTRY)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY (QUOTE SIZE))
PAGES))
(\FCACHE.LOGENTRY ENTRY)
ENTRY])
(\FCACHE.DUMP.ENTRY
[LAMBDA (entry stream) (* smL " 7-Jul-86 11:07")
(* * Write out a single entry to the info file)
(RESETLST (RESETSAVE (RADIX 10))
(RESETSAVE (SETREADTABLE \FCACHE.DIR.READTABLE))
(with CACHENTRY entry
(printout stream T "(" .P2 REMOTEFILENAME , .P2 LOCALFILENAME T .P2
CACHEISDIRTY , .P2 FILEXISTED , .P2 CACHEFILELENGTH , .P2
CACHEFILEPROPS , .P2 CACHEFILEDATE , .P2 CACHETIMECLOSED ")" T])
(\FCACHE.FILEMATCH?
[LAMBDA (fullName fileSpec) (* smL "21-Aug-86 17:06")
(* * Does the file match the spec?)
(LET [(fileSpecHost (FILENAMEFIELD fileSpec (QUOTE HOST]
(AND [OR (NOT fileSpecHost)
(EQ (\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD fileSpec (QUOTE HOST)))
(\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD fullName (QUOTE HOST]
(DIRECTORY.MATCH (DIRECTORY.MATCH.SETUP fileSpec)
fullName])
(\FCACHE.LOGENTRY
[LAMBDA (entry) (* smL " 9-Aug-85 10:18")
(* * Dribble out a bit of into to the cache log file so we know the state of the cache if the system dies an
ungraceful death)
(SETQ \FCACHE.LIST.CHANGED? T)
(if (\FCACHE.PROPERTY (QUOTE PREFIX))
then (if [NOT (AND (STREAMP \FCACHE.LOGFILE)
(OPENP \FCACHE.LOGFILE (QUOTE OUTPUT]
then (if (STREAMP \FCACHE.LOGFILE)
then (CLOSEF? \FCACHE.LOGFILE))
(SETQ \FCACHE.LOGFILE (OPENSTREAM (PACK* (\FCACHE.PROPERTY (QUOTE PREFIX))
"FCache.Log;1")
(QUOTE OUTPUT)
(QUOTE OLD/NEW)))
(replace USERCLOSEABLE of \FCACHE.LOGFILE with NIL)
(replace USERVISIBLE of \FCACHE.LOGFILE with NIL))
(\FCACHE.DUMP.ENTRY entry \FCACHE.LOGFILE)
(FORCEOUTPUT \FCACHE.LOGFILE T])
(\FCACHE.RESTORE
[LAMBDA (prefix) (* smL " 7-Jul-86 11:08")
(* * Restore the cache info dumped out by a previous system -- return T if success, NIL if failure)
(RESETLST (* Clear the cache of the local device)
(SETQ \FCACHE.LOCALDEVICE NIL)
(if (NULL prefix)
then (* disable the cache)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"Cache prefix is NIL, so disabling cache."))
(SETQ \FCACHE.LIST NIL)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
0)
(\FCACHE.PROPERTY.PUT (QUOTE PREFIX)
prefix)
T
elseif (NULL (\GETDEVICEFROMNAME prefix T))
then (* prefix is bad)
NIL
elseif (LET (testFile) (* can we access that directory?)
[RESETSAVE NIL (LIST [FUNCTION (LAMBDA (s)
(if (STREAMP s)
then (CLOSEF? s)
(DELFILE (fetch
FULLFILENAME
of s]
(SETQ testFile
(CAR (NLSETQ (OPENSTREAM
(PACK* prefix
"fcache.temp")
(QUOTE OUTPUT)
(QUOTE NEW]
testFile)
then
(PROG (name stream entryDef)
(SETQ \FCACHE.LIST NIL)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
0)
(\FCACHE.PROPERTY.PUT (QUOTE PREFIX)
prefix)
(if [NULL (SETQ name (INFILEP (PACK* prefix "FCache.Listing;1"]
then (* nothing to restore)
(RETURN T))
[RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(SETQ stream (OPENSTREAM name (QUOTE
INPUT)
(QUOTE OLD]
(\FCACHE.DONE.OR.ABORTED.MSG "Restoring cache")
(RESETSAVE (SETREADTABLE \FCACHE.DIR.READTABLE))
(* Read in the warning msg, and make sure that it is
correct.)
(if (NOT (LET [(header (CAR (NLSETQ (READ stream]
(if (AND (EQ (CAR header)
(QUOTE ERROR))
(EQUAL (CADR header)
"This file cannot be LOADed. Do not delete or alter this file!"))
then (* The file header matches, so parse the properties)
[LET [(plist (EVAL (CADDR header]
(SETQ \FCACHE.LISTING.VERSION.NUMBER
(OR (NUMBERP
(LISTGET plist
(QUOTE
FCacheVersion))
0)))
[if (GEQ
\FCACHE.LISTING.VERSION.NUMBER 1)
then (\FCACHE.PROPERTY.PUT
(QUOTE MAXSIZE)
(LISTGET plist
(QUOTE
MaxSize]
(if (GEQ
\FCACHE.LISTING.VERSION.NUMBER 1.6)
then (\FCACHE.PROPERTY.PUT
(QUOTE MAXFILEPAGES)
(LISTGET plist
(QUOTE
MaxFilePages]
T
else NIL)))
then (LET ((errorWindow (CREATEW (create REGION
LEFT ← 300
BOTTOM ← 300
WIDTH ← 425
HEIGHT ← 120)
"File cache warning")))
(printout errorWindow
"WARNING: The file cache directory file was trashed!"
"The cacher has lost track of all the files in the cache."
"If there were any files that needed to be dumped, "
"they have been lost!" T T
"You should run FCACHE.SCAVENGE soon to clean up your disk."))
(GO BADINFOFILE))
NEXTENTRY
(if (EOFP stream)
then (LET ((errorWindow (CREATEW (create REGION
LEFT ← 300
BOTTOM ← 300
WIDTH ← 425
HEIGHT ← 120)
"File cache warning")))
(printout errorWindow
"WARNING: The file cache directory file was not completly dumped."
"The cacher may have lost track of some files."
"If there were any files that needed to be dumped, "
"they may have been lost!" T T
"You should run FCACHE.SCAVENGE soon to clean up your disk."))
(GO BADINFOFILE)
elseif (EQ [SETQ entryDef (CAR (NLSETQ (READ stream]
(QUOTE STOP))
then (GO DONE)
elseif (NLSETQ (\FCACHE.RESTORE.ENTRY entryDef))
then (* a good entry def)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* "."))
else (* a bad entry def)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* "?")))
(GO NEXTENTRY)
BADINFOFILE
(CLOSEF? stream)
(DELFILE name)
(GO CLEANUP)
DONE(CLOSEF? stream)
CLEANUP
[if (LESSP \FCACHE.LISTING.VERSION.NUMBER 5.0)
then
(* At version 5.0 there was a change in the way that the listing file gets written. If an older version attempts to
read a cache listing created after version 5.0, it will not see any MATCHFILENAME fields in the cache entries.
It might then add a file to the cache that is already cached. Then, if you go back to a more recent version of the
cacher, it would find two different cache enties for the same file. TROUBLE! The following is an attempt to take
care of this odd situation.)
(for entries on \FCACHE.LIST
do (for e in (CDR entries)
when (EQ (fetch MATCHFILENAME of e)
(fetch MATCHFILENAME
of (CAR entries)))
do (if (\FCACHE.PRINT.MESSAGE?)
then (printout
*FILE-CACHE-MESSAGE-STREAM*
"[Duplicate cache file!]"
T))
(\FCACHE.DELETE.ENTRY e]
(RETURN T))
else (* nope, can't access the directory at that prefix)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T "Cache can't write to "
prefix "!"])
(\FCACHE.RESTORE.ENTRY
[LAMBDA (entryList first?) (* smL "27-Feb-86 13:16")
(* * Restore an entryList to the cache list. Put it at the end of the list because of the order they are read in.)
(LET [[entry (create CACHENTRY
REMOTEFILENAME ←(CAR entryList)
LOCALFILENAME ←(CADR entryList)
CACHEISDIRTY ←(CADDR entryList)
FILEXISTED ←(CADDDR entryList)
CACHEFILELENGTH ←(CAR (CDDDDR entryList))
CACHEFILEPROPS ←(CADR (CDDDDR entryList))
CACHEFILEDATE ←(CADDR (CDDDDR entryList))
CACHETIMECLOSED ←(CADDDR (CDDDDR entryList))
MATCHFILENAME ←(MatchFileName (CAR entryList]
(oldEntry (for x in \FCACHE.LIST bind (name ←(CADR entryList))
thereis (EQ name (fetch LOCALFILENAME of x]
[if oldEntry
then (SETQ \FCACHE.LIST (DREMOVE oldEntry \FCACHE.LIST))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE (\FCACHE.PROPERTY (QUOTE SIZE))
(fetch CACHEFILELENGTH of oldEntry]
(SETQ \FCACHE.LIST (if first?
then (CONS entry \FCACHE.LIST)
else (NCONC1 \FCACHE.LIST entry)))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY (QUOTE SIZE))
(fetch CACHEFILELENGTH of entry])
)
(RPAQ \FCACHE.DIR.READTABLE (COPYREADTABLE (QUOTE ORIG)))
(RPAQQ \FCACHE.LISTING.VERSION.NUMBER NIL)
(* * Data access functions)
(DEFINEQ
(\FCACHE.DEVINFO
[LAMBDA (dev) (* smL " 9-Apr-85 12:56")
(* * Get the cache dev info for this cache device)
(for devinfo in (\FCACHE.PROPERTY (QUOTE DEVICES)) thereis (EQ dev (fetch CACHEDEV of devinfo])
(\FCACHE.PUT.DEVINFO
[LAMBDA (dev info) (* smL " 9-Apr-85 13:14")
(* * Replace the device info record for this cache device)
(\FCACHE.PROPERTY.PUT (QUOTE DEVICES)
(CONS info (DREMOVE (\FCACHE.DEVINFO dev)
(\FCACHE.PROPERTY (QUOTE DEVICES])
)
(ADDTOVAR \SYSTEMCACHEVARS \FCACHE.LOCALDEVICE)
(RPAQ? \FCACHE.LOCALDEVICE NIL)
(RPAQ? \FCACHE.PROPERTIES (QUOTE (USECACHE T DEVICES NIL PREFIX NIL SIZE 0 MAXSIZE 10000
MAXFILEPAGES 600 UNSAFE ASK UNSAFE.TIMEOUT 30
UNSAFE.DEFAULT NIL TRUST.CACHELIST NIL SILENT NIL
DUMPSLEEP 60000 DUMPIDLE 20 FASTDIR NIL DELAY.DELETE NIL
KEEPVERSIONS 2 TIMETOVERIFY 5 BADDEVICES NIL)))
(RPAQ? \FCACHE.PROMPT.WINDOW (CREATEW (CREATEREGION 200 200 500 100)
"File cache prompt window" 15 T))
(RPAQ? \FCACHE.GENERIC.DEVICES NIL)
(* * Declarations and the like)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS REALDEVOP MACRO (X (LET [(realDevice (GENSYM (QUOTE realDevice]
(BQUOTE (LET [(, realDevice (fetch (CACHEDEVICE REALDEVICE)
of , (CADR X]
(if , realDevice then (FDEVOP ,@ (SUBST realDevice
(CADR X)
X))
else
(ERROR "Host not up" (fetch (CACHEDEVICE
REALDEVICENAME)
of , (CADR X]
)
(FILESLOAD FILECACHE-DECLS)
DONTEVAL@LOAD
(FILESLOAD NSFILING LLNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY DONTEVAL@COMPILE
(/DECLAREDATATYPE (QUOTE CACHENTRY)
(QUOTE (POINTER POINTER POINTER FLAG FLAG FIXP POINTER FIXP FLAG POINTER POINTER
FIXP))
(QUOTE ((CACHENTRY 0 POINTER)
(CACHENTRY 2 POINTER)
(CACHENTRY 4 POINTER)
(CACHENTRY 4 (FLAGBITS . 0))
(CACHENTRY 4 (FLAGBITS . 16))
(CACHENTRY 6 FIXP)
(CACHENTRY 8 POINTER)
(CACHENTRY 10 FIXP)
(CACHENTRY 8 (FLAGBITS . 0))
(CACHENTRY 12 POINTER)
(CACHENTRY 14 POINTER)
(CACHENTRY 16 FIXP)))
(QUOTE 18))
)
(* * Related files)
(FILESLOAD FILECACHE-BROWSER FILECACHE-SCAVENGE MERGE-FILEGEN)
(* * Initialize things)
(DEFINEQ
(\FCACHE.INITIALIZE
[LAMBDA NIL (* smL " 3-Sep-86 15:05")
(* * Initialize the FileCache stuff, UNDOably)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands ERRORTYPELST))
(if (NOT (\GETDEVICEFROMHOSTNAME (QUOTE FCACHE)
T))
then
(* * Change the user level IO functions so that they go thru the cache)
(* The lists of functions below is the result of (FINDCALLERS (QUOTE (\GETDEVICEFROMNAME))
(QUOTE ({Eris}<Lisp>Intermezzo>Sources>Fileio))) and (FINDCALLERS (QUOTE (\GETDEVICEFROMHOSTNAME))
(QUOTE ({Eris}<Lisp>Intermezzo>Sources>Fileio))))
(for fn in (QUOTE (\DELETEFILE \GENERATEFILES \GETFILENAME \GETFILENAME.OR.STREAM
\OPENFILE \RENAMEFILE DIRECTORYNAMEP GETFILEINFO
SETFILEINFO))
do (CHANGENAME fn (QUOTE \GETDEVICEFROMNAME)
(QUOTE \GETUSERDEVICEFROMNAME)))
(for fn in (QUOTE (DIRECTORYNAME)) do (CHANGENAME fn (QUOTE
\GETDEVICEFROMHOSTNAME)
(QUOTE
\GETUSERDEVICEFROMNAME)))
(* * The following device is used to catch events...)
(SETQ \FCACHE.DEVICE (create FDEV
EVENTFN ←(FUNCTION \FCACHE.DEVICE.EVENTFN)
DEVICENAME ←(QUOTE FCACHE)
NODIRECTORIES ← T
HOSTNAMEP ←(FUNCTION NILL)))
(\DEFINEDEVICE (QUOTE FCACHE)
\FCACHE.DEVICE)
(* * Catch changes in the user)
(MOVD? (QUOTE LOGIN)
(QUOTE \OLD/LOGIN))
[UNDOSAVE (QUOTE (MOVD (QUOTE \OLD/LOGIN)
(QUOTE LOGIN]
(MOVD (QUOTE \FCACHE.ADVISED.LOGIN)
(QUOTE LOGIN))
(* * Set up to catch "FILE SYSTEM RESOURCES EXCEEDED" erorrs)
(PUTASSOC 22 [QUOTE ((\FCACHE.RESOURCES.ERROR (CADR ERRORMESS]
ERRORTYPELST)
(* * Put a flush-cache entry on the background menu)
(if (NOT (ASSOC (QUOTE DumpCache)
BackgroundMenuCommands))
then
[push BackgroundMenuCommands
(QUOTE
(DumpCache (QUOTE (FCACHE.DUMP.ALL))
"Writes out all dirty files and updates the cache listing"
(SUBITEMS
(DumpCache (QUOTE (FCACHE.DUMP.ALL))
"Writes out all dirty files and updates the cache listing")
(BrowseCache (QUOTE (\FCACHE.FLUSH.INFOHOOK))
"Inspect the cache properties")
(ScavengeCache
(QUOTE (PRINT (FCACHE.SCAVENGE)))
"Scavenge the file cache, collecting a list of unknown files"
(SUBITEMS ("Collect files" [QUOTE (PRINT (SETQ IT
(
FCACHE.SCAVENGE]
"Scavenge the file cache, collecting a list of unknown files")
("Existing files"
[QUOTE (PRINT (SETQ IT (FCACHE.SCAVENGE
(QUOTE EXISTS]
"Scavenge the cache, making sure that each file in the cache exists")
("Verify files" [QUOTE
(PRINT (SETQ IT
(FCACHE.SCAVENGE
(QUOTE VERIFY]
"Scavenge the cache, verifying each file in the cache")
("Repair files" [QUOTE
(PRINT (SETQ IT
(FCACHE.SCAVENGE
(QUOTE REPAIR]
"Scavenge the cache, attempting to repair unknown files")))
(RecoverFile (QUOTE (FCACHE.RECOVER.DELETED.FILE))
"Recover a deleted file from the cache"]
(SETQ BackgroundMenu NIL))
(* * Make it all undoable)
(UNDOSAVE (QUOTE (FCACHE.VANQUISH)))
(* * Now start it all up)
(\FCACHE.INITIALIZE.PROPS)
(for devName in FCACHE.GENERIC.DEVICE.TYPES do (FCACHE.GENERIC.START devName])
(FCACHE.VANQUISH
[LAMBDA NIL (* smL " 7-Jul-86 18:08")
(* * Unload the cacher from the system, removing any and all traces that it ever existed)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands ERRORTYPELST))
(if (\GETDEVICEFROMNAME (QUOTE FCACHE)
T)
then [for entry in \FCACHE.LIST do (if (AND (fetch CACHEISDIRTY of entry)
(\FCACHE.ENTRYOPEN? entry))
then (ERROR
"Can't vanquish the file cacher -- a (cached) file is open and needs to be flushed!"
(fetch REMOTEFILENAME
of entry]
(for dev in \FCACHE.GENERIC.DEVICES do (FCACHE.GENERIC.STOP dev))
(\FCACHE.DEVICE.EVENTFN \FCACHE.DEVICE (QUOTE BEFORELOGOUT))
(for dev in (\FCACHE.PROPERTY (QUOTE DEVICES)) do (FCACHE.STOP (CAR dev)))
(if (GETD (QUOTE \OLD/LOGIN))
then (MOVD (QUOTE \OLD/LOGIN)
(QUOTE LOGIN)))
(\REMOVEDEVICE (\GETDEVICEFROMNAME (QUOTE FCACHE)
T])
)
(RPAQ FCACHE.VERSION.DATE " 3-Sep-86 18:30:34")
(RPAQQ FCACHE.VERSION.NUMBER 5.3)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\FCACHE.INITIALIZE)
)
(PUTPROPS FILECACHE COPYRIGHT ("Xerox Corporation" 1983 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7188 23720 (ADD.FILE.TO.CACHE? 7198 . 7564) (CACHE.FILE 7566 . 7929) (
FCACHE.DELETE.CACHE.ENTRY 7931 . 8432) (FCACHE.DUMP.ALL 8434 . 8869) (FCACHE.EXPUNGE.DELETED.FILES
8871 . 9191) (FCACHE.GENERIC.START 9193 . 10115) (FCACHE.GENERIC.STOP 10117 . 10641) (FCACHE.GETPROP
10643 . 11174) (FCACHE.PRIVATE.FILE? 11176 . 11481) (FCACHE.PUTPROP 11483 . 13394) (
FCACHE.RECOVER.DELETED.FILE 13396 . 15748) (FCACHE.START 15750 . 17895) (FCACHE.STOP 17897 . 19549) (
FCACHE.CACHELIST 19551 . 19816) (FCACHE.DIRTY? 19818 . 20257) (FCACHE.DUMP.FILE 20259 . 20800) (
FCACHE.DUMP 20802 . 23718)) (24696 25939 (\FCACHE.DONE.OR.ABORTED.MSG 24706 . 25383) (
\FCACHE.PRINT.MESSAGE? 25385 . 25937)) (26041 27146 (\FCACHE.PRINT.PROMPT 26051 . 26855) (
\FCACHE.CREATE.MSG.WINDOW 26857 . 27144)) (28728 35202 (\GETUSERDEVICEFROMNAME 28738 . 29484) (
\GETCACHEDEVICEFROMHOSTNAME 29486 . 32367) (\GETREALDEVICEFROMHOSTNAME 32369 . 33534) (
\FCACHE.CANONICAL.HOSTNAME 33536 . 34726) (\FCACHE.GENERIC.DEVICE.TYPE 34728 . 35200)) (35271 47073 (
\FCACHE.DELETE.ENTRY 35281 . 36705) (\FCACHE.EXPUNGE.DELETED.ENTRY 36707 . 37416) (\FCACHE.INVENTNAME
37418 . 37929) (\FCACHE.KEEPVERSIONS 37931 . 39174) (\FCACHE.LOAD 39176 . 43471) (
\FCACHE.MAKE.LEGAL.FILENAME 43473 . 43981) (\FCACHE.MAKEROOM 43983 . 46844) (
\FCACHE.MAKEROOM.DELETEABLE? 46846 . 47071)) (47477 49579 (\FCACHE.BUILD.DEVICE 47487 . 49173) (
\FCACHE.OFF 49175 . 49577)) (49646 53795 (\FCACHE.DEVICE.EVENTFN 49656 . 52252) (
\FCACHE.INITIALIZE.PROPS 52254 . 53793)) (54469 55331 (\FCACHE.GLOBAL.EVENT 54479 . 55329)) (55481
57696 (\FCACHE.AROUNDEXIT 55491 . 57694)) (57781 59057 (\FCACHE.BEFORELOGIN 57791 . 58742) (
\FCACHE.ADVISED.LOGIN 58744 . 59055)) (59339 86046 (\FCACHE.CLOSEFILE 59349 . 61189) (
\FCACHE.DELETEFILE 61191 . 62636) (\FCACHE.DIRECTORYNAMEP 62638 . 65700) (\FCACHE.EVENTFN 65702 .
67766) (\FCACHE.GENERATEFILES 67768 . 68573) (\FCACHE.GETFILEINFO 68575 . 69250) (\FCACHE.GETFILENAME
69252 . 74611) (\FCACHE.HOSTNAMEP 74613 . 74799) (\FCACHE.OPENFILE 74801 . 79155) (\FCACHE.RENAMEFILE
79157 . 81693) (\FCACHE.REOPENFILE 81695 . 83411) (\FCACHE.SETFILEINFO 83413 . 86044)) (86070 87955 (
\FCACHE.ENTRYINFO 86080 . 87953)) (88000 92252 (\FCACHE.GENERATE.FILEINFO 88010 . 88791) (
\FCACHE.GENERATE.FILES.DEPTH 88793 . 89217) (\FCACHE.GENERATE.LOCAL.FILES 89219 . 91240) (
\FCACHE.NEXT.LOCAL.FILE 91242 . 92250)) (92459 100385 (\FCACHE.LOOKUP 92469 . 94529) (\FCACHE.PROMOTE
94531 . 95390) (\FCACHE.USECACHE? 95392 . 98414) (\FCACHE.VERIFY 98416 . 100383)) (100591 112612 (
\FCACHE.HOSTUP? 100601 . 105682) (\NSFILING.ADDRESS 105684 . 105908) (\FCACHE.IGNOREDATECHECK? 105910
. 109190) (\FCACHE.USELOCALDIRECTORY? 109192 . 112045) (\FCACHE.HOSTDEAD.WHENSELECTEDFN 112047 .
112610)) (112709 114087 (\FCACHE.RESOURCES.ERROR 112719 . 114085)) (114153 133479 (\FCACHE.ENTRYOPEN?
114163 . 114496) (\FCACHE.FLUSH 114498 . 115235) (\FCACHE.WRITEOUT 115237 . 131393) (
\FCACHE.WRITEOUT.NEWFILENAME 131395 . 132430) (\FCACHE.WRITEOUT.READNEWFILENAME 132432 . 133095) (
\FCACHE.WRITEOUT.WHENSELECTEDFN 133097 . 133477)) (133643 144772 (\FCACHE.ADDENTRY 133653 . 134588) (
\FCACHE.DUMP.ENTRY 134590 . 135113) (\FCACHE.FILEMATCH? 135115 . 135657) (\FCACHE.LOGENTRY 135659 .
136648) (\FCACHE.RESTORE 136650 . 143327) (\FCACHE.RESTORE.ENTRY 143329 . 144770)) (144918 145593 (
\FCACHE.DEVINFO 144928 . 145235) (\FCACHE.PUT.DEVINFO 145237 . 145591)) (147418 152601 (
\FCACHE.INITIALIZE 147428 . 151410) (FCACHE.VANQUISH 151412 . 152599)))))
STOP