(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Sep-87 13:04:38" {ERIS}<LAFITE>SOURCES>NSMAIL.;10 63924
changes to%: (VARS NSMAILCOMS) (FNS \MAILOBJ.PUT.FILE)
previous date%: " 6-Jul-87 15:39:30" {ERIS}<LAFITE>SOURCES>NSMAIL.;9)
(* "
Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT NSMAILCOMS)
(RPAQQ NSMAILCOMS ((COMS (* ; "Basic mail protocol") (COURIERPROGRAMS MAILTRANSPORT INBASKET) (FNS \NSMAIL.AUTHENTICATE NS.FINDMAILBOXES) (ALISTS (LAFITEMODELST NS STAR))) (COMS (* ; "Retrieving mail") (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.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM \NSMAIL.PRINT.HEADERFIELDS \NSMAIL.PRINT.NAMES) (* ; "Close/flush protocol") (FNS NS.CLOSEMAILBOX \NSMAIL.DISCONNECT \NSMAIL.CHANGE.STATUS) (INITVARS (NSMAILDEBUGFLG) (NSMAIL.LEAVE.ATTACHMENTS)) (ADDVARS (\NSMAIL.GOOD.BODYTYPES 2 4))) (COMS (* ; "Handling attachments as a special kind of image object") (FNS \MAILOBJ.CREATE \MAILOBJ.DISPLAY \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT) (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.COPY.BODY \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT \MAILOBJ.PARSE.ATTRIBUTES) (ADDVARS (FILING.TYPES (VIEWPOINT 4353) (XEROX860 5120))) (INITVARS (MAILOBJ.WINDOWOFFSET 16) (MAILOBJ.SKIPCHAR 0)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT) (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))))) (COMS (* ; "sending mail") (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) (INITVARS (\NSMAIL.SERVER.CACHE) (NSMAIL.NET.HINT)) (ADDVARS (\SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE)) (FNS \NSMAIL.MAKEANSWERFORM)) (COMS (* ; "Utility for handling mail attributes") (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.LEAVE.ATTACHMENTS \NSMAIL.GOOD.BODYTYPES MAILOBJ.WINDOWOFFSET MAILOBJ.SKIPCHAR \MAILOBJ.IMAGEFNS)) (COMS (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) LAFITEDECLS) (FILES (LOADCOMP) CLEARINGHOUSE))))
)
(* ; "Basic mail protocol")
(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 (* ; "Edited 17-Dec-86 19:53 by bvm:") (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 (STRING.EQUAL (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))))))
)
)
(ADDTOVAR LAFITEMODELST (NS \NSMAIL.SEND.PARSE \NSMAIL.SEND \NSMAIL.MAKEANSWERFORM \NSMAIL.AUTHENTICATE)
(STAR . NS))
(* ; "Retrieving mail")
(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) (* ; "Edited 3-Jul-87 17:15 by bvm:") (* ;;; "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 NIL))))) (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) (* ; "Failed somehow") (RETURN NIL)) ((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))))) (COND ((EQ (SETQ LASTINDEX (COURIER.FETCH (INBASKET . INBASKET.STATE) LASTINDEX of (CAR POLLRESULT))) 0) (* ; "Mailbox is empty") (replace STATEFIRSTNEW of STATE with 0)) ((NOT NSMAIL.LEAVE.ATTACHMENTS) (* ; "Retrieving all mail, so we don't care about NEW vs OLD") (replace STATEFIRSTNEW of STATE with 1) (replace STATEOLDLAST of STATE with LASTINDEX)) ((OR (NULL OLDLAST) (ILESSP OLDLAST LASTINDEX) (NOT JUSTCHECKING) (NULL FIRSTNEW)) (* ; "Need to accurately locate first NEW message") (replace STATEFIRSTNEW of STATE with (COND (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 NIL))))
)
(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) (* ; "Edited 3-Jul-87 17:31 by bvm:") (DECLARE (SPECVARS MSGOUTFILE ENVELOPE RETRIEVALERROR)) (LET ((RETRIEVALERROR NIL) (ENVELOPE (pop (fetch NSMAILENVTAIL of MAILBOX))) TYPE) (if (OR NSMAIL.LEAVE.ATTACHMENTS (MEMB (SETQ TYPE (CADR (ASSOC (QUOTE BodyType) ENVELOPE))) \NSMAIL.GOOD.BODYTYPES)) then (* ; "Retrieve ordinary text message, or retrieve the text part and leave attachment behind") (COURIER.CALL (fetch NSMAILSTREAM of MAILBOX) (QUOTE INBASKET) (QUOTE RETRIEVE) (fetch NSMAILSESSION of MAILBOX) (CAR ENVELOPE) \NSMAIL.CTSTANDARD.MESSAGE (FUNCTION \NSMAIL.RETRIEVE.CONTENT)) (COND (RETRIEVALERROR (printout MSGOUTFILE T RETRIEVALERROR T))) else (* ; "Not text or mail note, so retrieve the whole thing raw.") (SETQ TYPE (\TYPE.FROM.FILETYPE TYPE)) (LET ((BODY (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH) NIL (QUOTE ((ENDOFSTREAMOP \NSMAIL.EOF.ON.RETRIEVE))))) (BUFFER (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) ATTACHPOINT ATTRIBUTE.END) (COURIER.CALL (fetch NSMAILSTREAM of MAILBOX) (QUOTE INBASKET) (QUOTE RETRIEVE) (fetch NSMAILSESSION of MAILBOX) (CAR ENVELOPE) \NSMAIL.CTSTANDARD.MESSAGE (FUNCTION (LAMBDA (BULKSTREAM) (* ; "Just eat it raw") (COPYBYTES BULKSTREAM BODY)))) (SETFILEPTR BODY 0) (\NSMAIL.CHECK.SERIALIZED.VERSION BODY) (SETQ ATTACHPOINT (\NSMAIL.READ.SERIALIZED.TREE BODY BUFFER (CDR ENVELOPE) T)) (SETQ ATTRIBUTE.END (GETFILEPTR BODY)) (SETQ BUFFER (OPENTEXTSTREAM BUFFER NIL NIL NIL (LIST (QUOTE FONT) LAFITEDISPLAYFONT))) (TEDIT.INSERT.OBJECT (\MAILOBJ.CREATE BODY TYPE ATTRIBUTE.END) BUFFER (ADD1 ATTACHPOINT)) (COPYBYTES (OPENSTREAM (COERCETEXTOBJ BUFFER (QUOTE FILE)) (QUOTE INPUT)) MSGOUTFILE) (* ; "Would like this to be (COERCETEXTOBJ BUFFER (QUOTE FILE) MSGOUTFILE) but Tedit has a bug"))) (COND ((NEQ (CADR ENVELOPE) (QUOTE NO)) (* ; "Read okay, tell close mailbox to delete it. NO set when there is an attachment to leave behind") (RPLACA (CDR ENVELOPE) (QUOTE DELETE))))))
)
(\NSMAIL.RETRIEVE.CONTENT
(LAMBDA (MSGSTREAM) (DECLARE (USEDFREE ENVELOPE MSGOUTFILE)) (* ; "Edited 3-Jul-87 17:30 by bvm:") (* ;; "Bulk data fn for procedure RETRIEVE. MSGSTREAM is a bulk data stream containing content of msg, as a 'serialized file'") (SETFILEINFO MSGSTREAM (QUOTE ENDOFSTREAMOP) (FUNCTION \NSMAIL.EOF.ON.RETRIEVE)) (\NSMAIL.CHECK.SERIALIZED.VERSION MSGSTREAM) (\NSMAIL.READ.SERIALIZED.TREE MSGSTREAM MSGOUTFILE (CDR ENVELOPE)))
)
(\NSMAIL.EOF.ON.RETRIEVE
(LAMBDA (STREAM) (DECLARE (USEDFREE RETRIEVALERROR)) (* ; "Edited 3-Jul-87 17:24 by bvm:") (SETQ RETRIEVALERROR "**Warning: errors in message format**") (COND (LAFITEDEBUGFLG (HELP "EOF during retrieve"))) (LET (POS) (COND ((SETQ POS (STKPOS (FUNCTION \NSMAIL.READ.SERIALIZED.TREE))) (RETFROM POS NIL T)) (T 0))))
)
(\NSMAIL.READ.SERIALIZED.TREE
(LAMBDA (MSGSTREAM MSGOUTFILE ENVELOPE ATTACHMENT) (* ; "Edited 30-Jun-87 17:41 by bvm:") (* ;;; "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 ATTACHPOINT) (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.SKIP.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 (SETQ ATTACHPOINT (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY ATTACHMENT)) (* ; "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") (SETQ ATTACHPOINT (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY ATTACHMENT))) (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") (COND (ATTACHMENT (* ; "We have read the header, body is attachment. Let caller know where the %"Attachment: %" line is.") (RETURN ATTACHPOINT))) (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) (COURIER.ABORT.BULKDATA))) (\NSMAIL.READ.SERIALIZED.CONTENT MSGSTREAM MSGOUTFILE))) (RPTQ (\WIN MSGSTREAM) (* ; "Read children") (\NSMAIL.READ.SERIALIZED.TREE MSGSTREAM MSGOUTFILE))))
)
(\NSMAIL.CHECK.SERIALIZED.VERSION
(LAMBDA (STREAM) (* ; "Edited 3-Jul-87 17:29 by bvm:") (OR (EQ (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL)) \SERIALIZED.FILE.VERSION) (HELP "Wrong serialized file version")))
)
(\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.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 ATTACHMENT) (* ; "Edited 30-Jun-87 15:32 by bvm:") (* ;; "Compose message header from HEADERFIELDS and ENVELOPE, printing to MSGOUTFILE. SENDER is the %"Sender%" field of the message, if we encountered one. NOTEBODY if non-NIL is a stream containing the text of a Note attribute. if ATTACHMENT is true, we add a line %"Attachment:%" to the message and return its file pointer in MSGOUTFILE for later insertion of an attachment object.") (LET (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 ((AND (NOT ATTACHMENT) (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)) (PROG1 (COND (ATTACHMENT (* ; "Reserve a line where the attachment will be placed.") (TERPRI MSGOUTFILE) (PRINTOUT MSGOUTFILE "Attachment: ") (PROG1 (GETFILEPTR 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)))
)
)
(* ; "Close/flush protocol")
(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)))))))
)
)
(RPAQ? NSMAILDEBUGFLG )
(RPAQ? NSMAIL.LEAVE.ATTACHMENTS )
(ADDTOVAR \NSMAIL.GOOD.BODYTYPES 2 4)
(* ; "Handling attachments as a special kind of image object")
(DEFINEQ
(\MAILOBJ.CREATE
(LAMBDA (DATA TYPE ATTR.LENGTH NAME) (* ; "Edited 6-Jul-87 15:19 by bvm:") (* ;; "Create a mail object encapsulating data (a core file in serialized file format). TYPE is the type of the serialized data.") (LET* ((PRETTY.TYPE (if (EQ TYPE (QUOTE DIRECTORY)) then "Viewpoint Folder" else (CONCAT (if (FIXP TYPE) then (CONCAT "Type " TYPE) else (L-CASE (MKSTRING TYPE) T)) (if NAME then "" else " Document")))) (IMAGE (WINDOWPROP (TITLEDICONW NIL (if NAME then (CONCAT NAME " (" PRETTY.TYPE ")") else PRETTY.TYPE) (AND NAME (LET* ((FONT DEFAULTICONFONT) (SIZE (FONTPROP FONT (QUOTE SIZE)))) (* ; "Use a smaller font if available") (AND (> SIZE 8) (CAR (NLSETQ (FONTCOPY FONT (QUOTE SIZE) (- SIZE 2))))))) (QUOTE (0 . 0)) T) (QUOTE ICONIMAGE)))) (* ; "Crude way of getting a bitmap with some text printed on it nicely") (IMAGEOBJCREATE (create MAILOBJ MAILOBJ.IMAGE ← IMAGE MAILOBJ.BOX ← (create IMAGEBOX XSIZE ← (BITMAPWIDTH IMAGE) YSIZE ← (BITMAPHEIGHT IMAGE) YDESC ← (LRSH (BITMAPHEIGHT IMAGE) 1) XKERN ← 0) MAILOBJ.TYPE ← TYPE MAILOBJ.DATA ← DATA MAILOBJ.ATTR.LENGTH ← ATTR.LENGTH MAILOBJ.NAME ← NAME) \MAILOBJ.IMAGEFNS)))
)
(\MAILOBJ.DISPLAY
(LAMBDA (OBJ STREAM) (* ; "Edited 29-Jun-87 17:34 by bvm:") (LET ((IMAGE (fetch MAILOBJ.IMAGE of (fetch OBJECTDATUM of OBJ)))) (* ; "Display the image, centered on the baseline") (BITBLT IMAGE NIL NIL STREAM (DSPXPOSITION NIL STREAM) (- (DSPYPOSITION NIL STREAM) (LRSH (BITMAPHEIGHT IMAGE) 1)))))
)
(\MAILOBJ.GET
(LAMBDA (STREAM TEXTSTREAM) (* ; "Edited 6-Jul-87 15:05 by bvm:") (DESTRUCTURING-BIND (LEN TYPE ATTR.LEN NAME) (READ STREAM FILERDTBL) (LET ((DATASTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (COPYBYTES STREAM DATASTREAM LEN) (\MAILOBJ.CREATE DATASTREAM TYPE ATTR.LEN NAME))))
)
(\MAILOBJ.IMAGEBOX
(LAMBDA (OBJ) (* ; "Edited 29-Jun-87 16:57 by bvm:") (fetch MAILOBJ.BOX of (fetch OBJECTDATUM of OBJ)))
)
(\MAILOBJ.PUT
(LAMBDA (OBJ STREAM) (* ; "Edited 6-Jul-87 15:06 by bvm:") (LET* ((MAILOBJ (fetch OBJECTDATUM of OBJ)) (COREFILE (fetch MAILOBJ.DATA of MAILOBJ)) (END (GETEOFPTR COREFILE))) (LET ((*PRINT-BASE* 10) (*READTABLE FILERDTBL) (NAME (fetch MAILOBJ.NAME of MAILOBJ))) (* ; "Make sure we can read it back.") (PRIN4 (LIST* END (fetch MAILOBJ.TYPE of MAILOBJ) (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ) (AND NAME (LIST NAME))) STREAM)) (COPYBYTES COREFILE STREAM 0 END)))
)
(\MAILOBJ.INIT
(LAMBDA NIL (* ; "Edited 29-Jun-87 16:36 by bvm:") (SETQ \MAILOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION \MAILOBJ.DISPLAY) (FUNCTION \MAILOBJ.IMAGEBOX) (FUNCTION \MAILOBJ.PUT) (FUNCTION \MAILOBJ.GET) (FUNCTION CL:IDENTITY) (FUNCTION \MAILOBJ.BUTTONEVENTFN))))
)
)
(DEFINEQ
(\MAILOBJ.BUTTONEVENTFN
(LAMBDA (OBJ WINDOWSTREAM SELECTION RELX RELY WINDOW TEXTSTREAM BUTTON) (* ; "Edited 3-Jul-87 17:51 by bvm:") (if (IMAGEOBJPROP OBJ (QUOTE BUSY)) then (* ; "Busy") (PRINTOUT PROMPTWINDOW T "Attachment is busy") else (LET ((CMD (MENU (create MENU ITEMS ← (BQUOTE (("View as text" (QUOTE \MAILOBJ.VIEW) "View the attachment as raw text, using TEdit") ("Put to file" (QUOTE \MAILOBJ.PUT.FILE) "Store the attachment in a file. This operation loses information unless the file is on an NS File Server.") (\,@ (SELECTQ (fetch MAILOBJ.TYPE of (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (INTERPRESS (QUOTE (("Send to Printer" (QUOTE \MAILOBJ.HARDCOPY) "Send the document to the printer of your choice.")))) (DIRECTORY (QUOTE (("Expand folder" (QUOTE \MAILOBJ.EXPAND) "Extract the first-level subparts of the folder")))) NIL)))))))) (if (NULL CMD) then (* ; "Nothing selected; allow TEdit to select") T else (* ; "Do the command in its own process so that the window can return to its more natural state (instead of severely clipped)") (ADD.PROCESS (LIST (FUNCTION \MAILOBJ.DO.COMMAND) (KWOTE CMD) (KWOTE OBJ) (KWOTE WINDOW) (KWOTE TEXTSTREAM)) (QUOTE NAME) (QUOTE MAILOBJ) (QUOTE RESTARTABLE) (QUOTE HARDRESET) (QUOTE BEFOREEXIT) (QUOTE DON'T)) (* ; "Return DON'T so that the window doesn't pop on top to select") (QUOTE DON'T)))))
)
(\MAILOBJ.DO.COMMAND
(LAMBDA (CMD OBJ WINDOW TEXTSTREAM) (* ; "Edited 3-Jul-87 17:51 by bvm:") (RESETLST (RESETSAVE (IMAGEOBJPROP OBJ (QUOTE BUSY) T) (LIST (QUOTE IMAGEOBJPROP) OBJ (QUOTE BUSY) NIL)) (CL:FUNCALL CMD OBJ WINDOW TEXTSTREAM)))
)
(\MAILOBJ.HARDCOPY
(LAMBDA (OBJ WINDOW) (* ; "Edited 6-Jul-87 15:26 by bvm:") (* ;; "Hardcopy the attachment in MAILOBJ. WINDOW is the window in which we are viewing it (not currently used).") (LET* ((PRINTER (GetPrinterName)) (MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (DATA (fetch MAILOBJ.DATA of MAILOBJ)) ATTRIBUTES PRINTRESULTS NAME) (if (NULL PRINTER) then (* ; "abort") NIL elseif (NOT (STRPOS ":" PRINTER)) then (* ; "not ns") (PRINTOUT PROMPTWINDOW T PRINTER " is not an Interpress printer") else (SETQ PRINTER (GETNSPRINTER PRINTER)) (SETQ ATTRIBUTES (\MAILOBJ.PARSE.ATTRIBUTES DATA (CONSTANT (BQUOTE ((DOCUMENT.NAME (\,@ (CDR (ASSOC (QUOTE NAME) \NSFILING.ATTRIBUTES)))) (DOCUMENT.CREATION.DATE (\,@ (CDR (ASSOC (QUOTE CREATED.ON) \NSFILING.ATTRIBUTES))))))))) (* ; "Parse out the name and creation date, and use them for the document name/date") (SETQ PRINTRESULTS (\NSPRINT.INTERNAL PRINTER ATTRIBUTES (FUNCTION (LAMBDA (DATASTREAM) (\MAILOBJ.COPY.BODY DATA DATASTREAM (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ)) NIL)))) (PRINTOUT PROMPTWINDOW T (SETQ NAME (LISTGET ATTRIBUTES (QUOTE DOCUMENT.NAME))) " sent to " (fetch NSOBJECT of (CAR PRINTER))) (COND ((AND PRINTRESULTS NSPRINT.WATCHERFLG) (* ; "Set up a 'watchdog' process to keep the guy informed of the print job's status") (ADD.PROCESS (LIST (FUNCTION \NSPRINT.WATCHDOG) (KWOTE PRINTRESULTS) (KWOTE PRINTER) (KWOTE NAME)) (QUOTE NAME) (PACK* (fetch NSOBJECT of (CAR PRINTER)) " WATCHER") (QUOTE AFTEREXIT) (QUOTE DELETE)))))))
)
(\MAILOBJ.PUT.FILE
(LAMBDA (OBJ WINDOW) (* ; "Edited 1-Sep-87 13:03 by bvm:") (* ;; "Store the attachment of MAILOBJ as file of user's choosing. Prompt for file name. If it's on an NS directory, we can deserialize and thus preserve the whole thing.") (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (DATA (fetch MAILOBJ.DATA of MAILOBJ)) (PW (CREATEW (create REGION LEFT ← LASTMOUSEX BOTTOM ← LASTMOUSEY WIDTH ← (WINDOWPROP WINDOW (QUOTE WIDTH)) HEIGHT ← (HEIGHTIFWINDOW (TIMES 4 (FONTPROP DEFAULTFONT (QUOTE HEIGHT))) NIL 8)) NIL 8)) FILE DEVICE) (if (NULL (SETQ FILE (PROMPTFORWORD "Put attachment to file: " NIL NIL PW NIL (QUOTE TTY) (CHARCODE (CR))))) then (PRINTOUT PW "...aborted") elseif (NULL (SETQ DEVICE (\GETDEVICEFROMNAME FILE T))) then (PRINTOUT PW T "No such server/device") else (ALLOW.BUTTON.EVENTS) (PRINTOUT PW " ... ") (if (SETQ FILE (if (EQ (fetch OPENFILE of DEVICE) (FUNCTION \NSFILING.OPENFILE)) then (* ; "NS device. Really need better test than this.") (SETFILEPTR DATA 0) (LET ((*UPPER-CASE-FILE-NAMES* NIL)) (DECLARE (CL:SPECIAL *UPPER-CASE-FILE-NAMES*)) (* ; "Get name pretty") (\NSFILING.DESERIALIZE FILE DATA DEVICE)) else (SETQ FILE (OPENSTREAM FILE (QUOTE OUTPUT) (QUOTE NEW) (BQUOTE ((TYPE (\, (fetch MAILOBJ.TYPE of MAILOBJ))) (SEQUENTIAL T))))) (PRINTOUT PW "(some attributes will be lost) ") (\MAILOBJ.COPY.BODY DATA FILE (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ) PW) (CLOSEF FILE))) then (PRINTOUT PW T FILE " written.") else (PRINTOUT PW "failed")))))
)
(\MAILOBJ.VIEW
(LAMBDA (OBJ WINDOW) (* ; "Edited 6-Jul-87 15:13 by bvm:") (* ;; "View the text of the attachment. This is often enough to tell you whether you want to bother doing something more exciting with it.") (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (DATA (fetch MAILOBJ.DATA of MAILOBJ)) (START (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ)) (WREG (WINDOWREGION WINDOW)) PROPS W SUBJECT) (SETQ SUBJECT (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA (CONSTANT (LIST (ASSOC (QUOTE NAME) \NSFILING.ATTRIBUTES)))))) (SETQ W (CREATEW (create REGION using WREG LEFT ← (+ (fetch (REGION LEFT) of WREG) (if (> (+ (fetch (REGION LEFT) of WREG) (fetch (REGION WIDTH) of WREG) MAILOBJ.WINDOWOFFSET) SCREENWIDTH) then (- MAILOBJ.WINDOWOFFSET) else MAILOBJ.WINDOWOFFSET)) BOTTOM ← (- (fetch (REGION BOTTOM) of WREG) (if (< (- (fetch (REGION BOTTOM) of WREG) MAILOBJ.WINDOWOFFSET) 0) then (- MAILOBJ.WINDOWOFFSET) else MAILOBJ.WINDOWOFFSET))) (CONCAT "Attachment: " SUBJECT))) (* ; "Make window slightly overlapping display window") (if (NEQ (fetch MAILOBJ.TYPE of MAILOBJ) (QUOTE TEDIT)) then (* ; "TEdit's not so good on binary files, so just pull out the text.") (SETFILEPTR DATA START) (SETQ DATA (\MAILOBJ.EXTRACT.TEXT DATA)) (SETQ START NIL) (SETQ PROPS (LIST (QUOTE FONT) LAFITEDISPLAYFONT))) (OPENTEXTSTREAM DATA W START (AND START (GETEOFPTR DATA)) (APPEND PROPS (QUOTE (PROMPTWINDOW DON'T))))))
)
(\MAILOBJ.COPY.BODY
(LAMBDA (INSTREAM OUTSTREAM START PW) (* ; "Edited 6-Jul-87 12:47 by bvm:") (SETFILEPTR INSTREAM START) (\NSMAIL.READ.SERIALIZED.CONTENT INSTREAM OUTSTREAM) (if (NEQ (\WIN INSTREAM) 0) then (PRINTOUT (OR PW PROMPTWINDOW) T "Warning: Attachment had children, which were not processed.")))
)
(\MAILOBJ.EXPAND
(LAMBDA (OBJ WINDOW TEXTSTREAM) (* ; "Edited 6-Jul-87 15:14 by bvm:") (LET* ((MAILOBJ (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))) (DATA (fetch MAILOBJ.DATA of MAILOBJ)) (START (fetch MAILOBJ.ATTR.LENGTH of MAILOBJ)) (IMAGEPOS (TEDIT.FIND.OBJECT TEXTSTREAM OBJ)) CHILDREN SUBDATA SUBSTART TYPE PARSE) (SETFILEPTR DATA START) (\NSMAIL.READ.SERIALIZED.CONTENT DATA (OPENSTREAM (QUOTE {NULL}) (QUOTE OUTPUT))) (* ; "Skip over the body of the folder (should be empty, actually)") (to (\WIN DATA) do (* ; "copy each child into its own image obj") (SETQ SUBDATA (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (COURIER.WRITE SUBDATA \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL)) (SETQ SUBSTART (\MAILOBJ.COPY.CHILD DATA SUBDATA)) (* ; "Copy recursive part") (SETQ PARSE (\MAILOBJ.PARSE.ATTRIBUTES SUBDATA (CONSTANT (LIST (ASSOC (QUOTE FILE.TYPE) \NSFILING.ATTRIBUTES) (ASSOC (QUOTE NAME) \NSFILING.ATTRIBUTES))))) (SETQ TYPE (LISTGET PARSE (QUOTE FILE.TYPE))) (push CHILDREN (\MAILOBJ.CREATE SUBDATA (AND TYPE (\TYPE.FROM.FILETYPE TYPE)) SUBSTART (LISTGET PARSE (QUOTE NAME)))) (* ; "Create object, parsing the type field out of the raw data")) (add IMAGEPOS 1) (for C in CHILDREN do (* ; "Insert the objects following obj in reverse order of creation, so they come out right in the end.") (TEDIT.INSERT.OBJECT C TEXTSTREAM IMAGEPOS))))
)
(\MAILOBJ.COPY.CHILD
(LAMBDA (INSTREAM OUTSTREAM) (* ; "Edited 6-Jul-87 14:41 by bvm:") (* ;; "This is the counterpart to \nsmail.read.serialized.tree, except that it copies the data as it parses it, rather than interpreting it. Returns file pointer of the start of the main child's data section.") (* ;; "We are parsing here the recursive part of Filing.SerializedFile: SerializedTree, which consists of: Sequence of Attribute; Content; children = Sequence of SerializedTree") (LET (ATTRLENGTH SUBSTART NCHILDREN LASTSEGMENT?) (\WOUT OUTSTREAM (SETQ ATTRLENGTH (\WIN INSTREAM))) (* ; "number of attributes") (to ATTRLENGTH do (RPTQ 4 (\BOUT OUTSTREAM (\BIN INSTREAM))) (* ; "Copy attribute type (longcardinal)") (\MAILOBJ.COPY.SEQUENCE INSTREAM OUTSTREAM) (* ; "Copy attribute value (sequence unspecified)")) (SETQ SUBSTART (GETFILEPTR OUTSTREAM)) (* ;; "Now copy the body, which is StreamOfUnspecified followed by lastByteIsSignficant boolean") (do (\WOUT OUTSTREAM (SETQ LASTSEGMENT? (\WIN INSTREAM))) (* ; "1 => this is last segment") (\MAILOBJ.COPY.SEQUENCE INSTREAM OUTSTREAM) (* ; "Copy the sequence") repeatuntil (NEQ LASTSEGMENT? 0) finally (\WOUT OUTSTREAM (\WIN INSTREAM)) (* ; "Copy lastByteIsSignficant boolean")) (\WOUT OUTSTREAM (SETQ NCHILDREN (\WIN INSTREAM))) (to NCHILDREN do (\MAILOBJ.COPY.CHILD INSTREAM OUTSTREAM)) SUBSTART))
)
(\MAILOBJ.COPY.SEQUENCE
(LAMBDA (INSTREAM OUTSTREAM) (* ; "Edited 6-Jul-87 14:37 by bvm:") (* ;; "Copy a Sequence of Unspecified from in to out.") (LET ((SEQLENGTH (\WIN INSTREAM))) (\WOUT OUTSTREAM SEQLENGTH) (* ; "Representation is sequence length (word) followed by that many words") (RPTQ (UNFOLD SEQLENGTH BYTESPERWORD) (\BOUT OUTSTREAM (\BIN INSTREAM)))))
)
(\MAILOBJ.EXTRACT.TEXT
(LAMBDA (DATA) (* ; "Edited 30-Jun-87 17:56 by bvm:") (* ;; "Produce a new core file consisting of the bytes from the stream DATA, where all the runs of non-printing characters are replaced by some small number of ugly characters that won't upset tedit.") (LET ((NEWDATA (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (SETFILEINFO DATA (QUOTE ENDOFSTREAMOP) (FUNCTION NILL)) (bind CH (SKIPPING ← -1) while (SETQ CH (\BIN DATA)) do (if (OR (>= CH 127) (AND (< CH (CHARCODE SPACE)) (SELCHARQ CH ((TAB CR LF) NIL) T))) then (if (EVENP (add SKIPPING 1) 16) then (BOUT NEWDATA MAILOBJ.SKIPCHAR)) else (SETQ SKIPPING -1) (BOUT NEWDATA CH))) NEWDATA))
)
(\MAILOBJ.PARSE.ATTRIBUTES
(LAMBDA (DATA FIELDS) (* ; "Edited 6-Jul-87 15:12 by bvm:") (* ;; "Parse the SUBJECT field out of the serialized stream DATA. FIELDS is in the format of \nsfiling.attributes entries") (SETFILEPTR DATA 4) (* ; "Skip the version number (LONGCARDINAL). Next comes SEQUENCE Filing.Attribute") (to (\WIN DATA) bind (CNT ← (LENGTH FIELDS)) X TYPE do (SETQ TYPE (COURIER.READ DATA NIL (QUOTE LONGCARDINAL))) (if (find old X in FIELDS suchthat (EQ (CADR X) TYPE)) then (* ; "X = (type number interpretation)") (\WIN DATA) (push $$VAL (CAR X) (COURIER.READ DATA NIL (CADDR X))) (if (<= (SETQ CNT (SUB1 CNT)) 0) then (* ;; "Found them all") (RETURN $$VAL)) else (COURIER.SKIP.SEQUENCE DATA NIL (QUOTE UNSPECIFIED)))))
)
)
(ADDTOVAR FILING.TYPES (VIEWPOINT 4353) (XEROX860 5120))
(RPAQ? MAILOBJ.WINDOWOFFSET 16)
(RPAQ? MAILOBJ.SKIPCHAR 0)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD MAILOBJ (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH MAILOBJ.NAME)
)
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\MAILOBJ.INIT)
(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
)
(* ; "sending mail")
(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)))))
)
)
(RPAQ? \NSMAIL.SERVER.CACHE )
(RPAQ? NSMAIL.NET.HINT )
(ADDTOVAR \SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE)
(DEFINEQ
(\NSMAIL.MAKEANSWERFORM
(LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* bvm%: " 6-May-86 11:35") (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 T "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 (STRING-EQUAL (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)))
)
)
(* ; "Utility for handling mail attributes")
(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.LEAVE.ATTACHMENTS \NSMAIL.GOOD.BODYTYPES MAILOBJ.WINDOWOFFSET MAILOBJ.SKIPCHAR \MAILOBJ.IMAGEFNS)
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE) LAFITEDECLS)
(FILESLOAD (LOADCOMP) CLEARINGHOUSE)
)
(PUTPROPS NSMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8510 10740 (\NSMAIL.AUTHENTICATE 8520 . 10343) (NS.FINDMAILBOXES 10345 . 10738)) (10897
28358 (NS.POLLNEWMAIL 10907 . 11292) (NS.OPENMAILBOX 11294 . 12289) (\NSMAIL.CHECK 12291 . 16162) (
NS.NEXTMESSAGE 16164 . 16627) (\NSMAIL.READ.ENVELOPES 16629 . 17499) (NS.RETRIEVEMESSAGE 17501 . 19478
) (\NSMAIL.RETRIEVE.CONTENT 19480 . 19934) (\NSMAIL.EOF.ON.RETRIEVE 19936 . 20281) (
\NSMAIL.READ.SERIALIZED.TREE 20283 . 24302) (\NSMAIL.CHECK.SERIALIZED.VERSION 24304 . 24521) (
\NSMAIL.READ.SERIALIZED.CONTENT 24523 . 25396) (\NSMAIL.READ.STRING.AS.STREAM 25398 . 25807) (
\NSMAIL.PRINT.HEADERFIELDS 25809 . 28099) (\NSMAIL.PRINT.NAMES 28101 . 28356)) (28396 31005 (
NS.CLOSEMAILBOX 28406 . 29700) (\NSMAIL.DISCONNECT 29702 . 30378) (\NSMAIL.CHANGE.STATUS 30380 . 31003
)) (31188 33866 (\MAILOBJ.CREATE 31198 . 32346) (\MAILOBJ.DISPLAY 32348 . 32668) (\MAILOBJ.GET 32670
. 32976) (\MAILOBJ.IMAGEBOX 32978 . 33106) (\MAILOBJ.PUT 33108 . 33586) (\MAILOBJ.INIT 33588 . 33864)
) (33867 44723 (\MAILOBJ.BUTTONEVENTFN 33877 . 35229) (\MAILOBJ.DO.COMMAND 35231 . 35478) (
\MAILOBJ.HARDCOPY 35480 . 36986) (\MAILOBJ.PUT.FILE 36988 . 38493) (\MAILOBJ.VIEW 38495 . 39900) (
\MAILOBJ.COPY.BODY 39902 . 40216) (\MAILOBJ.EXPAND 40218 . 41571) (\MAILOBJ.COPY.CHILD 41573 . 42930)
(\MAILOBJ.COPY.SEQUENCE 42932 . 43300) (\MAILOBJ.EXTRACT.TEXT 43302 . 43976) (
\MAILOBJ.PARSE.ATTRIBUTES 43978 . 44721)) (45168 56589 (\NSMAIL.SEND.PARSE 45178 . 46729) (
\NSMAIL.PARSE 46731 . 46992) (\NSMAIL.PARSE1 46994 . 47562) (NS.REMOVEDUPLICATES 47564 . 47924) (
\NSMAIL.SEND 47926 . 50835) (\NSMAIL.SEND.MESSAGE.CONTENT 50837 . 53520) (
COURIER.WRITE.STREAM.UNSPECIFIED 53522 . 54666) (\NSMAIL.SEND.STREAM.AS.STRING 54668 . 55288) (
\NSMAIL.WRITE.ATTRIBUTE 55290 . 55661) (\NSMAIL.FINDSERVER 55663 . 56327) (\NSMAIL.CHECKSERVER 56329
. 56587)) (56709 59447 (\NSMAIL.MAKEANSWERFORM 56719 . 59445)) (59591 60933 (\NS.READ.ENVELOPE.ITEM
59601 . 60266) (\NS.WRITE.ENVELOPE.ITEM 60268 . 60931)))))
STOP