(FILECREATED "21-Feb-85 17:49:29" {ERIS}<LISPCORE>LIBRARY>MAILSCAVENGE.;3 11979
changes to: (FNS MAILSCAVENGE \MAILSCAVENGE.INTERNAL \PARSENMSGS1 \MSGERROR
MAILSCAVENGE.IN.PLACE)
(VARS MAILSCAVENGECOMS)
previous date: "21-Feb-85 14:59:04" {ERIS}<LISPCORE>LIBRARY>MAILSCAVENGE.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MAILSCAVENGECOMS)
(RPAQQ MAILSCAVENGECOMS ((FNS MAILSCAVENGE MAILSCAVENGE.IN.PLACE \MAILSCAVENGE.INTERNAL \PARSENMSGS1
\MSGERROR SEEMSG \MSGPOKE.INIT)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS *MSGHEADER*LENGTH)
(GLOBALVARS *START*PAT)
(LOCALVARS . T))
(VARS (*START*PAT "*start*
"))
(FILES (SYSLOAD FROM LISPUSERS)
BSEARCH)))
(DEFINEQ
(MAILSCAVENGE
[LAMBDA (FILENAME ERRORMSGSTREAM TEMPDIR) (* bvm: "21-Feb-85 17:44")
(PROG ((FULLFOLDERNAME (LA.LONGFILENAME FILENAME LAFITEMAIL.EXT))
TEMPFOLDER)
(SETQ FULLFOLDERNAME (OR (INFILEP FULLFOLDERNAME)
(LISPERROR "FILE NOT FOUND" FULLFOLDERNAME)))
[SETQ TEMPFOLDER (COND
((AND (NULL TEMPDIR)
(EQ (\GETDEVICEFROMHOSTNAME (QUOTE DSK))
(QUOTE PSEUDO-DSK))) (* Put it the same place as FILENAME if DSK is only
fake)
(PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE EXTENSION)
(QUOTE SCAVENGE$)
(QUOTE BODY)
FULLFOLDERNAME))
(T (* Put scratch file where requested, or {DSK})
(PACKFILENAME (QUOTE DIRECTORY)
(OR TEMPDIR (QUOTE {DSK}))
(QUOTE VERSION)
NIL
(QUOTE EXTENSION)
(QUOTE SCAVENGE$)
(QUOTE BODY)
FULLFOLDERNAME]
(SETQ TEMPFOLDER (COPYFILE FULLFOLDERNAME TEMPFOLDER))
(RETURN (COND
((NULL (\MAILSCAVENGE.INTERNAL TEMPFOLDER ERRORMSGSTREAM FULLFOLDERNAME))
(* Well-formed file)
(DELFILE TEMPFOLDER)
FULLFOLDERNAME)
((EQ (QUOTE Y)
(ASKUSER 100 (QUOTE N)
(CONCAT "Do you want to replace the mail file " FULLFOLDERNAME
" with the newly-scavenged version? ")))
(UNINTERRUPTABLY
(DELFILE FULLFOLDERNAME)
(RENAMEFILE TEMPFOLDER FULLFOLDERNAME)))
(T TEMPFOLDER])
(MAILSCAVENGE.IN.PLACE
[LAMBDA (FILE ERRORMSGSTREAM) (* bvm: "21-Feb-85 16:59")
(\MAILSCAVENGE.INTERNAL (LA.LONGFILENAME FILE LAFITEMAIL.EXT)
ERRORMSGSTREAM])
(\MAILSCAVENGE.INTERNAL
[LAMBDA (FILE ERRORMSGSTREAM REALNAME) (* bvm: "21-Feb-85 17:43")
(* * Does the scavenge destructively to FILE, returning NIL if nothing changed, the file name if it did.
REALNAME is the name of the "real" file being scavenged, if it differs)
(RESETLST (LET ((MSGNO 1)
(NOERRORFLG T)
(GOODMSGPTR 0)
(NEXTPTR 0)
FOLDERSTRM EOFPTR NOMOREP MSGLENGTHPTR ERRORSIGNAL ANYERRORS? SHORTP)
(DECLARE (SPECVARS FOLDERSTRM NOERRORFLG))
[RESETSAVE [SETQ FOLDERSTRM (OPENSTREAM FILE (QUOTE BOTH)
(QUOTE OLD)
NIL
(QUOTE ((ENDOFSTREAMOP \LAFITE.EOF]
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(OR REALNAME (SETQ REALNAME (FULLNAME FOLDERSTRM)))
(SETQ EOFPTR (GETEOFPTR FOLDERSTRM))
(COND
((ILEQ EOFPTR *MSGHEADER*LENGTH)
(ERROR "File too small to be a mail folder" REALNAME))
((NEQ 0 (\PARSENMSGS1 GOODMSGPTR 0 T)) (* Foo, something's wrong with the very first msg)
(OR (EQ (ASKUSER 100 (QUOTE N)
(CONCAT REALNAME
" -- Alleged mail folder doesn't begin with a correct mail header -- are you sure you want to go on? "
))
(QUOTE Y))
(HELP))
(SETFILEPTR FOLDERSTRM 0)
(LA.PRINTSTAMP FOLDERSTRM)))
(until (IGEQ NEXTPTR EOFPTR) finally (RETURN (COND
(ANYERRORS? (printout ERRORMSGSTREAM T)
REALNAME)
(T (printout ERRORMSGSTREAM REALNAME
" is a well-formed message file"
T)
NIL)))
do (COND
((FIXP (SETQ NEXTPTR (\PARSENMSGS1 GOODMSGPTR 1)))
(add MSGNO 1)
(SETQ GOODMSGPTR NEXTPTR))
(T (SETQ ERRORSIGNAL NEXTPTR)
[SETQ MSGLENGTHPTR (IPLUS GOODMSGPTR (CONSTANT (NCHARS *START*PAT]
(SETQ NEXTPTR (\PARSENMSGS1 MSGLENGTHPTR 1 T))
(* Something's wrong, so scan for the next msg
starter.)
(SETQ NOMOREP (EQUAL NEXTPTR "No more messages"))
(SETFILEPTR FOLDERSTRM MSGLENGTHPTR)
(* First, fix up the length field of the msg header.)
(LA.PRINTCOUNT (IDIFFERENCE (COND
((FIXP NEXTPTR)
NEXTPTR)
(NOMOREP EOFPTR)
(T (SHOULDNT)))
GOODMSGPTR)
FOLDERSTRM)
(SETQ SHORTP)
(SETQ ANYERRORS? T)
(COND
((EQUAL ERRORSIGNAL "Can't parse msg header")
(* Sigh, have to rewrite the rest of the header.)
(printout ERRORMSGSTREAM T "Rebuilding header for message number "
MSGNO)
(LA.PRINTCOUNT *MSGHEADER*LENGTH FOLDERSTRM)
(PRIN3 "UU
" FOLDERSTRM))
[(OR (EQUAL ERRORSIGNAL "Msg length in header is incorrect")
(SETQ SHORTP (EQUAL ERRORSIGNAL "Msg and/or header is too short")))
(COND
((AND SHORTP NOMOREP) (* Foo the terrible case of a zero-length message at
the end of the file)
(OR (FIXP (SETQ SHORTP (\PARSENMSGS1 (SUB1 GOODMSGPTR)
-1 T)))
(SHOULDNT)) (* Go back on message, and make it longer)
(add MSGNO -1)
[SETFILEPTR FOLDERSTRM (IPLUS SHORTP (CONSTANT (NCHARS *START*PAT]
(LA.PRINTCOUNT (IDIFFERENCE EOFPTR SHORTP)
FOLDERSTRM)
(SETFILEPTR FOLDERSTRM (SETQ GOODMSGPTR SHORTP))
(SETQ NEXTPTR 0))
(T (printout ERRORMSGSTREAM T
"Patching length field of header in message number "
MSGNO]
(T (SHOULDNT)))
(OR (FIXP NEXTPTR)
(SETQ NEXTPTR EOFPTR])
(\PARSENMSGS1
[LAMBDA (FOLDERFILEPTR N SCANFLG) (* bvm: "21-Feb-85 17:38")
(* Allegedly, FOLDERFILEPTR is the file address of a good message. But when N = 0, that's the signal simply to
certify that FOLDERFILEPTR starts a good message.)
(DECLARE (USEDFREE FOLDERSTRM))
(COND
((AND (EQ 0 N)
(FILEPOS *START*PAT FOLDERSTRM FOLDERFILEPTR FOLDERFILEPTR))
(* The case of N=0 permits a "stand still")
(BLOCK)
FOLDERFILEPTR)
((NOT (OPENP FOLDERSTRM))
(\MSGERROR "No more messages" (QUOTE CLOSED)))
(T (LET ((BACKWARDSP (ILESSP N 0))
(EOFPTR (GETEOFPTR FOLDERSTRM))
(NEXTSPOT FOLDERFILEPTR)
THISSPOT THISMSGSTART MAXSEARCHPOS MSGLENGTH HDRLENGTH FORMERSPOT)
(SETQ MAXSEARCHPOS (IMAX -1 (IDIFFERENCE EOFPTR *MSGHEADER*LENGTH)))
(for NN from N by (COND
(BACKWARDSP 1)
(T -1))
until (EQ 0 NN)
do (BLOCK)
(SETQ THISMSGSTART (IPLUS (SETQ THISSPOT NEXTSPOT)
*MSGHEADER*LENGTH))
[COND
[BACKWARDSP (COND
((ILESSP THISMSGSTART 0)
(RETURN (\MSGERROR "No more messages" 0)))
([NULL (SETQ NEXTSPOT (BFILEPOS *START*PAT FOLDERSTRM 0
(IDIFFERENCE THISSPOT
*MSGHEADER*LENGTH]
(RETURN (\MSGERROR "No *start* at beginning of folder?" 0]
[SCANFLG (SETQ NEXTSPOT (FFILEPOS *START*PAT FOLDERSTRM THISMSGSTART MAXSEARCHPOS))
(COND
((NULL NEXTSPOT)
(RETURN (\MSGERROR "No more messages" THISSPOT]
(T (SETFILEPTR FOLDERSTRM THISSPOT)
(COND
([OR (NOT (LA.READSTAMP FOLDERSTRM))
(NOT (SETQ MSGLENGTH (LA.READCOUNT FOLDERSTRM)))
(NOT (SETQ HEADERLENGTH (LA.READCOUNT FOLDERSTRM)))
(PROGN (BIN FOLDERSTRM)
(BIN FOLDERSTRM)
(BIN FOLDERSTRM) (* Read 3 status bytes)
(NEQ (BIN FOLDERSTRM)
(CHARCODE CR]
(RETURN (\MSGERROR "Can't parse msg header" THISSPOT)))
((OR (ILEQ MSGLENGTH HEADERLENGTH)
(IGEQ THISMSGSTART EOFPTR))
(RETURN (\MSGERROR "Msg and/or header is too short" THISSPOT)))
((COND
((ILESSP (SETQ NEXTSPOT (IPLUS THISSPOT MSGLENGTH))
MAXSEARCHPOS)
(SETFILEPTR FOLDERSTRM NEXTSPOT)
(NOT (LA.READSTAMP FOLDERSTRM)))
(T (IGREATERP NEXTSPOT EOFPTR)))
(RETURN (\MSGERROR "Msg length in header is incorrect" THISSPOT]
finally (RETURN NEXTSPOT])
(\MSGERROR
[LAMBDA (X N)
(DECLARE (USEDFREE FOLDERSTRM NOERRORFLG)) (* bvm: "21-Feb-85 17:38")
(OR (STRINGP X)
(\ILLEGAL.ARG X))
(COND
(NOERRORFLG X)
(T (ERROR X (LIST (QUOTE FULLNAME)
(FULLNAME FOLDERSTRM)
(QUOTE FILEPTR)
N])
(SEEMSG
[LAMBDA (FILE FOLDERFILEPTR SCANFLG OUTFILE)
(DECLARE (SPECVARS FILE FOLDERFILEPTR)) (* JonL " 1-Nov-84 18:29")
(\MSGPOKE.INIT SCANFLG)
[SETFILEPTR FILE (IPLUS FOLDERFILEPTR (CONSTANT (NCHARS *START*PAT]
(PROG [(MSGLENGTH (OR (FIXP (RATOM FILE))
(SHOULDNT "Can't parse msg length")))
(HDRLENGTH (OR (FIXP (RATOM FILE))
(SHOULDNT "Can't parse msgheader length"]
(COPYBYTES FILE OUTFILE (IPLUS FOLDERFILEPTR HDRLENGTH)
(IPLUS FOLDERFILEPTR MSGLENGTH)))
NIL])
(\MSGPOKE.INIT
[LAMBDA (SCANFORIT) (* JonL " 1-Nov-84 18:31")
(* Checks for certain errors, and sets FOLDERFILEPTR to the beginning of a message (or runs an error if it was
specified, but not at the beginning of a msg))
(DECLARE (USEDFREE FILE FOLDERFILEPTR))
(OR (OPENP FILE (QUOTE INPUT))
(ERRORX (LIST 13 FILE)))
(PROG ((STARTPOS (OR (FIXP FOLDERFILEPTR)
(GETFILEPTR FILE)))
VALIDPOS)
(COND
([OR (AND (SETQ VALIDPOS (FILEPOS *START*PAT FILE STARTPOS STARTPOS))
(IEQP VALIDPOS STARTPOS))
(AND SCANFORIT (SETQ VALIDPOS (OR (FFILEPOS *START*PAT FILE STARTPOS
(IDIFFERENCE (GETEOFPTR FILE)
*MSGHEADER*LENGTH))
(BFILEPOS *START*PAT FILE 0 STARTPOS]
(SETQ FOLDERFILEPTR VALIDPOS))
(T (ERROR FOLDERFILEPTR " - INDEX IS NOT AT BEGINNING OF A MSG"])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ *MSGHEADER*LENGTH 24)
(CONSTANTS *MSGHEADER*LENGTH)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *START*PAT)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(RPAQ *START*PAT "*start*
")
(FILESLOAD (SYSLOAD FROM LISPUSERS)
BSEARCH)
(PUTPROPS MAILSCAVENGE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (770 11571 (MAILSCAVENGE 780 . 2566) (MAILSCAVENGE.IN.PLACE 2568 . 2784) (
\MAILSCAVENGE.INTERNAL 2786 . 6800) (\PARSENMSGS1 6802 . 9605) (\MSGERROR 9607 . 9935) (SEEMSG 9937 .
10555) (\MSGPOKE.INIT 10557 . 11569)))))
STOP