(FILECREATED "12-Mar-85 00:52:27" {ERIS}<LAFITE>LAFITEMAIL.;20 57280
changes to: (FNS \LAFITE.GET.USER.DATA \LAFITE.HANDLE.BIG.MESSAGE \LAFITE.WAKE.WATCHER
POLLNEWMAIL PRINTLAFITESTATUS)
previous date: "24-Feb-85 22:49:29" {ERIS}<LAFITE>LAFITEMAIL.;18)
(* Copyright (c) 1984, 1985 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)
(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 (RECORDS MAILSERVEROPS)
(GLOBALVARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY ADDRESSPARSERRDTBL
DEFAULTREGISTRY LAFITEDEBUGFLG LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE
LAFITEIFFROMMETHENSEENFLG LAFITENEWMAILTUNE LINEPARSERRDTBL
MAILWATCHWAITTIME \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL
\LAPARSE.TOCFIELDS \LAPARSE.TOFIELD LAFITE.AFTER.GETMAIL.FN))))
(* 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: "24-Feb-85 22:45")
(PROG ((REPORTWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER))
(OUTSTREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE APPEND)))
FIRSTMESSAGE)
[for MAILSERVER in [fetch (LAFITEUSERDATA MAILSERVERS)
of (OR (\LAFITE.GET.USER.DATA)
(PROGN (printout REPORTWINDOW "No mailboxes known")
(GO EXIT]
bind MESSAGELIST NTHTIME when (PROGN (COND
(NTHTIME (printout REPORTWINDOW "; "))
(T (SETQ NTHTIME T)))
(printout REPORTWINDOW (fetch (MAILSERVER
MAILSERVERNAME)
of MAILSERVER)
" ..")
(SETQ MESSAGELIST (\LAFITE.GETNEWMAIL1 MAILSERVER
MAILFOLDER
OUTSTREAM
REPORTWINDOW
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]
(printout REPORTWINDOW (QUOTE %.))
[COND
(FIRSTMESSAGE (* If any mail was retrieved, select the first message
and make sure it is visible)
(LAB.EXPOSEMESSAGE MAILFOLDER FIRSTMESSAGE)
(COND
((AND LAFITEGETMAILTUNE (EQ (MACHINETYPE)
(QUOTE DANDELION)))
(PLAYTUNE LAFITEGETMAILTUNE]
EXIT(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T])
(\LAFITE.GETNEWMAIL1
[LAMBDA (MAILSERVER MAILFOLDER OUTSTREAM REPORTWINDOW NTHTIME)
(* bvm: "24-Feb-85 21:36")
(PROG (MESSAGELIST OPENRESULT MAILBOX #OFMESSAGES)
(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 (CAR OPENRESULT)))
(T OPENRESULT))
(EMPTY (printout REPORTWINDOW " empty")
(RETURN))
(NIL (* No response))
(COND
(MAILBOX (COND
((NOT NTHTIME)
(PRINTLAFITESTATUS (QUOTE NEW.MAIL))
(UNSELECTALLMESSAGES MAILFOLDER)))
(COND
((SETQ #OFMESSAGES (fetch (OPENEDMAILBOX #OFMESSAGES) of OPENRESULT))
(\LAFITE.GETNEWMAIL# REPORTWINDOW #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)
(printout REPORTWINDOW " done")
[COND
((NULL #OFMESSAGES)
(\LAFITE.GETNEWMAIL# REPORTWINDOW (LENGTH MESSAGELIST]
MESSAGELIST)
(T (* \LAFITE.RETRIEVEMESSAGES already set the file ptr
back, etc *)
(printout REPORTWINDOW " retrieval aborted")
(APPLY* (fetch (MAILSERVER CLOSEMAILBOX) of MAILSERVER)
MAILBOX NIL)
NIL]
(printout REPORTWINDOW " not responding")
(COND
((CDR (LISTP OPENRESULT)) (* Say more about why not responding)
(printout REPORTWINDOW " (" (fetch (OPENEDMAILBOX PROPERTIES) of OPENRESULT)
")"])
(\LAFITE.GETNEWMAIL#
[LAMBDA (REPORTWINDOW #OFMESSAGES) (* bvm: " 4-Jan-84 15:44")
(printout REPORTWINDOW " (" #OFMESSAGES (COND
((EQ #OFMESSAGES 1)
" msg")
(T " msgs"))
")"])
(\LAFITE.RETRIEVEMESSAGES
[LAMBDA (MAILSERVER MAILBOX OUTSTREAM MAILFOLDER) (* bvm: "13-Nov-84 11:00")
(DECLARE (SPECVARS GOODEOFPTR)) (* Kludge for NS mail)
(PROG ((ORIGEOF (GETEOFPTR OUTSTREAM))
MESSAGELIST GOODEOFPTR)
(SETQ GOODEOFPTR ORIGEOF)
(RETURN (COND
([ERSETQ (bind (NEXTMESSAGEFN ←(fetch (MAILSERVER NEXTMESSAGE) of MAILSERVER))
(RETRIEVEFN ←(fetch (MAILSERVER RETRIEVEMESSAGE) of MAILSERVER))
(ENDPOS ← ORIGEOF)
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]
(REVERSE MESSAGELIST))
(T (* something went drastically wrong!!! -
repair the damage and get out *)
(SETFILEPTR OUTSTREAM GOODEOFPTR)
(SETFILEINFO OUTSTREAM (QUOTE LENGTH)
GOODEOFPTR)
(\LAFITE.CLOSE.FOLDER MAILFOLDER T) (* open it up again *)
(\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE APPEND))
(COND
((NEQ GOODEOFPTR ORIGEOF) (* Return what we have so far)
(REVERSE MESSAGELIST])
(\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: "31-Jul-84 15:16")
(PROG ((STREAM (\LAFITE.OPEN.FOLDER MAILFOLDER (QUOTE INPUT)
(QUOTE OLD)))
MESSAGES END)
(SETQ END (GETEOFPTR STREAM))
(RETURN (COND
((OR (ZEROP END)
(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: "28-Mar-84 14:43")
(* * 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)
(printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Parsing "
(COND
((ZEROP START)
"folder")
(T "additional msgs"))
(QUOTE ...))
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
(bind CHCOUNT STAMPCOUNT MARK SEEN STARTFLG DELETED LASTMSG (HERE ← START) 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))
finally [COND
((NOT (IEQP HERE EOFPTR))
(LAB.PROMPTPRINT MAILFOLDER "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]
(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: " 5-Jan-84 12:11")
(PROGN (printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
" [at msg " .P2 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: "31-Jul-84 15:09")
(* * 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 (printout (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)
"Reading table of contents...")
(replace (MAILFOLDER BROWSERPROMPTDIRTY) of MAILFOLDER with T)
(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)
(printout (fetch BROWSERPROMPTWINDOW of 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
((ZEROP (SETQ LENGTH (BIN TOCSTREAM)))
(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: "20-Feb-84 12:41")
(PROG ((WINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of MAILFOLDER)))
(COND
(CLEARFLG (CLEARW WINDOW)))
(printout WINDOW ERRMSG)
(COND
(LAFITEDEBUGFLG (HELP "TOC file error" ERRMSG)))
(DELFILE (CLOSEF TOCSTREAM))
(RETURN NIL])
(\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: "15-Apr-84 16:51")
(PROG ((SENDER (fetch (LAFITEMSG FROM) of MSG)))
(RETURN (replace (LAFITEMSG MSGFROMMEP) of MSG
with (COND
[\LAFITEUSERDATA (OR (UCASE.STREQUAL SENDER (fetch (LAFITEUSERDATA
FULLUSERNAME)
of \LAFITEUSERDATA))
(UCASE.STREQUAL SENDER (CAR (fetch (LAFITEUSERDATA
UNPACKEDUSERNAME)
of \LAFITEUSERDATA]
(T (UCASE.STREQUAL 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: "12-Nov-84 17:21")
(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)))
(DEFINEQ
(LAFITE.INIT.PARSETABLES
[LAMBDA NIL (* bvm: "12-Nov-84 17:28")
(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))
(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: EVAL@COMPILE
(RECORD MAILSERVEROPS (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX
SERVERPORTFROMNAME))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY ADDRESSPARSERRDTBL DEFAULTREGISTRY
LAFITEDEBUGFLG LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITEIFFROMMETHENSEENFLG
LAFITENEWMAILTUNE LINEPARSERRDTBL MAILWATCHWAITTIME \LAFITE.AUTHENTICATION.FAILURE
\LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD LAFITE.AFTER.GETMAIL.FN)
)
)
(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2331 15366 (\LAFITE.GETMAIL 2341 . 2629) (\LAFITE.GETMAIL.PROC 2631 . 3076) (
\LAFITE.GETNEWMAIL 3078 . 5014) (\LAFITE.GETNEWMAIL1 5016 . 7413) (\LAFITE.GETNEWMAIL# 7415 . 7647) (
\LAFITE.RETRIEVEMESSAGES 7649 . 10705) (\LAFITE.HANDLE.BIG.MESSAGE 10707 . 14511) (
\LAFITE.FIND.BREAKPOINT 14513 . 15364)) (15409 22181 (\LAFITE.GET.USER.DATA 15419 . 15831) (
LAFITECLEARCACHE 15833 . 15981) (FULLUSERNAME 15983 . 17015) (LAFITEMAILWATCH 17017 . 17689) (
\LAFITE.WAKE.WATCHER 17691 . 18301) (POLLNEWMAIL 18303 . 18836) (POLLNEWMAIL1 18838 . 20123) (
PRINTLAFITESTATUS 20125 . 22179)) (22213 41008 (PARSEMAILFOLDER 22223 . 23237) (PARSEMAILFOLDER1 23239
. 26685) (BADMAILFILE 26687 . 27505) (BADMAILFILE.FLAGBYTE 27507 . 27771) (VERIFYMAILFOLDER 27773 .
30966) (VERIFYFAILED 30968 . 31172) (READTOCFILE 31174 . 36257) (BADTOCFILE 36259 . 36703) (
\LAFITE.TOCEOF 36705 . 36981) (LA.READCOUNT 36983 . 37402) (LA.PRINTCOUNT 37404 . 37609) (LA.READSTAMP
37611 . 38040) (\LAFITE.VERIFYMSG 38042 . 38742) (LA.MSGFROMMEP 38744 . 39334) (LA.PRINTSTAMP 39336
. 39702) (LA.READSHORTSTRING 39704 . 40057) (LA.PRINTSHORTSTRING 40059 . 40469) (LA.READSTRING 40471
. 41006)) (41009 50106 (LAFITE.PARSE.MSG.FOR.TOC 41019 . 42915) (LAFITE.FETCH.TO.FIELD 42917 . 43611)
(LAFITE.PARSE.HEADER 43613 . 45565) (LAFITE.GRAB.DATE 45567 . 46903) (LAFITE.READ.LINE.FOR.TOC 46905
. 47275) (LAFITE.READ.FORMAT 47277 . 47699) (LAFITE.READ.NAME.FIELD 47701 . 48374) (
LAFITE.READ.ONE.LINE.FOR.TOC 48376 . 48556) (LAFITE.READ.TO.EOL 48558 . 49367) (LA.SKIP.TO.EOL 49369
. 49891) (LAFITE.SKIP.WHITE.SPACE 49893 . 50104)) (50814 56318 (LAFITE.INIT.PARSETABLES 50824 . 54415
) (LAFITE.MAKE.PARSE.TABLE 54417 . 54962) (LAFITE.MAKE.PARSE.TABLE1 54964 . 56316)))))
STOP