diff --git a/internal/library/MAILSCAVENGE b/internal/library/MAILSCAVENGE
deleted file mode 100644
index 95de1b1f..00000000
--- a/internal/library/MAILSCAVENGE
+++ /dev/null
@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Jun-90 18:25:37" {DSK}<usr>local>lde>lispcore>internal>library>MAILSCAVENGE.;2 21651  

      changes to%:  (VARS MAILSCAVENGECOMS)

      previous date%: " 7-Nov-89 19:34:02" 
{DSK}<usr>local>lde>lispcore>internal>library>MAILSCAVENGE.;1)


(* ; "
Copyright (c) 1985, 1989, 1990 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT MAILSCAVENGECOMS)

(RPAQQ MAILSCAVENGECOMS
       [(FNS LAFITE.SCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH 
             \MAILSCAVENGE.LENGTHWIDTH \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP 
             \MAILSCAVENGE.DUPLICATE? \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW 
             \MAILSCAVENGE.ASKUSER \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (*START*LENGTH 8))
               (SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
               (LOCALVARS . T))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA 
                                                                                 \MAILSCAVENGE.FORMAT
                                                                                   ])
(DEFINEQ

(LAFITE.SCAVENGE
(LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?) (* ; "Edited 18-Apr-89 18:19 by bvm") (* ;; "User entry to the scavenger.  If FORGET?, we won't add folder to the list of known folders.") (LET ((FOLDER (LAFITE.OBTAIN.FOLDER (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT) (QUOTE INPUT) T (AND FORGET? :FORGET)))) (WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER) (\MAILSCAVENGE.INTERNAL FOLDER ERRORMSGSTREAM))))
)

(\MAILSCAVENGE.INTERNAL
(LAMBDA (*FOLDER* *ERRORMSGSTREAM* GOODPTR MSGNO) (* ; "Edited  3-May-89 13:05 by bvm") (* ;; "Scavenge FOLDER, which can be a mail folder, mail file name, or open stream on a mail file.  Commentary goes to *ERRORMSGSTREAM*, which for folders defaults to its browser window.  If GOODPTR is supplied, it is a file pointer that we assert points to the *START* corresponding to msg # MSGNO, and we guarantee we will not touch anything earlier in the file.") (LET (SCRATCHSTREAM FOLDERSTRM) (CL:UNWIND-PROTECT (PROG ((*UPPER-CASE-FILE-NAMES* NIL) (*PRINT-BASE* 10) (BADCOUNT 0) (*START* "*start*
") (*EOL* (CHARCODE CR)) (COPYFN (FUNCTION COPYBYTES)) TRYPTR LFP PWINDOW XPOS DUPSCRATCH FOLDERNAME EOFPTR BODYSTART BADHEADER NOMOREP STAMPLENGTH MSGLENGTH ENDPTR FIELDWIDTH LENGTHFIXUPS TRUNCATEPTR TSTREAM SUCCESS CH) (DECLARE (CL:SPECIAL *FOLDER* *ERRORMSGSTREAM* *EOL*)) (* ; "Used by \mailscavenge.askuser") (if (TYPENAMEP *FOLDER* (QUOTE MAILFOLDER)) then (* ; "It's a mail folder, so play by the rules") (SETQ FOLDERSTRM (\LAFITE.OPEN.FOLDER *FOLDER* (QUOTE INPUT) :OK)) (SETQ PWINDOW (fetch (MAILFOLDER BROWSERPROMPTWINDOW) of *FOLDER*)) elseif (TYPENAMEP *FOLDER* (QUOTE STREAM)) then (SETQ FOLDERSTRM *FOLDER*) else (SETQ FOLDERSTRM (\LAFITE.OPENSTREAM *FOLDER* (QUOTE INPUT) (QUOTE OLD) (FUNCTION \LAFITE.EOF) NIL (QUOTE LAFITE)))) (SETQ FOLDERNAME (FULLNAME FOLDERSTRM)) (SETFILEINFO FOLDERSTRM (QUOTE BUFFERS) 30) (SETQ EOFPTR (GETEOFPTR FOLDERSTRM)) (SETFILEPTR FOLDERSTRM 0) (if PWINDOW then (LAB.PROMPTPRINT *FOLDER* " Scavenging... ") (SETQ XPOS (DSPXPOSITION NIL PWINDOW))) (if (NOT *ERRORMSGSTREAM*) then (SETQ *ERRORMSGSTREAM* (if (AND (TYPENAMEP *FOLDER* (QUOTE MAILFOLDER)) (SETQ TSTREAM (\MAILSCAVENGE.MAKEWINDOW *FOLDER*))) then (* ; "We waited til here to make the window in case printing %"Scavenging... %" up there grew the window.") (TEXTSTREAM TSTREAM) else (GETSTREAM NIL (QUOTE OUTPUT))))) (\MAILSCAVENGE.FORMAT "Scavenging ~A..." FOLDERNAME) (if GOODPTR then (* ; "Somebody has already gotten us started") (GO LP) else (SETQ GOODPTR 0) (SETQ MSGNO 1) (if (LA.READSTAMP FOLDERSTRM) then (* ; "Good start") (GO PARSEMSG) elseif (PROGN (SETFILEPTR FOLDERSTRM (SUB1 *START*LENGTH)) (AND (EQ (BIN FOLDERSTRM) (CHARCODE LF)) (FILEPOS "*start*" FOLDERSTRM 0 7))) then (* ; "LF woes") (if (\MAILSCAVENGE.ASKUSER "File was apparently written with end of line convention LF.  Convert to CR (Note: TEdit formatting may be corrupted by this action, or could already have been corrupted by copying the file into LF format)? ") then (SETQ *START* "*start*") (SETQ COPYFN (FUNCTION \MAILSCAVENGE.LFCOPYBYTES)) (SETQ *EOL* (CHARCODE LF)) (SETQ LFP T) (SETQ SCRATCHSTREAM (\MAILSCAVENGE.OPEN.SCRATCH FOLDERNAME)) (SETFILEINFO FOLDERSTRM (QUOTE EOL) (QUOTE LF))) elseif (\MAILSCAVENGE.ASKUSER (CL:FORMAT NIL "Alleged mail folder ~A doesn't begin with a Lafite header -- proceed anyway? " FOLDERNAME)) then (SETQ BODYSTART 0) (GO FINDSTART) else (RETURN NIL))) LP (* ;; "GOODPTR is believed to point at *start*") (SETFILEPTR FOLDERSTRM GOODPTR) (if (NOT (\MAILSCAVENGE.READSTAMP FOLDERSTRM)) then (* ; "This shouldn't happen") (CL:ERROR "Scavenger is confused at message ~D, byte ~D" MSGNO GOODPTR)) PARSEMSG (if PWINDOW then (* ; "Tell which message we're on") (DSPXPOSITION XPOS PWINDOW) (PRIN3 MSGNO PWINDOW)) (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) (if (NOT (AND (SETQ MSGLENGTH (LA.READCOUNT FOLDERSTRM)) (> MSGLENGTH 0))) then (* ; "Malformed header--not even the length exists.  Will need to build a new header.  Take all the stuff from BODYSTART as potential message") (SETQ BADHEADER T) (GO FINDSTART)) (SETQ BADHEADER (NOT (AND (PROGN (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) (SETQ STAMPLENGTH (LA.READCOUNT FOLDERSTRM))) (PROGN (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) (BIN FOLDERSTRM) (BIN FOLDERSTRM) (BIN FOLDERSTRM) (* ; "Read 3 status bytes") (OR (EQ (SETQ CH (BIN FOLDERSTRM)) *EOL*) (AND LFP (EQ CH (CHARCODE CR))))) (<= (- (SETQ BODYSTART (GETFILEPTR FOLDERSTRM)) GOODPTR) STAMPLENGTH)))) (* ;; "We have a plausible length.  BADHEADER true means the rest of header does not parse because (a) no header length, (b) no CR after the the 3 mark bytes, or (c) header length is too short.  Wait to see whether the length appears correct before deciding whether to rebuild the header or just smash it.") (* ; "Take all the stuff from BODYSTART as potential message") (if (OR (<= (SETQ ENDPTR (+ GOODPTR MSGLENGTH)) (GETFILEPTR FOLDERSTRM)) (> ENDPTR EOFPTR)) then (* ; "Length too short or points past eof.") (GO FINDSTART) elseif (AND (< ENDPTR EOFPTR) (PROGN (SETFILEPTR FOLDERSTRM ENDPTR) (NOT (\MAILSCAVENGE.READSTAMP FOLDERSTRM)))) then (* ; "Length doesn't point at next *start*, have to search for a boundary") (SETFILEPTR FOLDERSTRM ENDPTR) (if (AND (EQ (BIN FOLDERSTRM) 0) (to (- EOFPTR ENDPTR 1) always (EQ (BIN FOLDERSTRM) 0))) then (* ; "File is well-formed except for ending in a bunch of nulls.  This seems to happen every once in a fhile when a file server spazzes.  Throw them away.") (\MAILSCAVENGE.FORMAT "~%%Starting at byte ~D (after message #~D):~%%    File ends in ~D null bytes.  Will discard." ENDPTR MSGNO (- EOFPTR ENDPTR)) (if SCRATCHSTREAM then (* ; "Copy last message verbatim to scratch file") (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM GOODPTR ENDPTR) else (* ; "Note truncation here") (SETQ TRUNCATEPTR ENDPTR)) (add BADCOUNT 1) (GO DONE)) (GO FINDSTART) elseif BADHEADER then (* ; "Length ok, but header was malformed.  It is likely to be safe to just overwrite the header") (add BADCOUNT 1) (\MAILSCAVENGE.FORMAT "~%%Message #~D at byte ~D: length ok, but header garbled." MSGNO GOODPTR) (SETQ FIELDWIDTH (\MAILSCAVENGE.LENGTHWIDTH FOLDERSTRM GOODPTR)) (if SCRATCHSTREAM then (* ; "Have to copy") (SETQ BODYSTART (+ GOODPTR FIELDWIDTH LAFITEBASICSTAMPLENGTH)) (SETQ MSGLENGTH (- ENDPTR BODYSTART)) (GO COPYMSG) else (* ; "Remember fixup") (push LENGTHFIXUPS (LIST GOODPTR MSGLENGTH FIELDWIDTH T)) (GO NEXT)) else (* ; "Well-formed message") (if (AND (< (- BODYSTART GOODPTR) STAMPLENGTH) (EQ (PROGN (SETFILEPTR FOLDERSTRM BODYSTART) (BIN FOLDERSTRM)) (CHARCODE *))) then (* ; "May be a funny one") (LET ((INFO (CL:READ-LINE FOLDERSTRM)) ISDUP) (if (AND (STRPOS "duplicate*" INFO 1 NIL T) (FIXP (SETQ INFO (SUBATOM INFO 11)))) then (* ; "This message claims to be a duplicate of the one at INFO") (SETQ ISDUP (\MAILSCAVENGE.DUPLICATE? FOLDERSTRM INFO GOODPTR STAMPLENGTH MSGLENGTH (OR DUPSCRATCH (SETQ DUPSCRATCH (OPENSTREAM "{nodircore}" (QUOTE BOTH)))))) (\MAILSCAVENGE.FORMAT "~%%Message #~D at byte ~D is marked as a duplicate of the one at byte~D from an aborted Expunge~A." MSGNO GOODPTR INFO (if (NOT ISDUP) then "; however, the original is not there" elseif SCRATCHSTREAM then " (not copied)" else "")) (if ISDUP then (* ; "Nothing to do.") (GO NEXT) elseif SCRATCHSTREAM then (SETQ BADHEADER T) (* ; "so that message gets undeleted") (GO COPYGOOD) else (* ; "Want to rewrite the flags") (push LENGTHFIXUPS (LIST GOODPTR NIL NIL T)) (GO NEXT))))) (if SCRATCHSTREAM then (* ; "Copy verbatim to scratch file") (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM GOODPTR ENDPTR)) (GO NEXT)) FINDSTART (* ;; "At this point, we have a malformed message starting at GOODPTR.  Look for its end.  If the header is also malformed, BADHEADER is true.  BODYSTART points at what could be the start of text..") (SETQ TRYPTR BODYSTART) FINDSTARTLP (SETQ ENDPTR (FFILEPOS *START* FOLDERSTRM TRYPTR)) (if (NULL ENDPTR) then (* ; "Can't find next message.  Maybe this is the last one") (if (AND (EQ MSGNO 1) BADHEADER) then (* ; "Never saw a single *start*") (if (NULL (\MAILSCAVENGE.ASKUSER (CL:FORMAT NIL "There are no message boundaries in this file.  Do you want to turn the file into a single message of length ~D?" (- EOFPTR GOODPTR)))) then (RETURN NIL))) (SETQ ENDPTR EOFPTR) elseif (AND LFP (PROGN (* ; "Have to check that an eol follows, since we're not sure which kind.") (SETFILEPTR FOLDERSTRM (+ ENDPTR (SUB1 *START*LENGTH))) (SELCHARQ (BIN FOLDERSTRM) ((CR LF) NIL) T))) then (SETQ TRYPTR (+ ENDPTR (- *START*LENGTH 2))) (GO FINDSTARTLP)) (\MAILSCAVENGE.FORMAT "~%%Message #~D at byte ~D: length ~:[missing~%%    (~;incorrect~%%    (file says ~:*~D, ~]apparent length is ~D)" MSGNO GOODPTR MSGLENGTH (if BADHEADER then (* ; "Estimate based on standard header size.  We'll be exact later") (+ LAFITESTAMPLENGTH (SETQ MSGLENGTH (- ENDPTR BODYSTART))) else (SETQ MSGLENGTH (- ENDPTR GOODPTR)))) (add BADCOUNT 1) (if BADHEADER then (\MAILSCAVENGE.FORMAT "~%%    Need to rebuild internal header.  Message body may be malformed.") (GO COPYMSG)) (* ; "Header ok, just the length was wrong") (if (NULL SCRATCHSTREAM) then (* ; "Should suffice just to change length in place") (if (<= (NCHARS MSGLENGTH) (SETQ FIELDWIDTH (\MAILSCAVENGE.LENGTHWIDTH FOLDERSTRM GOODPTR))) then (* ; "Good, the correct length fits in the available space.  Save for confirmation later") (push LENGTHFIXUPS (LIST GOODPTR MSGLENGTH FIELDWIDTH)) (GO NEXT)) (* ;; "Arrrgh, the length is too big.  Fall thru to copy message to scratch file.") (\MAILSCAVENGE.FORMAT "~%%New length does not fit into old header, will have to rebuild.")) COPYGOOD (* ;; "Bring MSGLENGTH down to just the body length so we compute the new header correctly") (SETQ MSGLENGTH (- MSGLENGTH STAMPLENGTH)) COPYMSG (* ;; "At this point, we want to write the current message on scratch file.  MSGLENGTH is the length of the body, sans header, starting at BODYSTART.  If BADHEADER is true, we rebuild whole header.  Otherwise, message is believed well-formed, so we can copy flag bytes from old message.") (if (NULL SCRATCHSTREAM) then (* ; "Have to set up scratch file") (\MAILSCAVENGE.FORMAT "~%%Opening scratch file to handle rebuilt header.") (SETQ SCRATCHSTREAM (\MAILSCAVENGE.OPEN.SCRATCH FOLDERNAME)) (if (> GOODPTR 0) then (\MAILSCAVENGE.FORMAT "~%%Copying ~D previous message~:P to scratch file..." (SUB1 MSGNO)) (COPYBYTES FOLDERSTRM SCRATCHSTREAM 0 GOODPTR) (\MAILSCAVENGE.FORMAT "done."))) (LA.PRINTHEADER SCRATCHSTREAM MSGLENGTH) (if BADHEADER then (* ; "Have to create afresh, so use primordial flags") (PRIN3 "UU 
" SCRATCHSTREAM) else (* ; "Original header was ok, except for length info, so copy flags and mark byte from it.") (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM (- BODYSTART 4) BODYSTART) (SETQ BODYSTART (+ GOODPTR STAMPLENGTH))) (CL:FUNCALL COPYFN FOLDERSTRM SCRATCHSTREAM BODYSTART ENDPTR) NEXT (COND ((< (SETQ GOODPTR ENDPTR) EOFPTR) (* ; "Go process some more") (add MSGNO 1) (GO LP))) DONE (* ;; "All finished--shall we confirm it?") (if SCRATCHSTREAM then (* ; "Close this now (could be slow) before saying done.") (SETQ SCRATCHSTREAM (CLOSEF SCRATCHSTREAM))) (if PWINDOW then (DSPXPOSITION XPOS PWINDOW) (PRIN1 "done. " PWINDOW)) (SETQ SUCCESS (if SCRATCHSTREAM then (* ; "We had to use a scratch file.") (if LENGTHFIXUPS then (* ; "Had some length fixups before we got to a really bad spot, so go back and do them now") (SETQ SCRATCHSTREAM (OPENSTREAM SCRATCHSTREAM (QUOTE BOTH) (QUOTE OLD) (QUOTE ((TYPE LAFITE))))) (CL:UNWIND-PROTECT (\MAILSCAVENGE.FIX.LENGTHS LENGTHFIXUPS SCRATCHSTREAM) (SETQ SCRATCHSTREAM (CLOSEF SCRATCHSTREAM)))) (if (AND (\MAILSCAVENGE.CONFIRM BADCOUNT MSGNO "Replace damaged mail file with scavenged file? ") (PROGN (if *FOLDER* then (\LAFITE.CLOSE.FOLDER *FOLDER* T) else (CLOSEF FOLDERSTRM)) (CL:MULTIPLE-VALUE-BIND (RESULT CONDITION) (\LAFITE.RENAMEFILE SCRATCHSTREAM FOLDERNAME) (if RESULT then T else (\MAILSCAVENGE.FORMAT "~%%RenameFile failed~@[ because ~A~]." CONDITION) NIL)))) then T else (* ; "File not renamed, either because of error or user choice.  Tell where the scavenged file is.") (\MAILSCAVENGE.FORMAT "~%%Scavenged file stored as ~A." SCRATCHSTREAM MSGNO) NIL) elseif (AND (NULL LENGTHFIXUPS) (NULL TRUNCATEPTR)) then (\MAILSCAVENGE.FORMAT "~%%~A is a well-formed message file of ~D messages." FOLDERNAME MSGNO) NIL elseif (\MAILSCAVENGE.CONFIRM BADCOUNT MSGNO "Shall I correct these messages in the file? ") then (* ; "Do fixups in place") (if *FOLDER* then (SETQ FOLDERSTRM (\LAFITE.OPEN.FOLDER *FOLDER* (QUOTE BOTH))) elseif (NOT (OPENP FOLDERSTRM (QUOTE OUTPUT))) then (SETQ FOLDERSTRM (OPENSTREAM (CLOSEF FOLDERSTRM) (QUOTE BOTH) NIL (QUOTE ((TYPE LAFITE)))))) (\MAILSCAVENGE.FIX.LENGTHS LENGTHFIXUPS FOLDERSTRM) (if TRUNCATEPTR then (* ; "Truncate file to drop nulls off end") (SETFILEINFO FOLDERSTRM (QUOTE LENGTH) TRUNCATEPTR)) (* ; "Return success") T)) (if SUCCESS then (\MAILSCAVENGE.FORMAT "done.~2%%You may want to examine the messages listed above for duplications or concatenated messages.~%%")) (if TSTREAM then (DETACHWINDOW TSTREAM) (\MAILSCAVENGE.FORMAT "
(This report window is now detached from its browser.
 You may close it at your convenience.)")) (RETURN (AND SUCCESS FOLDERNAME))) (* ;; "Cleanup time") (if (type? MAILFOLDER *FOLDER*) then (\LAFITE.CLOSE.FOLDER *FOLDER* T) elseif (AND (STREAMP FOLDERSTRM) (OPENP FOLDERSTRM)) then (CLOSEF FOLDERSTRM)) (if (STREAMP SCRATCHSTREAM) then (* ; "Must have aborted.") (DELFILE (CLOSEF SCRATCHSTREAM))))))
)

(\MAILSCAVENGE.OPEN.SCRATCH
(LAMBDA (FOLDERNAME) (* ; "Edited  3-May-89 13:03 by bvm") (OPENSTREAM (PACKFILENAME.STRING (QUOTE VERSION) NIL (QUOTE EXTENSION) (CONCAT (UNPACKFILENAME.STRING FOLDERNAME (QUOTE EXTENSION)) "-scavenged") (QUOTE BODY) FOLDERNAME) (QUOTE OUTPUT) (QUOTE NEW) (QUOTE ((TYPE LAFITE) (SEQUENTIAL T)))))
)

(\MAILSCAVENGE.LENGTHWIDTH
(LAMBDA (FOLDERSTRM STARTPTR) (* ; "Edited  3-May-89 12:42 by bvm") (* ;; "Return the actual width of the %"message length%" field in this message") (LET ((LENSTART (+ STARTPTR *START*LENGTH))) (SETFILEPTR FOLDERSTRM LENSTART) (LA.READCOUNT FOLDERSTRM T) (- (GETFILEPTR FOLDERSTRM) LENSTART 1)))
)

(\MAILSCAVENGE.LFCOPYBYTES
(LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited  3-May-89 13:07 by bvm") (* ;; "A COPYBYTES that turns LF into CR as it goes.") (SETFILEPTR SRCFIL START) (to (- END START) bind CH do (\BOUT DSTFIL (if (EQ (SETQ CH (BIN SRCFIL)) (CHARCODE LF)) then (CHARCODE CR) else CH))))
)

(\MAILSCAVENGE.READSTAMP
(LAMBDA (STREAM) (* ; "Edited  3-May-89 12:20 by bvm") (* ;; "Like LA.READSTAMP, but also succeeds if the stamp ends in LF when we're processing a LF file.") (AND (EQ (BIN STREAM) (CHARCODE *)) (EQ (BIN STREAM) (CHARCODE s)) (EQ (BIN STREAM) (CHARCODE t)) (EQ (BIN STREAM) (CHARCODE a)) (EQ (BIN STREAM) (CHARCODE r)) (EQ (BIN STREAM) (CHARCODE t)) (EQ (BIN STREAM) (CHARCODE *)) (SELCHARQ (BIN STREAM) (CR T) (LF (EQ *EOL* (CHARCODE LF))) NIL)))
)

(\MAILSCAVENGE.DUPLICATE?
(LAMBDA (FOLDERSTRM OLDPTR GOODPTR STAMPLENGTH MSGLENGTH SCRATCH) (* ; "Edited  2-May-89 12:06 by bvm") (* ;; "True if the message at pointer OLDPTR is a duplicate of the one starting at GOODPTR with lengths STAMPLENGTH & MSGLENGTH.") (SETFILEPTR FOLDERSTRM OLDPTR) (LET (OLDLENGTH OLDSTAMP) (AND (LA.READSTAMP FOLDERSTRM) (SETQ OLDLENGTH (LA.READCOUNT FOLDERSTRM)) (SETQ OLDSTAMP (LA.READCOUNT FOLDERSTRM)) (\LAFITE.CHECK.DUPLICATE FOLDERSTRM SCRATCH GOODPTR STAMPLENGTH MSGLENGTH OLDPTR OLDSTAMP OLDLENGTH))))
)

(\MAILSCAVENGE.FORMAT
(CL:LAMBDA (&REST ARGS) (* ; "Edited 21-Apr-89 15:25 by bvm") (if (TEXTSTREAMP *ERRORMSGSTREAM*) then (* ;; "It is MUCH faster to cons the string and hand it to tedit than to print a character at a time.  One difference: unless we set the %"dontscroll%" flag, the window will scroll when we run off the bottom.  This is probably desirable, as it means we look like we're doing something.") (TEDIT.INSERT *ERRORMSGSTREAM* (CL:APPLY (FUNCTION CL:FORMAT) NIL ARGS) (ADD1 (GETEOFPTR *ERRORMSGSTREAM*))) else (CL:APPLY (FUNCTION CL:FORMAT) *ERRORMSGSTREAM* ARGS)))
)

(\MAILSCAVENGE.MAKEWINDOW
(LAMBDA (FOLDER) (* ; "Edited 21-Apr-89 15:34 by bvm") (* ;; "Return a tedit window to use for Scavenger report, or NIL if FOLDER doesn't have a browser") (LET ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (if BROWSERWINDOW then (LET* ((FONT (DSPFONT NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (ERRHEIGHT (HEIGHTIFWINDOW (TIMES 10 (FONTPROP FONT (QUOTE HEIGHT))) T)) (ERRW (CREATEW (CREATEREGION 0 0 10 ERRHEIGHT) (CONCAT "Mail Scavenger Report for " (fetch (MAILFOLDER SHORTFOLDERNAME) of FOLDER)) T))) (ATTACHWINDOW ERRW BROWSERWINDOW (if (< (fetch (REGION BOTTOM) of (WINDOWPROP BROWSERWINDOW (QUOTE REGION))) ERRHEIGHT) then (* ; "Won't fit below") (QUOTE TOP) else (QUOTE BOTTOM)) (QUOTE JUSTIFY) (QUOTE LOCALCLOSE)) (OPENTEXTSTREAM "" ERRW NIL NIL (BQUOTE (FONT (\, FONT) PROMPTWINDOW DON'T))) ERRW))))
)

(\MAILSCAVENGE.ASKUSER
(LAMBDA (PROMPT) (DECLARE (CL:SPECIAL *FOLDER*)) (* ; "Edited  2-May-89 11:42 by bvm") (LET (BROWSERWINDOW) (if (AND *FOLDER* (SETQ BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of *FOLDER*))) then (* ; "Use the browser for interaction") (CLEARW BROWSERWINDOW) (FLASHWINDOW BROWSERWINDOW) (if (> (STRINGWIDTH PROMPT BROWSERWINDOW) (WINDOWPROP BROWSERWINDOW (QUOTE WIDTH))) then (* ; "Sigh, too wide to centerprint.  I wish we had better text layout...") (RELMOVETO 0 (- (IQUOTIENT (WINDOWPROP BROWSERWINDOW (QUOTE HEIGHT)) 2)) BROWSERWINDOW) (PRIN3 PROMPT BROWSERWINDOW) else (* ; "Nicely center the prompt") (CENTERPRINTINREGION PROMPT NIL BROWSERWINDOW)) (LET* ((MENUW (fetch (MAILFOLDER BROWSERMENUWINDOW) of *FOLDER*)) (MENUWREG (WINDOWPROP MENUW (QUOTE REGION))) (MENUWIDTH (fetch (REGION WIDTH) of MENUWREG)) (ITEMS (QUOTE (("Proceed" T "Continue the scavenge as asked") ("Abort" NIL "Abort the mail scavenge operation")))) (MENU (create MENU ITEMS _ ITEMS CENTERFLG _ T MENUFONT _ LAFITEMENUFONT MENUROWS _ 1 ITEMWIDTH _ (MAX (STRINGWIDTH (CAAR ITEMS) LAFITEMENUFONT) (IQUOTIENT MENUWIDTH 4)) MENUOUTLINESIZE _ 0 MENUBORDERSIZE _ 0))) (* ; "Position the menu in the middle of the browser's menu window") (PROG1 (MENU MENU (LA.POSITION.FROM.REGION MENUWREG (IQUOTIENT (- MENUWIDTH (fetch (MENU IMAGEWIDTH) of MENU)) 2) (WINDOWPROP MENUW (QUOTE BORDER))) T) (CLEARW BROWSERWINDOW))) else (EQ (ASKUSER NIL NIL PROMPT) (QUOTE Y)))))
)

(\MAILSCAVENGE.FIX.LENGTHS
(LAMBDA (FIXUPS STREAM) (* ; "Edited  3-May-89 12:42 by bvm") (* ;; "Perform length fixups.  FIXUPS has entries of the form (startptr length fieldwidth fixheader)") (for ENTRY in FIXUPS do (DESTRUCTURING-BIND (START LENGTH FIELDWIDTH FIXHEADER) ENTRY (SETFILEPTR STREAM (+ START *START*LENGTH)) (if LENGTH then (LA.PRINTCOUNT LENGTH STREAM (BQUOTE (FIX (\, FIELDWIDTH) 10 T))) else (LA.READCOUNT STREAM)) (if FIXHEADER then (* ; "Write the rest of the header, too") (if LENGTH then (LA.PRINTCOUNT (+ FIELDWIDTH LAFITEBASICSTAMPLENGTH) STREAM) else (LA.READCOUNT STREAM)) (PRIN3 "UU 
" STREAM))))))

(\MAILSCAVENGE.CONFIRM
(LAMBDA (BADNO TOTALNO PROMPT) (* ; "Edited 21-Apr-89 15:27 by bvm") (DECLARE (CL:SPECIAL *FOLDER* *ERRORMSGSTREAM*)) (* ;; "Called at end of scavenge to report results.  Return T/NIL response to PROMPT") (LET ((FORMATSTRING "~2%%Finished, found ~D bad messages out of ~D total messages.~%%")) (\MAILSCAVENGE.FORMAT FORMATSTRING BADNO TOTALNO) (if (\MAILSCAVENGE.ASKUSER PROMPT) then (if *FOLDER* then (* ; "Make sure to delete any toc that might be hanging around") (DELFILE (TOCFILENAME (fetch (MAILFOLDER FULLFOLDERNAME) of *FOLDER*)))) (\MAILSCAVENGE.FORMAT "Working... ") (* ; "Show some response") T)))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE 

(RPAQQ *START*LENGTH 8)


(CONSTANTS (*START*LENGTH 8))
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA \MAILSCAVENGE.FORMAT)
)
(PUTPROPS MAILSCAVENGE COPYRIGHT ("Venue & Xerox Corporation" 1985 1989 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1429 21135 (LAFITE.SCAVENGE 1439 . 1871) (\MAILSCAVENGE.INTERNAL 1873 . 14946) (
\MAILSCAVENGE.OPEN.SCRATCH 14948 . 15279) (\MAILSCAVENGE.LENGTHWIDTH 15281 . 15609) (
\MAILSCAVENGE.LFCOPYBYTES 15611 . 15916) (\MAILSCAVENGE.READSTAMP 15918 . 16395) (
\MAILSCAVENGE.DUPLICATE? 16397 . 16940) (\MAILSCAVENGE.FORMAT 16942 . 17529) (\MAILSCAVENGE.MAKEWINDOW
 17531 . 18396) (\MAILSCAVENGE.ASKUSER 18398 . 19864) (\MAILSCAVENGE.FIX.LENGTHS 19866 . 20494) (
\MAILSCAVENGE.CONFIRM 20496 . 21133)))))
STOP
\ No newline at end of file
diff --git a/internal/library/MAILSCAVENGE.LCOM b/internal/library/MAILSCAVENGE.LCOM
deleted file mode 100644
index 63d9b485..00000000
Binary files a/internal/library/MAILSCAVENGE.LCOM and /dev/null differ
diff --git a/internal/library/NEWNSMAIL b/internal/library/NEWNSMAIL
deleted file mode 100644
index d299c587..00000000
--- a/internal/library/NEWNSMAIL
+++ /dev/null
@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "26-Sep-90 11:35:28" "{tigger/n}<tigger>lafite>sources>NEWNSMAIL;42" 86998  

      changes to%:  (VARS NEWNSMAILCOMS *NSMAIL-RETURN-CONTENTS* *NSMAIL-ALLOW-DL-RECIPIENTS* \NSMAIL.HEADING.ATTRIBUTES)
 (FNS \NSMAIL.NEW.PRINT.HEADING NULL.NSNAME \NSMAIL.READ.BODY.PARTS \NSMAIL.BUILD.HEADING \NSMAIL.GDATE \NSMAIL.EMIT.ANNOTATION \NSMAIL.NEW.CHECKSERVER \NSMAIL.HANDLE.DELIVERY.REPORT \NSMAIL.NEW.SEND \NSMAIL.NEW.FINDSERVER \NSMAIL.COPY.NSTEXTFILE \NSMAIL.EMIT.FORWARDING \NSMAIL.SKIP.LINES LA.TRIM.WHITESPACE \NSMAIL.TRANSLATE.IP.MESSAGEID \NSMAIL.MAYBE.QUOTE)
 (COURIERPROGRAMS NEW.MAILTRANSPORT)

      previous date%: " 4-Apr-90 17:42:21" "{tigger/n}<tigger>lafite>sources>NEWNSMAIL;20")


(* "
Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT NEWNSMAILCOMS)

(RPAQQ NEWNSMAILCOMS ((COURIERPROGRAMS NEW.MAILTRANSPORT NEW.INBASKET) (COMS (* ; "Courier type EnvelopeItem") (FNS \NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM) (VARS \NSMAIL.NEW.ENVELOPE.ITEM.TYPES) (PROP COURIERDEF NEW.ENVELOPE.ITEM)) (COMS (* ; "Courier type HeadingAttribute") (FNS \NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE) (VARS \NSMAIL.HEADING.ATTRIBUTES) (PROP COURIERDEF HEADING.ATTRIBUTE)) (COMS (* ; "Courier type RName") (FNS \NSMAIL.READ.RNAME \NSMAIL.WRITE.RNAME \NSMAIL.RNAME.LENGTH) (PROP COURIERDEF NEW.RNAME) (FNS RNAME.TO.STRING X400.NAME.TO.STRING EQUAL.RNAMES)) (COMS (* ; "Posting") (FNS \NSMAIL.NEW.SEND.PARSE \NSMAIL.CHECK.ENUMERATION \NSMAIL.NEW.SEND \NSMAIL.NEW.INVALID.RECIPIENTS \NSMAIL.BUILD.HEADING \NSMAIL.POST.BODY.PART \NSMAIL.NEW.PREPARE.ATTACHMENT \NSMAIL.CHECK.ABORT \NSMAIL.NEW.FINDSERVER \NSMAIL.NEW.CHECKSERVER) (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND (CCODEP (QUOTE \NSMAIL.NEW.SEND.PARSE)) (MOVD (QUOTE \NSMAIL.NEW.SEND.PARSE) (QUOTE \NSMAIL.SEND.PARSE) NIL T)))) (INITVARS (*USE-NEW-NSMAIL* T) (*NEWNSMAIL-POST-AS-TEXTFILE* :TEST) (*NEWNSMAIL-REPORT-TYPE* (QUOTE NON.DELIVERY.ONLY)) (*NSMAIL-ALLOW-DL-RECIPIENTS* T) (*NSMAIL-RETURN-CONTENTS* T) (*NSMAIL-MIN-WILLINGNESS* 9) (*NSMAIL-TRACE-SERVERS*) (*NSMAIL-GENERATE-MESSAGE-ID*) (*NSMAIL-DISPLAY-TRANSPORT-ID*) (*NSMAIL-DISPLAY-POSTMARK*) (*NSMAIL-DISPLAY-ERRORS-TO*) (*NSMAIL-CACHE-TIMEOUT* (TIMES 1000 60 60)) (\NSMAIL.MIN.VP.TYPE 4300) (\NSMAIL.MAX.VP.TYPE 5200) (\NSMAIL.NEW.SERVER.CACHE)) (GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *USE-NEW-NSMAIL* *NEWNSMAIL-POST-AS-TEXTFILE* *NEWNSMAIL-REPORT-TYPE* *NSMAIL-ALLOW-DL-RECIPIENTS* *NSMAIL-RETURN-CONTENTS* *NSMAIL-MIN-WILLINGNESS* *NSMAIL-TRACE-SERVERS* *NSMAIL-GENERATE-MESSAGE-ID* *NSMAIL-DISPLAY-TRANSPORT-ID* *NSMAIL-DISPLAY-POSTMARK* *NSMAIL-DISPLAY-ERRORS-TO* *NSMAIL-CACHE-TIMEOUT*))))) (COMS (* ; "Retrieving") (FNS \NSMAIL.NEW.AUTHENTICATE NEWNS.POLLNEWMAIL NEWNS.OPENMAILBOX \NSMAIL.NEW.CHECK NEWNS.NEXTMESSAGE NEWNS.RETRIEVEMESSAGE \NSMAIL.READ.BODY.PARTS \NSMAIL.COPY.IA5 \NSMAIL.COPY.NSTEXTFILE \NSMAIL.READ.HEADING \NSMAIL.PARSE.ANNOTATION \NSMAIL.EMIT.ANNOTATION LA.TRIM.WHITESPACE \NSMAIL.READ.FORWARDING \NSMAIL.NEW.PRINT.HEADING \NSMAIL.NEW.PRINT.NAMES \NSMAIL.EMIT.FORWARDING \NSMAIL.GDATE \NSMAIL.TRANSLATE.IP.MESSAGEID \NSMAIL.MAYBE.QUOTE NULL.NSNAME \NSMAIL.HANDLE.DELIVERY.REPORT \NSMAIL.RECIPIENT.NAME NEW.INBASKET.CALL NEWNS.CLOSEMAILBOX \NSMAIL.NEW.LOGOFF) (VARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS) (GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS) (ALISTS (LAFITEMODELST NS)) (P (LAFITEMODE (LAFITEMODE)) (COND ((AND *USE-NEW-NSMAIL* \LAFITE.ACTIVE) (* ; "recache") (LAFITECLEARCACHE))))) (COMS (* ; "Old ns mail") (FNS \NS.READ.ENVELOPE.ITEM \NS.WRITE.ENVELOPE.ITEM) (VARS \NSMAIL.ENVELOPE.ITEM.TYPES)) (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T) (RECORDS FORWARD) (MACROS \COMPUTED.FORM \NSMAIL.BODY.PART.TYPE) (GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES) (FILES (SOURCE) LAFITEDECLS) (FILES (LOADCOMP) NSMAIL) (CONSTANTS * \NSMAIL.CONTENTS.TYPES) (* ; "This one we need at run time also") DOCOPY (VARS \NSMAIL.BODY.PART.TYPES)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA NEW.INBASKET.CALL)))))

(COURIERPROGRAM NEW.MAILTRANSPORT (17 5)
    TYPES
      ((CREDENTIALS (AUTHENTICATION . CREDENTIALS)) (VERIFIER (AUTHENTICATION . VERIFIER)) (SESSION (RECORD (TOKEN (ARRAY 2 UNSPECIFIED)) (VERIFIER VERIFIER))) (ENVELOPE.ITEM.TYPE LONGCARDINAL) (ENVELOPE (SEQUENCE NEW.ENVELOPE.ITEM)) (INVALID.NAME (RECORD (ID CARDINAL) (REASON INVALID.REASON))) (INVALID.NAME.LIST (SEQUENCE INVALID.NAME)) (INVALID.REASON (ENUMERATION (NoSuchRecipient 0) (NoMailboxForRecipient 1) (IllegalName 2) (NoDlsAllowed 3) (ReportNotAllowed 4))) (NAME NSNAME) (RNAME NEW.RNAME (* ; "(choice (xns 0 name) (gateway 1 gateway.name))")) (RNAME.LIST (SEQUENCE RNAME)) (GATEWAY.NAME (RECORD (COUNTRY STRING) (ADMIN.DOMAIN STRING) (PRIVATE.DOMAIN STRING) (ORGANIZATION STRING) (ORGANIZATIONAL.UNITS (SEQUENCE STRING)) (PERSONAL (CHOICE (WHOLE 0 STRING) (BROKEN 1 BROKEN.NAME))) (GATEWAY.SPECIFIC.INFORMATION (SEQUENCE X400.ATTRIBUTE)))) (BROKEN.NAME (RECORD (GIVEN STRING) (INITIALS STRING) (FAMILY STRING) (GENERATION STRING))) (X400.ATTRIBUTE (RECORD (TYPE STRING) (VALUE STRING))) (REPORT.TYPE (ENUMERATION (NONE 0) (NON.DELIVERY.ONLY 1) (ALL 2))) (RECIPIENT (RECORD (NAME RNAME) (RECIPIENT.ID CARDINAL) (REPORT REPORT.TYPE))) (RECIPIENT.LIST (SEQUENCE RECIPIENT)) (WILLINGNESS (SEQUENCE WILLINGNESS.METRIC)) (WILLINGNESS.METRIC CARDINAL) (BODY.PART.TYPE LONGCARDINAL) (CONTENTS.TYPE LONGCARDINAL) (MESSAGEID (ARRAY 5 UNSPECIFIED)) (POSTING.DATA (RECORD (RECIPIENTS RECIPIENT.LIST) (CONTENTS.TYPE CONTENTS.TYPE) (CONTENTS.SIZE LONGCARDINAL) (BODY.PART.TYPES.SEQUENCE (SEQUENCE BODY.PART.TYPE)))) (POSTMARK (RECORD (POSTED.AT RNAME) (TIME TIME))) (TOC (SEQUENCE TOC.ITEM)) (TOC.ITEM (RECORD (TYPE BODY.PART.TYPE) (SIZE LONGCARDINAL))) (REPORT (RECORD (ORIGINAL.ENVELOPE ENVELOPE) (FATE (CHOICE (DELIVERED 0 (ENUMERATION (CONTENTS.TRUNCATED 0) (NO.PROBLEM 1))) (NOT.DELIVERED 1 (RECORD (REASON NON.DELIVERY.REASON) (POSTMARK POSTMARK))))) (REPORT.TYPE (CHOICE (DLMEMBER 0 DLREPORT) (OTHER 1 OTHER.REPORT))))) (DLREPORT (RECORD (DLNAME RNAME) (INVALID.RECIPIENTS (SEQUENCE NON.DELIVERED.RECIPIENT)))) (OTHER.REPORT (RECORD (SUCCEEDED (SEQUENCE DELIVERED.RECIPIENT)) (FAILED (SEQUENCE NON.DELIVERED.RECIPIENT)))) (DELIVERED.RECIPIENT (RECORD (RECIPIENT RECIPIENT) (WHEN TIME))) (NON.DELIVERED.RECIPIENT (RECORD (RECIPIENT RECIPIENT) (REASON NON.DELIVERY.REASON))) (NON.DELIVERY.REASON (ENUMERATION (NoSuchRecipient 0) (NoMailboxForRecipient 1) (IllegalName 2) (Timeout 3) (ReportNotAllowed 4) (MessageTooLong 5) (AmbiguousRName 6) (IllegalCharacters 7) (UnsupportedBodyParts 8) (UnsupportedContentsType 9) (TransientProblem 10) (ContentSyntaxError 11) (TooManyRecipients 12) (ProtocolViolation 13) (X400PragmaticConstraintViolation 14) (x400NoBilateralAgreement 15) (AccessRightsInsufficientForDL 16) (Other 17))) (TRANSPORT.OPTIONS (RECORD (RETURN.OF.CONTENTS BOOLEAN) (ALTERNATE.RECIPIENT.ALLOWED BOOLEAN))) (PRIORITY (ENUMERATION (NonUrgent 0) (Normal 1) (Urgent 2))) (CONVERTED.ITEM (ENUMERATION (IA5TextToTeletex 0) (TeletexToTelex 1) (TeletexToIA5Text 2) (TelexToTeletex 3))) (IP.MESSAGEID (RECORD (ORIGINATOR RNAME) (UNIQUESTRING STRING))) (AUTHENTICATION.LEVEL (ENUMERATION (Strong 0) (Simple 1) (Foreign 2))) (FORWARDED.MESSAGE.INFO (RECORD (ENVELOPE ENVELOPE) (HEADING (SEQUENCE HEADING.ATTRIBUTE)) (ASSOCIATED.BODY.PARTS (SEQUENCE BODY.PART.INDEX)) (INDEX.OF.PARENT.HEADING (CHOICE (NULL 0 (RECORD)) (NESTED 1 CARDINAL))))) (BODY.PART.INDEX CARDINAL) (SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0) (ServiceFull 1) (ServiceUnavailable 2) (MediumFull 3))) (TRANSFER.PROBLEM (ENUMERATION (Aborted 0))) (OTHER.PROBLEM (ENUMERATION (Can'tExpedite 0) (MalformedMessage 1) (IncorrectContentsSize 2) (LAST 65535))) (SESSION.PROBLEM (ENUMERATION (InvalidHandle 0) (WrongState 1))))
    PROCEDURES
      ((SERVER.POLL 0 NIL RETURNS (WILLINGNESS (CLEARINGHOUSE . NETWORK.ADDRESS.LIST) NAME)) (BEGIN.POST 1 (POSTING.DATA BOOLEAN BOOLEAN (SEQUENCE NEW.ENVELOPE.ITEM) CREDENTIALS VERIFIER) RETURNS (SESSION INVALID.NAME.LIST) REPORTS (AUTHENTICATION.ERROR INVALID.RECIPIENTS SERVICE.ERROR OTHER.ERROR)) (MAILPOLL 7 (NAME CREDENTIALS VERIFIER) RETURNS (BOOLEAN) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR)) (POST.ONE.BODY.PART 8 (SESSION BODY.PART.TYPE BULK.DATA.SOURCE) RETURNS NIL REPORTS (AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR SESSION.ERROR TRANSFER.ERROR)) (END.POST 9 (SESSION BOOLEAN) RETURNS (MESSAGEID) REPORTS (AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR SESSION.ERROR TRANSFER.ERROR)))
    ERRORS
      ((ACCESS.ERROR 0 (ACCESS.PROBLEM)) (AUTHENTICATION.ERROR 1 ((AUTHENTICATION . PROBLEM))) (INVALID.RECIPIENTS 3 (INVALID.NAME.LIST)) (SERVICE.ERROR 4 (SERVICE.PROBLEM)) (TRANSFER.ERROR 5 (TRANSFER.PROBLEM)) (OTHER.ERROR 6 (OTHER.PROBLEM)) (SESSION.ERROR 7 (SESSION.PROBLEM)))
)

(COURIERPROGRAM NEW.INBASKET (18 2)
    INHERITS
      (NEW.MAILTRANSPORT)
    TYPES
      ((CREDENTIALS (AUTHENTICATION . CREDENTIALS)) (VERIFIER (AUTHENTICATION . VERIFIER)) (NAME NSNAME) (INDEX LONGCARDINAL) (RANGE (RECORD (LOW INDEX) (HIGH INDEX))) (MESSAGE.STATUS (RECORD (USER.DEFINED.STATUS CARDINAL) (EXISTENCE.OF.MESSAGE (ENUMERATION (NEW 0) (KNOWN 1))))) (BODY.PART.SEQUENCE (SEQUENCE BODY.PART.INDEX)) (BODY.PART.STATUS (SEQUENCE BOOLEAN)) (BODY.PART.STATUS.CHANGE (RECORD (BODY.PART.INDEX BODY.PART.INDEX) (DELETABLE (ENUMERATION (TRUE 0) (NOCHANGE 1))))) (BODY.PART.STATUS.CHANGE.SEQUENCE (SEQUENCE BODY.PART.STATUS.CHANGE)) (STATUS (RECORD (MESSAGE.STATUS MESSAGE.STATUS) (BODY.PART.STATUS BODY.PART.STATUS))) (SESSION (RECORD (TOKEN (ARRAY 2 UNSPECIFIED)) (VERIFIER VERIFIER))) (ANCHOR (ARRAY 5 UNSPECIFIED)) (STATE (RECORD (NEW CARDINAL) (TOTAL CARDINAL))) (WHICH.MESSAGE (ENUMERATION (THIS 0) (NEXT 1))) (ACCESS.PROBLEM (ENUMERATION (AccessRightsInsufficient 0) (AccessRightsIndeterminate 1) (NoSuchInbasket 2) (InbasketIndeterminate 3) (WrongService 4))) (CONNECTION.PROBLEM (FILING . CONNECTION.PROBLEM)) (SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0) (ServiceFull 1) (ServiceUnavailable 2))) (TRANSFER.PROBLEM (ENUMERATION (Aborted 0))) (SESSION.PROBLEM (ENUMERATION (TokenInvalid 0))) (OTHER.PROBLEM (ENUMERATION (USE.COURIER 0) (MalformedMessage 1) (InvalidOperation 2) (LAST 65535))) (INDEX.PROBLEM (ENUMERATION (InvalidIndex 0) (InvalidBodyPartIndex 1))))
    PROCEDURES
      ((LOGON 5 (NAME CREDENTIALS VERIFIER) RETURNS (SESSION STATE ANCHOR) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR INBASKET.IN.USE SERVICE.ERROR OTHER.ERROR)) (LOGOFF 4 (SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR SESSION.ERROR OTHER.ERROR)) (MAILPOLL 7 (NAME CREDENTIALS VERIFIER) RETURNS (STATE) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR)) (MAILCHECK 6 (SESSION) RETURNS (STATE) REPORTS (AUTHENTICATION.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (RETRIEVE.ENVELOPES 2 (INDEX WHICH.MESSAGE SESSION) RETURNS (ENVELOPE STATUS INDEX)) (RETRIEVE.BODY.PARTS 8 (INDEX BODY.PART.SEQUENCE BULK.DATA.SINK SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR INDEX.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR TRANSFER.ERROR)) (CHANGE.MESSAGE.STATUS 0 (RANGE BOOLEAN CARDINAL SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR INDEX.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (CHANGE.BODY.PARTS.STATUS 3 (INDEX BODY.PART.STATUS.CHANGE.SEQUENCE SESSION) RETURNS (BOOLEAN) REPORTS (AUTHENTICATION.ERROR INDEX.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (DELETE 1 (RANGE SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (GET.SIZE 10 (NAME CREDENTIALS VERIFIER) RETURNS (LONGCARDINAL) REPORTS (AUTHENTICATION.ERROR ACCESS.ERROR SERVICE.ERROR OTHER.ERROR)))
    ERRORS
      ((ACCESS.ERROR 0 (ACCESS.PROBLEM)) (AUTHENTICATION.ERROR 1 ((AUTHENTICATION . PROBLEM))) (SESSION.ERROR 5 (SESSION.PROBLEM)) (SERVICE.ERROR 6 (SERVICE.PROBLEM)) (TRANSFER.ERROR 7 (TRANSFER.PROBLEM)) (OTHER.ERROR 8 (OTHER.PROBLEM)) (INDEX.ERROR 9 (INDEX.PROBLEM)) (INBASKET.IN.USE 10 (NAME)))
)



(* ; "Courier type EnvelopeItem")

(DEFINEQ

(\NS.NEW.READ.ENVELOPE.ITEM
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:53 by bvm") (* ;; "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") (LET* ((TYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) (VALUETYPE (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.NEW.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CADR TRIPLE)) (SETQ TYPE (QUOTE (\, (CAR TRIPLE)))) (QUOTE (\, (CADDR TRIPLE)))))))))))) (LIST TYPE (if VALUETYPE then (\WIN STREAM) (* ; "Skip sequence count") (COURIER.READ STREAM PROGRAM VALUETYPE) else (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.NEW.WRITE.ENVELOPE.ITEM
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:53 by bvm") (* ;;; "Writes a filing attribute value pair to STREAM.  ITEM is a list of two elements (TYPE VALUE)") (LET ((TYPE (CAR ITEM)) (VALUE (CADR ITEM)) VALUETYPE) (COURIER.WRITE STREAM (OR (FIXP TYPE) (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.NEW.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CAR TRIPLE)) (SETQ VALUETYPE (QUOTE (\, (CADDR TRIPLE)))) (QUOTE (\, (CADR TRIPLE))))))) (T (ERROR "Unknown Envelope Item Type" 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.NEW.ENVELOPE.ITEM.TYPES ((Postmark 0 POSTMARK) (Message-ID 1 MESSAGEID) (ContentsType 2 CONTENTS.TYPE) (TOC 3 TOC) (CONTENTS.SIZE 4 LONGCARDINAL) (Originator 5 RNAME) (REPORT 6 REPORT) (RETURN.TO.NAME 7 RNAME) (Previous-Recipients 8 RECIPIENT.LIST) (GatewayPostmark 9 POSTMARK) (AddressChangeNotice 10 RNAME) (TRANSPORT.OPTIONS 11 TRANSPORT.OPTIONS) (X400SpecificReportInformation 12 (SEQUENCE (SEQUENCE UNSPECIFIED))) (OtherRecipients 13 RECIPIENT.LIST) (Priority 14 PRIORITY) (Converted 15 (SEQUENCE CONVERTED.ITEM)) (AuthenticationLevelOfSender 16 AUTHENTICATION.LEVEL)))

(PUTPROPS NEW.ENVELOPE.ITEM COURIERDEF (\NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM))



(* ; "Courier type HeadingAttribute")

(DEFINEQ

(\NS.READ.HEADING.ATTRIBUTE
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 25-Jan-90 16:59 by bvm") (* ;; "Reads a mail heading 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))) for X in \NSMAIL.HEADING.ATTRIBUTES when (EQ (CADR X) TYPE) do (RETURN (LIST* (CAR X) (LET* ((RANDP (RANDACCESSP STREAM)) (END (+ (UNFOLD (\WIN STREAM) BYTESPERWORD) (if RANDP then (GETFILEPTR STREAM) else 0))) HERE) (CONS (COURIER.READ STREAM (OR PROGRAM (QUOTE NEW.MAILTRANSPORT)) (CADDR X)) (if (AND RANDP (NOT (EQL (SETQ HERE (GETFILEPTR STREAM)) END))) then (if (> HERE END) then (HELP "Heading attribute overran by " (- HERE END)) else (to (- END HERE) collect (BIN STREAM)))))))) finally (* ; "TYPE not recognized") (RETURN (LIST TYPE (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.WRITE.HEADING.ATTRIBUTE
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 18:17 by bvm") (* ;;; "Writes a mail heading 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.HEADING.ATTRIBUTES when (EQ (CAR X) TYPE) do (SETQ TYPE (CADR X)) (SETQ VALUETYPE (CADDR X)) (RETURN) finally (ERROR "Unknown Heading Attribute 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.HEADING.ATTRIBUTES ((Message-ID 1 IP.MESSAGEID) (Sender 2 RNAME) (From 3 RNAME.LIST) (To 4 RNAME.LIST) (cc 5 RNAME.LIST) (bcc 6 RNAME.LIST) (In-Reply-to 7 IP.MESSAGEID) (Obsoletes 8 (SEQUENCE IP.MESSAGEID)) (References 9 (SEQUENCE IP.MESSAGEID)) (Subject 10 STRING) (Expiration-Date 11 TIME) (Reply-By 12 TIME) (Reply-to 13 RNAME.LIST) (Importance 14 (ENUMERATION (Low 0) (Normal 1) (High 2))) (Sensitivity 15 (ENUMERATION (Personal 0) (Private 1) (CompanyConfidential 2))) (Auto-Forwarded 16 BOOLEAN) (Immutable 17 (RECORD)) (Reply-Requested-of 18 RNAME.LIST) (TextAnnotation 19 STRING) (ForwardedHeadings 20 (SEQUENCE FORWARDED.MESSAGE.INFO)) (newTextAnnotation 199 STRING) (BodyOffset 198 LONGCARDINAL) (LispFormatting 4911 STRING)))

(PUTPROPS HEADING.ATTRIBUTE COURIERDEF (\NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE))



(* ; "Courier type RName")

(DEFINEQ

(\NSMAIL.READ.RNAME
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 29-Nov-89 12:53 by bvm") (* ;; "Special code to read newmailtransport.rname, whose definition is (choice (xns 0 name) (gateway 1 gateway.name)).  The xns name we return as an NSNAME object, all other types as if they had been read as the definition reads.") (LET ((CHOICE (\WIN STREAM))) (CASE CHOICE (0 (COURIER.READ.NSNAME STREAM PROGRAM (QUOTE NSNAME))) (1 (LIST (QUOTE GATEWAY) (COURIER.READ STREAM PROGRAM (QUOTE GATEWAY.NAME)))) (T (ERROR "Not a recognized type of RNAME" CHOICE)))))
)

(\NSMAIL.WRITE.RNAME
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 29-Nov-89 12:52 by bvm") (* ;; "Special code to write newmailtransport.rname.  ITEM can be an NSNAME or a list (GATEWAY gatewayname).") (if (TYPEP ITEM (QUOTE NSNAME)) then (\WOUT STREAM 0) (COURIER.WRITE.NSNAME STREAM ITEM PROGRAM (QUOTE NSNAME)) elseif (EQ (CAR (LISTP ITEM)) (QUOTE GATEWAY)) then (\WOUT STREAM 1) (COURIER.WRITE STREAM (CADR ITEM) PROGRAM (QUOTE GATEWAY.NAME)) else (ERROR "ARG not RNAME" ITEM)))
)

(\NSMAIL.RNAME.LENGTH
(LAMBDA (ITEM PROGRAM TYPE) (* ; "Edited 29-Nov-89 21:22 by bvm") (+ 1 (if (TYPEP ITEM (QUOTE NSNAME)) then (COURIER.NSNAME.LENGTH ITEM PROGRAM (QUOTE NSNAME)) elseif (EQ (CAR (LISTP ITEM)) (QUOTE GATEWAY)) then (COURIER.REP.LENGTH (CADR ITEM) PROGRAM (QUOTE GATEWAY.NAME)) else (ERROR "ARG not RNAME" ITEM))))
)
)

(PUTPROPS NEW.RNAME COURIERDEF (\NSMAIL.READ.RNAME \NSMAIL.WRITE.RNAME \NSMAIL.RNAME.LENGTH))
(DEFINEQ

(RNAME.TO.STRING
(LAMBDA (NAME FULLFLG) (* ; "Edited  4-Apr-90 17:26 by bvm") (CL:ETYPECASE NAME (NSNAME (NSNAME.TO.STRING NAME FULLFLG)) (LIST (X400.NAME.TO.STRING NAME))))
)

(X400.NAME.TO.STRING
(LAMBDA (NAME) (* ; "Edited  4-Apr-90 17:27 by bvm") (LET ((SLASH "/") TMP) (if (NEQ (CAR NAME) (QUOTE GATEWAY)) then (ERROR "ARG NOT X400 NAME" NAME) else (SETQ NAME (CADR NAME))) (CONCATLIST (BQUOTE ((\, SLASH) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) COUNTRY of NAME)) (LIST "C=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) ADMIN.DOMAIN of NAME)) (LIST "ADMD=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) PRIVATE.DOMAIN of NAME)) (LIST "PRMD=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) ORGANIZATION of NAME)) (LIST "O=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) ORGANIZATIONAL.UNITS of NAME)) (for UNIT in TMP join (LIST "OU=" UNIT SLASH)))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) PERSONAL of NAME)) (CASE (CAR TMP) (WHOLE (LIST "PN=" (CADR TMP) SLASH)) (BROKEN (LET ((BROKEN (CADR TMP))) (BQUOTE ((\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) GIVEN of BROKEN)) (LIST "G=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) INITIALS of BROKEN)) (LIST "I=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) FAMILY of BROKEN)) (LIST "S=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) GENERATION of BROKEN)) (LIST "GQ=" TMP SLASH)))))))))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) GATEWAY.SPECIFIC.INFORMATION of NAME)) (for PAIR in TMP join (LIST (CAR PAIR) "=" (CADR PAIR) SLASH)))))))))
)

(EQUAL.RNAMES
(LAMBDA (NAME1 NAME2) (* ; "Edited  4-Apr-90 17:21 by bvm") (if (type? NSNAME NAME1) then (AND (type? NSNAME NAME2) (EQUAL.CH.NAMES NAME1 NAME2)) else (EQUAL NAME1 NAME2)))
)
)



(* ; "Posting")

(DEFINEQ

(\NSMAIL.NEW.SEND.PARSE
(LAMBDA (MSG EDITORWINDOW) (* ; "Edited 24-Jan-90 16:36 by bvm") (PROG ((SENDER (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*)) RECIPIENTS MSGFIELDS FORMATTEDP HEADEREOF INTERESTINGFIELDS SUBJECT ATTACHMENT) (OR (SETQ MSGFIELDS (\LAFITE.PREPARE.SEND MSG EDITORWINDOW \LAPARSE.NSMAIL)) (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) (LET ((EXPANDED (for NAME in (CDR PAIR) join (if (CL:STRING= (fetch NSDOMAIN of NAME) ";") then (* ; "DL syntax") (\NSMAIL.EXPAND.DL (fetch NSOBJECT of NAME) SENDER EDITORWINDOW) else (LIST NAME))))) (SETQ RECIPIENTS (COND (RECIPIENTS (NS.REMOVEDUPLICATES (APPEND EXPANDED RECIPIENTS))) (T EXPANDED))))) (PROGN (* ; "Might want to check validity of From and Reply-to") NIL))) ((Subject In-Reply-to) (LET ((STR (COND ((CDDR PAIR) (* ; "Make one string") (CONCATLIST (CDR PAIR))) (T (CADR PAIR))))) (COND ((EQ (CAR PAIR) (QUOTE Subject)) (SETQ SUBJECT STR)) (*USE-NEW-NSMAIL* (* ; "format is different in new protocol") (SETQ STR (COURIER.CREATE (NEW.MAILTRANSPORT . IP.MESSAGEID) ORIGINATOR _ (create NSNAME NSOBJECT _ "" NSDOMAIN _ "" NSORGANIZATION _ "") UNIQUESTRING _ STR)))) (RPLACD PAIR STR) (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))) ((REFERENCE ATTACHMENT) (if ATTACHMENT then (\SENDMESSAGEFAIL EDITORWINDOW "Can only send a single attachment")) (SETQ ATTACHMENT T) (push INTERESTINGFIELDS PAIR)) ((Importance Sensitivity Immutable) (if (AND *USE-NEW-NSMAIL* (> (NCHARS (CADR PAIR)) 0) (SETQ PAIR (\NSMAIL.CHECK.ENUMERATION PAIR EDITORWINDOW))) then (push INTERESTINGFIELDS PAIR))) 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.CHECK.ENUMERATION
(LAMBDA (PAIR EDITORWINDOW) (* ; "Edited 24-Jan-90 16:35 by bvm") (LET* ((FIELD (CAR PAIR)) (VALUE (CADR PAIR)) (EXPECTED (CADDR (ASSOC FIELD \NSMAIL.HEADING.ATTRIBUTES))) FOUND) (if (EQ (CAR (LISTP EXPECTED)) (QUOTE ENUMERATION)) then (SETQ EXPECTED (CDR EXPECTED)) (if (SETQ FOUND (CL:ASSOC VALUE EXPECTED :TEST (QUOTE STRING-EQUAL))) then (CONS FIELD (CAR FOUND)) else (\SENDMESSAGEFAIL EDITORWINDOW (CL:FORMAT NIL "Field '~A' not understood--expected one of ~A" FIELD (CONCATLIST (CDR (for V in EXPECTED join (LIST ", " (CAR V)))))))) elseif (OR (STRING-EQUAL VALUE "True") (STRING-EQUAL VALUE "Yes") (STRING-EQUAL VALUE T)) then (* ; "Good.  Value is actually irrelevant") PAIR elseif (OR (STRING-EQUAL VALUE "False") (STRING-EQUAL VALUE "No")) then (* ; "Good, omit attribute") NIL else (\SENDMESSAGEFAIL EDITORWINDOW "Field 'Immutable' not understood--expected True or False"))))
)

(\NSMAIL.NEW.SEND
(LAMBDA (MSG PARSE EDITORWINDOW ABORTWINDOW) (* ; "Edited 29-Jun-90 16:04 by bvm") (* ;;; "MSG is the entire text of the message -- RECIPIENTS is a parsed list of recipients") (if (NOT *USE-NEW-NSMAIL*) then (\NSMAIL.SEND MSG PARSE EDITORWINDOW ABORTWINDOW) else (RESETLST (PROG* ((PWINDOW (AND EDITORWINDOW (GETPROMPTWINDOW EDITORWINDOW))) (RECIPIENTS (fetch NSPRECIPIENTS of PARSE)) (START (OR (fetch NSPSTART of PARSE) (GETEOFPTR MSG))) (MSGFIELDS (fetch NSPFIELDS of PARSE)) (CREDENTIALS (fetch (LAFITEMODEDATA CREDENTIALS) of *LAFITE-MODE-DATA*)) (ALLOW.DL.RECIPIENTS (OR *NSMAIL-ALLOW-DL-RECIPIENTS* (ASSOC (QUOTE Reply-to) MSGFIELDS))) USENSTEXTFILE FORMATSTREAM REFERENCE ATTACHMENT ATTACHMENT-TYPE ATTACHMENT-LENGTH ATTACHED-ATTRIBUTES BODYLENGTH COURIERSTREAM MAILDROP RESULTS HEADING SESSION ESTIMATED-SIZE PART-TYPES) (* ;; "Some day maybe try using the ALLOW.DL.RECIPIENTS feature.  Unfortunately, there are too many users in XNS who look like groups to the mail system for this to be very interesting.") (COND (PWINDOW (* ; "Make sure prompt window will expand as needed.  Probably generic sendmessage should do this") (RESETSAVE (TTYDISPLAYSTREAM PWINDOW)) (RESETSAVE (LINELENGTH T)))) (COND ((AND (fetch NSPFORMATTED of PARSE) (TEDIT.FORMATTEDFILEP MSG)) (* ; "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)") (CLOSEF MSG) (* ; "We're thru with this new textstream, let it clean up after itself.") (SETQ MSG (OPENSTREAM (CAR FORMATSTREAM) (QUOTE INPUT))) (SETQ FORMATSTREAM (OPENSTREAM (CDR FORMATSTREAM) (QUOTE INPUT))) (SETQ START 0)) ((AND (TEXTSTREAMP MSG) (TEDIT.FORMATTEDFILEP MSG)) (* ; "Message has formatting, but caller asked to send it as plain text.  Carefully coerce it, since TEDIT ns chars and image objects don't pass thru COPYBYTES very well") (SETQ MSG (LAFITE.MAKE.PLAIN.TEXTSTREAM MSG START)) (SETQ START 0))) (SETQ BODYLENGTH (- (GETEOFPTR MSG) START)) (if FORMATSTREAM then (* ; "Formatted messages can only go as text files for now, or else old clients can't receive them") (SETQ USENSTEXTFILE T) else (CASE *NEWNSMAIL-POST-AS-TEXTFILE* ((NIL) (* ; "Always send as note")) ((:TEST) (* ; "Send as note only if short enough (the default)") (if (> BODYLENGTH *NSMAIL-MAX-NOTE-LENGTH*) then (SETQ USENSTEXTFILE T))) (T (SETQ USENSTEXTFILE T)))) (SETQ REFERENCE (ASSOC (QUOTE REFERENCE) MSGFIELDS)) (SETQ ATTACHMENT (ASSOC (QUOTE ATTACHMENT) MSGFIELDS)) (if (OR REFERENCE ATTACHMENT) then (if ATTACHMENT then (* ; "We're going to send a whole file along with the message") (SETQ MSGFIELDS (DREMOVE ATTACHMENT MSGFIELDS)) (if (LISTP (SETQ ATTACHMENT (\NSMAIL.NEW.PREPARE.ATTACHMENT (CADR ATTACHMENT) EDITORWINDOW))) then (* ; "Not an ns file") (SETQ ATTACHMENT-TYPE (CDR (ASSOC (QUOTE BodyType) (SETQ ATTACHED-ATTRIBUTES (CDR ATTACHMENT))))) (SETQ ATTACHMENT (CAR ATTACHMENT)) (* ; "Length estimate: file length.  Actual length will be a little greater due to attributes.") (SETQ ATTACHMENT-LENGTH (GETEOFPTR ATTACHMENT)) else (* ; "NS serialized file") (SETQ ATTACHMENT-TYPE (GETFILEINFO ATTACHMENT (QUOTE FILETYPE))) (* ;; "To estimate length, ask server for stored size.  This is rounded up to nearest page, so we subtract lest we overestimate (grumble).  In directory case, it could be way off, though, due to rounding errors from lots of files.  It's either that or read the whole damn file into core.") (SETQ ATTACHMENT-LENGTH (- (GETFILEINFO ATTACHMENT (if (GETFILEINFO ATTACHMENT (QUOTE IS.DIRECTORY)) then (QUOTE SUBTREE.SIZE) else (QUOTE STORED.SIZE))) BYTESPERPAGE))) (SETQ ATTACHMENT-TYPE (CASE (\TYPE.FROM.FILETYPE ATTACHMENT-TYPE) (INTERPRESS (if NIL then (* ; "This way doesn't go thru the backward incompatibility module correctly.") (\NSMAIL.BODY.PART.TYPE INTERPRESS) else (\NSMAIL.BODY.PART.TYPE VPDOCUMENT))) (DIRECTORY (\NSMAIL.BODY.PART.TYPE VPFOLDER)) (TEXT (\NSMAIL.BODY.PART.TYPE NSTEXTFILE)) (T (if (AND (>= ATTACHMENT-TYPE \NSMAIL.MIN.VP.TYPE) (<= ATTACHMENT-TYPE \NSMAIL.MAX.VP.TYPE)) then (* ; "I assume everything in this range is a vpdocument") (\NSMAIL.BODY.PART.TYPE VPDOCUMENT) else (\NSMAIL.BODY.PART.TYPE OTHERNSFILE))))) elseif REFERENCE then (* ; "Just a Vp reference.  This is a null file with a special attribute giving the file name, etc") (SETQ MSGFIELDS (DREMOVE REFERENCE MSGFIELDS)) (SETQ ATTACHED-ATTRIBUTES (LIST (CONSTANT (CONS (QUOTE BodyType) \NSMAIL.REFERENCE.BODYTYPE)) (RPLACD REFERENCE (\NSMAIL.PARSE.REFERENCE (CADR REFERENCE) EDITORWINDOW)))) (SETQ ATTACHMENT-TYPE (\NSMAIL.BODY.PART.TYPE VPDOCUMENT))) (SETQ PART-TYPES (LIST ATTACHMENT-TYPE))) (if USENSTEXTFILE then (push PART-TYPES (\NSMAIL.BODY.PART.TYPE NSTEXTFILE)) elseif (> BODYLENGTH 0) then (push PART-TYPES (\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE))) (SETQ HEADING (\NSMAIL.BUILD.HEADING MSGFIELDS (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*))) (SETQ RECIPIENTS (for R in RECIPIENTS as I from 1 collect (COURIER.CREATE (NEW.MAILTRANSPORT . RECIPIENT) NAME _ R RECIPIENT.ID _ I REPORT _ (OR *NEWNSMAIL-REPORT-TYPE* (QUOTE NON.DELIVERY.ONLY))))) (COND (PWINDOW (CLEARW PWINDOW) (LET ((TYPE (if REFERENCE then (\TYPE.FROM.FILETYPE (CADR (ASSOC (QUOTE TYPE) (CDR REFERENCE)))) elseif ATTACHMENT-TYPE then (for PAIR in \NSMAIL.BODY.PART.TYPES when (EQL ATTACHMENT-TYPE (CADR PAIR)) do (RETURN (CAR PAIR)))))) (CL:FORMAT PWINDOW "Delivering ~:[~;formatted ~]~@[with ~A ~]~@[~A ~]to ~D recipient~:P" FORMATSTREAM (AND TYPE (CL:STRING-CAPITALIZE (MKSTRING TYPE))) (COND (REFERENCE "reference") (ATTACHMENT "attachment")) (LENGTH RECIPIENTS))))) (SETQ ESTIMATED-SIZE (PROGN (* ;; "@##!@ protocol demands that you tell the size of the message almost exactly.  Specifically, size estimate must not be too large (!), and not be more than 5000 bytes too small.  That almost means you have to buffer the whole message before you start.  We are lazy here and hope that serialization overhead and file server size estimates don't screw us up.") (+ (GETEOFPTR HEADING) BODYLENGTH (if FORMATSTREAM then (* ; "This plus a few more bytes of serialized file encoding") (GETEOFPTR FORMATSTREAM) else 0) (OR ATTACHMENT-LENGTH 0)))) (COND ((NULL (SETQ MAILDROP (\NSMAIL.NEW.FINDSERVER ESTIMATED-SIZE))) (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 NEW.MAILTRANSPORT) (QUOTE BEGIN.POST) (COURIER.CREATE (NEW.MAILTRANSPORT . POSTING.DATA) RECIPIENTS _ RECIPIENTS CONTENTS.TYPE _ \CT.STANDARD.MESSAGE CONTENTS.SIZE _ ESTIMATED-SIZE BODY.PART.TYPES.SEQUENCE _ (CONS (\NSMAIL.BODY.PART.TYPE HEADING) PART-TYPES)) NIL ALLOW.DL.RECIPIENTS (AND *NSMAIL-RETURN-CONTENTS* (QUOTE ((TRANSPORT.OPTIONS (T T))))) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (COND ((EQ (CAR (LISTP RESULTS)) (QUOTE ERROR)) (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (SELECTQ (CADR RESULTS) (INVALID.RECIPIENTS (\NSMAIL.NEW.INVALID.RECIPIENTS (CADDR RESULTS) RECIPIENTS)) (MKSTRING (CDR RESULTS))))))) (* ;; "RESULTS = (session invalid-recipients)") (SETQ SESSION (CAR RESULTS)) (if (SETQ RESULTS (CADR RESULTS)) then (* ; "Some were invalid.  I think we don't get any here because we didn't say to post anyway.") (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (\NSMAIL.NEW.INVALID.RECIPIENTS RESULTS RECIPIENTS)))) (* ;; "Now post body parts") (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION) (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION (\NSMAIL.BODY.PART.TYPE HEADING) HEADING 0 EDITORWINDOW) (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION) (if USENSTEXTFILE then (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION (\NSMAIL.BODY.PART.TYPE NSTEXTFILE) MSG START EDITORWINDOW (BQUOTE ((BodyType (\,@ \NSMAIL.TEXT.BODYTYPE)) (\,@ (AND FORMATSTREAM (BQUOTE ((LispFormatting (\,@ FORMATSTREAM))))))))) elseif (> BODYLENGTH 0) then (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION (\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE) MSG START EDITORWINDOW)) (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION) (if ATTACHMENT-TYPE then (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION ATTACHMENT-TYPE ATTACHMENT NIL EDITORWINDOW ATTACHED-ATTRIBUTES) (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION)) (if ABORTWINDOW then (* ; "Too late to abort now") (DELETEMENU (CAR (WINDOWPROP ABORTWINDOW (QUOTE MENU))) NIL ABORTWINDOW)) (SETQ RESULTS (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE END.POST) SESSION NIL (QUOTE RETURNERRORS))) (if (EQ (CAR (LISTP RESULTS)) (QUOTE ERROR)) then (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (MKSTRING (CDR RESULTS))))) (AND NSMAILDEBUGFLG (printout PROMPTWINDOW T "EndPost results: " RESULTS)) (RETURN (LENGTH RECIPIENTS))))))
)

(\NSMAIL.NEW.INVALID.RECIPIENTS
(LAMBDA (INVALID.NAME.LIST RECIPIENTS) (* ; "Edited 19-Dec-89 13:00 by bvm") (* ;; "INVALID.NAME.LIST = Sequence (id reason).  id is 1-based.") (if (CDR INVALID.NAME.LIST) then (CONCAT "Invalid recipients: " (SUBSTRING (for PAIR in INVALID.NAME.LIST collect (LIST (COURIER.FETCH (NEW.MAILTRANSPORT . RECIPIENT) NAME of (CAR (NTH RECIPIENTS (CAR PAIR)))) (CADR PAIR))) 2 -2)) else (DESTRUCTURING-BIND (ID REASON) (CAR INVALID.NAME.LIST) (CONCAT (COURIER.FETCH (NEW.MAILTRANSPORT . RECIPIENT) NAME of (CAR (NTH RECIPIENTS ID))) " -- " REASON))))
)

(\NSMAIL.BUILD.HEADING
(LAMBDA (MSGFIELDS SENDER) (* ; "Edited 11-Jul-90 18:03 by bvm") (* ;; "Build a heading body part, which is a sequence of attribute.  Return a stream") (LET ((S (OPENSTREAM "{nodircore}" (QUOTE BOTH))) (COUNT 2)) (SETFILEPTR S 2) (* ; "Save space for the sequence count") (COND ((ASSOC (QUOTE From) MSGFIELDS) (* ; "Identify actual sender (single name here)") (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE Sender) SENDER) (QUOTE NEW.MAILTRANSPORT))) (T (* ; "Identify sender as the sole %"From%" name") (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE From) (LIST SENDER)) (QUOTE NEW.MAILTRANSPORT)))) (for PAIR in MSGFIELDS do (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (CAR PAIR) (CDR PAIR)) (QUOTE NEW.MAILTRANSPORT)) (add COUNT 1)) (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE TextAnnotation) (CONCAT "Date: " (DATE (DATEFORMAT TIME.ZONE SPACES DAY.OF.WEEK)) LAFITEEOL)) (QUOTE NEW.MAILTRANSPORT)) (* ; "Send the Date with time zone, as Cedar does") (if *NSMAIL-GENERATE-MESSAGE-ID* then (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE Message-ID) (COURIER.CREATE (NEW.MAILTRANSPORT . IP.MESSAGEID) ORIGINATOR _ (fetch UNPACKEDUSERNAME of *LAFITE-MODE-DATA*) UNIQUESTRING _ (DATE (DATEFORMAT TIME.ZONE)))) (QUOTE NEW.MAILTRANSPORT)) (add COUNT 1)) (SETFILEPTR S 0) (\WOUT S COUNT) S))
)

(\NSMAIL.POST.BODY.PART
(LAMBDA (COURIERSTREAM SESSION TYPE PARTSTREAM START EDITORWINDOW ATTRIBUTES) (* ; "Edited  8-Mar-90 12:14 by bvm") (LET ((RESULTS (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE POST.ONE.BODY.PART) SESSION TYPE (FUNCTION (LAMBDA (BULKSTREAM) (if ATTRIBUTES then (* ; "Create a serialized file on the fly") (COURIER.WRITE BULKSTREAM \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL)) (* ; "version.  Next comes Sequence Attribute") (\WOUT BULKSTREAM (LENGTH ATTRIBUTES)) (for PAIR in ATTRIBUTES do (if (EQ (CAR PAIR) (QUOTE LispFormatting)) then (* ; "Do this special so we don't have to cons an enormous string") (\NSMAIL.SEND.STREAM.AS.STRING (CDR PAIR) BULKSTREAM 0 (\NSMAIL.ATTRIBUTE.TYPE LispFormatting)) else (\NSMAIL.WRITE.ATTRIBUTE BULKSTREAM (CAR PAIR) (CDR PAIR)))) (* ;; "Next comes StreamOfUnspecified, then lastByteIsSignificant") (if PARTSTREAM then (COURIER.WRITE BULKSTREAM (COURIER.WRITE.STREAM.UNSPECIFIED BULKSTREAM PARTSTREAM (OR START 0) -1) NIL (QUOTE BOOLEAN)) else (* ; "no content") (\WOUT BULKSTREAM 1) (* ; "Last segment") (\WOUT BULKSTREAM 0) (* ; "Empty sequence") (\WOUT BULKSTREAM 1) (* ; "Last Byte is Significant = Byte Length is Even.")) (\WOUT BULKSTREAM 0) (* ; "no children") else (* ; "PARTSTREAM is already in proper format, just send it") (if START then (SETFILEPTR PARTSTREAM START)) (COPYBYTES PARTSTREAM BULKSTREAM)) (* ; "return NIL so caller can see return value") NIL)) (QUOTE RETURNERRORS)))) (if (EQ (CAR RESULTS) (QUOTE ERROR)) then (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE END.POST) SESSION T (QUOTE RETURNERRORS)) (* ; "Abort the post") (\LAFITE.SEND.FAIL EDITORWINDOW (CL:FORMAT NIL "Failed to post ~A because: ~A" (CAR (find TYP in \NSMAIL.BODY.PART.TYPES suchthat (EQ (CADR TYP) TYPE))) (CDR RESULTS))) (ERROR!))))
)

(\NSMAIL.NEW.PREPARE.ATTACHMENT
(LAMBDA (FILE EDITORWINDOW) (* ; "Edited 19-Dec-89 11:38 by bvm") (LET* ((HOST (UNPACKFILENAME.STRING FILE (QUOTE HOST))) (SERIALIZED (STRPOS ":" HOST)) BODYTYPE) (CL:MULTIPLE-VALUE-BIND (STREAM CONDITION) (IGNORE-ERRORS (if SERIALIZED then (\NSFILING.GETFILE (\GETDEVICEFROMHOSTNAME (MKATOM (U-CASE HOST))) FILE (QUOTE SERIALIZE) (QUOTE OLD) NIL NIL T) else (OPENSTREAM FILE (QUOTE INPUT)))) (if (NULL STREAM) then (\LAFITE.SEND.FAIL EDITORWINDOW (OR CONDITION "Attachment not found.")) (ERROR!)) (RESETSAVE NIL (LIST (FUNCTION CLOSEF) STREAM)) (if SERIALIZED then (* ; "Easy case") STREAM else (* ; "Not on an NS server, let's investigate the type") (CASE (SETQ BODYTYPE (\FILETYPE.FROM.TYPE (GETFILEINFO STREAM (QUOTE TYPE)))) ((NIL 0) (* ; "Under specified") (if (SETQ BODYTYPE (\NSMAIL.GUESS.FILE.TYPE (FULLNAME STREAM))) then (SETQ BODYTYPE (\FILETYPE.FROM.TYPE BODYTYPE)) elseif (\SENDMESSAGE.MENUPROMPT EDITORWINDOW (\LAFITE.CREATE.MENU (QUOTE (("Send as BINARY attachment" T) ("Abort" NIL))) "Send attachment?") "Warning: Type of attached file is unknown; most mail clients can't do anything interesting with this.") then (SETQ BODYTYPE 0) else (ERROR!)))) (CONS STREAM (BQUOTE ((BodyType (\,@ BODYTYPE)) (MODIFIED.ON (\,@ (GETFILEINFO STREAM (QUOTE ICREATIONDATE)))))))))))
)

(\NSMAIL.CHECK.ABORT
(LAMBDA (ABORTWINDOW COURIERSTREAM SESSION) (* ; "Edited 28-Nov-89 15:06 by bvm") (* ;; "Abort a post if user has pressed Abort") (COND ((AND ABORTWINDOW (WINDOWPROP ABORTWINDOW (QUOTE ABORT))) (* ; "Abort the post") (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE END.POST) SESSION T (QUOTE RETURNERRORS)) (ERROR!))))
)

(\NSMAIL.NEW.FINDSERVER
(LAMBDA (ESTIMATED-SIZE) (* ; "Edited 25-Jun-90 16:02 by bvm") (PROG (INFO) (if (AND (CDR \NSMAIL.NEW.SERVER.CACHE) (NOT (TIMEREXPIRED? (CAR \NSMAIL.NEW.SERVER.CACHE)))) then (if (SETQ INFO (find ADDR in (CDR \NSMAIL.NEW.SERVER.CACHE) suchthat (\NSMAIL.NEW.CHECKSERVER (COURIER.EXPEDITED.CALL ADDR \NSMAIL.SOCKET (QUOTE NEW.MAILTRANSPORT) (QUOTE SERVER.POLL) (QUOTE RETURNERRORS)) ESTIMATED-SIZE))) then (RETURN INFO)) else (* ;; "Cache nonexistent or timed out, so refigure from scratch.  We like to time out the cache periodically so that we don't permanently latch on to some distant server when local ones are flaky.") (SETQ \NSMAIL.NEW.SERVER.CACHE (LIST (SETUPTIMER *NSMAIL-CACHE-TIMEOUT* (CAR \NSMAIL.NEW.SERVER.CACHE))))) (* ;; "Ask around for a server") (COND ((SETQ INFO (COURIER.BROADCAST.CALL \NSMAIL.SOCKET (QUOTE NEW.MAILTRANSPORT) (QUOTE SERVER.POLL) NIL (FUNCTION (LAMBDA (RESULT) (\NSMAIL.NEW.CHECKSERVER RESULT ESTIMATED-SIZE))) NSMAIL.NET.HINT)) (push (CDR \NSMAIL.NEW.SERVER.CACHE) INFO))) (RETURN INFO)))
)

(\NSMAIL.NEW.CHECKSERVER
(LAMBDA (POLLRESULT ESTIMATED-SIZE) (* ; "Edited 29-Jun-90 17:57 by bvm") (* ;; "Checks that the result of a SERVER.POLL is useful for sending a message of size ESTIMATED-SIZE.  Returns the server's address") (* ;; "POLLRESULT = (willingness network.address.list name)") (LET ((WILLINGNESS (CAR POLLRESULT)) (SIZE (OR ESTIMATED-SIZE 4000))) (* ; "The i'th element of willingness defines the server's willingness to accept messages up to size 8^i.") (if (AND (LISTP WILLINGNESS) (for W in WILLINGNESS as (I _ 8) by (LLSH I 3) while (> I SIZE) always (>= W *NSMAIL-MIN-WILLINGNESS*))) then (PROG ((BESTADDRESS (CAR (SORT.NSADDRESSES.BY.DISTANCE (CADR POLLRESULT))))) (SELECTQ *NSMAIL-TRACE-SERVERS* (NIL NIL) (:ASK (if (NOT (EQ (QUOTE Y) (ASKUSER 30 (QUOTE Y) (LIST "Use posting server" (CADDR POLLRESULT) (LIST BESTADDRESS)) NIL T))) then (RETURN NIL))) (PRINTOUT PROMPTWINDOW T "Using posting server " (CADDR POLLRESULT) " = " BESTADDRESS)) (RETURN BESTADDRESS)))))
)
)

(RPAQQ NSMAIL.PARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT) ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE) ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT) ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance) ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity) ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))

(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(AND (CCODEP (QUOTE \NSMAIL.NEW.SEND.PARSE)) (MOVD (QUOTE \NSMAIL.NEW.SEND.PARSE) (QUOTE \NSMAIL.SEND.PARSE) NIL T))
)

(RPAQ? *USE-NEW-NSMAIL* T)

(RPAQ? *NEWNSMAIL-POST-AS-TEXTFILE* :TEST)

(RPAQ? *NEWNSMAIL-REPORT-TYPE* (QUOTE NON.DELIVERY.ONLY))

(RPAQ? *NSMAIL-ALLOW-DL-RECIPIENTS* T)

(RPAQ? *NSMAIL-RETURN-CONTENTS* T)

(RPAQ? *NSMAIL-MIN-WILLINGNESS* 9)

(RPAQ? *NSMAIL-TRACE-SERVERS*)

(RPAQ? *NSMAIL-GENERATE-MESSAGE-ID*)

(RPAQ? *NSMAIL-DISPLAY-TRANSPORT-ID*)

(RPAQ? *NSMAIL-DISPLAY-POSTMARK*)

(RPAQ? *NSMAIL-DISPLAY-ERRORS-TO*)

(RPAQ? *NSMAIL-CACHE-TIMEOUT* (TIMES 1000 60 60))

(RPAQ? \NSMAIL.MIN.VP.TYPE 4300)

(RPAQ? \NSMAIL.MAX.VP.TYPE 5200)

(RPAQ? \NSMAIL.NEW.SERVER.CACHE)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE)
)

(CL:PROCLAIM (QUOTE (CL:SPECIAL *USE-NEW-NSMAIL* *NEWNSMAIL-POST-AS-TEXTFILE* *NEWNSMAIL-REPORT-TYPE* *NSMAIL-ALLOW-DL-RECIPIENTS* *NSMAIL-RETURN-CONTENTS* *NSMAIL-MIN-WILLINGNESS* *NSMAIL-TRACE-SERVERS* *NSMAIL-GENERATE-MESSAGE-ID* *NSMAIL-DISPLAY-TRANSPORT-ID* *NSMAIL-DISPLAY-POSTMARK* *NSMAIL-DISPLAY-ERRORS-TO* *NSMAIL-CACHE-TIMEOUT*)))



(* ; "Retrieving")

(DEFINEQ

(\NSMAIL.NEW.AUTHENTICATE
(LAMBDA NIL (* ; "Edited  4-Apr-90 17:26 by bvm") (LET ((INFO (\INTERNAL/GETPASSWORD (QUOTE |NS::|))) NSUSERNAME FULLNAME MSERVERS AUTHENTICATED? CREDENTIALS MSG) (SETQ NSUSERNAME (PARSE.NSNAME (CAR INFO))) (COND ((NEQ (SETQ AUTHENTICATED? (COND ((NULL (SETQ FULLNAME (CH.LOOKUP.OBJECT NSUSERNAME))) (QUOTE NONE)) (T (NS.AUTHENTICATE (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS (CONS FULLNAME (CDR INFO)))))))) T) (printout PROMPTWINDOW T "Cannot authenticate user " (RNAME.TO.STRING (OR FULLNAME NSUSERNAME) T) " because: " (SELECTQ (SETQ \LAFITE.AUTHENTICATION.FAILURE AUTHENTICATED?) (CredentialsInvalid "Login incorrect") (KeysUnavailable (CONCAT "Authentication server unavailable for domain " (fetch NSDOMAIN of FULLNAME))) (NONE "No such user") AUTHENTICATED?) ".") NIL) (T (create LAFITEMODEDATA FULLUSERNAME _ (RNAME.TO.STRING FULLNAME T) UNPACKEDUSERNAME _ FULLNAME CREDENTIALS _ CREDENTIALS SHORTUSERNAME _ (CONCAT (fetch NSOBJECT of FULLNAME) (QUOTE %:) (COND ((NOT (STRING-EQUAL (fetch NSDOMAIN of FULLNAME) CH.DEFAULT.DOMAIN)) (fetch NSDOMAIN of FULLNAME)) (T ""))) MAILSERVERS _ (LET ((SERVERS (\NSMAIL.MAKE.MAILSERVERS (NS.FINDMAILBOXES FULLNAME) FULLNAME CREDENTIALS))) (if *USE-NEW-NSMAIL* then (for S in SERVERS do (replace MAILSERVEROPS of S with (CONSTANT (LIST (FUNCTION NEWNS.POLLNEWMAIL) (FUNCTION NEWNS.OPENMAILBOX) (FUNCTION NEWNS.NEXTMESSAGE) (FUNCTION NEWNS.RETRIEVEMESSAGE) (FUNCTION NEWNS.CLOSEMAILBOX)))))) SERVERS))))))
)

(NEWNS.POLLNEWMAIL
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER) (* ; "Edited 18-Dec-89 18:59 by bvm") (LET ((RESULT (\NSMAIL.NEW.CHECK ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER))) (COND ((OR (NOT RESULT) (EQ (CAR RESULT) (QUOTE ERROR))) (* ; "Server down") (QUOTE ?)) ((NEQ RESULT 0) RESULT))))
)

(NEWNS.OPENMAILBOX
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER) (* ; "Edited 18-Dec-89 18:59 by bvm") (LET ((STREAM (\NSMAIL.COURIER.OPEN ADDRESS)) NSMAILSTATE N) (COND ((NULL STREAM) NIL) ((OR (NULL (SETQ N (\NSMAIL.NEW.CHECK ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM T))) (EQ (CAR N) (QUOTE ERROR))) (CLOSEF STREAM) (* ; "Return error msg") (CONS NIL (CDR N))) ((EQ (PROGN (SETQ NSMAILSTATE (fetch MAILSTATE of MAILSERVER)) N) 0) (\NSMAIL.NEW.LOGOFF NSMAILSTATE STREAM) (QUOTE EMPTY)) (T (* ; "Return (MAILBOX  . properties)") (CONS (create NSMAILBOX NSMAILSTREAM _ STREAM NSMAILLASTINDEX _ 0 NSMAILSTATE _ NSMAILSTATE) (LIST (QUOTE %#OFMESSAGES) N))))))
)

(\NSMAIL.NEW.CHECK
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS) (* ; "Edited  5-Jan-90 19:21 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)) (STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER)) SESSION POLLRESULT TIMER) (COND ((AND NIL JUSTCHECKING (SETQ TIMER (fetch STATETIMER of STATE)) (TIMEREXPIRED? TIMER) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) (* ; "Some mailboxes moved") (GO FAILFAST))) (SETQ SESSION (fetch STATESESSION of STATE)) RETRY (COND ((NULL SESSION) (if JUSTCHECKING then (* ; "Just polling, don't need session") (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILPOLL) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (GO GOTRESULT)) (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 (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGON) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS)))) (QUOTE ERROR)) (GO ERROR))) (* ; "result = (session state anchor)") (SETQ POLLRESULT (CADR SESSION)) (replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION)))) (T (SETQ POLLRESULT (COND ((NULL STREAM) (* ; "Just checking") (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))) (T (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))))))) GOTRESULT (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 NIL) (replace STATEOLDLAST of STATE with NIL) (GO RETRY)) (T (SETQ SESSION POLLRESULT) (GO ERROR))))) (replace STATELASTERROR of STATE with NIL) (replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL) (RETURN (COURIER.FETCH (NEW.INBASKET . STATE) TOTAL of POLLRESULT)) ERROR (if (AND (NOT (EQUAL (CDR SESSION) (QUOTE (CONNECTION.PROBLEM NoResponse)))) (NOT (EQUAL (CDR SESSION) (fetch STATELASTERROR of STATE)))) then (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.") (replace STATELASTERROR of STATE with (CDR SESSION)) (LET ((ERRMSG (CASE (CADR SESSION) ((REJECT) (* ; "3rd element = reject reason") (LET* ((REASON (CADDR SESSION)) (TYPE (CAR REASON))) (if (AND (EQ TYPE (QUOTE WrongVersionOfService)) (<= (CAADR REASON) 1) (< (CADADR REASON) 2)) then (* ; "Server supports old inbasket, but not new") (PRINTOUT PROMPTWINDOW T T "****Note: " (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) " does not support new mail protocols." T "Setting *USE-NEW-NSMAIL* to NIL and trying again...") (SETQ *USE-NEW-NSMAIL* NIL) (SETQ \LAFITE.ACTIVE.MODES NIL) (LET ((POS (STKPOS (QUOTE POLLNEWMAIL)))) (if POS then (* ; "Tell mail watcher to start over") (RETFROM POS 0 T))) (if (NOT RETURNERRORS) then (RETURN NIL))) TYPE)) ((SERVICE.ERROR ACCESS.ERROR) (* ; "the specific reason is just as informative, and more readable than the whole error.") (CADDR SESSION)) (T (COND (NSWIZARDFLG (HELP SESSION))) (SUBSTRING (CDR SESSION) 2 -2))))) (if RETURNERRORS then (RETURN (CONS (QUOTE ERROR) ERRMSG)) elseif (AND (EQ ERRMSG (QUOTE NoSuchInbasket)) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) then (* ;; "We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately") (replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0) else (LET ((*PRINT-CASE* :UPCASE)) (* ; "Lousy atomic error names...") (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A" (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) (CASE ERRMSG (NoSuchService "Mail service not running") (T ERRMSG))))))) FAILFAST (RETURN NIL))))
)

(NEWNS.NEXTMESSAGE
(LAMBDA (MAILBOX) (* ; "Edited 13-Dec-89 17:27 by bvm") (LET ((NEXT (NEW.INBASKET.CALL MAILBOX (QUOTE RETRIEVE.ENVELOPES) (fetch NSMAILLASTINDEX of MAILBOX) (QUOTE NEXT) (fetch NSMAILSESSION of MAILBOX)))) (* ;; "NEXT = (envelope status index)") (DESTRUCTURING-BIND (ENVELOPE STATUS INDEX) NEXT (if (EQ INDEX 0) then (* ; "No more messages") NIL else (replace NSMAILLASTINDEX of MAILBOX with INDEX) (replace NSMAILENVTAIL of MAILBOX with ENVELOPE) (* ; "Success") T))))
)

(NEWNS.RETRIEVEMESSAGE
(LAMBDA (MAILBOX MSGOUTFILE) (* ; "Edited 16-Jan-90 15:43 by bvm") (DECLARE (SPECVARS *ATTACHMENTS* *DISCARDED-PARTS* *ENVELOPE* *FORMAT-STREAM* *HAVE-ATTACHMENTS* *HEADER-EOF* *MSGSTREAM* *RETRIEVAL-ERROR* *TABLE-OF-CONTENTS*)) (* ; "For the bulk data fn") (PROG* ((*RETRIEVAL-ERROR* NIL) (INDEX (fetch NSMAILLASTINDEX of MAILBOX)) (*ENVELOPE* (fetch NSMAILENVTAIL of MAILBOX)) (*TABLE-OF-CONTENTS* (CADR (ASSOC (QUOTE TOC) *ENVELOPE*))) (*MSGSTREAM* MSGOUTFILE) (HERE 0) *DISCARDED-PARTS* *HAVE-ATTACHMENTS* *ATTACHMENTS* *FORMAT-STREAM* *HEADER-EOF* PARTS-TO-RETRIEVE RESULT REPORT) (for PAIR in *TABLE-OF-CONTENTS* bind OTHER do (if (FMEMB (CAR PAIR) \NSMAIL.GOOD.BODY.PARTS) then (* ; "we read this fine") elseif (SETQ OTHER (ASSOC (CAR PAIR) \NSMAIL.DISCARDABLE.BODY.PARTS)) then (push *DISCARDED-PARTS* OTHER) else (* ; "Will need to arrange for an attachment") (SETQ *HAVE-ATTACHMENTS* T))) (if (NOT *HAVE-ATTACHMENTS*) then (* ; "Write directly to MSGOUTFILE.  Note where we are in case we have to retry") (SETQ HERE (GETFILEPTR *MSGSTREAM*))) (if *DISCARDED-PARTS* then (* ; "Ordinarily we retrieve everything (PARTS-TO-RETRIEVE = NIL), but if there were parts we like to ignore, we can skip these.") (SETQ PARTS-TO-RETRIEVE (for PAIR in *TABLE-OF-CONTENTS* as INDEX from 0 collect INDEX unless (ASSOC (CAR PAIR) *DISCARDED-PARTS*)))) RETRY (if *HAVE-ATTACHMENTS* then (SETQ *MSGSTREAM* (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (if (SETQ REPORT (CADR (ASSOC (QUOTE REPORT) *ENVELOPE*))) then (* ; "This is a delivery report.  What a crufty way to represent it") (SETQ *ENVELOPE* (\NSMAIL.HANDLE.DELIVERY.REPORT *MSGSTREAM* REPORT *ENVELOPE*)) (if (NULL *TABLE-OF-CONTENTS*) then (* ; "No body, e.g., a bad dl member report") (GO FINISH) else (* ; "Some message parts will follow the report") (PRINTOUT *MSGSTREAM* T "- - - - - - - - -" T))) (if (NEQ (CAAR *TABLE-OF-CONTENTS*) (\NSMAIL.BODY.PART.TYPE HEADING)) then (HELP "First body part is not heading" *TABLE-OF-CONTENTS*)) (SETQ RESULT (COURIER.CALL (fetch NSMAILSTREAM of MAILBOX) (QUOTE NEW.INBASKET) (QUOTE RETRIEVE.BODY.PARTS) INDEX PARTS-TO-RETRIEVE (FUNCTION \NSMAIL.READ.BODY.PARTS) (fetch NSMAILSESSION of MAILBOX) (QUOTE RETURNERRORS))) (if (EQ (CAR (LISTP RESULT)) (QUOTE ERROR)) then (\NSMAIL.SIGNAL.ERROR RESULT MAILBOX (QUOTE NEW.INBASKET) (QUOTE RETRIEVE.BODY.PARTS)) (if *HAVE-ATTACHMENTS* then (SETQ *ATTACHMENTS* NIL) else (SETFILEPTR MSGOUTFILE HERE)) (SETQ *RETRIEVAL-ERROR* NIL) (GO RETRY)) (COND (*RETRIEVAL-ERROR* (printout *MSGSTREAM* T *RETRIEVAL-ERROR* T))) (if *FORMAT-STREAM* then (* ; "This is a TEdit formatted message") (LA.ADJUST.FORMATTING *FORMAT-STREAM* *MSGSTREAM* (- *HEADER-EOF* HERE))) (if *HAVE-ATTACHMENTS* then (SETQ *MSGSTREAM* (OPENTEXTSTREAM *MSGSTREAM* NIL NIL NIL (LIST (QUOTE FONT) LAFITEDISPLAYFONT))) (LET ((ATTACHPOINT (TEDIT.FIND *MSGSTREAM* "

Attachment: " 1))) (SETQ ATTACHPOINT (if ATTACHPOINT then (* ; "Insert object at end of this line") (+ ATTACHPOINT 14) else (* ; "Shouldn't happen") (+ (TEDIT.FIND *MSGSTREAM* "

" 1) 2))) (for AT in *ATTACHMENTS* do (LET (TYPE) (SETFILEPTR AT 4) (* ; "Skip the version number (LONGCARDINAL).  Next comes SEQUENCE Filing.Attribute") (* ; "unknown") (to (\WIN AT) bind X ATTR do (if (EQ (SETQ ATTR (COURIER.READ AT NIL (QUOTE LONGCARDINAL))) (\NSMAIL.ATTRIBUTE.TYPE BodyType)) then (\WIN AT) (SETQ TYPE (\TYPE.FROM.FILETYPE (COURIER.READ AT NIL (QUOTE LONGCARDINAL)))) else (COURIER.SKIP.SEQUENCE AT NIL (QUOTE UNSPECIFIED)))) (TEDIT.INSERT.OBJECT (\MAILOBJ.CREATE AT TYPE (GETFILEPTR AT)) *MSGSTREAM* ATTACHPOINT)))) (* ;; "Would like the following to be (COERCETEXTOBJ OUTSTREAM 'FILE MSGOUTFILE) but Tedit has a bug") (COPYBYTES (OPENSTREAM (COERCETEXTOBJ *MSGSTREAM* (QUOTE FILE)) (QUOTE INPUT)) MSGOUTFILE)) FINISH (push (fetch NSMAILENVELOPES of MAILBOX) INDEX)))
)

(\NSMAIL.READ.BODY.PARTS
(LAMBDA (BULKSTREAM) (* ; "Edited 14-Aug-90 16:13 by bvm") (DECLARE (SPECVARS *ATTACHMENTS* *DISCARDED-PARTS* *ENVELOPE* *FORMAT-STREAM* *HAVE-ATTACHMENTS* *HEADER-EOF* *MSGSTREAM* *TABLE-OF-CONTENTS* *BODY-OFFSET*)) (* ;; "Bulk data handler for RetrieveBodyParts call.  We see the body parts, one directly after the other, per toc.") (* ;; "I hope the heading part is first") (for PAIR in *TABLE-OF-CONTENTS* as INDEX from 0 bind (START _ (GETFILEPTR BULKSTREAM)) (*BODY-OFFSET* _ 0) END HAVETEXT DISCARDING HEADERFIELDS FORWARDINFO FINFO FORWARDSTREAM PART-TYPE PART-LENGTH unless (ASSOC (SETQ PART-TYPE (CAR PAIR)) *DISCARDED-PARTS*) do (* ;; "Assertion: START = (getfileptr bulkstream)") (SETQ PART-LENGTH (CADR PAIR)) (if DISCARDING then (* ; "We already ate some of this, have to skip the rest") (if (> (SETQ DISCARDING (- DISCARDING PART-LENGTH)) 0) then (* ; "We've eaten the entire part, keep discarding") else (* ; "We've eaten all but -DISCARDING bytes") (SETFILEPTR BULKSTREAM (SETQ START (- START DISCARDING))) (SETQ DISCARDING NIL)) else (SETQ END (+ START PART-LENGTH)) (SETQ FINFO (find F in FORWARDINFO suchthat (* ; "See if this is a forwarded part") (FMEMB INDEX (fetch (FORWARD PARTS) of F)))) (SELECTC PART-TYPE ((\NSMAIL.BODY.PART.TYPE HEADING) (* ; "The heading = Sequence of Heading Attribute") (CL:MULTIPLE-VALUE-SETQ (HEADERFIELDS *FORMAT-STREAM* FORWARDINFO) (\NSMAIL.READ.HEADING BULKSTREAM END)) (\NSMAIL.NEW.PRINT.HEADING *MSGSTREAM* HEADERFIELDS *ENVELOPE*) (* ; "Print your basic heading.  May set *BODY-OFFSET*") (if *DISCARDED-PARTS* then (* ; "Add another header field to show what we dropped.") (MAPRINT (CL:REMOVE-DUPLICATES (MAPCAR *DISCARDED-PARTS* (FUNCTION CADR)) :TEST (QUOTE STRING-EQUAL)) *MSGSTREAM* "Discarded-Parts: " NIL ", ") (TERPRI *MSGSTREAM*)) (if *HAVE-ATTACHMENTS* then (* ; "We'll insert image object(s) here later") (PRINTOUT *MSGSTREAM* "
Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ *HEADER-EOF* (GETFILEPTR *MSGSTREAM*)) (if FORWARDINFO then (* ; "We'll need to buffer the forwarded body parts in order to print them properly") (SETQ FORWARDSTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))))) ((LIST (\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE) (\NSMAIL.BODY.PART.TYPE NSTEXTFILE) (\NSMAIL.BODY.PART.TYPE IA5.NOTE)) (* ; "This is text") (LET ((OUTSTREAM *MSGSTREAM*) (OFFSET *BODY-OFFSET*) FORWARDSTART) (if FINFO then (* ; "We'll buffer this text part") (SETQ FORWARDSTART (GETFILEPTR (SETQ OUTSTREAM FORWARDSTREAM))) (SETQ OFFSET 0) else (* ; "Normal case") (if HAVETEXT then (* ; "yet another text part") (PRIN3 "
- - - - - - -

" *MSGSTREAM*) else (SETQ HAVETEXT T))) (SELECTC PART-TYPE ((\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE) (* ; "Xerox character set--just copy.") (SETFILEPTR BULKSTREAM (+ START OFFSET)) (COPYBYTES BULKSTREAM OUTSTREAM (- PART-LENGTH OFFSET))) ((\NSMAIL.BODY.PART.TYPE IA5.NOTE) (* ; "ia5 takes a little bit of conversion.  Note that the skip case never happens here") (\NSMAIL.COPY.IA5 BULKSTREAM OUTSTREAM PART-LENGTH)) ((\NSMAIL.BODY.PART.TYPE NSTEXTFILE) (* ; "nstextfile--decode serialized file") (\NSMAIL.COPY.NSTEXTFILE BULKSTREAM OUTSTREAM END OFFSET)) NIL) (if FINFO then (* ; "Record where the text went") (push (fetch (FORWARD MAP) of FINFO) (LIST INDEX FORWARDSTART (- (GETFILEPTR FORWARDSTREAM) FORWARDSTART))) else (* ; "We've finished whatever skipping we were going to do.") (SETQ *BODY-OFFSET* 0)))) (LET ((BODY (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (* ;; "Parts we don't handle become opaque attachments") (if (OR (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE VPFOLDER)) (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE VPDOCUMENT)) (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE OTHERNSFILE))) then (* ; "It's already serialized") (COPYBYTES BULKSTREAM BODY PART-LENGTH) else (* ; "for now, make a serialized file") (COURIER.WRITE BODY \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL)) (* ; "version") (\WOUT BODY 1) (* ; "Length of attribute sequence") (\NSMAIL.WRITE.ATTRIBUTE BODY (QUOTE BodyType) (if (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE INTERPRESS)) then (CONSTANT (\FILETYPE.FROM.TYPE (QUOTE INTERPRESS))) else (+ PART-TYPE 100000000))) (COURIER.WRITE BODY (COURIER.WRITE.STREAM.UNSPECIFIED BODY BULKSTREAM START END) NIL (QUOTE BOOLEAN)) (* ; "StreamOfUnspecified followed by lastByteIsSignificant") (\WOUT BODY 0) (* ; "no children")) (push *ATTACHMENTS* BODY) (if FINFO then (* ; "So we can refer to this later as attachment #n") (push (fetch (FORWARD MAP) of FINFO) (LIST INDEX (LENGTH *ATTACHMENTS*)))))) (if (NOT (EQL END (SETQ START (GETFILEPTR BULKSTREAM)))) then (HELP (CL:FORMAT NIL "Body part ~A wrong length: parsed as ~D, should have been ~D" PART-TYPE (+ PART-LENGTH (- START END)) PART-LENGTH) (CL:FORMAT NIL "Type 'RETURN' to " (if (> START END) then "flush rest of message" else "flush unread portion"))) (if (> START END) then (SETQ DISCARDING (- START END)) else (SETFILEPTR BULKSTREAM (SETQ START END))))) finally (if FORWARDINFO then (* ;; "At this point we have written all the original parts.  Now walk thru the Forwarding info and write those messages") (LET ((*NSMAIL-DISPLAY-TRANSPORT-ID* NIL) (*NSMAIL-DISPLAY-POSTMARK* NIL)) (* ; "Those fields are boring in forwarded mail") (\NSMAIL.EMIT.FORWARDING FORWARDINFO FORWARDSTREAM *MSGSTREAM* NIL))) (* ;; "Return NIL to let Courier result show thru") (RETURN NIL)))
)

(\NSMAIL.COPY.IA5
(LAMBDA (INSTREAM OUTSTREAM NBYTES) (* ; "Edited 22-Dec-89 18:06 by bvm") (* ;; "Convert NBYTES of ia5 text on INSTREAM to Xerox charset on OUTSTREAM") (while (>= (SETQ NBYTES (SUB1 NBYTES)) 0) bind CH do (SELCHARQ (SETQ CH (\BIN INSTREAM)) (CR (* ; "CR followed by some number of lfs indicates line breaks") (bind GOT1 while (AND (>= (SETQ NBYTES (SUB1 NBYTES)) 0) (EQ (SETQ CH (\BIN INSTREAM)) (CHARCODE LF))) do (* ; "One eol for each lf") (\BOUT OUTSTREAM (CHARCODE CR)) (SETQ GOT1 T) finally (if (NOT GOT1) then (* ; "Naked CR?  Well, go ahead and print one anyway--we don't know how else to do it") (\BOUT OUTSTREAM (CHARCODE CR)))) (if (< NBYTES 0) then (* ; "Text ended in eol") (RETURN))) NIL) (\BOUT OUTSTREAM CH)))
)

(\NSMAIL.COPY.NSTEXTFILE
(LAMBDA (INSTREAM OUTSTREAM END OFFSET) (* ; "Edited 22-May-90 10:37 by bvm") (* ;; "Copies the serialized text file from INSTREAM to OUTSTREAM.  If there's a formatting item, sets *FORMAT-STREAM*.  Just in case of trouble, END is the file pointer where we expect the file to end.  If OFFSET is specified, it is an initial number of bytes to skip.") (\NSMAIL.CHECK.SERIALIZED.VERSION INSTREAM) (* ; "Now Sequence of Filing.Attribute") (to (\WIN INSTREAM) bind TYPE do (SETQ TYPE (COURIER.READ INSTREAM NIL (QUOTE LONGCARDINAL))) (if (AND (EQL TYPE (\NSMAIL.ATTRIBUTE.TYPE LispFormatting)) (NOT *FORMAT-STREAM*)) then (* ; "Read formatting") (\NSMAIL.READ.STRING.AS.STREAM INSTREAM (SETQ *FORMAT-STREAM* (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) else (* ; "Skip over the value") (COURIER.SKIP.SEQUENCE INSTREAM NIL (QUOTE UNSPECIFIED)))) (* ;; "Now read the text content.  This is adapted from \nsmail.read.serialized.content") (if (NOT OFFSET) then (SETQ OFFSET 0)) (bind LASTSEGMENT? BYTE BYTECOUNT do (SETQ LASTSEGMENT? (NEQ (\WIN INSTREAM) 0)) (COND ((NEQ (SETQ BYTECOUNT (UNFOLD (\WIN INSTREAM) BYTESPERWORD)) 0) (if (AND (> OFFSET 0) (LET ((SKIPLENGTH (MIN OFFSET BYTECOUNT))) (* ; "How much of this segment to skip") (SETFILEPTR INSTREAM (+ (GETFILEPTR INSTREAM) SKIPLENGTH)) (SETQ OFFSET (- OFFSET SKIPLENGTH)) (EQ (SETQ BYTECOUNT (- BYTECOUNT SKIPLENGTH)) 0))) then (* ; "We skipped the entire segment") (if LASTSEGMENT? then (* ; "Have to consume the lastByteIsSignificant flag") (\WIN INSTREAM)) else (COPYBYTES INSTREAM OUTSTREAM (SUB1 BYTECOUNT)) (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))))) (LASTSEGMENT? (* ; "Null body.  Throw out the lastByteIsSignificant flag") (\WIN INSTREAM))) repeatuntil LASTSEGMENT?) (LET ((NCHILDREN (\WIN INSTREAM))) (if (> NCHILDREN 0) then (HELP "nsTextFile has children!! -- return to skip them" NCHILDREN) (SETFILEPTR INSTREAM END))))
)

(\NSMAIL.READ.HEADING
(LAMBDA (BULKSTREAM HEADING-END) (* ; "Edited 21-Dec-89 17:09 by bvm") (* ;; "Read a Heading body part, which consists of Sequence of Heading Attribute.  Returns 4 values: headerfields (an alist), formatstream (if there was tedit formatting item), forwardInfo (if there was a forwarding structure), malformedP (if we had to advance the file pointer manually to HEADING-END") (LET (TYPE VALUE HEADERFIELDS TYPEINFO DISCARDED FORMATSTREAM FORWARDINFO MALFORMED COURIERTYPE) (to (\WIN BULKSTREAM) do (SETQ TYPE (COURIER.READ BULKSTREAM NIL (QUOTE LONGCARDINAL))) (COND ((NOT (find old TYPEINFO in \NSMAIL.HEADING.ATTRIBUTES suchthat (EQ (CADR TYPEINFO) TYPE))) (* ; "We don't understand this attribute") (if NSMAILDEBUGFLG then (push DISCARDED TYPE)) (COURIER.SKIP.SEQUENCE BULKSTREAM NIL (QUOTE UNSPECIFIED))) ((EQ (SETQ TYPE (CAR TYPEINFO)) (QUOTE LispFormatting)) (* ; "Save the formatting so we can munge it") (SETQ FORMATSTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (\NSMAIL.READ.STRING.AS.STREAM BULKSTREAM FORMATSTREAM)) (T (LET ((VALUE-END (+ (UNFOLD (\WIN BULKSTREAM) BYTESPERWORD) (GETFILEPTR BULKSTREAM))) (COURIERTYPE (CADDR TYPEINFO)) HERE) (* ; "Note careful order of args to +") (if (EQ TYPE (QUOTE ForwardedHeadings)) then (SETQ FORWARDINFO (\NSMAIL.READ.FORWARDING BULKSTREAM VALUE-END)) else (CL:MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (COURIER.READ BULKSTREAM (QUOTE NEW.MAILTRANSPORT) COURIERTYPE)) (if (OR CONDITION (NOT (EQL (SETQ HERE (GETFILEPTR BULKSTREAM)) VALUE-END))) then (if (NOT CONDITION) then (SETQ CONDITION "wrong length")) (if NSMAILDEBUGFLG then (HELP (CL:FORMAT NIL "Error reading attribute ~A: ~A" TYPE CONDITION))) (push HEADERFIELDS (CONS (MKSTRING TYPE) (CL:FORMAT NIL "XNS encoding error: ~A" CONDITION))) (if (< HERE VALUE-END) then (SETFILEPTR BULKSTREAM VALUE-END) elseif (AND (> HERE VALUE-END) (< HERE HEADING-END)) then (SETFILEPTR BULKSTREAM HEADING-END) (push HEADERFIELDS (QUOTE ("Header-Errors" . "Malformed XNS heading, some fields may be missing."))) (* ; "Exit this heading reader loop") (RETURN (SETQ MALFORMED T))) else (* ; "Save field") (push HEADERFIELDS (CONS TYPE (if (EQ TYPE (QUOTE Immutable)) then (* ; "Strange null-valued type") "True" elseif (LISTP COURIERTYPE) then (if (EQUAL COURIERTYPE (QUOTE (SEQUENCE IP.MESSAGEID))) then (MAPCAR VALUE (FUNCTION \NSMAIL.TRANSLATE.IP.MESSAGEID)) else VALUE) else (SELECTQ COURIERTYPE (TIME (\NSMAIL.GDATE VALUE)) (IP.MESSAGEID (\NSMAIL.TRANSLATE.IP.MESSAGEID VALUE)) VALUE))))))))))) (if DISCARDED then (push HEADERFIELDS (CONS "Discarded-Fields" (CONCATLIST (CDR (for D in (REVERSE DISCARDED) join (LIST ", " D))))))) (CL:VALUES HEADERFIELDS FORMATSTREAM FORWARDINFO MALFORMED)))
)

(\NSMAIL.PARSE.ANNOTATION
(LAMBDA (ANNOTATION OUTSTREAM HEADERFIELDS) (* ; "Edited 21-Dec-89 13:10 by bvm") (* ;; "ANNOTATION is the value of the TextAnnotation heading.  We parse it and print it to OUTSTREAM.  HEADERFIELDS is an alist of other headers the caller will be printing.") (bind (LEN _ (NCHARS ANNOTATION)) (START _ 1) (NEXT _ 1) CR while (SETQ CR (STRPOS "
" ANNOTATION NEXT)) do (CASE (AND (< CR LEN) (CL:CHAR ANNOTATION CR)) ((#\Space #\Tab) (* ; "Whitespace denoting continuation line")) (T (\NSMAIL.EMIT.ANNOTATION (SUBSTRING ANNOTATION START (SUB1 CR)) OUTSTREAM HEADERFIELDS) (SETQ START (ADD1 CR)))) (SETQ NEXT (ADD1 CR)) finally (\NSMAIL.EMIT.ANNOTATION (SUBSTRING ANNOTATION START) OUTSTREAM HEADERFIELDS)))
)

(\NSMAIL.EMIT.ANNOTATION
(LAMBDA (STR OUTSTREAM HEADERFIELDS) (* ; "Edited 10-Jul-90 15:55 by bvm") (DECLARE (SPECVARS *ORIGINAL-DATE*)) (* ;; "Print extra field STR to OUTSTREAM.  We don't know exactly what it looks like, so we need to ensure that it is syntactically ok.  If it is one of HEADERFIELDS, we make sure to rename it to avoid a clash.  If it is the Date field, we print it and set *ORIGINAL-DATE* to the value portion.") (PROG (I LEN FIELD) (if (AND STR (> (SETQ LEN (NCHARS STR)) 0)) then (if (NOT (SETQ FIELD (for old I from 0 to (SUB1 LEN) do (CASE (CL:CHAR STR I) (#\: (* ; "valid field") (RETURN (SUBSTRING STR 1 I))) ((#\Space #\Tab) (* ; "Space before colon?  Malformed") (RETURN NIL)))))) then (* ; "Malformed field") (PRIN3 "Other-Field: " OUTSTREAM) elseif (CL:ASSOC FIELD HEADERFIELDS :TEST (QUOTE STRING-EQUAL)) then (* ; "We already have a field of this name, so rename it") (if (AND (< I (- LEN 2)) (EQL (CL:CHAR STR (ADD1 I)) #\Tab)) then (* ; "field:<tab> looks a little weird when we add text to the front") (CL:SETF (CL:CHAR STR (ADD1 I)) #\Space)) (PRIN3 "Original-" OUTSTREAM) elseif (STRING-EQUAL FIELD "Date") then (SETQ *ORIGINAL-DATE* (LA.TRIM.WHITESPACE (SUBSTRING STR (+ I 2))))) (PRIN3 STR OUTSTREAM) (TERPRI OUTSTREAM))))
)

(LA.TRIM.WHITESPACE
(LAMBDA (STR) (* ; "Edited 14-May-90 16:35 by bvm") (CL:STRING-TRIM (QUOTE (#\Space #\Tab)) STR)))

(\NSMAIL.READ.FORWARDING
(LAMBDA (INSTREAM VALUE-END) (* ; "Edited 21-Dec-89 18:39 by bvm") (* ;; "Read the attribute ForwardedHeadings = Sequence of ForwardedMessageInfo.  We do this instead of a straight COURIER.READ so that we can play with the headings field.  Returns NIL if the attribute is malformed.") (to (\WIN INSTREAM) collect (create FORWARD ENVELOPE _ (COURIER.READ INSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE ENVELOPE)) HEADINGS _ (CL:MULTIPLE-VALUE-BIND (HEADINGS FORMATSTREAM FORWARDINFO MALFORMED) (\NSMAIL.READ.HEADING INSTREAM VALUE-END) (if MALFORMED then (RETURN NIL) else (* ;; "Note that we ignore FORWARDINFO (not allowed anyway, as messages are not quite recursive) and FORMATSTREAM (who would have had it anyway, though it would be cute to be able to use it).") HEADINGS)) PARTS _ (COURIER.READ.SEQUENCE INSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE BODY.PART.INDEX)) PARENT _ (if (NEQ (\WIN INSTREAM) 0) then (* ; "Open coding of (choice (null 0 (record)) (nested 1 cardinal))") (\WIN INSTREAM)))))
)

(\NSMAIL.NEW.PRINT.HEADING
(LAMBDA (OUTSTREAM HEADERFIELDS ENVELOPE) (* ; "Edited 26-Sep-90 11:35 by bvm") (* ;; "Compose message header from HEADERFIELDS and ENVELOPE, printing to OUTSTREAM.  ") (PROG (*ORIGINAL-DATE* ORIGIDATE POSTED.DATE ORIGINATOR RETURN-TO VALUE TYPE SENDER FROMFIELD FULLFROMFIELD) (DECLARE (SPECVARS *ORIGINAL-DATE* *BODY-OFFSET*)) (for PAIR in (SETQ HEADERFIELDS (REVERSE HEADERFIELDS)) do (* ; "Before we start printing anything, look for some special fields") (CASE (CAR PAIR) (Sender (SETQ SENDER (CDR PAIR))) (From (SETQ FULLFROMFIELD (CDR PAIR)) (COND ((NULL (CDDR PAIR)) (* ; "Only interesting to eliminate if there's only one") (SETQ FROMFIELD (CADR PAIR))))) ((TextAnnotation newTextAnnotation) (\NSMAIL.PARSE.ANNOTATION (CDR PAIR) OUTSTREAM HEADERFIELDS) (RPLACD PAIR NIL)) (BodyOffset (* ; "Says how much of body duplicates the textannotation") (SETQ *BODY-OFFSET* (CDR PAIR)) (RPLACD PAIR NIL)))) (* ;; "Look at the envelope to see if there is any additional info we should supply that wasn't in the headers") (for PAIR in ENVELOPE do (SETQ VALUE (CADR PAIR)) (CASE (SETQ TYPE (CAR PAIR)) (Originator (if (OR (NULL (OR SENDER FROMFIELD)) (NOT (EQUAL.RNAMES VALUE (OR SENDER FROMFIELD)))) then (SETQ ORIGINATOR VALUE))) (RETURN.TO.NAME (SETQ RETURN-TO VALUE)) (Message-ID (if *NSMAIL-DISPLAY-TRANSPORT-ID* then (CL:FORMAT OUTSTREAM "XNS-Transport-ID: ~{~4,'0x~}~%%" VALUE))) (Postmark (SETQ POSTED.DATE (COURIER.FETCH (NEW.MAILTRANSPORT . POSTMARK) TIME of VALUE)) (if *NSMAIL-DISPLAY-POSTMARK* then (CL:FORMAT OUTSTREAM "Postmark: ~A at ~A~%%" (RNAME.TO.STRING (COURIER.FETCH (NEW.MAILTRANSPORT . POSTMARK) POSTED.AT of VALUE) T) (GDATE POSTED.DATE (DATEFORMAT TIME.ZONE))))))) (if POSTED.DATE then (* ; "Date is found only in the envelope") (if (AND *ORIGINAL-DATE* (SETQ ORIGIDATE (IDATE *ORIGINAL-DATE*)) (< (IABS (- POSTED.DATE ORIGIDATE)) (TIMES 5 60))) then (* ; "Text-annotation portion gave a date that is within 5 minutes, so don't bother mentioning the posting date.") else (if *ORIGINAL-DATE* then (* ; "Already have a Date field printed, so this one we'll call %"Posted-Date%"") (PRINTOUT OUTSTREAM "Posted-")) (PRINTOUT OUTSTREAM "Date: " (\NSMAIL.GDATE POSTED.DATE) T))) (if (NULL FULLFROMFIELD) then (* ; "Derive From field from somewhere else") (if SENDER then (RPLNODE (ASSOC (QUOTE Sender) HEADERFIELDS) (QUOTE From) (LIST SENDER)) (if ORIGINATOR then (push HEADERFIELDS (CONS (QUOTE Sender) ORIGINATOR))) elseif ORIGINATOR then (* ; "Neither From nor Sender in heading, take it out of envelope") (push HEADERFIELDS (LIST (QUOTE From) (SETQ SENDER ORIGINATOR)))) elseif (NULL SENDER) then (* ; "From but no Sender") (if ORIGINATOR then (* ; "ORIGINATOR only set when it's different from From") (push HEADERFIELDS (CONS (QUOTE Sender) (SETQ SENDER ORIGINATOR))) else (SETQ SENDER FROMFIELD)) elseif (AND FROMFIELD (EQUAL.RNAMES SENDER FROMFIELD)) then (* ; "Sender is redundant with From--get rid of it, unless the envelope originator is different") (RPLACD (ASSOC (QUOTE Sender) HEADERFIELDS) ORIGINATOR) elseif ORIGINATOR then (* ; "Three distinct fields") (push HEADERFIELDS (CONS (QUOTE Originator) ORIGINATOR))) (if (AND RETURN-TO (OR (NULL SENDER) (NOT (EQUAL.RNAMES RETURN-TO SENDER))) *NSMAIL-DISPLAY-ERRORS-TO*) then (* ;; "Usually same as originator, so we omit.  (NULL SENDER) is only true when there's no originator in envelope, allegedly illegal") (push HEADERFIELDS (CONS (QUOTE Errors-To) RETURN-TO))) (if (NOT (type? NSNAME SENDER)) then (* ; "Can't resolve domain/orgs against this") (SETQ SENDER NIL)) (for PAIR in (SORT HEADERFIELDS (FUNCTION (LAMBDA (X Y) (* ;; "X sorts before Y if X is in the well-known order and either Y appears after it or doesn't appear at all.  Non-symbols sort after everything") (AND (LITATOM (CAR X)) (OR (NOT (LITATOM (CAR Y))) (AND (SETQ X (FMEMB (CAR X) NSMAIL.HEADER.ORDER)) (OR (FMEMB (CAR Y) X) (NULL (FMEMB (CAR Y) NSMAIL.HEADER.ORDER))))))))) when (SETQ VALUE (CDR PAIR)) do (printout OUTSTREAM (SETQ TYPE (CAR PAIR)) ": ") (CASE TYPE ((From To cc bcc Reply-to) (\NSMAIL.NEW.PRINT.NAMES VALUE OUTSTREAM (SELECTQ TYPE (From (* ; "Always fully qualified.  Also check against sender.") (if (AND SENDER (NOT (for NAME in VALUE always (OR (EQ NAME SENDER) (AND (STRING-EQUAL (fetch NSDOMAIN of NAME) (fetch NSDOMAIN of SENDER)) (STRING-EQUAL (fetch NSORGANIZATION of NAME) (fetch NSORGANIZATION of SENDER))))))) then (* ; "Ugh, From and Sender are different domains.  To reduce confusion, force everything to be fully qualified") (SETQ SENDER NIL)) NIL) (Reply-to (* ; "always full-qualified") NIL) SENDER))) ((Sender Originator Errors-To) (printout OUTSTREAM (RNAME.TO.STRING VALUE T))) (T (if (LISTP VALUE) then (* ; "List of things we'll print as each thing separated by spaces (e.g., References)") (SETQ VALUE (CONCATLIST (CDR (for X in VALUE join (LIST " " X)))))) (while (AND (> (NCHARS VALUE) 0) (EQ (NTHCHARCODE VALUE -1) (CHARCODE CR))) do (* ; "Trailing cr's, e.g., in the Subject line, will cause the header not to parse") (SETQ VALUE (SUBSTRING VALUE 1 -2))) (bind (CR _ 1) while (SETQ CR (STRPOS "
" VALUE CR)) do (* ; "Given internal CR, have to make sure subsequent lines are continuation lines, i.e., start with whitespace.") (SELCHARQ (NTHCHARCODE VALUE (ADD1 CR)) ((SPACE TAB) (* ; "It's ok, let it go") (SETQ CR (ADD1 CR))) (PROGN (* ; "Not followed by whitespace, so print this much (including cr), then a tab.") (PRIN3 (SUBSTRING VALUE 1 CR) OUTSTREAM) (PRINTCCODE (CHARCODE TAB) OUTSTREAM) (SETQ VALUE (SUBSTRING VALUE (ADD1 CR))) (SETQ CR 1)))) (PRIN3 VALUE OUTSTREAM))) (TERPRI OUTSTREAM))))
)

(\NSMAIL.NEW.PRINT.NAMES
(LAMBDA (RNAMES OUTSTREAM DEFAULTNAME) (* ; "Edited  4-Apr-90 17:32 by bvm") (for NAME in RNAMES bind (FIRSTTIME _ T) ORGDIFFERS do (if (type? NSNAME NAME) then (COND (FIRSTTIME (SETQ FIRSTTIME NIL)) (T (PRIN3 ", " OUTSTREAM))) (PRIN3 (fetch NSOBJECT of NAME) OUTSTREAM) (LET ((ORG (fetch NSORGANIZATION of NAME)) (DOM (fetch NSDOMAIN of NAME))) (if (OR (SETQ ORGDIFFERS (NOT (AND DEFAULTNAME (OR (STRING-EQUAL ORG (fetch NSORGANIZATION of DEFAULTNAME)) (EQ (NCHARS ORG) 0))))) (NOT (OR (STRING-EQUAL DOM (fetch NSDOMAIN of DEFAULTNAME)) (EQ (NCHARS DOM) 0)))) then (* ;; "Have to print the domain.  The null string tests are because there exists buggy software that doesn't fill in the domain and org--we want them to default correctly eventually.") (PRIN3 ":" OUTSTREAM) (PRIN3 DOM OUTSTREAM) (if ORGDIFFERS then (* ; "Have to print the org, too") (PRIN3 ":" OUTSTREAM) (PRIN3 ORG OUTSTREAM)))) else (PRIN3 (RNAME.TO.STRING NAME) OUTSTREAM))))
)

(\NSMAIL.EMIT.FORWARDING
(LAMBDA (FORWARDINFO FORWARDSTREAM OUTSTREAM PARENT-INDEX) (* ; "Edited 22-May-90 10:41 by bvm") (* ;; "Recursively emit Forwarded body structure.  In this pass, we print all the body parts subsidiary to the PARENT-INDEXth item, or the top level items if PARENT-INDEX is nil.") (for FINFO in FORWARDINFO as I from 0 bind NTHTIME when (EQ (fetch (FORWARD PARENT) of FINFO) PARENT-INDEX) do (* ;; "This bit of forwarding info describes a child of PARENT-INDEX") (LET ((*BODY-OFFSET* 0)) (DECLARE (SPECVARS *BODY-OFFSET*)) (* ; "set by \nsmail.new.print.heading") (TERPRI OUTSTREAM) (PRIN3 (if NTHTIME then (* ; "%"Next Message%"") (CADDR LAFITEFORWARDSTRINGS) else (SETQ NTHTIME T) (* ; "%"Begin Forwarded Messages%"") (CADR LAFITEFORWARDSTRINGS)) OUTSTREAM) (TERPRI OUTSTREAM) (\NSMAIL.NEW.PRINT.HEADING OUTSTREAM (fetch (FORWARD HEADINGS) of FINFO) (fetch (FORWARD ENVELOPE) of FINFO)) (* ; "Print header of this part") (TERPRI OUTSTREAM) (for INDEX in (fetch (FORWARD PARTS) of FINFO) bind (MAP _ (fetch (FORWARD MAP) of FINFO)) MAPENTRY NTHPART do (if NTHPART then (* ; "Yet another body part") (PRIN3 "
- - - - - - -

" OUTSTREAM) else (SETQ NTHPART T)) (if (NOT (SETQ MAPENTRY (CDR (ASSOC INDEX MAP)))) then (PRIN3 "[Missing part]
" OUTSTREAM) elseif (CDR MAPENTRY) then (* ; "(start length)") (SETFILEPTR FORWARDSTREAM (+ (CAR MAPENTRY) *BODY-OFFSET*)) (COPYBYTES FORWARDSTREAM OUTSTREAM (CADR MAPENTRY)) (SETQ *BODY-OFFSET* 0) else (* ; "(attachment#)") (if (CL:FORMAT OUTSTREAM "[See Attachment #~D]~%%" (CAR MAPENTRY)))))) (* ; "If there are children, do them") (\NSMAIL.EMIT.FORWARDING FORWARDINFO FORWARDSTREAM OUTSTREAM I) finally (if NTHTIME then (* ; "Yes, we printed some parts, so time for %"End Forwarded Messages%"") (TERPRI OUTSTREAM) (PRIN3 (CADDDR LAFITEFORWARDSTRINGS) OUTSTREAM))))
)

(\NSMAIL.GDATE
(LAMBDA (TIME) (* ; "Edited 11-Jul-90 18:03 by bvm") (GDATE TIME (DATEFORMAT SPACES TIME.ZONE))))

(\NSMAIL.TRANSLATE.IP.MESSAGEID
(LAMBDA (ID) (* ; "Edited 11-May-90 10:45 by bvm") (LET ((RNAME (COURIER.FETCH (NEW.MAILTRANSPORT . IP.MESSAGEID) ORIGINATOR of ID)) (USTRING (COURIER.FETCH (NEW.MAILTRANSPORT . IP.MESSAGEID) UNIQUESTRING of ID))) (if (NOT (NULL.NSNAME RNAME)) then (* ; "Really has name") (CONCAT #\< USTRING #\* (RNAME.TO.STRING RNAME T) #\>) elseif (AND (EQ (CL:CHAR USTRING 0) #\<) (EQ (CL:CHAR USTRING (SUB1 (NCHARS USTRING))) #\>)) then (* ; "It's already in msg-id format") USTRING else (\NSMAIL.MAYBE.QUOTE USTRING))))
)

(\NSMAIL.MAYBE.QUOTE
(LAMBDA (STR) (* ; "Edited 11-May-90 10:44 by bvm") (* ;; "return STR with string quotes around it if it contains any characters that RFC822 says are special") (if (for I from 1 to (NCHARS STR) bind CH thereis (OR (< (SETQ CH (NTHCHARCODE STR I)) (CHARCODE SPACE)) (>= CH (CHARCODE DEL)) (FMEMB CH (CHARCODE ("(" ")" "<" ">" "@" "," ";" ":" \ %" "." "[" "]"))))) then (CONCAT #\" (if (STRPOSL (CHARCODE (\ %")) STR) then (* ; "Have to quote these") (CONCATLIST (for I from 0 to (SUB1 (NCHARS STR)) bind CH join (CASE (SETQ CH (CL:CHAR STR I)) ((#\\ #\") (LIST #\\ CH)) (T (LIST CH))))) else STR) #\") else STR))
)

(NULL.NSNAME
(LAMBDA (NAME) (* ; "Edited 21-Aug-90 11:32 by bvm") (AND (type? NSNAME NAME) (EQL (NCHARS (fetch NSDOMAIN of NAME)) 0) (EQL (NCHARS (fetch NSORGANIZATION of NAME)) 0) (PROGN (* ; "Kludge in new gateway due to bug in backward compatibility--object = single char is also %"null%"") (< (NCHARS (fetch NSOBJECT of NAME)) 2))))
)

(\NSMAIL.HANDLE.DELIVERY.REPORT
(LAMBDA (OUTSTREAM REPORT-RECORD ENVELOPE) (* ; "Edited 29-Jun-90 18:06 by bvm") (LET* ((POSTED.DATE (COURIER.FETCH (NEW.MAILTRANSPORT . POSTMARK) TIME of (CADR (ASSOC (QUOTE Postmark) ENVELOPE)))) (OLD.ENVELOPE (COURIER.FETCH (NEW.MAILTRANSPORT . REPORT) ORIGINAL.ENVELOPE of REPORT-RECORD)) (REPORT (COURIER.FETCH (NEW.MAILTRANSPORT . REPORT) REPORT.TYPE of REPORT-RECORD)) (REPORTVALUE (CADR REPORT)) (FATE (COURIER.FETCH (NEW.MAILTRANSPORT . REPORT) FATE of REPORT-RECORD)) (SENDER (CADR (ASSOC (QUOTE Originator) ENVELOPE))) (RETURN-TO (CADR (ASSOC (QUOTE RETURN.TO.NAME) ENVELOPE))) BADNAMES GOODNAMES) (if POSTED.DATE then (PRINTOUT OUTSTREAM "Date: " (\NSMAIL.GDATE POSTED.DATE) T)) (if SENDER then (PRINTOUT OUTSTREAM "From: " (RNAME.TO.STRING SENDER T) T)) (if (AND RETURN-TO (NOT (EQUAL.RNAMES SENDER RETURN-TO))) then (PRINTOUT OUTSTREAM "Errors-to: " (RNAME.TO.STRING RETURN-TO T) T)) (PRINTOUT OUTSTREAM "Subject: ") (if (EQ (CAR FATE) (QUOTE NOT.DELIVERED)) then (* ; "Bizarre") (PRINTOUT OUTSTREAM "Return of non-delivery notice" T T "This non-delivery report could not be delivered because " (CAR (CADR FATE)) T T "Original-Subject: ")) (CASE (CAR REPORT) (DLMEMBER (* ; "Bad member notification") (SETQ BADNAMES (COURIER.FETCH (NEW.MAILTRANSPORT . DLREPORT) INVALID.RECIPIENTS of REPORTVALUE)) (PRINTOUT OUTSTREAM "Bad group membership notification" T T) (CL:FORMAT OUTSTREAM "A message from ~A could not be delivered to the following member~P of ~A:" (RNAME.TO.STRING (CADR (ASSOC (QUOTE Originator) OLD.ENVELOPE)) T) (LENGTH BADNAMES) (RNAME.TO.STRING (COURIER.FETCH (NEW.MAILTRANSPORT . DLREPORT) DLNAME of REPORTVALUE) T))) (OTHER (SETQ BADNAMES (COURIER.FETCH (NEW.MAILTRANSPORT . OTHER.REPORT) FAILED of REPORTVALUE)) (SETQ GOODNAMES (COURIER.FETCH (NEW.MAILTRANSPORT . OTHER.REPORT) SUCCEEDED of REPORTVALUE)) (if BADNAMES then (PRINTOUT OUTSTREAM "Undeliverable mail" T T) (CL:FORMAT OUTSTREAM "This message could not be delivered to the following recipient~P:" (LENGTH BADNAMES)) else (* ; "Strictly a delivery report") (PRINTOUT OUTSTREAM "Delivery report"))) (T (* ; "Shouldn't happen") (PRINTOUT OUTSTREAM "Erroneous (non-)delivery report" T T REPORT))) (PRINTOUT OUTSTREAM T T) (for PAIR in BADNAMES do (PRINTCCODE (CHARCODE TAB) OUTSTREAM) (PRINTOUT OUTSTREAM (\NSMAIL.RECIPIENT.NAME (COURIER.FETCH (NEW.MAILTRANSPORT . NON.DELIVERED.RECIPIENT) RECIPIENT of PAIR)) " -- " (COURIER.FETCH (NEW.MAILTRANSPORT . NON.DELIVERED.RECIPIENT) REASON of PAIR) T)) (if GOODNAMES then (* ; "A delivery report") (if BADNAMES then (TERPRI OUTSTREAM)) (CL:FORMAT OUTSTREAM "This message was delivered to the following recipient~P:~2%%" (LENGTH GOODNAMES)) (for PAIR in GOODNAMES do (PRINTCCODE (CHARCODE TAB) OUTSTREAM) (PRINTOUT OUTSTREAM (\NSMAIL.RECIPIENT.NAME (COURIER.FETCH (NEW.MAILTRANSPORT . DELIVERED.RECIPIENT) RECIPIENT of PAIR)) " at " (\NSMAIL.GDATE (COURIER.FETCH (NEW.MAILTRANSPORT . DELIVERED.RECIPIENT) WHEN of PAIR) (DATEFORMAT TIME.ZONE)) T))) OLD.ENVELOPE))
)

(\NSMAIL.RECIPIENT.NAME
(LAMBDA (RECIPIENT) (* ; "Edited  4-Apr-90 17:26 by bvm") (* ;; "Printable rep for a MailTransport.Recipient") (RNAME.TO.STRING (COURIER.FETCH (NEW.MAILTRANSPORT . RECIPIENT) NAME of RECIPIENT) T))
)

(NEW.INBASKET.CALL
(CL:LAMBDA (MAILBOX PROCEDURE &REST ARGS) (* ; "Edited 13-Dec-89 17:17 by bvm") (PROG ((STREAM (fetch NSMAILSTREAM of MAILBOX)) RESULT) LP (if (AND (EQ (CAR (LISTP (SETQ RESULT (CL:APPLY (FUNCTION COURIER.CALL) STREAM (QUOTE NEW.INBASKET) PROCEDURE ARGS)))) (QUOTE ERROR)) (CASE (CAR (LAST ARGS)) (NOERROR NIL) (RETURNERRORS (* ; "We'll only handle stream lost--caller gets the rest") (EQ (CADR RESULT) (QUOTE STREAM.LOST))) (T (* ; "Probably an error was already signaled") T))) then (SETQ STREAM (\NSMAIL.SIGNAL.ERROR RESULT MAILBOX (QUOTE NEW.INBASKET) PROCEDURE)) (GO LP) else (RETURN RESULT))))
)

(NEWNS.CLOSEMAILBOX
(LAMBDA (MAILBOX FLUSH?) (* ; "Edited 18-Dec-89 17:35 by bvm") (COND (FLUSH? (* ; "Delete everything we retrieved") (LET ((INDICES (REVERSE (fetch NSMAILENVELOPES of MAILBOX))) (SESSION (fetch NSMAILSESSION of MAILBOX))) (while INDICES do (* ; "Delete a message or more.  To keep the calls down, try to delete consecutive ranges when possible.") (LET* ((START (CAR INDICES)) (END START)) (while (AND (SETQ INDICES (CDR INDICES)) (EQL (CAR INDICES) (ADD1 END))) do (SETQ END (ADD1 END))) (NEW.INBASKET.CALL MAILBOX (QUOTE DELETE) (COURIER.CREATE (NEW.INBASKET . RANGE) LOW _ START HIGH _ END) SESSION)))))) (\NSMAIL.NEW.LOGOFF (fetch NSMAILSTATE of MAILBOX) (fetch NSMAILSTREAM of MAILBOX)))
)

(\NSMAIL.NEW.LOGOFF
(LAMBDA (STATE STREAM) (* ; "Edited 19-Dec-89 11:08 by bvm") (* ;; "Executes the Inbasket.Logoff procedure and clears appropriate state.  Returns true if LOGOFF call succeeded.") (LET ((RESULT (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGOFF) (fetch STATESESSION of STATE) (QUOTE RETURNERRORS)))) (PROG1 (NEQ (CAR (LISTP RESULT)) (QUOTE ERROR)) (replace STATESESSION of STATE with NIL) (CLOSEF STREAM))))
)
)

(RPAQQ \NSMAIL.GOOD.BODY.PARTS (0 5 6 2))

(RPAQQ \NSMAIL.DISCARDABLE.BODY.PARTS ((201 "Tioga formatting") (202 "Tioga header")))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
)

(ADDTOVAR LAFITEMODELST (NS 1 \NSMAIL.SEND.PARSE \NSMAIL.NEW.SEND \NSMAIL.MAKEANSWERFORM \NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.LOGIN))

(LAFITEMODE (LAFITEMODE))

(COND ((AND *USE-NEW-NSMAIL* \LAFITE.ACTIVE) (* ; "recache") (LAFITECLEARCACHE)))



(* ; "Old ns mail")

(DEFINEQ

(\NS.READ.ENVELOPE.ITEM
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:11 by bvm") (* ;; "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") (LET* ((TYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) (VALUETYPE (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CADR TRIPLE)) (SETQ TYPE (QUOTE (\, (CAR TRIPLE)))) (QUOTE (\, (CADDR TRIPLE)))))))))))) (LIST TYPE (if VALUETYPE then (\WIN STREAM) (* ; "Skip sequence count") (COURIER.READ STREAM PROGRAM VALUETYPE) else (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.WRITE.ENVELOPE.ITEM
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:31 by bvm") (* ;;; "Writes a filing attribute value pair to STREAM.  ITEM is a list of two elements (TYPE VALUE)") (LET ((TYPE (CAR ITEM)) (VALUE (CADR ITEM)) VALUETYPE) (COURIER.WRITE STREAM (OR (FIXP TYPE) (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CAR TRIPLE)) (SETQ VALUETYPE (QUOTE (\, (CADDR TRIPLE)))) (QUOTE (\, (CADR TRIPLE))))))) (T (ERROR "Unknown Envelope Item Type" 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) (BodyType 17 LONGCARDINAL) (Status 1000 (INBASKET . STATUS))))
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)

(DECLARE%: EVAL@COMPILE

(RECORD FORWARD (ENVELOPE HEADINGS PARTS PARENT . MAP))
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS \COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN) (MAPCAR X (FUNCTION EVAL)))))

(PUTPROPS \NSMAIL.BODY.PART.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS) \NSMAIL.BODY.PART.TYPES))) (T (ERROR "Unknown body part type" (CAR ARGS)) (QUOTE IGNOREMACRO)))))
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES)
)


(FILESLOAD (SOURCE) LAFITEDECLS)


(FILESLOAD (LOADCOMP) NSMAIL)


(RPAQQ \NSMAIL.CONTENTS.TYPES ((\CT.NULL 0) (\CT.STANDARD.MESSAGE 4) (\CT.REPORT 6)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \CT.NULL 0)

(RPAQQ \CT.STANDARD.MESSAGE 4)

(RPAQQ \CT.REPORT 6)


(CONSTANTS (\CT.NULL 0) (\CT.STANDARD.MESSAGE 4) (\CT.REPORT 6))
)
DOCOPY 

(RPAQQ \NSMAIL.BODY.PART.TYPES ((HEADING 0) (VPFOLDER 1) (NSTEXTFILE 2) (VPDOCUMENT 3) (OTHERNSFILE 4) (MULTINATIONAL.NOTE 5) (IA5.NOTE 6) (PILOTFILE 7) (G3FAX 8) (TELETEX 9) (TELEX 10) (ISO6937.NOTE 11) (INTERPRESS 12)))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA)

(ADDTOVAR NLAML)

(ADDTOVAR LAMA NEW.INBASKET.CALL)
)
(PUTPROPS NEWNSMAIL COPYRIGHT ("Xerox Corporation" 1989 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (12380 13895 (\NS.NEW.READ.ENVELOPE.ITEM 12390 . 13155) (\NS.NEW.WRITE.ENVELOPE.ITEM 
13157 . 13893)) (14631 16309 (\NS.READ.HEADING.ATTRIBUTE 14641 . 15619) (\NS.WRITE.HEADING.ATTRIBUTE 
15621 . 16307)) (17196 18599 (\NSMAIL.READ.RNAME 17206 . 17764) (\NSMAIL.WRITE.RNAME 17766 . 18257) (
\NSMAIL.RNAME.LENGTH 18259 . 18597)) (18695 20769 (RNAME.TO.STRING 18705 . 18884) (X400.NAME.TO.STRING
 18886 . 20573) (EQUAL.RNAMES 20575 . 20767)) (20794 40694 (\NSMAIL.NEW.SEND.PARSE 20804 . 23178) (
\NSMAIL.CHECK.ENUMERATION 23180 . 24099) (\NSMAIL.NEW.SEND 24101 . 33237) (
\NSMAIL.NEW.INVALID.RECIPIENTS 33239 . 33820) (\NSMAIL.BUILD.HEADING 33822 . 35121) (
\NSMAIL.POST.BODY.PART 35123 . 36954) (\NSMAIL.NEW.PREPARE.ATTACHMENT 36956 . 38277) (
\NSMAIL.CHECK.ABORT 38279 . 38637) (\NSMAIL.NEW.FINDSERVER 38639 . 39694) (\NSMAIL.NEW.CHECKSERVER 
39696 . 40692)) (42644 83283 (\NSMAIL.NEW.AUTHENTICATE 42654 . 44139) (NEWNS.POLLNEWMAIL 44141 . 44456
) (NEWNS.OPENMAILBOX 44458 . 45142) (\NSMAIL.NEW.CHECK 45144 . 49574) (NEWNS.NEXTMESSAGE 49576 . 50070
) (NEWNS.RETRIEVEMESSAGE 50072 . 53936) (\NSMAIL.READ.BODY.PARTS 53938 . 59349) (\NSMAIL.COPY.IA5 
59351 . 60100) (\NSMAIL.COPY.NSTEXTFILE 60102 . 62251) (\NSMAIL.READ.HEADING 62253 . 64988) (
\NSMAIL.PARSE.ANNOTATION 64990 . 65724) (\NSMAIL.EMIT.ANNOTATION 65726 . 66994) (LA.TRIM.WHITESPACE 
66996 . 67118) (\NSMAIL.READ.FORWARDING 67120 . 68145) (\NSMAIL.NEW.PRINT.HEADING 68147 . 73771) (
\NSMAIL.NEW.PRINT.NAMES 73773 . 74749) (\NSMAIL.EMIT.FORWARDING 74751 . 76585) (\NSMAIL.GDATE 76587 . 
76703) (\NSMAIL.TRANSLATE.IP.MESSAGEID 76705 . 77252) (\NSMAIL.MAYBE.QUOTE 77254 . 77892) (NULL.NSNAME
 77894 . 78236) (\NSMAIL.HANDLE.DELIVERY.REPORT 78238 . 81269) (\NSMAIL.RECIPIENT.NAME 81271 . 81498) 
(NEW.INBASKET.CALL 81500 . 82124) (NEWNS.CLOSEMAILBOX 82126 . 82842) (\NSMAIL.NEW.LOGOFF 82844 . 83281
)) (83836 85335 (\NS.READ.ENVELOPE.ITEM 83846 . 84603) (\NS.WRITE.ENVELOPE.ITEM 84605 . 85333)))))
STOP
\ No newline at end of file
diff --git a/internal/library/NEWNSMAIL.LCOM b/internal/library/NEWNSMAIL.LCOM
deleted file mode 100644
index 1a3be385..00000000
Binary files a/internal/library/NEWNSMAIL.LCOM and /dev/null differ
diff --git a/internal/library/NEWNSMAIL.~2~ b/internal/library/NEWNSMAIL.~2~
deleted file mode 100644
index d299c587..00000000
--- a/internal/library/NEWNSMAIL.~2~
+++ /dev/null
@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "26-Sep-90 11:35:28" "{tigger/n}<tigger>lafite>sources>NEWNSMAIL;42" 86998  

      changes to%:  (VARS NEWNSMAILCOMS *NSMAIL-RETURN-CONTENTS* *NSMAIL-ALLOW-DL-RECIPIENTS* \NSMAIL.HEADING.ATTRIBUTES)
 (FNS \NSMAIL.NEW.PRINT.HEADING NULL.NSNAME \NSMAIL.READ.BODY.PARTS \NSMAIL.BUILD.HEADING \NSMAIL.GDATE \NSMAIL.EMIT.ANNOTATION \NSMAIL.NEW.CHECKSERVER \NSMAIL.HANDLE.DELIVERY.REPORT \NSMAIL.NEW.SEND \NSMAIL.NEW.FINDSERVER \NSMAIL.COPY.NSTEXTFILE \NSMAIL.EMIT.FORWARDING \NSMAIL.SKIP.LINES LA.TRIM.WHITESPACE \NSMAIL.TRANSLATE.IP.MESSAGEID \NSMAIL.MAYBE.QUOTE)
 (COURIERPROGRAMS NEW.MAILTRANSPORT)

      previous date%: " 4-Apr-90 17:42:21" "{tigger/n}<tigger>lafite>sources>NEWNSMAIL;20")


(* "
Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT NEWNSMAILCOMS)

(RPAQQ NEWNSMAILCOMS ((COURIERPROGRAMS NEW.MAILTRANSPORT NEW.INBASKET) (COMS (* ; "Courier type EnvelopeItem") (FNS \NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM) (VARS \NSMAIL.NEW.ENVELOPE.ITEM.TYPES) (PROP COURIERDEF NEW.ENVELOPE.ITEM)) (COMS (* ; "Courier type HeadingAttribute") (FNS \NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE) (VARS \NSMAIL.HEADING.ATTRIBUTES) (PROP COURIERDEF HEADING.ATTRIBUTE)) (COMS (* ; "Courier type RName") (FNS \NSMAIL.READ.RNAME \NSMAIL.WRITE.RNAME \NSMAIL.RNAME.LENGTH) (PROP COURIERDEF NEW.RNAME) (FNS RNAME.TO.STRING X400.NAME.TO.STRING EQUAL.RNAMES)) (COMS (* ; "Posting") (FNS \NSMAIL.NEW.SEND.PARSE \NSMAIL.CHECK.ENUMERATION \NSMAIL.NEW.SEND \NSMAIL.NEW.INVALID.RECIPIENTS \NSMAIL.BUILD.HEADING \NSMAIL.POST.BODY.PART \NSMAIL.NEW.PREPARE.ATTACHMENT \NSMAIL.CHECK.ABORT \NSMAIL.NEW.FINDSERVER \NSMAIL.NEW.CHECKSERVER) (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND (CCODEP (QUOTE \NSMAIL.NEW.SEND.PARSE)) (MOVD (QUOTE \NSMAIL.NEW.SEND.PARSE) (QUOTE \NSMAIL.SEND.PARSE) NIL T)))) (INITVARS (*USE-NEW-NSMAIL* T) (*NEWNSMAIL-POST-AS-TEXTFILE* :TEST) (*NEWNSMAIL-REPORT-TYPE* (QUOTE NON.DELIVERY.ONLY)) (*NSMAIL-ALLOW-DL-RECIPIENTS* T) (*NSMAIL-RETURN-CONTENTS* T) (*NSMAIL-MIN-WILLINGNESS* 9) (*NSMAIL-TRACE-SERVERS*) (*NSMAIL-GENERATE-MESSAGE-ID*) (*NSMAIL-DISPLAY-TRANSPORT-ID*) (*NSMAIL-DISPLAY-POSTMARK*) (*NSMAIL-DISPLAY-ERRORS-TO*) (*NSMAIL-CACHE-TIMEOUT* (TIMES 1000 60 60)) (\NSMAIL.MIN.VP.TYPE 4300) (\NSMAIL.MAX.VP.TYPE 5200) (\NSMAIL.NEW.SERVER.CACHE)) (GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *USE-NEW-NSMAIL* *NEWNSMAIL-POST-AS-TEXTFILE* *NEWNSMAIL-REPORT-TYPE* *NSMAIL-ALLOW-DL-RECIPIENTS* *NSMAIL-RETURN-CONTENTS* *NSMAIL-MIN-WILLINGNESS* *NSMAIL-TRACE-SERVERS* *NSMAIL-GENERATE-MESSAGE-ID* *NSMAIL-DISPLAY-TRANSPORT-ID* *NSMAIL-DISPLAY-POSTMARK* *NSMAIL-DISPLAY-ERRORS-TO* *NSMAIL-CACHE-TIMEOUT*))))) (COMS (* ; "Retrieving") (FNS \NSMAIL.NEW.AUTHENTICATE NEWNS.POLLNEWMAIL NEWNS.OPENMAILBOX \NSMAIL.NEW.CHECK NEWNS.NEXTMESSAGE NEWNS.RETRIEVEMESSAGE \NSMAIL.READ.BODY.PARTS \NSMAIL.COPY.IA5 \NSMAIL.COPY.NSTEXTFILE \NSMAIL.READ.HEADING \NSMAIL.PARSE.ANNOTATION \NSMAIL.EMIT.ANNOTATION LA.TRIM.WHITESPACE \NSMAIL.READ.FORWARDING \NSMAIL.NEW.PRINT.HEADING \NSMAIL.NEW.PRINT.NAMES \NSMAIL.EMIT.FORWARDING \NSMAIL.GDATE \NSMAIL.TRANSLATE.IP.MESSAGEID \NSMAIL.MAYBE.QUOTE NULL.NSNAME \NSMAIL.HANDLE.DELIVERY.REPORT \NSMAIL.RECIPIENT.NAME NEW.INBASKET.CALL NEWNS.CLOSEMAILBOX \NSMAIL.NEW.LOGOFF) (VARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS) (GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS) (ALISTS (LAFITEMODELST NS)) (P (LAFITEMODE (LAFITEMODE)) (COND ((AND *USE-NEW-NSMAIL* \LAFITE.ACTIVE) (* ; "recache") (LAFITECLEARCACHE))))) (COMS (* ; "Old ns mail") (FNS \NS.READ.ENVELOPE.ITEM \NS.WRITE.ENVELOPE.ITEM) (VARS \NSMAIL.ENVELOPE.ITEM.TYPES)) (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T) (RECORDS FORWARD) (MACROS \COMPUTED.FORM \NSMAIL.BODY.PART.TYPE) (GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES) (FILES (SOURCE) LAFITEDECLS) (FILES (LOADCOMP) NSMAIL) (CONSTANTS * \NSMAIL.CONTENTS.TYPES) (* ; "This one we need at run time also") DOCOPY (VARS \NSMAIL.BODY.PART.TYPES)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA NEW.INBASKET.CALL)))))

(COURIERPROGRAM NEW.MAILTRANSPORT (17 5)
    TYPES
      ((CREDENTIALS (AUTHENTICATION . CREDENTIALS)) (VERIFIER (AUTHENTICATION . VERIFIER)) (SESSION (RECORD (TOKEN (ARRAY 2 UNSPECIFIED)) (VERIFIER VERIFIER))) (ENVELOPE.ITEM.TYPE LONGCARDINAL) (ENVELOPE (SEQUENCE NEW.ENVELOPE.ITEM)) (INVALID.NAME (RECORD (ID CARDINAL) (REASON INVALID.REASON))) (INVALID.NAME.LIST (SEQUENCE INVALID.NAME)) (INVALID.REASON (ENUMERATION (NoSuchRecipient 0) (NoMailboxForRecipient 1) (IllegalName 2) (NoDlsAllowed 3) (ReportNotAllowed 4))) (NAME NSNAME) (RNAME NEW.RNAME (* ; "(choice (xns 0 name) (gateway 1 gateway.name))")) (RNAME.LIST (SEQUENCE RNAME)) (GATEWAY.NAME (RECORD (COUNTRY STRING) (ADMIN.DOMAIN STRING) (PRIVATE.DOMAIN STRING) (ORGANIZATION STRING) (ORGANIZATIONAL.UNITS (SEQUENCE STRING)) (PERSONAL (CHOICE (WHOLE 0 STRING) (BROKEN 1 BROKEN.NAME))) (GATEWAY.SPECIFIC.INFORMATION (SEQUENCE X400.ATTRIBUTE)))) (BROKEN.NAME (RECORD (GIVEN STRING) (INITIALS STRING) (FAMILY STRING) (GENERATION STRING))) (X400.ATTRIBUTE (RECORD (TYPE STRING) (VALUE STRING))) (REPORT.TYPE (ENUMERATION (NONE 0) (NON.DELIVERY.ONLY 1) (ALL 2))) (RECIPIENT (RECORD (NAME RNAME) (RECIPIENT.ID CARDINAL) (REPORT REPORT.TYPE))) (RECIPIENT.LIST (SEQUENCE RECIPIENT)) (WILLINGNESS (SEQUENCE WILLINGNESS.METRIC)) (WILLINGNESS.METRIC CARDINAL) (BODY.PART.TYPE LONGCARDINAL) (CONTENTS.TYPE LONGCARDINAL) (MESSAGEID (ARRAY 5 UNSPECIFIED)) (POSTING.DATA (RECORD (RECIPIENTS RECIPIENT.LIST) (CONTENTS.TYPE CONTENTS.TYPE) (CONTENTS.SIZE LONGCARDINAL) (BODY.PART.TYPES.SEQUENCE (SEQUENCE BODY.PART.TYPE)))) (POSTMARK (RECORD (POSTED.AT RNAME) (TIME TIME))) (TOC (SEQUENCE TOC.ITEM)) (TOC.ITEM (RECORD (TYPE BODY.PART.TYPE) (SIZE LONGCARDINAL))) (REPORT (RECORD (ORIGINAL.ENVELOPE ENVELOPE) (FATE (CHOICE (DELIVERED 0 (ENUMERATION (CONTENTS.TRUNCATED 0) (NO.PROBLEM 1))) (NOT.DELIVERED 1 (RECORD (REASON NON.DELIVERY.REASON) (POSTMARK POSTMARK))))) (REPORT.TYPE (CHOICE (DLMEMBER 0 DLREPORT) (OTHER 1 OTHER.REPORT))))) (DLREPORT (RECORD (DLNAME RNAME) (INVALID.RECIPIENTS (SEQUENCE NON.DELIVERED.RECIPIENT)))) (OTHER.REPORT (RECORD (SUCCEEDED (SEQUENCE DELIVERED.RECIPIENT)) (FAILED (SEQUENCE NON.DELIVERED.RECIPIENT)))) (DELIVERED.RECIPIENT (RECORD (RECIPIENT RECIPIENT) (WHEN TIME))) (NON.DELIVERED.RECIPIENT (RECORD (RECIPIENT RECIPIENT) (REASON NON.DELIVERY.REASON))) (NON.DELIVERY.REASON (ENUMERATION (NoSuchRecipient 0) (NoMailboxForRecipient 1) (IllegalName 2) (Timeout 3) (ReportNotAllowed 4) (MessageTooLong 5) (AmbiguousRName 6) (IllegalCharacters 7) (UnsupportedBodyParts 8) (UnsupportedContentsType 9) (TransientProblem 10) (ContentSyntaxError 11) (TooManyRecipients 12) (ProtocolViolation 13) (X400PragmaticConstraintViolation 14) (x400NoBilateralAgreement 15) (AccessRightsInsufficientForDL 16) (Other 17))) (TRANSPORT.OPTIONS (RECORD (RETURN.OF.CONTENTS BOOLEAN) (ALTERNATE.RECIPIENT.ALLOWED BOOLEAN))) (PRIORITY (ENUMERATION (NonUrgent 0) (Normal 1) (Urgent 2))) (CONVERTED.ITEM (ENUMERATION (IA5TextToTeletex 0) (TeletexToTelex 1) (TeletexToIA5Text 2) (TelexToTeletex 3))) (IP.MESSAGEID (RECORD (ORIGINATOR RNAME) (UNIQUESTRING STRING))) (AUTHENTICATION.LEVEL (ENUMERATION (Strong 0) (Simple 1) (Foreign 2))) (FORWARDED.MESSAGE.INFO (RECORD (ENVELOPE ENVELOPE) (HEADING (SEQUENCE HEADING.ATTRIBUTE)) (ASSOCIATED.BODY.PARTS (SEQUENCE BODY.PART.INDEX)) (INDEX.OF.PARENT.HEADING (CHOICE (NULL 0 (RECORD)) (NESTED 1 CARDINAL))))) (BODY.PART.INDEX CARDINAL) (SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0) (ServiceFull 1) (ServiceUnavailable 2) (MediumFull 3))) (TRANSFER.PROBLEM (ENUMERATION (Aborted 0))) (OTHER.PROBLEM (ENUMERATION (Can'tExpedite 0) (MalformedMessage 1) (IncorrectContentsSize 2) (LAST 65535))) (SESSION.PROBLEM (ENUMERATION (InvalidHandle 0) (WrongState 1))))
    PROCEDURES
      ((SERVER.POLL 0 NIL RETURNS (WILLINGNESS (CLEARINGHOUSE . NETWORK.ADDRESS.LIST) NAME)) (BEGIN.POST 1 (POSTING.DATA BOOLEAN BOOLEAN (SEQUENCE NEW.ENVELOPE.ITEM) CREDENTIALS VERIFIER) RETURNS (SESSION INVALID.NAME.LIST) REPORTS (AUTHENTICATION.ERROR INVALID.RECIPIENTS SERVICE.ERROR OTHER.ERROR)) (MAILPOLL 7 (NAME CREDENTIALS VERIFIER) RETURNS (BOOLEAN) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR)) (POST.ONE.BODY.PART 8 (SESSION BODY.PART.TYPE BULK.DATA.SOURCE) RETURNS NIL REPORTS (AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR SESSION.ERROR TRANSFER.ERROR)) (END.POST 9 (SESSION BOOLEAN) RETURNS (MESSAGEID) REPORTS (AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR SESSION.ERROR TRANSFER.ERROR)))
    ERRORS
      ((ACCESS.ERROR 0 (ACCESS.PROBLEM)) (AUTHENTICATION.ERROR 1 ((AUTHENTICATION . PROBLEM))) (INVALID.RECIPIENTS 3 (INVALID.NAME.LIST)) (SERVICE.ERROR 4 (SERVICE.PROBLEM)) (TRANSFER.ERROR 5 (TRANSFER.PROBLEM)) (OTHER.ERROR 6 (OTHER.PROBLEM)) (SESSION.ERROR 7 (SESSION.PROBLEM)))
)

(COURIERPROGRAM NEW.INBASKET (18 2)
    INHERITS
      (NEW.MAILTRANSPORT)
    TYPES
      ((CREDENTIALS (AUTHENTICATION . CREDENTIALS)) (VERIFIER (AUTHENTICATION . VERIFIER)) (NAME NSNAME) (INDEX LONGCARDINAL) (RANGE (RECORD (LOW INDEX) (HIGH INDEX))) (MESSAGE.STATUS (RECORD (USER.DEFINED.STATUS CARDINAL) (EXISTENCE.OF.MESSAGE (ENUMERATION (NEW 0) (KNOWN 1))))) (BODY.PART.SEQUENCE (SEQUENCE BODY.PART.INDEX)) (BODY.PART.STATUS (SEQUENCE BOOLEAN)) (BODY.PART.STATUS.CHANGE (RECORD (BODY.PART.INDEX BODY.PART.INDEX) (DELETABLE (ENUMERATION (TRUE 0) (NOCHANGE 1))))) (BODY.PART.STATUS.CHANGE.SEQUENCE (SEQUENCE BODY.PART.STATUS.CHANGE)) (STATUS (RECORD (MESSAGE.STATUS MESSAGE.STATUS) (BODY.PART.STATUS BODY.PART.STATUS))) (SESSION (RECORD (TOKEN (ARRAY 2 UNSPECIFIED)) (VERIFIER VERIFIER))) (ANCHOR (ARRAY 5 UNSPECIFIED)) (STATE (RECORD (NEW CARDINAL) (TOTAL CARDINAL))) (WHICH.MESSAGE (ENUMERATION (THIS 0) (NEXT 1))) (ACCESS.PROBLEM (ENUMERATION (AccessRightsInsufficient 0) (AccessRightsIndeterminate 1) (NoSuchInbasket 2) (InbasketIndeterminate 3) (WrongService 4))) (CONNECTION.PROBLEM (FILING . CONNECTION.PROBLEM)) (SERVICE.PROBLEM (ENUMERATION (CannotAuthenticate 0) (ServiceFull 1) (ServiceUnavailable 2))) (TRANSFER.PROBLEM (ENUMERATION (Aborted 0))) (SESSION.PROBLEM (ENUMERATION (TokenInvalid 0))) (OTHER.PROBLEM (ENUMERATION (USE.COURIER 0) (MalformedMessage 1) (InvalidOperation 2) (LAST 65535))) (INDEX.PROBLEM (ENUMERATION (InvalidIndex 0) (InvalidBodyPartIndex 1))))
    PROCEDURES
      ((LOGON 5 (NAME CREDENTIALS VERIFIER) RETURNS (SESSION STATE ANCHOR) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR INBASKET.IN.USE SERVICE.ERROR OTHER.ERROR)) (LOGOFF 4 (SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR SESSION.ERROR OTHER.ERROR)) (MAILPOLL 7 (NAME CREDENTIALS VERIFIER) RETURNS (STATE) REPORTS (ACCESS.ERROR AUTHENTICATION.ERROR SERVICE.ERROR OTHER.ERROR)) (MAILCHECK 6 (SESSION) RETURNS (STATE) REPORTS (AUTHENTICATION.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (RETRIEVE.ENVELOPES 2 (INDEX WHICH.MESSAGE SESSION) RETURNS (ENVELOPE STATUS INDEX)) (RETRIEVE.BODY.PARTS 8 (INDEX BODY.PART.SEQUENCE BULK.DATA.SINK SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR INDEX.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR TRANSFER.ERROR)) (CHANGE.MESSAGE.STATUS 0 (RANGE BOOLEAN CARDINAL SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR INDEX.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (CHANGE.BODY.PARTS.STATUS 3 (INDEX BODY.PART.STATUS.CHANGE.SEQUENCE SESSION) RETURNS (BOOLEAN) REPORTS (AUTHENTICATION.ERROR INDEX.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (DELETE 1 (RANGE SESSION) RETURNS NIL REPORTS (AUTHENTICATION.ERROR SESSION.ERROR SERVICE.ERROR OTHER.ERROR)) (GET.SIZE 10 (NAME CREDENTIALS VERIFIER) RETURNS (LONGCARDINAL) REPORTS (AUTHENTICATION.ERROR ACCESS.ERROR SERVICE.ERROR OTHER.ERROR)))
    ERRORS
      ((ACCESS.ERROR 0 (ACCESS.PROBLEM)) (AUTHENTICATION.ERROR 1 ((AUTHENTICATION . PROBLEM))) (SESSION.ERROR 5 (SESSION.PROBLEM)) (SERVICE.ERROR 6 (SERVICE.PROBLEM)) (TRANSFER.ERROR 7 (TRANSFER.PROBLEM)) (OTHER.ERROR 8 (OTHER.PROBLEM)) (INDEX.ERROR 9 (INDEX.PROBLEM)) (INBASKET.IN.USE 10 (NAME)))
)



(* ; "Courier type EnvelopeItem")

(DEFINEQ

(\NS.NEW.READ.ENVELOPE.ITEM
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:53 by bvm") (* ;; "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") (LET* ((TYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) (VALUETYPE (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.NEW.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CADR TRIPLE)) (SETQ TYPE (QUOTE (\, (CAR TRIPLE)))) (QUOTE (\, (CADDR TRIPLE)))))))))))) (LIST TYPE (if VALUETYPE then (\WIN STREAM) (* ; "Skip sequence count") (COURIER.READ STREAM PROGRAM VALUETYPE) else (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.NEW.WRITE.ENVELOPE.ITEM
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:53 by bvm") (* ;;; "Writes a filing attribute value pair to STREAM.  ITEM is a list of two elements (TYPE VALUE)") (LET ((TYPE (CAR ITEM)) (VALUE (CADR ITEM)) VALUETYPE) (COURIER.WRITE STREAM (OR (FIXP TYPE) (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.NEW.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CAR TRIPLE)) (SETQ VALUETYPE (QUOTE (\, (CADDR TRIPLE)))) (QUOTE (\, (CADR TRIPLE))))))) (T (ERROR "Unknown Envelope Item Type" 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.NEW.ENVELOPE.ITEM.TYPES ((Postmark 0 POSTMARK) (Message-ID 1 MESSAGEID) (ContentsType 2 CONTENTS.TYPE) (TOC 3 TOC) (CONTENTS.SIZE 4 LONGCARDINAL) (Originator 5 RNAME) (REPORT 6 REPORT) (RETURN.TO.NAME 7 RNAME) (Previous-Recipients 8 RECIPIENT.LIST) (GatewayPostmark 9 POSTMARK) (AddressChangeNotice 10 RNAME) (TRANSPORT.OPTIONS 11 TRANSPORT.OPTIONS) (X400SpecificReportInformation 12 (SEQUENCE (SEQUENCE UNSPECIFIED))) (OtherRecipients 13 RECIPIENT.LIST) (Priority 14 PRIORITY) (Converted 15 (SEQUENCE CONVERTED.ITEM)) (AuthenticationLevelOfSender 16 AUTHENTICATION.LEVEL)))

(PUTPROPS NEW.ENVELOPE.ITEM COURIERDEF (\NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM))



(* ; "Courier type HeadingAttribute")

(DEFINEQ

(\NS.READ.HEADING.ATTRIBUTE
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 25-Jan-90 16:59 by bvm") (* ;; "Reads a mail heading 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))) for X in \NSMAIL.HEADING.ATTRIBUTES when (EQ (CADR X) TYPE) do (RETURN (LIST* (CAR X) (LET* ((RANDP (RANDACCESSP STREAM)) (END (+ (UNFOLD (\WIN STREAM) BYTESPERWORD) (if RANDP then (GETFILEPTR STREAM) else 0))) HERE) (CONS (COURIER.READ STREAM (OR PROGRAM (QUOTE NEW.MAILTRANSPORT)) (CADDR X)) (if (AND RANDP (NOT (EQL (SETQ HERE (GETFILEPTR STREAM)) END))) then (if (> HERE END) then (HELP "Heading attribute overran by " (- HERE END)) else (to (- END HERE) collect (BIN STREAM)))))))) finally (* ; "TYPE not recognized") (RETURN (LIST TYPE (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.WRITE.HEADING.ATTRIBUTE
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 18:17 by bvm") (* ;;; "Writes a mail heading 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.HEADING.ATTRIBUTES when (EQ (CAR X) TYPE) do (SETQ TYPE (CADR X)) (SETQ VALUETYPE (CADDR X)) (RETURN) finally (ERROR "Unknown Heading Attribute 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.HEADING.ATTRIBUTES ((Message-ID 1 IP.MESSAGEID) (Sender 2 RNAME) (From 3 RNAME.LIST) (To 4 RNAME.LIST) (cc 5 RNAME.LIST) (bcc 6 RNAME.LIST) (In-Reply-to 7 IP.MESSAGEID) (Obsoletes 8 (SEQUENCE IP.MESSAGEID)) (References 9 (SEQUENCE IP.MESSAGEID)) (Subject 10 STRING) (Expiration-Date 11 TIME) (Reply-By 12 TIME) (Reply-to 13 RNAME.LIST) (Importance 14 (ENUMERATION (Low 0) (Normal 1) (High 2))) (Sensitivity 15 (ENUMERATION (Personal 0) (Private 1) (CompanyConfidential 2))) (Auto-Forwarded 16 BOOLEAN) (Immutable 17 (RECORD)) (Reply-Requested-of 18 RNAME.LIST) (TextAnnotation 19 STRING) (ForwardedHeadings 20 (SEQUENCE FORWARDED.MESSAGE.INFO)) (newTextAnnotation 199 STRING) (BodyOffset 198 LONGCARDINAL) (LispFormatting 4911 STRING)))

(PUTPROPS HEADING.ATTRIBUTE COURIERDEF (\NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE))



(* ; "Courier type RName")

(DEFINEQ

(\NSMAIL.READ.RNAME
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 29-Nov-89 12:53 by bvm") (* ;; "Special code to read newmailtransport.rname, whose definition is (choice (xns 0 name) (gateway 1 gateway.name)).  The xns name we return as an NSNAME object, all other types as if they had been read as the definition reads.") (LET ((CHOICE (\WIN STREAM))) (CASE CHOICE (0 (COURIER.READ.NSNAME STREAM PROGRAM (QUOTE NSNAME))) (1 (LIST (QUOTE GATEWAY) (COURIER.READ STREAM PROGRAM (QUOTE GATEWAY.NAME)))) (T (ERROR "Not a recognized type of RNAME" CHOICE)))))
)

(\NSMAIL.WRITE.RNAME
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 29-Nov-89 12:52 by bvm") (* ;; "Special code to write newmailtransport.rname.  ITEM can be an NSNAME or a list (GATEWAY gatewayname).") (if (TYPEP ITEM (QUOTE NSNAME)) then (\WOUT STREAM 0) (COURIER.WRITE.NSNAME STREAM ITEM PROGRAM (QUOTE NSNAME)) elseif (EQ (CAR (LISTP ITEM)) (QUOTE GATEWAY)) then (\WOUT STREAM 1) (COURIER.WRITE STREAM (CADR ITEM) PROGRAM (QUOTE GATEWAY.NAME)) else (ERROR "ARG not RNAME" ITEM)))
)

(\NSMAIL.RNAME.LENGTH
(LAMBDA (ITEM PROGRAM TYPE) (* ; "Edited 29-Nov-89 21:22 by bvm") (+ 1 (if (TYPEP ITEM (QUOTE NSNAME)) then (COURIER.NSNAME.LENGTH ITEM PROGRAM (QUOTE NSNAME)) elseif (EQ (CAR (LISTP ITEM)) (QUOTE GATEWAY)) then (COURIER.REP.LENGTH (CADR ITEM) PROGRAM (QUOTE GATEWAY.NAME)) else (ERROR "ARG not RNAME" ITEM))))
)
)

(PUTPROPS NEW.RNAME COURIERDEF (\NSMAIL.READ.RNAME \NSMAIL.WRITE.RNAME \NSMAIL.RNAME.LENGTH))
(DEFINEQ

(RNAME.TO.STRING
(LAMBDA (NAME FULLFLG) (* ; "Edited  4-Apr-90 17:26 by bvm") (CL:ETYPECASE NAME (NSNAME (NSNAME.TO.STRING NAME FULLFLG)) (LIST (X400.NAME.TO.STRING NAME))))
)

(X400.NAME.TO.STRING
(LAMBDA (NAME) (* ; "Edited  4-Apr-90 17:27 by bvm") (LET ((SLASH "/") TMP) (if (NEQ (CAR NAME) (QUOTE GATEWAY)) then (ERROR "ARG NOT X400 NAME" NAME) else (SETQ NAME (CADR NAME))) (CONCATLIST (BQUOTE ((\, SLASH) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) COUNTRY of NAME)) (LIST "C=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) ADMIN.DOMAIN of NAME)) (LIST "ADMD=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) PRIVATE.DOMAIN of NAME)) (LIST "PRMD=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) ORGANIZATION of NAME)) (LIST "O=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) ORGANIZATIONAL.UNITS of NAME)) (for UNIT in TMP join (LIST "OU=" UNIT SLASH)))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) PERSONAL of NAME)) (CASE (CAR TMP) (WHOLE (LIST "PN=" (CADR TMP) SLASH)) (BROKEN (LET ((BROKEN (CADR TMP))) (BQUOTE ((\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) GIVEN of BROKEN)) (LIST "G=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) INITIALS of BROKEN)) (LIST "I=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) FAMILY of BROKEN)) (LIST "S=" TMP SLASH))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . BROKEN.NAME) GENERATION of BROKEN)) (LIST "GQ=" TMP SLASH)))))))))) (\,. (AND (SETQ TMP (COURIER.FETCH (NEW.MAILTRANSPORT . GATEWAY.NAME) GATEWAY.SPECIFIC.INFORMATION of NAME)) (for PAIR in TMP join (LIST (CAR PAIR) "=" (CADR PAIR) SLASH)))))))))
)

(EQUAL.RNAMES
(LAMBDA (NAME1 NAME2) (* ; "Edited  4-Apr-90 17:21 by bvm") (if (type? NSNAME NAME1) then (AND (type? NSNAME NAME2) (EQUAL.CH.NAMES NAME1 NAME2)) else (EQUAL NAME1 NAME2)))
)
)



(* ; "Posting")

(DEFINEQ

(\NSMAIL.NEW.SEND.PARSE
(LAMBDA (MSG EDITORWINDOW) (* ; "Edited 24-Jan-90 16:36 by bvm") (PROG ((SENDER (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*)) RECIPIENTS MSGFIELDS FORMATTEDP HEADEREOF INTERESTINGFIELDS SUBJECT ATTACHMENT) (OR (SETQ MSGFIELDS (\LAFITE.PREPARE.SEND MSG EDITORWINDOW \LAPARSE.NSMAIL)) (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) (LET ((EXPANDED (for NAME in (CDR PAIR) join (if (CL:STRING= (fetch NSDOMAIN of NAME) ";") then (* ; "DL syntax") (\NSMAIL.EXPAND.DL (fetch NSOBJECT of NAME) SENDER EDITORWINDOW) else (LIST NAME))))) (SETQ RECIPIENTS (COND (RECIPIENTS (NS.REMOVEDUPLICATES (APPEND EXPANDED RECIPIENTS))) (T EXPANDED))))) (PROGN (* ; "Might want to check validity of From and Reply-to") NIL))) ((Subject In-Reply-to) (LET ((STR (COND ((CDDR PAIR) (* ; "Make one string") (CONCATLIST (CDR PAIR))) (T (CADR PAIR))))) (COND ((EQ (CAR PAIR) (QUOTE Subject)) (SETQ SUBJECT STR)) (*USE-NEW-NSMAIL* (* ; "format is different in new protocol") (SETQ STR (COURIER.CREATE (NEW.MAILTRANSPORT . IP.MESSAGEID) ORIGINATOR _ (create NSNAME NSOBJECT _ "" NSDOMAIN _ "" NSORGANIZATION _ "") UNIQUESTRING _ STR)))) (RPLACD PAIR STR) (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))) ((REFERENCE ATTACHMENT) (if ATTACHMENT then (\SENDMESSAGEFAIL EDITORWINDOW "Can only send a single attachment")) (SETQ ATTACHMENT T) (push INTERESTINGFIELDS PAIR)) ((Importance Sensitivity Immutable) (if (AND *USE-NEW-NSMAIL* (> (NCHARS (CADR PAIR)) 0) (SETQ PAIR (\NSMAIL.CHECK.ENUMERATION PAIR EDITORWINDOW))) then (push INTERESTINGFIELDS PAIR))) 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.CHECK.ENUMERATION
(LAMBDA (PAIR EDITORWINDOW) (* ; "Edited 24-Jan-90 16:35 by bvm") (LET* ((FIELD (CAR PAIR)) (VALUE (CADR PAIR)) (EXPECTED (CADDR (ASSOC FIELD \NSMAIL.HEADING.ATTRIBUTES))) FOUND) (if (EQ (CAR (LISTP EXPECTED)) (QUOTE ENUMERATION)) then (SETQ EXPECTED (CDR EXPECTED)) (if (SETQ FOUND (CL:ASSOC VALUE EXPECTED :TEST (QUOTE STRING-EQUAL))) then (CONS FIELD (CAR FOUND)) else (\SENDMESSAGEFAIL EDITORWINDOW (CL:FORMAT NIL "Field '~A' not understood--expected one of ~A" FIELD (CONCATLIST (CDR (for V in EXPECTED join (LIST ", " (CAR V)))))))) elseif (OR (STRING-EQUAL VALUE "True") (STRING-EQUAL VALUE "Yes") (STRING-EQUAL VALUE T)) then (* ; "Good.  Value is actually irrelevant") PAIR elseif (OR (STRING-EQUAL VALUE "False") (STRING-EQUAL VALUE "No")) then (* ; "Good, omit attribute") NIL else (\SENDMESSAGEFAIL EDITORWINDOW "Field 'Immutable' not understood--expected True or False"))))
)

(\NSMAIL.NEW.SEND
(LAMBDA (MSG PARSE EDITORWINDOW ABORTWINDOW) (* ; "Edited 29-Jun-90 16:04 by bvm") (* ;;; "MSG is the entire text of the message -- RECIPIENTS is a parsed list of recipients") (if (NOT *USE-NEW-NSMAIL*) then (\NSMAIL.SEND MSG PARSE EDITORWINDOW ABORTWINDOW) else (RESETLST (PROG* ((PWINDOW (AND EDITORWINDOW (GETPROMPTWINDOW EDITORWINDOW))) (RECIPIENTS (fetch NSPRECIPIENTS of PARSE)) (START (OR (fetch NSPSTART of PARSE) (GETEOFPTR MSG))) (MSGFIELDS (fetch NSPFIELDS of PARSE)) (CREDENTIALS (fetch (LAFITEMODEDATA CREDENTIALS) of *LAFITE-MODE-DATA*)) (ALLOW.DL.RECIPIENTS (OR *NSMAIL-ALLOW-DL-RECIPIENTS* (ASSOC (QUOTE Reply-to) MSGFIELDS))) USENSTEXTFILE FORMATSTREAM REFERENCE ATTACHMENT ATTACHMENT-TYPE ATTACHMENT-LENGTH ATTACHED-ATTRIBUTES BODYLENGTH COURIERSTREAM MAILDROP RESULTS HEADING SESSION ESTIMATED-SIZE PART-TYPES) (* ;; "Some day maybe try using the ALLOW.DL.RECIPIENTS feature.  Unfortunately, there are too many users in XNS who look like groups to the mail system for this to be very interesting.") (COND (PWINDOW (* ; "Make sure prompt window will expand as needed.  Probably generic sendmessage should do this") (RESETSAVE (TTYDISPLAYSTREAM PWINDOW)) (RESETSAVE (LINELENGTH T)))) (COND ((AND (fetch NSPFORMATTED of PARSE) (TEDIT.FORMATTEDFILEP MSG)) (* ; "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)") (CLOSEF MSG) (* ; "We're thru with this new textstream, let it clean up after itself.") (SETQ MSG (OPENSTREAM (CAR FORMATSTREAM) (QUOTE INPUT))) (SETQ FORMATSTREAM (OPENSTREAM (CDR FORMATSTREAM) (QUOTE INPUT))) (SETQ START 0)) ((AND (TEXTSTREAMP MSG) (TEDIT.FORMATTEDFILEP MSG)) (* ; "Message has formatting, but caller asked to send it as plain text.  Carefully coerce it, since TEDIT ns chars and image objects don't pass thru COPYBYTES very well") (SETQ MSG (LAFITE.MAKE.PLAIN.TEXTSTREAM MSG START)) (SETQ START 0))) (SETQ BODYLENGTH (- (GETEOFPTR MSG) START)) (if FORMATSTREAM then (* ; "Formatted messages can only go as text files for now, or else old clients can't receive them") (SETQ USENSTEXTFILE T) else (CASE *NEWNSMAIL-POST-AS-TEXTFILE* ((NIL) (* ; "Always send as note")) ((:TEST) (* ; "Send as note only if short enough (the default)") (if (> BODYLENGTH *NSMAIL-MAX-NOTE-LENGTH*) then (SETQ USENSTEXTFILE T))) (T (SETQ USENSTEXTFILE T)))) (SETQ REFERENCE (ASSOC (QUOTE REFERENCE) MSGFIELDS)) (SETQ ATTACHMENT (ASSOC (QUOTE ATTACHMENT) MSGFIELDS)) (if (OR REFERENCE ATTACHMENT) then (if ATTACHMENT then (* ; "We're going to send a whole file along with the message") (SETQ MSGFIELDS (DREMOVE ATTACHMENT MSGFIELDS)) (if (LISTP (SETQ ATTACHMENT (\NSMAIL.NEW.PREPARE.ATTACHMENT (CADR ATTACHMENT) EDITORWINDOW))) then (* ; "Not an ns file") (SETQ ATTACHMENT-TYPE (CDR (ASSOC (QUOTE BodyType) (SETQ ATTACHED-ATTRIBUTES (CDR ATTACHMENT))))) (SETQ ATTACHMENT (CAR ATTACHMENT)) (* ; "Length estimate: file length.  Actual length will be a little greater due to attributes.") (SETQ ATTACHMENT-LENGTH (GETEOFPTR ATTACHMENT)) else (* ; "NS serialized file") (SETQ ATTACHMENT-TYPE (GETFILEINFO ATTACHMENT (QUOTE FILETYPE))) (* ;; "To estimate length, ask server for stored size.  This is rounded up to nearest page, so we subtract lest we overestimate (grumble).  In directory case, it could be way off, though, due to rounding errors from lots of files.  It's either that or read the whole damn file into core.") (SETQ ATTACHMENT-LENGTH (- (GETFILEINFO ATTACHMENT (if (GETFILEINFO ATTACHMENT (QUOTE IS.DIRECTORY)) then (QUOTE SUBTREE.SIZE) else (QUOTE STORED.SIZE))) BYTESPERPAGE))) (SETQ ATTACHMENT-TYPE (CASE (\TYPE.FROM.FILETYPE ATTACHMENT-TYPE) (INTERPRESS (if NIL then (* ; "This way doesn't go thru the backward incompatibility module correctly.") (\NSMAIL.BODY.PART.TYPE INTERPRESS) else (\NSMAIL.BODY.PART.TYPE VPDOCUMENT))) (DIRECTORY (\NSMAIL.BODY.PART.TYPE VPFOLDER)) (TEXT (\NSMAIL.BODY.PART.TYPE NSTEXTFILE)) (T (if (AND (>= ATTACHMENT-TYPE \NSMAIL.MIN.VP.TYPE) (<= ATTACHMENT-TYPE \NSMAIL.MAX.VP.TYPE)) then (* ; "I assume everything in this range is a vpdocument") (\NSMAIL.BODY.PART.TYPE VPDOCUMENT) else (\NSMAIL.BODY.PART.TYPE OTHERNSFILE))))) elseif REFERENCE then (* ; "Just a Vp reference.  This is a null file with a special attribute giving the file name, etc") (SETQ MSGFIELDS (DREMOVE REFERENCE MSGFIELDS)) (SETQ ATTACHED-ATTRIBUTES (LIST (CONSTANT (CONS (QUOTE BodyType) \NSMAIL.REFERENCE.BODYTYPE)) (RPLACD REFERENCE (\NSMAIL.PARSE.REFERENCE (CADR REFERENCE) EDITORWINDOW)))) (SETQ ATTACHMENT-TYPE (\NSMAIL.BODY.PART.TYPE VPDOCUMENT))) (SETQ PART-TYPES (LIST ATTACHMENT-TYPE))) (if USENSTEXTFILE then (push PART-TYPES (\NSMAIL.BODY.PART.TYPE NSTEXTFILE)) elseif (> BODYLENGTH 0) then (push PART-TYPES (\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE))) (SETQ HEADING (\NSMAIL.BUILD.HEADING MSGFIELDS (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*))) (SETQ RECIPIENTS (for R in RECIPIENTS as I from 1 collect (COURIER.CREATE (NEW.MAILTRANSPORT . RECIPIENT) NAME _ R RECIPIENT.ID _ I REPORT _ (OR *NEWNSMAIL-REPORT-TYPE* (QUOTE NON.DELIVERY.ONLY))))) (COND (PWINDOW (CLEARW PWINDOW) (LET ((TYPE (if REFERENCE then (\TYPE.FROM.FILETYPE (CADR (ASSOC (QUOTE TYPE) (CDR REFERENCE)))) elseif ATTACHMENT-TYPE then (for PAIR in \NSMAIL.BODY.PART.TYPES when (EQL ATTACHMENT-TYPE (CADR PAIR)) do (RETURN (CAR PAIR)))))) (CL:FORMAT PWINDOW "Delivering ~:[~;formatted ~]~@[with ~A ~]~@[~A ~]to ~D recipient~:P" FORMATSTREAM (AND TYPE (CL:STRING-CAPITALIZE (MKSTRING TYPE))) (COND (REFERENCE "reference") (ATTACHMENT "attachment")) (LENGTH RECIPIENTS))))) (SETQ ESTIMATED-SIZE (PROGN (* ;; "@##!@ protocol demands that you tell the size of the message almost exactly.  Specifically, size estimate must not be too large (!), and not be more than 5000 bytes too small.  That almost means you have to buffer the whole message before you start.  We are lazy here and hope that serialization overhead and file server size estimates don't screw us up.") (+ (GETEOFPTR HEADING) BODYLENGTH (if FORMATSTREAM then (* ; "This plus a few more bytes of serialized file encoding") (GETEOFPTR FORMATSTREAM) else 0) (OR ATTACHMENT-LENGTH 0)))) (COND ((NULL (SETQ MAILDROP (\NSMAIL.NEW.FINDSERVER ESTIMATED-SIZE))) (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 NEW.MAILTRANSPORT) (QUOTE BEGIN.POST) (COURIER.CREATE (NEW.MAILTRANSPORT . POSTING.DATA) RECIPIENTS _ RECIPIENTS CONTENTS.TYPE _ \CT.STANDARD.MESSAGE CONTENTS.SIZE _ ESTIMATED-SIZE BODY.PART.TYPES.SEQUENCE _ (CONS (\NSMAIL.BODY.PART.TYPE HEADING) PART-TYPES)) NIL ALLOW.DL.RECIPIENTS (AND *NSMAIL-RETURN-CONTENTS* (QUOTE ((TRANSPORT.OPTIONS (T T))))) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (COND ((EQ (CAR (LISTP RESULTS)) (QUOTE ERROR)) (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (SELECTQ (CADR RESULTS) (INVALID.RECIPIENTS (\NSMAIL.NEW.INVALID.RECIPIENTS (CADDR RESULTS) RECIPIENTS)) (MKSTRING (CDR RESULTS))))))) (* ;; "RESULTS = (session invalid-recipients)") (SETQ SESSION (CAR RESULTS)) (if (SETQ RESULTS (CADR RESULTS)) then (* ; "Some were invalid.  I think we don't get any here because we didn't say to post anyway.") (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (\NSMAIL.NEW.INVALID.RECIPIENTS RESULTS RECIPIENTS)))) (* ;; "Now post body parts") (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION) (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION (\NSMAIL.BODY.PART.TYPE HEADING) HEADING 0 EDITORWINDOW) (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION) (if USENSTEXTFILE then (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION (\NSMAIL.BODY.PART.TYPE NSTEXTFILE) MSG START EDITORWINDOW (BQUOTE ((BodyType (\,@ \NSMAIL.TEXT.BODYTYPE)) (\,@ (AND FORMATSTREAM (BQUOTE ((LispFormatting (\,@ FORMATSTREAM))))))))) elseif (> BODYLENGTH 0) then (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION (\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE) MSG START EDITORWINDOW)) (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION) (if ATTACHMENT-TYPE then (\NSMAIL.POST.BODY.PART COURIERSTREAM SESSION ATTACHMENT-TYPE ATTACHMENT NIL EDITORWINDOW ATTACHED-ATTRIBUTES) (\NSMAIL.CHECK.ABORT ABORTWINDOW COURIERSTREAM SESSION)) (if ABORTWINDOW then (* ; "Too late to abort now") (DELETEMENU (CAR (WINDOWPROP ABORTWINDOW (QUOTE MENU))) NIL ABORTWINDOW)) (SETQ RESULTS (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE END.POST) SESSION NIL (QUOTE RETURNERRORS))) (if (EQ (CAR (LISTP RESULTS)) (QUOTE ERROR)) then (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW (MKSTRING (CDR RESULTS))))) (AND NSMAILDEBUGFLG (printout PROMPTWINDOW T "EndPost results: " RESULTS)) (RETURN (LENGTH RECIPIENTS))))))
)

(\NSMAIL.NEW.INVALID.RECIPIENTS
(LAMBDA (INVALID.NAME.LIST RECIPIENTS) (* ; "Edited 19-Dec-89 13:00 by bvm") (* ;; "INVALID.NAME.LIST = Sequence (id reason).  id is 1-based.") (if (CDR INVALID.NAME.LIST) then (CONCAT "Invalid recipients: " (SUBSTRING (for PAIR in INVALID.NAME.LIST collect (LIST (COURIER.FETCH (NEW.MAILTRANSPORT . RECIPIENT) NAME of (CAR (NTH RECIPIENTS (CAR PAIR)))) (CADR PAIR))) 2 -2)) else (DESTRUCTURING-BIND (ID REASON) (CAR INVALID.NAME.LIST) (CONCAT (COURIER.FETCH (NEW.MAILTRANSPORT . RECIPIENT) NAME of (CAR (NTH RECIPIENTS ID))) " -- " REASON))))
)

(\NSMAIL.BUILD.HEADING
(LAMBDA (MSGFIELDS SENDER) (* ; "Edited 11-Jul-90 18:03 by bvm") (* ;; "Build a heading body part, which is a sequence of attribute.  Return a stream") (LET ((S (OPENSTREAM "{nodircore}" (QUOTE BOTH))) (COUNT 2)) (SETFILEPTR S 2) (* ; "Save space for the sequence count") (COND ((ASSOC (QUOTE From) MSGFIELDS) (* ; "Identify actual sender (single name here)") (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE Sender) SENDER) (QUOTE NEW.MAILTRANSPORT))) (T (* ; "Identify sender as the sole %"From%" name") (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE From) (LIST SENDER)) (QUOTE NEW.MAILTRANSPORT)))) (for PAIR in MSGFIELDS do (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (CAR PAIR) (CDR PAIR)) (QUOTE NEW.MAILTRANSPORT)) (add COUNT 1)) (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE TextAnnotation) (CONCAT "Date: " (DATE (DATEFORMAT TIME.ZONE SPACES DAY.OF.WEEK)) LAFITEEOL)) (QUOTE NEW.MAILTRANSPORT)) (* ; "Send the Date with time zone, as Cedar does") (if *NSMAIL-GENERATE-MESSAGE-ID* then (\NS.WRITE.HEADING.ATTRIBUTE S (LIST (QUOTE Message-ID) (COURIER.CREATE (NEW.MAILTRANSPORT . IP.MESSAGEID) ORIGINATOR _ (fetch UNPACKEDUSERNAME of *LAFITE-MODE-DATA*) UNIQUESTRING _ (DATE (DATEFORMAT TIME.ZONE)))) (QUOTE NEW.MAILTRANSPORT)) (add COUNT 1)) (SETFILEPTR S 0) (\WOUT S COUNT) S))
)

(\NSMAIL.POST.BODY.PART
(LAMBDA (COURIERSTREAM SESSION TYPE PARTSTREAM START EDITORWINDOW ATTRIBUTES) (* ; "Edited  8-Mar-90 12:14 by bvm") (LET ((RESULTS (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE POST.ONE.BODY.PART) SESSION TYPE (FUNCTION (LAMBDA (BULKSTREAM) (if ATTRIBUTES then (* ; "Create a serialized file on the fly") (COURIER.WRITE BULKSTREAM \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL)) (* ; "version.  Next comes Sequence Attribute") (\WOUT BULKSTREAM (LENGTH ATTRIBUTES)) (for PAIR in ATTRIBUTES do (if (EQ (CAR PAIR) (QUOTE LispFormatting)) then (* ; "Do this special so we don't have to cons an enormous string") (\NSMAIL.SEND.STREAM.AS.STRING (CDR PAIR) BULKSTREAM 0 (\NSMAIL.ATTRIBUTE.TYPE LispFormatting)) else (\NSMAIL.WRITE.ATTRIBUTE BULKSTREAM (CAR PAIR) (CDR PAIR)))) (* ;; "Next comes StreamOfUnspecified, then lastByteIsSignificant") (if PARTSTREAM then (COURIER.WRITE BULKSTREAM (COURIER.WRITE.STREAM.UNSPECIFIED BULKSTREAM PARTSTREAM (OR START 0) -1) NIL (QUOTE BOOLEAN)) else (* ; "no content") (\WOUT BULKSTREAM 1) (* ; "Last segment") (\WOUT BULKSTREAM 0) (* ; "Empty sequence") (\WOUT BULKSTREAM 1) (* ; "Last Byte is Significant = Byte Length is Even.")) (\WOUT BULKSTREAM 0) (* ; "no children") else (* ; "PARTSTREAM is already in proper format, just send it") (if START then (SETFILEPTR PARTSTREAM START)) (COPYBYTES PARTSTREAM BULKSTREAM)) (* ; "return NIL so caller can see return value") NIL)) (QUOTE RETURNERRORS)))) (if (EQ (CAR RESULTS) (QUOTE ERROR)) then (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE END.POST) SESSION T (QUOTE RETURNERRORS)) (* ; "Abort the post") (\LAFITE.SEND.FAIL EDITORWINDOW (CL:FORMAT NIL "Failed to post ~A because: ~A" (CAR (find TYP in \NSMAIL.BODY.PART.TYPES suchthat (EQ (CADR TYP) TYPE))) (CDR RESULTS))) (ERROR!))))
)

(\NSMAIL.NEW.PREPARE.ATTACHMENT
(LAMBDA (FILE EDITORWINDOW) (* ; "Edited 19-Dec-89 11:38 by bvm") (LET* ((HOST (UNPACKFILENAME.STRING FILE (QUOTE HOST))) (SERIALIZED (STRPOS ":" HOST)) BODYTYPE) (CL:MULTIPLE-VALUE-BIND (STREAM CONDITION) (IGNORE-ERRORS (if SERIALIZED then (\NSFILING.GETFILE (\GETDEVICEFROMHOSTNAME (MKATOM (U-CASE HOST))) FILE (QUOTE SERIALIZE) (QUOTE OLD) NIL NIL T) else (OPENSTREAM FILE (QUOTE INPUT)))) (if (NULL STREAM) then (\LAFITE.SEND.FAIL EDITORWINDOW (OR CONDITION "Attachment not found.")) (ERROR!)) (RESETSAVE NIL (LIST (FUNCTION CLOSEF) STREAM)) (if SERIALIZED then (* ; "Easy case") STREAM else (* ; "Not on an NS server, let's investigate the type") (CASE (SETQ BODYTYPE (\FILETYPE.FROM.TYPE (GETFILEINFO STREAM (QUOTE TYPE)))) ((NIL 0) (* ; "Under specified") (if (SETQ BODYTYPE (\NSMAIL.GUESS.FILE.TYPE (FULLNAME STREAM))) then (SETQ BODYTYPE (\FILETYPE.FROM.TYPE BODYTYPE)) elseif (\SENDMESSAGE.MENUPROMPT EDITORWINDOW (\LAFITE.CREATE.MENU (QUOTE (("Send as BINARY attachment" T) ("Abort" NIL))) "Send attachment?") "Warning: Type of attached file is unknown; most mail clients can't do anything interesting with this.") then (SETQ BODYTYPE 0) else (ERROR!)))) (CONS STREAM (BQUOTE ((BodyType (\,@ BODYTYPE)) (MODIFIED.ON (\,@ (GETFILEINFO STREAM (QUOTE ICREATIONDATE)))))))))))
)

(\NSMAIL.CHECK.ABORT
(LAMBDA (ABORTWINDOW COURIERSTREAM SESSION) (* ; "Edited 28-Nov-89 15:06 by bvm") (* ;; "Abort a post if user has pressed Abort") (COND ((AND ABORTWINDOW (WINDOWPROP ABORTWINDOW (QUOTE ABORT))) (* ; "Abort the post") (COURIER.CALL COURIERSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE END.POST) SESSION T (QUOTE RETURNERRORS)) (ERROR!))))
)

(\NSMAIL.NEW.FINDSERVER
(LAMBDA (ESTIMATED-SIZE) (* ; "Edited 25-Jun-90 16:02 by bvm") (PROG (INFO) (if (AND (CDR \NSMAIL.NEW.SERVER.CACHE) (NOT (TIMEREXPIRED? (CAR \NSMAIL.NEW.SERVER.CACHE)))) then (if (SETQ INFO (find ADDR in (CDR \NSMAIL.NEW.SERVER.CACHE) suchthat (\NSMAIL.NEW.CHECKSERVER (COURIER.EXPEDITED.CALL ADDR \NSMAIL.SOCKET (QUOTE NEW.MAILTRANSPORT) (QUOTE SERVER.POLL) (QUOTE RETURNERRORS)) ESTIMATED-SIZE))) then (RETURN INFO)) else (* ;; "Cache nonexistent or timed out, so refigure from scratch.  We like to time out the cache periodically so that we don't permanently latch on to some distant server when local ones are flaky.") (SETQ \NSMAIL.NEW.SERVER.CACHE (LIST (SETUPTIMER *NSMAIL-CACHE-TIMEOUT* (CAR \NSMAIL.NEW.SERVER.CACHE))))) (* ;; "Ask around for a server") (COND ((SETQ INFO (COURIER.BROADCAST.CALL \NSMAIL.SOCKET (QUOTE NEW.MAILTRANSPORT) (QUOTE SERVER.POLL) NIL (FUNCTION (LAMBDA (RESULT) (\NSMAIL.NEW.CHECKSERVER RESULT ESTIMATED-SIZE))) NSMAIL.NET.HINT)) (push (CDR \NSMAIL.NEW.SERVER.CACHE) INFO))) (RETURN INFO)))
)

(\NSMAIL.NEW.CHECKSERVER
(LAMBDA (POLLRESULT ESTIMATED-SIZE) (* ; "Edited 29-Jun-90 17:57 by bvm") (* ;; "Checks that the result of a SERVER.POLL is useful for sending a message of size ESTIMATED-SIZE.  Returns the server's address") (* ;; "POLLRESULT = (willingness network.address.list name)") (LET ((WILLINGNESS (CAR POLLRESULT)) (SIZE (OR ESTIMATED-SIZE 4000))) (* ; "The i'th element of willingness defines the server's willingness to accept messages up to size 8^i.") (if (AND (LISTP WILLINGNESS) (for W in WILLINGNESS as (I _ 8) by (LLSH I 3) while (> I SIZE) always (>= W *NSMAIL-MIN-WILLINGNESS*))) then (PROG ((BESTADDRESS (CAR (SORT.NSADDRESSES.BY.DISTANCE (CADR POLLRESULT))))) (SELECTQ *NSMAIL-TRACE-SERVERS* (NIL NIL) (:ASK (if (NOT (EQ (QUOTE Y) (ASKUSER 30 (QUOTE Y) (LIST "Use posting server" (CADDR POLLRESULT) (LIST BESTADDRESS)) NIL T))) then (RETURN NIL))) (PRINTOUT PROMPTWINDOW T "Using posting server " (CADDR POLLRESULT) " = " BESTADDRESS)) (RETURN BESTADDRESS)))))
)
)

(RPAQQ NSMAIL.PARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT) ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE) ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT) ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance) ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity) ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))

(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(AND (CCODEP (QUOTE \NSMAIL.NEW.SEND.PARSE)) (MOVD (QUOTE \NSMAIL.NEW.SEND.PARSE) (QUOTE \NSMAIL.SEND.PARSE) NIL T))
)

(RPAQ? *USE-NEW-NSMAIL* T)

(RPAQ? *NEWNSMAIL-POST-AS-TEXTFILE* :TEST)

(RPAQ? *NEWNSMAIL-REPORT-TYPE* (QUOTE NON.DELIVERY.ONLY))

(RPAQ? *NSMAIL-ALLOW-DL-RECIPIENTS* T)

(RPAQ? *NSMAIL-RETURN-CONTENTS* T)

(RPAQ? *NSMAIL-MIN-WILLINGNESS* 9)

(RPAQ? *NSMAIL-TRACE-SERVERS*)

(RPAQ? *NSMAIL-GENERATE-MESSAGE-ID*)

(RPAQ? *NSMAIL-DISPLAY-TRANSPORT-ID*)

(RPAQ? *NSMAIL-DISPLAY-POSTMARK*)

(RPAQ? *NSMAIL-DISPLAY-ERRORS-TO*)

(RPAQ? *NSMAIL-CACHE-TIMEOUT* (TIMES 1000 60 60))

(RPAQ? \NSMAIL.MIN.VP.TYPE 4300)

(RPAQ? \NSMAIL.MAX.VP.TYPE 5200)

(RPAQ? \NSMAIL.NEW.SERVER.CACHE)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE)
)

(CL:PROCLAIM (QUOTE (CL:SPECIAL *USE-NEW-NSMAIL* *NEWNSMAIL-POST-AS-TEXTFILE* *NEWNSMAIL-REPORT-TYPE* *NSMAIL-ALLOW-DL-RECIPIENTS* *NSMAIL-RETURN-CONTENTS* *NSMAIL-MIN-WILLINGNESS* *NSMAIL-TRACE-SERVERS* *NSMAIL-GENERATE-MESSAGE-ID* *NSMAIL-DISPLAY-TRANSPORT-ID* *NSMAIL-DISPLAY-POSTMARK* *NSMAIL-DISPLAY-ERRORS-TO* *NSMAIL-CACHE-TIMEOUT*)))



(* ; "Retrieving")

(DEFINEQ

(\NSMAIL.NEW.AUTHENTICATE
(LAMBDA NIL (* ; "Edited  4-Apr-90 17:26 by bvm") (LET ((INFO (\INTERNAL/GETPASSWORD (QUOTE |NS::|))) NSUSERNAME FULLNAME MSERVERS AUTHENTICATED? CREDENTIALS MSG) (SETQ NSUSERNAME (PARSE.NSNAME (CAR INFO))) (COND ((NEQ (SETQ AUTHENTICATED? (COND ((NULL (SETQ FULLNAME (CH.LOOKUP.OBJECT NSUSERNAME))) (QUOTE NONE)) (T (NS.AUTHENTICATE (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS (CONS FULLNAME (CDR INFO)))))))) T) (printout PROMPTWINDOW T "Cannot authenticate user " (RNAME.TO.STRING (OR FULLNAME NSUSERNAME) T) " because: " (SELECTQ (SETQ \LAFITE.AUTHENTICATION.FAILURE AUTHENTICATED?) (CredentialsInvalid "Login incorrect") (KeysUnavailable (CONCAT "Authentication server unavailable for domain " (fetch NSDOMAIN of FULLNAME))) (NONE "No such user") AUTHENTICATED?) ".") NIL) (T (create LAFITEMODEDATA FULLUSERNAME _ (RNAME.TO.STRING FULLNAME T) UNPACKEDUSERNAME _ FULLNAME CREDENTIALS _ CREDENTIALS SHORTUSERNAME _ (CONCAT (fetch NSOBJECT of FULLNAME) (QUOTE %:) (COND ((NOT (STRING-EQUAL (fetch NSDOMAIN of FULLNAME) CH.DEFAULT.DOMAIN)) (fetch NSDOMAIN of FULLNAME)) (T ""))) MAILSERVERS _ (LET ((SERVERS (\NSMAIL.MAKE.MAILSERVERS (NS.FINDMAILBOXES FULLNAME) FULLNAME CREDENTIALS))) (if *USE-NEW-NSMAIL* then (for S in SERVERS do (replace MAILSERVEROPS of S with (CONSTANT (LIST (FUNCTION NEWNS.POLLNEWMAIL) (FUNCTION NEWNS.OPENMAILBOX) (FUNCTION NEWNS.NEXTMESSAGE) (FUNCTION NEWNS.RETRIEVEMESSAGE) (FUNCTION NEWNS.CLOSEMAILBOX)))))) SERVERS))))))
)

(NEWNS.POLLNEWMAIL
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER) (* ; "Edited 18-Dec-89 18:59 by bvm") (LET ((RESULT (\NSMAIL.NEW.CHECK ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER))) (COND ((OR (NOT RESULT) (EQ (CAR RESULT) (QUOTE ERROR))) (* ; "Server down") (QUOTE ?)) ((NEQ RESULT 0) RESULT))))
)

(NEWNS.OPENMAILBOX
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER) (* ; "Edited 18-Dec-89 18:59 by bvm") (LET ((STREAM (\NSMAIL.COURIER.OPEN ADDRESS)) NSMAILSTATE N) (COND ((NULL STREAM) NIL) ((OR (NULL (SETQ N (\NSMAIL.NEW.CHECK ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM T))) (EQ (CAR N) (QUOTE ERROR))) (CLOSEF STREAM) (* ; "Return error msg") (CONS NIL (CDR N))) ((EQ (PROGN (SETQ NSMAILSTATE (fetch MAILSTATE of MAILSERVER)) N) 0) (\NSMAIL.NEW.LOGOFF NSMAILSTATE STREAM) (QUOTE EMPTY)) (T (* ; "Return (MAILBOX  . properties)") (CONS (create NSMAILBOX NSMAILSTREAM _ STREAM NSMAILLASTINDEX _ 0 NSMAILSTATE _ NSMAILSTATE) (LIST (QUOTE %#OFMESSAGES) N))))))
)

(\NSMAIL.NEW.CHECK
(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS) (* ; "Edited  5-Jan-90 19:21 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)) (STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER)) SESSION POLLRESULT TIMER) (COND ((AND NIL JUSTCHECKING (SETQ TIMER (fetch STATETIMER of STATE)) (TIMEREXPIRED? TIMER) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) (* ; "Some mailboxes moved") (GO FAILFAST))) (SETQ SESSION (fetch STATESESSION of STATE)) RETRY (COND ((NULL SESSION) (if JUSTCHECKING then (* ; "Just polling, don't need session") (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILPOLL) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (GO GOTRESULT)) (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 (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGON) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS)))) (QUOTE ERROR)) (GO ERROR))) (* ; "result = (session state anchor)") (SETQ POLLRESULT (CADR SESSION)) (replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION)))) (T (SETQ POLLRESULT (COND ((NULL STREAM) (* ; "Just checking") (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))) (T (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))))))) GOTRESULT (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 NIL) (replace STATEOLDLAST of STATE with NIL) (GO RETRY)) (T (SETQ SESSION POLLRESULT) (GO ERROR))))) (replace STATELASTERROR of STATE with NIL) (replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL) (RETURN (COURIER.FETCH (NEW.INBASKET . STATE) TOTAL of POLLRESULT)) ERROR (if (AND (NOT (EQUAL (CDR SESSION) (QUOTE (CONNECTION.PROBLEM NoResponse)))) (NOT (EQUAL (CDR SESSION) (fetch STATELASTERROR of STATE)))) then (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.") (replace STATELASTERROR of STATE with (CDR SESSION)) (LET ((ERRMSG (CASE (CADR SESSION) ((REJECT) (* ; "3rd element = reject reason") (LET* ((REASON (CADDR SESSION)) (TYPE (CAR REASON))) (if (AND (EQ TYPE (QUOTE WrongVersionOfService)) (<= (CAADR REASON) 1) (< (CADADR REASON) 2)) then (* ; "Server supports old inbasket, but not new") (PRINTOUT PROMPTWINDOW T T "****Note: " (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) " does not support new mail protocols." T "Setting *USE-NEW-NSMAIL* to NIL and trying again...") (SETQ *USE-NEW-NSMAIL* NIL) (SETQ \LAFITE.ACTIVE.MODES NIL) (LET ((POS (STKPOS (QUOTE POLLNEWMAIL)))) (if POS then (* ; "Tell mail watcher to start over") (RETFROM POS 0 T))) (if (NOT RETURNERRORS) then (RETURN NIL))) TYPE)) ((SERVICE.ERROR ACCESS.ERROR) (* ; "the specific reason is just as informative, and more readable than the whole error.") (CADDR SESSION)) (T (COND (NSWIZARDFLG (HELP SESSION))) (SUBSTRING (CDR SESSION) 2 -2))))) (if RETURNERRORS then (RETURN (CONS (QUOTE ERROR) ERRMSG)) elseif (AND (EQ ERRMSG (QUOTE NoSuchInbasket)) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) then (* ;; "We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately") (replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0) else (LET ((*PRINT-CASE* :UPCASE)) (* ; "Lousy atomic error names...") (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A" (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) (CASE ERRMSG (NoSuchService "Mail service not running") (T ERRMSG))))))) FAILFAST (RETURN NIL))))
)

(NEWNS.NEXTMESSAGE
(LAMBDA (MAILBOX) (* ; "Edited 13-Dec-89 17:27 by bvm") (LET ((NEXT (NEW.INBASKET.CALL MAILBOX (QUOTE RETRIEVE.ENVELOPES) (fetch NSMAILLASTINDEX of MAILBOX) (QUOTE NEXT) (fetch NSMAILSESSION of MAILBOX)))) (* ;; "NEXT = (envelope status index)") (DESTRUCTURING-BIND (ENVELOPE STATUS INDEX) NEXT (if (EQ INDEX 0) then (* ; "No more messages") NIL else (replace NSMAILLASTINDEX of MAILBOX with INDEX) (replace NSMAILENVTAIL of MAILBOX with ENVELOPE) (* ; "Success") T))))
)

(NEWNS.RETRIEVEMESSAGE
(LAMBDA (MAILBOX MSGOUTFILE) (* ; "Edited 16-Jan-90 15:43 by bvm") (DECLARE (SPECVARS *ATTACHMENTS* *DISCARDED-PARTS* *ENVELOPE* *FORMAT-STREAM* *HAVE-ATTACHMENTS* *HEADER-EOF* *MSGSTREAM* *RETRIEVAL-ERROR* *TABLE-OF-CONTENTS*)) (* ; "For the bulk data fn") (PROG* ((*RETRIEVAL-ERROR* NIL) (INDEX (fetch NSMAILLASTINDEX of MAILBOX)) (*ENVELOPE* (fetch NSMAILENVTAIL of MAILBOX)) (*TABLE-OF-CONTENTS* (CADR (ASSOC (QUOTE TOC) *ENVELOPE*))) (*MSGSTREAM* MSGOUTFILE) (HERE 0) *DISCARDED-PARTS* *HAVE-ATTACHMENTS* *ATTACHMENTS* *FORMAT-STREAM* *HEADER-EOF* PARTS-TO-RETRIEVE RESULT REPORT) (for PAIR in *TABLE-OF-CONTENTS* bind OTHER do (if (FMEMB (CAR PAIR) \NSMAIL.GOOD.BODY.PARTS) then (* ; "we read this fine") elseif (SETQ OTHER (ASSOC (CAR PAIR) \NSMAIL.DISCARDABLE.BODY.PARTS)) then (push *DISCARDED-PARTS* OTHER) else (* ; "Will need to arrange for an attachment") (SETQ *HAVE-ATTACHMENTS* T))) (if (NOT *HAVE-ATTACHMENTS*) then (* ; "Write directly to MSGOUTFILE.  Note where we are in case we have to retry") (SETQ HERE (GETFILEPTR *MSGSTREAM*))) (if *DISCARDED-PARTS* then (* ; "Ordinarily we retrieve everything (PARTS-TO-RETRIEVE = NIL), but if there were parts we like to ignore, we can skip these.") (SETQ PARTS-TO-RETRIEVE (for PAIR in *TABLE-OF-CONTENTS* as INDEX from 0 collect INDEX unless (ASSOC (CAR PAIR) *DISCARDED-PARTS*)))) RETRY (if *HAVE-ATTACHMENTS* then (SETQ *MSGSTREAM* (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (if (SETQ REPORT (CADR (ASSOC (QUOTE REPORT) *ENVELOPE*))) then (* ; "This is a delivery report.  What a crufty way to represent it") (SETQ *ENVELOPE* (\NSMAIL.HANDLE.DELIVERY.REPORT *MSGSTREAM* REPORT *ENVELOPE*)) (if (NULL *TABLE-OF-CONTENTS*) then (* ; "No body, e.g., a bad dl member report") (GO FINISH) else (* ; "Some message parts will follow the report") (PRINTOUT *MSGSTREAM* T "- - - - - - - - -" T))) (if (NEQ (CAAR *TABLE-OF-CONTENTS*) (\NSMAIL.BODY.PART.TYPE HEADING)) then (HELP "First body part is not heading" *TABLE-OF-CONTENTS*)) (SETQ RESULT (COURIER.CALL (fetch NSMAILSTREAM of MAILBOX) (QUOTE NEW.INBASKET) (QUOTE RETRIEVE.BODY.PARTS) INDEX PARTS-TO-RETRIEVE (FUNCTION \NSMAIL.READ.BODY.PARTS) (fetch NSMAILSESSION of MAILBOX) (QUOTE RETURNERRORS))) (if (EQ (CAR (LISTP RESULT)) (QUOTE ERROR)) then (\NSMAIL.SIGNAL.ERROR RESULT MAILBOX (QUOTE NEW.INBASKET) (QUOTE RETRIEVE.BODY.PARTS)) (if *HAVE-ATTACHMENTS* then (SETQ *ATTACHMENTS* NIL) else (SETFILEPTR MSGOUTFILE HERE)) (SETQ *RETRIEVAL-ERROR* NIL) (GO RETRY)) (COND (*RETRIEVAL-ERROR* (printout *MSGSTREAM* T *RETRIEVAL-ERROR* T))) (if *FORMAT-STREAM* then (* ; "This is a TEdit formatted message") (LA.ADJUST.FORMATTING *FORMAT-STREAM* *MSGSTREAM* (- *HEADER-EOF* HERE))) (if *HAVE-ATTACHMENTS* then (SETQ *MSGSTREAM* (OPENTEXTSTREAM *MSGSTREAM* NIL NIL NIL (LIST (QUOTE FONT) LAFITEDISPLAYFONT))) (LET ((ATTACHPOINT (TEDIT.FIND *MSGSTREAM* "

Attachment: " 1))) (SETQ ATTACHPOINT (if ATTACHPOINT then (* ; "Insert object at end of this line") (+ ATTACHPOINT 14) else (* ; "Shouldn't happen") (+ (TEDIT.FIND *MSGSTREAM* "

" 1) 2))) (for AT in *ATTACHMENTS* do (LET (TYPE) (SETFILEPTR AT 4) (* ; "Skip the version number (LONGCARDINAL).  Next comes SEQUENCE Filing.Attribute") (* ; "unknown") (to (\WIN AT) bind X ATTR do (if (EQ (SETQ ATTR (COURIER.READ AT NIL (QUOTE LONGCARDINAL))) (\NSMAIL.ATTRIBUTE.TYPE BodyType)) then (\WIN AT) (SETQ TYPE (\TYPE.FROM.FILETYPE (COURIER.READ AT NIL (QUOTE LONGCARDINAL)))) else (COURIER.SKIP.SEQUENCE AT NIL (QUOTE UNSPECIFIED)))) (TEDIT.INSERT.OBJECT (\MAILOBJ.CREATE AT TYPE (GETFILEPTR AT)) *MSGSTREAM* ATTACHPOINT)))) (* ;; "Would like the following to be (COERCETEXTOBJ OUTSTREAM 'FILE MSGOUTFILE) but Tedit has a bug") (COPYBYTES (OPENSTREAM (COERCETEXTOBJ *MSGSTREAM* (QUOTE FILE)) (QUOTE INPUT)) MSGOUTFILE)) FINISH (push (fetch NSMAILENVELOPES of MAILBOX) INDEX)))
)

(\NSMAIL.READ.BODY.PARTS
(LAMBDA (BULKSTREAM) (* ; "Edited 14-Aug-90 16:13 by bvm") (DECLARE (SPECVARS *ATTACHMENTS* *DISCARDED-PARTS* *ENVELOPE* *FORMAT-STREAM* *HAVE-ATTACHMENTS* *HEADER-EOF* *MSGSTREAM* *TABLE-OF-CONTENTS* *BODY-OFFSET*)) (* ;; "Bulk data handler for RetrieveBodyParts call.  We see the body parts, one directly after the other, per toc.") (* ;; "I hope the heading part is first") (for PAIR in *TABLE-OF-CONTENTS* as INDEX from 0 bind (START _ (GETFILEPTR BULKSTREAM)) (*BODY-OFFSET* _ 0) END HAVETEXT DISCARDING HEADERFIELDS FORWARDINFO FINFO FORWARDSTREAM PART-TYPE PART-LENGTH unless (ASSOC (SETQ PART-TYPE (CAR PAIR)) *DISCARDED-PARTS*) do (* ;; "Assertion: START = (getfileptr bulkstream)") (SETQ PART-LENGTH (CADR PAIR)) (if DISCARDING then (* ; "We already ate some of this, have to skip the rest") (if (> (SETQ DISCARDING (- DISCARDING PART-LENGTH)) 0) then (* ; "We've eaten the entire part, keep discarding") else (* ; "We've eaten all but -DISCARDING bytes") (SETFILEPTR BULKSTREAM (SETQ START (- START DISCARDING))) (SETQ DISCARDING NIL)) else (SETQ END (+ START PART-LENGTH)) (SETQ FINFO (find F in FORWARDINFO suchthat (* ; "See if this is a forwarded part") (FMEMB INDEX (fetch (FORWARD PARTS) of F)))) (SELECTC PART-TYPE ((\NSMAIL.BODY.PART.TYPE HEADING) (* ; "The heading = Sequence of Heading Attribute") (CL:MULTIPLE-VALUE-SETQ (HEADERFIELDS *FORMAT-STREAM* FORWARDINFO) (\NSMAIL.READ.HEADING BULKSTREAM END)) (\NSMAIL.NEW.PRINT.HEADING *MSGSTREAM* HEADERFIELDS *ENVELOPE*) (* ; "Print your basic heading.  May set *BODY-OFFSET*") (if *DISCARDED-PARTS* then (* ; "Add another header field to show what we dropped.") (MAPRINT (CL:REMOVE-DUPLICATES (MAPCAR *DISCARDED-PARTS* (FUNCTION CADR)) :TEST (QUOTE STRING-EQUAL)) *MSGSTREAM* "Discarded-Parts: " NIL ", ") (TERPRI *MSGSTREAM*)) (if *HAVE-ATTACHMENTS* then (* ; "We'll insert image object(s) here later") (PRINTOUT *MSGSTREAM* "
Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ *HEADER-EOF* (GETFILEPTR *MSGSTREAM*)) (if FORWARDINFO then (* ; "We'll need to buffer the forwarded body parts in order to print them properly") (SETQ FORWARDSTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))))) ((LIST (\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE) (\NSMAIL.BODY.PART.TYPE NSTEXTFILE) (\NSMAIL.BODY.PART.TYPE IA5.NOTE)) (* ; "This is text") (LET ((OUTSTREAM *MSGSTREAM*) (OFFSET *BODY-OFFSET*) FORWARDSTART) (if FINFO then (* ; "We'll buffer this text part") (SETQ FORWARDSTART (GETFILEPTR (SETQ OUTSTREAM FORWARDSTREAM))) (SETQ OFFSET 0) else (* ; "Normal case") (if HAVETEXT then (* ; "yet another text part") (PRIN3 "
- - - - - - -

" *MSGSTREAM*) else (SETQ HAVETEXT T))) (SELECTC PART-TYPE ((\NSMAIL.BODY.PART.TYPE MULTINATIONAL.NOTE) (* ; "Xerox character set--just copy.") (SETFILEPTR BULKSTREAM (+ START OFFSET)) (COPYBYTES BULKSTREAM OUTSTREAM (- PART-LENGTH OFFSET))) ((\NSMAIL.BODY.PART.TYPE IA5.NOTE) (* ; "ia5 takes a little bit of conversion.  Note that the skip case never happens here") (\NSMAIL.COPY.IA5 BULKSTREAM OUTSTREAM PART-LENGTH)) ((\NSMAIL.BODY.PART.TYPE NSTEXTFILE) (* ; "nstextfile--decode serialized file") (\NSMAIL.COPY.NSTEXTFILE BULKSTREAM OUTSTREAM END OFFSET)) NIL) (if FINFO then (* ; "Record where the text went") (push (fetch (FORWARD MAP) of FINFO) (LIST INDEX FORWARDSTART (- (GETFILEPTR FORWARDSTREAM) FORWARDSTART))) else (* ; "We've finished whatever skipping we were going to do.") (SETQ *BODY-OFFSET* 0)))) (LET ((BODY (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) (* ;; "Parts we don't handle become opaque attachments") (if (OR (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE VPFOLDER)) (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE VPDOCUMENT)) (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE OTHERNSFILE))) then (* ; "It's already serialized") (COPYBYTES BULKSTREAM BODY PART-LENGTH) else (* ; "for now, make a serialized file") (COURIER.WRITE BODY \SERIALIZED.FILE.VERSION NIL (QUOTE LONGCARDINAL)) (* ; "version") (\WOUT BODY 1) (* ; "Length of attribute sequence") (\NSMAIL.WRITE.ATTRIBUTE BODY (QUOTE BodyType) (if (EQL PART-TYPE (\NSMAIL.BODY.PART.TYPE INTERPRESS)) then (CONSTANT (\FILETYPE.FROM.TYPE (QUOTE INTERPRESS))) else (+ PART-TYPE 100000000))) (COURIER.WRITE BODY (COURIER.WRITE.STREAM.UNSPECIFIED BODY BULKSTREAM START END) NIL (QUOTE BOOLEAN)) (* ; "StreamOfUnspecified followed by lastByteIsSignificant") (\WOUT BODY 0) (* ; "no children")) (push *ATTACHMENTS* BODY) (if FINFO then (* ; "So we can refer to this later as attachment #n") (push (fetch (FORWARD MAP) of FINFO) (LIST INDEX (LENGTH *ATTACHMENTS*)))))) (if (NOT (EQL END (SETQ START (GETFILEPTR BULKSTREAM)))) then (HELP (CL:FORMAT NIL "Body part ~A wrong length: parsed as ~D, should have been ~D" PART-TYPE (+ PART-LENGTH (- START END)) PART-LENGTH) (CL:FORMAT NIL "Type 'RETURN' to " (if (> START END) then "flush rest of message" else "flush unread portion"))) (if (> START END) then (SETQ DISCARDING (- START END)) else (SETFILEPTR BULKSTREAM (SETQ START END))))) finally (if FORWARDINFO then (* ;; "At this point we have written all the original parts.  Now walk thru the Forwarding info and write those messages") (LET ((*NSMAIL-DISPLAY-TRANSPORT-ID* NIL) (*NSMAIL-DISPLAY-POSTMARK* NIL)) (* ; "Those fields are boring in forwarded mail") (\NSMAIL.EMIT.FORWARDING FORWARDINFO FORWARDSTREAM *MSGSTREAM* NIL))) (* ;; "Return NIL to let Courier result show thru") (RETURN NIL)))
)

(\NSMAIL.COPY.IA5
(LAMBDA (INSTREAM OUTSTREAM NBYTES) (* ; "Edited 22-Dec-89 18:06 by bvm") (* ;; "Convert NBYTES of ia5 text on INSTREAM to Xerox charset on OUTSTREAM") (while (>= (SETQ NBYTES (SUB1 NBYTES)) 0) bind CH do (SELCHARQ (SETQ CH (\BIN INSTREAM)) (CR (* ; "CR followed by some number of lfs indicates line breaks") (bind GOT1 while (AND (>= (SETQ NBYTES (SUB1 NBYTES)) 0) (EQ (SETQ CH (\BIN INSTREAM)) (CHARCODE LF))) do (* ; "One eol for each lf") (\BOUT OUTSTREAM (CHARCODE CR)) (SETQ GOT1 T) finally (if (NOT GOT1) then (* ; "Naked CR?  Well, go ahead and print one anyway--we don't know how else to do it") (\BOUT OUTSTREAM (CHARCODE CR)))) (if (< NBYTES 0) then (* ; "Text ended in eol") (RETURN))) NIL) (\BOUT OUTSTREAM CH)))
)

(\NSMAIL.COPY.NSTEXTFILE
(LAMBDA (INSTREAM OUTSTREAM END OFFSET) (* ; "Edited 22-May-90 10:37 by bvm") (* ;; "Copies the serialized text file from INSTREAM to OUTSTREAM.  If there's a formatting item, sets *FORMAT-STREAM*.  Just in case of trouble, END is the file pointer where we expect the file to end.  If OFFSET is specified, it is an initial number of bytes to skip.") (\NSMAIL.CHECK.SERIALIZED.VERSION INSTREAM) (* ; "Now Sequence of Filing.Attribute") (to (\WIN INSTREAM) bind TYPE do (SETQ TYPE (COURIER.READ INSTREAM NIL (QUOTE LONGCARDINAL))) (if (AND (EQL TYPE (\NSMAIL.ATTRIBUTE.TYPE LispFormatting)) (NOT *FORMAT-STREAM*)) then (* ; "Read formatting") (\NSMAIL.READ.STRING.AS.STREAM INSTREAM (SETQ *FORMAT-STREAM* (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH)))) else (* ; "Skip over the value") (COURIER.SKIP.SEQUENCE INSTREAM NIL (QUOTE UNSPECIFIED)))) (* ;; "Now read the text content.  This is adapted from \nsmail.read.serialized.content") (if (NOT OFFSET) then (SETQ OFFSET 0)) (bind LASTSEGMENT? BYTE BYTECOUNT do (SETQ LASTSEGMENT? (NEQ (\WIN INSTREAM) 0)) (COND ((NEQ (SETQ BYTECOUNT (UNFOLD (\WIN INSTREAM) BYTESPERWORD)) 0) (if (AND (> OFFSET 0) (LET ((SKIPLENGTH (MIN OFFSET BYTECOUNT))) (* ; "How much of this segment to skip") (SETFILEPTR INSTREAM (+ (GETFILEPTR INSTREAM) SKIPLENGTH)) (SETQ OFFSET (- OFFSET SKIPLENGTH)) (EQ (SETQ BYTECOUNT (- BYTECOUNT SKIPLENGTH)) 0))) then (* ; "We skipped the entire segment") (if LASTSEGMENT? then (* ; "Have to consume the lastByteIsSignificant flag") (\WIN INSTREAM)) else (COPYBYTES INSTREAM OUTSTREAM (SUB1 BYTECOUNT)) (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))))) (LASTSEGMENT? (* ; "Null body.  Throw out the lastByteIsSignificant flag") (\WIN INSTREAM))) repeatuntil LASTSEGMENT?) (LET ((NCHILDREN (\WIN INSTREAM))) (if (> NCHILDREN 0) then (HELP "nsTextFile has children!! -- return to skip them" NCHILDREN) (SETFILEPTR INSTREAM END))))
)

(\NSMAIL.READ.HEADING
(LAMBDA (BULKSTREAM HEADING-END) (* ; "Edited 21-Dec-89 17:09 by bvm") (* ;; "Read a Heading body part, which consists of Sequence of Heading Attribute.  Returns 4 values: headerfields (an alist), formatstream (if there was tedit formatting item), forwardInfo (if there was a forwarding structure), malformedP (if we had to advance the file pointer manually to HEADING-END") (LET (TYPE VALUE HEADERFIELDS TYPEINFO DISCARDED FORMATSTREAM FORWARDINFO MALFORMED COURIERTYPE) (to (\WIN BULKSTREAM) do (SETQ TYPE (COURIER.READ BULKSTREAM NIL (QUOTE LONGCARDINAL))) (COND ((NOT (find old TYPEINFO in \NSMAIL.HEADING.ATTRIBUTES suchthat (EQ (CADR TYPEINFO) TYPE))) (* ; "We don't understand this attribute") (if NSMAILDEBUGFLG then (push DISCARDED TYPE)) (COURIER.SKIP.SEQUENCE BULKSTREAM NIL (QUOTE UNSPECIFIED))) ((EQ (SETQ TYPE (CAR TYPEINFO)) (QUOTE LispFormatting)) (* ; "Save the formatting so we can munge it") (SETQ FORMATSTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (\NSMAIL.READ.STRING.AS.STREAM BULKSTREAM FORMATSTREAM)) (T (LET ((VALUE-END (+ (UNFOLD (\WIN BULKSTREAM) BYTESPERWORD) (GETFILEPTR BULKSTREAM))) (COURIERTYPE (CADDR TYPEINFO)) HERE) (* ; "Note careful order of args to +") (if (EQ TYPE (QUOTE ForwardedHeadings)) then (SETQ FORWARDINFO (\NSMAIL.READ.FORWARDING BULKSTREAM VALUE-END)) else (CL:MULTIPLE-VALUE-BIND (VALUE CONDITION) (IGNORE-ERRORS (COURIER.READ BULKSTREAM (QUOTE NEW.MAILTRANSPORT) COURIERTYPE)) (if (OR CONDITION (NOT (EQL (SETQ HERE (GETFILEPTR BULKSTREAM)) VALUE-END))) then (if (NOT CONDITION) then (SETQ CONDITION "wrong length")) (if NSMAILDEBUGFLG then (HELP (CL:FORMAT NIL "Error reading attribute ~A: ~A" TYPE CONDITION))) (push HEADERFIELDS (CONS (MKSTRING TYPE) (CL:FORMAT NIL "XNS encoding error: ~A" CONDITION))) (if (< HERE VALUE-END) then (SETFILEPTR BULKSTREAM VALUE-END) elseif (AND (> HERE VALUE-END) (< HERE HEADING-END)) then (SETFILEPTR BULKSTREAM HEADING-END) (push HEADERFIELDS (QUOTE ("Header-Errors" . "Malformed XNS heading, some fields may be missing."))) (* ; "Exit this heading reader loop") (RETURN (SETQ MALFORMED T))) else (* ; "Save field") (push HEADERFIELDS (CONS TYPE (if (EQ TYPE (QUOTE Immutable)) then (* ; "Strange null-valued type") "True" elseif (LISTP COURIERTYPE) then (if (EQUAL COURIERTYPE (QUOTE (SEQUENCE IP.MESSAGEID))) then (MAPCAR VALUE (FUNCTION \NSMAIL.TRANSLATE.IP.MESSAGEID)) else VALUE) else (SELECTQ COURIERTYPE (TIME (\NSMAIL.GDATE VALUE)) (IP.MESSAGEID (\NSMAIL.TRANSLATE.IP.MESSAGEID VALUE)) VALUE))))))))))) (if DISCARDED then (push HEADERFIELDS (CONS "Discarded-Fields" (CONCATLIST (CDR (for D in (REVERSE DISCARDED) join (LIST ", " D))))))) (CL:VALUES HEADERFIELDS FORMATSTREAM FORWARDINFO MALFORMED)))
)

(\NSMAIL.PARSE.ANNOTATION
(LAMBDA (ANNOTATION OUTSTREAM HEADERFIELDS) (* ; "Edited 21-Dec-89 13:10 by bvm") (* ;; "ANNOTATION is the value of the TextAnnotation heading.  We parse it and print it to OUTSTREAM.  HEADERFIELDS is an alist of other headers the caller will be printing.") (bind (LEN _ (NCHARS ANNOTATION)) (START _ 1) (NEXT _ 1) CR while (SETQ CR (STRPOS "
" ANNOTATION NEXT)) do (CASE (AND (< CR LEN) (CL:CHAR ANNOTATION CR)) ((#\Space #\Tab) (* ; "Whitespace denoting continuation line")) (T (\NSMAIL.EMIT.ANNOTATION (SUBSTRING ANNOTATION START (SUB1 CR)) OUTSTREAM HEADERFIELDS) (SETQ START (ADD1 CR)))) (SETQ NEXT (ADD1 CR)) finally (\NSMAIL.EMIT.ANNOTATION (SUBSTRING ANNOTATION START) OUTSTREAM HEADERFIELDS)))
)

(\NSMAIL.EMIT.ANNOTATION
(LAMBDA (STR OUTSTREAM HEADERFIELDS) (* ; "Edited 10-Jul-90 15:55 by bvm") (DECLARE (SPECVARS *ORIGINAL-DATE*)) (* ;; "Print extra field STR to OUTSTREAM.  We don't know exactly what it looks like, so we need to ensure that it is syntactically ok.  If it is one of HEADERFIELDS, we make sure to rename it to avoid a clash.  If it is the Date field, we print it and set *ORIGINAL-DATE* to the value portion.") (PROG (I LEN FIELD) (if (AND STR (> (SETQ LEN (NCHARS STR)) 0)) then (if (NOT (SETQ FIELD (for old I from 0 to (SUB1 LEN) do (CASE (CL:CHAR STR I) (#\: (* ; "valid field") (RETURN (SUBSTRING STR 1 I))) ((#\Space #\Tab) (* ; "Space before colon?  Malformed") (RETURN NIL)))))) then (* ; "Malformed field") (PRIN3 "Other-Field: " OUTSTREAM) elseif (CL:ASSOC FIELD HEADERFIELDS :TEST (QUOTE STRING-EQUAL)) then (* ; "We already have a field of this name, so rename it") (if (AND (< I (- LEN 2)) (EQL (CL:CHAR STR (ADD1 I)) #\Tab)) then (* ; "field:<tab> looks a little weird when we add text to the front") (CL:SETF (CL:CHAR STR (ADD1 I)) #\Space)) (PRIN3 "Original-" OUTSTREAM) elseif (STRING-EQUAL FIELD "Date") then (SETQ *ORIGINAL-DATE* (LA.TRIM.WHITESPACE (SUBSTRING STR (+ I 2))))) (PRIN3 STR OUTSTREAM) (TERPRI OUTSTREAM))))
)

(LA.TRIM.WHITESPACE
(LAMBDA (STR) (* ; "Edited 14-May-90 16:35 by bvm") (CL:STRING-TRIM (QUOTE (#\Space #\Tab)) STR)))

(\NSMAIL.READ.FORWARDING
(LAMBDA (INSTREAM VALUE-END) (* ; "Edited 21-Dec-89 18:39 by bvm") (* ;; "Read the attribute ForwardedHeadings = Sequence of ForwardedMessageInfo.  We do this instead of a straight COURIER.READ so that we can play with the headings field.  Returns NIL if the attribute is malformed.") (to (\WIN INSTREAM) collect (create FORWARD ENVELOPE _ (COURIER.READ INSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE ENVELOPE)) HEADINGS _ (CL:MULTIPLE-VALUE-BIND (HEADINGS FORMATSTREAM FORWARDINFO MALFORMED) (\NSMAIL.READ.HEADING INSTREAM VALUE-END) (if MALFORMED then (RETURN NIL) else (* ;; "Note that we ignore FORWARDINFO (not allowed anyway, as messages are not quite recursive) and FORMATSTREAM (who would have had it anyway, though it would be cute to be able to use it).") HEADINGS)) PARTS _ (COURIER.READ.SEQUENCE INSTREAM (QUOTE NEW.MAILTRANSPORT) (QUOTE BODY.PART.INDEX)) PARENT _ (if (NEQ (\WIN INSTREAM) 0) then (* ; "Open coding of (choice (null 0 (record)) (nested 1 cardinal))") (\WIN INSTREAM)))))
)

(\NSMAIL.NEW.PRINT.HEADING
(LAMBDA (OUTSTREAM HEADERFIELDS ENVELOPE) (* ; "Edited 26-Sep-90 11:35 by bvm") (* ;; "Compose message header from HEADERFIELDS and ENVELOPE, printing to OUTSTREAM.  ") (PROG (*ORIGINAL-DATE* ORIGIDATE POSTED.DATE ORIGINATOR RETURN-TO VALUE TYPE SENDER FROMFIELD FULLFROMFIELD) (DECLARE (SPECVARS *ORIGINAL-DATE* *BODY-OFFSET*)) (for PAIR in (SETQ HEADERFIELDS (REVERSE HEADERFIELDS)) do (* ; "Before we start printing anything, look for some special fields") (CASE (CAR PAIR) (Sender (SETQ SENDER (CDR PAIR))) (From (SETQ FULLFROMFIELD (CDR PAIR)) (COND ((NULL (CDDR PAIR)) (* ; "Only interesting to eliminate if there's only one") (SETQ FROMFIELD (CADR PAIR))))) ((TextAnnotation newTextAnnotation) (\NSMAIL.PARSE.ANNOTATION (CDR PAIR) OUTSTREAM HEADERFIELDS) (RPLACD PAIR NIL)) (BodyOffset (* ; "Says how much of body duplicates the textannotation") (SETQ *BODY-OFFSET* (CDR PAIR)) (RPLACD PAIR NIL)))) (* ;; "Look at the envelope to see if there is any additional info we should supply that wasn't in the headers") (for PAIR in ENVELOPE do (SETQ VALUE (CADR PAIR)) (CASE (SETQ TYPE (CAR PAIR)) (Originator (if (OR (NULL (OR SENDER FROMFIELD)) (NOT (EQUAL.RNAMES VALUE (OR SENDER FROMFIELD)))) then (SETQ ORIGINATOR VALUE))) (RETURN.TO.NAME (SETQ RETURN-TO VALUE)) (Message-ID (if *NSMAIL-DISPLAY-TRANSPORT-ID* then (CL:FORMAT OUTSTREAM "XNS-Transport-ID: ~{~4,'0x~}~%%" VALUE))) (Postmark (SETQ POSTED.DATE (COURIER.FETCH (NEW.MAILTRANSPORT . POSTMARK) TIME of VALUE)) (if *NSMAIL-DISPLAY-POSTMARK* then (CL:FORMAT OUTSTREAM "Postmark: ~A at ~A~%%" (RNAME.TO.STRING (COURIER.FETCH (NEW.MAILTRANSPORT . POSTMARK) POSTED.AT of VALUE) T) (GDATE POSTED.DATE (DATEFORMAT TIME.ZONE))))))) (if POSTED.DATE then (* ; "Date is found only in the envelope") (if (AND *ORIGINAL-DATE* (SETQ ORIGIDATE (IDATE *ORIGINAL-DATE*)) (< (IABS (- POSTED.DATE ORIGIDATE)) (TIMES 5 60))) then (* ; "Text-annotation portion gave a date that is within 5 minutes, so don't bother mentioning the posting date.") else (if *ORIGINAL-DATE* then (* ; "Already have a Date field printed, so this one we'll call %"Posted-Date%"") (PRINTOUT OUTSTREAM "Posted-")) (PRINTOUT OUTSTREAM "Date: " (\NSMAIL.GDATE POSTED.DATE) T))) (if (NULL FULLFROMFIELD) then (* ; "Derive From field from somewhere else") (if SENDER then (RPLNODE (ASSOC (QUOTE Sender) HEADERFIELDS) (QUOTE From) (LIST SENDER)) (if ORIGINATOR then (push HEADERFIELDS (CONS (QUOTE Sender) ORIGINATOR))) elseif ORIGINATOR then (* ; "Neither From nor Sender in heading, take it out of envelope") (push HEADERFIELDS (LIST (QUOTE From) (SETQ SENDER ORIGINATOR)))) elseif (NULL SENDER) then (* ; "From but no Sender") (if ORIGINATOR then (* ; "ORIGINATOR only set when it's different from From") (push HEADERFIELDS (CONS (QUOTE Sender) (SETQ SENDER ORIGINATOR))) else (SETQ SENDER FROMFIELD)) elseif (AND FROMFIELD (EQUAL.RNAMES SENDER FROMFIELD)) then (* ; "Sender is redundant with From--get rid of it, unless the envelope originator is different") (RPLACD (ASSOC (QUOTE Sender) HEADERFIELDS) ORIGINATOR) elseif ORIGINATOR then (* ; "Three distinct fields") (push HEADERFIELDS (CONS (QUOTE Originator) ORIGINATOR))) (if (AND RETURN-TO (OR (NULL SENDER) (NOT (EQUAL.RNAMES RETURN-TO SENDER))) *NSMAIL-DISPLAY-ERRORS-TO*) then (* ;; "Usually same as originator, so we omit.  (NULL SENDER) is only true when there's no originator in envelope, allegedly illegal") (push HEADERFIELDS (CONS (QUOTE Errors-To) RETURN-TO))) (if (NOT (type? NSNAME SENDER)) then (* ; "Can't resolve domain/orgs against this") (SETQ SENDER NIL)) (for PAIR in (SORT HEADERFIELDS (FUNCTION (LAMBDA (X Y) (* ;; "X sorts before Y if X is in the well-known order and either Y appears after it or doesn't appear at all.  Non-symbols sort after everything") (AND (LITATOM (CAR X)) (OR (NOT (LITATOM (CAR Y))) (AND (SETQ X (FMEMB (CAR X) NSMAIL.HEADER.ORDER)) (OR (FMEMB (CAR Y) X) (NULL (FMEMB (CAR Y) NSMAIL.HEADER.ORDER))))))))) when (SETQ VALUE (CDR PAIR)) do (printout OUTSTREAM (SETQ TYPE (CAR PAIR)) ": ") (CASE TYPE ((From To cc bcc Reply-to) (\NSMAIL.NEW.PRINT.NAMES VALUE OUTSTREAM (SELECTQ TYPE (From (* ; "Always fully qualified.  Also check against sender.") (if (AND SENDER (NOT (for NAME in VALUE always (OR (EQ NAME SENDER) (AND (STRING-EQUAL (fetch NSDOMAIN of NAME) (fetch NSDOMAIN of SENDER)) (STRING-EQUAL (fetch NSORGANIZATION of NAME) (fetch NSORGANIZATION of SENDER))))))) then (* ; "Ugh, From and Sender are different domains.  To reduce confusion, force everything to be fully qualified") (SETQ SENDER NIL)) NIL) (Reply-to (* ; "always full-qualified") NIL) SENDER))) ((Sender Originator Errors-To) (printout OUTSTREAM (RNAME.TO.STRING VALUE T))) (T (if (LISTP VALUE) then (* ; "List of things we'll print as each thing separated by spaces (e.g., References)") (SETQ VALUE (CONCATLIST (CDR (for X in VALUE join (LIST " " X)))))) (while (AND (> (NCHARS VALUE) 0) (EQ (NTHCHARCODE VALUE -1) (CHARCODE CR))) do (* ; "Trailing cr's, e.g., in the Subject line, will cause the header not to parse") (SETQ VALUE (SUBSTRING VALUE 1 -2))) (bind (CR _ 1) while (SETQ CR (STRPOS "
" VALUE CR)) do (* ; "Given internal CR, have to make sure subsequent lines are continuation lines, i.e., start with whitespace.") (SELCHARQ (NTHCHARCODE VALUE (ADD1 CR)) ((SPACE TAB) (* ; "It's ok, let it go") (SETQ CR (ADD1 CR))) (PROGN (* ; "Not followed by whitespace, so print this much (including cr), then a tab.") (PRIN3 (SUBSTRING VALUE 1 CR) OUTSTREAM) (PRINTCCODE (CHARCODE TAB) OUTSTREAM) (SETQ VALUE (SUBSTRING VALUE (ADD1 CR))) (SETQ CR 1)))) (PRIN3 VALUE OUTSTREAM))) (TERPRI OUTSTREAM))))
)

(\NSMAIL.NEW.PRINT.NAMES
(LAMBDA (RNAMES OUTSTREAM DEFAULTNAME) (* ; "Edited  4-Apr-90 17:32 by bvm") (for NAME in RNAMES bind (FIRSTTIME _ T) ORGDIFFERS do (if (type? NSNAME NAME) then (COND (FIRSTTIME (SETQ FIRSTTIME NIL)) (T (PRIN3 ", " OUTSTREAM))) (PRIN3 (fetch NSOBJECT of NAME) OUTSTREAM) (LET ((ORG (fetch NSORGANIZATION of NAME)) (DOM (fetch NSDOMAIN of NAME))) (if (OR (SETQ ORGDIFFERS (NOT (AND DEFAULTNAME (OR (STRING-EQUAL ORG (fetch NSORGANIZATION of DEFAULTNAME)) (EQ (NCHARS ORG) 0))))) (NOT (OR (STRING-EQUAL DOM (fetch NSDOMAIN of DEFAULTNAME)) (EQ (NCHARS DOM) 0)))) then (* ;; "Have to print the domain.  The null string tests are because there exists buggy software that doesn't fill in the domain and org--we want them to default correctly eventually.") (PRIN3 ":" OUTSTREAM) (PRIN3 DOM OUTSTREAM) (if ORGDIFFERS then (* ; "Have to print the org, too") (PRIN3 ":" OUTSTREAM) (PRIN3 ORG OUTSTREAM)))) else (PRIN3 (RNAME.TO.STRING NAME) OUTSTREAM))))
)

(\NSMAIL.EMIT.FORWARDING
(LAMBDA (FORWARDINFO FORWARDSTREAM OUTSTREAM PARENT-INDEX) (* ; "Edited 22-May-90 10:41 by bvm") (* ;; "Recursively emit Forwarded body structure.  In this pass, we print all the body parts subsidiary to the PARENT-INDEXth item, or the top level items if PARENT-INDEX is nil.") (for FINFO in FORWARDINFO as I from 0 bind NTHTIME when (EQ (fetch (FORWARD PARENT) of FINFO) PARENT-INDEX) do (* ;; "This bit of forwarding info describes a child of PARENT-INDEX") (LET ((*BODY-OFFSET* 0)) (DECLARE (SPECVARS *BODY-OFFSET*)) (* ; "set by \nsmail.new.print.heading") (TERPRI OUTSTREAM) (PRIN3 (if NTHTIME then (* ; "%"Next Message%"") (CADDR LAFITEFORWARDSTRINGS) else (SETQ NTHTIME T) (* ; "%"Begin Forwarded Messages%"") (CADR LAFITEFORWARDSTRINGS)) OUTSTREAM) (TERPRI OUTSTREAM) (\NSMAIL.NEW.PRINT.HEADING OUTSTREAM (fetch (FORWARD HEADINGS) of FINFO) (fetch (FORWARD ENVELOPE) of FINFO)) (* ; "Print header of this part") (TERPRI OUTSTREAM) (for INDEX in (fetch (FORWARD PARTS) of FINFO) bind (MAP _ (fetch (FORWARD MAP) of FINFO)) MAPENTRY NTHPART do (if NTHPART then (* ; "Yet another body part") (PRIN3 "
- - - - - - -

" OUTSTREAM) else (SETQ NTHPART T)) (if (NOT (SETQ MAPENTRY (CDR (ASSOC INDEX MAP)))) then (PRIN3 "[Missing part]
" OUTSTREAM) elseif (CDR MAPENTRY) then (* ; "(start length)") (SETFILEPTR FORWARDSTREAM (+ (CAR MAPENTRY) *BODY-OFFSET*)) (COPYBYTES FORWARDSTREAM OUTSTREAM (CADR MAPENTRY)) (SETQ *BODY-OFFSET* 0) else (* ; "(attachment#)") (if (CL:FORMAT OUTSTREAM "[See Attachment #~D]~%%" (CAR MAPENTRY)))))) (* ; "If there are children, do them") (\NSMAIL.EMIT.FORWARDING FORWARDINFO FORWARDSTREAM OUTSTREAM I) finally (if NTHTIME then (* ; "Yes, we printed some parts, so time for %"End Forwarded Messages%"") (TERPRI OUTSTREAM) (PRIN3 (CADDDR LAFITEFORWARDSTRINGS) OUTSTREAM))))
)

(\NSMAIL.GDATE
(LAMBDA (TIME) (* ; "Edited 11-Jul-90 18:03 by bvm") (GDATE TIME (DATEFORMAT SPACES TIME.ZONE))))

(\NSMAIL.TRANSLATE.IP.MESSAGEID
(LAMBDA (ID) (* ; "Edited 11-May-90 10:45 by bvm") (LET ((RNAME (COURIER.FETCH (NEW.MAILTRANSPORT . IP.MESSAGEID) ORIGINATOR of ID)) (USTRING (COURIER.FETCH (NEW.MAILTRANSPORT . IP.MESSAGEID) UNIQUESTRING of ID))) (if (NOT (NULL.NSNAME RNAME)) then (* ; "Really has name") (CONCAT #\< USTRING #\* (RNAME.TO.STRING RNAME T) #\>) elseif (AND (EQ (CL:CHAR USTRING 0) #\<) (EQ (CL:CHAR USTRING (SUB1 (NCHARS USTRING))) #\>)) then (* ; "It's already in msg-id format") USTRING else (\NSMAIL.MAYBE.QUOTE USTRING))))
)

(\NSMAIL.MAYBE.QUOTE
(LAMBDA (STR) (* ; "Edited 11-May-90 10:44 by bvm") (* ;; "return STR with string quotes around it if it contains any characters that RFC822 says are special") (if (for I from 1 to (NCHARS STR) bind CH thereis (OR (< (SETQ CH (NTHCHARCODE STR I)) (CHARCODE SPACE)) (>= CH (CHARCODE DEL)) (FMEMB CH (CHARCODE ("(" ")" "<" ">" "@" "," ";" ":" \ %" "." "[" "]"))))) then (CONCAT #\" (if (STRPOSL (CHARCODE (\ %")) STR) then (* ; "Have to quote these") (CONCATLIST (for I from 0 to (SUB1 (NCHARS STR)) bind CH join (CASE (SETQ CH (CL:CHAR STR I)) ((#\\ #\") (LIST #\\ CH)) (T (LIST CH))))) else STR) #\") else STR))
)

(NULL.NSNAME
(LAMBDA (NAME) (* ; "Edited 21-Aug-90 11:32 by bvm") (AND (type? NSNAME NAME) (EQL (NCHARS (fetch NSDOMAIN of NAME)) 0) (EQL (NCHARS (fetch NSORGANIZATION of NAME)) 0) (PROGN (* ; "Kludge in new gateway due to bug in backward compatibility--object = single char is also %"null%"") (< (NCHARS (fetch NSOBJECT of NAME)) 2))))
)

(\NSMAIL.HANDLE.DELIVERY.REPORT
(LAMBDA (OUTSTREAM REPORT-RECORD ENVELOPE) (* ; "Edited 29-Jun-90 18:06 by bvm") (LET* ((POSTED.DATE (COURIER.FETCH (NEW.MAILTRANSPORT . POSTMARK) TIME of (CADR (ASSOC (QUOTE Postmark) ENVELOPE)))) (OLD.ENVELOPE (COURIER.FETCH (NEW.MAILTRANSPORT . REPORT) ORIGINAL.ENVELOPE of REPORT-RECORD)) (REPORT (COURIER.FETCH (NEW.MAILTRANSPORT . REPORT) REPORT.TYPE of REPORT-RECORD)) (REPORTVALUE (CADR REPORT)) (FATE (COURIER.FETCH (NEW.MAILTRANSPORT . REPORT) FATE of REPORT-RECORD)) (SENDER (CADR (ASSOC (QUOTE Originator) ENVELOPE))) (RETURN-TO (CADR (ASSOC (QUOTE RETURN.TO.NAME) ENVELOPE))) BADNAMES GOODNAMES) (if POSTED.DATE then (PRINTOUT OUTSTREAM "Date: " (\NSMAIL.GDATE POSTED.DATE) T)) (if SENDER then (PRINTOUT OUTSTREAM "From: " (RNAME.TO.STRING SENDER T) T)) (if (AND RETURN-TO (NOT (EQUAL.RNAMES SENDER RETURN-TO))) then (PRINTOUT OUTSTREAM "Errors-to: " (RNAME.TO.STRING RETURN-TO T) T)) (PRINTOUT OUTSTREAM "Subject: ") (if (EQ (CAR FATE) (QUOTE NOT.DELIVERED)) then (* ; "Bizarre") (PRINTOUT OUTSTREAM "Return of non-delivery notice" T T "This non-delivery report could not be delivered because " (CAR (CADR FATE)) T T "Original-Subject: ")) (CASE (CAR REPORT) (DLMEMBER (* ; "Bad member notification") (SETQ BADNAMES (COURIER.FETCH (NEW.MAILTRANSPORT . DLREPORT) INVALID.RECIPIENTS of REPORTVALUE)) (PRINTOUT OUTSTREAM "Bad group membership notification" T T) (CL:FORMAT OUTSTREAM "A message from ~A could not be delivered to the following member~P of ~A:" (RNAME.TO.STRING (CADR (ASSOC (QUOTE Originator) OLD.ENVELOPE)) T) (LENGTH BADNAMES) (RNAME.TO.STRING (COURIER.FETCH (NEW.MAILTRANSPORT . DLREPORT) DLNAME of REPORTVALUE) T))) (OTHER (SETQ BADNAMES (COURIER.FETCH (NEW.MAILTRANSPORT . OTHER.REPORT) FAILED of REPORTVALUE)) (SETQ GOODNAMES (COURIER.FETCH (NEW.MAILTRANSPORT . OTHER.REPORT) SUCCEEDED of REPORTVALUE)) (if BADNAMES then (PRINTOUT OUTSTREAM "Undeliverable mail" T T) (CL:FORMAT OUTSTREAM "This message could not be delivered to the following recipient~P:" (LENGTH BADNAMES)) else (* ; "Strictly a delivery report") (PRINTOUT OUTSTREAM "Delivery report"))) (T (* ; "Shouldn't happen") (PRINTOUT OUTSTREAM "Erroneous (non-)delivery report" T T REPORT))) (PRINTOUT OUTSTREAM T T) (for PAIR in BADNAMES do (PRINTCCODE (CHARCODE TAB) OUTSTREAM) (PRINTOUT OUTSTREAM (\NSMAIL.RECIPIENT.NAME (COURIER.FETCH (NEW.MAILTRANSPORT . NON.DELIVERED.RECIPIENT) RECIPIENT of PAIR)) " -- " (COURIER.FETCH (NEW.MAILTRANSPORT . NON.DELIVERED.RECIPIENT) REASON of PAIR) T)) (if GOODNAMES then (* ; "A delivery report") (if BADNAMES then (TERPRI OUTSTREAM)) (CL:FORMAT OUTSTREAM "This message was delivered to the following recipient~P:~2%%" (LENGTH GOODNAMES)) (for PAIR in GOODNAMES do (PRINTCCODE (CHARCODE TAB) OUTSTREAM) (PRINTOUT OUTSTREAM (\NSMAIL.RECIPIENT.NAME (COURIER.FETCH (NEW.MAILTRANSPORT . DELIVERED.RECIPIENT) RECIPIENT of PAIR)) " at " (\NSMAIL.GDATE (COURIER.FETCH (NEW.MAILTRANSPORT . DELIVERED.RECIPIENT) WHEN of PAIR) (DATEFORMAT TIME.ZONE)) T))) OLD.ENVELOPE))
)

(\NSMAIL.RECIPIENT.NAME
(LAMBDA (RECIPIENT) (* ; "Edited  4-Apr-90 17:26 by bvm") (* ;; "Printable rep for a MailTransport.Recipient") (RNAME.TO.STRING (COURIER.FETCH (NEW.MAILTRANSPORT . RECIPIENT) NAME of RECIPIENT) T))
)

(NEW.INBASKET.CALL
(CL:LAMBDA (MAILBOX PROCEDURE &REST ARGS) (* ; "Edited 13-Dec-89 17:17 by bvm") (PROG ((STREAM (fetch NSMAILSTREAM of MAILBOX)) RESULT) LP (if (AND (EQ (CAR (LISTP (SETQ RESULT (CL:APPLY (FUNCTION COURIER.CALL) STREAM (QUOTE NEW.INBASKET) PROCEDURE ARGS)))) (QUOTE ERROR)) (CASE (CAR (LAST ARGS)) (NOERROR NIL) (RETURNERRORS (* ; "We'll only handle stream lost--caller gets the rest") (EQ (CADR RESULT) (QUOTE STREAM.LOST))) (T (* ; "Probably an error was already signaled") T))) then (SETQ STREAM (\NSMAIL.SIGNAL.ERROR RESULT MAILBOX (QUOTE NEW.INBASKET) PROCEDURE)) (GO LP) else (RETURN RESULT))))
)

(NEWNS.CLOSEMAILBOX
(LAMBDA (MAILBOX FLUSH?) (* ; "Edited 18-Dec-89 17:35 by bvm") (COND (FLUSH? (* ; "Delete everything we retrieved") (LET ((INDICES (REVERSE (fetch NSMAILENVELOPES of MAILBOX))) (SESSION (fetch NSMAILSESSION of MAILBOX))) (while INDICES do (* ; "Delete a message or more.  To keep the calls down, try to delete consecutive ranges when possible.") (LET* ((START (CAR INDICES)) (END START)) (while (AND (SETQ INDICES (CDR INDICES)) (EQL (CAR INDICES) (ADD1 END))) do (SETQ END (ADD1 END))) (NEW.INBASKET.CALL MAILBOX (QUOTE DELETE) (COURIER.CREATE (NEW.INBASKET . RANGE) LOW _ START HIGH _ END) SESSION)))))) (\NSMAIL.NEW.LOGOFF (fetch NSMAILSTATE of MAILBOX) (fetch NSMAILSTREAM of MAILBOX)))
)

(\NSMAIL.NEW.LOGOFF
(LAMBDA (STATE STREAM) (* ; "Edited 19-Dec-89 11:08 by bvm") (* ;; "Executes the Inbasket.Logoff procedure and clears appropriate state.  Returns true if LOGOFF call succeeded.") (LET ((RESULT (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGOFF) (fetch STATESESSION of STATE) (QUOTE RETURNERRORS)))) (PROG1 (NEQ (CAR (LISTP RESULT)) (QUOTE ERROR)) (replace STATESESSION of STATE with NIL) (CLOSEF STREAM))))
)
)

(RPAQQ \NSMAIL.GOOD.BODY.PARTS (0 5 6 2))

(RPAQQ \NSMAIL.DISCARDABLE.BODY.PARTS ((201 "Tioga formatting") (202 "Tioga header")))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
)

(ADDTOVAR LAFITEMODELST (NS 1 \NSMAIL.SEND.PARSE \NSMAIL.NEW.SEND \NSMAIL.MAKEANSWERFORM \NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.LOGIN))

(LAFITEMODE (LAFITEMODE))

(COND ((AND *USE-NEW-NSMAIL* \LAFITE.ACTIVE) (* ; "recache") (LAFITECLEARCACHE)))



(* ; "Old ns mail")

(DEFINEQ

(\NS.READ.ENVELOPE.ITEM
(LAMBDA (STREAM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:11 by bvm") (* ;; "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") (LET* ((TYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) (VALUETYPE (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CADR TRIPLE)) (SETQ TYPE (QUOTE (\, (CAR TRIPLE)))) (QUOTE (\, (CADDR TRIPLE)))))))))))) (LIST TYPE (if VALUETYPE then (\WIN STREAM) (* ; "Skip sequence count") (COURIER.READ STREAM PROGRAM VALUETYPE) else (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.WRITE.ENVELOPE.ITEM
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:31 by bvm") (* ;;; "Writes a filing attribute value pair to STREAM.  ITEM is a list of two elements (TYPE VALUE)") (LET ((TYPE (CAR ITEM)) (VALUE (CADR ITEM)) VALUETYPE) (COURIER.WRITE STREAM (OR (FIXP TYPE) (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CAR TRIPLE)) (SETQ VALUETYPE (QUOTE (\, (CADDR TRIPLE)))) (QUOTE (\, (CADR TRIPLE))))))) (T (ERROR "Unknown Envelope Item Type" 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) (BodyType 17 LONGCARDINAL) (Status 1000 (INBASKET . STATUS))))
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)

(DECLARE%: EVAL@COMPILE

(RECORD FORWARD (ENVELOPE HEADINGS PARTS PARENT . MAP))
)

(DECLARE%: EVAL@COMPILE 

(PUTPROPS \COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN) (MAPCAR X (FUNCTION EVAL)))))

(PUTPROPS \NSMAIL.BODY.PART.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS) \NSMAIL.BODY.PART.TYPES))) (T (ERROR "Unknown body part type" (CAR ARGS)) (QUOTE IGNOREMACRO)))))
)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES)
)


(FILESLOAD (SOURCE) LAFITEDECLS)


(FILESLOAD (LOADCOMP) NSMAIL)


(RPAQQ \NSMAIL.CONTENTS.TYPES ((\CT.NULL 0) (\CT.STANDARD.MESSAGE 4) (\CT.REPORT 6)))
(DECLARE%: EVAL@COMPILE 

(RPAQQ \CT.NULL 0)

(RPAQQ \CT.STANDARD.MESSAGE 4)

(RPAQQ \CT.REPORT 6)


(CONSTANTS (\CT.NULL 0) (\CT.STANDARD.MESSAGE 4) (\CT.REPORT 6))
)
DOCOPY 

(RPAQQ \NSMAIL.BODY.PART.TYPES ((HEADING 0) (VPFOLDER 1) (NSTEXTFILE 2) (VPDOCUMENT 3) (OTHERNSFILE 4) (MULTINATIONAL.NOTE 5) (IA5.NOTE 6) (PILOTFILE 7) (G3FAX 8) (TELETEX 9) (TELEX 10) (ISO6937.NOTE 11) (INTERPRESS 12)))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA)

(ADDTOVAR NLAML)

(ADDTOVAR LAMA NEW.INBASKET.CALL)
)
(PUTPROPS NEWNSMAIL COPYRIGHT ("Xerox Corporation" 1989 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (12380 13895 (\NS.NEW.READ.ENVELOPE.ITEM 12390 . 13155) (\NS.NEW.WRITE.ENVELOPE.ITEM 
13157 . 13893)) (14631 16309 (\NS.READ.HEADING.ATTRIBUTE 14641 . 15619) (\NS.WRITE.HEADING.ATTRIBUTE 
15621 . 16307)) (17196 18599 (\NSMAIL.READ.RNAME 17206 . 17764) (\NSMAIL.WRITE.RNAME 17766 . 18257) (
\NSMAIL.RNAME.LENGTH 18259 . 18597)) (18695 20769 (RNAME.TO.STRING 18705 . 18884) (X400.NAME.TO.STRING
 18886 . 20573) (EQUAL.RNAMES 20575 . 20767)) (20794 40694 (\NSMAIL.NEW.SEND.PARSE 20804 . 23178) (
\NSMAIL.CHECK.ENUMERATION 23180 . 24099) (\NSMAIL.NEW.SEND 24101 . 33237) (
\NSMAIL.NEW.INVALID.RECIPIENTS 33239 . 33820) (\NSMAIL.BUILD.HEADING 33822 . 35121) (
\NSMAIL.POST.BODY.PART 35123 . 36954) (\NSMAIL.NEW.PREPARE.ATTACHMENT 36956 . 38277) (
\NSMAIL.CHECK.ABORT 38279 . 38637) (\NSMAIL.NEW.FINDSERVER 38639 . 39694) (\NSMAIL.NEW.CHECKSERVER 
39696 . 40692)) (42644 83283 (\NSMAIL.NEW.AUTHENTICATE 42654 . 44139) (NEWNS.POLLNEWMAIL 44141 . 44456
) (NEWNS.OPENMAILBOX 44458 . 45142) (\NSMAIL.NEW.CHECK 45144 . 49574) (NEWNS.NEXTMESSAGE 49576 . 50070
) (NEWNS.RETRIEVEMESSAGE 50072 . 53936) (\NSMAIL.READ.BODY.PARTS 53938 . 59349) (\NSMAIL.COPY.IA5 
59351 . 60100) (\NSMAIL.COPY.NSTEXTFILE 60102 . 62251) (\NSMAIL.READ.HEADING 62253 . 64988) (
\NSMAIL.PARSE.ANNOTATION 64990 . 65724) (\NSMAIL.EMIT.ANNOTATION 65726 . 66994) (LA.TRIM.WHITESPACE 
66996 . 67118) (\NSMAIL.READ.FORWARDING 67120 . 68145) (\NSMAIL.NEW.PRINT.HEADING 68147 . 73771) (
\NSMAIL.NEW.PRINT.NAMES 73773 . 74749) (\NSMAIL.EMIT.FORWARDING 74751 . 76585) (\NSMAIL.GDATE 76587 . 
76703) (\NSMAIL.TRANSLATE.IP.MESSAGEID 76705 . 77252) (\NSMAIL.MAYBE.QUOTE 77254 . 77892) (NULL.NSNAME
 77894 . 78236) (\NSMAIL.HANDLE.DELIVERY.REPORT 78238 . 81269) (\NSMAIL.RECIPIENT.NAME 81271 . 81498) 
(NEW.INBASKET.CALL 81500 . 82124) (NEWNS.CLOSEMAILBOX 82126 . 82842) (\NSMAIL.NEW.LOGOFF 82844 . 83281
)) (83836 85335 (\NS.READ.ENVELOPE.ITEM 83846 . 84603) (\NS.WRITE.ENVELOPE.ITEM 84605 . 85333)))))
STOP
\ No newline at end of file
diff --git a/internal/library/NSMAIL b/internal/library/NSMAIL
deleted file mode 100644
index c41cbeec..00000000
--- a/internal/library/NSMAIL
+++ /dev/null
@@ -1 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Jun-90 18:42:52" {DSK}<usr>local>lde>lispcore>internal>library>NSMAIL.;3 132387 

      changes to%:  (VARS NSMAILCOMS)
                    (FNS NS.POLLNEWMAIL NS.OPENMAILBOX \NSMAIL.CHECK \NSMAIL.FIX.MAILBOX.LOCATIONS 
                         NS.NEXTMESSAGE \NSMAIL.READ.ENVELOPES INBASKET.CALL NS.RETRIEVEMESSAGE 
                         \NSMAIL.RETRIEVE \NSMAIL.SIGNAL.ERROR NS.CLOSEMAILBOX \NSMAIL.LOGOFF 
                         \NSMAIL.CHANGE.STATUS \MAILOBJ.DISPLAY \MAILOBJ.IMAGEBOX \MAILOBJ.PUT 
                         \MAILOBJ.BUTTONEVENTFN \MAILOBJ.HARDCOPY \MAILOBJ.FB \MAILOBJ.PUT.FILE 
                         \MAILOBJ.VIEW \MAILOBJ.EXPAND \NSMAIL.SEND)

      previous date%: "14-Feb-90 17:23:04" {DSK}<usr>local>lde>lispcore>internal>library>NSMAIL.;2)


(* ; "
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT NSMAILCOMS)

(RPAQQ NSMAILCOMS
       [(COMS                                                (* ; "Basic mail protocol")
              (COURIERPROGRAMS MAILTRANSPORT INBASKET)
              (FNS \NSMAIL.AUTHENTICATE \NSMAIL.MAKE.MAILSERVERS \NSMAIL.LOGIN NS.FINDMAILBOXES)
              (ALISTS (LAFITEMODELST NS STAR)))
        (COMS                                                (* ; "Retrieving mail")
              (FNS NS.POLLNEWMAIL NS.OPENMAILBOX \NSMAIL.CHECK \NSMAIL.FIX.MAILBOX.LOCATIONS 
                   NS.NEXTMESSAGE \NSMAIL.READ.ENVELOPES INBASKET.CALL NS.RETRIEVEMESSAGE 
                   \NSMAIL.RETRIEVE \NSMAIL.EOF.ON.RETRIEVE \NSMAIL.READ.SERIALIZED.TREE 
                   \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT 
                   \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM 
                   \NSMAIL.PRINT.HEADERFIELDS \NSMAIL.PRINT.NAMES)
                                                             (* ; "Error handling")
              (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR)
                                                             (* ; "Close/flush protocol")
              (FNS NS.CLOSEMAILBOX \NSMAIL.LOGOFF \NSMAIL.CHANGE.STATUS)
              [INITVARS (NSMAILDEBUGFLG)
                     (NSMAIL.LEAVE.ATTACHMENTS)
                     (NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID 
                                                 Reply-to]
              (ADDVARS (\NSMAIL.GOOD.BODYTYPES 2 4)))
        [COMS                                                (* ; 
                                           "Handling attachments as a special kind of image object")
              (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY 
                   \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT)
              (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB 
                   \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY 
                   \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT 
                   \MAILOBJ.PARSE.ATTRIBUTES)
              (ADDVARS (FILING.TYPES (VIEWPOINT 4353)
                              (RES 4428)
                              (XEROX860 5120)
                              (REFERENCE 4427)
                              (MAILFOLDER 4417)))
              (VARS MAILOBJ.REFERENCE.FIELD)
              (INITVARS (MAILOBJ.WINDOWOFFSET 16)
                     (MAILOBJ.SKIPCHAR (CHARCODE ".")))
              (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ)
                     (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED))
              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT)
                                                 (AND (EQ MAKESYSNAME :LYRIC)
                                                      (FILESLOAD (SYSLOAD)
                                                             NSRANDOM]
        (COMS                                                (* ; "sending mail")
              (FNS \NSMAIL.SEND.PARSE \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE 
                   \NSMAIL.PARSE1 NS.REMOVEDUPLICATES \NSMAIL.SEND \NSMAIL.PREPARE.ATTACHMENT 
                   \NSMAIL.GUESS.FILE.TYPE \NSMAIL.SEND.MESSAGE.CONTENT 
                   COURIER.WRITE.STREAM.UNSPECIFIED \NSMAIL.SEND.STREAM.AS.STRING 
                   \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.FINDSERVER \NSMAIL.CHECKSERVER)
              (FILES LAFITEMAIL)
                                                             (* ; "for LAFITE.MAKE.PARSE.TABLE")
              (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
                    )
              (GLOBALVARS \LAPARSE.NSMAIL)
              (INITVARS (\NSMAIL.SERVER.CACHE)
                     (NSMAIL.NET.HINT)
                     (*NSMAIL-MAX-NOTE-LENGTH* 8000)
                     (*NSMAIL-SEND-MAIL-NOTES*)
                     (*NSMAIL-CACHE-TIMEOUT* 14400000)
                     (LAFITEDL.EXT "DL"))
              [P (CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* 
                                      *NSMAIL-SEND-MAIL-NOTES* *NSMAIL-CACHE-TIMEOUT*]
              (ADDVARS (\SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE))
              (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \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 \SERIALIZED.FILE.VERSIONS 
                      \NSMAIL.CTSTANDARD.MESSAGE \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE 
                      \NSMAIL.REFERENCE.BODYTYPE 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
                      MAILOBJ.REFERENCE.FIELD \NSFILING.ATTRIBUTES DEFAULTICONFONT NSPRINT.WATCHERFLG
                      NSMAIL.HEADER.ORDER FILING.TYPES)
               [P (CL:PROCLAIM '(CL:SPECIAL *RETRIEVAL-ERROR*]
               (FILES (SOURCE)
                      LAFITEDECLS)
               (FILES (LOADCOMP)
                      CLEARINGHOUSE)
               (LOCALVARS . T))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML)
                                                                             (LAMA INBASKET.CALL])



(* ; "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  5-Jan-90 18:36 by bvm") (LET ((INFO (\INTERNAL/GETPASSWORD (QUOTE |NS::|))) NSUSERNAME FULLNAME MSERVERS AUTHENTICATED? CREDENTIALS MSG) (SETQ NSUSERNAME (PARSE.NSNAME (CAR INFO))) (COND ((NEQ (SETQ AUTHENTICATED? (COND ((NULL (SETQ FULLNAME (CH.LOOKUP.OBJECT NSUSERNAME))) (QUOTE NoSuchUser)) (T (NS.AUTHENTICATE (SETQ CREDENTIALS (NS.MAKE.SIMPLE.CREDENTIALS (CONS FULLNAME (CDR INFO)))))))) T) (printout PROMPTWINDOW T "Cannot authenticate user " (NSNAME.TO.STRING (OR FULLNAME NSUSERNAME) T) " because: " (SELECTQ (SETQ \LAFITE.AUTHENTICATION.FAILURE AUTHENTICATED?) (CredentialsInvalid "Login incorrect") (KeysUnavailable (CONCAT "Authentication server unavailable for domain " (fetch NSDOMAIN of FULLNAME))) (NoSuchUser "No such user") AUTHENTICATED?) ".") NIL) (T (create LAFITEMODEDATA FULLUSERNAME _ (NSNAME.TO.STRING FULLNAME T) UNPACKEDUSERNAME _ FULLNAME CREDENTIALS _ CREDENTIALS SHORTUSERNAME _ (CONCAT (fetch NSOBJECT of FULLNAME) (QUOTE %:) (COND ((NOT (STRING-EQUAL (fetch NSDOMAIN of FULLNAME) CH.DEFAULT.DOMAIN)) (fetch NSDOMAIN of FULLNAME)) (T ""))) MAILSERVERS _ (\NSMAIL.MAKE.MAILSERVERS (NS.FINDMAILBOXES FULLNAME) FULLNAME CREDENTIALS))))))
)

(\NSMAIL.MAKE.MAILSERVERS
(LAMBDA (SERVERS FULLNAME CREDENTIALS) (* ; "Edited 16-Aug-89 16:05 by bvm") (* ;; "Return a list of mail server info for insertion in the MAILSERVERS slot of NS mode.  Each element of SERVERS is of the form (name . addresses)") (if (NULL SERVERS) then (printout PROMPTWINDOW T "There are no mail servers for user " (NSNAME.TO.STRING FULLNAME T)) NIL else (for PAIR in SERVERS bind (FIRSTTIME _ T) collect (create MAILSERVER MAILPORT _ (CADR PAIR) MAILSERVERNAME _ (CAR PAIR) MAILSERVEROPS _ (CONSTANT (LIST (FUNCTION NS.POLLNEWMAIL) (FUNCTION NS.OPENMAILBOX) (FUNCTION NS.NEXTMESSAGE) (FUNCTION NS.RETRIEVEMESSAGE) (FUNCTION NS.CLOSEMAILBOX))) MAILSTATE _ (create NSMAILSTATE STATENAME _ FULLNAME STATEADDRESS _ (CADR PAIR) STATECREDENTIALS _ CREDENTIALS STATETIMER _ (if FIRSTTIME then (* ; "Only need a timer on the first server") (SETQ FIRSTTIME NIL) (SETUPTIMER *NSMAIL-CACHE-TIMEOUT*)))))))
)

(\NSMAIL.LOGIN
(LAMBDA NIL (* ; "Edited  7-Jun-88 19:37 by bvm") (if (LAFITE.PROMPT.FOR.LOGIN (QUOTE |NS::|)) then (* ; "Got the login, now authenticate") (\LAFITE.GET.USER.DATA (QUOTE NS) NIL T) (\LAFITE.WAKE.WATCHER)))
)

(NS.FINDMAILBOXES
(LAMBDA (USERNAME) (* ; "Edited 18-Jul-88 12:55 by bvm") (LET ((MAILBOXENTRY (CH.RETRIEVE.ITEM (PARSE.NSNAME USERNAME) (CH.PROPERTY (QUOTE MAILBOXES)) (QUOTE MAILBOX.VALUES)))) (AND MAILBOXENTRY (for MB in (COURIER.FETCH (CLEARINGHOUSE . MAILBOX.VALUES) MAIL.SERVICE of (CADR MAILBOXENTRY)) when (SETQ MB (COND ((LOOKUP.NS.SERVER MB NIL T)) (T (PRINTOUT PROMPTWINDOW T "Cannot find address for mail server " MB) NIL))) collect MB))))
)
)

(ADDTOVAR LAFITEMODELST (NS 1 \NSMAIL.SEND.PARSE \NSMAIL.SEND \NSMAIL.MAKEANSWERFORM 
                                \NSMAIL.AUTHENTICATE \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P 
                                \NSMAIL.LOGIN)
                            (STAR . NS))



(* ; "Retrieving mail")

(DEFINEQ

(NS.POLLNEWMAIL
  [LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER)(* ; "Edited 26-Jun-90 18:21 by jds")
    (LET (RESULT N)
         (COND
            ((NOT (SETQ RESULT (\NSMAIL.CHECK ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER)))
                                                             (* ; "Server down")
             '?)
            ((AND (> (SETQ N (fetch (NSMAILSTATE STATEFIRSTNEW) of (fetch MAILSTATE
                                                                              of MAILSERVER)))
                     0)
                  (> (SETQ N (ADD1 (- (COURIER.FETCH (INBASKET . INBASKET.STATE)
                                             LASTINDEX of RESULT)
                                      N)))
                     0))                                     (* ; "Return number of messages")
             N])

(NS.OPENMAILBOX
  [LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER)(* ; "Edited 26-Jun-90 18:21 by jds")
    (LET ((STREAM (\NSMAIL.COURIER.OPEN ADDRESS))
          NSMAILSTATE INBASKETSTATE FIRSTINDEX LASTINDEX N)
         (COND
            ((NULL STREAM)
             NIL)
            ((OR (NULL (SETQ INBASKETSTATE (\NSMAIL.CHECK ADDRESS REGISTEREDNAME CREDENTIALS 
                                                  MAILSERVER STREAM T)))
                 (EQ (CAR INBASKETSTATE)
                     'ERROR))
             (CLOSEF STREAM)                                 (* ; "Return error msg")
             (CONS NIL (CDR INBASKETSTATE)))
            ((EQ [SETQ N (COND
                            ((EQ [SETQ FIRSTINDEX (fetch (NSMAILSTATE STATEFIRSTNEW)
                                                     of (SETQ NSMAILSTATE (fetch MAILSTATE
                                                                                 of MAILSERVER]
                                 0)                          (* ; "No NEW messages at all")
                             0)
                            (T                               (* ; "Protocol suggests using (courier.fetch (inbasket . inbasket.state) newcount inbasketstate) but that's always zero.")
                               (ADD1 (- (SETQ LASTINDEX (COURIER.FETCH (INBASKET . INBASKET.STATE)
                                                               LASTINDEX of INBASKETSTATE))
                                        FIRSTINDEX]
                 0)
             (\NSMAIL.LOGOFF NSMAILSTATE STREAM)
             'EMPTY)
            (T                                               (* ; "Return (MAILBOX  . properties)")
               (CONS (create NSMAILBOX
                            NSMAILSTREAM _ STREAM
                            NSMAILLASTINDEX _ LASTINDEX
                            NSMAILSTATE _ NSMAILSTATE)
                     (LIST '%#OFMESSAGES N])

(\NSMAIL.CHECK
  [LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS)
                                                             (* ; "Edited 26-Jun-90 18:21 by jds")

(* ;;; "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 (MAILSERVER MAILSTATE) of MAILSERVER))
               SESSION POLLRESULT LASTINDEX FIRSTNEW OLDLAST CONTINUANCE TIMER)
              (COND
                 ((AND JUSTCHECKING (SETQ TIMER (fetch (NSMAILSTATE STATETIMER) of STATE))
                       (TIMEREXPIRED? TIMER)
                       (\NSMAIL.FIX.MAILBOX.LOCATIONS))  (* ; "Some mailboxes moved")
                  (GO FAILFAST)))
              (SETQ SESSION (fetch (NSMAILSTATE STATESESSION) of STATE))
              (SETQ FIRSTNEW (fetch (NSMAILSTATE STATEFIRSTNEW) of STATE))
              (SETQ OLDLAST (fetch (NSMAILSTATE STATEOLDLAST) of STATE))
          RETRY
              [COND
                 ((NULL SESSION)
                  (if (AND (NOT NSMAIL.LEAVE.ATTACHMENTS)
                               JUSTCHECKING)
                      then                               (* ; 
                                                           "Just polling, don't need session")
                            (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
                                                    'INBASKET
                                                    'MAILPOLL
                                                    (CAR CREDENTIALS)
                                                    (CDR CREDENTIALS)
                                                    (fetch (NSMAILSTATE STATENAME) of STATE)
                                                    'RETURNERRORS))
                            (GO GOTRESULT))
                  [COND
                     ((NULL STREAM)                          (* ; 
                                                  "Need a real Courier stream for some reason here")
                      (COND
                         ((SETQ STREAM (COURIER.OPEN ADDRESS NIL T 'NSMAIL))
                          (RESETSAVE NIL (LIST '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 'INBASKET 'LOGON (CAR 
                                                                                          CREDENTIALS
                                                                                            )
                                                        (CDR CREDENTIALS)
                                                        (fetch (NSMAILSTATE STATENAME)
                                                           of STATE)
                                                        \NULL.CACHE.VERIFIER T 'RETURNERRORS))
                                                (T (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
                                                          'INBASKET
                                                          'LOGON
                                                          (CAR CREDENTIALS)
                                                          (CDR CREDENTIALS)
                                                          (fetch (NSMAILSTATE STATENAME)
                                                             of STATE)
                                                          \NULL.CACHE.VERIFIER T 'RETURNERRORS]
                          'ERROR)
                      (GO ERROR)))
                  (replace (NSMAILSTATE STATESESSION) of STATE with (SETQ SESSION
                                                                                 (CAR SESSION]
              [SETQ POLLRESULT (COND
                                  ((NULL STREAM)             (* ; "Just checking")
                                   (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET 'INBASKET
                                          'MAILCHECK SESSION 'RETURNERRORS))
                                  (T (COURIER.CALL STREAM 'INBASKET 'MAILCHECK SESSION 'RETURNERRORS]
          GOTRESULT
              [COND
                 ((NULL POLLRESULT)                          (* ; "Failed somehow")
                  (RETURN NIL))
                 ((EQ (CAR (LISTP POLLRESULT))
                      'ERROR)
                  (COND
                     ((EQ (CADR POLLRESULT)
                          'SESSION.ERROR)                    (* ; 
                                                           "Session timed out, start a new one")
                      (replace (NSMAILSTATE STATESESSION) of STATE with (SETQ SESSION NIL
                                                                                     ))
                      (replace (NSMAILSTATE STATEFIRSTNEW) of STATE with (SETQ FIRSTNEW 
                                                                                      NIL))
                      (replace (NSMAILSTATE STATEOLDLAST) of STATE with (SETQ OLDLAST NIL
                                                                                     ))
                      (GO RETRY))
                     (T (SETQ SESSION POLLRESULT)
                        (GO ERROR]
              (replace (NSMAILSTATE STATELASTERROR) of STATE with NIL)
              (if SESSION
                  then                                   (* ; 
                                               "MAILCHECK returned 2 values: state and continuance")
                        (SETQ CONTINUANCE (CADR POLLRESULT))
                        (SETQ POLLRESULT (CAR POLLRESULT)))
              (COND
                 ((EQ (SETQ LASTINDEX (COURIER.FETCH (INBASKET . INBASKET.STATE)
                                             LASTINDEX of POLLRESULT))
                      0)                                     (* ; "Mailbox is empty")
                  (replace (NSMAILSTATE STATEFIRSTNEW) of STATE with 0))
                 ((NOT NSMAIL.LEAVE.ATTACHMENTS)             (* ; 
                                           "Retrieving all mail, so we don't care about NEW vs OLD")
                  (replace (NSMAILSTATE STATEFIRSTNEW) of STATE with 1)
                  (replace (NSMAILSTATE STATEOLDLAST) of STATE with LASTINDEX))
                 ((OR (NULL OLDLAST)
                      (ILESSP OLDLAST LASTINDEX)
                      (NOT JUSTCHECKING)
                      (NULL FIRSTNEW))                       (* ; 
                                                      "Need to accurately locate first NEW message")
                  [replace (NSMAILSTATE STATEFIRSTNEW) of STATE
                     with (COND
                                 (STREAM (COURIER.CALL STREAM 'INBASKET 'LOCATE SESSION 'NEW
                                                'NOERROR))
                                 (T (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET 'INBASKET
                                           'LOCATE SESSION 'NEW 'RETURNERRORS]
                  (replace (NSMAILSTATE STATEOLDLAST) of STATE with LASTINDEX)))
              [replace (MAILSERVER CONTINUANCE) of MAILSERVER
                 with (AND (FIXP CONTINUANCE)
                               (ITIMES 1000 (IQUOTIENT (ITIMES CONTINUANCE 4)
                                                   5]        (* ; 
                                      "Tell poller to call again soon enough to keep session alive")
              (RETURN POLLRESULT)
          ERROR
              [if [AND [NOT (EQUAL (CDR SESSION)
                                       '(CONNECTION.PROBLEM NoResponse]
                           (NOT (EQUAL (CDR SESSION)
                                       (fetch (NSMAILSTATE STATELASTERROR) of STATE]
                  then 

                        (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.")

                        (replace (NSMAILSTATE STATELASTERROR) of STATE with (CDR SESSION)
                               )
                        (LET [(ERRMSG (CASE (CADR SESSION)
                                          ((REJECT)          (* ; "3rd element = (reason ...)")
                                             (CAADDR SESSION))
                                          ((SERVICE.ERROR ACCESS.ERROR) 
                                                             (* ; 
              "the specific reason is just as informative, and more readable than the whole error.")
                                             (CADDR SESSION))
                                          (T (COND
                                                (NSWIZARDFLG (HELP SESSION)))
                                             (SUBSTRING (CDR SESSION)
                                                    2 -2)))]
                             (if RETURNERRORS
                                 then (RETURN (CONS 'ERROR ERRMSG))
                               elseif (AND (EQ ERRMSG 'NoSuchRecipients)
                                               (\NSMAIL.FIX.MAILBOX.LOCATIONS))
                                 then 

                                 (* ;; "Rather odd message.  We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately")

                                       (replace (MAILSERVER CONTINUANCE) of MAILSERVER
                                          with 0)
                               else (LET ((*PRINT-CASE* :UPCASE))
                                                             (* ; "Lousy atomic error names...")
                                             (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A"
                                                    (fetch (MAILSERVER MAILSERVERNAME)
                                                       of MAILSERVER)
                                                    (CASE ERRMSG
                                                        (NoSuchService "Mail service not running")
                                                        (T ERRMSG))]
              (RETURN NIL)
          FAILFAST))])

(\NSMAIL.FIX.MAILBOX.LOCATIONS
  [LAMBDA NIL                                            (* ; "Edited 26-Jun-90 18:21 by jds")

    (* ;; "Called when we think user's mailboxes may have moved.  If they have, sets new info into NS mode and returns T.")

    (LET
     ((OLDDATA (\LAFITE.GET.USER.DATA 'NS))
      OLDSERVERS NEWSERVERS FULLNAME)
     (if (AND OLDDATA (SETQ OLDSERVERS (fetch (LAFITEMODEDATA MAILSERVERS) of OLDDATA)))
         then                                            (* ; 
         "Actually, if we got here at all, OLDSERVERS surely is non-NIL.  The check is for sanity.")
         [SETQ NEWSERVERS (NS.FINDMAILBOXES (SETQ FULLNAME (fetch (LAFITEMODEDATA 
                                                                                 UNPACKEDUSERNAME)
                                                                  of OLDDATA]
         [LET [(STATE (fetch (MAILSERVER MAILSTATE) of (CAR OLDSERVERS]
                                                             (* ; 
                                    "Reset the timer that tells us when next to check on location.")
              (replace (NSMAILSTATE STATETIMER) of STATE
                 with (SETUPTIMER (if NEWSERVERS
                                          then *NSMAIL-CACHE-TIMEOUT*
                                        else             (* ; 
                                                           "Couldn't find servers?  Try again soon")
                                              60000)
                                 (fetch (NSMAILSTATE STATETIMER) of STATE]
         (if [AND NEWSERVERS
                      (OR (NOT (EQ (LENGTH NEWSERVERS)
                                   (LENGTH OLDSERVERS)))
                          (for SERVER in OLDSERVERS as PAIR in NEWSERVERS
                             thereis (OR (NOT (EQUAL.CH.NAMES (CAR PAIR)
                                                         (fetch MAILSERVERNAME of SERVER)))
                                             (NOT (for I from 0 to 4
                                                     bind (SERVERADDR _ (fetch MAILPORT
                                                                               of SERVER))
                                                           (PAIRADDR _ (CADR PAIR))
                                                     always (EQ (\GETBASE SERVERADDR I)
                                                                    (\GETBASE PAIRADDR I]
             then 

                   (* ;; "Yes, mailbox info is different.  Fix it up.  Note that we do nothing if no mail servers were found.  This is to avoid screwing up when we failed to talk to a clearinghouse (since otherwise we would find ourselves with no servers, hence nobody to wake up periodically and find out where the servers have moved to).  If only CH.RETRIEVE.ITEM could give us an error return in that case...")

                   (replace (LAFITEMODEDATA MAILSERVERS) of OLDDATA
                      with (\NSMAIL.MAKE.MAILSERVERS NEWSERVERS FULLNAME (fetch
                                                                                  (LAFITEMODEDATA
                                                                                   CREDENTIALS)
                                                                                    of OLDDATA)))
                   T])

(NS.NEXTMESSAGE
  [LAMBDA (MAILBOX)                                      (* ; "Edited 26-Jun-90 18:18 by jds")
    (PROG ((ENVELOPES (fetch (NSMAILBOX NSMAILENVTAIL) of MAILBOX)))
          (SELECTQ ENVELOPES
              (NIL                                           (* ; "First time, read all envelopes")
                   (COND
                      ([OR (fetch (NSMAILBOX NSMAILENVELOPES) of MAILBOX)
                           (NULL (SETQ ENVELOPES (\NSMAIL.READ.ENVELOPES MAILBOX]
                       (RETURN)))
                   (replace (NSMAILBOX NSMAILENVELOPES) of MAILBOX with ENVELOPES)
                   (replace (NSMAILBOX NSMAILENVTAIL) of MAILBOX with ENVELOPES))
              (T                                             (* ; "Finished")
                 (RETURN))
              NIL)
          (RETURN (CAR ENVELOPES])

(\NSMAIL.READ.ENVELOPES
  [LAMBDA (MAILBOX)                                      (* ; "Edited 26-Jun-90 18:19 by jds")
    (LET [(ENVELOPES (INBASKET.CALL MAILBOX 'LIST (fetch (NSMAILBOX NSMAILSESSION)
                                                         of MAILBOX)
                            (COURIER.CREATE (INBASKET . RANGE)
                                   FIRST _ (fetch (NSMAILBOX NSMAILFIRSTINDEX) of MAILBOX)
                                   LAST _ (fetch (NSMAILBOX NSMAILLASTINDEX) of MAILBOX))
                            (COURIER.CREATE (INBASKET . SELECTIONS)
                                   TRANSPORT.ENVELOPE _ T INBASKET.ENVELOPE _ T MAIL.ATTRIBUTES _
                                   (LIST (\NSMAIL.ATTRIBUTE.TYPE BodyType)))
                            '(INBASKET . MESSAGE.DESCRIPTION]
         (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])

(INBASKET.CALL
  [CL:LAMBDA (MAILBOX PROCEDURE &REST ARGS)              (* ; "Edited 26-Jun-90 18:19 by jds")
         (PROG ((STREAM (fetch (NSMAILBOX NSMAILSTREAM) of MAILBOX))
                RESULT)
           LP  (if (AND (EQ [CAR (LISTP (SETQ RESULT (CL:APPLY (FUNCTION COURIER.CALL)
                                                                STREAM
                                                                'INBASKET PROCEDURE ARGS]
                                'ERROR)
                            (CASE (CAR (LAST ARGS))
                                (NOERROR NIL)
                                (RETURNERRORS                (* ; 
                                              "We'll only handle stream lost--caller gets the rest")
                                   (EQ (CADR RESULT)
                                       'STREAM.LOST))
                                (T                           (* ; 
                                                           "Probably an error was already signaled")
                                   T)))
                   then (SETQ STREAM (\NSMAIL.SIGNAL.ERROR RESULT MAILBOX 'INBASKET PROCEDURE
                                                ))
                         (GO LP)
                 else (RETURN RESULT])

(NS.RETRIEVEMESSAGE
  [LAMBDA (MAILBOX MSGOUTFILE)                           (* ; "Edited 26-Jun-90 18:19 by jds")
    (LET ((*RETRIEVAL-ERROR* NIL)
          (ENVELOPE (pop (fetch (NSMAILBOX NSMAILENVTAIL) of MAILBOX)))
          TYPE)
         (if (OR NSMAIL.LEAVE.ATTACHMENTS (MEMB (SETQ TYPE (CADR (ASSOC 'BodyType ENVELOPE)))
                                                    \NSMAIL.GOOD.BODYTYPES))
             then                                        (* ; 
            "Retrieve ordinary text message, or retrieve the text part and leave attachment behind")
                   (\NSMAIL.RETRIEVE MAILBOX ENVELOPE [FUNCTION (LAMBDA (MSGSTREAM)

                                                           (* ;; 
                "MSGSTREAM is a bulk data stream containing content of msg, as a 'serialized file'")

                                                                      (SETFILEINFO
                                                                       MSGSTREAM
                                                                       'ENDOFSTREAMOP
                                                                       (FUNCTION 
                                                                        \NSMAIL.EOF.ON.RETRIEVE))
                                                                      (
                                                                   \NSMAIL.CHECK.SERIALIZED.VERSION
                                                                       MSGSTREAM)
                                                                      (\NSMAIL.READ.SERIALIZED.TREE
                                                                       MSGSTREAM MSGOUTFILE
                                                                       (CDR ENVELOPE]
                          (GETFILEPTR MSGOUTFILE)
                          MSGOUTFILE)
                   (COND
                      (*RETRIEVAL-ERROR* (printout MSGOUTFILE T *RETRIEVAL-ERROR* T)))
           else                                          (* ; 
                "Not text or mail note, so retrieve the whole thing raw and make an %"attachment%"")
                 (SETQ TYPE (\TYPE.FROM.FILETYPE TYPE))
                 (LET ((BUFFER (OPENSTREAM '{NODIRCORE} 'BOTH))
                       BODY ATTACHPOINT ATTRIBUTE.END)
                      [SETQ BODY (\NSMAIL.RETRIEVE
                                  MAILBOX ENVELOPE (FUNCTION (LAMBDA (BULKSTREAM)
                                                             (* ; "Just eat it raw")
                                                               (LET
                                                                [(BODY (OPENSTREAM
                                                                        '{NODIRCORE}
                                                                        'BOTH NIL
                                                                        '((ENDOFSTREAMOP 
                                                                              \NSMAIL.EOF.ON.RETRIEVE
                                                                                 ]
                                                                (COPYBYTES BULKSTREAM BODY)
                                                                BODY]
                      (SETFILEPTR BODY 0)
                      (\NSMAIL.CHECK.SERIALIZED.VERSION BODY)
                      (\NSMAIL.READ.SERIALIZED.TREE BODY BUFFER (CDR ENVELOPE)
                             T)
                      (SETQ ATTRIBUTE.END (GETFILEPTR BODY))
                      (SETQ BUFFER (OPENTEXTSTREAM BUFFER NIL NIL NIL (LIST 'FONT LAFITEDISPLAYFONT))
                       )
                      (TEDIT.INSERT.OBJECT (\MAILOBJ.CREATE BODY TYPE ATTRIBUTE.END)
                             BUFFER
                             (if (SETQ ATTACHPOINT (TEDIT.FIND BUFFER "

Attachment: " 1))
                                 then                    (* ; 
                                                           "Insert object at end of this line")
                                       (+ ATTACHPOINT 14)
                               else                      (* ; "Shouldn't happen")
                                     (+ (TEDIT.FIND BUFFER "

" 1)
                                        2)))
                      (COPYBYTES (OPENSTREAM (COERCETEXTOBJ BUFFER 'FILE)
                                        'INPUT)
                             MSGOUTFILE)                     (* ; 
         "Would like this to be (COERCETEXTOBJ BUFFER (QUOTE FILE) MSGOUTFILE) but Tedit has a bug")
                      ))
         (COND
            ((NEQ (CADR ENVELOPE)
                  'NO)                                       (* ; 
  "Read okay, tell close mailbox to delete it.  NO set when there is an attachment to leave behind")
             (RPLACA (CDR ENVELOPE)
                    'DELETE])

(\NSMAIL.RETRIEVE
  [LAMBDA (MAILBOX ENVELOPE RETRIEVEFN START MSGOUTFILE) (* ; "Edited 26-Jun-90 18:19 by jds")

    (* ;; "Perform an Inbasket.Retrieve on the specified message, using RETRIEVEFN to read the bulk data.  If START is true, then the file pointer on MSGOUTFILE is returned to START if we have to retry")

    (bind RESULT while (EQ [CAR (LISTP (SETQ RESULT (COURIER.CALL (fetch (NSMAILBOX
                                                                                      NSMAILSTREAM)
                                                                             of MAILBOX)
                                                                   'INBASKET
                                                                   'RETRIEVE
                                                                   (fetch (NSMAILBOX 
                                                                                     NSMAILSESSION)
                                                                      of MAILBOX)
                                                                   (CAR ENVELOPE)
                                                                   \NSMAIL.CTSTANDARD.MESSAGE 
                                                                   RETRIEVEFN 'RETURNERRORS]
                                   'ERROR) do            (* ; "Maybe lost the stream?")
                                                 (\NSMAIL.SIGNAL.ERROR RESULT MAILBOX
                                                        'INBASKET
                                                        'RETRIEVE)
                                                 (AND START (SETFILEPTR MSGOUTFILE START))
       finally (RETURN RESULT])

(\NSMAIL.EOF.ON.RETRIEVE
(LAMBDA (STREAM) (DECLARE (USEDFREE *RETRIEVAL-ERROR*)) (* ; "Edited  9-Sep-88 12:29 by bvm") (SETQ *RETRIEVAL-ERROR* "**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 17-Jan-89 17:30 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 (TYPE VALUE HEADERFIELDS LENGTH NOTEBODY HEADERS SENDER TYPEINFO DISCARDED COERCED FORMATSTREAM BODYSTREAM) (for N from (\WIN MSGSTREAM) to 1 by -1 do (SETQ TYPE (COURIER.READ MSGSTREAM NIL (QUOTE LONGCARDINAL))) (COND ((NOT (find old TYPEINFO in \NSMAIL.ATTRIBUTES suchthat (EQ (CADR TYPEINFO) TYPE))) (* ; "We don't understand this attribute") (if (AND NSMAILDEBUGFLG (NOT ATTACHMENT)) then (push DISCARDED 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 (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY ATTACHMENT DISCARDED) (* ; "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) (* ; "Save the formatting so we can munge it") (SETQ FORMATSTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM FORMATSTREAM) (RETURN)) (T (PRINTOUT PROMPTWINDOW T "Bad formatted message") (\NSMAIL.READ.STRING.AS.STREAM MSGSTREAM (OPENSTREAM (QUOTE {NULL}) (QUOTE OUTPUT)))))) (T (SETQ VALUE (PROGN (\WIN MSGSTREAM) (COURIER.READ MSGSTREAM (QUOTE MAILTRANSPORT) (CADDR TYPEINFO)))) (COND ((SELECTQ TYPE ((BodyType BodySize) NIL) (Sender (SETQ SENDER VALUE)) (From (COND ((AND (NULL SENDER) (NULL (CDR VALUE))) (SETQ SENDER (CAR VALUE)))) T) T) (push HEADERFIELDS (CONS TYPE VALUE)))))) finally (* ; "Note was not the final attribute.  Print headers accumulated, then the Note last") (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NOTEBODY ATTACHMENT DISCARDED)) (COND (FORMATSTREAM (* ; "This is a TEdit formatted message") (LET ((START (GETFILEPTR MSGOUTFILE))) (\NSMAIL.PRINT.HEADERFIELDS MSGOUTFILE HEADERFIELDS ENVELOPE SENDER NIL ATTACHMENT DISCARDED) (TERPRI MSGOUTFILE) (* ; "We have now printed the header and a blank line.  This is all the added text we have, not counted in the formatting") (SETQ START (- (GETFILEPTR MSGOUTFILE) START)) (if NOTEBODY then (COPYBYTES NOTEBODY MSGOUTFILE 0 -1) (if (NULL ATTACHMENT) then (* ; "There better be nothing more here.  In case of attachment, caller is handling it separately") (\NSMAIL.DISCARD.SERIALIZED.CONTENT MSGSTREAM)) else (* ; "One or the other of these clauses (never both) produced the body of the message, to which the formatting applies.") (\NSMAIL.READ.SERIALIZED.CONTENT MSGSTREAM MSGOUTFILE)) (LA.ADJUST.FORMATTING FORMATSTREAM MSGOUTFILE START) (if (NULL ATTACHMENT) then (* ; "Have to get past the children.  This better be null") (RPTQ (\WIN MSGSTREAM) (to (\WIN MSGSTREAM) do (* ; "Read and discard an attribute...") (COURIER.READ MSGSTREAM NIL (QUOTE LONGCARDINAL)) (COURIER.SKIP.SEQUENCE MSGSTREAM NIL (QUOTE UNSPECIFIED))))))) ((NULL ATTACHMENT) (* ; "No formatting, possibly read body now") (TERPRI MSGOUTFILE) (* ; "Set off header") (COND ((EQ (CAR ENVELOPE) (QUOTE NO)) (* ; "Can't read this attachment, leave in mailbox") (printout MSGOUTFILE T T "*** Attachment retained in mailbox for retrieval by other means ***" T) (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  5-May-89 14:47 by bvm") (LET ((V (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL)))) (SELECTC V (\SERIALIZED.FILE.VERSIONS T) (HELP (CL:FORMAT NIL "Lafite does not understand serialized file version ~D.
RETURN to attempt retrieval anyway." V))))))

(\NSMAIL.READ.SERIALIZED.CONTENT
(LAMBDA (INSTREAM OUTSTREAM) (* ; "Edited 17-Jan-89 17:14 by bvm") (* ;;; "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 BYTECOUNT do (SETQ LASTSEGMENT? (NEQ (\WIN INSTREAM) 0)) (COND ((NEQ (SETQ BYTECOUNT (UNFOLD (\WIN INSTREAM) BYTESPERWORD)) 0) (RPTQ (SUB1 BYTECOUNT) (\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)))) (LASTSEGMENT? (* ; "Null body.  Throw out the lastByteIsSignificant flag") (\WIN INSTREAM))) repeatuntil LASTSEGMENT?))
)

(\NSMAIL.DISCARD.SERIALIZED.CONTENT
(LAMBDA (INSTREAM) (* ; "Edited 17-Jan-89 17:17 by bvm") (* ;;; "Interprets INSTREAM as SerializedTree.Content, i.e., as a Bulkdata.StreamOfUnspecified followed by the lastByteIsSignificant flag and discards it all") (do (if (NEQ (PROG1 (\WIN INSTREAM) (RPTQ (UNFOLD (\WIN INSTREAM) BYTESPERWORD) (\BIN INSTREAM))) 0) then (* ; "Finished.  Read the lastByteIsSignificant flag") (\WIN INSTREAM) (RETURN))))
)

(\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 DISCARDED) (* ; "Edited  4-Aug-89 18:34 by bvm") (* ;; "Compose message header from HEADERFIELDS and ENVELOPE, printing to MSGOUTFILE.  SENDER is the %"Sender%" field of the message, if we encountered one, or sole element of the %"From%" field.  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 where caller will later insert the attachment object.  DISCARDED is list of fields we didn't recognize.") (LET (TYPE BADNAMES REASON TMP VALUE ID) (SETQ HEADERFIELDS (REVERSE HEADERFIELDS)) (COND (ENVELOPE (if (SETQ VALUE (ASSOC (QUOTE TransportProblem) ENVELOPE)) then (* ; "Return of undeliverable mail") (SETQ HEADERFIELDS (DREMOVE VALUE HEADERFIELDS)) (SETQ VALUE (CADR VALUE)) (* ; "VALUE is (invalidNames envelope)") (PRINTOUT MSGOUTFILE "Date: " (GDATE (COURIER.FETCH (MAILTRANSPORT . POSTMARK) TIME of (CADR (ASSOC (QUOTE Postmark) ENVELOPE))) (DATEFORMAT TIME.ZONE)) T "From: " (NSNAME.TO.STRING (CADR (ASSOC (QUOTE Originator) ENVELOPE)) T) T "Subject: Undeliverable mail" T T) (SETQ BADNAMES (COURIER.FETCH (MAILTRANSPORT . PROBLEM) UNDELIVERABLES of VALUE)) (SETQ REASON (COURIER.FETCH (MAILTRANSPORT . INVALID.NAME) REASON of (CAR BADNAMES))) (PRINTOUT MSGOUTFILE "This message could not be delivered to ") (if (NULL (CDR BADNAMES)) then (PRINTOUT MSGOUTFILE (NSNAME.TO.STRING (COURIER.FETCH (MAILTRANSPORT . INVALID.NAME) NAME of (CAR BADNAMES)) T) " because: " REASON T) else (PRINTOUT MSGOUTFILE "the following recipients") (if (for PAIR in (CDR BADNAMES) always (EQ (COURIER.FETCH (MAILTRANSPORT . INVALID.NAME) REASON of PAIR) REASON)) then (* ; "Same reason for all") (PRINTOUT MSGOUTFILE " because: " REASON) (for PAIR in BADNAMES bind (SEPR _ ": ") do (PRINTOUT MSGOUTFILE SEPR (NSNAME.TO.STRING (COURIER.FETCH (MAILTRANSPORT . INVALID.NAME) NAME of PAIR) T)) (SETQ SEPR ", ") finally (TERPRI MSGOUTFILE)) else (PRINTOUT MSGOUTFILE ":" T) (for PAIR in BADNAMES do (PRINTOUT MSGOUTFILE (NSNAME.TO.STRING (COURIER.FETCH (MAILTRANSPORT . INVALID.NAME) NAME of PAIR) T) " because: " (COURIER.FETCH (MAILTRANSPORT . INVALID.NAME) REASON of PAIR) T)))) (PRINTOUT MSGOUTFILE T "- - - - - - - - -" T) (for PAIR in (CADR VALUE) do (* ; "Replace envelope of remaining message with returned envelope") (if (SETQ TMP (ASSOC (CAR PAIR) ENVELOPE)) then (RPLACD TMP (CDR PAIR)) else (push HEADERFIELDS PAIR)))) (* ;; "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)) ((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 ((NOT (AND SENDER (EQUAL.CH.NAMES SENDER VALUE))) (* ; "The agent that sent the message is not the same as what the header gives as Sender/From.") (push HEADERFIELDS (CONS (if (ASSOC (QUOTE Sender) HEADERFIELDS) then (* ; "There's already a Sender field, so leave it as Originator") (QUOTE Originator) else (QUOTE Sender)) 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 (SORT HEADERFIELDS (FUNCTION (LAMBDA (X Y) (* ;; "X sorts before Y if X is in the well-known order and either Y appears after it or doesn't appear at all.") (AND (SETQ X (FMEMB (CAR X) NSMAIL.HEADER.ORDER)) (OR (FMEMB (CAR Y) X) (NULL (FMEMB (CAR Y) NSMAIL.HEADER.ORDER))))))) when (SETQ VALUE (CDR PAIR)) do (printout MSGOUTFILE (SETQ TYPE (CAR PAIR)) ": ") (CASE TYPE (Date (printout MSGOUTFILE (GDATE VALUE (DATEFORMAT NO.SECONDS TIME.ZONE SPACES)))) ((From To cc Reply-to) (\NSMAIL.PRINT.NAMES VALUE MSGOUTFILE (SELECTQ TYPE (From (* ; "Always fully qualified.  Also check against sender.") (if (AND SENDER (NOT (for NAME in VALUE always (OR (EQ NAME SENDER) (AND (STRING-EQUAL (fetch NSDOMAIN of NAME) (fetch NSDOMAIN of SENDER)) (STRING-EQUAL (fetch NSORGANIZATION of NAME) (fetch NSORGANIZATION of SENDER))))))) then (* ; "Ugh, From and Sender are different domains.  To reduce confusion, force everything to be fully qualified") (SETQ SENDER NIL)) NIL) (Reply-to (* ; "always full-qualified") NIL) SENDER))) ((Sender Originator) (printout MSGOUTFILE (NSNAME.TO.STRING VALUE T))) (Attachment (printout MSGOUTFILE "%"Type " |.I1| VALUE " ID " |.P2| ID "%"") (RPLACA ENVELOPE (QUOTE NO))) (T (while (AND (> (NCHARS VALUE) 0) (EQ (NTHCHARCODE VALUE -1) (CHARCODE CR))) do (* ; "Trailing cr's, e.g., in the Subject line, will cause the header not to parse") (SETQ VALUE (SUBSTRING VALUE 1 -2))) (if (STRPOS "
" VALUE) then (* ; "Internal CR?  I suppose we could print it and make sure there is whitespace at the start of the next line, but why bother?") (SETQ VALUE (CL:SUBSTITUTE #\\ #\Newline VALUE))) (PRIN1 VALUE MSGOUTFILE))) (TERPRI MSGOUTFILE)) (if DISCARDED then (printout MSGOUTFILE "Discarded-Fields: ") (LA.PRINT.COMMA.LIST (REVERSE DISCARDED) MSGOUTFILE) (TERPRI MSGOUTFILE)) (COND (ATTACHMENT (* ; "Reserve a line where the attachment object will be placed.") (PRINTOUT MSGOUTFILE T "Attachment: " T))) (COND (NOTEBODY (TERPRI MSGOUTFILE) (COPYBYTES NOTEBODY MSGOUTFILE 0 -1) (TERPRI MSGOUTFILE)))))
)

(\NSMAIL.PRINT.NAMES
(LAMBDA (NSNAMES OUTSTREAM DEFAULTNAME) (* ; "Edited  5-Jan-90 18:30 by bvm") (for NAME in NSNAMES bind (FIRSTTIME _ T) ORGDIFFERS do (COND (FIRSTTIME (SETQ FIRSTTIME NIL)) (T (PRIN3 ", " OUTSTREAM))) (PRIN3 (fetch NSOBJECT of NAME) OUTSTREAM) (LET ((ORG (fetch NSORGANIZATION of NAME)) (DOM (fetch NSDOMAIN of NAME))) (if (OR (SETQ ORGDIFFERS (NOT (AND DEFAULTNAME (OR (STRING-EQUAL ORG (fetch NSORGANIZATION of DEFAULTNAME)) (EQ (NCHARS ORG) 0))))) (NOT (OR (STRING-EQUAL DOM (fetch NSDOMAIN of DEFAULTNAME)) (EQ (NCHARS DOM) 0)))) then (* ;; "Have to print the domain.  The null string tests are because there exists buggy software that doesn't fill in the domain and org--we want them to default correctly eventually.") (PRIN3 ":" OUTSTREAM) (PRIN3 DOM OUTSTREAM) (if ORGDIFFERS then (* ; "Have to print the org, too") (PRIN3 ":" OUTSTREAM) (PRIN3 ORG OUTSTREAM))))))
)
)



(* ; "Error handling")

(DEFINEQ

(\NSMAIL.COURIER.OPEN
(LAMBDA (ADDRESS) (* ; "Edited  9-Sep-88 12:06 by bvm") (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL) NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSMAIL.ERRORHANDLER)))))
)

(\NSMAIL.ERRORHANDLER
(LAMBDA (STREAM ERRCODE) (* ; "Edited  9-Sep-88 12:35 by bvm") (* ;; "Called when SPP error occurs on NS mail courier connection STREAM.  Fakes an error return from the courier.call.") (LET (POS) (if (AND (EQ ERRCODE (QUOTE STREAM.LOST)) (SETQ POS (STKPOS (FUNCTION COURIER.CALL)))) then (BLOCK 500) (RETFROM POS (QUOTE (ERROR STREAM.LOST)) T) else (\SPP.DEFAULT.ERRORHANDLER STREAM ERRCODE))))
)

(\NSMAIL.SIGNAL.ERROR
  [LAMBDA (ERROR MAILBOX PROGRAM PROCEDURE)              (* ; "Edited 26-Jun-90 18:19 by jds")

    (* ;; "Called when we get an error on an NS mail courier call.  If stream lost, then tries to reestablish the connection, returning a new stream on success.")

    (if (EQ (CADR ERROR)
                'STREAM.LOST)
        then (PRINTOUT PROMPTWINDOW T "Lost NS mail connection, trying to reestablish...")
              (LET [(STREAM (\NSMAIL.COURIER.OPEN (create NSADDRESS
                                                         using (SPP.DESTADDRESS
                                                                    (fetch (NSMAILBOX 
                                                                                      NSMAILSTREAM)
                                                                       of MAILBOX))
                                                               NSSOCKET _ 0]
                   (if STREAM
                       then (PRINTOUT PROMPTWINDOW "done.")
                             (replace (NSMAILBOX NSMAILSTREAM) of MAILBOX with STREAM)
                     else (PRINTOUT PROMPTWINDOW "failed.")
                           (ERROR "NS mail connection lost, can't reestablish")))
      else (COURIER.SIGNAL.ERROR PROGRAM PROCEDURE ERROR])
)



(* ; "Close/flush protocol")

(DEFINEQ

(NS.CLOSEMAILBOX
  [LAMBDA (MAILBOX FLUSH?)                               (* ; "Edited 26-Jun-90 18:19 by jds")
    [COND
       (FLUSH?                                               (* ; 
                                                           "Mark everything either deleted or seen")
              (for E in (fetch (NSMAILBOX 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
                                                                                 (NSMAILBOX 
                                                                                      NSMAILLASTINDEX
                                                                                        )
                                                                                   of MAILBOX)
                                              STATUS]
    (\NSMAIL.LOGOFF (fetch (NSMAILBOX NSMAILSTATE) of MAILBOX)
           (fetch (NSMAILBOX NSMAILSTREAM) of MAILBOX])

(\NSMAIL.LOGOFF
  [LAMBDA (STATE STREAM)                                 (* ; "Edited 26-Jun-90 18:22 by jds")

    (* ;; "Executes the Inbasket.Logoff procedure and clears appropriate state.  Returns true if LOGOFF call succeeded.")

    (LET [(RESULT (COURIER.CALL STREAM 'INBASKET 'LOGOFF (fetch (NSMAILSTATE STATESESSION)
                                                            of STATE)
                         'RETURNERRORS]
         (PROG1 (AND (LISTP RESULT)
                     (NEQ (CAR RESULT)
                          'ERROR))
             (replace (NSMAILSTATE 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 (NSMAILSTATE STATEFIRSTNEW) of STATE with NIL)
             (replace (NSMAILSTATE STATEOLDLAST) of STATE with NIL)
             (CLOSEF STREAM))])

(\NSMAIL.CHANGE.STATUS
  [LAMBDA (MAILBOX START END STATUS)                     (* ; "Edited 26-Jun-90 18:19 by jds")

(* ;;; "Change status of messages START thru END to be STATUS, which is either DELETE or KEEP.  Returns number of messages kept")

    (PROG ((SESSION (fetch (NSMAILBOX NSMAILSESSION) of MAILBOX))
           (STREAM (fetch (NSMAILBOX NSMAILSTREAM) of MAILBOX))
           (RANGE (COURIER.CREATE (INBASKET . RANGE)
                         FIRST _ START LAST _ END)))
          (RETURN (COND
                     ((EQ STATUS 'DELETE)
                      (COURIER.CALL STREAM 'INBASKET 'DELETE SESSION RANGE)
                      0)
                     (T (COURIER.CALL STREAM 'INBASKET 'CHANGE.STATUS SESSION RANGE 'KNOWN)
                        (ADD1 (IDIFFERENCE END START])
)

(RPAQ? NSMAILDEBUGFLG )

(RPAQ? NSMAIL.LEAVE.ATTACHMENTS )

(RPAQ? NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))

(ADDTOVAR \NSMAIL.GOOD.BODYTYPES 2 4)



(* ; "Handling attachments as a special kind of image object")

(DEFINEQ

(\MAILOBJ.CREATE
(LAMBDA (DATA TYPE ATTR.LENGTH NAME MORE.INFO START) (* ; "Edited 14-Feb-90 16:59 by bvm") (* ;; "Create a mail object encapsulating data (a core file in serialized file format).  TYPE is the type of the serialized data.") (OR START (SETQ START 0)) (LET* ((TITLE (SELECTQ TYPE (REFERENCE (* ; "Reference to a file.") (if (NOT MORE.INFO) then (* ; "Try parsing the reference info--returns (REFERENCE info)") (LET* ((INFO (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA (LIST MAILOBJ.REFERENCE.FIELD) START))) (TYPE (\TYPE.FROM.FILETYPE (CADR (ASSOC (QUOTE TYPE) INFO))))) (SETQ NAME (\MAILOBJ.NS.TO.LISP.NAME (CADR (ASSOC (QUOTE HOST) INFO)) (CADR (ASSOC (QUOTE DIRECTORY) INFO)) (CADR (ASSOC (QUOTE NAME) INFO)) (AND (NEQ (CADR (ASSOC (QUOTE FLAGS) INFO)) \MAILOBJ.REFERENCE.LAST.FILED) (CADR (ASSOC (QUOTE VERSION) INFO))) (EQ TYPE (QUOTE DIRECTORY)))) (SETQ MORE.INFO (BQUOTE (FILE.ID (\, (CADR (ASSOC (QUOTE FILE.ID) INFO))) TYPE (\, TYPE)))))) (CL:FORMAT NIL "Reference to ~A ~A" (\MAILOBJ.TYPE.NAME (LISTGET MORE.INFO (QUOTE TYPE))) NAME)) (if NAME then (CONCAT NAME " (" (\MAILOBJ.TYPE.NAME TYPE T) ")") else (\MAILOBJ.TYPE.NAME TYPE)))) (TITLELEN (NCHARS TITLE)) (FONT (AND (> TITLELEN 20) (LET* ((FONT DEFAULTICONFONT) (SIZE (FONTPROP FONT (QUOTE SIZE)))) (* ; "Use a smaller font if available") (if (> TITLELEN 30) then (* ; "This is really getting out of hand...") (SETQ TITLE (CONCAT (SUBSTRING TITLE 1 25) "..."))) (AND (> SIZE 8) (CAR (NLSETQ (FONTCOPY FONT (QUOTE SIZE) (- SIZE 2)))))))) (IMAGE (WINDOWPROP (TITLEDICONW NIL TITLE FONT (QUOTE (0 . 0)) T NIL (QUOTE FILE)) (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.START _ START MAILOBJ.NAME _ NAME MAILOBJ.INFO _ MORE.INFO MAILOBJ.EXPANDABLE _ (PROGN (* ; "True if object has children") (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA (CONSTANT (LIST (ASSOC (QUOTE IS.DIRECTORY) \NSFILING.ATTRIBUTES))) START)))) \MAILOBJ.IMAGEFNS)))
)

(\MAILOBJ.TYPE.NAME
(LAMBDA (TYPE SHORT) (* ; "Edited 29-Sep-87 14:21 by bvm:") (* ;; "Translate filing TYPE into a descriptive string, e.g., %"Interpress Document%".  If SHORT is true, leave out %"Document%".  If TYPE is numeric, it is rendered as %"Type nnn Document%".") (if (EQ TYPE (QUOTE DIRECTORY)) then (* ; "Viewpoint calls these %"folders%"") "Viewpoint Folder" else (CL:FORMAT NIL "~:[~:(~A~)~;Type ~D~]~@[ Document~]" (FIXP TYPE) TYPE (NOT SHORT))))
)

(\MAILOBJ.NS.TO.LISP.NAME
(LAMBDA (HOST DIRECTORY NAME VERSION DIRECTORYFLG) (* ; "Edited 29-Sep-87 17:54 by bvm:") (* ;; "Turn these pieces parsed out of a reference icon into a Lisp-style file name.  Mainly this means turning the slashes into angles.  This code is stolen from \NSFILING.FULLNAME, which is what we would use if it didn't require a filing session arg.") (LET ((PATHNAME (if DIRECTORYFLG then (CONCAT DIRECTORY "/" NAME (if (AND VERSION (NEQ VERSION 1)) then (CONCAT "!" VERSION) else "")) else DIRECTORY)) FILENAME DIRLST FULLNAME FUNNYCHAR DOTSEEN QUOTEDDIRS) (for I from 1 bind CH (START _ 1) while (SETQ CH (NTHCHARCODE PATHNAME I)) do (SELCHARQ CH (%' (* ; "quote mark, skip it and next char") (add I 1)) (/ (* ; "Directory marker") (push DIRLST (SUBSTRING PATHNAME START (SUB1 I))) (SETQ START (ADD1 I))) ((; %: < > } %]) (* ; "Funny characters that filing doesn't care about but we do -- need to quote these") (SETQ FUNNYCHAR T)) NIL) finally (push DIRLST (SUBSTRING PATHNAME START))) (* ;; "DIRLST is in reverse order now.") (for DIR in DIRLST do (push QUOTEDDIRS (COND (FUNNYCHAR (\NSFILING.ADDQUOTES DIR T)) (T DIR)) (QUOTE >))) (CONCATLIST (NCONC (LIST (QUOTE {) HOST "}<") QUOTEDDIRS (AND (NOT DIRECTORYFLG) (CONS (\NSFILING.ADDQUOTES NAME) (AND VERSION (LIST (if (STRPOS "." NAME) then ";" else ".;") VERSION))))))))
)

(\MAILOBJ.DISPLAY
  [LAMBDA (OBJ STREAM)                                   (* ; "Edited 26-Jun-90 18:17 by jds")
    (LET [(IMAGE (fetch (MAILOBJ 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 14-Feb-90 16:50 by bvm") (DESTRUCTURING-BIND (LEN TYPE ATTR.LEN NAME . INFO) (READ STREAM FILERDTBL) (LET (DATASTREAM START) (if (EQ (fetch DEVICENAME of (fetch (STREAM DEVICE) of STREAM)) (QUOTE NODIRCORE)) then (* ; "No need to copy the data, just copy the cover") (SETQ DATASTREAM (NCREATE (QUOTE STREAM) STREAM)) (SETQ START (GETFILEPTR STREAM)) (LET ((EOF (+ START LEN))) (* ; "Fix the eof so we don't have to carry around the length") (replace (STREAM EPAGE) of DATASTREAM with (FOLDLO EOF BYTESPERPAGE)) (replace (STREAM EOFFSET) of DATASTREAM with (IMOD EOF BYTESPERPAGE))) else (SETQ DATASTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (COPYBYTES STREAM DATASTREAM LEN) (SETQ START 0)) (\MAILOBJ.CREATE DATASTREAM TYPE ATTR.LEN NAME INFO START))))
)

(\MAILOBJ.IMAGEBOX
  [LAMBDA (OBJ)                                          (* ; "Edited 26-Jun-90 18:17 by jds")
    (fetch (MAILOBJ MAILOBJ.BOX) of (fetch OBJECTDATUM of OBJ])

(\MAILOBJ.PUT
  [LAMBDA (OBJ STREAM)                                   (* ; "Edited 26-Jun-90 18:17 by jds")
    (LET* ((MAILOBJ (fetch OBJECTDATUM of OBJ))
           (COREFILE (fetch (MAILOBJ MAILOBJ.DATA) of MAILOBJ))
           (END (GETEOFPTR COREFILE))
           (START (fetch (MAILOBJ MAILOBJ.START) of MAILOBJ)))
          (LET ((*PRINT-BASE* 10)
                (*READTABLE FILERDTBL)
                (NAME (fetch (MAILOBJ MAILOBJ.NAME) of MAILOBJ))
                (INFO (fetch (MAILOBJ MAILOBJ.INFO) of MAILOBJ)))
                                                             (* ; "Make sure we can read it back.")
               (PRIN4 (LIST* (- END START)
                             (fetch (MAILOBJ MAILOBJ.TYPE) of MAILOBJ)
                             (fetch (MAILOBJ MAILOBJ.ATTR.LENGTH) of MAILOBJ)
                             (AND (OR NAME INFO)
                                  (CONS NAME INFO)))
                      STREAM))
          (COPYBYTES COREFILE STREAM START 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 26-Jun-90 18:17 by jds")
    (if (.COPYKEYDOWNP.)
        then                                             (* ; 
                                                         "There's more to copy selection than this")
              [AND NIL (LET [(NAME (fetch (MAILOBJ MAILOBJ.NAME) of (IMAGEOBJPROP
                                                                             OBJ
                                                                             'OBJECTDATUM]
                            (AND NAME (BKSYSBUF NAME]
      elseif (IMAGEOBJPROP OBJ 'BUSY)
        then                                             (* ; "Busy")
              (PRINTOUT PROMPTWINDOW T "Attachment is busy")
      else
      (LET*
       [(MAILOBJ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
        (TYPE (fetch (MAILOBJ MAILOBJ.TYPE) of MAILOBJ))
        (REAL.TYPE (if (EQ TYPE 'REFERENCE)
                       then (LISTGET (fetch (MAILOBJ MAILOBJ.INFO) of MAILOBJ)
                                       'TYPE)
                     else TYPE))
        (CMD (MENU (create MENU
                          ITEMS _
                          `(("View as text" '\MAILOBJ.VIEW 
                                   "View the attachment as raw text, using TEdit")
                            (,(if (EQ TYPE 'REFERENCE)
                                  then                   (* ; 
                           "Note that we are storing the reference itself, not the referenced file")
                                        "Store reference"
                                else "Put to file")
                             '\MAILOBJ.PUT.FILE "Store the attachment in a file.  This operation loses information unless the file is on an NS File Server."
                             )
                            ,@[AND (EQ REAL.TYPE 'INTERPRESS)
                                   '(("Send to Printer" '\MAILOBJ.HARDCOPY 
                                            "Send the document to the printer of your choice."]
                            ,@[AND (fetch (MAILOBJ MAILOBJ.EXPANDABLE) of MAILOBJ)
                                   '(("Expand folder" '\MAILOBJ.EXPAND 
                                            "Extract the first-level subparts of the folder"]
                            ,@(SELECTQ TYPE
                                  (REFERENCE [AND (GETD 'FILEBROWSER)
                                                  (EQ (NTHCHARCODE (fetch (MAILOBJ MAILOBJ.NAME)
                                                                      of MAILOBJ)
                                                             -1)
                                                      (CHARCODE >))
                                                  `(("FileBrowse" '\MAILOBJ.FB 
                                                   "Invoke the File Browser on the referenced object"
                                                           ])
                                  NIL))
                          CENTERFLG _ T]
       (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))
                      'NAME
                      'MAILOBJ
                      'RESTARTABLE
                      'HARDRESET
                      'BEFOREEXIT
                      'DON'T)                                (* ; 
                                     "Return DON'T so that the window doesn't pop on top to select")
               '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 26-Jun-90 18:17 by jds")

    (* ;; "Hardcopy the attachment in MAILOBJ.  WINDOW is the window in which we are viewing it (not currently used).")

    (LET* ((*UPPER-CASE-FILE-NAMES* NIL)
           (PRINTER (GetPrinterName))
           (MAILOBJ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
           (REFP (EQ (fetch (MAILOBJ MAILOBJ.TYPE) of MAILOBJ)
                     'REFERENCE))
           ATTRIBUTES PRINTRESULTS NAME DATA START)
          (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))
                  (if REFP
                      then (NSPRINT PRINTER (SETQ NAME (fetch (MAILOBJ MAILOBJ.NAME)
                                                              of MAILOBJ)))
                    else                                 (* ; 
                            "Have to do this by hand, since we don't have a nice standalone stream")
                          [SETQ ATTRIBUTES
                           (\MAILOBJ.PARSE.ATTRIBUTES
                            (SETQ DATA (fetch (MAILOBJ MAILOBJ.DATA) of MAILOBJ))
                            [CONSTANT `([DOCUMENT.NAME ,@(CDR (ASSOC 'NAME \NSFILING.ATTRIBUTES]
                                        (DOCUMENT.CREATION.DATE ,@(CDR (ASSOC 'CREATED.ON 
                                                                              \NSFILING.ATTRIBUTES]
                            (SETQ START (fetch (MAILOBJ MAILOBJ.START) of MAILOBJ] 
                                                             (* ; 
                    "Parse out the name and creation date, and use them for the document name/date")
                          [if (SETQ NAME (LISTGET ATTRIBUTES 'DOCUMENT.NAME))
                              then                       (* ; "Fix up any wayward subject")
                                    (LISTPUT ATTRIBUTES 'DOCUMENT.NAME (SETQ NAME (
                                                                                \MAILOBJ.MUNGE.NAME
                                                                                   NAME]
                          [SETQ PRINTRESULTS (\NSPRINT.INTERNAL PRINTER ATTRIBUTES
                                                    (FUNCTION (LAMBDA (DATASTREAM)
                                                                (\MAILOBJ.COPY.BODY
                                                                 DATA DATASTREAM
                                                                 (+ START (fetch (MAILOBJ 
                                                                                  MAILOBJ.ATTR.LENGTH
                                                                                            )
                                                                             of MAILOBJ)))
                                                                NIL]
                          (if (AND PRINTRESULTS NSPRINT.WATCHERFLG)
                              then                       (* ; 
                  "Set up a 'watchdog' process to keep the guy informed of the print job's status.")
                                    (\NSPRINT.WATCH.JOB PRINTRESULTS PRINTER NAME)))
                  (PRINTOUT PROMPTWINDOW T NAME " sent to " (fetch NSOBJECT of (CAR PRINTER])

(\MAILOBJ.FB
  [LAMBDA (OBJ WINDOW)                                   (* ; "Edited 26-Jun-90 18:17 by jds")

    (* ;; "Invoke the File Browser on the referenced object")

    (FILEBROWSER (fetch (MAILOBJ MAILOBJ.NAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM])

(\MAILOBJ.PUT.FILE
  [LAMBDA (OBJ WINDOW)                                   (* ; "Edited 26-Jun-90 18:17 by jds")

    (* ;; "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 'OBJECTDATUM))
      (DATA (fetch (MAILOBJ MAILOBJ.DATA) of MAILOBJ))
      (START (fetch (MAILOBJ MAILOBJ.START) of MAILOBJ))
      (PW (CREATEW (create REGION
                          LEFT _ LASTMOUSEX
                          BOTTOM _ LASTMOUSEY
                          WIDTH _ (WINDOWPROP WINDOW 'WIDTH)
                          HEIGHT _ (HEIGHTIFWINDOW (TIMES 4 (FONTPROP DEFAULTFONT 'HEIGHT))
                                          NIL 8))
                 NIL 8))
      FILE DEVICE CONDITION)
     (if [NULL (SETQ FILE (TTYINPROMPTFORWORD "Put attachment to file: " NIL NIL PW NIL
                                     'TTY
                                     (CHARCODE (CR]
         then (PRINTOUT PW "...aborted")
       elseif (NULL (SETQ DEVICE (\GETDEVICEFROMNAME (SETQ FILE (\ADD.CONNECTED.DIR FILE))
                                            T)))
         then (PRINTOUT PW T "No such server/device")
       else
       (ALLOW.BUTTON.EVENTS)
       (PRINTOUT PW " ... ")
       (if [CL:MULTIPLE-VALUE-SETQ
                (FILE CONDITION)
                (IGNORE-ERRORS (if (EQ (fetch OPENFILE of DEVICE)
                                           (FUNCTION \NSFILING.OPENFILE))
                                   then                  (* ; 
                                                   "NS device.  Really need better test than this.")
                                         (SETFILEPTR DATA START)
                                         (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 'OUTPUT 'NEW
                                                  `((TYPE ,(fetch (MAILOBJ MAILOBJ.TYPE)
                                                              of MAILOBJ))
                                                    (SEQUENTIAL T]
                                       (PRINTOUT PW "(some attributes will be lost) ")
                                       (\MAILOBJ.COPY.BODY DATA FILE (+ START (fetch
                                                                                   (MAILOBJ 
                                                                                  MAILOBJ.ATTR.LENGTH
                                                                                          )
                                                                                     of MAILOBJ))
                                              PW)
                                       (CLOSEF FILE]
           then (PRINTOUT PW T FILE " written.")
         else (PRINTOUT PW "failed: " CONDITION])

(\MAILOBJ.VIEW
  [LAMBDA (OBJ WINDOW)                                   (* ; "Edited 26-Jun-90 18:17 by jds")

    (* ;; "View the text of the attachment.   This is often enough to tell you whether you want to bother doing something more exciting with it.")

    (RESETLST
        [LET*
         ((MAILOBJ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
          (TYPE (fetch (MAILOBJ MAILOBJ.TYPE) of MAILOBJ))
          (REFP (EQ TYPE 'REFERENCE))
          (WREG (WINDOWREGION (OR (CAR (WINDOWPROP WINDOW 'EXTRAWINDOWS))
                                  WINDOW)))
          PROPS W SUBJECT START DATA DATASTART)
         [if REFP
             then (SETQ SUBJECT (fetch (MAILOBJ MAILOBJ.NAME) of MAILOBJ))
                   (SETQ TYPE (LISTGET (fetch (MAILOBJ MAILOBJ.INFO) of MAILOBJ)
                                     'TYPE))
                   (SETQ START NIL)
           else (SETQ DATA (fetch (MAILOBJ MAILOBJ.DATA) of MAILOBJ))
                 [SETQ SUBJECT (CADR (\MAILOBJ.PARSE.ATTRIBUTES DATA
                                            (CONSTANT (LIST (ASSOC 'NAME \NSFILING.ATTRIBUTES)))
                                            (SETQ DATASTART (fetch (MAILOBJ MAILOBJ.START)
                                                               of MAILOBJ]
                 (SETQ START (+ DATASTART (fetch (MAILOBJ MAILOBJ.ATTR.LENGTH) of MAILOBJ]
         [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: " (\MAILOBJ.MUNGE.NAME SUBJECT]
                                                             (* ; 
                                                  "Make window slightly overlapping display window")
         (WINDOWADDPROP WINDOW 'EXTRAWINDOWS W T)
         [if (NEQ TYPE 'TEDIT)
             then                                        (* ; 
                                  "TEdit's not so good on binary files, so just pull out the text.")
             (LET
              [(COMPACTDATA (OPENSTREAM '{NODIRCORE} 'BOTH]
              [if REFP
                  then [RESETSAVE NIL (LIST 'CLOSEF (SETQ DATA (OPENSTREAM SUBJECT 'INPUT NIL
                                                                          '((SEQUENTIAL T]
                else (SETFILEPTR DATA (+ DATASTART 4))   (* ; 
                    "Skip the version number (LONGCARDINAL).  Next comes SEQUENCE Filing.Attribute")
                      (if NIL
                          then 

                                (* ;; "First extract possible text from unknown attributes.  This is not really worth much, other than it skips the mail note, and it is completely the wrong thing on sub-mailobjs, for which none of the fields (except the subject) has been exposed.")

                                (to (\WIN DATA) bind X TYPE
                                   do (SETQ TYPE (COURIER.READ DATA NIL 'LONGCARDINAL))
                                         (if (find X in \NSMAIL.ATTRIBUTES
                                                    suchthat (EQ (CADR X)
                                                                     TYPE))
                                             then        (* ; 
                      "Something of known type--it's probably in the message header.  Just skip it")
                                                   (COURIER.SKIP.SEQUENCE DATA NIL 'UNSPECIFIED)
                                           else          (* ; 
 "Unknown attribute--extract text from it in case it's interesting.  Next word is a count of words")
                                                 (\MAILOBJ.EXTRACT.TEXT DATA COMPACTDATA
                                                        (UNFOLD (\WIN DATA)
                                                               BYTESPERWORD]
              (\MAILOBJ.EXTRACT.TEXT DATA COMPACTDATA (- (\GETEOFPTR DATA)
                                                             (GETFILEPTR DATA)))
              (SETQ DATA COMPACTDATA)
              (SETQ START NIL)
              (SETQ PROPS (LIST 'FONT LAFITEDISPLAYFONT]
         (OPENTEXTSTREAM DATA W START (AND START (GETEOFPTR DATA))
                (APPEND PROPS '(PROMPTWINDOW DON'T])])

(\MAILOBJ.MUNGE.NAME
(LAMBDA (STRING) (* ; "Edited 15-Aug-89 17:03 by bvm") (* ;; "Get rid of the CR's in string, substituting something more innocuous.") (if (OR (NULL STRING) (NOT (STRPOS "
" STRING))) then STRING else (CL:SUBSTITUTE #\\ #\Newline STRING))))

(\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 26-Jun-90 18:17 by jds")
    (LET* ((MAILOBJ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
           (DATA (fetch (MAILOBJ MAILOBJ.DATA) of MAILOBJ))
           (IMAGEPOS (TEDIT.FIND.OBJECT TEXTSTREAM OBJ))
           NUMCHILDREN CHILDREN SUBDATA SUBSTART TYPE PARSE)
          (SETFILEPTR DATA (+ (fetch (MAILOBJ MAILOBJ.START) of MAILOBJ)
                              (fetch (MAILOBJ MAILOBJ.ATTR.LENGTH) of MAILOBJ)))
          (\NSMAIL.DISCARD.SERIALIZED.CONTENT DATA)      (* ; 
                                     "Skip over the body of the folder (should be empty, actually)")
          (if (EQ (SETQ NUMCHILDREN (\WIN DATA))
                      0)
              then                                       (* ; 
                                                           "Why did it say it was a directory?")
                    (PRINTOUT PROMPTWINDOW T "There is nothing in that 'folder' to expand!")
            else (to NUMCHILDREN do              (* ; 
                                                           "copy each child into its own image obj")
                                               (SETQ SUBDATA (OPENSTREAM '{NODIRCORE} 'BOTH))
                                               (COURIER.WRITE SUBDATA \SERIALIZED.FILE.VERSION NIL
                                                      'LONGCARDINAL)
                                               (SETQ SUBSTART (\MAILOBJ.COPY.CHILD DATA SUBDATA))
                                                             (* ; "Copy recursive part")
                                               (SETQ PARSE (\MAILOBJ.PARSE.ATTRIBUTES
                                                            SUBDATA
                                                            (CONSTANT (LIST (ASSOC 'FILE.TYPE 
                                                                                 \NSFILING.ATTRIBUTES
                                                                                   )
                                                                            (ASSOC 'NAME 
                                                                                 \NSFILING.ATTRIBUTES
                                                                                   )))
                                                            0))
                                               (SETQ TYPE (LISTGET PARSE 'FILE.TYPE))
                                               [push CHILDREN (\MAILOBJ.CREATE
                                                                   SUBDATA
                                                                   (AND TYPE (\TYPE.FROM.FILETYPE
                                                                              TYPE))
                                                                   SUBSTART
                                                                   (LISTGET PARSE 'NAME] 
                                                             (* ; 
                                        "Create object, parsing the type field out of the raw data")
                            )
                  (add IMAGEPOS 1)
                  (TEXTPROP TEXTSTREAM 'READONLY (PROG1 (TEXTPROP TEXTSTREAM 'READONLY)
                                                     (TEXTPROP TEXTSTREAM 'READONLY NIL)
                                                             (* ; 
                                "This ought to be one call, but the macro does not expand properly")
                                                     (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 OUTSTREAM LEN) (* ; "Edited 15-Aug-89 16:38 by bvm") (* ;; "Copy LEN bytes from the stream DATA to OUTSTREAM, where all the runs of non-printing characters are replaced by some small number of ugly characters that won't upset tedit.") (to LEN bind CH HELDCH (SKIPPING _ -1) do (if (OR (>= (SETQ CH (\BIN DATA)) 127) (AND (< CH (CHARCODE SPACE)) (SELCHARQ CH ((TAB CR) NIL) ( (* ; "VP eol") (SETQ CH (CHARCODE CR)) NIL) T))) then (* ; "Junk") (SETQ HELDCH NIL) (* ; "I don't care if the previous byte was accidentally ascii") (if (EVENP (add SKIPPING 1) 16) then (BOUT OUTSTREAM MAILOBJ.SKIPCHAR)) elseif (< SKIPPING 0) then (* ; "in a nice ascii section") (BOUT OUTSTREAM CH) elseif HELDCH then (* ; "We were just waiting to see...") (BOUT OUTSTREAM HELDCH) (SETQ HELDCH NIL) (SETQ SKIPPING -1) (BOUT OUTSTREAM CH) else (* ; "We had been skipping.  Don't print this byte until we see the next byte is nice, too, so as to reduce the gibberish of accidental ascii in the middle of binary") (SETQ HELDCH CH))) OUTSTREAM)
)

(\MAILOBJ.PARSE.ATTRIBUTES
(LAMBDA (DATA FIELDS START) (* ; "Edited 14-Feb-90 16:26 by bvm") (* ;; "Parse the SUBJECT field out of the serialized stream DATA beginning at START.  FIELDS is in the format of \nsfiling.attributes entries") (SETFILEPTR DATA (+ START 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)
                           (RES 4428)
                           (XEROX860 5120)
                           (REFERENCE 4427)
                           (MAILFOLDER 4417))

(RPAQQ MAILOBJ.REFERENCE.FIELD
       (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID))
                              (SERVICE NSNAME)
                              (ADDRESS NSADDRESS)
                              (HOST STRING)
                              (DIRECTORY STRING)
                              (NAME STRING)
                              (TYPE (FILING . ATTRIBUTE.TYPE))
                              (NIL UNSPECIFIED)
                              (PAGES CARDINAL)
                              (VERSION CARDINAL)
                              (FLAGS CARDINAL))))

(RPAQ? MAILOBJ.WINDOWOFFSET 16)

(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
(DECLARE%: EVAL@COMPILE DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD MAILOBJ (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH 
                           MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)


(CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)
)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(\MAILOBJ.INIT)

(AND (EQ MAKESYSNAME :LYRIC)
     (FILESLOAD (SYSLOAD)
            NSRANDOM))
)



(* ; "sending mail")

(DEFINEQ

(\NSMAIL.SEND.PARSE
(LAMBDA (MSG EDITORWINDOW) (* ; "Edited 17-Jan-89 15:55 by bvm") (PROG ((SENDER (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*)) RECIPIENTS MSGFIELDS FORMATTEDP HEADEREOF INTERESTINGFIELDS SUBJECT ATTACHMENT) (OR (SETQ MSGFIELDS (\LAFITE.PREPARE.SEND MSG EDITORWINDOW \LAPARSE.NSMAIL)) (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) (LET ((EXPANDED (for NAME in (CDR PAIR) join (if (CL:STRING= (fetch NSDOMAIN of NAME) ";") then (* ; "DL syntax") (\NSMAIL.EXPAND.DL (fetch NSOBJECT of NAME) SENDER EDITORWINDOW) else (LIST NAME))))) (SETQ RECIPIENTS (COND (RECIPIENTS (NS.REMOVEDUPLICATES (APPEND EXPANDED RECIPIENTS))) (T EXPANDED))))) (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))) ((REFERENCE ATTACHMENT) (if ATTACHMENT then (\SENDMESSAGEFAIL EDITORWINDOW "Can only send a single attachment")) (SETQ ATTACHMENT T) (push INTERESTINGFIELDS PAIR)) 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.REFERENCE
(LAMBDA (FILENAME EDITWINDOW) (* ; "Edited 17-Jan-89 15:55 by bvm") (LET* ((*UPPER-CASE-FILE-NAMES* NIL) (FULLNAME (FINDFILE FILENAME T))) (COND ((NULL FULLNAME) (\SENDMESSAGEFAIL EDITWINDOW "Can't find reference file " FILENAME)) (T (LET* ((FIELDS (UNPACKFILENAME.STRING FULLNAME)) (HOST (LISTGET FIELDS (QUOTE HOST))) (NSHOST (PARSE.NSNAME HOST)) (ADDRESS (LOOKUP.NS.SERVER NSHOST)) (NAME (LISTGET FIELDS (QUOTE NAME))) (EXT (LISTGET FIELDS (QUOTE EXTENSION))) (VERSION (LISTGET FIELDS (QUOTE VERSION))) (ID (GETFILEINFO FULLNAME (QUOTE FILE.ID))) (TYPE (GETFILEINFO FULLNAME (QUOTE FILE.TYPE))) (SIZE (GETFILEINFO FULLNAME (QUOTE SIZE)))) (COND ((NOT (AND (STRPOS ":" HOST) ADDRESS)) (\SENDMESSAGEFAIL EDITWINDOW "Reference file must be on NS server")) ((NOT (AND ID TYPE SIZE)) (\SENDMESSAGEFAIL EDITWINDOW "Can't lookup info on " FULLNAME)) (T (BQUOTE ((FILE.ID (\, ID)) (SERVICE (\, NSHOST)) (ADDRESS (\, ADDRESS)) (HOST (\, HOST)) (DIRECTORY (\, (CL:SUBSTITUTE #\/ #\> (UNPACKFILENAME.STRING FULLNAME (QUOTE DIRECTORY))))) (NAME (\, (if EXT then (SETQ NAME (CONCAT NAME "." EXT)) else NAME))) (TYPE (\, (if (OR (NEQ TYPE 0) (NULL EXT)) then (* ; "Interesting type, or no clue from extension") TYPE elseif (AND (SETQ TYPE (\NSMAIL.GUESS.FILE.TYPE NAME EXT)) (SELECTQ (\SENDMESSAGE.MENUPROMPT EDITWINDOW (\LAFITE.CREATE.MENU (BQUOTE (((\, (CONCAT "Change file type to " TYPE)) T) ("Leave as type BINARY" NIL) ("Abort" (QUOTE ABORT)))) "Fix type of reference file?") "Referenced document is of type BINARY; some mail clients will not understand.") (NIL NIL) (ABORT (ERROR!)) (if (SETFILEINFO FULLNAME (QUOTE TYPE) (SETQ TYPE (\FILETYPE.FROM.TYPE TYPE))) then TYPE else (\SENDMESSAGEFAIL EDITWINDOW "Could not set the file type")))) else (* ; "Oh, give up, leave it binary") 0))) (NIL 0) (PAGES (\, (ADD1 SIZE))) (VERSION (\, (OR (AND VERSION (MKATOM VERSION)) 0))) (FLAGS 0))))))))))
)

(\NSMAIL.EXPAND.DL
(LAMBDA (DL SENDER EDITWINDOW) (* ; "Edited 16-Jan-89 14:04 by bvm") (LET ((FILENAME (PACKFILENAME.STRING (QUOTE BODY) (if (EQL (CL:CHAR DL 0) #\") then (* ; "quoted file name, take off the quotes first") (CL:SUBSEQ DL 1 (- (CL:LENGTH DL) 1)) else DL) (QUOTE EXTENSION) LAFITEDL.EXT)) STREAM) (if (NULL (SETQ FILENAME (if (OR (UNPACKFILENAME.STRING FILENAME (QUOTE HOST)) (UNPACKFILENAME.STRING FILENAME (QUOTE DIRECTORY))) then (INFILEP FILENAME) else (* ; "Search default directories") (FINDFILE FILENAME T (CONS LAFITEDEFAULTHOST&DIR LAFITEDLDIRECTORIES))))) then (\SENDMESSAGEFAIL EDITWINDOW "Can't find file named " DL) elseif (NULL (SETQ STREAM (CAR (NLSETQ (OPENTEXTSTREAM (MKATOM FILENAME)))))) then (\SENDMESSAGEFAIL EDITWINDOW "Can't open " DL) else (RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEF) STREAM)) (* ; "I hope this closes the file.  We used OPENTEXTSTREAM instead of OPEN so that file can contain tedit formatting.") (bind LINE while (SETQ LINE (CL:READ-LINE STREAM NIL NIL)) join (\NSMAIL.PARSE LINE SENDER EDITWINDOW))))))
)

(\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) (* ; "Edited  6-Jun-88 13:38 by bvm") (CL:REMOVE-DUPLICATES LST :TEST (FUNCTION EQUAL.CH.NAMES)))
)

(\NSMAIL.SEND
  [LAMBDA (MSG PARSE EDITORWINDOW ABORTWINDOW)           (* ; "Edited 26-Jun-90 18:25 by jds")

(* ;;; "MSG is the entire text of the message -- RECIPIENTS is a parsed list of recipients")

    (DECLARE (SPECVARS MSG START MSGFIELDS EDITORWINDOW ABORTWINDOW FORMATSTREAM REFERENCE 
                        ATTACHMENT ATTACHED-ATTRIBUTES BODYTYPE BODYLENGTH NOTEP))
                                                             (* ; 
                                                           "For \NSMAIL.SEND.MESSAGE.CONTENT")
    (RESETLST
        (PROG ((PWINDOW (AND EDITORWINDOW (GETPROMPTWINDOW EDITORWINDOW)))
               (RECIPIENTS (fetch (NSMAILPARSE NSPRECIPIENTS) of PARSE))
               (START (OR (fetch (NSMAILPARSE NSPSTART) of PARSE)
                          (GETEOFPTR MSG)))
               (MSGFIELDS (fetch (NSMAILPARSE NSPFIELDS) of PARSE))
               (CREDENTIALS (fetch (LAFITEMODEDATA CREDENTIALS) of *LAFITE-MODE-DATA*))
               FORMATSTREAM REFERENCE ATTACHMENT BODYTYPE BODYLENGTH NOTEP COURIERSTREAM DATASTREAM 
               RECIPIENTSCHECK SENDRESULT SENDERFIELD DATEFIELD TYPE MAILDROP RESULTS 
               ATTACHED-ATTRIBUTES)
              [COND
                 (PWINDOW                                    (* ; 
      "Make sure prompt window will expand as needed.  Probably generic sendmessage should do this")
                        (RESETSAVE (TTYDISPLAYSTREAM PWINDOW))
                        (RESETSAVE (LINELENGTH T]
              (COND
                 ((AND (fetch (NSMAILPARSE NSPFORMATTED) of PARSE)
                       (TEDIT.FORMATTEDFILEP MSG))           (* ; 
                "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 'SPLIT))
                                                             (* ; "Get (body  . formatting)")
                  (SETQ MSG (OPENSTREAM (CAR FORMATSTREAM)
                                   'INPUT))
                  (SETQ FORMATSTREAM (OPENSTREAM (CDR FORMATSTREAM)
                                            'INPUT))
                  (SETQ START 0))
                 ((AND (TEXTSTREAMP MSG)
                       (TEDIT.FORMATTEDFILEP MSG))           (* ; "Message has formatting, but caller asked to send it as plain text.  Carefully coerce it, since TEDIT ns chars and image objects don't pass thru COPYBYTES very well")
                  (SETQ MSG (LAFITE.MAKE.PLAIN.TEXTSTREAM MSG START))
                  (SETQ START 0)))
              (SETQ BODYLENGTH (- (GETEOFPTR MSG)
                                  START))
              (SETQ REFERENCE (ASSOC 'REFERENCE MSGFIELDS))
              (SETQ ATTACHMENT (ASSOC 'ATTACHMENT MSGFIELDS))
              (if (OR REFERENCE ATTACHMENT)
                  then                                   (* ; "Text must be sent as mail note")
                        (if (< BODYLENGTH *NSMAIL-MAX-NOTE-LENGTH*)
                            then (SETQ NOTEP T)
                          else (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW 
                                                  "Message text too long to send with attachment")))
                        (if (AND REFERENCE ATTACHMENT)
                            then (RETURN (\LAFITE.SEND.FAIL EDITORWINDOW 
                                                    "Can't send both attachment file AND reference"))
                               )
                elseif (AND *NSMAIL-SEND-MAIL-NOTES* (< BODYLENGTH *NSMAIL-MAX-NOTE-LENGTH*))
                  then (SETQ NOTEP T))
              (if ATTACHMENT
                  then (SETQ MSGFIELDS (DREMOVE ATTACHMENT MSGFIELDS))
                        (SETQ ATTACHMENT (\NSMAIL.PREPARE.ATTACHMENT (CADR ATTACHMENT)))
                elseif REFERENCE
                  then (RPLACD REFERENCE (\NSMAIL.PARSE.REFERENCE (CADR REFERENCE)
                                                    EDITORWINDOW))
                        (SETQ BODYTYPE \NSMAIL.REFERENCE.BODYTYPE))
              [COND
                 (PWINDOW (CLEARW PWINDOW)
                        (LET ((TYPE (if REFERENCE
                                        then (CADR (ASSOC 'TYPE (CDR REFERENCE)))
                                      else BODYTYPE)))
                             (CL:FORMAT PWINDOW 
                                "Delivering ~:[~;formatted ~]~@[with ~A ~]~@[~A ~]to ~D recipient~:P"
                                    FORMATSTREAM [AND TYPE (CL:STRING-CAPITALIZE (MKSTRING
                                                                                  (
                                                                                  \TYPE.FROM.FILETYPE
                                                                                   TYPE]
                                    (COND
                                       (REFERENCE "reference")
                                       (ATTACHMENT "attachment"))
                                    (LENGTH RECIPIENTS]
              [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 '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 '|...|))
              (SETQ RESULTS (COURIER.CALL COURIERSTREAM 'MAILTRANSPORT 'POST (CAR CREDENTIALS)
                                   (CDR CREDENTIALS)
                                   RECIPIENTS NIL T \NSMAIL.CTSTANDARD.MESSAGE NIL
                                   (FUNCTION \NSMAIL.SEND.MESSAGE.CONTENT)
                                   'RETURNERRORS))
              [COND
                 ((EQ (CAR (LISTP RESULTS))
                      '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.PREPARE.ATTACHMENT
(LAMBDA (FILE) (* ; "Edited 14-Sep-89 12:15 by bvm") (DECLARE (USEDFREE MSGFIELDS EDITORWINDOW ATTACHMENT ATTACHED-ATTRIBUTES BODYTYPE BODYLENGTH)) (LET* ((HOST (UNPACKFILENAME.STRING FILE (QUOTE HOST))) (SERIALIZED (STRPOS ":" HOST)) (ATTRCOUNT 0) ATTRSTREAM) (CL:MULTIPLE-VALUE-BIND (STREAM CONDITION) (IGNORE-ERRORS (if SERIALIZED then (\NSFILING.GETFILE (\GETDEVICEFROMHOSTNAME (MKATOM (U-CASE HOST))) FILE (QUOTE SERIALIZE) (QUOTE OLD) NIL NIL T) else (OPENSTREAM FILE (QUOTE INPUT)))) (if (NULL STREAM) then (\LAFITE.SEND.FAIL EDITORWINDOW (OR CONDITION "Attachment not found.")) (ERROR!)) (RESETSAVE NIL (LIST (FUNCTION CLOSEF) STREAM)) (if SERIALIZED then (* ; "Parse out the attributes portion of the serialized file and save those that are not specifically mail attributes") (SETQ ATTRSTREAM (OPENSTREAM (QUOTE {NODIRCORE}) (QUOTE BOTH))) (\NSMAIL.CHECK.SERIALIZED.VERSION STREAM) (to (\WIN STREAM) bind TYPE WORDCOUNT do (SETQ TYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) (if (EQ TYPE (\NSMAIL.ATTRIBUTE.TYPE BodyType)) then (* ; "We always send type explicitly") (\WIN STREAM) (SETQ BODYTYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) elseif (OR (for TRIPLE in \NSMAIL.ATTRIBUTES thereis (EQ TYPE (CADR TRIPLE))) (AND (< TYPE 100) (for TRIPLE in \NSFILING.ATTRIBUTES when (EQ TYPE (CADR TRIPLE)) do (* ; "Only a few filing attributes are interesting.  Is.directory appears to be vital (the server won't deserialize something with children without it)") (RETURN (NOT (FMEMB (CAR TRIPLE) (QUOTE (IS.DIRECTORY CREATED.BY CREATED.ON MODIFIED.BY MODIFIED.ON)))))))) then (* ; "A mail attribute or file-specific file attribute, skip it") (COURIER.SKIP.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED)) else (* ; "Save it") (add ATTRCOUNT 1) (COURIER.WRITE ATTRSTREAM TYPE NIL (QUOTE LONGCARDINAL)) (\WOUT ATTRSTREAM (SETQ WORDCOUNT (\WIN STREAM))) (COPYBYTES STREAM ATTRSTREAM (UNFOLD WORDCOUNT BYTESPERWORD)))) (SETQ ATTACHED-ATTRIBUTES (CONS ATTRCOUNT ATTRSTREAM)) else (* ; "Not on an NS server, let's investigate the type") (CASE (SETQ BODYTYPE (\FILETYPE.FROM.TYPE (GETFILEINFO STREAM (QUOTE TYPE)))) ((NIL 0) (* ; "Under specified") (if (SETQ BODYTYPE (\NSMAIL.GUESS.FILE.TYPE (FULLNAME STREAM))) then (SETQ BODYTYPE (\FILETYPE.FROM.TYPE BODYTYPE)) elseif (\SENDMESSAGE.MENUPROMPT EDITORWINDOW (\LAFITE.CREATE.MENU (QUOTE (("Send as BINARY attachment" T) ("Abort" NIL))) "Send attachment?") "Warning: Type of attached file is unknown; most mail clients can't do anything interesting with this.") then (SETQ BODYTYPE 0) else (ERROR!)))) (push MSGFIELDS (BQUOTE (MODIFIED.ON (\,@ (GETFILEINFO STREAM (QUOTE ICREATIONDATE))))))) STREAM)))
)

(\NSMAIL.GUESS.FILE.TYPE
(LAMBDA (FILENAME EXT) (* ; "Edited 17-Jan-89 15:42 by bvm") (* ;; "Given a file name, try to guess what type it is from the extension, since file's TYPE property was boring.  EXT is computed from FILENAME if omitted.") (OR (CAR (CL:ASSOC (OR EXT (UNPACKFILENAME.STRING FILENAME (QUOTE EXTENSION))) FILING.TYPES :TEST (QUOTE STRING-EQUAL))) (LET ((TYPE (PRINTFILETYPE.FROM.EXTENSION FILENAME))) (AND TYPE (CAR (CL:ASSOC TYPE FILING.TYPES :TEST (QUOTE STRING-EQUAL)))))))
)

(\NSMAIL.SEND.MESSAGE.CONTENT
(LAMBDA (DATASTREAM) (* ; "Edited 13-Sep-89 17:15 by bvm") (DECLARE (USEDFREE MSG START MSGFIELDS EDITORWINDOW ABORTWINDOW FORMATSTREAM REFERENCE ATTACHMENT ATTACHED-ATTRIBUTES BODYTYPE BODYLENGTH NOTEP)) (* ; "From \NSMAIL.SEND") (* ;; "Transmits the bulkdata portion of the message") (PROG ((SENDER (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*))) (* ;; "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 (+ (LENGTH MSGFIELDS) (if FORMATSTREAM then (* ; "Also a LispFormatting item") 1 else 0) (if NOTEP then (* ; "Send body as Note attribute") (SETQ BODYLENGTH 0) 1 else (* ; "Send as body") 0) (if ATTACHED-ATTRIBUTES then (* ; "From serialized file") (CAR ATTACHED-ATTRIBUTES) else 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 (BODYTYPE) (NOTEP \NSMAIL.EMPTY.BODYTYPE) (T \NSMAIL.TEXT.BODYTYPE))) (\NSMAIL.WRITE.ATTRIBUTE DATASTREAM (QUOTE BodySize) (if ATTACHMENT then (SETQ BODYLENGTH (GETEOFPTR ATTACHMENT)) else 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 (\NSMAIL.ATTRIBUTE.TYPE LispFormatting)))) (PROGN (* ; "Now the content of the serialized tree, first part of which is a Bulkdata.StreamOfUnspecified") (COND (ATTACHMENT (if ATTACHED-ATTRIBUTES then (* ; "We have a serialized file here already.  First send the rest of the interesting attributes") (COPYBYTES (CDR ATTACHED-ATTRIBUTES) DATASTREAM 0 -1) (* ; "Then the rest of the serialization") (COPYBYTES ATTACHMENT DATASTREAM) else (COURIER.WRITE.STREAM.UNSPECIFIED DATASTREAM ATTACHMENT 0 BODYLENGTH))) (NOTEP (* ; "Null content") (\WOUT DATASTREAM 1) (* ; "Last segment") (\WOUT DATASTREAM 0) (* ; "Empty sequence")) (T (COURIER.WRITE.STREAM.UNSPECIFIED DATASTREAM MSG START (GETEOFPTR MSG))))) (if (NOT ATTACHED-ATTRIBUTES) then (* ; "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) (* ; "Edited 17-Jan-89 16:39 by bvm") (LET* (FILINGP (TYPEINFO (if (EQ TYPE (QUOTE REFERENCE)) then (* ; "This is handled specially so that we don't read references on input") MAILOBJ.REFERENCE.FIELD else (OR (ASSOC TYPE \NSMAIL.ATTRIBUTES) (SETQ FILINGP (ASSOC TYPE \NSFILING.ATTRIBUTES)))))) (if TYPEINFO then (COURIER.WRITE STREAM (CADR TYPEINFO) NIL (QUOTE LONGCARDINAL)) (* ; "Type code") (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (if FILINGP then (QUOTE FILING) else (QUOTE MAILTRANSPORT)) (CADDR TYPEINFO)) else (ERROR "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)))))
)
)

(FILESLOAD LAFITEMAIL)



(* ; "for LAFITE.MAKE.PARSE.TABLE")


(RPAQQ NSMAIL.PARSEFIELDS
       (("DATE:" LAFITE.READ.LINE.FOR.TOC Date)
        ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
        ("SENDER:" LAFITE.READ.NAME.FIELD Sender)
        ("FROM:" LAFITE.READ.NAME.FIELD From)
        ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to)
        ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to)
        ("TO:" LAFITE.READ.NAME.FIELD To)
        ("CC:" LAFITE.READ.NAME.FIELD cc)
        ("FORMAT:" LAFITE.READ.FORMAT)
        ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE)
        ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT)))

(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \LAPARSE.NSMAIL)
)

(RPAQ? \NSMAIL.SERVER.CACHE )

(RPAQ? NSMAIL.NET.HINT )

(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)

(RPAQ? *NSMAIL-SEND-MAIL-NOTES* )

(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)

(RPAQ? LAFITEDL.EXT "DL")

(CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-SEND-MAIL-NOTES* 
                     *NSMAIL-CACHE-TIMEOUT*))

(ADDTOVAR \SYSTEMCACHEVARS \NSMAIL.SERVER.CACHE)
(DEFINEQ

(\NSMAIL.MESSAGE.P
(LAMBDA (MSG) (* ; "Edited  6-May-88 13:58 by bvm") (AND (STRPOS ":" (fetch (LAFITEMSG FROM) of MSG)) (QUOTE ?)))
)

(\NSMAIL.MESSAGE.FROM.SELF.P
(LAMBDA (MSG) (* ; "Edited  6-May-88 14:37 by bvm") (* ;; "True if message is from current user.  Easy in NS case because we always make the From field be exactly our full name") (STRING-EQUAL (fetch (LAFITEMSG FROM) of MSG) (fetch (LAFITEMODEDATA FULLUSERNAME) of *LAFITE-MODE-DATA*)))
)

(\NSMAIL.MAKEANSWERFORM
(LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* ; "Edited  6-Jun-88 14:09 by bvm") (LET ((MSGFIELDS (\LAFITE.PARSE.MESSAGE MAILFOLDER (OR (CAR (LISTP MSGDESCRIPTORS)) MSGDESCRIPTORS))) SUBJECT FROM DATE SENDER REPLYTO TO CC ORIGINALREGISTRY OLDFROM NEWTO) (* ; "get the fields from the file") (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 NEWTO (OR (AND REPLYTO (SETQ REPLYTO (\NSMAIL.PARSE REPLYTO ORIGINALREGISTRY))) OLDFROM)) (LAFITE.FILL.IN.ANSWER.FORM SUBJECT FROM DATE NEWTO (CL:SET-DIFFERENCE (COND (REPLYTO (* ; "Only this address, so can only cc to self now") (LIST (fetch (LAFITEMODEDATA UNPACKEDUSERNAME) of *LAFITE-MODE-DATA*))) (T (* ; "Take everyone who got the original, removing duplicates, of course.") (NS.REMOVEDUPLICATES (APPEND (AND TO (\NSMAIL.PARSE TO ORIGINALREGISTRY)) (AND CC (\NSMAIL.PARSE CC ORIGINALREGISTRY)))))) NEWTO :TEST (FUNCTION EQUAL.CH.NAMES)) (FUNCTION \NSMAIL.PRINT.NAMES))))
)
)



(* ; "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) (* ; "Edited 22-Nov-89 12:11 by bvm") (* ;; "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") (LET* ((TYPE (COURIER.READ STREAM NIL (QUOTE LONGCARDINAL))) (VALUETYPE (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CADR TRIPLE)) (SETQ TYPE (QUOTE (\, (CAR TRIPLE)))) (QUOTE (\, (CADDR TRIPLE)))))))))))) (LIST TYPE (if VALUETYPE then (\WIN STREAM) (* ; "Skip sequence count") (COURIER.READ STREAM PROGRAM VALUETYPE) else (COURIER.READ.SEQUENCE STREAM NIL (QUOTE UNSPECIFIED))))))
)

(\NS.WRITE.ENVELOPE.ITEM
(LAMBDA (STREAM ITEM PROGRAM TYPE) (* ; "Edited 22-Nov-89 12:31 by bvm") (* ;;; "Writes a filing attribute value pair to STREAM.  ITEM is a list of two elements (TYPE VALUE)") (LET ((TYPE (CAR ITEM)) (VALUE (CADR ITEM)) VALUETYPE) (COURIER.WRITE STREAM (OR (FIXP TYPE) (\COMPUTED.FORM (BQUOTE (CASE TYPE (\,@ (for TRIPLE in \NSMAIL.ENVELOPE.ITEM.TYPES collect (BQUOTE ((\, (CAR TRIPLE)) (SETQ VALUETYPE (QUOTE (\, (CADDR TRIPLE)))) (QUOTE (\, (CADR TRIPLE))))))) (T (ERROR "Unknown Envelope Item Type" 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)
        (BodyType 17 LONGCARDINAL)
        (Status 1000 (INBASKET . STATUS))))
(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 STATELASTERROR STATETIMER))

(RECORD NSMAILPARSE (NSPSUBJECT NSPRECIPIENTS NSPSTART NSPFORMATTED . NSPFIELDS))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ \NSMAIL.SOCKET 26)

(RPAQQ \SERIALIZED.FILE.VERSION 2)

(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))

(RPAQQ \NSMAIL.CTSTANDARD.MESSAGE 0)

(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)

(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)

(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)

(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)

(RPAQQ \NULL.CACHE.VERIFIER (0 0 0 0))


(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS 
       \NSMAIL.CTSTANDARD.MESSAGE \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE 
       \NSMAIL.REFERENCE.BODYTYPE 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))
                                                           'IGNOREMACRO])

(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO
          [ARGS (LET [(INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS)))
                                        \NSMAIL.ATTRIBUTES]
                     (COND
                        [INFO (LIST '\NSMAIL.WRITE.ATTRIBUTE.MACRO (CAR ARGS)
                                    (CAR INFO)
                                    (CADDR ARGS)
                                    (KWOTE (CADR INFO]
                        (T 'IGNOREMACRO])

(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE)
                                                             (COURIER.WRITE STREAM TYPENO NIL
                                                                    'LONGCARDINAL)
                                                             (COURIER.WRITE.SEQUENCE.UNSPECIFIED
                                                              STREAM VALUE '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 MAILOBJ.REFERENCE.FIELD 
       \NSFILING.ATTRIBUTES DEFAULTICONFONT NSPRINT.WATCHERFLG NSMAIL.HEADER.ORDER FILING.TYPES)
)


(CL:PROCLAIM '(CL:SPECIAL *RETRIEVAL-ERROR*))


(FILESLOAD (SOURCE)
       LAFITEDECLS)


(FILESLOAD (LOADCOMP)
       CLEARINGHOUSE)

(DECLARE%: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA INBASKET.CALL)
)
(PUTPROPS NSMAIL COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (15176 18023 (\NSMAIL.AUTHENTICATE 15186 . 16404) (\NSMAIL.MAKE.MAILSERVERS 16406 . 
17334) (\NSMAIL.LOGIN 17336 . 17562) (NS.FINDMAILBOXES 17564 . 18021)) (18335 59849 (NS.POLLNEWMAIL 
18345 . 19228) (NS.OPENMAILBOX 19230 . 21228) (\NSMAIL.CHECK 21230 . 32463) (
\NSMAIL.FIX.MAILBOX.LOCATIONS 32465 . 36016) (NS.NEXTMESSAGE 36018 . 36929) (\NSMAIL.READ.ENVELOPES 
36931 . 38905) (INBASKET.CALL 38907 . 40247) (NS.RETRIEVEMESSAGE 40249 . 45307) (\NSMAIL.RETRIEVE 
45309 . 47078) (\NSMAIL.EOF.ON.RETRIEVE 47080 . 47430) (\NSMAIL.READ.SERIALIZED.TREE 47432 . 51396) (
\NSMAIL.CHECK.SERIALIZED.VERSION 51398 . 51711) (\NSMAIL.READ.SERIALIZED.CONTENT 51713 . 52607) (
\NSMAIL.DISCARD.SERIALIZED.CONTENT 52609 . 53056) (\NSMAIL.READ.STRING.AS.STREAM 53058 . 53467) (
\NSMAIL.PRINT.HEADERFIELDS 53469 . 58947) (\NSMAIL.PRINT.NAMES 58949 . 59847)) (59881 61895 (
\NSMAIL.COURIER.OPEN 59891 . 60094) (\NSMAIL.ERRORHANDLER 60096 . 60518) (\NSMAIL.SIGNAL.ERROR 60520
 . 61893)) (61933 65545 (NS.CLOSEMAILBOX 61943 . 63668) (\NSMAIL.LOGOFF 63670 . 64710) (
\NSMAIL.CHANGE.STATUS 64712 . 65543)) (65827 72849 (\MAILOBJ.CREATE 65837 . 68062) (\MAILOBJ.TYPE.NAME
 68064 . 68531) (\MAILOBJ.NS.TO.LISP.NAME 68533 . 69884) (\MAILOBJ.DISPLAY 69886 . 70464) (
\MAILOBJ.GET 70466 . 71289) (\MAILOBJ.IMAGEBOX 71291 . 71496) (\MAILOBJ.PUT 71498 . 72569) (
\MAILOBJ.INIT 72571 . 72847)) (72850 98554 (\MAILOBJ.BUTTONEVENTFN 72860 . 77169) (\MAILOBJ.DO.COMMAND
 77171 . 77418) (\MAILOBJ.HARDCOPY 77420 . 81186) (\MAILOBJ.FB 81188 . 81466) (\MAILOBJ.PUT.FILE 81468
 . 84817) (\MAILOBJ.VIEW 84819 . 90235) (\MAILOBJ.MUNGE.NAME 90237 . 90501) (\MAILOBJ.COPY.BODY 90503
 . 90817) (\MAILOBJ.EXPAND 90819 . 94981) (\MAILOBJ.COPY.CHILD 94983 . 96340) (\MAILOBJ.COPY.SEQUENCE 
96342 . 96710) (\MAILOBJ.EXTRACT.TEXT 96712 . 97773) (\MAILOBJ.PARSE.ATTRIBUTES 97775 . 98552)) (99976
 122547 (\NSMAIL.SEND.PARSE 99986 . 101938) (\NSMAIL.PARSE.REFERENCE 101940 . 103858) (
\NSMAIL.EXPAND.DL 103860 . 104927) (\NSMAIL.PARSE 104929 . 105190) (\NSMAIL.PARSE1 105192 . 105760) (
NS.REMOVEDUPLICATES 105762 . 105900) (\NSMAIL.SEND 105902 . 112999) (\NSMAIL.PREPARE.ATTACHMENT 113001
 . 115686) (\NSMAIL.GUESS.FILE.TYPE 115688 . 116189) (\NSMAIL.SEND.MESSAGE.CONTENT 116191 . 119224) (
COURIER.WRITE.STREAM.UNSPECIFIED 119226 . 120370) (\NSMAIL.SEND.STREAM.AS.STRING 120372 . 120992) (
\NSMAIL.WRITE.ATTRIBUTE 120994 . 121619) (\NSMAIL.FINDSERVER 121621 . 122285) (\NSMAIL.CHECKSERVER 
122287 . 122545)) (123769 125868 (\NSMAIL.MESSAGE.P 123779 . 123917) (\NSMAIL.MESSAGE.FROM.SELF.P 
123919 . 124240) (\NSMAIL.MAKEANSWERFORM 124242 . 125866)) (126016 127515 (\NS.READ.ENVELOPE.ITEM 
126026 . 126783) (\NS.WRITE.ENVELOPE.ITEM 126785 . 127513)))))
STOP
\ No newline at end of file
diff --git a/internal/library/NSMAIL.LCOM b/internal/library/NSMAIL.LCOM
deleted file mode 100644
index 6aa6ca69..00000000
Binary files a/internal/library/NSMAIL.LCOM and /dev/null differ
diff --git a/internal/library/NSMAIL.TEDIT b/library/lafite/NSMAIL.TEDIT
similarity index 100%
rename from internal/library/NSMAIL.TEDIT
rename to library/lafite/NSMAIL.TEDIT
