(FILECREATED " 1-Jan-84 17:59:49" {PHYLUM}<LISPCORE>LIBRARY>MTP.;1 7611
changes to: (VARS MTPCOMS)
previous date: " 5-SEP-83 18:09:08" {PHYLUM}<LISP>LIBRARY>MTP.;1)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT MTPCOMS)
(RPAQQ MTPCOMS ((FNS MTP.OPENMAILBOX MTP.POLLNEWMAIL MTP.NEXTMESSAGE MTP.RETRIEVEMESSAGE
MTP.CLOSEMAILBOX)
(FNS \MTP.ENDOFMESSAGESTATE \MTP.HANDLE.NO)
(ADDVARS (MAILSERVERTYPES (MTP MTP.POLLNEWMAIL MTP.OPENMAILBOX MTP.NEXTMESSAGE
MTP.RETRIEVEMESSAGE MTP.CLOSEMAILBOX ETHERPORT)))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS MTPMAILBOX)
(CONSTANTS \PUPSOCKET.MTP)
(FILES (LOADCOMP)
DPUPFTP))))
(DEFINEQ
(MTP.OPENMAILBOX
[LAMBDA (PORT MAILBOXNAME PASSWORD HOSTNAME) (* bvm: " 6-JUL-83 14:57")
(PROG ((MAILPORT (ETHERPORT PORT))
[LOGINFO (\INTERNAL/GETPASSWORD (OR HOSTNAME (U-CASE (ETHERHOSTNAME PORT]
PLIST INS OUTS CONN)
[SETQ MAILPORT (CONS (CAR MAILPORT)
(COND
((ZEROP (CDR MAILPORT))
\PUPSOCKET.MTP)
(T (CDR MAILPORT]
(COND
((NOT LOGINFO)
(RETURN)))
[SETQ PLIST (LIST (LIST (QUOTE MAILBOX)
MAILBOXNAME)
(LIST (QUOTE USER-NAME)
(CAR LOGINFO))
(LIST (QUOTE USER-PASSWORD)
(CDR LOGINFO]
NEWCONNECTION
(COND
([NULL (SETQ INS (OPENBSPSTREAM MAILPORT NIL (FUNCTION \FTP.ERRORHANDLER]
(RETURN)))
(SETQ OUTS (BSPOUTPUTSTREAM INS))
RETRY
(FTPPUTMARK OUTS (MARK# RETRIEVE-MAIL))
(\FTP.PRINTPLIST OUTS PLIST)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
[(\MTP.HANDLE.NO INS PLIST NIL NIL PORT)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
(T (CLOSEBSPSTREAM INS)
(RETURN]
[(MARK# HERE-IS-PLIST)
(RETURN (CONS (create MTPMAILBOX
MTPIN ← INS
MTPOUT ← OUTS
MTPSTATE ←(QUOTE OPEN]
(RETURN (\FTPERROR NIL "MTP error"])
(MTP.POLLNEWMAIL
[LAMBDA (USER HOSTPORT) (* M.Yonke "24-AUG-83 16:53")
(* * Does a Laurel-style mail check for USER on machine HOSTPORT, returning NIL or a string describing the new
mail.)
(PROG ((SOC (\GETMISCSOCKET))
(OUTPUP (ALLOCATE.PUP))
(RESULT (QUOTE ?))
INPUP)
(SETUPPUP OUTPUP HOSTPORT \PUPSOCKET.MISCSERVICES \PT.LAURELCHECK NIL SOC T)
(PUTPUPSTRING OUTPUP USER)
(to \MAXETHERTRIES when (SETQ INPUP (EXCHANGEPUPS SOC OUTPUP NIL T))
do (SELECTC (fetch PUPTYPE of INPUP)
(\PT.NEWMAIL (GETPUPSTRING INPUP)
(SETQ RESULT T)
(RETURN))
(\PT.NONEWMAIL (SETQ RESULT NIL)
(RETURN))
(\PT.NOMAILBOX (printout T (GETPUPSTRING INPUP)
T)
(RETURN))
(\PT.ERROR (AND PUPTRACEFLG (PRINTERRORPUP INPUP PUPTRACEFILE))
(if (EQ (fetch ERRORPUPCODE of INPUP)
\PUPE.NOSOCKET)
then (RETURN)))
NIL)
finally (AND PUPTRACEFLG (printout PUPTRACEFILE "Mail check timed out" T)))
(AND INPUP (RELEASE.PUP INPUP))
(RELEASE.PUP OUTPUP)
(RETURN RESULT])
(MTP.NEXTMESSAGE
[LAMBDA (MAILBOX) (* bvm: " 6-JUL-83 14:27")
(SELECTQ (fetch MTPSTATE of MAILBOX)
(EMPTY NIL)
[OPEN (PROG ((PLIST (READPLIST (fetch MTPIN of MAILBOX)))
(NEXTSTATE (QUOTE MESSAGE)))
(RETURN (PROG1 (OR (for PAIR in PLIST
do (SELECTQ (CAR PAIR)
(LENGTH (push $$VAL (QUOTE LENGTH)
(CADR PAIR)))
(OPENED (SELECTQ (CADR PAIR)
((YES Yes yes)
(push $$VAL
(QUOTE EXAMINED)
T))
NIL))
(DELETED (SELECTQ (CADR PAIR)
[(YES Yes yes)
(push $$VAL
(QUOTE
DELETEDFLG)
T)
(FTPGETMARK
(fetch MTPIN
of MAILBOX))
(\FTP.FLUSH.TO.MARK
(fetch MTPIN
of MAILBOX))
(SETQ NEXTSTATE
(
\MTP.ENDOFMESSAGESTATE (fetch MTPIN of MAILBOX]
NIL))
NIL))
T)
(replace MTPSTATE of MAILBOX with NEXTSTATE]
(ERROR "Mailbox not in good state for NEXTMESSAGE" MAILBOX])
(MTP.RETRIEVEMESSAGE
[LAMBDA (MAILBOX OUTSTREAM) (* bvm: " 6-JUL-83 14:27")
(SELECTQ (fetch MTPSTATE of MAILBOX)
[MESSAGE (COND
((EQ (FTPGETMARK (fetch MTPIN of MAILBOX))
(MARK# HERE-IS-FILE))
(\FTP.FLUSH.TO.MARK (fetch MTPIN of MAILBOX)
OUTSTREAM)
(replace MTPSTATE of MAILBOX with (\MTP.ENDOFMESSAGESTATE (fetch MTPIN
of MAILBOX]
(\FTPERROR])
(MTP.CLOSEMAILBOX
[LAMBDA (MAILBOX FLUSHP) (* bvm: " 5-SEP-83 18:07")
[COND
((AND FLUSHP (EQ (fetch MTPSTATE of MAILBOX)
(QUOTE EMPTY)))
(FTPPUTMARK (fetch MTPOUT of MAILBOX)
(MARK# FLUSH-MAILBOX))
(.EOC. (fetch MTPOUT of MAILBOX))
(SELECTC (FTPGETMARK (fetch MTPIN of MAILBOX))
((MARK# YES)
(FTPGETCODE (fetch MTPIN of MAILBOX))
(\FTP.FLUSH.TO.EOC (fetch MTPIN of MAILBOX)
(.FTPDEBUGLOG.)))
((MARK# NO)
(FTPGETCODE (fetch MTPIN of MAILBOX))
(\FTP.FLUSH.TO.EOC (fetch MTPIN of MAILBOX)
PROMPTWINDOW))
(\FTPERROR]
(CLOSEBSPSTREAM (fetch MTPIN of MAILBOX)
11610Q])
)
(DEFINEQ
(\MTP.ENDOFMESSAGESTATE
[LAMBDA (INSTREAM) (* bvm: " 5-SEP-83 18:08")
(SELECTC (FTPGETMARK INSTREAM)
((MARK# HERE-IS-PLIST)
(QUOTE OPEN))
((MARK# YES)
(FTPGETCODE INSTREAM)
(\FTP.FLUSH.TO.EOC INSTREAM (.FTPDEBUGLOG.))
(QUOTE EMPTY))
((MARK# NO)
(FTPGETCODE INSTREAM)
(\FTP.FLUSH.TO.EOC INSTREAM PROMPTWINDOW)
(QUOTE ERROR))
(\FTPERROR])
(\MTP.HANDLE.NO
[LAMBDA (INSTREAM BADPLIST ECHOSTREAM CODE HOST) (* bvm: " 5-SEP-83 18:08")
(SELECTQ (OR CODE (SETQ CODE (FTPGETCODE INSTREAM)))
[(20Q 21Q) (* Password errors)
(PROG (INFO)
[FRESHLINE (OR ECHOSTREAM (SETQ ECHOSTREAM (GETSTREAM PROMPTWINDOW (QUOTE OUTPUT]
(RETURN (COND
((AND (\FTP.FLUSH.TO.EOC INSTREAM ECHOSTREAM)
(SETQ INFO (\INTERNAL/GETPASSWORD HOST T NIL NIL)))
(for PAIR in BADPLIST do (SELECTQ (CAR PAIR)
(USER-NAME (FRPLACA (CDR PAIR)
(CAR INFO)))
(USER-PASSWORD
(FRPLACA (CDR PAIR)
(CDR INFO)))
NIL))
T]
(PROGN (\FTP.FLUSH.TO.EOC INSTREAM (OR ECHOSTREAM (.FTPDEBUGLOG.)
PROMPTWINDOW))
NIL])
)
(ADDTOVAR MAILSERVERTYPES (MTP MTP.POLLNEWMAIL MTP.OPENMAILBOX MTP.NEXTMESSAGE MTP.RETRIEVEMESSAGE
MTP.CLOSEMAILBOX ETHERPORT))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD MTPMAILBOX (MTPIN MTPOUT MTPSTATE))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \PUPSOCKET.MTP 7)
(CONSTANTS \PUPSOCKET.MTP)
)
(FILESLOAD (LOADCOMP)
DPUPFTP)
)
(PUTPROPS MTP COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (702 5823 (MTP.OPENMAILBOX 712 . 2082) (MTP.POLLNEWMAIL 2084 . 3297) (MTP.NEXTMESSAGE
3299 . 4554) (MTP.RETRIEVEMESSAGE 4556 . 5054) (MTP.CLOSEMAILBOX 5056 . 5821)) (5824 7157 (
\MTP.ENDOFMESSAGESTATE 5834 . 6304) (\MTP.HANDLE.NO 6306 . 7155)))))
STOP