(FILECREATED "10-AUG-83 15:41:56" {PHYLUM}<YONKE>MTP.;2 7317
changes to: (VARS \PUPSOCKET.MTP)
(RECORDS MTPMAILBOX)
(FNS MTP.POLLNEWMAIL)
previous date: "10-AUG-83 11:16:30" {PHYLUM}<YONKE>MTP.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT MTPCOMS)
(RPAQQ MTPCOMS ((FNS MTP.OPENMAILBOX MTP.POLLNEWMAIL MTP.NEXTMESSAGE MTP.RETRIEVEMESSAGE
MTP.CLOSEMAILBOX \MTP.ENDOFMESSAGESTATE)
(FNS \MTP.HANDLE.NO)
(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 "10-AUG-83 15:40")
(* * 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 (SETQ RESULT (GETPUPSTRING INPUP))
(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-JUL-83 18:18")
[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)
FTPDEBUGGING))
((MARK# NO)
(FTPGETCODE (fetch MTPIN of MAILBOX))
(\FTP.FLUSH.TO.EOC (fetch MTPIN of MAILBOX)
PROMPTWINDOW))
(\FTPERROR]
(ENDBSPSTREAM (fetch MTPIN of MAILBOX)
5000])
(\MTP.ENDOFMESSAGESTATE
[LAMBDA (INSTREAM) (* bvm: " 6-JUL-83 14:26")
(SELECTC (FTPGETMARK INSTREAM)
((MARK# HERE-IS-PLIST)
(QUOTE OPEN))
((MARK# YES)
(FTPGETCODE INSTREAM)
(\FTP.FLUSH.TO.EOC INSTREAM FTPDEBUGGING)
(QUOTE EMPTY))
((MARK# NO)
(FTPGETCODE INSTREAM)
(\FTP.FLUSH.TO.EOC INSTREAM PROMPTWINDOW)
(QUOTE ERROR))
(\FTPERROR])
)
(DEFINEQ
(\MTP.HANDLE.NO
[LAMBDA (INSTREAM BADPLIST ECHOSTREAM CODE HOST) (* bvm: " 5-JUL-83 17:53")
(SELECTQ (OR CODE (SETQ CODE (FTPGETCODE INSTREAM)))
[(16 17) (* 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 FTPDEBUGGING PROMPTWINDOW))
NIL])
)
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (594 6163 (MTP.OPENMAILBOX 604 . 1974) (MTP.POLLNEWMAIL 1976 . 3177) (MTP.NEXTMESSAGE
3179 . 4434) (MTP.RETRIEVEMESSAGE 4436 . 4934) (MTP.CLOSEMAILBOX 4936 . 5692) (\MTP.ENDOFMESSAGESTATE
5694 . 6161)) (6164 7012 (\MTP.HANDLE.NO 6174 . 7010)))))
STOP