(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