(FILECREATED "30-Jul-86 16:17:03" {PHYLUM}<LANNING>FILECACHE>FILECACHE-SCAVENGE.;1 14297
changes to: (VARS FILECACHE-SCAVENGECOMS))
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILECACHE-SCAVENGECOMS)
(RPAQQ FILECACHE-SCAVENGECOMS ((* * FILECACHE scavenging functions)
(FNS FCACHE.SCAVENGE)
(FNS \FCACHE.REPAIR \FCACHE.REPAIR.FINDFILE \FCACHE.REPAIR.VERIFY)
[INITVARS (FCACHE.SCAVENGE.IGNORE (QUOTE ((DANDELION FCACHE.POINTER FCACHE.LISTING FCACHE.LOG)
(DOVE FCACHE.POINTER FCACHE.LISTING FCACHE.LOG)
(DORADO FCACHE.POINTER FCACHE.LISTING FCACHE.LOG
COM.CM DISKDESCRIPTOR. DMT.BOOT DUMPER.BOOT
EXECUTIVE.RUN FTP.LOG FTP.RUN REM.CM SWAT.
SWATEE. SYS.BOOT SYS.ERRORS SYSDIR.
SYSFONT.AL USER.CM]
(GLOBALVARS FCACHE.SCAVENGE.IGNORE)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES FILECACHE-DECLS))))
(* * FILECACHE scavenging functions)
(DEFINEQ
(FCACHE.SCAVENGE
[LAMBDA (options) (* smL "11-Sep-85 11:47")
(* * Build a list of all files in the cache directory that are not known to the cacher, and not on the list
FCACHE.SCAVENGE.IGNORE)
(WITHOUT.FCACHE (WITH.MONITOR
\FCACHE.CACHELOCK
(LET ((options (MKLIST options))
badList) (* make sure the cache size is correct)
(if (NOT (MEMB (QUOTE SILENT)
options))
then (printout NIL "Recomputing cache size..." T))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(for entry in \FCACHE.LIST
sum (fetch CACHEFILELENGTH of entry)))
(* get rid of all entries that don't have coresponding
cached files)
(if (MEMB (QUOTE EXISTS)
options)
then (if (MEMB (QUOTE SILENT)
options)
then (for entry in \FCACHE.LIST
do (if (NOT (INFILEP (fetch
LOCALFILENAME
of entry)))
then (\FCACHE.DELETE.ENTRY entry)))
else (printout NIL "Verifying that cache files exist")
(for entry in \FCACHE.LIST
do (if (NOT (INFILEP (fetch LOCALFILENAME
of entry)))
then (printout NIL "?")
(\FCACHE.DELETE.ENTRY entry)
else (printout NIL ".")))
(printout NIL T)))
(* if we should, verify all files in the cache)
[if (MEMB (QUOTE VERIFY)
options)
then (if (MEMB (QUOTE SILENT)
options)
then (for entry in \FCACHE.LIST
do (if [NOT (WITH.MONITOR
(fetch CACHELOCK
of entry)
(\FCACHE.REPAIR.VERIFY
(fetch LOCALFILENAME
of entry)
(fetch REMOTEFILENAME
of entry]
then (\FCACHE.DELETE.ENTRY entry)))
else (printout NIL
"Verifying that cache files are valid copies"
T)
(for entry in \FCACHE.LIST
do (if [NOT (WITH.MONITOR
(fetch CACHELOCK
of entry)
(\FCACHE.REPAIR.VERIFY
(fetch LOCALFILENAME
of entry)
(fetch REMOTEFILENAME
of entry]
then (printout NIL "?")
(\FCACHE.DELETE.ENTRY entry)
else (printout NIL "."]
(* now collect the list of all files on the local disk
that are not cached files)
(if (NOT (MEMB (QUOTE SILENT)
options))
then (printout NIL "Collecting unknown files from the cache..." T))
(SETQ badList (for file inunsortedfiles (CONCAT
(FCACHE.GETPROP
(QUOTE PREFIX))
"*.*;*")
eachtime (SETQ file (MKATOM (U-CASE file)))
when [NOT (for entry in \FCACHE.LIST
thereis (EQ file
(fetch LOCALFILENAME
of entry]
collect file))
(* and then remove the files that match any on
FCACHE.SCAVENGE.IGNORE)
[for fileSpec in (CDR (ASSOC (MACHINETYPE)
FCACHE.SCAVENGE.IGNORE))
bind (host ←(FILENAMEFIELD (\FCACHE.PROPERTY (QUOTE PREFIX))
(QUOTE HOST)))
(dir ←(FILENAMEFIELD (\FCACHE.PROPERTY (QUOTE PREFIX))
(QUOTE DIRECTORY)))
while (NOT (NULL badList))
do (for file in badList when (\FCACHE.FILEMATCH?
file
(PACKFILENAME (QUOTE BODY)
fileSpec
(QUOTE
DIRECTORY)
dir
(QUOTE HOST)
host
(QUOTE VERSION)
"*"))
do (SETQ badList (DREMOVE file badList]
(* try to repair files if we are told to.)
[if (MEMB (QUOTE REPAIR)
options)
then (if (NOT (MEMB (QUOTE SILENT)
options))
then (printout NIL "Trying to repair unknown files..." T))
(for file in badList bind remoteFile alreadyCached
do [SETQ remoteFile (MKATOM (U-CASE (\FCACHE.REPAIR
file]
[SETQ alreadyCached
(AND remoteFile
(for entry in \FCACHE.LIST
when (EQ remoteFile
(fetch LOCALFILENAME
of entry))
thereis (\FCACHE.VERIFY
entry
(FILENAMEFIELD (fetch
REMOTEFILENAME
of entry)
(QUOTE
HOST]
(if (NOT (MEMB (QUOTE SILENT)
options))
then (if alreadyCached
then (printout NIL file
" is a duplicate copy of "
remoteFile T)
elseif remoteFile
then (printout NIL file
" is a copy of "
remoteFile T)
else (printout NIL
"Can't match the file "
file T)))
(if (AND (NOT alreadyCached)
remoteFile)
then (\FCACHE.ADDENTRY file remoteFile
(GETFILEINFO
file
(QUOTE ICREATIONDATE)
)
(GETFILEINFO
remoteFile
(QUOTE PLIST))
(GETFILEINFO
file
(QUOTE SIZE)))
(SETQ badList (DREMOVE file badList]
badList])
)
(DEFINEQ
(\FCACHE.REPAIR
[LAMBDA (localFileName) (* lmm " 6-Nov-85 15:58")
(* * Try to figure out what file this is a cached version of. RETURN the remote file name if you can)
(DECLARE (GLOBALVARS COMPILE.EXT LAFITEMAIL.EXT LAFITETOC.EXT LAFITEFORM.EXT
LAFITEFORMDIRECTORIES LAFITEDEFAULTHOST&DIR DISPLAYFONTDIRECTORIES
FILERDTBL DISPLAYFONTDIRECTORIES INTERPRESSFONTDIRECTORIES
PRESSFONTWIDTHSFILES LOGINHOST/DIR DIRECTORIES LISPUSERSDIRECTORIES))
(RESETLST (LET ((fileNameFields (U-CASE (UNPACKFILENAME localFileName)))
name ext stream expr)
(SETQ name (LISTGET fileNameFields (QUOTE NAME)))
(SETQ ext (LISTGET fileNameFields (QUOTE EXTENSION)))
(* * First try some magic based on the file name. If that doesn't work, try some generic method to find the remote
file. * *)
(OR (for lf in LOADEDFILELST when (STRPOS name lf)
when (EQ (PACKFILENAME (QUOTE NAME)
name
(QUOTE EXTENSION)
ext)
(NAMEFIELD lf T))
do (AND (\FCACHE.REPAIR.VERIFY localFileName lf)
(RETURN lf)))
(if (LISPSOURCEFILEP localFileName)
then (* possibly a LISP file -- see if the first expr in
the file is a FILECREATED expression)
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ stream (OPENSTREAM
localFileName
(QUOTE INPUT]
[SETQ expr (CAR (NLSETQ (READ stream FILERDTBL]
(if (AND (EQ (CAR expr)
(QUOTE FILECREATED))
(\FCACHE.REPAIR.VERIFY localFileName
(CADDR expr)))
then (CADDR expr)
else NIL))
(if (EQ ext COMPILE.EXT)
then [RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ stream (OPENSTREAM
localFileName
(QUOTE INPUT]
[SETQ expr (CAR (NLSETQ (READ stream FILERDTBL]
(if (EQ (CAR expr)
(QUOTE FILECREATED))
then
(* now (CADR (CADDR expr)) is a pointer to the source file, so we need to figure out what DCOM file this is)
[CAR (NLSETQ (for file
inunsortedfiles
(PACKFILENAME.STRING
(QUOTE EXTENSION)
COMPILE.EXT
(QUOTE VERSION)
(QUOTE *)
(QUOTE BODY)
(CADR (CADDR expr)))
thereis (
\FCACHE.REPAIR.VERIFY
localFileName file]
else NIL))
(if (MEMB ext (LIST LAFITEMAIL.EXT (PACK* LAFITEMAIL.EXT
LAFITETOC.EXT)
LAFITEFORM.EXT))
then (* a LAFITE file, so look in the users mail directory)
(\FCACHE.REPAIR.FINDFILE localFileName (OR
LAFITEDEFAULTHOST&DIR
LOGINHOST/DIR)))
(if (AND (BOUNDP (QUOTE LAFITEFORMDIRECTORIES))
LAFITEFORMDIRECTORIES
(EQ ext LAFITEFORM.EXT))
then (* a LAFITE form, so check the form directory)
(\FCACHE.REPAIR.FINDFILE localFileName (MKLIST
LAFITEFORMDIRECTORIES)))
(if (MEMB ext (CONS (QUOTE WD)
DISPLAYFONTEXTENSIONS))
then (* a font file, so check the font directories)
(\FCACHE.REPAIR.FINDFILE localFileName (UNION
DISPLAYFONTDIRECTORIES
INTERPRESSFONTDIRECTORIES)))
(if (AND (EQ name (QUOTE FONTS))
(EQ ext (QUOTE WIDTHS)))
then (* a fonts widths file)
(for file in PRESSFONTWIDTHSFILES
when (NOT (EQ (U-CASE (FILENAMEFIELD file
(QUOTE
HOST)))
(QUOTE DSK)))
thereis (\FCACHE.REPAIR.VERIFY localFileName file)))
(\FCACHE.REPAIR.FINDFILE localFileName (UNION (LIST LOGINHOST/DIR)
DIRECTORIES
LISPUSERSDIRECTORIES])
(\FCACHE.REPAIR.FINDFILE
[LAMBDA (localFile dirList) (* smL " 5-Feb-86 14:13")
(* * Kind of like FINDFILE, but keeps looking on the directories untill a file matches)
(CAR (NLSETQ (OR (for dir inside dirList bind full
when (AND (NOT (STRPOS "DSK" dir NIL NIL NIL NIL (
UPPERCASEARRAY)))
(SETQ full (INFILEP (PACKFILENAME.STRING
(QUOTE VERSION)
NIL
(QUOTE DIRECTORY)
dir
(QUOTE BODY)
localFile)))
(\FCACHE.REPAIR.VERIFY localFile full))
do (RETURN full))
(for dir inside dirList
bind (name ←(FILENAMEFIELD localFile (QUOTE NAME)))
(extension ←(FILENAMEFIELD localFile (QUOTE EXTENSION)))
remoteFile
when (NOT (STRPOS "DSK" dir NIL NIL NIL NIL (UPPERCASEARRAY)))
do (SETQ remoteFile (for file inunsortedfiles
(PACKFILENAME.STRING
(QUOTE DIRECTORY)
dir
(QUOTE NAME)
name
(QUOTE EXTENSION)
extension)
thereis (\FCACHE.REPAIR.VERIFY localFile
file)))
(if remoteFile
then (RETURN remoteFile])
(\FCACHE.REPAIR.VERIFY
[LAMBDA (localFile remoteFile) (* smL " 5-Feb-86 14:11")
(* * Is the local file a copy of the remote file?)
(CAR (NLSETQ (AND (INFILEP localFile)
(INFILEP remoteFile)
(for prop in (QUOTE (ICREATIONDATE LENGTH)) bind info
always (AND (SETQ info (GETFILEINFO localFile prop))
(EQUAL info (GETFILEINFO remoteFile prop])
)
(RPAQ? FCACHE.SCAVENGE.IGNORE (QUOTE ((DANDELION FCACHE.POINTER FCACHE.LISTING FCACHE.LOG)
(DOVE FCACHE.POINTER FCACHE.LISTING FCACHE.LOG)
(DORADO FCACHE.POINTER FCACHE.LISTING FCACHE.LOG COM.CM
DISKDESCRIPTOR. DMT.BOOT DUMPER.BOOT EXECUTIVE.RUN
FTP.LOG FTP.RUN REM.CM SWAT. SWATEE. SYS.BOOT
SYS.ERRORS SYSDIR. SYSFONT.AL USER.CM))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FCACHE.SCAVENGE.IGNORE)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD FILECACHE-DECLS)
)
(PUTPROPS FILECACHE-SCAVENGE COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (953 7318 (FCACHE.SCAVENGE 963 . 7316)) (7319 13702 (\FCACHE.REPAIR 7329 . 11758) (
\FCACHE.REPAIR.FINDFILE 11760 . 13204) (\FCACHE.REPAIR.VERIFY 13206 . 13700)))))
STOP