(FILECREATED " 7-Oct-86 18:46:17" {ERIS}<LAFITE>SOURCES>LAFITEMAIL.;10 77587
changes to: (VARS LAFITEMAILCOMS)
previous date: " 1-May-86 15:35:53" {ERIS}<LAFITE>SOURCES>LAFITEMAIL.;9)
(* "
Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITEMAILCOMS)
(RPAQQ LAFITEMAILCOMS
((COMS (* ; "Retrieving mail")
(FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL \LAFITE.GETNEWMAIL1
\LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES \LAFITE.HANDLE.BIG.MESSAGE
\LAFITE.FIND.BREAKPOINT))
(COMS (* ; "Mail polling and registration")
(FNS \LAFITE.GET.USER.DATA LAFITECLEARCACHE FULLUSERNAME LAFITEMAILWATCH
\LAFITE.WAKE.WATCHER POLLNEWMAIL POLLNEWMAIL1 PRINTLAFITESTATUS))
(COMS (* ; "Parsing mail files")
(FNS PARSEMAILFOLDER PARSEMAILFOLDER1 BADMAILFILE BADMAILFILE.FLAGBYTE VERIFYMAILFOLDER
VERIFYFAILED READTOCFILE BADTOCFILE \LAFITE.TOCEOF LA.READCOUNT LA.PRINTCOUNT
LA.READSTAMP \LAFITE.VERIFYMSG LA.MSGFROMMEP LA.PRINTSTAMP LA.READSHORTSTRING
LA.PRINTSHORTSTRING LA.READSTRING)
(FNS LAFITE.PARSE.MSG.FOR.TOC LAFITE.FETCH.TO.FIELD LAFITE.PARSE.HEADER
LAFITE.GRAB.DATE LAFITE.READ.LINE.FOR.TOC LAFITE.READ.FORMAT
LAFITE.READ.NAME.FIELD LAFITE.READ.ONE.LINE.FOR.TOC LAFITE.READ.TO.EOL
LA.SKIP.TO.EOL LAFITE.SKIP.WHITE.SPACE)
(COMS (VARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.SUBJECTFIELDONLY)
(FNS LAFITE.INIT.PARSETABLES LAFITE.MAKE.PARSE.TABLE LAFITE.MAKE.PARSE.TABLE1)))
(COMS (INITVARS (MAILWATCHWAITTIME 5)
(LAFITEFLUSHMAILFLG T)
(LAFITETOC.EXT (QUOTE -LAFITE-TOC))
(LAFITENEWMAILTUNE)
(LAFITEGETMAILTUNE)
(LAFITE.AFTER.GETMAIL.FN))
(INITVARS (\LAFITE.LAST.STATUS))
(ADDVARS (\SYSTEMCACHEVARS \LAFITE.LAST.STATUS)))
(DECLARE: EVAL@COMPILE DONTCOPY
(GLOBALVARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.SUBJECTFIELDONLY
ADDRESSPARSERRDTBL DEFAULTREGISTRY LAFITEDEBUGFLG LAFITEFLUSHMAILFLG
LAFITEGETMAILTUNE LAFITEIFFROMMETHENSEENFLG LAFITENEWMAILTUNE LINEPARSERRDTBL
MAILWATCHWAITTIME \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL
\LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD
LAFITE.AFTER.GETMAIL.FN)
(FILES (SOURCE)
LAFITEDECLS))))
(* ; "Retrieving mail")
(DEFINEQ
(\LAFITE.GETMAIL
[LAMBDA (WINDOW MAILFILEDATA ITEM MENU) (* bvm: "25-Mar-84 17:20")
(\LAFITE.PROCESS (LIST (FUNCTION \LAFITE.GETMAIL.PROC)
(KWOTE WINDOW)
(KWOTE MAILFILEDATA)
(KWOTE ITEM)
(KWOTE MENU))
(QUOTE LAFITEGETMAIL])
(\LAFITE.GETMAIL.PROC
[LAMBDA (WINDOW MAILFOLDER ITEM MENU) (* bvm: "11-Nov-84 18:30")
(RESETLST (LA.RESETSHADE ITEM MENU)
(OBTAIN.MONITORLOCK (fetch FOLDERLOCK of MAILFOLDER)
NIL T)
(\LAFITE.MAYBE.CLEAR.PROMPT MAILFOLDER)
(OBTAIN.MONITORLOCK \LAFITE.MAILSERVERLOCK NIL T)
(\LAFITE.GETNEWMAIL MAILFOLDER WINDOW))
(\LAFITE.WAKE.WATCHER])
(\LAFITE.GETNEWMAIL
[LAMBDA (MAILFOLDER WINDOW) (* bvm: " 1-May-86 14:51")
(PROG (FIRSTMESSAGE)
(\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE APPEND))
[for MAILSERVER in [fetch (LAFITEUSERDATA MAILSERVERS)
of (OR (\LAFITE.GET.USER.DATA)
(PROGN (LAB.PROMPTPRINT MAILFOLDER "No mailboxes known")
(GO EXIT] bind MESSAGELIST NTHTIME
when (PROGN (COND
(NTHTIME (LAB.PROMPTPRINT MAILFOLDER "; "))
(T (SETQ NTHTIME T)))
(LAB.PROMPTPRINT MAILFOLDER (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER
)
" .. ")
(SETQ MESSAGELIST (\LAFITE.GETNEWMAIL1 MAILSERVER MAILFOLDER FIRSTMESSAGE)))
do (LAB.APPENDMESSAGES MAILFOLDER MESSAGELIST)
(COND
((NOT FIRSTMESSAGE) (* select the first new message --
all former messages have already been
unselected)
(SELECTMESSAGE (SETQ FIRSTMESSAGE (CAR MESSAGELIST))
MAILFOLDER)
(AND LAFITE.AFTER.GETMAIL.FN (APPLY* LAFITE.AFTER.GETMAIL.FN MAILFOLDER
MESSAGELIST]
(LAB.PROMPTPRINT MAILFOLDER (QUOTE %.))
[COND
(FIRSTMESSAGE (* If any mail was retrieved, select
the first message and make sure it is
visible)
(LAB.EXPOSEMESSAGE MAILFOLDER FIRSTMESSAGE)
(COND
(LAFITEGETMAILTUNE (PLAYTUNE LAFITEGETMAILTUNE]
EXIT])
(\LAFITE.GETNEWMAIL1
[LAMBDA (MAILSERVER MAILFOLDER NTHTIME) (* bvm: "24-Feb-86 16:56")
(PROG (MESSAGELIST OPENRESULT MAILBOX #OFMESSAGES OUTSTREAM)
(SETQ OPENRESULT (APPLY* (fetch (MAILSERVER OPENMAILBOX) of MAILSERVER)
(fetch (MAILSERVER MAILPORT) of MAILSERVER)
(fetch (LAFITEUSERDATA FULLUSERNAME) of \LAFITEUSERDATA)
(fetch (LAFITEUSERDATA ENCRYPTEDPASSWORD) of \LAFITEUSERDATA)
MAILSERVER))
[SELECTQ (COND
((LISTP OPENRESULT)
(SETQ MAILBOX (fetch (OPENEDMAILBOX MAILBOX) of OPENRESULT)))
(T OPENRESULT))
(EMPTY (LAB.PROMPTPRINT MAILFOLDER "empty")
(RETURN))
(NIL (* No response))
(COND
(MAILBOX (COND
((NOT NTHTIME)
(PRINTLAFITESTATUS (QUOTE NEW.MAIL))
(UNSELECTALLMESSAGES MAILFOLDER)))
(SETQ OUTSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE APPEND)))
(COND
((SETQ #OFMESSAGES (LISTGET (fetch (OPENEDMAILBOX PROPERTIES) of
OPENRESULT
)
(QUOTE #OFMESSAGES)))
(\LAFITE.GETNEWMAIL# MAILFOLDER #OFMESSAGES)))
(RETURN (COND
((SETQ MESSAGELIST (\LAFITE.RETRIEVEMESSAGES MAILSERVER MAILBOX
OUTSTREAM MAILFOLDER))
(* first flush the file back out to
disk before calling FLUSH *)
(\LAFITE.CLOSE.FOLDER MAILFOLDER)
(APPLY* (fetch (MAILSERVER CLOSEMAILBOX) of MAILSERVER)
MAILBOX LAFITEFLUSHMAILFLG)
(LAB.PROMPTPRINT MAILFOLDER "done")
[COND
((NULL #OFMESSAGES)
(\LAFITE.GETNEWMAIL# MAILFOLDER (LENGTH MESSAGELIST]
MESSAGELIST)
(T (* \LAFITE.RETRIEVEMESSAGES already
set the file ptr back, etc *)
(LAB.PROMPTPRINT MAILFOLDER "retrieval aborted")
(APPLY* (fetch (MAILSERVER CLOSEMAILBOX) of MAILSERVER)
MAILBOX NIL)
NIL]
(LAB.PROMPTPRINT MAILFOLDER "not responding")
(COND
((CDR (LISTP OPENRESULT)) (* Say more about why not responding)
(LAB.PROMPTPRINT MAILFOLDER " (" (fetch (OPENEDMAILBOX PROPERTIES) of OPENRESULT)
")"])
(\LAFITE.GETNEWMAIL#
[LAMBDA (MAILFOLDER #OFMESSAGES) (* bvm: " 4-Feb-86 12:17")
(LAB.PROMPTPRINT MAILFOLDER "(" #OFMESSAGES (COND
((EQ #OFMESSAGES 1)
" msg")
(T " msgs"))
") "])
(\LAFITE.RETRIEVEMESSAGES
[LAMBDA (MAILSERVER MAILBOX OUTSTREAM MAILFOLDER) (* bvm: "24-Feb-86 16:56")
(LET* ((ORIGEOF (GETEOFPTR OUTSTREAM))
(WINDOW (fetch BROWSERPROMPTWINDOW of MAILFOLDER))
(XPOS (AND WINDOW (DSPXPOSITION NIL WINDOW)))
(GOODEOFPTR ORIGEOF)
MESSAGELIST)
(COND
([ERSETQ (bind (NEXTMESSAGEFN ← (fetch (MAILSERVER NEXTMESSAGE) of MAILSERVER))
(RETRIEVEFN ← (fetch (MAILSERVER RETRIEVEMESSAGE) of MAILSERVER))
(ENDPOS ← ORIGEOF)
(COUNTER ← 0)
STARTPOS LENGTHPOS MSGLENGTH NEXTMESSAGERESULT MSG EXTRAMESSAGES
while (SETQ NEXTMESSAGERESULT (APPLY* NEXTMESSAGEFN MAILBOX))
unless (AND (LISTP NEXTMESSAGERESULT)
(LISTGET NEXTMESSAGERESULT (QUOTE DELETED)))
do
(* * print the message stamp to the file * *)
(SETFILEPTR OUTSTREAM (SETQ STARTPOS ENDPOS))
(OR (IEQP STARTPOS (GETEOFPTR OUTSTREAM))
(HELP "Confusion in new mail fileptr"))
(LA.PRINTSTAMP OUTSTREAM)
(SETQ LENGTHPOS (GETFILEPTR OUTSTREAM))
(PRIN3 "00000 00024 UU " OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE CR))
(* * now get the message and put it in the file * *)
(APPLY* RETRIEVEFN MAILBOX OUTSTREAM)
(SETQ MSGLENGTH (IDIFFERENCE (SETQ ENDPOS (GETFILEPTR OUTSTREAM))
STARTPOS))
(* * go back and print the message length in the stamp * *)
(SETQ MSG
(create LAFITEMSG
MARKCHAR ← UNSEENMARK
BEGIN ← STARTPOS
STAMPLENGTH ← LAFITESTAMPLENGTH
MESSAGELENGTH ← MSGLENGTH))
[COND
((IGREATERP MSGLENGTH 99999) (* Too big for this crufty format to
handle)
(SETQ EXTRAMESSAGES (\LAFITE.HANDLE.BIG.MESSAGE OUTSTREAM MAILFOLDER
MSG MSGLENGTH))
(SETQ MSGLENGTH (fetch (LAFITEMSG MESSAGELENGTH) of MSG))
(SETQ ENDPOS (GETEOFPTR OUTSTREAM]
(SETFILEPTR OUTSTREAM LENGTHPOS)
(LA.PRINTCOUNT MSGLENGTH OUTSTREAM)
(push MESSAGELIST MSG)
(COND
(EXTRAMESSAGES (for M in EXTRAMESSAGES do (push MESSAGELIST M))
(SETQ EXTRAMESSAGES)))
(COND
(XPOS (DSPXPOSITION XPOS WINDOW)
(printout WINDOW .I1 (add COUNTER 1]
(COND
(XPOS (* Prepare to overwrite counter with
"done")
(DSPXPOSITION XPOS WINDOW)))
(REVERSE MESSAGELIST))
(T (* something went drastically wrong!!!
-
repair the damage and get out *)
(SETFILEPTR OUTSTREAM ORIGEOF)
(SETFILEINFO OUTSTREAM (QUOTE LENGTH)
ORIGEOF)
(\LAFITE.CLOSE.FOLDER MAILFOLDER T)
(COND
(WINDOW (* Leave counter up as part of state
to show how far we got before aborting)
(SPACES 1 WINDOW)))
NIL])
(\LAFITE.HANDLE.BIG.MESSAGE
[LAMBDA (OUTSTREAM MAILFOLDER MSG TOTALLENGTH) (* bvm: "11-Mar-85 23:41")
(* Called when we receive a message that is longer than our mail file format
accommodates. Breaks it into two or more messages of suitable length, and
returns them)
(PROG ((TEMPFILE (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(TEMPSTART 0)
MSGLENGTH CRPOS SPACEPOS OUTSTREAMSTART RESTLENGTH HERE NEXTLENGTH LENGTHPOS HEADERLENGTH
MSGFIELDS)
(SETQ MSGFIELDS (LAFITE.PARSE.HEADER OUTSTREAM \LAPARSE.FULL (fetch (LAFITEMSG START)
of MSG)
(fetch (LAFITEMSG END) of MSG)))
(* get header info)
(SETQ MSGLENGTH (\LAFITE.FIND.BREAKPOINT OUTSTREAM (fetch (LAFITEMSG BEGIN) of MSG)
99999)) (* New length of first part of message)
[COPYBYTES OUTSTREAM TEMPFILE (SETQ OUTSTREAMSTART (IPLUS (fetch (LAFITEMSG BEGIN)
of MSG)
MSGLENGTH))
(IPLUS OUTSTREAMSTART (SETQ TOTALLENGTH (IDIFFERENCE TOTALLENGTH MSGLENGTH]
(* Save rest of message in TEMPFILE)
(replace (LAFITEMSG MESSAGELENGTH) of MSG with MSGLENGTH)
(SETFILEPTR OUTSTREAM OUTSTREAMSTART)
(RETURN (while (NEQ TOTALLENGTH 0)
collect (LA.PRINTSTAMP OUTSTREAM) (* Print a new header for next
continuation part)
(SETQ LENGTHPOS (GETFILEPTR OUTSTREAM))
(PRIN3 "00000 00024 UU " OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE CR))
(POSITION OUTSTREAM 0)
(LINELENGTH MAX.SMALLP OUTSTREAM)
(for PAIR in (REVERSE MSGFIELDS)
do (* Reconstruct some of header)
(SELECTQ (CAR PAIR)
((Date Sender From)
(printout OUTSTREAM (CAR PAIR)
": "
(CADR PAIR)
T))
((To cc Reply-to)
(for X in (CDR PAIR) do (printout OUTSTREAM (CAR PAIR)
": " X T)))
NIL))
(printout OUTSTREAM "Subject: (continuation of previous message)" T T)
(SETQ HEADERLENGTH (IDIFFERENCE (SETQ HERE (GETFILEPTR OUTSTREAM))
OUTSTREAMSTART))
(* This is how much we added by
putting in a message header and the
stamp section)
[COND
((IGREATERP (SETQ NEXTLENGTH (IPLUS (SETQ RESTLENGTH TOTALLENGTH)
HEADERLENGTH))
99999) (* Need to break up still more)
(SETQ RESTLENGTH (\LAFITE.FIND.BREAKPOINT TEMPFILE TEMPSTART
(IDIFFERENCE 99999 HEADERLENGTH)))
(SETQ NEXTLENGTH (IPLUS RESTLENGTH HEADERLENGTH]
(SETFILEPTR OUTSTREAM LENGTHPOS)
(LA.PRINTCOUNT NEXTLENGTH OUTSTREAM)
(* Store correct length of this
segment)
(SETFILEPTR OUTSTREAM HERE)
(SETFILEPTR TEMPFILE TEMPSTART)
(COPYBYTES TEMPFILE OUTSTREAM RESTLENGTH)
(PROG1 (create LAFITEMSG
MARKCHAR ← UNSEENMARK
BEGIN ← OUTSTREAMSTART
MESSAGELENGTH ← NEXTLENGTH
STAMPLENGTH ← LAFITESTAMPLENGTH)
(SETQ OUTSTREAMSTART (IPLUS OUTSTREAMSTART NEXTLENGTH))
(SETQ TEMPSTART (IPLUS TEMPSTART RESTLENGTH))
(SETQ TOTALLENGTH (IDIFFERENCE TOTALLENGTH RESTLENGTH])
(\LAFITE.FIND.BREAKPOINT
[LAMBDA (STREAM START LENGTH) (* bvm: " 7-Nov-84 14:07")
(* * Looks for a good breaking place in STREAM somewhere short of LENGTH beyond
START. Returns a new length less than or equal to LENGTH)
(SETFILEPTR STREAM (IPLUS START LENGTH -200))
(for I from 199 to 1 by -1 bind CRPOS SPACEPOS do (* look for a space or cr to make a
pleasant break)
(SELCHARQ (\BIN STREAM)
((SPACE TAB)
(SETQ SPACEPOS I))
(CR (SETQ CRPOS I))
NIL)
finally (* Break after the last CR, or last
space if no CR)
(RETURN (IDIFFERENCE LENGTH (OR CRPOS SPACEPOS 0])
)
(* ; "Mail polling and registration")
(DEFINEQ
(\LAFITE.GET.USER.DATA
[LAMBDA NIL (* bvm: "12-Mar-85 00:27")
(* * This function in charge of setting \LAFITEUSERDATA)
(COND
(\LAFITEUSERDATA)
((OR \LAFITEMODE (\LAFITE.INFER.MODE))
(APPLY* (fetch AUTHENTICATOR of \LAFITEMODE)))
(T (SETQ \LAFITE.AUTHENTICATION.FAILURE "No Mode")
NIL])
(LAFITECLEARCACHE
[LAMBDA NIL (* M.Yonke "23-AUG-83 11:15")
(SETQ \LAFITEUSERDATA NIL])
(FULLUSERNAME
[LAMBDA (UNPACKEDFLG) (* bvm: "15-Apr-84 16:33")
(COND
[\LAFITEUSERDATA (COND
(UNPACKEDFLG (fetch (LAFITEUSERDATA UNPACKEDUSERNAME) of \LAFITEUSERDATA))
(T (fetch (LAFITEUSERDATA FULLUSERNAME) of \LAFITEUSERDATA]
(T (PROG (DOT USER REGISTRY SIMPLENAME)
(\INTERNAL/GETPASSWORD) (* Insure logged in)
(SETQ USER (USERNAME NIL NIL T))
[COND
((NOT (SETQ DOT (STRPOS "." USER)))
(SETQ SIMPLENAME USER)
(SETQ REGISTRY DEFAULTREGISTRY))
((NULL UNPACKEDFLG) (* Have registry, return right now)
(RETURN USER))
(T (SETQ SIMPLENAME (SUBSTRING USER 1 (SUB1 DOT)))
(SETQ REGISTRY (SUBATOM USER (ADD1 DOT]
[COND
((U-CASEP SIMPLENAME)
(SETQ SIMPLENAME (L-CASE SIMPLENAME T]
(SETQ REGISTRY (L-CASE REGISTRY))
(RETURN (COND
(UNPACKEDFLG (CONS SIMPLENAME REGISTRY))
(T (CONCAT SIMPLENAME "." REGISTRY])
(LAFITEMAILWATCH
[LAMBDA NIL (* bvm: "13-Nov-84 16:31")
(bind (INTERVAL ← (ITIMES MAILWATCHWAITTIME 60000)) while (PROGN
(* Until killed)
T)
do (WITH.MONITOR \LAFITE.MAILSERVERLOCK (POLLNEWMAIL))
(BLOCK (for MAILSERVER in (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA)
bind ($$VAL ← INTERVAL)
N do (COND
((AND (SETQ N (fetch (MAILSERVER CONTINUANCE) of MAILSERVER))
(ILESSP N $$VAL))
(SETQ $$VAL N])
(\LAFITE.WAKE.WATCHER
[LAMBDA NIL (* bvm: "11-Mar-85 23:02")
(* Wakes the LAFITEMAILWATCH process
in response to various actions)
(PROG [(P (FIND.PROCESS (QUOTE LAFITEMAILWATCH]
(COND
(P (WAKE.PROCESS P))
(\LAFITE.ACTIVE (* Process got killed somehow;
reinstate it)
(\LAFITE.PROCESS (LIST (FUNCTION LAFITEMAILWATCH))
NIL T (QUOTE HARDRESET])
(POLLNEWMAIL
[LAMBDA NIL (* bvm: "12-Mar-85 00:03")
(PRINTLAFITESTATUS (COND
[(NULL (\LAFITE.GET.USER.DATA))
(COND
(\LAFITEMODE (QUOTE NO.MAILSERVER))
(LAFITEMODELST (QUOTE MODE.NOT.SET))
(T (QUOTE NO.MODE]
((NULL (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA))
(QUOTE NO.MAILBOX))
(T (POLLNEWMAIL1 (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA])
(POLLNEWMAIL1
[LAMBDA (MAILSERVERS) (* bvm: "14-Nov-84 10:10")
(for MAILSERVER in MAILSERVERS bind POLLNEWMAILVAL NEWMAILFLG NOMAILFLG NOTUPFLG
do (SETQ POLLNEWMAILVAL (APPLY* (fetch (MAILSERVER POLLNEWMAIL) of MAILSERVER)
(fetch (MAILSERVER MAILPORT) of MAILSERVER)
(fetch (LAFITEUSERDATA FULLUSERNAME) of \LAFITEUSERDATA)
(fetch (LAFITEUSERDATA ENCRYPTEDPASSWORD) of \LAFITEUSERDATA)
MAILSERVER))
(SELECTQ POLLNEWMAILVAL
(T (SETQ NEWMAILFLG T))
(NIL (SETQ NOMAILFLG T))
(? (SETQ NOTUPFLG T) (* if the server is down --
don't lets try to get mail *)
)
(SHOULDNT)) finally (RETURN (COND
(NEWMAILFLG (* someone has new mail *)
(QUOTE NEW.MAIL))
((AND NOMAILFLG (NULL NOTUPFLG))
(* no one has new mail *)
(QUOTE NO.MAIL))
((AND NOMAILFLG NOTUPFLG)
(* no one who was up has new mail but
some are down *)
(QUOTE SOME.UP))
(NOTUPFLG (* no one was up *)
(QUOTE NONE.UP])
(PRINTLAFITESTATUS
[LAMBDA (STATUS) (* bvm: "12-Mar-85 00:02")
(PROG ((WINDOW (WINDOWP LAFITESTATUSWINDOW))
STR X REG)
(OR WINDOW (RETURN))
[SETQ STR (SELECTQ STATUS
((NEW.MAIL NO.MAILBOX NO.MAILSERVER NO.MODE MODE.NOT.SET)
[COND
((EQ STATUS \LAFITE.LAST.STATUS)
(* No change to prompt)
(RETURN))
(T (SELECTQ STATUS
(NEW.MAIL (COND
((AND LAFITENEWMAILTUNE (EQ (MACHINETYPE)
(QUOTE DANDELION)))
(PLAYTUNE LAFITENEWMAILTUNE)))
(CONCAT "New Mail for " (fetch (LAFITEUSERDATA
SHORTUSERNAME)
of \LAFITEUSERDATA)))
(NO.MAILBOX "No Accessible Mail Boxes")
(NO.MODE "No Mail Handler Loaded")
(MODE.NOT.SET "Mode Not Set")
(CONCAT "Not Logged In: " \LAFITE.AUTHENTICATION.FAILURE])
(CONCAT (SELECTQ STATUS
(NO.MAIL "No New Mail")
(SOME.UP "Some Servers Unavailable")
(NONE.UP "No Mail Servers Responding")
STATUS)
" at "
(DATE (DATEFORMAT NO.DATE NO.SECONDS CIVILIAN.TIME]
(SETQ \LAFITE.LAST.STATUS NIL)
(CLEARW WINDOW)
(COND
((LESSP (SETQ X (IDIFFERENCE (WINDOWPROP WINDOW (QUOTE WIDTH))
(STRINGWIDTH STR WINDOW)))
0)
(SETQ REG (WINDOWREGION WINDOW)) (* String wider than window, so widen
window)
(add (fetch WIDTH of REG)
(IMINUS X))
(MAKEWITHINREGION REG)
(RESHAPEALLWINDOWS WINDOW REG)
(SETQ X 0)))
(MOVETO (LRSH (ADD1 X)
1)
(WINDOWPROP WINDOW (QUOTE YPOS))
WINDOW)
(PRIN3 STR WINDOW)
(SETQ \LAFITE.LAST.STATUS STATUS])
)
(* ; "Parsing mail files")
(DEFINEQ
(PARSEMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: " 9-Dec-85 17:15")
(PROG ((STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT)
(QUOTE OLD)))
MESSAGES END)
(SETQ END (GETEOFPTR STREAM))
(RETURN (COND
((OR (EQ END 0)
(SETQ MESSAGES (PARSEMAILFOLDER1 MAILFOLDER STREAM END 0 1)))
(replace (MAILFOLDER #OFMESSAGES) of MAILFOLDER with (COND
(MESSAGES (CAR MESSAGES
))
(T 0)))
[replace (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER
with (AND MESSAGES (\LAFITE.ADDMESSAGES.TO.ARRAY NIL (CDR MESSAGES)
1
(CAR MESSAGES]
(replace (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER with END)
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with 0)
(replace (MAILFOLDER BROWSERREADY) of MAILFOLDER with T)
MAILFOLDER)
(T (\LAFITE.CLOSE.FOLDER MAILFOLDER T)
NIL])
(PARSEMAILFOLDER1
[LAMBDA (MAILFOLDER STREAM EOFPTR START FIRSTMSG# NOERROR) (* bvm: "24-Feb-86 12:42")
(* * Parse MAILFOLDER starting at byte START until end of file at EOFPTR.
FIRSTMSG# is the ordinal to assign to the first message.
Returns (lastmsg# . messagedescriptors), or NIL if there was any problem.
If NOERROR is true, does not publicly complain about errors, but quietly
returns NIL)
(LAB.PROMPTPRINT MAILFOLDER "Parsing " (COND
((EQ START 0)
"folder")
(T "additional msgs"))
(QUOTE ...))
(LET* ((HERE START)
(WINDOW (fetch BROWSERPROMPTWINDOW of MAILFOLDER))
(XPOS (AND WINDOW (DSPXPOSITION NIL WINDOW)))
CHCOUNT STAMPCOUNT MARK SEEN STARTFLG DELETED LASTMSG)
(for MSG# from FIRSTMSG# while (ILESSP HERE EOFPTR)
collect (SETFILEPTR STREAM HERE)
(* * the format of the stamp field of a laurel message is -
(*stamp* <c.r.> <length.of.message.in.5.ascii.chars>
<sp><length.of.stamp.in.5.ascii.chars> <sp> <the.char.U.or.D> <the.char.S.or.U>
<any.char> <c.r.>) -
U.or.D is Undeleted or Deleted -
S.or.U is Seen or Unseen * *)
[COND
((AND (LA.READSTAMP STREAM)
(SETQ CHCOUNT (LA.READCOUNT STREAM))
(SETQ STAMPCOUNT (LA.READCOUNT STREAM))
(IGEQ CHCOUNT STAMPCOUNT)))
(T (RETURN (BADMAILFILE MAILFOLDER HERE MSG#
"Bad header or previous message length is incorrect" LASTMSG
NOERROR]
(* * now read in the status characters and save their pointers * *)
(SETQ DELETED (SELECTC (BIN STREAM)
(UNDELETEDFLAG NIL)
(DELETEDFLAG T)
(BADMAILFILE.FLAGBYTE MAILFOLDER MSG#)))
(* read the U for Undeleted *)
(SETQ SEEN (SELECTC (BIN STREAM)
(UNSEENFLAG NIL)
(SEENFLAG T)
((CHARCODE N) (* For some reason, there are files
with this for the Seen mark, so allow
it)
T)
(BADMAILFILE.FLAGBYTE MAILFOLDER MSG#)))
(* read the U for unseen *)
(SETQ MARK (BIN STREAM)) (* read the mark char *)
[PROG1 (SETQ LASTMSG
(create LAFITEMSG
# ← MSG#
BEGIN ← HERE
MESSAGELENGTH ← CHCOUNT
MARKCHAR ← (OR (AND (NOT SEEN)
UNSEENMARK)
MARK)
SEEN? ← SEEN
DELETED? ← DELETED
STAMPLENGTH ← STAMPCOUNT))
(LAFITE.PARSE.MSG.FOR.TOC LASTMSG MAILFOLDER)
(add HERE CHCOUNT)
(COND
(XPOS (DSPXPOSITION XPOS WINDOW)
(printout WINDOW .I1 MSG#]
finally (COND
(XPOS (* Prepare to overwrite counter with
"done")
(DSPXPOSITION XPOS WINDOW)))
(COND
((NOT (IEQP HERE EOFPTR))
(LAB.PROMPTPRINT MAILFOLDER T "Warning: last message truncated from "
(fetch (LAFITEMSG MESSAGELENGTH) of LASTMSG)
" to "
(replace (LAFITEMSG MESSAGELENGTH) of LASTMSG
with (IDIFFERENCE (fetch (LAFITEMSG MESSAGELENGTH) of LASTMSG)
(IDIFFERENCE HERE EOFPTR)))
" bytes. ")
(replace (LAFITEMSG MESSAGELENGTHCHANGED?) of LASTMSG
with (replace (LAFITEMSG MARKSCHANGED?) of LASTMSG with T))
(replace (MAILFOLDER FOLDERNEEDSUPDATE) of MAILFOLDER with T)))
(RETURN (CONS (fetch (LAFITEMSG #) of LASTMSG)
$$VAL])
(BADMAILFILE
[LAMBDA (MAILFOLDER HERE MSG# ERRSTR LASTMSG NOERROR) (* bvm: "20-Feb-84 12:42")
[COND
((OR (NOT NOERROR)
LAFITEDEBUGFLG)
(PROG ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of MAILFOLDER)))
(CLEARW BROWSERWINDOW)
(printout BROWSERWINDOW "Cannot parse file " (fetch (MAILFOLDER FULLFOLDERNAME)
of MAILFOLDER)
" near message " .P2 MSG# ", byte " .P2 HERE " because: " ERRSTR)
[COND
(LASTMSG (printout BROWSERWINDOW T "Last message was:" T "Date: "
(fetch (LAFITEMSG DATE) of LASTMSG)
T "From: " (fetch (LAFITEMSG FROM) of LASTMSG)
T "Subject: " (fetch (LAFITEMSG SUBJECT) of LASTMSG]
(COND
(LAFITEDEBUGFLG (HELP "Mail file parsing error" ERRSTR]
NIL])
(BADMAILFILE.FLAGBYTE
[LAMBDA (MAILFOLDER MSG#) (* bvm: "24-Feb-86 12:08")
(LAB.PROMPTPRINT MAILFOLDER " [at msg " MSG# ": bad flag byte] ")
NIL])
(VERIFYMAILFOLDER
[LAMBDA (MAILFOLDER) (* bvm: "31-Jul-84 15:09")
(DECLARE (SPECVARS MSG# MSG HERE CHCOUNT))
[COND
((NOT (type? MAILFOLDER MAILFOLDER))
(SETQ MAILFOLDER (\DTEST (COND
((WINDOWP MAILFOLDER)
(WINDOWPROP MAILFOLDER (QUOTE MAILFOLDER)))
((LITATOM MAILFOLDER)
(\LAFITE.GETMAILFOLDER MAILFOLDER)))
(QUOTE MAILFOLDER]
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG (STREAM END)
(SETQ STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT)
(QUOTE OLD)))
(OR (IEQP (SETQ END (GETEOFPTR STREAM))
(fetch (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER))
(HELP "Length of file does not match Folder's idea of length" (LIST END)))
[bind CHCOUNT STAMPCOUNT MARK MSG (HERE ← 0)
(MESSAGES ← (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER))
(LASTMSG# ← (fetch (MAILFOLDER #OFMESSAGES) of MAILFOLDER)) for MSG#
from 1 while (ILESSP HERE END)
do (SETFILEPTR STREAM HERE)
[COND
((IGREATERP MSG# LASTMSG#)
(RETURN (VERIFYFAILED "More messages in file than in core"]
(SETQ MSG (NTHMESSAGE MESSAGES MSG#))
(* * the format of the stamp field of a laurel message is -
(*stamp* <c.r.> <length.of.message.in.5.ascii.chars>
<sp><length.of.stamp.in.5.ascii.chars> <sp> <the.char.U.or.D> <the.char.S.or.U>
<any.char> <c.r.>) -
U.or.D is Undeleted or Deleted -
S.or.U is Seen or Unseen * *)
(COND
((NOT (IEQP (fetch (LAFITEMSG BEGIN) of MSG)
HERE))
(VERIFYFAILED "Message beginning pointer wrong"))
((NOT (LA.READSTAMP STREAM))
(VERIFYFAILED "Bad Stamp"))
([OR (NOT (SETQ CHCOUNT (LA.READCOUNT STREAM)))
(NOT (IEQP CHCOUNT (fetch (LAFITEMSG MESSAGELENGTH) of MSG]
(VERIFYFAILED "Bad Message Length"))
([OR (NOT (SETQ STAMPCOUNT (LA.READCOUNT STREAM)))
(NOT (IEQP STAMPCOUNT (fetch (LAFITEMSG STAMPLENGTH) of MSG]
(VERIFYFAILED "Bad Message Length"))
((fetch (LAFITEMSG MARKSCHANGED?) of MSG))
((NOT (EQ (SELECTC (BIN STREAM)
(UNDELETEDFLAG NIL)
(DELETEDFLAG T)
(QUOTE ?))
(fetch (LAFITEMSG DELETED?) of MSG)))
(VERIFYFAILED "Disagreement in delete mark"))
((NOT (EQ (SELECTC (BIN STREAM)
(UNSEENFLAG NIL)
(SEENFLAG T)
(QUOTE ?))
(fetch (LAFITEMSG SEEN?) of MSG)))
(* Figure out how to handle seen from
me)
(VERIFYFAILED "Disagreement in seen mark"))
([NOT (OR (EQ (SETQ MARK (BIN STREAM))
(fetch (LAFITEMSG MARKCHAR) of MSG))
(NOT (fetch (LAFITEMSG SEEN?) of MSG]
(VERIFYFAILED "Disagreement in mark byte")))
(add HERE CHCOUNT) finally (COND
((NOT (IEQP HERE END))
(VERIFYFAILED "Last message too short"]
(RETURN T])
(VERIFYFAILED
[LAMBDA (ERRMSG) (* bvm: "28-Dec-83 16:14")
(DECLARE (USEDFREE MSG#))
(HELP (CONCAT "Error in message " MSG# ": ")
ERRMSG])
(READTOCFILE
[LAMBDA (MAILFOLDER TOCFILE) (* bvm: " 3-Feb-86 15:02")
(* * Read TOCFILE into MAILFOLDER)
(* * Format of TOCFILE -
-
<LafitePassword word> <LafiteVersion word> -
<EOF of mailfile integer> -
<last msg# in toc word> -
-
followed by one entry per message, of the form -
-
<messagelength 3 bytes> <stamplength byte> <del&seen flags byte> <mark byte>
<date 6 bytes> -
<subject ShortString> <From ShortString> <To ShortString>)
(DECLARE (SPECVARS MAILFOLDER TOCSTREAM))
(RESETLST (LAB.PROMPTPRINT MAILFOLDER "Reading table of contents...")
(PROG ([TOCSTREAM (OPENSTREAM TOCFILE (QUOTE INPUT)
(QUOTE OLD)
NIL
(QUOTE ((ENDOFSTREAMOP \LAFITE.TOCEOF]
(FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT)))
(MSGCOUNTGUESS 0)
END FOLDEREOFPTR MESSAGES EXTRAMESSAGES LASTMSG# READMORE TOCVERSION OLDTOCFORMAT)
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
TOCSTREAM))
(WHENCLOSE TOCSTREAM (QUOTE CLOSEALL)
(QUOTE NO))
(SETFILEPTR TOCSTREAM 0) (* Just in case it was already open)
[COND
((OR (NEQ (WORDIN TOCSTREAM)
LAFITETOCPASSWORD)
(NEQ (SETQ TOCVERSION (WORDIN TOCSTREAM))
LAFITEVERSION#))
(COND
((EQ TOCVERSION 8) (* A slightly different format, still
readable)
(LAB.PROMPTPRINT MAILFOLDER "(older format)")
(SETQ OLDTOCFORMAT T))
(T (RETURN (BADTOCFILE "Format obsolete, discarding..."]
[COND
([NOT (IEQP (SETQ END (FIXPIN TOCSTREAM))
(SETQ FOLDEREOFPTR (GETEOFPTR FOLDERSTREAM]
(* Maybe new messages have been added
to file)
(SETFILEPTR FOLDERSTREAM END)
(COND
((NOT (LA.READSTAMP FOLDERSTREAM))
(RETURN (BADTOCFILE "It does not agree with mail folder...")))
(T (SETQ READMORE T)
(SETQ MSGCOUNTGUESS (IQUOTIENT (IDIFFERENCE FOLDEREOFPTR END)
500]
(add MSGCOUNTGUESS (SETQ LASTMSG# (WORDIN TOCSTREAM)))
(SETQ MESSAGES (\LAFITE.MAKE.MSGARRAY MSGCOUNTGUESS))
(for I from 1 to LASTMSG# bind MSG LENGTH (START ← (GETFILEPTR TOCSTREAM))
(MESSAGESTART ← 0)
do (* Message length is 3 bytes long
because it can be greater than
MAX.SMALLP, though most unlikely)
[SETQ LENGTH (COND
((EQ (SETQ LENGTH (BIN TOCSTREAM))
0)
(WORDIN TOCSTREAM))
(T (\MAKENUMBER LENGTH (WORDIN TOCSTREAM]
(SETQ MSG (create LAFITEMSG
# ← I
BEGIN ← MESSAGESTART
MESSAGELENGTH ← LENGTH))
(add MESSAGESTART LENGTH)
(replace (LAFITEMSG STAMPLENGTH) of MSG with (BIN TOCSTREAM))
[COND
(OLDTOCFORMAT (replace (LAFITEMSG PARSED&DELETED&SEENBITS) of MSG
with (BIN TOCSTREAM)))
(T (replace (LAFITEMSG MSGFLAGBITS) of MSG with (BIN TOCSTREAM]
(replace (LAFITEMSG MARKCHAR) of MSG with (BIN TOCSTREAM))
(replace (LAFITEMSG DATE) of MSG with (LA.READSTRING TOCSTREAM 6))
(replace (LAFITEMSG SUBJECT) of MSG with (LA.READSHORTSTRING TOCSTREAM))
(replace (LAFITEMSG FROM) of MSG with (LA.READSHORTSTRING TOCSTREAM))
(replace (LAFITEMSG TO) of MSG with (LA.READSHORTSTRING TOCSTREAM))
[replace (LAFITEMSG TOCLENGTH) of MSG with (IMINUS (IDIFFERENCE START
(SETQ START
(GETFILEPTR
TOCSTREAM]
(SETA MESSAGES I MSG))
(replace (MAILFOLDER TOCLASTMESSAGE#) of MAILFOLDER with (COND
((EQ TOCVERSION
LAFITEVERSION#)
LASTMSG#)
(T
(* Will have to rewrite toc next time)
0)))
[COND
(READMORE (COND
[(SETQ EXTRAMESSAGES (PARSEMAILFOLDER1 MAILFOLDER FOLDERSTREAM
FOLDEREOFPTR END (ADD1 LASTMSG#)
T))
(SETQ MESSAGES (\LAFITE.ADDMESSAGES.TO.ARRAY MESSAGES (CDR
EXTRAMESSAGES
)
(ADD1 LASTMSG#)
(SETQ LASTMSG# (CAR EXTRAMESSAGES]
(T (RETURN (BADTOCFILE
"Couldn't parse new messages, trying from scratch..."
T]
(replace (MAILFOLDER MESSAGEDESCRIPTORS) of MAILFOLDER with MESSAGES)
(replace (MAILFOLDER #OFMESSAGES) of MAILFOLDER with LASTMSG#)
(replace (MAILFOLDER FOLDEREOFPTR) of MAILFOLDER with FOLDEREOFPTR)
(replace (MAILFOLDER BROWSERREADY) of MAILFOLDER with T)
(RETURN T])
(BADTOCFILE
[LAMBDA (ERRMSG CLEARFLG)
(DECLARE (USEDFREE MAILFOLDER TOCSTREAM)) (* bvm: " 3-Feb-86 15:11")
(COND
(CLEARFLG (LAB.PROMPTPRINT MAILFOLDER T)))
(LAB.PROMPTPRINT MAILFOLDER ERRMSG)
(COND
(LAFITEDEBUGFLG (HELP "TOC file error" ERRMSG)))
(DELFILE (CLOSEF TOCSTREAM])
(\LAFITE.TOCEOF
[LAMBDA (STREAM) (* bvm: "28-Dec-83 11:39")
(* * Unexpected end of file on TOC, flush it)
(RETFROM (QUOTE READTOCFILE)
(BADTOCFILE "Malformed table of contents, discarding..."])
(LA.READCOUNT
[LAMBDA (STREAM) (* bvm: "22-Dec-83 18:21")
(bind CH VAL do (COND
[(AND (ILEQ (SETQ CH (BIN STREAM))
(CHARCODE 9))
(IGEQ CH (CHARCODE 0)))
(SETQ VAL (IPLUS (IDIFFERENCE CH (CHARCODE 0))
(COND
(VAL (ITIMES VAL 10))
(T 0]
((EQ CH (CHARCODE SPACE))
(RETURN VAL))
(T (RETURN NIL])
(LA.PRINTCOUNT
[LAMBDA (COUNT STREAM) (* bvm: "27-Dec-83 12:56")
(PRINTNUM (QUOTE (FIX 5 10 T))
COUNT STREAM)
(BOUT STREAM (CHARCODE SPACE])
(LA.READSTAMP
[LAMBDA (STREAM) (* bvm: "22-Dec-83 18:23")
(AND (EQ (BIN STREAM)
(CHARCODE *))
(EQ (BIN STREAM)
(CHARCODE s))
(EQ (BIN STREAM)
(CHARCODE t))
(EQ (BIN STREAM)
(CHARCODE a))
(EQ (BIN STREAM)
(CHARCODE r))
(EQ (BIN STREAM)
(CHARCODE t))
(EQ (BIN STREAM)
(CHARCODE *))
(EQ (BIN STREAM)
(CHARCODE CR])
(\LAFITE.VERIFYMSG
[LAMBDA (MSG MAILFOLDER) (* bvm: "31-Jul-84 22:46")
(PROG ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER)))
(SETFILEPTR STREAM (fetch (LAFITEMSG BEGIN) of MSG))
(OR (LA.READSTAMP STREAM)
(HELP (CONCAT "Inconsistency in table of contents at message number "
(fetch (LAFITEMSG #) of MSG)
".
Lafite's parse of the file is incorrect at this point. Recommendation: close browser with option Don't Update, delete "
(TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER))
", then browse this folder again to reparse.")
MSG])
(LA.MSGFROMMEP
[LAMBDA (MSG) (* bvm: " 9-Dec-85 17:03")
(PROG ((SENDER (fetch (LAFITEMSG FROM) of MSG)))
(RETURN (replace (LAFITEMSG MSGFROMMEP) of MSG
with (COND
[\LAFITEUSERDATA (OR (STRING-EQUAL SENDER (fetch (LAFITEUSERDATA
FULLUSERNAME)
of \LAFITEUSERDATA))
(STRING-EQUAL SENDER (CAR (fetch (LAFITEUSERDATA
UNPACKEDUSERNAME)
of \LAFITEUSERDATA]
(T (STRING-EQUAL SENDER (USERNAME])
(LA.PRINTSTAMP
[LAMBDA (STREAM) (* bvm: "27-Dec-83 12:54")
(PROGN (BOUT STREAM (CHARCODE *))
(BOUT STREAM (CHARCODE s))
(BOUT STREAM (CHARCODE t))
(BOUT STREAM (CHARCODE a))
(BOUT STREAM (CHARCODE r))
(BOUT STREAM (CHARCODE t))
(BOUT STREAM (CHARCODE *))
(BOUT STREAM (CHARCODE CR])
(LA.READSHORTSTRING
[LAMBDA (STREAM) (* bvm: "28-Dec-83 11:42")
(* * Read from STREAM a string written by LA.PRINTSHORTSTRING whose length is
stored as the first byte.)
(PROG ((NBYTES (BIN STREAM)))
(RETURN (AND (NEQ NBYTES 0)
(LA.READSTRING STREAM NBYTES])
(LA.PRINTSHORTSTRING
[LAMBDA (STREAM STRING) (* bvm: "28-Dec-83 14:00")
(COND
((NULL STRING)
(BOUT STREAM 0)
1)
(T (PROG ((NBYTES (NCHARS STRING)))
(COND
((IGREATERP NBYTES 255)
(SETQ STRING (SUBSTRING STRING 1 255))
(SETQ NBYTES 255)))
(BOUT STREAM NBYTES)
(PRIN3 STRING STREAM)
(RETURN (ADD1 NBYTES])
(LA.READSTRING
[LAMBDA (STREAM NBYTES) (* bvm: "28-Dec-83 14:40")
(* * Returns a string of length NBYTES composed of the next NBYTES characters
of STREAM)
(PROG ((STR (ALLOCSTRING NBYTES))
BASE OFFSET)
(for I from 0 to (SUB1 NBYTES) bind (BASE ← (fetch (STRINGP BASE) of STR))
(OFFSET ← (fetch (STRINGP OFFST) of STR))
do (\PUTBASEBYTE BASE (IPLUS I OFFSET)
(BIN STREAM)))
(RETURN STR])
)
(DEFINEQ
(LAFITE.PARSE.MSG.FOR.TOC
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "28-Feb-86 14:42")
(COND
((NULL (fetch (LAFITEMSG PARSED?) of MSGDESCRIPTOR))
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(PROG [(FOLDERSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT]
(for PAIR in (LAFITE.PARSE.HEADER FOLDERSTREAM \LAPARSE.TOCFIELDS
(fetch (LAFITEMSG START) of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR))
do (SELECTQ (CAR PAIR)
(From (replace (LAFITEMSG FROM) of MSGDESCRIPTOR with (CADR PAIR)))
(Subject (replace (LAFITEMSG SUBJECT) of MSGDESCRIPTOR
with (CADR PAIR)))
(Date (replace (LAFITEMSG DATE) of MSGDESCRIPTOR with (CADR PAIR)))
(Format (SELECTQ (CADR PAIR)
((TEDIT MULTIMEDIA)
(replace (LAFITEMSG FORMATTED?) of MSGDESCRIPTOR
with T))
NIL))
NIL))
(replace (LAFITEMSG PARSED?) of MSGDESCRIPTOR with T)
(COND
((fetch (LAFITEMSG MSGFROMMEP) of MSGDESCRIPTOR)
(* Get the TO field while we're at it,
since TOC display will want it)
(LAFITE.FETCH.TO.FIELD MSGDESCRIPTOR MAILFOLDER)
(COND
((AND LAFITEIFFROMMETHENSEENFLG (NOT (fetch (LAFITEMSG SEEN?)
of MSGDESCRIPTOR)))
(replace (LAFITEMSG SEEN?) of MSGDESCRIPTOR with T)
(replace (LAFITEMSG MARKCHAR) of MSGDESCRIPTOR with SEENMARK)
(replace (LAFITEMSG MARKSCHANGED?) of MSGDESCRIPTOR with T])
(LAFITE.FETCH.TO.FIELD
[LAMBDA (MSGDESCRIPTOR MAILFOLDER) (* bvm: "31-Jul-84 15:10")
(* Fetch just the TO field of a
message)
(OR (fetch (LAFITEMSG TO) of MSGDESCRIPTOR)
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(replace (LAFITEMSG TO) of MSGDESCRIPTOR with (OR (LAFITE.PARSE.HEADER
(\LAFITE.OPEN.FOLDER MAILFOLDER
(QUOTE INPUT))
\LAPARSE.TOFIELD
(fetch (LAFITEMSG START)
of MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of
MSGDESCRIPTOR
)
T)
UNSUPPLIEDFIELDSTR])
(LAFITE.PARSE.HEADER
[LAMBDA (STREAM PARSETABLE START END ONCEONLY CHECKEOF) (* bvm: "13-Nov-84 13:20")
(DECLARE (SPECVARS PARSERESULT)) (* For Parse result functions to
access)
(PROG (PARSERESULT TABLE CH CHOICE HERE)
(COND
(START (SETFILEPTR STREAM START)))
TOP (SETQ TABLE PARSETABLE)
(AND CHECKEOF (SETQ HERE (GETFILEPTR STREAM)))
LP [SELECTQ (CAR TABLE)
(CHOICE (SETQ CH (UCASECODE (BIN STREAM)))
(COND
((find old CHOICE in (CDR TABLE) suchthat (EQ (CAR CHOICE)
CH))
(SETQ TABLE (CDR CHOICE))
(GO LP))))
(RESULT (SETQ TABLE (CDR TABLE))
(LAFITE.SKIP.WHITE.SPACE STREAM)
(APPLY* (CAR TABLE)
STREAM
(CDR TABLE))
(COND
(ONCEONLY (RETURN PARSERESULT))
(T (GO TOP))))
(STOP [COND
((AND CHECKEOF (EQ CH (CHARCODE EOL)))
(push PARSERESULT (LIST (QUOTE EOF)
HERE]
(RETURN PARSERESULT))
(COND
((EQ (SETQ CH (UCASECODE (BIN STREAM)))
(CAR TABLE))
(SETQ TABLE (CDR TABLE))
(GO LP]
(* * Get here if parse of current line failed)
(COND
[CHECKEOF (COND
([do (SELCHARQ CH
((CR TAB SPACE) (* Whitespace before a colon is
illegal)
(push PARSERESULT (LIST (QUOTE EOF)
HERE T))
(RETURN T))
(: (LA.SKIP.TO.EOL STREAM CH)
(RETURN NIL))
(SETQ CH (BIN STREAM]
(RETURN PARSERESULT]
(T (COND
((AND END (IGEQ (GETFILEPTR STREAM)
END))
(RETURN PARSERESULT)))
(LA.SKIP.TO.EOL STREAM CH)))
(GO TOP])
(LAFITE.GRAB.DATE
[LAMBDA (STREAM) (* bvm: "12-Nov-84 17:21")
(DECLARE (USEDFREE PARSERESULT))
(push PARSERESULT (LIST (QUOTE Date)
(PROG ((DATESTR (LAFITE.READ.TO.EOL STREAM))
CH)
[for I from 1 bind
do (* Now hack to strip off prefix day of
week, such as "Mon, 19 Dec 83 --")
(COND
((NULL (SETQ CH (NTHCHARCODE DATESTR I)))
(* No digits at all?)
(RETURN DATESTR))
[(EQ CH (CHARCODE ,))
(* Assume initial prefix was a day of
the week)
(repeatwhile (EQ (NTHCHARCODE DATESTR (add I 1))
(CHARCODE SPACE)))
(RETURN (SETQ DATESTR (SUBSTRING DATESTR I NIL DATESTR]
((AND (ILEQ CH (CHARCODE 9))
(IGEQ CH (CHARCODE 0)))
(* Digit encountered before comma,
must not be day of week)
(RETURN DATESTR]
(RETURN (OR (SUBSTRING DATESTR 1 6 DATESTR)
DATESTR])
(LAFITE.READ.LINE.FOR.TOC
[LAMBDA (STREAM ARGS) (* bvm: "19-Dec-83 14:08")
(DECLARE (USEDFREE PARSERESULT))
(PROG ((STR (LAFITE.READ.TO.EOL STREAM)))
[COND
((IGREATERP (NCHARS STR)
255)
(SETQ STR (SUBSTRING STR 1 255 STR]
(push PARSERESULT (LIST (CAR ARGS)
STR])
(LAFITE.READ.FORMAT
[LAMBDA (STREAM) (* bvm: "12-Nov-84 17:21")
(DECLARE (USEDFREE PARSERESULT))
(PROG ((STR (LAFITE.READ.TO.EOL STREAM)))
(while (EQ (NTHCHARCODE STR -1)
(CHARCODE SPACE)) do (GLC STR))
(push PARSERESULT (LIST (QUOTE Format)
(MKATOM (U-CASE STR])
(LAFITE.READ.NAME.FIELD
[LAMBDA (STREAM ARGS)
(DECLARE (USEDFREE PARSERESULT)) (* bvm: "13-Nov-84 13:10")
(PROG ((FIELD (CAR ARGS))
LINELIST LINE)
[SETQ LINELIST (LIST (SETQ LINE (LAFITE.READ.TO.EOL STREAM]
(do (SELCHARQ (NTHCHARCODE LINE -1)
((SPACE TAB ,) (* Strip off trailing spaces)
(GLC LINE))
(RETURN NIL)))
(for PAIR in PARSERESULT when (EQ (CAR PAIR)
FIELD) do (RETURN (NCONC PAIR LINELIST))
finally (push PARSERESULT (CONS FIELD LINELIST])
(LAFITE.READ.ONE.LINE.FOR.TOC
[LAMBDA (STREAM) (* bvm: "19-Dec-83 14:10")
(SETQ PARSERESULT (LAFITE.READ.TO.EOL STREAM])
(LAFITE.READ.TO.EOL
[LAMBDA (STREAM) (* bvm: "13-Nov-84 13:07")
(* * Reads everything in STREAM up to next EOL and returns it as a string.
If the next line starts with whitespace, it is assumed to be a continuation
line, and it is returned as part of the result as well.
See RFC 822)
(PROG (RESULT LINE)
LP (SETQ LINE (RSTRING STREAM LINEPARSERRDTBL))
(READC STREAM) (* Eat the EOL)
(SETQ RESULT (COND
(RESULT (CONCAT RESULT " " LINE))
(T LINE)))
(SELCHARQ (\PEEKBIN STREAM)
((SPACE TAB)
(LAFITE.SKIP.WHITE.SPACE STREAM)
(GO LP))
NIL)
(RETURN RESULT])
(LA.SKIP.TO.EOL
[LAMBDA (STREAM LASTCH) (* bvm: "13-Nov-84 13:20")
(* * Flush to end of this field. LASTCH is the last char read before this)
(do [COND
((NEQ LASTCH (CHARCODE EOL))
(repeatuntil (EQ (BIN STREAM)
(CHARCODE EOL] repeatuntil (SELCHARQ (\PEEKBIN STREAM)
((SPACE TAB)
(* Continuation line, keep eating)
(SETQ LASTCH NIL))
T])
(LAFITE.SKIP.WHITE.SPACE
[LAMBDA (STREAM) (* bvm: "19-Dec-83 12:35")
(do (SELCHARQ (\PEEKBIN STREAM)
((SPACE TAB)
(BIN STREAM))
(RETURN])
)
(RPAQQ LA.FULLPARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date)
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
("SENDER:" LAFITE.READ.NAME.FIELD Sender)
("FROM:" LAFITE.READ.NAME.FIELD From)
("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to)
("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to)
("TO:" LAFITE.READ.NAME.FIELD To)
("CC:" LAFITE.READ.NAME.FIELD cc)
("FORMAT:" LAFITE.READ.FORMAT)))
(RPAQQ LA.TOCFIELDS (("DATE:" LAFITE.GRAB.DATE)
("FROM:" LAFITE.READ.LINE.FOR.TOC From)
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
("FORMAT:" LAFITE.READ.FORMAT)))
(RPAQQ LA.TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
(RPAQQ LA.SUBJECTFIELDONLY (("SUBJECT:" LAFITE.READ.ONE.LINE.FOR.TOC)))
(DEFINEQ
(LAFITE.INIT.PARSETABLES
[LAMBDA NIL (* bvm: " 2-Mar-86 16:24")
(SETQ \LAPARSE.FULL (LAFITE.MAKE.PARSE.TABLE LA.FULLPARSEFIELDS))
(SETQ \LAPARSE.TOCFIELDS (LAFITE.MAKE.PARSE.TABLE LA.TOCFIELDS))
(SETQ \LAPARSE.TOFIELD (LAFITE.MAKE.PARSE.TABLE LA.TOFIELDONLY))
(SETQ \LAPARSE.SUBJECTFIELD (LAFITE.MAKE.PARSE.TABLE LA.SUBJECTFIELDONLY))
(PROGN (SETQ LINEPARSERRDTBL (COPYREADTABLE (QUOTE ORIG)))
(* first make a read table with no
breaks and seperators *)
(for CH in (GETSEPR LINEPARSERRDTBL) do (SETSYNTAX CH (QUOTE OTHER)
LINEPARSERRDTBL))
(for CH in (GETBRK LINEPARSERRDTBL) do (SETSYNTAX CH (QUOTE OTHER)
LINEPARSERRDTBL))
(* % is not ESCAPE --
just a regular char *)
(SETSYNTAX (QUOTE %%)
(QUOTE OTHER)
LINEPARSERRDTBL))
(SETQ ADDRESSPARSERRDTBL (COPYREADTABLE LINEPARSERRDTBL))
(PROGN
(* * make a readtable whose only sepr char is <c.r.> and no break chars * *)
(SETSYNTAX (CHARCODE CR)
(QUOTE SEPRCHAR)
LINEPARSERRDTBL))
(PROGN
(* * set the character syntax right for parsing address lines and address in
the lines * *)
(SETSYNTAX (CHARCODE SP)
(QUOTE SEPRCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (CHARCODE TAB)
(QUOTE SEPRCHAR)
ADDRESSPARSERRDTBL) (* "," separates addresses *)
(SETSYNTAX (QUOTE ,)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* "@" separates local-part from
domain *)
(SETSYNTAX (QUOTE @)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE %.)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* if "<" is present in an address
then the text between "<" and ">" is
the real address -- what BS *)
(SETSYNTAX (QUOTE <)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE >)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* "\" is the
"don't interpret the next char" char *)
(SETSYNTAX (QUOTE \)
(QUOTE ESCAPE)
ADDRESSPARSERRDTBL) (* ";" and ":" have to do with private
distributions lists --
don't know when I'll get around to
really recognizing them *)
(SETSYNTAX (QUOTE ;)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE :)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL) (* comments are enclosed in parens --
will just throw out lists in the
parser *)
(SETSYNTAX (QUOTE %()
(QUOTE ORIG)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE %))
(QUOTE ORIG)
ADDRESSPARSERRDTBL) (* make strings strings --
thank god *)
(SETSYNTAX (QUOTE %")
(QUOTE ORIG)
ADDRESSPARSERRDTBL) (* for "local-domains" --
e.g. "[0.1.23.45]" --
not recommended *)
(SETSYNTAX (QUOTE %[)
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL)
(SETSYNTAX (QUOTE %])
(QUOTE BREAKCHAR)
ADDRESSPARSERRDTBL])
(LAFITE.MAKE.PARSE.TABLE
[LAMBDA (TABLE) (* bvm: "19-Dec-83 15:12")
(* * Take a list of entries (string resultfn resultargs) and make a table
usable by LAFITE.PARSE.HEADER)
(PROG ((PARSETABLE (LAFITE.MAKE.PARSE.TABLE1 TABLE 1)))
(RETURN (CONS (QUOTE CHOICE)
(NCONC PARSETABLE (CONSTANT (BQUOTE ((, (CHARCODE CR)
STOP)
(,@ (CHARCODE
(* S T A R T *))
STOP])
(LAFITE.MAKE.PARSE.TABLE1
[LAMBDA (TABLE I) (* bvm: "30-Dec-83 11:12")
(* * Subfunction of LAFITE.MAKE.PARSE.TABLE that builds a parsetable from the
entries in TABLE splitting on character I)
(PROG (ENTRY OTHERENTRIES DONE CHOICELIST CH)
[for TAIL on TABLE unless (FMEMB (CAR TAIL)
DONE)
do (SETQ CH (NTHCHARCODE (CAR (SETQ ENTRY (CAR TAIL)))
I))
(COND
((NULL CH) (* Shouldn't happen: can't distinguish
two them)
(ERROR (CAR ENTRY)
"is an initial prefix of another entry")))
(push CHOICELIST (CONS CH (COND
[[NOT (SETQ OTHERENTRIES
(for X in (CDR TAIL) collect X
when (EQ (NTHCHARCODE (CAR X)
I)
CH]
(* This is the only choice)
(NCONC (for J from (ADD1 I)
while (SETQ CH (NTHCHARCODE (CAR ENTRY)
J)) collect CH)
(CONS (QUOTE RESULT)
(CDR ENTRY]
(T (SETQ DONE (APPEND OTHERENTRIES DONE))
(CONS (QUOTE CHOICE)
(LAFITE.MAKE.PARSE.TABLE1 (CONS ENTRY
OTHERENTRIES)
(ADD1 I]
(RETURN CHOICELIST])
)
(RPAQ? MAILWATCHWAITTIME 5)
(RPAQ? LAFITEFLUSHMAILFLG T)
(RPAQ? LAFITETOC.EXT (QUOTE -LAFITE-TOC))
(RPAQ? LAFITENEWMAILTUNE )
(RPAQ? LAFITEGETMAILTUNE )
(RPAQ? LAFITE.AFTER.GETMAIL.FN )
(RPAQ? \LAFITE.LAST.STATUS )
(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.LAST.STATUS)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.SUBJECTFIELDONLY ADDRESSPARSERRDTBL
DEFAULTREGISTRY LAFITEDEBUGFLG LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITEIFFROMMETHENSEENFLG
LAFITENEWMAILTUNE LINEPARSERRDTBL MAILWATCHWAITTIME \LAFITE.AUTHENTICATION.FAILURE
\LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD
LAFITE.AFTER.GETMAIL.FN)
)
(FILESLOAD (SOURCE)
LAFITEDECLS)
)
(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2787 20638 (\LAFITE.GETMAIL 2797 . 3177) (\LAFITE.GETMAIL.PROC 3179 . 3636) (
\LAFITE.GETNEWMAIL 3638 . 5806) (\LAFITE.GETNEWMAIL1 5808 . 9335) (\LAFITE.GETNEWMAIL# 9337 . 9724) (
\LAFITE.RETRIEVEMESSAGES 9726 . 14173) (\LAFITE.HANDLE.BIG.MESSAGE 14175 . 19446) (
\LAFITE.FIND.BREAKPOINT 19448 . 20636)) (20685 29541 (\LAFITE.GET.USER.DATA 20695 . 21118) (
LAFITECLEARCACHE 21120 . 21272) (FULLUSERNAME 21274 . 22589) (LAFITEMAILWATCH 22591 . 23415) (
\LAFITE.WAKE.WATCHER 23417 . 24138) (POLLNEWMAIL 24140 . 24819) (POLLNEWMAIL1 24821 . 26719) (
PRINTLAFITESTATUS 26721 . 29539)) (29577 55648 (PARSEMAILFOLDER 29587 . 31106) (PARSEMAILFOLDER1 31108
. 36368) (BADMAILFILE 36370 . 37403) (BADMAILFILE.FLAGBYTE 37405 . 37606) (VERIFYMAILFOLDER 37608 .
42078) (VERIFYFAILED 42080 . 42295) (READTOCFILE 42297 . 49852) (BADTOCFILE 49854 . 50196) (
\LAFITE.TOCEOF 50198 . 50492) (LA.READCOUNT 50494 . 51162) (LA.PRINTCOUNT 51164 . 51377) (LA.READSTAMP
51379 . 51925) (\LAFITE.VERIFYMSG 51927 . 52731) (LA.MSGFROMMEP 52733 . 53679) (LA.PRINTSTAMP 53681
. 54108) (LA.READSHORTSTRING 54110 . 54505) (LA.PRINTSHORTSTRING 54507 . 55015) (LA.READSTRING 55017
. 55646)) (55649 67769 (LAFITE.PARSE.MSG.FOR.TOC 55659 . 58104) (LAFITE.FETCH.TO.FIELD 58106 . 59522)
(LAFITE.PARSE.HEADER 59524 . 62186) (LAFITE.GRAB.DATE 62188 . 64117) (LAFITE.READ.LINE.FOR.TOC 64119
. 64554) (LAFITE.READ.FORMAT 64556 . 64978) (LAFITE.READ.NAME.FIELD 64980 . 65702) (
LAFITE.READ.ONE.LINE.FOR.TOC 65704 . 65888) (LAFITE.READ.TO.EOL 65890 . 66784) (LA.SKIP.TO.EOL 66786
. 67519) (LAFITE.SKIP.WHITE.SPACE 67521 . 67767)) (68764 76676 (LAFITE.INIT.PARSETABLES 68774 . 73628
) (LAFITE.MAKE.PARSE.TABLE 73630 . 74381) (LAFITE.MAKE.PARSE.TABLE1 74383 . 76674)))))
STOP