(FILECREATED " 6-Jun-85 14:24:07" {ERIS}<LAFITE>NSMAIL.;28 67022
changes to: (FNS \NSMAIL.CHECK)
(COURIERPROGRAMS INBASKET)
previous date: "24-May-85 18:31:30" {ERIS}<LAFITE>NSMAIL.;27)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NSMAILCOMS)
(RPAQQ NSMAILCOMS [(COURIERPROGRAMS MAILTRANSPORT INBASKET)
(FNS \NSMAIL.AUTHENTICATE NS.FINDMAILBOXES)
(FNS NS.POLLNEWMAIL NS.OPENMAILBOX \NSMAIL.CHECK NS.NEXTMESSAGE
\NSMAIL.READ.ENVELOPES NS.RETRIEVEMESSAGE \NSMAIL.RETRIEVE.CONTENT
\NSMAIL.EOF.ON.RETRIEVE \NSMAIL.READ.SERIALIZED.TREE
\NSMAIL.READ.SERIALIZED.CONTENT \NSMAIL.READ.ATTR.SEQUENCE
\NSMAIL.READ.STRING.AS.STREAM \NSMAIL.PRINT.HEADERFIELDS \NSMAIL.PRINT.NAMES)
(FNS NS.CLOSEMAILBOX \NSMAIL.DISCONNECT \NSMAIL.CHANGE.STATUS)
(FNS \NSMAIL.SEND.PARSE \NSMAIL.PARSE \NSMAIL.PARSE1 NS.REMOVEDUPLICATES
\NSMAIL.SEND \NSMAIL.SEND.MESSAGE.CONTENT COURIER.WRITE.STREAM.UNSPECIFIED
\NSMAIL.SEND.STREAM.AS.STRING \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.FINDSERVER
\NSMAIL.CHECKSERVER)
(FNS \NSMAIL.MAKEANSWERFORM)
(COMS (PROP COURIERDEF ENVELOPE.ITEM)
(FNS \NS.READ.ENVELOPE.ITEM \NS.WRITE.ENVELOPE.ITEM)
(VARS \NSMAIL.ENVELOPE.ITEM.TYPES)
(DECLARE: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES)))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE)
(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION
\NSMAIL.CTSTANDARD.MESSAGE \NSMAIL.TEXT.BODYTYPE
\NSMAIL.EMPTY.BODYTYPE \NSMAIL.MAX.NOTE.LENGTH
MAX.BULK.SEGMENT.LENGTH \NULL.CACHE.VERIFIER)
(MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE
\NSMAIL.WRITE.ATTRIBUTE.MACRO)
(PROP INFO \NSMAIL.ATTRIBUTE.TYPE)
(GLOBALVARS NSMAIL.NET.HINT \NSMAIL.ENVELOPE.ITEM.TYPES
\NSMAIL.ATTRIBUTES \NSMAIL.SERVER.CACHE NSMAILDEBUGFLG
NSWIZARDFLG NSMAIL.RETRIEVE.OLD \NSMAIL.GOOD.BODYTYPES))
(INITVARS (\NSMAIL.SERVER.CACHE)
(NSMAILDEBUGFLG)
(NSMAIL.NET.HINT)
(NSMAIL.RETRIEVE.OLD))
(ADDVARS (\SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE)
(\NSMAIL.GOOD.BODYTYPES 2 4))
(ALISTS (LAFITEMODELST NS STAR))
(COMS (DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LAFITE CLEARINGHOUSE])
(COURIERPROGRAM MAILTRANSPORT (17 4)
TYPES
[(CREDENTIALS (AUTHENTICATION . CREDENTIALS))
(VERIFIER (AUTHENTICATION . VERIFIER))
(ENVELOPE.ITEM.TYPE LONGCARDINAL)
(ENVELOPE (SEQUENCE ENVELOPE.ITEM))
(INVALID.NAME (RECORD (REASON INVALID.NAME.REASON)
(NAME RNAME)))
(INVALID.NAME.LIST (SEQUENCE INVALID.NAME))
(INVALID.NAME.REASON (ENUMERATION (NoSuchRecipient 0)
(CantValidateNow 1)
(IllegalName 2)
(Refused 3)
(NoAccessToDl 4)
(Timeout 5)
(NoDlsAllowed 6)
(MessageTooLong 7)))
(NAME (CLEARINGHOUSE . NAME))
(NAME.LIST (SEQUENCE NAME))
(RNAME NAME)
(RNAME.LIST (SEQUENCE RNAME))
(WILLINGNESS CARDINAL)
(CONTENTS.TYPE LONGCARDINAL)
(MESSAGEID (ARRAY 5 UNSPECIFIED))
(POSTMARK (RECORD (POSTED.AT NAME)
(TIME TIME)))
(PROBLEM (RECORD (UNDELIVERABLES INVALID.NAME.LIST)
(RETURNED.ENVELOPE ENVELOPE)))
(CONNECTION.PROBLEM (FILING . CONNECTION.PROBLEM))
(SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0)
(ServiceFull 1)
(ServiceUnavailable 2)
(MediumFull 3)))
(TRANSFER.PROBLEM (ENUMERATION (Aborted 0)
(NoRendezvous 1)
(WrongDirection 4]
PROCEDURES
((SERVER.POLL 0 (CREDENTIALS VERIFIER)
RETURNS
(WILLINGNESS (CLEARINGHOUSE . NETWORK.ADDRESS.LIST)
VERIFIER NAME))
(POST 1 (CREDENTIALS VERIFIER RNAME.LIST BOOLEAN BOOLEAN CONTENTS.TYPE ENVELOPE
BULK.DATA.SOURCE)
RETURNS
(INVALID.NAME.LIST MESSAGEID)
REPORTS
(AUTHENTICATION.ERROR CONNECTION.ERROR INVALID.RECIPIENTS SERVICE.ERROR TRANSFER.ERROR
UNDEFINED.ERROR)))
ERRORS
((AUTHENTICATION.ERROR 1 ((AUTHENTICATION . PROBLEM)))
(CONNECTION.ERROR 2 (CONNECTION.PROBLEM))
(INVALID.RECIPIENTS 3 (INVALID.NAME.LIST))
(SERVICE.ERROR 4 (SERVICE.PROBLEM))
(TRANSFER.ERROR 5 (TRANSFER.PROBLEM))
(UNDEFINED.ERROR 6 (CARDINAL))))
(COURIERPROGRAM INBASKET (18 1)
INHERITS
(MAILTRANSPORT)
TYPES
[(CREDENTIALS (AUTHENTICATION . CREDENTIALS))
(VERIFIER (AUTHENTICATION . VERIFIER))
(SESSION (RECORD (HANDLE (ARRAY 2 UNSPECIFIED))
(VERIFIER VERIFIER)))
(ENVELOPE.ITEM.TYPE LONGCARDINAL)
(ENVELOPE (SEQUENCE ENVELOPE.ITEM))
(INVALID.NAME (RECORD (REASON INVALID.NAME.REASON)
(NAME RNAME)))
(INVALID.NAME.LIST (SEQUENCE INVALID.NAME))
(INVALID.NAME.REASON (ENUMERATION (NoSuchRecipient 0)
(CantValidateNow 1)
(IllegalName 2)
(Refused 3)
(NoAccessToDl 4)
(Timeout 5)
(NoDlsAllowed 6)
(MessageTooLong 7)))
(NAME (CLEARINGHOUSE . NAME))
(NAME.LIST (SEQUENCE NAME))
(RNAME NAME)
(RNAME.LIST (SEQUENCE RNAME))
(CONTENTS.TYPE LONGCARDINAL)
(INDEX CARDINAL)
(INBASKET.STATE (RECORD (LASTINDEX INDEX)
(NEWCOUNT CARDINAL)
(ISPRIMARY BOOLEAN)
(ISPRIMARYUP BOOLEAN)))
(RANGE (RECORD (FIRST INDEX)
(LAST INDEX)))
(MAIL.ATTRIBUTE.TYPE LONGCARDINAL)
[MAIL.ATTRIBUTE (RECORD (TYPE MAIL.ATTRIBUTE.TYPE)
(VALUE (SEQUENCE UNSPECIFIED]
[SELECTIONS (RECORD (TRANSPORT.ENVELOPE BOOLEAN)
(INBASKET.ENVELOPE BOOLEAN)
(MAIL.ATTRIBUTES (SEQUENCE MAIL.ATTRIBUTE.TYPE]
(CACHE.VERIFIER (ARRAY 4 UNSPECIFIED))
(MESSAGE.DESCRIPTION (RECORD (MESSAGE.INDEX INDEX)
(TRANSPORT.ENVELOPE ENVELOPE)
(INBASKET.ENVELOPE ENVELOPE)
(CONTENT.ATTRIBUTES ENVELOPE)))
(CACHE.STATUS UNSPECIFIED)
(STATUS (ENUMERATION (NEW 0)
(KNOWN 1)
(RECEIVED 2)))
(ACCESS.PROBLEM (ENUMERATION (AccessRightsInsufficient 0)
(AccessRightsIndeterminate 1)
(InbasketInUse 2)
(NoSuchRecipients 3)
(RecipientNameIndeterminate 4)))
(CONNECTION.PROBLEM (FILING . CONNECTION.PROBLEM))
(SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0)
(ServiceFull 1)
(ServiceUnavailable 2)
(MediumFull 3)))
(TRANSFER.PROBLEM (ENUMERATION (Aborted 0)
(NoRendezvous 1)
(WrongDirection 4)))
(SESSION.PROBLEM (ENUMERATION (TokenInvalid 0)
(SessionInUse 1)))
(CALL.PROBLEM (ENUMERATION (USE.COURIER 0]
PROCEDURES
((LOGON 5 (CREDENTIALS VERIFIER NAME CACHE.VERIFIER BOOLEAN)
RETURNS
(SESSION CACHE.STATUS)
REPORTS
(ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR UNDEFINED.ERROR))
(LOGOFF 4 (SESSION)
RETURNS
(CACHE.VERIFIER)
REPORTS
(AUTHENTICATION.ERROR SESSION.ERROR UNDEFINED.ERROR))
(MAILPOLL 7 (CREDENTIALS VERIFIER NAME)
RETURNS
(INBASKET.STATE)
REPORTS
(ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR UNDEFINED.ERROR))
(MAILCHECK 6 (SESSION)
RETURNS
(INBASKET.STATE CARDINAL)
REPORTS
(ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR UNDEFINED.ERROR))
(CHANGE.STATUS 0 (SESSION RANGE STATUS)
RETURNS NIL REPORTS (AUTHENTICATION.ERROR INVALID.INDEX SESSION.ERROR
UNDEFINED.ERROR))
(DELETE 1 (SESSION RANGE)
RETURNS NIL REPORTS (AUTHENTICATION.ERROR INVALID.INDEX SESSION.ERROR UNDEFINED.ERROR))
(LIST 2 (SESSION RANGE SELECTIONS BULK.DATA.SINK)
RETURNS NIL REPORTS (AUTHENTICATION.ERROR CONNECTION.ERROR INVALID.INDEX SESSION.ERROR
TRANSFER.ERROR UNDEFINED.ERROR))
(LOCATE 3 (SESSION STATUS)
RETURNS
(INDEX)
REPORTS
(AUTHENTICATION.ERROR SESSION.ERROR UNDEFINED.ERROR))
(RETRIEVE 8 (SESSION INDEX CONTENTS.TYPE BULK.DATA.SINK)
RETURNS
(ENVELOPE ENVELOPE)
REPORTS
(AUTHENTICATION.ERROR CONNECTION.ERROR CONTENTS.TYPE.MISMATCH INVALID.INDEX
SESSION.ERROR TRANSFER.ERROR UNDEFINED.ERROR)))
ERRORS
((ACCESS.ERROR 0 (ACCESS.PROBLEM))
(AUTHENTICATION.ERROR 1 ((AUTHENTICATION . PROBLEM)))
(CONNECTION.ERROR 2 (CONNECTION.PROBLEM))
(CONTENTS.TYPE.MISMATCH 3 (CONTENTS.TYPE))
(SESSION.ERROR 5 (SESSION.PROBLEM))
(INVALID.INDEX 4 (INDEX))
(SERVICE.ERROR 6 (SERVICE.PROBLEM))
(TRANSFER.ERROR 7 (TRANSFER.PROBLEM))
(UNDEFINED.ERROR 8 (CALL.PROBLEM))))
(DEFINEQ
(\NSMAIL.AUTHENTICATE
[LAMBDA NIL (* bvm: "13-Nov-84 11:39")
(PROG ((INFO (\INTERNAL/GETPASSWORD (QUOTE NS::)))
NSUSERNAME FULLNAME MSERVERS AUTHENTICATED? CREDENTIALS MSG)
(COND
(\LAFITEUSERDATA (RETURN \LAFITEUSERDATA)))
RETRY
(SETQ NSUSERNAME (PARSE.NSNAME (CAR INFO)))
(COND
((NEQ [SETQ AUTHENTICATED? (COND
((NULL (SETQ NSUSERNAME (CH.LOOKUP.OBJECT NSUSERNAME)))
(QUOTE NONE))
(T (NS.AUTHENTICATE (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS
(CONS NSUSERNAME (CDR INFO]
T)
(COND
((AND (SETQ MSG (SELECTQ AUTHENTICATED?
(CredentialsInvalid "Login incorrect")
(KeysUnavailable (CONCAT
"Authentication server unavailable for domain "
(fetch NSDOMAIN of NSUSERNAME)))
(NONE "No such user")
NIL))
(SETQ INFO (\INTERNAL/GETPASSWORD (QUOTE NS::)
T NIL MSG)))
(GO RETRY)))
(printout PROMPTWINDOW T "Cannot authenticate user " (NSNAME.TO.STRING NSUSERNAME T)
" because: "
(SETQ \LAFITE.AUTHENTICATION.FAILURE AUTHENTICATED?)
"."))
((NULL (SETQ MSERVERS (NS.FINDMAILBOXES NSUSERNAME)))
(printout PROMPTWINDOW T "There are no mail servers for user " (NSNAME.TO.STRING
NSUSERNAME T)))
(T [SETQ \LAFITEUSERDATA (create LAFITEUSERDATA
FULLUSERNAME ←(NSNAME.TO.STRING NSUSERNAME T)
UNPACKEDUSERNAME ← NSUSERNAME
ENCRYPTEDPASSWORD ← CREDENTIALS
SHORTUSERNAME ←(CONCAT (fetch NSOBJECT of NSUSERNAME)
(QUOTE :)
(COND
((NOT (UCASE.STREQUAL
(fetch NSDOMAIN
of NSUSERNAME)
CH.DEFAULT.DOMAIN))
(fetch NSDOMAIN of NSUSERNAME)
)
(T "")))
MAILSERVERS ←(for MAILSERVER in MSERVERS
collect
(* MAILSERVER = (name (addresses)))
(create
MAILSERVER
MAILPORT ←(CAADR MAILSERVER)
MAILSERVERNAME ←(CAR MAILSERVER)
MAILSERVEROPS ←(CONSTANT
(LIST (FUNCTION NS.POLLNEWMAIL)
(FUNCTION NS.OPENMAILBOX)
(FUNCTION NS.NEXTMESSAGE)
(FUNCTION NS.RETRIEVEMESSAGE)
(FUNCTION NS.CLOSEMAILBOX]
(RETURN \LAFITEUSERDATA])
(NS.FINDMAILBOXES
[LAMBDA (USERNAME) (* bvm: "28-Jun-84 16:37")
(PROG [(MAILBOXENTRY (CH.RETRIEVE.ITEM (PARSE.NSNAME USERNAME)
(CH.PROPERTY (QUOTE MAILBOXES))
(QUOTE MAILBOX.VALUES]
(RETURN (for MB in (COURIER.FETCH (CLEARINGHOUSE . MAILBOX.VALUES)
MAIL.SERVICE of (CADR MAILBOXENTRY))
collect (CH.RETRIEVE.ITEM MB (CH.PROPERTY (QUOTE ADDRESS.LIST))
(QUOTE NETWORK.ADDRESS.LIST])
)
(DEFINEQ
(NS.POLLNEWMAIL
[LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER) (* bvm: "22-May-85 11:40")
(PROG (RESULT N)
(RETURN (COND
((SETQ RESULT (\NSMAIL.CHECK ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER))
(AND (NEQ (SETQ N (fetch STATEFIRSTNEW of (fetch MAILSTATE of MAILSERVER)))
0)
(IGEQ (COURIER.FETCH (INBASKET . INBASKET.STATE)
LASTINDEX of RESULT)
N)))
(T (QUOTE ?])
(NS.OPENMAILBOX
[LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER) (* bvm: "15-Nov-84 00:23")
(PROG ((STREAM (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL)))
(NSMAILSTATE (fetch MAILSTATE of MAILSERVER))
INBASKETSTATE FIRSTINDEX LASTINDEX N)
(RETURN (COND
((NULL STREAM)
NIL)
((NULL (SETQ INBASKETSTATE (\NSMAIL.CHECK ADDRESS REGISTEREDNAME CREDENTIALS
MAILSERVER STREAM)))
(CLOSEF STREAM)
NIL)
((EQ [SETQ N (COND
(NIL (* This is apparently not yet implemented -- always
zero)
(COURIER.FETCH (INBASKET . INBASKET.STATE)
NEWCOUNT of INBASKETSTATE))
((EQ (SETQ FIRSTINDEX (fetch STATEFIRSTNEW of NSMAILSTATE))
0) (* No NEW messages at all)
0)
(T (ADD1 (IDIFFERENCE (SETQ LASTINDEX (COURIER.FETCH (INBASKET .
INBASKET.STATE)
LASTINDEX of
INBASKETSTATE))
FIRSTINDEX]
0)
(CLOSEF STREAM)
(QUOTE EMPTY))
(T (* Return (MAILBOX . properties))
(CONS (create NSMAILBOX
NSMAILSTREAM ← STREAM
NSMAILLASTINDEX ← LASTINDEX
NSMAILSTATE ← NSMAILSTATE)
(LIST (QUOTE #OFMESSAGES)
N])
(\NSMAIL.CHECK
[LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM STATE)
(* bvm: " 6-Jun-85 14:22")
(* * Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not.
Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW
(first new message))
(RESETLST (PROG ((JUSTCHECKING (NULL STREAM))
SESSION POLLRESULT LASTINDEX FIRSTNEW OLDLAST)
[COND
([AND (NULL STATE)
(NULL (SETQ STATE (fetch MAILSTATE of MAILSERVER]
(replace MAILSTATE of MAILSERVER with (SETQ STATE (create NSMAILSTATE
STATENAME ←(
PARSE.NSNAME
REGISTEREDNAME)
STATEADDRESS ←
ADDRESS
STATECREDENTIALS ←
CREDENTIALS]
(SETQ SESSION (fetch STATESESSION of STATE))
(SETQ FIRSTNEW (fetch STATEFIRSTNEW of STATE))
(SETQ OLDLAST (fetch STATEOLDLAST of STATE))
RETRY
[COND
((NULL SESSION)
(* Would be nice to be able to do a simple check without session -- (COND ((AND JUSTCHECKING
(EQ FIRSTNEW 1)) (RETURN (AND (LISTP (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
(QUOTE INBASKET) (QUOTE MAILPOLL) (CAR CREDENTIALS) (CDR CREDENTIALS) (fetch STATENAME of STATE)
(QUOTE RETURNERRORS)))) (NEQ (CAR POLLRESULT) (QUOTE ERROR)) POLLRESULT)))))
[COND
((NULL STREAM) (* Need a real Courier stream for some reason here)
(COND
((SETQ STREAM (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STREAM)))
(T (RETURN]
(COND
((EQ [CAR (SETQ SESSION (COND
((OR T STREAM) (* Would be nice to do this expedited, but this ability
was taken out in Services 8.1!)
(COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE LOGON)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
(fetch STATENAME of STATE)
\NULL.CACHE.VERIFIER T (QUOTE RETURNERRORS)))
(T (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
(QUOTE INBASKET)
(QUOTE LOGON)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
(fetch STATENAME of STATE)
\NULL.CACHE.VERIFIER T
(QUOTE RETURNERRORS]
(QUOTE ERROR))
(GO ERROR)))
(replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION]
[SETQ POLLRESULT (COND
((NULL STREAM) (* Just checking)
(COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE INBASKET)
(QUOTE MAILCHECK)
SESSION
(QUOTE RETURNERRORS)))
(T (COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE MAILCHECK)
SESSION
(QUOTE RETURNERRORS]
(COND
((NULL POLLRESULT)
(RETURN)))
[COND
((EQ (CAR (LISTP POLLRESULT))
(QUOTE ERROR))
(COND
((EQ (CADR POLLRESULT)
(QUOTE SESSION.ERROR)) (* Session timed out, start a new one)
(replace STATESESSION of STATE with (SETQ SESSION NIL))
(replace STATEFIRSTNEW of STATE with (SETQ FIRSTNEW NIL))
(replace STATEOLDLAST of STATE with (SETQ OLDLAST NIL))
(GO RETRY))
(T (SETQ SESSION POLLRESULT)
(GO ERROR]
(SETQ LASTINDEX (COURIER.FETCH (INBASKET . INBASKET.STATE)
LASTINDEX of (CAR POLLRESULT)))
(COND
((EQ LASTINDEX 0)
(replace STATEFIRSTNEW of STATE with 0))
((OR (NULL OLDLAST)
(ILESSP OLDLAST LASTINDEX)
(NOT JUSTCHECKING)
(NULL FIRSTNEW)) (* Need to accurately locate first NEW message)
[replace STATEFIRSTNEW of STATE with (COND
(NSMAIL.RETRIEVE.OLD
(* Retrieve even OLD messages)
1)
(STREAM (COURIER.CALL STREAM
(QUOTE INBASKET)
(QUOTE LOCATE)
SESSION
(QUOTE NEW)
(QUOTE NOERROR)))
(T (COURIER.EXPEDITED.CALL
ADDRESS \NSMAIL.SOCKET
(QUOTE INBASKET)
(QUOTE LOCATE)
SESSION
(QUOTE NEW)
(QUOTE RETURNERRORS]
(replace STATEOLDLAST of STATE with LASTINDEX)))
(replace (MAILSERVER CONTINUANCE) of MAILSERVER
with (ITIMES 1000 (IQUOTIENT (ITIMES (CADR POLLRESULT)
4)
5))) (* Tell poller to call again soon enough to keep
session alive)
(RETURN (CAR POLLRESULT))
ERROR
(PRINTOUT PROMPTWINDOW T "Mail Server Error: " (CDR SESSION))
(COND
(NSWIZARDFLG (HELP SESSION)))
(RETURN])
(NS.NEXTMESSAGE
[LAMBDA (MAILBOX) (* bvm: "14-Nov-84 23:30")
(PROG ((ENVELOPES (fetch NSMAILENVTAIL of MAILBOX)))
(SELECTQ ENVELOPES
(NIL (* First time, read all envelopes)
(COND
([OR (fetch NSMAILENVELOPES of MAILBOX)
(NULL (SETQ ENVELOPES (\NSMAIL.READ.ENVELOPES MAILBOX]
(RETURN)))
(replace NSMAILENVELOPES of MAILBOX with ENVELOPES)
(replace NSMAILENVTAIL of MAILBOX with ENVELOPES))
(T (* Finished)
(RETURN))
NIL)
(RETURN (CAR ENVELOPES])
(\NSMAIL.READ.ENVELOPES
[LAMBDA (MAILBOX) (* bvm: "16-May-85 12:47")
(PROG (ENVELOPES)
[SETQ ENVELOPES (COURIER.CALL (fetch NSMAILSTREAM of MAILBOX)
(QUOTE INBASKET)
(QUOTE LIST)
(fetch NSMAILSESSION of MAILBOX)
(COURIER.CREATE (INBASKET . RANGE)
FIRST ←(fetch NSMAILFIRSTINDEX of MAILBOX)
LAST ←(fetch NSMAILLASTINDEX of MAILBOX))
(COURIER.CREATE (INBASKET . SELECTIONS)
TRANSPORT.ENVELOPE ← T INBASKET.ENVELOPE ← T
MAIL.ATTRIBUTES ←(LIST (\NSMAIL.ATTRIBUTE.TYPE
BodyType)))
(QUOTE (INBASKET . MESSAGE.DESCRIPTION]
(RETURN (for E in ENVELOPES collect (CONS (COURIER.FETCH (INBASKET . MESSAGE.DESCRIPTION)
MESSAGE.INDEX of E)
(APPEND (COURIER.FETCH (INBASKET .
MESSAGE.DESCRIPTION)
CONTENT.ATTRIBUTES of E)
(COURIER.FETCH (INBASKET .
MESSAGE.DESCRIPTION)
TRANSPORT.ENVELOPE of E)
(COURIER.FETCH (INBASKET .
MESSAGE.DESCRIPTION)
INBASKET.ENVELOPE of E])
(NS.RETRIEVEMESSAGE
[LAMBDA (MAILBOX MSGOUTFILE) (* bvm: "14-Nov-84 23:30")
(DECLARE (SPECVARS MSGOUTFILE ENVELOPE))
(PROG [(ENVELOPE (pop (fetch NSMAILENVTAIL of MAILBOX]
(COURIER.CALL (fetch NSMAILSTREAM of MAILBOX)
(QUOTE INBASKET)
(QUOTE RETRIEVE)
(fetch NSMAILSESSION of MAILBOX)
(CAR ENVELOPE)
\NSMAIL.CTSTANDARD.MESSAGE
(FUNCTION \NSMAIL.RETRIEVE.CONTENT))
(COND
((NEQ (CADR ENVELOPE)
(QUOTE NO)) (* Read okay, tell close mailbox to delete it)
(RPLACA (CDR ENVELOPE)
(QUOTE DELETE])
(\NSMAIL.RETRIEVE.CONTENT
[LAMBDA (MSGSTREAM)
(DECLARE (SPECVARS RETRIEVALERROR)
(USEDFREE ENVELOPE MSGOUTFILE)) (* bvm: " 8-Nov-84 12:11")
(PROG (RETRIEVALERROR CTTYPE)
(SETFILEINFO MSGSTREAM (QUOTE ENDOFSTREAMOP)
(FUNCTION \NSMAIL.EOF.ON.RETRIEVE))
(OR (EQ (COURIER.READ MSGSTREAM NIL (QUOTE LONGCARDINAL))
\SERIALIZED.FILE.VERSION)
(HELP "Wrong serialized file version")) (* MSGSTREAM is a bulk data stream containing content
of msg, as a "serialized file")
(\NSMAIL.READ.SERIALIZED.TREE MSGSTREAM MSGOUTFILE (CDR ENVELOPE))
(COND
(RETRIEVALERROR (printout MSGOUTFILE T "**Warning: errors in message format**" T])
(\NSMAIL.EOF.ON.RETRIEVE
[LAMBDA (STREAM)
(DECLARE (USEDFREE RETRIEVALERROR)) (* bvm: "31-Jul-84 22:26")
(SETQ RETRIEVALERROR T)
(COND
(LAFITEDEBUGFLG (HELP "EOF during retrieve")))
(PROG (POS)
(COND
((SETQ POS (STKPOS (FUNCTION \NSMAIL.READ.ATTR.SEQUENCE)))
(RETTO POS (QUOTE *ERROR*)
T))
((SETQ POS (STKPOS (FUNCTION \NSMAIL.READ.SERIALIZED.TREE)))
(RETFROM POS NIL T))
(T 0])
(\NSMAIL.READ.SERIALIZED.TREE
[LAMBDA (MSGSTREAM MSGOUTFILE ENVELOPE) (* bvm: "16-May-85 16:57")
(* * Read a message, which is in the format of a NS Filing Serialized File. This is the recursive part,
SerializedTree. Format is -
Sequence of Attribute; Content; children = Sequence of SerializedTree)
(PROG (FORMATTED? TYPE VALUE HEADERFIELDS LENGTH NOTEBODY HEADERS SENDER TYPEINFO COERCED
FORMATSTREAM BODYSTREAM)
(for N from (\WIN MSGSTREAM) to 1 by -1
do (SETQ TYPE (COURIER.READ MSGSTREAM NIL (QUOTE LONGCARDINAL)))
[COND
((NOT (find old TYPEINFO in \NSMAIL.ATTRIBUTES suchthat (EQ (CADR TYPEINFO)
TYPE)))
(AND NSMAILDEBUGFLG (printout PROMPTWINDOW T "Unrecognized attribute " TYPE))
(COURIER.READ.SEQUENCE MSGSTREAM NIL (QUOTE UNSPECIFIED)))
[(EQ (SETQ TYPE (CAR TYPEINFO))
(QUOTE Note)) (* This is a star mail note.
Treat as body of message. If it isn't the last
attribute, save it for the end)
(COND
((NEQ N 1)
[COND
(NOTEBODY (TERPRI NOTEBODY))
(T (SETQ NOTEBODY (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH]
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM NOTEBODY))
(T (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY)
(* Print accumulated header fields)
(TERPRI MSGOUTFILE)
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM MSGOUTFILE)
(RETURN]
[(OR (EQ TYPE (QUOTE LispFormatting))
(EQ TYPE (QUOTE OldLispFormatting)))
(* Note that this MUST be the last attribute)
(COND
((EQ N 1)
(COND
(NOTEBODY (* Already got Note so body must be null)
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM NOTEBODY))
(T (* Have to save Format info until after we have read
Body)
(SETQ FORMATSTREAM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM FORMATSTREAM)))
(RETURN (SETQ FORMATTED? T)))
(T (PRINTOUT PROMPTWINDOW T "Bad formatted message")
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM (OPENSTREAM (QUOTE {NULL})
(QUOTE OUTPUT]
(T [SETQ VALUE (PROGN (\WIN MSGSTREAM)
(COURIER.READ MSGSTREAM (QUOTE MAILTRANSPORT)
(CADDR TYPEINFO]
(COND
((SELECTQ TYPE
((BodyType BodySize)
NIL)
(Sender (SETQ SENDER VALUE))
(From [COND
((AND (NULL SENDER)
(NULL (CDR VALUE)))
(SETQ SENDER (CAR VALUE]
T)
T)
(push HEADERFIELDS (CONS TYPE VALUE]
finally (* Note was not the final attribute.
Print headers accumulated, then the Note last)
(\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY))
(COND
[FORMATTED? (COND
(FORMATSTREAM (SETQ BODYSTREAM (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(\NSMAIL.READ.SERIALIZED.CONTENT MSGSTREAM BODYSTREAM)
(SETFILEPTR FORMATSTREAM 0)
(COPYBYTES FORMATSTREAM BODYSTREAM))
(T (* Already have note body)
(SETQ BODYSTREAM NOTEBODY)
(\NSMAIL.READ.SERIALIZED.CONTENT MSGSTREAM NOTEBODY)
(* This content better be empty)
))
(SETQ HEADERS (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(\NSMAIL.PRINT.HEADERFIELDS HEADERS HEADERFIELDS ENVELOPE SENDER NIL)
(TERPRI HEADERS)
(SETFILEPTR HEADERS 0)
(SETQ BODYSTREAM (OPENTEXTSTREAM BODYSTREAM))
(TEDIT.SETSEL BODYSTREAM 1 0 (QUOTE LEFT))
(TEDIT.INCLUDE BODYSTREAM HEADERS)
(PROGN (* Would like this to be (COERCETEXTOBJ BODYSTREAM
(QUOTE FILE) MSGOUTFILE) but Tedit has a bug)
(COPYBYTES (SETQ COERCED (OPENSTREAM (COERCETEXTOBJ BODYSTREAM
(QUOTE FILE))
(QUOTE INPUT)))
MSGOUTFILE)
(DELFILE (CLOSEF COERCED]
(T (* No formatting, possibly read body now)
(TERPRI MSGOUTFILE) (* Set off header)
(COND
((EQ (CAR ENVELOPE)
(QUOTE NO)) (* Can't read this attachment, leave in mailbox)
(printout MSGOUTFILE T T
"*** Attachment retained in mailbox for retrieval by other means ***"
T)
(ERROR!)))
(\NSMAIL.READ.SERIALIZED.CONTENT MSGSTREAM MSGOUTFILE)))
(RPTQ (\WIN MSGSTREAM) (* Read children)
(\NSMAIL.READ.SERIALIZED.TREE MSGSTREAM MSGOUTFILE])
(\NSMAIL.READ.SERIALIZED.CONTENT
[LAMBDA (INSTREAM OUTSTREAM) (* bvm: "16-May-85 14:29")
(* * Interprets INSTREAM as SerializedTree.Content, i.e., as a Bulkdata.StreamOfUnspecified followed by the
lastByteIsSignificant flag. Copies the raw data therein to OUTSTREAM)
(bind LASTSEGMENT? BYTE WORDCOUNT
do (SETQ LASTSEGMENT? (NEQ (\WIN INSTREAM)
0))
(COND
[(NEQ (SETQ WORDCOUNT (UNFOLD (\WIN INSTREAM)
BYTESPERWORD))
0)
(RPTQ (SUB1 WORDCOUNT)
(\BOUT OUTSTREAM (\BIN INSTREAM)))
(SETQ BYTE (\BIN INSTREAM)) (* Final byte of this segment.
Don't copy until we know whether it's significant)
(COND
((OR (NULL LASTSEGMENT?)
(NEQ (\WIN INSTREAM)
0)) (* Not last segment, or the word after says the final
byte was significant)
(\BOUT OUTSTREAM BYTE]
(T (* Null body. Throw out the lastByteIsSignificant flag)
(\WIN INSTREAM)))
repeatuntil LASTSEGMENT?])
(\NSMAIL.READ.ATTR.SEQUENCE
[LAMBDA (MSGSTREAM MSGOUTFILE ENVELOPE) (* bvm: "13-May-85 12:30")
(* Given an ATTRIBUTE.SEQUENCE object, decode the
values based on the attribute types and return a list
of attribute type/value pairs.)
(PROG (FORMATTED? TYPE VALUE HEADERFIELDS LENGTH NOTEBODY HEADERS SENDER TYPEINFO COERCED)
(for N from (\WIN MSGSTREAM) to 1 by -1
do (SETQ TYPE (COURIER.READ MSGSTREAM NIL (QUOTE LONGCARDINAL)))
[COND
((NOT (find old TYPEINFO in \NSMAIL.ATTRIBUTES suchthat (EQ (CADR TYPEINFO)
TYPE)))
(AND NSMAILDEBUGFLG (printout PROMPTWINDOW T "Unrecognized attribute " TYPE))
(COURIER.READ.SEQUENCE MSGSTREAM NIL (QUOTE UNSPECIFIED)))
[(EQ (SETQ TYPE (CAR TYPEINFO))
(QUOTE Note)) (* This is a star mail note.
Treat as body of message. If it isn't the last
attribute, save it for the end)
(COND
((NEQ N 1)
[COND
(NOTEBODY (TERPRI NOTEBODY))
(T (SETQ NOTEBODY (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH]
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM NOTEBODY))
(T (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY)
(* Print accumulated header fields)
(TERPRI MSGOUTFILE)
(\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM MSGOUTFILE)
(RETURN]
[(EQ TYPE (QUOTE LispFormatting)) (* Note that this MUST be preceded by Note)
(COND
(NOTEBODY (\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM NOTEBODY)
(SETQ HEADERS (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(\NSMAIL.PRINT.HEADERFIELDS HEADERS HEADERFIELDS ENVELOPE SENDER NIL)
(TERPRI HEADERS)
(SETFILEPTR HEADERS 0)
(SETQ NOTEBODY (OPENTEXTSTREAM NOTEBODY))
(TEDIT.SETSEL NOTEBODY 1 0 (QUOTE LEFT))
(TEDIT.INCLUDE NOTEBODY HEADERS)
(PROGN (* Would like this to be (COERCETEXTOBJ NOTEBODY
(QUOTE FILE) MSGOUTFILE) but Tedit has a bug)
(COPYBYTES (SETQ COERCED (OPENSTREAM (COERCETEXTOBJ
NOTEBODY
(QUOTE FILE))
(QUOTE INPUT)))
MSGOUTFILE)
(DELFILE (CLOSEF COERCED)))
(RETURN (SETQ FORMATTED? T)))
(T (push HEADERFIELDS (CONS (QUOTE LispFormatting)
"Invalid formatting"]
(T [SETQ VALUE (PROGN (\WIN MSGSTREAM)
(COURIER.READ MSGSTREAM (QUOTE MAILTRANSPORT)
(CADDR TYPEINFO]
(COND
((SELECTQ TYPE
((BodyType BodySize)
NIL)
(Sender (SETQ SENDER VALUE))
(From [COND
((AND (NULL SENDER)
(NULL (CDR VALUE)))
(SETQ SENDER (CAR VALUE]
T)
T)
(push HEADERFIELDS (CONS TYPE VALUE]
finally (* Note was not the final attribute.
Print headers accumulated, then the Note last)
(\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY))
(COND
((EQ (CAR ENVELOPE)
(QUOTE NO)) (* Can't read this attachment, leave in mailbox)
(printout MSGOUTFILE T T
"*** Attachment retained in mailbox for retrieval by other means ***"
T)
(ERROR!))
(T (RETURN FORMATTED?])
(\NSMAIL.READ.STRING.AS.STREAM
[LAMBDA (INSTREAM OUTSTREAM) (* bvm: "30-Jul-84 16:13")
(* Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string,
and copies said bytes to OUTSTREAM)
(PROG (LENGTH)
(\WIN INSTREAM) (* Skip sequence count)
(COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM)))
(COND
((ODDP LENGTH)
(\BIN INSTREAM])
(\NSMAIL.PRINT.HEADERFIELDS
[LAMBDA (MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY)
(* bvm: "24-May-85 18:26")
(PROG (TYPE VALUE ID)
(SETQ HEADERFIELDS (REVERSE HEADERFIELDS))
[COND
(ENVELOPE (* Prescan HEADERFIELDS to see if there is any
additional info we should supply that wasn't in the
message)
(for PAIR in ENVELOPE
do (SETQ VALUE (CADR PAIR))
(SELECTQ (SETQ TYPE (CAR PAIR))
((TransportProblem PreviousRecipients)
(push HEADERFIELDS (CONS TYPE VALUE)))
[Postmark (COND
((NULL (ASSOC (QUOTE Date)
HEADERFIELDS))
(push HEADERFIELDS (CONS (QUOTE Date)
(COURIER.FETCH
(MAILTRANSPORT .
POSTMARK)
TIME of VALUE]
[Originator (COND
[(NULL SENDER)
(push HEADERFIELDS (CONS (QUOTE Sender)
(SETQ SENDER VALUE]
((NOT (EQUAL.CH.NAMES SENDER VALUE))
(* Message has a Sender field, but it's not the same as
the Originator)
(push HEADERFIELDS (CONS TYPE VALUE]
[BodyType (COND
((NOT (MEMB VALUE \NSMAIL.GOOD.BODYTYPES))
(NCONC1 HEADERFIELDS (CONS (QUOTE Attachment)
VALUE]
(Message-ID (SETQ ID VALUE))
NIL]
(for PAIR in HEADERFIELDS when (SETQ VALUE (CDR PAIR))
do (printout MSGOUTFILE (SETQ TYPE (CAR PAIR))
": ")
(SELECTQ TYPE
[Date (printout MSGOUTFILE (GDATE VALUE (DATEFORMAT NO.SECONDS SPACES]
((From To cc Reply-to)
(\NSMAIL.PRINT.NAMES VALUE MSGOUTFILE (SELECTQ TYPE
((From Reply-to)
NIL)
SENDER)))
((Sender Originator)
(printout MSGOUTFILE (NSNAME.TO.STRING VALUE T)))
(Attachment (printout MSGOUTFILE "%"Type " .I1 VALUE " ID " .P2 ID "%"")
(RPLACA ENVELOPE (QUOTE NO)))
(PRIN1 VALUE MSGOUTFILE))
(TERPRI MSGOUTFILE))
(COND
(NOTEBODY (TERPRI MSGOUTFILE)
(COPYBYTES NOTEBODY MSGOUTFILE 0 -1)
(TERPRI MSGOUTFILE])
(\NSMAIL.PRINT.NAMES
[LAMBDA (NSNAMES OUTSTREAM DEFAULTNAME) (* bvm: " 3-Jul-84 12:53")
(for NAME in NSNAMES bind (FIRSTTIME ← T)
do (COND
(FIRSTTIME (SETQ FIRSTTIME NIL))
(T (printout OUTSTREAM ", ")))
(PRIN1 (NSNAME.TO.STRING NAME T)
OUTSTREAM])
)
(DEFINEQ
(NS.CLOSEMAILBOX
[LAMBDA (MAILBOX FLUSH?) (* bvm: "22-May-85 12:58")
(PROG ((STATE (fetch NSMAILSTATE of MAILBOX))
RESULT)
[COND
(FLUSH? (* Mark everything either deleted or seen)
[for E in (fetch NSMAILENVELOPES of MAILBOX) bind START STATUS
do [COND
((NEQ (CADR E)
STATUS)
(COND
(START (\NSMAIL.CHANGE.STATUS MAILBOX START (SUB1 (CAR E))
STATUS)))
(SETQ START (CAR E))
(SETQ STATUS (CADR E]
finally (COND
(START (\NSMAIL.CHANGE.STATUS MAILBOX START (fetch NSMAILLASTINDEX
of MAILBOX)
STATUS]
(COND
((AND [LISTP (SETQ RESULT (COURIER.CALL (fetch NSMAILSTREAM of MAILBOX)
(QUOTE INBASKET)
(QUOTE LOGOFF)
(fetch STATESESSION of STATE)
(QUOTE RETURNERRORS]
(NEQ (CAR RESULT)
(QUOTE ERROR)))
(SETQ RESULT T)))
(replace STATESESSION of STATE with NIL)
(* Once session is closed, can't say anything about first new message if there are any messages left, because
someone in the meantime could delete them from another session)
(replace STATEFIRSTNEW of STATE with NIL)
(replace STATEOLDLAST of STATE with NIL)
(* But as long as we happen to have a Courier stream
open to this host, let's establish a new session)
(* (\NSMAIL.CHECK FOO (fetch STATENAME OF STATE) NIL
NIL (fetch NSMAILSTREAM of MAILBOX) STATE))
]
(CLOSEF (fetch NSMAILSTREAM of MAILBOX))
(RETURN RESULT])
(\NSMAIL.DISCONNECT
[LAMBDA (SERVER FLUSH?) (* bvm: "22-May-85 12:58")
[OR SERVER (SETQ SERVER (CAR (fetch (LAFITEUSERDATA MAILSERVERS) of \LAFITEUSERDATA]
(RESETLST (PROG ((STATE (fetch MAILSTATE of SERVER))
STREAM RESULT)
(COND
((AND (SETQ STREAM (COURIER.OPEN (fetch MAILPORT of SERVER)))
[PROGN (RESETSAVE NIL (LIST (QUOTE CLOSEF)
STREAM))
(LISTP (SETQ RESULT (COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE LOGOFF)
(fetch STATESESSION
of STATE)
(QUOTE RETURNERRORS]
(NEQ (CAR RESULT)
(QUOTE ERROR)))
(SETQ RESULT T)))
(replace STATESESSION of STATE with NIL)
(replace STATEFIRSTNEW of STATE with NIL)
(replace STATEOLDLAST of STATE with NIL)
(RETURN RESULT])
(\NSMAIL.CHANGE.STATUS
[LAMBDA (MAILBOX START END STATUS) (* bvm: "14-Nov-84 23:28")
(* * Change status of messages START thru END to be STATUS, which is either DELETE or KEEP. Returns number of
messages kept)
(PROG ((SESSION (fetch NSMAILSESSION of MAILBOX))
(STREAM (fetch NSMAILSTREAM of MAILBOX))
(RANGE (COURIER.CREATE (INBASKET . RANGE)
FIRST ← START LAST ← END)))
(RETURN (COND
((EQ STATUS (QUOTE DELETE))
(COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE DELETE)
SESSION RANGE)
0)
(T (COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE CHANGE.STATUS)
SESSION RANGE (QUOTE KNOWN))
(ADD1 (IDIFFERENCE END START])
)
(DEFINEQ
(\NSMAIL.SEND.PARSE
[LAMBDA (MSG EDITORWINDOW) (* bvm: "22-Dec-84 00:10")
(PROG ((SENDER (fetch (LAFITEUSERDATA UNPACKEDUSERNAME) of \LAFITEUSERDATA))
RECIPIENTS MSGFIELDS FORMATTEDP HEADEREOF INTERESTINGFIELDS SUBJECT)
(OR (SETQ MSGFIELDS (\LAFITE.PREPARE.SEND MSG EDITORWINDOW))
(RETURN))
[COND
((EQ (CAAR MSGFIELDS)
(QUOTE EOF))
(SETQ HEADEREOF (CADR (pop MSGFIELDS]
(for PAIR in MSGFIELDS do (SELECTQ (CAR PAIR)
((To cc From Reply-to)
(push INTERESTINGFIELDS (RPLACD PAIR
(\NSMAIL.PARSE
(CDR PAIR)
SENDER EDITORWINDOW))
)
(SELECTQ (CAR PAIR)
[(To cc)
(SETQ RECIPIENTS
(COND
(RECIPIENTS (NS.REMOVEDUPLICATES
(APPEND (CDR PAIR)
RECIPIENTS)))
(T (CDR PAIR]
(PROGN
(* Might want to check validity of From and Reply-to)
NIL)))
[(Subject In-Reply-to)
[RPLACD PAIR (COND
((CDDR PAIR)
(CONCATLIST (CDR PAIR)))
(T (CADR PAIR]
(* Make one string)
(push INTERESTINGFIELDS PAIR)
(COND
((EQ (CAR PAIR)
(QUOTE Subject))
(SETQ SUBJECT (CDR PAIR]
(Date (\SENDMESSAGEFAIL EDITORWINDOW
"User-supplied Date not allowed"))
(Sender (\SENDMESSAGEFAIL EDITORWINDOW
"User-supplied Sender not allowed"))
(Format (SETQ FORMATTEDP (SELECTQ (CADR PAIR)
(TEDIT T)
NIL)))
NIL))
(COND
((NULL RECIPIENTS)
(\SENDMESSAGEFAIL EDITORWINDOW "No recipients!")))
(OR FORMATTEDP (SELECTQ (\LAFITE.CHOOSE.MSG.FORMAT MSG NIL EDITORWINDOW)
(TEDIT (SETQ FORMATTEDP T))
(NIL (* Aborted)
(RETURN))
NIL))
(RETURN (create NSMAILPARSE
NSPSUBJECT ← SUBJECT
NSPRECIPIENTS ← RECIPIENTS
NSPSTART ← HEADEREOF
NSPFIELDS ← INTERESTINGFIELDS
NSPFORMATTED ← FORMATTEDP])
(\NSMAIL.PARSE
[LAMBDA (FIELD DEFAULTDOMAIN EDITWINDOW) (* bvm: " 3-Jul-84 16:21")
(NS.REMOVEDUPLICATES (COND
((LISTP FIELD)
(for PIECE in FIELD join (\NSMAIL.PARSE1 PIECE DEFAULTDOMAIN EDITWINDOW))
)
(T (\NSMAIL.PARSE1 FIELD DEFAULTDOMAIN EDITWINDOW])
(\NSMAIL.PARSE1
[LAMBDA (FIELD DEFAULTDOMAIN EDITWINDOW) (* bvm: " 3-Jul-84 16:26")
(COND
(FIELD (bind ADDR (START ← 1)
COMMA when (PROGN [SETQ ADDR (SUBSTRING FIELD START (COND
((SETQ COMMA (STRPOS (QUOTE ,)
FIELD START))
(SUB1 COMMA]
(do (* Strip leading blanks)
(SELCHARQ (CHCON1 ADDR)
((SPACE TAB)
(GNC ADDR))
(RETURN)))
(do (* Strip trailing blanks)
(SELCHARQ (NTHCHARCODE ADDR -1)
((SPACE TAB)
(GLC ADDR))
(RETURN)))
(NEQ (NCHARS ADDR)
0))
collect (PARSE.NSNAME ADDR NIL DEFAULTDOMAIN) repeatwhile (COND
(COMMA (SETQ START
(ADD1 COMMA])
(NS.REMOVEDUPLICATES
[LAMBDA (LST) (* bvm: " 1-Jul-84 16:23")
(* * a case-independent intersection of LST and LST * *)
(for X in LST bind RESULT unless (for GOOD in RESULT thereis (EQUAL.CH.NAMES X GOOD))
do (* Collect only if we haven't seen this name before)
(push RESULT X)
finally (RETURN (COND
((CDR RESULT)
(REVERSE RESULT))
(T RESULT])
(\NSMAIL.SEND
[LAMBDA (MSG PARSE EDITORWINDOW ABORTWINDOW) (* bvm: "17-May-85 12:34")
(* * MSG is the entire text of the message -- RECIPIENTS is a parsed list of recipients * *)
(DECLARE (SPECVARS MSG START MSGFIELDS EDITORWINDOW ABORTWINDOW FORMATSTREAM))
(* For \NSMAIL.SEND.MESSAGE.CONTENT)
(RESETLST (PROG ((PWINDOW (AND EDITORWINDOW (GETPROMPTWINDOW EDITORWINDOW)))
(RECIPIENTS (fetch NSPRECIPIENTS of PARSE))
(START (fetch NSPSTART of PARSE))
(MSGFIELDS (fetch NSPFIELDS of PARSE))
(CREDENTIALS (fetch (LAFITEUSERDATA ENCRYPTEDPASSWORD) of \LAFITEUSERDATA))
FORMATSTREAM COURIERSTREAM DATASTREAM RECIPIENTSCHECK SENDRESULT SENDERFIELD
DATEFIELD TYPE MAILDROP RESULTS)
(COND
((fetch NSPFORMATTED of PARSE) (* Message is formatted, so get info.
Have to exclude header, since it is not sent.)
(SETQ MSG (COPYTEXTSTREAM MSG))
(TEDIT.DELETE MSG 1 START)
(SETQ FORMATSTREAM (COERCETEXTOBJ MSG (QUOTE SPLIT)))
(* Get (body . formatting))
(SETQ MSG (OPENSTREAM (CAR FORMATSTREAM)
(QUOTE INPUT)))
(SETQ FORMATSTREAM (OPENSTREAM (CDR FORMATSTREAM)
(QUOTE INPUT)))
[COND
((GREATERP [IPLUS (GETEOFPTR MSG)
(GETEOFPTR FORMATSTREAM)
START
(ITIMES (LENGTH RECIPIENTS)
42)
(NCHARS (fetch (LAFITEUSERDATA FULLUSERNAME)
of \LAFITEUSERDATA))
LAFITESTAMPLENGTH
(CONSTANT (NCHARS (CONCAT "Date: " (DATE (DATEFORMAT
TIME.ZONE))
"Sender: "]
99999) (* Message too long. Test conservatively, assuming
every recipient's name was defaulted in the actual text
given)
(RETURN (\LAFITE.SEND.FAIL EDITORWINDOW
"Message too long to send formatted. Either break it up or send it as plain text."]
(SETQ START 0)))
(COND
((NULL (\LAFITE.GET.USER.DATA)) (* \LAFITE.GET.USER.DATA didn't make it -- get out *)
(RETURN)))
[COND
(PWINDOW (CLEARW PWINDOW)
(printout PWINDOW "Delivering to " (LENGTH RECIPIENTS)
" recipient")
(COND
((CDR RECIPIENTS)
(printout PWINDOW (QUOTE s]
[COND
((NULL (SETQ MAILDROP (\NSMAIL.FINDSERVER)))
(RETURN (\LAFITE.SEND.FAIL EDITORWINDOW "Couldn't find a mail drop"]
(to 3 until (SETQ COURIERSTREAM (COURIER.OPEN MAILDROP NIL T (QUOTE NSMAILER)))
do (* loop 3 times trying to start this send *)
(DISMISS 1000))
[COND
((NULL COURIERSTREAM)
(RETURN (\LAFITE.SEND.FAIL EDITORWINDOW "Couldn't connect to a maildrop"]
(RESETSAVE NIL (LIST (FUNCTION \SPP.RESETCLOSE)
COURIERSTREAM))
(AND PWINDOW (printout PWINDOW (QUOTE ...)))
(SETQ RESULTS (COURIER.CALL COURIERSTREAM (QUOTE MAILTRANSPORT)
(QUOTE POST)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
RECIPIENTS NIL T \NSMAIL.CTSTANDARD.MESSAGE NIL
(FUNCTION \NSMAIL.SEND.MESSAGE.CONTENT)
(QUOTE RETURNERRORS)))
[COND
((EQ (CAR (LISTP RESULTS))
(QUOTE ERROR))
(RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (SELECTQ (CADR RESULTS)
(INVALID.RECIPIENTS
(\LAFITE.INVALID.RECIPIENTS
(CDDR RESULTS)))
(MKSTRING (CDR RESULTS]
(AND NSMAILDEBUGFLG (printout PROMPTWINDOW T "Post results: " RESULTS))
(RETURN (LENGTH RECIPIENTS])
(\NSMAIL.SEND.MESSAGE.CONTENT
[LAMBDA (DATASTREAM) (* bvm: "17-May-85 12:39")
(DECLARE (USEDFREE MSG START MSGFIELDS EDITORWINDOW ABORTWINDOW FORMATSTREAM))
(* From \NSMAIL.SEND)
(* * Transmits the bulkdata portion of the message)
(PROG ((SENDER (fetch (LAFITEUSERDATA UNPACKEDUSERNAME) of \LAFITEUSERDATA))
(BODYLENGTH (IDIFFERENCE (GETEOFPTR MSG)
START))
NOTEP)
(* * Want to send a serialized file on DATASTREAM -
version plus SerializedTree. See \NSMAIL.READ.SERIALIZED.TREE)
(COURIER.WRITE DATASTREAM \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL))
(* Version)
(* * Now comes (SEQUENCE ATTRIBUTE); the attributes we want to send are those in MSGFIELDS plus Date, From, BodyType
and Note)
(\WOUT DATASTREAM (IPLUS (LENGTH MSGFIELDS)
(COND
(FORMATSTREAM (* Also a LispFormatting item)
1)
(T 0))
(COND
((SETQ NOTEP (ILESSP BODYLENGTH \NSMAIL.MAX.NOTE.LENGTH))
(* Send body as Note attribute)
(SETQ BODYLENGTH 0)
1)
(T (* Send as body)
0))
4)) (* Number of attributes)
(\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE Date)
(IDATE))
[COND
((ASSOC (QUOTE From)
MSGFIELDS)
(\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE Sender)
SENDER))
(T (\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE From)
(LIST SENDER]
(for PAIR in MSGFIELDS do (\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (CAR PAIR)
(CDR PAIR)))
(\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE BodyType)
(COND
(NOTEP \NSMAIL.EMPTY.BODYTYPE)
(T \NSMAIL.TEXT.BODYTYPE)))
(\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE BodySize)
BODYLENGTH)
(COND
((AND ABORTWINDOW (WINDOWPROP ABORTWINDOW (QUOTE ABORT)))
(ERROR!)))
[COND
(NOTEP (\NSMAIL.SEND.STREAM.AS.STRING MSG DATASTREAM START (\NSMAIL.ATTRIBUTE.TYPE Note]
[COND
(FORMATSTREAM (\NSMAIL.SEND.STREAM.AS.STRING FORMATSTREAM DATASTREAM 0
(COND
(NOTEP
(* When everyone is in possession of Lafite that reads
new LispFormatting then get rid of this old one)
(\NSMAIL.ATTRIBUTE.TYPE
OldLispFormatting))
(T (\NSMAIL.ATTRIBUTE.TYPE LispFormatting]
[PROGN (* Now the content of the serialized tree, first part
of which is a Bulkdata.StreamOfUnspecified)
(COND
(NOTEP (* Null content)
(\WOUT DATASTREAM 1) (* Last segment)
(\WOUT DATASTREAM 0) (* Empty sequence)
)
(T (COURIER.WRITE.STREAM.UNSPECIFIED DATASTREAM MSG START (GETEOFPTR MSG]
(PROGN (* Finally, the last of the serialized tree)
(\WOUT DATASTREAM (LOGXOR (LOGAND BODYLENGTH 1)
1)) (* Last byte significant (even number of bytes))
(\WOUT DATASTREAM 0) (* No children)
)
(COND
((NULL ABORTWINDOW))
((WINDOWPROP ABORTWINDOW (QUOTE ABORT))
(ERROR!))
(T (* Too late to abort now)
(DELETEMENU (CAR (WINDOWPROP ABORTWINDOW (QUOTE MENU)))
NIL ABORTWINDOW)))
(RETURN NIL])
(COURIER.WRITE.STREAM.UNSPECIFIED
[LAMBDA (OUTSTREAM INSTREAM START END) (* bvm: "16-May-85 14:24")
(* * Copies INSTREAM from START to END onto OUTSTREAM in the form of Bulkdata.StreamOfUnspecified -
format is one or more concatenations of {lastSegmentP,SequenceUnspecified} -
returns T if even number of bytes written, NIL if odd)
(LET (LENGTH)
[COND
(END (SETFILEPTR INSTREAM START)
(SETQ LENGTH (IDIFFERENCE (COND
((EQ END -1)
(GETEOFPTR INSTREAM))
(T END))
START)))
(START (SETQ LENGTH START))
(T (SETQ LENGTH (IDIFFERENCE (GETEOFPTR INSTREAM)
(GETFILEPTR INSTREAM]
(while (GREATERP LENGTH MAX.BULK.SEGMENT.LENGTH)
do (\WOUT OUTSTREAM 0) (* Not last segment)
(\WOUT OUTSTREAM (FOLDHI MAX.BULK.SEGMENT.LENGTH BYTESPERWORD))
(* Word length of this segment)
(COPYBYTES INSTREAM OUTSTREAM MAX.BULK.SEGMENT.LENGTH)
(SETQ LENGTH (IDIFFERENCE LENGTH MAX.BULK.SEGMENT.LENGTH)))
(\WOUT OUTSTREAM 1) (* Last segment)
(\WOUT OUTSTREAM (FOLDHI LENGTH BYTESPERWORD)) (* Word length of this segment)
(COPYBYTES INSTREAM OUTSTREAM LENGTH)
(COND
((EVENP LENGTH)
T)
(T (* Garbage last byte)
(\BOUT OUTSTREAM 0)
NIL])
(\NSMAIL.SEND.STREAM.AS.STRING
[LAMBDA (INSTREAM OUTSTREAM START ATTRIBUTE) (* bvm: "30-Jul-84 15:31")
(* Writes the contents of INSTREAM, beginning at byte START, to OUTSTREAM in the form of a Filing Attribute whose
type is ATTRIBUTE and whose value is a string)
(PROG ((EOF (GETEOFPTR INSTREAM))
LENGTH)
(COURIER.WRITE OUTSTREAM ATTRIBUTE NIL (QUOTE LONGCARDINAL))
(\WOUT OUTSTREAM (ADD1 (FOLDHI (SETQ LENGTH (IDIFFERENCE EOF START))
BYTESPERWORD))) (* Sequence length)
(\WOUT OUTSTREAM LENGTH) (* String length)
(COPYBYTES INSTREAM OUTSTREAM START EOF)
(COND
((ODDP LENGTH)
(\BOUT OUTSTREAM 0])
(\NSMAIL.WRITE.ATTRIBUTE
[LAMBDA (STREAM TYPE VALUE) (* bvm: " 1-Jul-84 17:11")
(PROG ((TYPEINFO (ASSOC TYPE \NSMAIL.ATTRIBUTES)))
(IF TYPEINFO
THEN (COURIER.WRITE STREAM (CADR TYPEINFO)
NIL
(QUOTE LONGCARDINAL)) (* Type code)
(COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (QUOTE MAILTRANSPORT)
(CADDR TYPEINFO))
ELSE (HELP "Unknown mail attribute" TYPE])
(\NSMAIL.FINDSERVER
[LAMBDA NIL (* bvm: "14-Nov-84 23:47")
(PROG ((NULL.AUTHENTICATOR (CONSTANT (COURIER.CREATE (AUTHENTICATION . CREDENTIALS)
TYPE ←(QUOTE SIMPLE)
VALUE ← NIL)))
INFO)
(RETURN (COND
[(AND \NSMAIL.SERVER.CACHE (find ADDR in \NSMAIL.SERVER.CACHE
suchthat (\NSMAIL.CHECKSERVER
(COURIER.EXPEDITED.CALL ADDR
\NSMAIL.SOCKET
(QUOTE
MAILTRANSPORT)
(QUOTE
SERVER.POLL)
NULL.AUTHENTICATOR
(QUOTE (0))
(QUOTE
RETURNERRORS]
((SETQ INFO (COURIER.BROADCAST.CALL \NSMAIL.SOCKET (QUOTE MAILTRANSPORT)
(QUOTE SERVER.POLL)
(LIST NULL.AUTHENTICATOR (QUOTE (0)))
(FUNCTION \NSMAIL.CHECKSERVER)
NSMAIL.NET.HINT))
(push \NSMAIL.SERVER.CACHE INFO)
INFO])
(\NSMAIL.CHECKSERVER
[LAMBDA (POLLRESULT) (* bvm: " 1-Jul-84 15:15")
(* Checks that the result of a SERVER.POLL is useful.
Returns the server's address)
(COND
((AND (FIXP (CAR POLLRESULT))
(ILESSP (CAR POLLRESULT)
10))
(CAR (CADR POLLRESULT])
)
(DEFINEQ
(\NSMAIL.MAKEANSWERFORM
[LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* bvm: "12-Nov-84 17:24")
(PROG ((MSGDESCRIPTOR (OR (CAR (LISTP MSGDESCRIPTORS))
MSGDESCRIPTORS))
SUBJECT FROM DATE SENDER REPLYTO TO CC ORIGINALREGISTRY OLDFROM OLDREPLYTO OLDTO OLDCC
NEWTO NEWCC OUTSTREAM SELECTPOSITION MSGFIELDS X)
(* get the fields from the file or data *)
[SETQ MSGFIELDS (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of MAILFOLDER)
(LAFITE.PARSE.HEADER (\LAFITE.OPEN.FOLDER MAILFOLDER
(QUOTE INPUT))
\LAPARSE.FULL
(fetch (LAFITEMSG START) of
MSGDESCRIPTOR)
(fetch (LAFITEMSG END) of MSGDESCRIPTOR]
(for PAIR in MSGFIELDS do (SELECTQ (CAR PAIR)
(Subject (SETQ SUBJECT (CADR PAIR)))
(Sender (SETQ SENDER (CADR PAIR)))
(From (SETQ FROM (CADR PAIR)))
(Date (SETQ DATE (CADR PAIR)))
(Reply-to (SETQ REPLYTO (CDR PAIR)))
(To (SETQ TO (CDR PAIR)))
(cc (SETQ CC (CDR PAIR)))
NIL)) (* first parse the strings into recipients *)
(COND
[SENDER (* Sender is a mail address, and has the official
registry)
(SETQ ORIGINALREGISTRY (PARSE.NSNAME SENDER))
(SETQ OLDFROM (AND FROM (\NSMAIL.PARSE FROM ORIGINALREGISTRY]
[FROM (* Have to parse the From field before we can get its
registry)
(SETQ ORIGINALREGISTRY (CAR (SETQ OLDFROM (\NSMAIL.PARSE FROM]
(T (LAB.PROMPTPRINT MAILFOLDER "Can't reply--no FROM or SENDER field")))
(SETQ OLDREPLYTO (AND REPLYTO (\NSMAIL.PARSE REPLYTO ORIGINALREGISTRY)))
(SETQ OLDTO (AND TO (\NSMAIL.PARSE TO ORIGINALREGISTRY)))
(SETQ OLDCC (AND CC (\NSMAIL.PARSE CC ORIGINALREGISTRY)))
(* * Now construct the TO and CC fields of the reply)
(SETQ NEWTO (OR OLDREPLYTO OLDFROM))
[SETQ NEWCC (COND
(OLDREPLYTO (LIST (fetch (LAFITEUSERDATA UNPACKEDUSERNAME) of \LAFITEUSERDATA)))
(T (NS.REMOVEDUPLICATES (APPEND OLDTO OLDCC]
(for NAME in NEWTO when (SETQ X (find CCNAME in NEWCC suchthat (EQUAL.CH.NAMES CCNAME NAME))
)
do (SETQ NEWCC (DREMOVE X NEWCC))) (* now construct the message form *)
(SETQ OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST (QUOTE FONT)
LAFITEEDITORFONT)))
(LINELENGTH MAX.SMALLP OUTSTREAM) (* Sigh, apparently text streams have linelength)
(printout OUTSTREAM "Subject: ")
(COND
((NOT (UCASE.STREQUAL (SUBSTRING SUBJECT 1 3)
"Re:"))
(printout OUTSTREAM "Re: ")))
(printout OUTSTREAM (OR SUBJECT UNSUPPLIEDFIELDSTR)
T)
(printout OUTSTREAM "In-reply-to: " FROM "'s message of " DATE T)
(printout OUTSTREAM "To: ")
(\NSMAIL.PRINT.NAMES NEWTO OUTSTREAM)
(TERPRI OUTSTREAM)
(COND
(NEWCC (printout OUTSTREAM "cc: ")
(\NSMAIL.PRINT.NAMES NEWCC OUTSTREAM)
(TERPRI OUTSTREAM)))
(printout OUTSTREAM T)
(SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM)))
(printout OUTSTREAM MESSAGESTR T)
(TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS MESSAGESTR)
(QUOTE RIGHT)
T)
(RETURN OUTSTREAM])
)
(PUTPROPS ENVELOPE.ITEM COURIERDEF (\NS.READ.ENVELOPE.ITEM \NS.WRITE.ENVELOPE.ITEM))
(DEFINEQ
(\NS.READ.ENVELOPE.ITEM
[LAMBDA (STREAM PROGRAM TYPE) (* bvm: " 8-Nov-84 13:47")
(* Reads a mailing envelope attribute value pair from STREAM, returning a list of two elements,
(TYPE VALUE); if the attribute is not a known attribute, TYPE is an integer and VALUE is a sequence of unspecified)
(bind (TYPE ←(COURIER.READ STREAM NIL (QUOTE LONGCARDINAL)))
VALUE for X in \NSMAIL.ENVELOPE.ITEM.TYPES when (EQ (CADR X)
TYPE)
do [RETURN (LIST (CAR X)
(PROGN (\WIN STREAM) (* Skip sequence count)
(COURIER.READ STREAM PROGRAM (CADDR X]
finally (* TYPE not recognized)
(RETURN (LIST TYPE (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED])
(\NS.WRITE.ENVELOPE.ITEM
[LAMBDA (STREAM ITEM PROGRAM TYPE) (* bvm: " 8-Nov-84 13:46")
(* * Writes a filing attribute value pair to STREAM. ITEM is a list of two elements (TYPE VALUE))
(PROG ((TYPE (CAR ITEM))
(VALUE (CADR ITEM))
VALUETYPE)
[COND
((NOT (FIXP TYPE))
(for X in \NSMAIL.ENVELOPE.ITEM.TYPES when (EQ (CAR X)
TYPE)
do (SETQ TYPE (CADR X))
(SETQ VALUETYPE (CADDR X))
(RETURN)
finally (ERROR "Unknown Envelope Item Type" TYPE]
(COURIER.WRITE STREAM TYPE NIL (QUOTE LONGCARDINAL))
(COND
(VALUETYPE (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE PROGRAM VALUETYPE))
(T (COURIER.WRITE.SEQUENCE STREAM VALUE PROGRAM (QUOTE UNSPECIFIED])
)
(RPAQQ \NSMAIL.ENVELOPE.ITEM.TYPES ((Postmark 0 POSTMARK)
(Message-ID 1 MESSAGEID)
(ContentsType 2 LONGCARDINAL)
(CONTENTS.SIZE 3 LONGCARDINAL)
(Originator 4 RNAME)
(TransportProblem 6 PROBLEM)
(RETURN.TO.NAME 7 RNAME)
(Previous-Recipients 8 RNAME.LIST)
(Status 1000 STATUS)
(BodyType 17 LONGCARDINAL)))
(DECLARE: EVAL@COMPILE DOCOPY
(RPAQQ \NSMAIL.ATTRIBUTES ((From 4672 NAME.LIST)
(Date 4673 TIME)
(Reply-to 4674 NAME.LIST)
(To 4676 NAME.LIST)
(cc 4677 NAME.LIST)
(Subject 9 STRING)
(Message-ID 4693 MESSAGEID)
(Sender 4705 NAME)
(BodySize 16 LONGCARDINAL)
(BodyType 17 LONGCARDINAL)
(Note 4687 STRING)
(OldLispFormatting 4910 STRING)
(LispFormatting 4911 STRING)
(In-Reply-to 4690 STRING)))
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD NSMAILBOX (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE)
[ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION
of (fetch NSMAILSTATE of DATUM)))
(NSMAILFIRSTINDEX (fetch STATEFIRSTNEW of (fetch NSMAILSTATE
of DATUM])
(RECORD NSMAILSTATE (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS))
(RECORD NSMAILPARSE (NSPSUBJECT NSPRECIPIENTS NSPSTART NSPFORMATTED . NSPFIELDS))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \NSMAIL.SOCKET 26)
(RPAQQ \SERIALIZED.FILE.VERSION 2)
(RPAQQ \NSMAIL.CTSTANDARD.MESSAGE 0)
(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
(RPAQQ \NSMAIL.MAX.NOTE.LENGTH 8000)
(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
(RPAQQ \NULL.CACHE.VERIFIER (0 0 0 0))
(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \NSMAIL.CTSTANDARD.MESSAGE \NSMAIL.TEXT.BODYTYPE
\NSMAIL.EMPTY.BODYTYPE \NSMAIL.MAX.NOTE.LENGTH MAX.BULK.SEGMENT.LENGTH
\NULL.CACHE.VERIFIER)
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS)
\NSMAIL.ATTRIBUTES)))
(T (ERROR "Unknown mail attribute" (CAR ARGS))
(QUOTE IGNOREMACRO]
[PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO
(ARGS (LET [(INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS)))
\NSMAIL.ATTRIBUTES]
(COND [INFO (LIST (QUOTE \NSMAIL.WRITE.ATTRIBUTE.MACRO)
(CAR ARGS)
(CAR INFO)
(CADDR ARGS)
(KWOTE (CADR INFO]
(T (QUOTE IGNOREMACRO]
(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE)
(COURIER.WRITE STREAM TYPENO NIL
(QUOTE LONGCARDINAL))
(COURIER.WRITE.SEQUENCE.UNSPECIFIED
STREAM VALUE (QUOTE MAILTRANSPORT)
VALUETYPE)))
)
(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NSMAIL.NET.HINT \NSMAIL.ENVELOPE.ITEM.TYPES \NSMAIL.ATTRIBUTES \NSMAIL.SERVER.CACHE
NSMAILDEBUGFLG NSWIZARDFLG NSMAIL.RETRIEVE.OLD \NSMAIL.GOOD.BODYTYPES)
)
)
(RPAQ? \NSMAIL.SERVER.CACHE )
(RPAQ? NSMAILDEBUGFLG )
(RPAQ? NSMAIL.NET.HINT )
(RPAQ? NSMAIL.RETRIEVE.OLD )
(ADDTOVAR \SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE)
(ADDTOVAR \NSMAIL.GOOD.BODYTYPES 2 4)
(ADDTOVAR LAFITEMODELST (NS \NSMAIL.SEND.PARSE \NSMAIL.SEND \NSMAIL.MAKEANSWERFORM
\NSMAIL.AUTHENTICATE)
(STAR . NS))
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
LAFITE CLEARINGHOUSE)
)
(PUTPROPS NSMAIL COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8673 11835 (\NSMAIL.AUTHENTICATE 8683 . 11332) (NS.FINDMAILBOXES 11334 . 11833)) (11836
37039 (NS.POLLNEWMAIL 11846 . 12344) (NS.OPENMAILBOX 12346 . 13810) (\NSMAIL.CHECK 13812 . 19212) (
NS.NEXTMESSAGE 19214 . 19954) (\NSMAIL.READ.ENVELOPES 19956 . 21161) (NS.RETRIEVEMESSAGE 21163 . 21885
) (\NSMAIL.RETRIEVE.CONTENT 21887 . 22700) (\NSMAIL.EOF.ON.RETRIEVE 22702 . 23183) (
\NSMAIL.READ.SERIALIZED.TREE 23185 . 28598) (\NSMAIL.READ.SERIALIZED.CONTENT 28600 . 29827) (
\NSMAIL.READ.ATTR.SEQUENCE 29829 . 33669) (\NSMAIL.READ.STRING.AS.STREAM 33671 . 34211) (
\NSMAIL.PRINT.HEADERFIELDS 34213 . 36712) (\NSMAIL.PRINT.NAMES 36714 . 37037)) (37040 40918 (
NS.CLOSEMAILBOX 37050 . 39070) (\NSMAIL.DISCONNECT 39072 . 40078) (\NSMAIL.CHANGE.STATUS 40080 . 40916
)) (40919 57590 (\NSMAIL.SEND.PARSE 40929 . 43429) (\NSMAIL.PARSE 43431 . 43767) (\NSMAIL.PARSE1 43769
. 44598) (NS.REMOVEDUPLICATES 44600 . 45144) (\NSMAIL.SEND 45146 . 49220) (
\NSMAIL.SEND.MESSAGE.CONTENT 49222 . 53309) (COURIER.WRITE.STREAM.UNSPECIFIED 53311 . 54890) (
\NSMAIL.SEND.STREAM.AS.STRING 54892 . 55652) (\NSMAIL.WRITE.ATTRIBUTE 55654 . 56130) (
\NSMAIL.FINDSERVER 56132 . 57193) (\NSMAIL.CHECKSERVER 57195 . 57588)) (57591 61516 (
\NSMAIL.MAKEANSWERFORM 57601 . 61514)) (61607 63414 (\NS.READ.ENVELOPE.ITEM 61617 . 62521) (
\NS.WRITE.ENVELOPE.ITEM 62523 . 63412)))))
STOP