(FILECREATED "15-Nov-84 00:26:57" {ERIS}<LAFITE>NSMAIL.;15 54402
changes to: (FNS NS.CLOSEMAILBOX NS.POLLNEWMAIL NS.OPENMAILBOX \NSMAIL.READ.ATTR.SEQUENCE
\NSMAIL.PRINT.HEADERFIELDS NS.NEXTMESSAGE \NSMAIL.READ.ENVELOPES
NS.RETRIEVEMESSAGE \NSMAIL.CHANGE.STATUS \NSMAIL.FINDSERVER
\NSMAIL.AUTHENTICATE \NSMAIL.SEND.PARSE \NSMAIL.MAKEANSWERFORM
\NS.READ.ENVELOPE.ITEM \NS.WRITE.ENVELOPE.ITEM \NSMAIL.SEND)
(COURIERPROGRAMS INBASKET MAILTRANSPORT)
(VARS NSMAILCOMS \NSMAIL.ENVELOPE.ITEM.TYPES \NSMAIL.MAX.KNOWN.BODYTYPE)
(RECORDS NSMAILBOX NSMAILPARSE)
(ALISTS (LAFITEMODELST NS))
(PROPS (ENVELOPE.ITEM COURIERDEF))
previous date: " 6-Nov-84 17:16:06" {ERIS}<LAFITE>NSMAIL.;7)
(* Copyright (c) 1984 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.ATTR.SEQUENCE \NSMAIL.READ.STRING.AS.STREAM
\NSMAIL.PRINT.HEADERFIELDS \NSMAIL.PRINT.NAMES)
(FNS NS.CLOSEMAILBOX \NSMAIL.CHANGE.STATUS)
(FNS \NSMAIL.SEND.PARSE \NSMAIL.PARSE \NSMAIL.PARSE1 NS.REMOVEDUPLICATES
\NSMAIL.SEND \NSMAIL.SEND.MESSAGE.CONTENT \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 \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.KNOWN.BODYTYPE
\NULL.CACHE.VERIFIER)
(GLOBALVARS NSMAIL.NET.HINT \NSMAIL.ENVELOPE.ITEM.TYPES
\NSMAIL.ATTRIBUTES \NSMAIL.SERVER.CACHE NSMAILDEBUGFLG
NSWIZARDFLG))
(INITVARS (\NSMAIL.SERVER.CACHE)
(NSMAILDEBUGFLG)
(NSMAIL.NET.HINT))
(ADDVARS (\SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE))
(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 . 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]
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 . 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 (CARDINAL))))
(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: "15-Nov-84 00:25")
(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)
(* bvm: "14-Nov-84 22:03")
(* * 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))
(STATE (fetch MAILSTATE of MAILSERVER))
SESSION POLLRESULT)
[COND
((NULL STATE)
(replace MAILSTATE of MAILSERVER with (SETQ STATE (create NSMAILSTATE
STATENAME ←(
PARSE.NSNAME
REGISTEREDNAME]
(SETQ SESSION (fetch STATESESSION of STATE))
RETRY
[COND
((NULL SESSION)
[COND
((AND JUSTCHECKING (EQ (fetch STATEFIRSTNEW of STATE)
1)) (* No session happening, but a simple mail check will
suffice, since we think the mailbox is empty)
(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)
(COND
((SETQ STREAM (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL)))
(RESETSAVE NIL (LIST (QUOTE CLOSEF)
STREAM)))
(T (RETURN]
(COND
((EQ [CAR (SETQ SESSION (COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE LOGON)
(CAR CREDENTIALS)
(CDR CREDENTIALS)
(fetch STATENAME of STATE)
\NULL.CACHE.VERIFIER T (QUOTE
RETURNERRORS]
(QUOTE ERROR))
(COND
(NSWIZARDFLG (HELP SESSION)))
(CLOSEF STREAM)
(RETURN)))
(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
((AND (EQ (CAR (LISTP POLLRESULT))
(QUOTE ERROR))
(EQ (CADR POLLRESULT)
(QUOTE SESSION.ERROR))) (* Session timed out, start a new one)
(replace STATESESSION of STATE with (SETQ SESSION NIL))
(OR (EQ (fetch STATEFIRSTNEW of STATE)
1)
(replace STATEFIRSTNEW of STATE with NIL))
(GO RETRY)))
[COND
((OR (NOT JUSTCHECKING)
(NULL (fetch STATEFIRSTNEW of STATE)))
(* Need to locate first NEW message)
(replace STATEFIRSTNEW of STATE with (COURIER.CALL STREAM (QUOTE INBASKET)
(QUOTE LOCATE)
SESSION
(QUOTE NEW)
(QUOTE NOERROR]
(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])
(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: "14-Nov-84 23:28")
(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
(CADR (ASSOC (QUOTE BodyType)
\NSMAIL.ATTRIBUTES]
(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: "31-Jul-84 11:13")
(* * 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; BulkData.StreamOfUnspecified; lastByteIsSignificant: Boolean; children: Sequence of
SerializedTree)
(COND
((\NSMAIL.READ.ATTR.SEQUENCE MSGSTREAM MSGOUTFILE ENVELOPE)
(* Message is formatted, there should be no more)
)
(T (TERPRI MSGOUTFILE))) (* This is logical header)
(* Here comes body)
(bind LASTSEGMENT? BYTE WORDCOUNT
do [SETQ LASTSEGMENT? (NOT (ZEROP (GETWORD MSGSTREAM]
(COND
[(NEQ (SETQ WORDCOUNT (UNFOLD (GETWORD MSGSTREAM)
BYTESPERWORD))
0)
(RPTQ (SUB1 WORDCOUNT)
(\BOUT MSGOUTFILE (\BIN MSGSTREAM)))
(SETQ BYTE (\BIN MSGSTREAM)) (* Final byte of this segment.
Don't copy until we know whether it's significant)
(COND
((OR (NULL LASTSEGMENT?)
(NEQ (\WIN MSGSTREAM)
0)) (* Not last segment, or the word after says the final
byte was significant)
(\BOUT MSGOUTFILE BYTE]
(T (* Null body. Throw out the lastByteIsSignificant flag)
(\WIN MSGSTREAM)))
repeatuntil LASTSEGMENT?)
(RPTQ (\WIN MSGSTREAM) (* Read children)
(\NSMAIL.READ.SERIALIZED.TREE MSGSTREAM MSGOUTFILE])
(\NSMAIL.READ.ATTR.SEQUENCE
[LAMBDA (MSGSTREAM MSGOUTFILE ENVELOPE) (* bvm: "14-Nov-84 23:12")
(* 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)
(SETQ NOTEBODY (OPENTEXTSTREAM NOTEBODY))
(TEDIT.SETSEL NOTEBODY 1 0 (QUOTE LEFT))
(TEDIT.INCLUDE NOTEBODY HEADERS)
(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 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: "14-Nov-84 23:12")
(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
((IGREATERP VALUE \NSMAIL.MAX.KNOWN.BODYTYPE)
(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: "15-Nov-84 00:19")
(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 (KEPT ← 0)
do [COND
((NEQ (CADR E)
STATUS)
[COND
(START (add KEPT (\NSMAIL.CHANGE.STATUS MAILBOX START
(SUB1 (CAR E))
STATUS]
(SETQ START (CAR E))
(SETQ STATUS (CADR E]
finally [COND
(START (add KEPT (\NSMAIL.CHANGE.STATUS MAILBOX START
(fetch NSMAILLASTINDEX
of MAILBOX)
STATUS]
(* If any messages were kept, update our notion of what
the first new one should be)
(add (fetch STATEFIRSTNEW of STATE)
KEPT))
(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)
(COND
((NEQ (fetch STATEFIRSTNEW of STATE)
1)
(* 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]
(CLOSEF (fetch NSMAILSTREAM of MAILBOX))
(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: "12-Nov-84 18:22")
(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 [RPLACD PAIR (SETQ SUBJECT
(COND
((CDDR PAIR)
(CONCATLIST (CDR PAIR)))
(T (CADR PAIR]
(* Make one string)
(push INTERESTINGFIELDS 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: " 6-Nov-84 17:07")
(* * 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 (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)))
(SETQ START 0)))
(COND
((NULL (\LAFITE.GET.USER.DATA)) (* \LAFITE.GET.USER.DATA didn't make it -- get out *)
(RETURN)))
(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))
(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: "25-Aug-84 21:31")
(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)))
(* * 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))
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]
(\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE BodyType)
\NSMAIL.EMPTY.BODYTYPE)
(for PAIR in MSGFIELDS do (\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (CAR PAIR)
(CDR PAIR)))
(COND
((AND ABORTWINDOW (WINDOWPROP ABORTWINDOW (QUOTE ABORT)))
(ERROR!)))
(\NSMAIL.SEND.STREAM.AS.STRING MSG DATASTREAM START (CADR (ASSOC (QUOTE Note)
\NSMAIL.ATTRIBUTES)))
[COND
(FORMATSTREAM (\NSMAIL.SEND.STREAM.AS.STRING FORMATSTREAM DATASTREAM 0
(CADR (ASSOC (QUOTE LispFormatting)
\NSMAIL.ATTRIBUTES]
(PROGN (* Now the content -- null)
(\WOUT DATASTREAM 1) (* Last segment)
(\WOUT DATASTREAM 0) (* Empty sequence)
(\WOUT DATASTREAM 0) (* Last byte not significant)
(\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])
(\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)))
(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)
(BodyType 17 LONGCARDINAL)
(Note 4687 STRING)
(LispFormatting 4910 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 STATENAME STATEFIRSTNEW))
(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.KNOWN.BODYTYPE 4)
(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.KNOWN.BODYTYPE \NULL.CACHE.VERIFIER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NSMAIL.NET.HINT \NSMAIL.ENVELOPE.ITEM.TYPES \NSMAIL.ATTRIBUTES \NSMAIL.SERVER.CACHE
NSMAILDEBUGFLG NSWIZARDFLG)
)
)
(RPAQ? \NSMAIL.SERVER.CACHE )
(RPAQ? NSMAILDEBUGFLG )
(RPAQ? NSMAIL.NET.HINT )
(ADDTOVAR \SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE)
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8758 11920 (\NSMAIL.AUTHENTICATE 8768 . 11417) (NS.FINDMAILBOXES 11419 . 11918)) (11921
30615 (NS.POLLNEWMAIL 11931 . 12429) (NS.OPENMAILBOX 12431 . 13895) (\NSMAIL.CHECK 13897 . 17822) (
NS.NEXTMESSAGE 17824 . 18564) (\NSMAIL.READ.ENVELOPES 18566 . 19810) (NS.RETRIEVEMESSAGE 19812 . 20534
) (\NSMAIL.RETRIEVE.CONTENT 20536 . 21349) (\NSMAIL.EOF.ON.RETRIEVE 21351 . 21832) (
\NSMAIL.READ.SERIALIZED.TREE 21834 . 23613) (\NSMAIL.READ.ATTR.SEQUENCE 23615 . 27230) (
\NSMAIL.READ.STRING.AS.STREAM 27232 . 27772) (\NSMAIL.PRINT.HEADERFIELDS 27774 . 30288) (
\NSMAIL.PRINT.NAMES 30290 . 30613)) (30616 33425 (NS.CLOSEMAILBOX 30626 . 32585) (
\NSMAIL.CHANGE.STATUS 32587 . 33423)) (33426 46224 (\NSMAIL.SEND.PARSE 33436 . 35815) (\NSMAIL.PARSE
35817 . 36153) (\NSMAIL.PARSE1 36155 . 36984) (NS.REMOVEDUPLICATES 36986 . 37530) (\NSMAIL.SEND 37532
. 40780) (\NSMAIL.SEND.MESSAGE.CONTENT 40782 . 43524) (\NSMAIL.SEND.STREAM.AS.STRING 43526 . 44286) (
\NSMAIL.WRITE.ATTRIBUTE 44288 . 44764) (\NSMAIL.FINDSERVER 44766 . 45827) (\NSMAIL.CHECKSERVER 45829
. 46222)) (46225 50150 (\NSMAIL.MAKEANSWERFORM 46235 . 50148)) (50241 52048 (\NS.READ.ENVELOPE.ITEM
50251 . 51155) (\NS.WRITE.ENVELOPE.ITEM 51157 . 52046)))))
STOP