(FILECREATED "19-AUG-83 22:25:06" {PHYLUM}<LISPCORE>SOURCES>DPUPFTP.;12 38896  

      changes to:  (VARS FTPNOCODES DPUPFTPCOMS)
		   (FNS \FTP.OPENFILE \FTP.CLOSEFILE \FTP.RENAMEFILE \FTP.DELETEFILE 
			\FTP.GENERATEFILES \FTP.WHENCLOSED \GETFTPCONNECTION \FTP.HANDLE.NO 
			\FTP.PRINTPLIST \FTPERROR \FTP.ENUMERATE FTPDEBUG FTPPRINTMARK FTPPRINTCODE 
			\FTP.CLEANUP \FTP.OPEN.CONNECTION \FTP.ASSURE.CLEANUP)
		   (MACROS .FTPDEBUGLOG.)

      previous date: "16-AUG-83 18:47:16" {PHYLUM}<LISPCORE>SOURCES>DPUPFTP.;10)


(* Copyright (c) 1983 by Xerox Corporation)

(PRETTYCOMPRINT DPUPFTPCOMS)

(RPAQQ DPUPFTPCOMS [(FNS \FTPINIT \FTP.OPENFILE \FTP.CLOSEFILE \FTP.RENAMEFILE \FTP.DELETEFILE 
			 \FTP.GENERATEFILES \FTP.NEXTFILE \FTP.GETFILEINFO \FTP.GETDATEPROP)
		    (FNS \FTP.OPEN.CONNECTION \FTP.SENDVERSION \FTP.WHENCLOSED \GETFTPCONNECTION 
			 \RELEASE.FTPCONNECTION \FTP.ERRORHANDLER \FTP.CLEANUP \FTP.ASSURE.CLEANUP)
		    (FNS \FTP.HANDLE.NO \FTP.DIRECTORYNAMEONLY \FTP.MAKEPLIST \FTP.PRINTPLIST 
			 \FTP.PACKFILENAME \FTP.UNPACKFILENAME \FTP.FLUSH.TO.EOC \FTP.FLUSH.TO.MARK 
			 \FTPERROR)
		    (FNS REMOTEDIRECTORY \FTP.ENUMERATE \FTP.COLLECT.DIRECTORY)
		    (FNS FTPDEBUG FTPPRINTMARK FTPPRINTCODE FTPGETMARK FTPPUTMARK FTPPUTCODE 
			 FTPGETCODE FLUSH.FTPCONNECTIONS)
		    (ADDVARS (\FTPCONNECTIONS))
		    (INITVARS (FTPDEBUGLOG)
			      (FTPDEBUGFLG)
			      (\FTP.ILLEGAL.STREAM 0)
			      (\FTPAVAILABLE)
			      (\FTP.IDLE.TIMEOUT 120000))
		    (DECLARE: EVAL@COMPILE DONTCOPY (VARS FTPMARKTYPES)
			      (CONSTANTS \FTP.VERSION)
			      (CONSTANTS * FTPNOCODES)
			      (MACROS MARK# .EOC. .FTPDEBUGLOG.)
			      (RECORDS FTPCONNECTION FTPSTREAM)
			      (GLOBALVARS \FTP.ILLEGAL.STREAM FTPDEBUGFLG \FTPCONNECTIONS 
					  \FTPAVAILABLE \FTP.IDLE.TIMEOUT)
			      (FILES (LOADCOMP)
				     BSP))
		    (DECLARE: DONTEVAL@LOAD DOCOPY (P (\FTPINIT])
(DEFINEQ

(\FTPINIT
  [LAMBDA NIL                                                (* bvm: "14-JUN-83 19:06")
    (COND
      ((type? FDEV \BSPFDEV)
	(with FDEV \BSPFDEV (SETQ OPENFILE (FUNCTION \FTP.OPENFILE))
	      (SETQ CLOSEFILE (FUNCTION \FTP.CLOSEFILE))
	      (SETQ GETFILEINFO (FUNCTION \FTP.GETFILEINFO))
	      (SETQ GETFILEPTR (FUNCTION ZERO))
	      (SETQ RENAMEFILE (FUNCTION \FTP.RENAMEFILE))
	      (SETQ DELETEFILE (FUNCTION \FTP.DELETEFILE))
	      (SETQ GENERATEFILES (FUNCTION \FTP.GENERATEFILES)))
	(SETQ \FTPAVAILABLE T])

(\FTP.OPENFILE
  [LAMBDA (FILENAME ACCESS RECOG OTHERINFO)                  (* bvm: "19-AUG-83 22:06")
    (RESETLST (PROG (CONNECTION HOST INS OUTS REMOTEPLIST DESIREDPLIST FULLNAME TYPE BYTESIZE 
				EOLCONVENTION)
		    (COND
		      ((SELECTQ ACCESS
				(INPUT (EQ RECOG (QUOTE NEW)))
				(OUTPUT (EQ RECOG (QUOTE OLD)))
				T)
			(LISPERROR "FILE WON'T OPEN" FILENAME)))
		    (OR (SETQ HOST (\FTP.UNPACKFILENAME FILENAME))
			(RETURN))
		    (SETQ DESIREDPLIST (CDR HOST))
		    (SETQ HOST (CAR HOST))
		    (SELECTQ ACCESS
			     (OUTPUT
			       [for PAIR in OTHERINFO when (LISTP PAIR)
				  do (COND
				       ((SELECTQ (CAR PAIR)
						 (TYPE (SELECTQ (SETQ TYPE (CADR PAIR))
								((TEXT BINARY)
								  T)
								(NIL)
								(LISPERROR "ILLEGAL ARG" PAIR)))
						 (BYTESIZE (SETQ BYTESIZE (OR (FIXP (CADR PAIR))
									      (LISPERROR 
										    "ILLEGAL ARG"
											 PAIR)))
							   NIL)
						 ((EOL EOLCONVENTION)
						   (SELECTQ (CADR PAIR)
							    ((CR CRLF TRANSPARENT)
							      (SETQ EOLCONVENTION (CADR PAIR)))
							    (LISPERROR "ILLEGAL ARG" PAIR))
						   NIL)
						 (CREATIONDATE (push DESIREDPLIST
								     (LIST (QUOTE CREATION-DATE)
									   (CADR PAIR)))
							       NIL)
						 (LENGTH [push DESIREDPLIST
							       (LIST (QUOTE SIZE)
								     (OR (FIXP (CADR PAIR))
									 (LISPERROR "ILLEGAL ARG" 
										    PAIR]
							 NIL)
						 (SEQUENTIAL NIL)
						 T)
					 (push DESIREDPLIST PAIR]
			       [COND
				 ((NULL TYPE)
				   (push DESIREDPLIST (LIST (QUOTE TYPE)
							    (SETQ TYPE DEFAULTFILETYPE]
			       (SELECTQ TYPE
					[TEXT (push DESIREDPLIST (LIST (QUOTE END-OF-LINE-CONVENTION)
								       (OR EOLCONVENTION
									   (QUOTE CR]
					[BINARY (push DESIREDPLIST (LIST (QUOTE BYTE-SIZE)
									 (OR BYTESIZE 8]
					NIL))
			     NIL)
		NEWCONNECTION
		    (OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
			(RETURN))
		    (SETQ INS (fetch FTPIN of CONNECTION))
		    (SETQ OUTS (fetch FTPOUT of CONNECTION))
		RETRY
		    (FTPPUTMARK OUTS (SELECTQ ACCESS
					      (INPUT (MARK# RETRIEVE))
					      (OUTPUT (MARK# NEW-STORE))
					      NIL))
		    (\FTP.PRINTPLIST OUTS DESIREDPLIST)
		    (.EOC. OUTS)
		    (SELECTC (FTPGETMARK INS)
			     [(MARK# NO)
			       (COND
				 [(\FTP.HANDLE.NO CONNECTION DESIREDPLIST)
				   (COND
				     ((BSPOPENP INS (QUOTE INPUT))
				       (GO RETRY))
				     (T (GO NEWCONNECTION]
				 (T (\RELEASE.FTPCONNECTION CONNECTION)
				    (RETURN]
			     [(MARK# HERE-IS-PLIST)
			       (SETQ REMOTEPLIST (READPLIST INS))
			       (SETQ FULLNAME (\FTP.PACKFILENAME HOST REMOTEPLIST))
			       (OR (EQ (FTPGETMARK INS)
				       (MARK# EOC))
				   (RETURN (\FTPERROR CONNECTION]
			     (RETURN (\FTPERROR CONNECTION)))
		    (SELECTQ ACCESS
			     [INPUT (FTPPUTMARK OUTS (MARK# YES))
				    (FTPPUTCODE OUTS 0)
				    (.EOC. OUTS)
				    (SELECTC (FTPGETMARK INS)
					     [(MARK# NO)
					       (COND
						 ((\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL NIL T)
						   (CLOSEBSPSTREAM INS 2000)
                                                             (* Can't recover from in the middle like this, so just 
							     flush and start over)
						   (GO NEWCONNECTION))
						 (T (\RELEASE.FTPCONNECTION CONNECTION)
						    (RETURN (LISPERROR "FILE WON'T OPEN" FULLNAME]
					     ((MARK# HERE-IS-FILE)
					       (replace FULLFILENAME of INS with FULLNAME)
					       (replace FTPFILEPROPS of INS with REMOTEPLIST)
					       (replace ACCESS of INS with (QUOTE INPUT))
					       (RETURN INS))
					     (RETURN (\FTPERROR CONNECTION]
			     (OUTPUT (FTPPUTMARK OUTS (MARK# HERE-IS-FILE))
				     (replace FULLFILENAME of OUTS with FULLNAME)
				     (replace FTPFILEPROPS of OUTS with REMOTEPLIST)
				     (RETURN OUTS))
			     NIL])

(\FTP.CLOSEFILE
  [LAMBDA (STREAM)                                           (* bvm: "19-AUG-83 22:21")
    (PROG ((ACCESS (fetch ACCESS of STREAM))
	   [CONN (find C in \FTPCONNECTIONS suchthat (OR (EQ (fetch FTPIN of C)
							     STREAM)
							 (EQ (fetch FTPOUT of C)
							     STREAM]
	   (FILENAME (fetch FULLFILENAME of STREAM)))
          (replace FTPFILEPROPS of STREAM with NIL)
          (COND
	    ((NULL CONN))
	    ((AND (BSPOPENP STREAM ACCESS)
		  (SELECTQ ACCESS
			   [INPUT (COND
				    ((OR (\EOFP STREAM)
					 (PROGN (BIN STREAM)
						(\EOFP STREAM))
					 (PROGN (BIN STREAM)
						(\EOFP STREAM)))

          (* Hack. We are at the end of the file, or within a byte or two of it (typical for LOAD), so we can terminate the 
	  RETRIEVE cleanly)


				      (SELECTC (FTPGETMARK STREAM)
					       ((MARK# YES)
                                                             (* File sent ok)
						 (FTPGETCODE STREAM)
						 (\FTP.FLUSH.TO.EOC STREAM (.FTPDEBUGLOG.)))
					       NIL]
			   (OUTPUT (FTPPUTMARK STREAM (MARK# YES))
				   (FTPPUTCODE STREAM 0)
				   (.EOC. STREAM)
				   (OR (SELECTC (FTPGETMARK (fetch BSPINPUTSTREAM
							       of (fetch BSPSOC of STREAM)))
						((MARK# YES)
						  (FTPGETCODE (fetch FTPIN of CONN))
						  (\FTP.FLUSH.TO.EOC (fetch FTPIN of CONN)
								     (.FTPDEBUGLOG.)))
						((MARK# NO)
						  (\FTP.HANDLE.NO CONN NIL (GETSTREAM PROMPTWINDOW
										      (QUOTE OUTPUT)))
						  NIL)
						NIL)
				       (PROGN (ERROR "Remote File System did not finish writing file" 
						     FILENAME)
					      NIL)))
			   NIL))
	      (\RELEASE.FTPCONNECTION CONN))
	    (T (ENDBSPSTREAM (fetch FTPIN of CONN)
			     1000)))
          (RETURN FILENAME])

(\FTP.RENAMEFILE
  [LAMBDA (OLDFILE NEWFILE)                                  (* bvm: "19-AUG-83 22:23")
    (RESETLST (PROG (CONNECTION HOST OLDNAME INS OUTS OLDPLIST NEWPLIST)
		    (OR (SETQ HOST (\FTP.UNPACKFILENAME OLDFILE))
			(RETURN))
		    (SETQ OLDPLIST (CDR HOST))
		    (SETQ HOST (CAR HOST))
		    (OR (SETQ NEWPLIST (\FTP.UNPACKFILENAME NEWFILE))
			(RETURN))
		    [COND
		      ((NEQ (CAR NEWPLIST)
			    HOST)
			(RETURN))
		      (T (SETQ NEWPLIST (CDR NEWPLIST]
		    (CLEAR.LEAF.CACHE HOST)                  (* In case Leaf has this file open for input)
		NEWCONNECTION
		    (OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
			(RETURN))
		    (SETQ INS (fetch FTPIN of CONNECTION))
		    (SETQ OUTS (fetch FTPOUT of CONNECTION))
		RETRY
		    (FTPPUTMARK OUTS (MARK# RENAME))
		    (\FTP.PRINTPLIST OUTS OLDPLIST)
		    (\FTP.PRINTPLIST OUTS NEWPLIST)
		    (.EOC. OUTS)
		    (RETURN (PROG1 (SELECTC (FTPGETMARK INS)
					    [(MARK# NO)
					      (COND
						((\FTP.HANDLE.NO CONNECTION OLDPLIST)
						  (COND
						    ((BSPOPENP INS (QUOTE INPUT))
						      (GO RETRY))
						    (T (GO NEWCONNECTION]
					    ((MARK# YES)
					      (FTPGETCODE INS)
					      (AND (\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.))
						   NEWFILE))
					    (\FTPERROR CONNECTION))
				   (\RELEASE.FTPCONNECTION CONNECTION])

(\FTP.DELETEFILE
  [LAMBDA (FILENAME)                                         (* bvm: "19-AUG-83 22:08")
    (RESETLST (PROG (CONNECTION HOST REMOTENAME INS OUTS REMOTEPLIST DESIREDPLIST RESULT)
		    (OR (SETQ HOST (\FTP.UNPACKFILENAME FILENAME))
			(RETURN))
		    (SETQ DESIREDPLIST (CDR HOST))
		    (SETQ HOST (CAR HOST))
		    (for PROP in (QUOTE (DIRECTORY NAME-BODY VERSION))
		       do (push DESIREDPLIST (LIST (QUOTE DESIRED-PROPERTY)
						   PROP)))
		    (CLEAR.LEAF.CACHE HOST)                  (* In case Leaf has this file open for input)
		NEWCONNECTION
		    (OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
			(RETURN))
		    (SETQ INS (fetch FTPIN of CONNECTION))
		    (SETQ OUTS (fetch FTPOUT of CONNECTION))
		RETRY
		    (FTPPUTMARK OUTS (MARK# DELETE))
		    (\FTP.PRINTPLIST OUTS DESIREDPLIST)
		    (.EOC. OUTS)
		    (SELECTC (FTPGETMARK INS)
			     [(MARK# NO)
			       (COND
				 [(\FTP.HANDLE.NO CONNECTION DESIREDPLIST)
				   (COND
				     ((BSPOPENP INS (QUOTE INPUT))
				       (GO RETRY))
				     (T (GO NEWCONNECTION]
				 (T (\RELEASE.FTPCONNECTION CONNECTION)
				    (RETURN]
			     ((MARK# HERE-IS-PLIST)
			       NIL)
			     (RETURN (\FTPERROR CONNECTION)))
		NEXTPLIST
		    (SETQ REMOTEPLIST (READPLIST INS))
		    (OR (EQ (FTPGETMARK INS)
			    (MARK# EOC))
			(\FTPERROR))
		    (FTPPUTMARK OUTS (MARK# YES))
		    (FTPPUTCODE OUTS 0)
		    (.EOC. OUTS)
		    (SELECTC (FTPGETMARK INS)
			     [(MARK# NO)
			       (COND
				 ((\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL NIL T)
				   (CLOSEBSPSTREAM INS 2000)
				   (GO NEWCONNECTION]
			     ((MARK# YES)
			       (FTPGETCODE INS)
			       (\FTP.FLUSH.TO.MARK INS)
			       (push RESULT (\FTP.PACKFILENAME HOST REMOTEPLIST)))
			     (RETURN (\FTPERROR CONNECTION)))
		    (SELECTC (FTPGETMARK INS)
			     ((MARK# HERE-IS-PLIST)
			       (GO NEXTPLIST))
			     [(MARK# EOC)
			       (\RELEASE.FTPCONNECTION CONNECTION)
			       (RETURN (COND
					 ((CDR RESULT)
					   (REVERSE RESULT))
					 (T (CAR RESULT]
			     (RETURN (\FTPERROR CONNECTION])

(\FTP.GENERATEFILES
  [LAMBDA (DEVICE PATTERN DESIREDPROPS)                      (* bvm: "19-AUG-83 22:21")
    (RESETLST (PROG (CONNECTION HOST REMOTENAME INS OUTS DESIREDPLIST CODE VERSION EXTENSION NAME 
				DIRECTORY OSTYPE INFO (CMD (MARK# NEW-ENUMERATE)))
		    (for TAIL on (UNPACKFILENAME PATTERN) by (CDDR TAIL)
		       do (SELECTQ (CAR TAIL)
				   [HOST (SETQ HOST (\CANONICAL.HOSTNAME (CADR TAIL]
				   (DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
				   (NAME (SETQ NAME (CADR TAIL)))
				   (EXTENSION (SETQ EXTENSION (CADR TAIL)))
				   (VERSION (SETQ VERSION (CADR TAIL)))
				   (RETURN)))
		    (SETQ OSTYPE (GETOSTYPE HOST))
		    (SELECTQ OSTYPE
			     [TENEX [COND
				      ((STRPOS (QUOTE *)
					       NAME)
					(SETQ NAME (QUOTE *]
				    (COND
				      ((AND EXTENSION (OR (ZEROP (NCHARS EXTENSION))
							  (STRPOS (QUOTE *)
								  EXTENSION)))
					(SETQ EXTENSION (QUOTE *]
			     [TOPS20 (COND
				       ((AND EXTENSION (ZEROP (NCHARS EXTENSION)))
					 (SETQ EXTENSION (QUOTE *]
			     [(NIL IFS)
			       (COND
				 ((EQ EXTENSION (QUOTE *))
				   (SETQ EXTENSION NIL)
				   (COND
				     ((NEQ (NTHCHARCODE NAME -1)
					   (CHARCODE *))
				       (SETQ NAME (PACK* NAME (QUOTE *]
			     NIL)
		    [SETQ DESIREDPLIST (CONS [LIST (QUOTE USER-NAME)
						   (CAR (SETQ INFO (\INTERNAL/GETPASSWORD HOST]
					     (CONS (LIST (QUOTE USER-PASSWORD)
							 (CDR INFO))
						   (for PROP
						      in (NCONC (for PROP in DESIREDPROPS
								   collect
								    (SELECTQ PROP
									     (BYTESIZE (QUOTE 
											BYTE-SIZE))
									     (LENGTH (QUOTE SIZE))
									     ((CREATIONDATE 
										    ICREATIONDATE)
									       (QUOTE CREATION-DATE))
									     ((WRITEDATE IWRITEDATE)
									       (QUOTE WRITE-DATE))
									     ((READDATE IREADDATE)
									       (QUOTE READ-DATE))
									     (EOLCONVENTION
									       (QUOTE 
									   END-OF-LINE-CONVENTION))
									     PROP))
								(QUOTE (DIRECTORY NAME-BODY VERSION)))
						      collect (LIST (QUOTE DESIRED-PROPERTY)
								    PROP]
		    [push DESIREDPLIST (LIST (QUOTE VERSION)
					     (OR VERSION (SELECTQ OSTYPE
								  ((TENEX TOPS20)
								    0)
								  (QUOTE H]
		    [push DESIREDPLIST (LIST (QUOTE NAME-BODY)
					     (COND
					       ((NULL EXTENSION)
						 NAME)
					       (T (PACK* NAME "." EXTENSION]
		    [COND
		      (DIRECTORY (push DESIREDPLIST (LIST (QUOTE DIRECTORY)
							  DIRECTORY]
		NEWCONNECTION
		    (OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
			(RETURN))
		    (SETQ INS (fetch FTPIN of CONNECTION))
		    (SETQ OUTS (fetch FTPOUT of CONNECTION))
		RETRY
		    (FTPPUTMARK OUTS CMD)
		    (\FTP.PRINTPLIST OUTS DESIREDPLIST)
		    (.EOC. OUTS)
		    (SELECTC (FTPGETMARK INS)
			     [(MARK# NO)
			       (COND
				 ((AND (EQ (SETQ CODE (FTPGETCODE INS))
					   \NO.UNIMPLEMENTED)
				       (NEQ CMD (MARK# ENUMERATE)))
                                                             (* Unimplemented command. Try the obsolete version)
				   (SETQ CMD (MARK# ENUMERATE))
				   (\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.))
				   (GO RETRY))
				 [(\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL CODE)
				   (COND
				     ((BSPOPENP INS (QUOTE INPUT))
				       (GO RETRY))
				     (T (GO NEWCONNECTION]
				 (T (\RELEASE.FTPCONNECTION CONNECTION)
				    (RETURN (create FILEGENOBJ
						    NEXTFILEFN ←(FUNCTION NILL]
			     ((MARK# HERE-IS-PLIST)
			       (replace FTPBUSY of CONNECTION with (SETUPTIMER \FTP.IDLE.TIMEOUT))
                                                             (* This guy gets a timer because the generator could be 
							     aborted out of our control. Blech)
			       (\FTP.ASSURE.CLEANUP)
			       (RETURN (create FILEGENOBJ
					       NEXTFILEFN ←(FUNCTION \FTP.NEXTFILE)
					       GENFILESTATE ← CONNECTION)))
			     (RETURN (\FTPERROR CONNECTION])

(\FTP.NEXTFILE
  [LAMBDA (FTPCONNECTION SCRATCHLIST NOVERSION HOST/DIR)     (* bvm: "16-AUG-83 17:17")
    (DECLARE (SPECVARS FTPCONNECTION))                       (* Seen by \FTP.CLEANUP)
    (PROG ((INS (fetch FTPIN of FTPCONNECTION))
	   NAMEBODY NAME EXT N PLIST)
          (COND
	    ((NOT INS)
	      (ERROR "FTP connection aborted or timed out, can't finish ENUMERATE"
		     (fetch FTPHOST of FTPCONNECTION))
	      (RETURN)))
          (SETUPTIMER \FTP.IDLE.TIMEOUT (fetch FTPBUSY of FTPCONNECTION))
          [COND
	    ((\EOFP INS)                                     (* NEW-ENUMERATE sends plists one after another with no 
							     intervening HERE-IS-PLIST; check here for oldstyle, or 
							     for end of command)
	      (SELECTC (FTPGETMARK INS)
		       ((MARK# EOC)
			 (\RELEASE.FTPCONNECTION FTPCONNECTION)
			 (RETURN NIL))
		       ((MARK# HERE-IS-PLIST)                (* Old style)
			 )
		       (RETURN (\FTPERROR FTPCONNECTION]
          (SETQ PLIST (READPLIST INS))
          [COND
	    [(SETQ NAMEBODY (ASSOC (QUOTE NAME-BODY)
				   PLIST))
	      (COND
		[[SETQ N (STRPOS (QUOTE %.)
				 (SETQ NAMEBODY (OR (CADR NAMEBODY)
						    ""]
		  (SETQ EXT (SUBSTRING NAMEBODY (ADD1 N)))
		  (SETQ NAME (SUBSTRING NAMEBODY 1 (SUB1 N]
		(T (SETQ NAME NAMEBODY)))
	      (SETQ NAME (COND
		  [HOST/DIR (PACKFILENAME (QUOTE HOST)
					  (fetch FTPHOST of FTPCONNECTION)
					  (QUOTE DIRECTORY)
					  (CADR (ASSOC (QUOTE DIRECTORY)
						       PLIST))
					  (QUOTE NAME)
					  NAME
					  (QUOTE EXTENSION)
					  EXT
					  (QUOTE VERSION)
					  (AND (NOT NOVERSION)
					       (CADR (ASSOC (QUOTE VERSION)
							    PLIST]
		  (T (PACKFILENAME (QUOTE NAME)
				   NAME
				   (QUOTE EXTENSION)
				   EXT
				   (QUOTE VERSION)
				   (AND (NOT NOVERSION)
					(CADR (ASSOC (QUOTE VERSION)
						     PLIST]
	    ((SETQ NAMEBODY (CADR (ASSOC (QUOTE SERVER-FILENAME)
					 PLIST)))
	      (SETQ NAME (PACKFILENAME (QUOTE HOST)
				       (fetch FTPHOST of FTPCONNECTION)
				       (QUOTE BODY)
				       NAMEBODY]
          (SETUPTIMER \FTP.IDLE.TIMEOUT (fetch FTPBUSY of FTPCONNECTION))
          (RETURN (COND
		    (NAME (DCHCON NAME SCRATCHLIST))
		    (T (HELP "Uninterpretable filename returned by ENUMERATE" PLIST])

(\FTP.GETFILEINFO
  [LAMBDA (STREAM ATTRIBUTE)                                 (* bvm: " 5-JUN-83 00:32")
    (COND
      ((type? STREAM STREAM)
	(PROG ((PROPS (fetch FTPFILEPROPS of STREAM))
	       TMP)
	      (RETURN (SELECTQ ATTRIBUTE
			       (CREATIONDATE (\FTP.GETDATEPROP (QUOTE CREATION-DATE)
							       PROPS))
			       (WRITEDATE (\FTP.GETDATEPROP (QUOTE WRITE-DATE)
							    PROPS))
			       (READDATE (\FTP.GETDATEPROP (QUOTE READ-DATE)
							   PROPS))
			       [ICREATIONDATE (IDATE (\FTP.GETFILEINFO STREAM (QUOTE CREATIONDATE]
			       [IWRITEDATE (IDATE (\FTP.GETFILEINFO STREAM (QUOTE WRITEDATE]
			       [IREADDATE (IDATE (\FTP.GETFILEINFO STREAM (QUOTE READDATE]
			       (LENGTH (CADR (ASSOC (QUOTE SIZE)
						    PROPS)))
			       (SIZE (AND (SETQ TMP (CADR (ASSOC (QUOTE SIZE)
								 PROPS)))
					  (FOLDHI TMP BYTESPERPAGE)))
			       [TYPE (U-CASE (CADR (ASSOC ATTRIBUTE PROPS]
			       (BYTESIZE (CADR (ASSOC (QUOTE BYTE-SIZE)
						      PROPS)))
			       (CADR (ASSOC ATTRIBUTE PROPS])

(\FTP.GETDATEPROP
  [LAMBDA (NAME PROPS)                                       (* bvm: " 1-JUN-83 12:48")
    (PROG [(DATELIST (CDR (ASSOC NAME PROPS]
          (RETURN (AND DATELIST (U-CASE (SUBSTRING DATELIST 2 -2])
)
(DEFINEQ

(\FTP.OPEN.CONNECTION
  [LAMBDA (HOST ECHOSTREAM)                                  (* bvm: "19-AUG-83 16:12")
    (PROG ((PORT (ETHERPORT HOST))
	   INSTREAM)
          (SETQ INSTREAM (OPENBSPSTREAM [CONS (CAR PORT)
					      (COND
						((ZEROP (CDR PORT))
						  \PUPSOCKET.FTP)
						(T (CDR PORT]
					NIL
					(FUNCTION \FTP.ERRORHANDLER)
					NIL NIL (FUNCTION \FTP.WHENCLOSED)))
          (RETURN (COND
		    (INSTREAM (SETQ INSTREAM (create FTPCONNECTION
						     FTPIN ← INSTREAM
						     FTPOUT ←(BSPOUTPUTSTREAM INSTREAM)
						     FTPHOST ←[\CANONICAL.HOSTNAME
						       (COND
							 ((LITATOM HOST)
							   HOST)
							 (T (ETHERHOSTNAME PORT]
						     FTPBUSY ← T))
			      (COND
				((\FTP.SENDVERSION INSTREAM ECHOSTREAM)
				  (push \FTPCONNECTIONS INSTREAM)
				  INSTREAM)
				(T (CLOSEBSPSTREAM (fetch FTPIN of INSTREAM])

(\FTP.SENDVERSION
  [LAMBDA (CONNECTION ECHOSTREAM)                            (* bvm: " 3-JUN-83 23:58")
    (PROG ((INS (fetch FTPIN of CONNECTION))
	   (OUTS (fetch FTPOUT of CONNECTION)))
          (FTPPUTMARK OUTS (MARK# VERSION))
          (BOUT OUTS \FTP.VERSION)
          (PRIN3 "Interlisp-D Ftp user" OUTS)
          (.EOC. OUTS)
          (RETURN (SELECTC (FTPGETMARK INS)
			   [(MARK# VERSION)
			     (COND
			       ((EQ (BIN INS)
				    \FTP.VERSION)
				 (\FTP.FLUSH.TO.EOC INS ECHOSTREAM]
			   NIL])

(\FTP.WHENCLOSED
  [LAMBDA (INSTREAM)                                         (* bvm: "19-AUG-83 22:10")
    (PROG [(CONN (find C in \FTPCONNECTIONS suchthat (EQ (fetch FTPIN of C)
							 INSTREAM]
          (COND
	    (CONN (replace FTPOUT of CONN with (replace FTPIN of CONN with \FTP.ILLEGAL.STREAM))
		  (SETQ \FTPCONNECTIONS (DREMOVE CONN \FTPCONNECTIONS))
		  (AND FTPDEBUGFLG (printout FTPDEBUGLOG T "{FTP Connection with "
					     (fetch FTPHOST of CONN)
					     " closed}" T])

(\GETFTPCONNECTION
  [LAMBDA (HOST UNWINDSAVE)                                  (* bvm: "19-AUG-83 22:22")
    (PROG ([H (\CANONICAL.HOSTNAME (COND
				     ((LITATOM HOST)
				       HOST)
				     (T (ETHERHOSTNAME HOST]
	   CONNECTION)
          (RETURN (COND
		    ([SETQ CONNECTION (OR (for CONN in \FTPCONNECTIONS
					     when (AND (EQ (fetch FTPHOST of CONN)
							   H)
						       (NOT (fetch FTPBUSY of CONN))
						       (BSPOPENP (fetch FTPIN of CONN)
								 (QUOTE OUTPUT)))
					     do (replace FTPBUSY of CONN with T)
						(replace ACCESS of (fetch FTPIN of CONN)
						   with (QUOTE INPUT))
                                                             (* Because \CLOSEFILE clobbered this field)
						(replace ACCESS of (fetch FTPOUT of CONN)
						   with (QUOTE OUTPUT))
						(RETURN CONN))
					  (\FTP.OPEN.CONNECTION HOST (.FTPDEBUGLOG.]
		      [COND
			(UNWINDSAVE (RESETSAVE (PROGN (fetch FTPIN of CONNECTION))
					       (QUOTE (AND RESETSTATE (ENDBSPSTREAM OLDVALUE 0]
		      CONNECTION])

(\RELEASE.FTPCONNECTION
  [LAMBDA (CONN)                                             (* bvm: "18-MAY-83 10:53")
    (replace FTPBUSY of CONN with NIL])

(\FTP.ERRORHANDLER
  [LAMBDA (INSTREAM ERRCODE)                                 (* bvm: " 6-JUL-83 15:33")
    (SELECTQ ERRCODE
	     (MARK.ENCOUNTERED (COND
				 ((fetch FTPOPENP of INSTREAM)
				   (STREAMOP (QUOTE ENDOFSTREAMOP)
					     INSTREAM INSTREAM))
				 (T -1)))
	     (ERROR "BSP error" ERRCODE])

(\FTP.CLEANUP
  [LAMBDA NIL                                                (* bvm: "19-AUG-83 16:19")
                                                             (* Process that sits watching to see if an FTP 
							     connection has been idle too long)
    (DECLARE (SPECVARS CONNS FAIL))
    (PROG ((TIMER (SETUPTIMER 0))
	   (INTERVAL (LRSH \FTP.IDLE.TIMEOUT 1))
	   CONNS)
      SLEEP
          (SETUPTIMER INTERVAL TIMER)
          (do (BLOCK NIL TIMER) until (TIMEREXPIRED? TIMER))
      LP1 (COND
	    ((NULL (SETQ CONNS \FTPCONNECTIONS))
	      (RETURN)))
      LP2 (COND
	    ([AND (FIXP (fetch FTPBUSY of (CAR CONNS)))
		  (TIMEREXPIRED? (fetch FTPBUSY of (CAR CONNS)))
		  (NOT (PROG (FAIL)
			     [MAP.PROCESSES (FUNCTION (LAMBDA (PROC)
						(COND
						  ((EQ (PROCESS.EVALV PROC (QUOTE FTPCONNECTION))
						       (CAR CONNS))
						    (SETQ FAIL T]
			     (RETURN FAIL]

          (* Timer expired AND there is nobody actively using this connection. Latter is important in case the remote server
	  was just slow to answer. Ideal solution would be to see if anyone has a pointer to the generator, but that takes 
	  gc changes)


	      (CLOSEBSPSTREAM (fetch FTPIN of (CAR CONNS)))
	      (GO LP1)))
          (COND
	    ((SETQ CONNS (CDR CONNS))
	      (GO LP2)))
          (GO SLEEP])

(\FTP.ASSURE.CLEANUP
  [LAMBDA NIL                                                (* bvm: "19-AUG-83 16:12")
    (OR (FIND.PROCESS (QUOTE \FTP.CLEANUP))
	(ADD.PROCESS (QUOTE (\FTP.CLEANUP))
		     (QUOTE RESTARTABLE)
		     (QUOTE NO])
)
(DEFINEQ

(\FTP.HANDLE.NO
  [LAMBDA (CONNECTION BADPLIST ECHOSTREAM CODE LEAVEMARK)    (* bvm: "19-AUG-83 22:22")
    (PROG ((INSTREAM (fetch FTPIN of CONNECTION))
	   (HOST (fetch FTPHOST of CONNECTION))
	   [FLUSHER (COND
		      (LEAVEMARK (FUNCTION \FTP.FLUSH.TO.MARK))
		      (T (FUNCTION \FTP.FLUSH.TO.EOC]
	   INFO)
          (OR CODE (SETQ CODE (FTPGETCODE INSTREAM)))
          (RETURN (COND
		    ((EQ CODE \NO.FILE.NOT.FOUND)
		      (APPLY* FLUSHER INSTREAM (OR ECHOSTREAM (.FTPDEBUGLOG.)))
		      NIL)
		    ((SELECTC CODE
			      [(LIST \NO.ILLEGAL.CONNECTNAME \NO.FILE.PROTECTED)
				(COND
				  ((NULL (ASSOC (QUOTE CONNECT-NAME)
						BADPLIST))
				    [NCONC1 BADPLIST (LIST (QUOTE CONNECT-NAME)
							   (\FTP.DIRECTORYNAMEONLY
							     (CADR (ASSOC (QUOTE DIRECTORY)
									  BADPLIST]
				    (APPLY* FLUSHER INSTREAM (OR ECHOSTREAM (.FTPDEBUGLOG.]
			      NIL))
		    (T (printout [OR ECHOSTREAM (SETQ ECHOSTREAM (GETSTREAM PROMPTWINDOW
									    (QUOTE OUTPUT]
				 T HOST ": ")
		       (COND
			 ((APPLY* FLUSHER INSTREAM ECHOSTREAM)
			   (SELECTC CODE
				    ((LIST \NO.ILLEGAL.USERNAME \NO.ILLEGAL.USERPASSWORD)
                                                             (* User Password errors)
				      (COND
					((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)))
				    ((LIST \NO.ILLEGAL.CONNECTNAME \NO.ILLEGAL.CONNECTPASSWORD)
                                                             (* Connect Password errors)
				      (COND
					((SETQ INFO (\INTERNAL/GETPASSWORD
					      HOST T (CADR (ASSOC (QUOTE CONNECT-NAME)
								  BADPLIST))
					      NIL))
					  [for PAIR in BADPLIST
					     do (SELECTQ (CAR PAIR)
							 (CONNECT-NAME (FRPLACA (CDR PAIR)
										(CAR INFO)))
							 [CONNECT-PASSWORD
							   (RETURN (FRPLACA (CDR PAIR)
									    (CDR INFO]
							 NIL)
					     finally (NCONC1 BADPLIST (LIST (QUOTE CONNECT-PASSWORD)
									    (CDR INFO]
					  T)))
				    ((LIST \NO.FILE.PROTECTED \NO.FILE.BUSY)
				      (LISPERROR "FILE WON'T OPEN" (\FTP.PACKFILENAME HOST BADPLIST)))
				    (\NO.STORAGE.FULL (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED"
								 (\FTP.PACKFILENAME HOST BADPLIST)))
				    NIL))
			 (T (\FTPERROR CONNECTION])

(\FTP.DIRECTORYNAMEONLY
  [LAMBDA (DIRNAME)                                          (* bvm: "16-AUG-83 18:35")
    (PROG ((N (STRPOS (QUOTE >)
		      DIRNAME)))
          (RETURN (COND
		    (N (SUBATOM DIRNAME 1 (SUB1 N)))
		    (T DIRNAME])

(\FTP.MAKEPLIST
  [LAMBDA (FILENAME HOST DESIREDPROPS)                       (* bvm: " 4-JUN-83 21:35")
    (PROG ((INFO (\INTERNAL/GETPASSWORD HOST)))
          (RETURN (CONS (LIST (QUOTE USER-NAME)
			      (CAR INFO))
			(CONS (LIST (QUOTE USER-PASSWORD)
				    (CDR INFO))
			      (CONS (LIST (QUOTE SERVER-FILENAME)
					  FILENAME)
				    (for PROP inside DESIREDPROPS collect (LIST (QUOTE 
										 DESIRED-PROPERTY)
										PROP])

(\FTP.PRINTPLIST
  [LAMBDA (STREAM PLIST)                                     (* bvm: "19-AUG-83 22:15")
    (BOUT STREAM (CHARCODE %())
    (for PAIR in PLIST
       do (for ITEM in PAIR bind (BEFORE ←(CHARCODE %())
	     do (BOUT STREAM BEFORE)
		(SETQ BEFORE (CHARCODE SPACE))
		(for CH inchars ITEM
		   do (SELCHARQ CH
				((%( %) ')
				  (BOUT STREAM (CHARCODE ')))
				NIL)
		      (BOUT STREAM CH)))
	  (BOUT STREAM (CHARCODE %))))
    (BOUT STREAM (CHARCODE %)))
    (COND
      (FTPDEBUGFLG (PRIN2 PLIST FTPDEBUGLOG)))
    STREAM])

(\FTP.PACKFILENAME
  [LAMBDA (HOST PLIST PRESERVECASE)                          (* bvm: "13-JUN-83 16:36")
    (PROG ((NAMEBODY (CADR (ASSOC (QUOTE NAME-BODY)
				  PLIST)))
	   NAME EXT N)
          [COND
	    [NAMEBODY (COND
			[(SETQ N (STRPOS (QUOTE %.)
					 NAMEBODY))
			  (SETQ EXT (SUBSTRING NAMEBODY (ADD1 N)))
			  (SETQ NAME (SUBSTRING NAMEBODY 1 (SUB1 N]
			(T (SETQ NAME NAMEBODY)))
		      (SETQ NAME (PACKFILENAME (QUOTE HOST)
					       HOST
					       (QUOTE DIRECTORY)
					       (CADR (ASSOC (QUOTE DIRECTORY)
							    PLIST))
					       (QUOTE NAME)
					       NAME
					       (QUOTE EXTENSION)
					       EXT
					       (QUOTE VERSION)
					       (CADR (ASSOC (QUOTE VERSION)
							    PLIST]
	    ((SETQ NAMEBODY (CADR (ASSOC (QUOTE SERVER-FILENAME)
					 PLIST)))
	      (SETQ NAME (PACKFILENAME (QUOTE HOST)
				       HOST
				       (QUOTE BODY)
				       NAMEBODY]
          (RETURN (COND
		    (PRESERVECASE NAME)
		    (T (U-CASE NAME])

(\FTP.UNPACKFILENAME
  [LAMBDA (FILENAME)                                         (* bvm: " 7-JUL-83 10:23")
    (PROG ((FIELDS (UNPACKFILENAME FILENAME))
	   PLIST HOST DIR NAME EXT INFO)
          (for TAIL on FIELDS by (CDDR TAIL) do (SELECTQ (CAR TAIL)
							 (HOST (SETQ HOST (CADR TAIL)))
							 (DIRECTORY (SETQ DIR (CADR TAIL)))
							 (NAME (SETQ NAME (CADR TAIL)))
							 (EXTENSION (SETQ EXT (CADR TAIL)))
							 [VERSION (push PLIST (LIST (QUOTE VERSION)
										    (CADR TAIL]
							 NIL))
          (RETURN (COND
		    (HOST (SETQ INFO (\INTERNAL/GETPASSWORD HOST))
			  [push PLIST (LIST (QUOTE NAME-BODY)
					    (COND
					      (EXT (PACK* NAME (QUOTE %.)
							  EXT))
					      (T NAME]
			  [COND
			    (DIR (push PLIST (LIST (QUOTE DIRECTORY)
						   DIR]
			  (push PLIST (LIST (QUOTE USER-NAME)
					    (CAR INFO))
				(LIST (QUOTE USER-PASSWORD)
				      (CDR INFO)))
			  (CONS HOST PLIST])

(\FTP.FLUSH.TO.EOC
  [LAMBDA (INSTREAM ECHOSTREAM)                              (* bvm: "13-JUN-83 15:36")

          (* Eat bytes from the input side of CONNECTION up to next mark, copying bytes to ECHOSTREAM if given, and return T
	  if the mark is EOC)


    (PROG ([STREAM (AND ECHOSTREAM (GETSTREAM ECHOSTREAM (QUOTE OUTPUT]
	   CH)
          (while (NEQ (SETQ CH (BIN INSTREAM))
		      -1)
	     do (AND STREAM (\OUTCHAR STREAM CH)))
          (RETURN (EQ (FTPGETMARK INSTREAM)
		      (MARK# EOC])

(\FTP.FLUSH.TO.MARK
  [LAMBDA (INSTREAM ECHOSTREAM)                              (* bvm: " 7-JUL-83 12:08")
    (bind CH [STREAM ←(AND ECHOSTREAM (GETSTREAM ECHOSTREAM (QUOTE OUTPUT]
       while (NEQ (SETQ CH (BIN INSTREAM))
		  -1)
       do (AND STREAM (\OUTCHAR STREAM CH)))
    T])

(\FTPERROR
  [LAMBDA (CONNECTION ERRMSG ERRARG)                         (* bvm: "19-AUG-83 22:16")
    (COND
      (FTPDEBUGFLG (printout FTPDEBUGLOG T "{FTP Protocol violation, aborted}" T)
		   (HELP)))
    (ENDBSPSTREAM (COND
		    ((type? STREAM CONNECTION)
		      CONNECTION)
		    (T (fetch FTPIN of CONNECTION)))
		  1000)
    (COND
      (ERRMSG (ERROR (COND
		       ((EQ ERRMSG T)
			 "FTP Protocol violation")
		       (T ERRMSG))
		     ERRARG])
)
(DEFINEQ

(REMOTEDIRECTORY
  [LAMBDA (PATTERN)                                          (* bvm: " 7-JUL-83 10:57")
    (RESETLST (PROG (HOST PLIST FTPRESULT)
		    (DECLARE (SPECVARS FTPRESULT))
		    (SETQ PATTERN (\ADD.CONNECTED.DIR PATTERN))
		    (OR (SETQ HOST (\FTP.UNPACKFILENAME PATTERN))
			(RETURN))
		    (SETQ PLIST (CDR HOST))
		    (SETQ HOST (CAR HOST))
		    (for PROP in (QUOTE (DIRECTORY NAME-BODY VERSION))
		       do (push PLIST (LIST (QUOTE DESIRED-PROPERTY)
					    PROP)))
		    (\FTP.ENUMERATE HOST PLIST (FUNCTION \FTP.COLLECT.DIRECTORY))
		    (RETURN (REVERSE FTPRESULT])

(\FTP.ENUMERATE
  [LAMBDA (HOST DESIREDPLIST GENFN)                          (* bvm: "19-AUG-83 22:23")
    (PROG ((CMD (MARK# NEW-ENUMERATE))
	   INS OUTS CODE CONNECTION)
      NEWCONNECTION
          (OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
	      (RETURN))
          (SETQ INS (fetch FTPIN of CONNECTION))
          (SETQ OUTS (fetch FTPOUT of CONNECTION))
      RETRY
          (FTPPUTMARK OUTS CMD)
          (\FTP.PRINTPLIST OUTS DESIREDPLIST)
          (.EOC. OUTS)
      LP  (SELECTC (FTPGETMARK INS)
		   ((MARK# EOC)
		     (\RELEASE.FTPCONNECTION CONNECTION)
		     (RETURN T))
		   ((MARK# HERE-IS-PLIST)
		     (until (\EOFP INS) do (APPLY* GENFN (READPLIST INS)
						   CONNECTION))
                                                             (* This works for either ENUMERATE or NEW-ENUMERATE)
		     (GO LP))
		   [(MARK# NO)
		     (COND
		       ((EQ (SETQ CODE (FTPGETCODE INS))
			    \NO.UNIMPLEMENTED)               (* Unimplemented command)
			 (SETQ CMD (MARK# ENUMERATE))
			 (\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.))
			 (GO RETRY))
		       ((\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL CODE)
			 (COND
			   ((BSPOPENP INS (QUOTE INPUT))
			     (GO RETRY))
			   (T (GO NEWCONNECTION]
		   (RETURN (\FTPERROR CONNECTION)))
          (RETURN])

(\FTP.COLLECT.DIRECTORY
  [LAMBDA (PLIST CONNECTION)
    (DECLARE (USEDFREE FTPRESULT))                           (* bvm: " 5-JUN-83 00:12")
    (push FTPRESULT (\FTP.PACKFILENAME (fetch FTPHOST of CONNECTION)
				       PLIST T])
)
(DEFINEQ

(FTPDEBUG
  [LAMBDA (FLG REGION)                                       (* bvm: "19-AUG-83 22:17")
    (SETQ FTPDEBUGLOG (CREATEW REGION "FTP Debug info"))
    (SETQ FTPDEBUGLOG (WINDOWPROP FTPDEBUGLOG (QUOTE DSP)))
    (DSPFONT (FONTCREATE (QUOTE GACHA)
			 8)
	     FTPDEBUGLOG)
    (DSPSCROLL T FTPDEBUGLOG)
    (SETQ FTPDEBUGFLG T)
    FTPDEBUGLOG])

(FTPPRINTMARK
  [LAMBDA (MARK)                                             (* bvm: "19-AUG-83 22:17")
    (COND
      (FTPDEBUGFLG (printout FTPDEBUGLOG "[" (OR (CADR (FASSOC MARK FTPMARKTYPES))
						 MARK)
			     "]")))
    MARK])

(FTPPRINTCODE
  [LAMBDA (CODE)                                             (* bvm: "19-AUG-83 22:19")
    (COND
      (FTPDEBUGFLG (PRIN1 (QUOTE {)
			  FTPDEBUGLOG)
		   (PRINTCONSTANT CODE FTPNOCODES FTPDEBUGLOG "\NO.")
		   (PRIN1 (QUOTE })
			  FTPDEBUGLOG)))
    CODE])

(FTPGETMARK
  [LAMBDA (STREAM)                                           (* bvm: " 4-JUN-83 21:51")
    (bind MARK while (EQ (SETQ MARK (FTPPRINTMARK (BSPGETMARK STREAM)))
			 (MARK# COMMENT))
       do (\FTP.FLUSH.TO.MARK STREAM) finally (RETURN MARK])

(FTPPUTMARK
  [LAMBDA (STREAM MARK)                                      (* bvm: "12-MAY-83 10:24")
    (BSPPUTMARK STREAM (FTPPRINTMARK MARK])

(FTPPUTCODE
  [LAMBDA (STREAM CODE)                                      (* bvm: " 4-JUN-83 00:21")
    (BOUT STREAM (FTPPRINTCODE CODE])

(FTPGETCODE
  [LAMBDA (STREAM)                                           (* bvm: " 4-JUN-83 00:21")
    (FTPPRINTCODE (BIN STREAM])

(FLUSH.FTPCONNECTIONS
  [LAMBDA NIL                                                (* bvm: "14-JUN-83 12:35")
    (while \FTPCONNECTIONS do (CLOSEBSPSTREAM (fetch FTPIN of (CAR \FTPCONNECTIONS))
					      11610Q])
)

(ADDTOVAR \FTPCONNECTIONS )

(RPAQ? FTPDEBUGLOG )

(RPAQ? FTPDEBUGFLG )

(RPAQ? \FTP.ILLEGAL.STREAM 0)

(RPAQ? \FTPAVAILABLE )

(RPAQ? \FTP.IDLE.TIMEOUT 120000)
(DECLARE: EVAL@COMPILE DONTCOPY 

(RPAQQ FTPMARKTYPES ((1 RETRIEVE)
		     (2 STORE)
		     (3 YES)
		     (4 NO)
		     (5 HERE-IS-FILE)
		     (6 EOC)
		     (7 COMMENT)
		     (8 VERSION)
		     (9 NEW-STORE)
		     (10 ENUMERATE)
		     (11 HERE-IS-PLIST)
		     (12 NEW-ENUMERATE)
		     (14 DELETE)
		     (15 RENAME)
		     (16 STORE-MAIL)
		     (17 RETRIEVE-MAIL)
		     (18 FLUSH-MAILBOX)
		     (19 MAILBOX-EXCEPTION)))

(DECLARE: EVAL@COMPILE 

(RPAQQ \FTP.VERSION 1)

(CONSTANTS \FTP.VERSION)
)


(RPAQQ FTPNOCODES ((\NO.UNIMPLEMENTED 1)
		   (\NO.PROTOCOL.ERROR 3)
		   (\NO.ILLEGAL.USERNAME 16)
		   (\NO.ILLEGAL.USERPASSWORD 17)
		   (\NO.ILLEGAL.CONNECTNAME 19)
		   (\NO.ILLEGAL.CONNECTPASSWORD 20)
		   (\NO.FILE.NOT.FOUND 64)
		   (\NO.FILE.PROTECTED 65)
		   (\NO.FILE.BUSY 73)
		   (\NO.STORAGE.FULL 68)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \NO.UNIMPLEMENTED 1)

(RPAQQ \NO.PROTOCOL.ERROR 3)

(RPAQQ \NO.ILLEGAL.USERNAME 16)

(RPAQQ \NO.ILLEGAL.USERPASSWORD 17)

(RPAQQ \NO.ILLEGAL.CONNECTNAME 19)

(RPAQQ \NO.ILLEGAL.CONNECTPASSWORD 20)

(RPAQQ \NO.FILE.NOT.FOUND 64)

(RPAQQ \NO.FILE.PROTECTED 65)

(RPAQQ \NO.FILE.BUSY 73)

(RPAQQ \NO.STORAGE.FULL 68)

(CONSTANTS (\NO.UNIMPLEMENTED 1)
	   (\NO.PROTOCOL.ERROR 3)
	   (\NO.ILLEGAL.USERNAME 16)
	   (\NO.ILLEGAL.USERPASSWORD 17)
	   (\NO.ILLEGAL.CONNECTNAME 19)
	   (\NO.ILLEGAL.CONNECTPASSWORD 20)
	   (\NO.FILE.NOT.FOUND 64)
	   (\NO.FILE.PROTECTED 65)
	   (\NO.FILE.BUSY 73)
	   (\NO.STORAGE.FULL 68))
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS MARK# MACRO [X (OR [CAR (find M in FTPMARKTYPES suchthat (EQ (CADR M)
								       (CAR X]
			     (HELP "Unknown mark type" (CAR X])

(PUTPROPS .EOC. MACRO ((STREAM)
		       (FTPPUTMARK STREAM (MARK# EOC))))

(PUTPROPS .FTPDEBUGLOG. MACRO (NIL (AND FTPDEBUGFLG FTPDEBUGLOG)))
)

[DECLARE: EVAL@COMPILE 

(RECORD FTPCONNECTION (FTPIN FTPOUT FTPHOST FTPBUSY FTPCURRENTFILE))

(ACCESSFNS FTPSTREAM ((FTPFILEPROPS (fetch F5 of DATUM)
				    (replace F5 of DATUM with NEWVALUE)))
		     (SYNONYM FTPFILEPROPS (FTPOPENP)))
]

(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \FTP.ILLEGAL.STREAM FTPDEBUGFLG \FTPCONNECTIONS \FTPAVAILABLE \FTP.IDLE.TIMEOUT)
)

(FILESLOAD (LOADCOMP)
	   BSP)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\FTPINIT)
)
(PUTPROPS DPUPFTP COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1896 19705 (\FTPINIT 1906 . 2453) (\FTP.OPENFILE 2455 . 6488) (\FTP.CLOSEFILE 6490 . 
8381) (\FTP.RENAMEFILE 8383 . 9792) (\FTP.DELETEFILE 9794 . 11993) (\FTP.GENERATEFILES 11995 . 16040) 
(\FTP.NEXTFILE 16042 . 18395) (\FTP.GETFILEINFO 18397 . 19476) (\FTP.GETDATEPROP 19478 . 19703)) (
19706 24990 (\FTP.OPEN.CONNECTION 19716 . 20602) (\FTP.SENDVERSION 20604 . 21159) (\FTP.WHENCLOSED 
21161 . 21715) (\GETFTPCONNECTION 21717 . 22861) (\RELEASE.FTPCONNECTION 22863 . 23034) (
\FTP.ERRORHANDLER 23036 . 23362) (\FTP.CLEANUP 23364 . 24739) (\FTP.ASSURE.CLEANUP 24741 . 24988)) (
24991 32131 (\FTP.HANDLE.NO 25001 . 27526) (\FTP.DIRECTORYNAMEONLY 27528 . 27780) (\FTP.MAKEPLIST 
27782 . 28247) (\FTP.PRINTPLIST 28249 . 28839) (\FTP.PACKFILENAME 28841 . 29828) (\FTP.UNPACKFILENAME 
29830 . 30802) (\FTP.FLUSH.TO.EOC 30804 . 31337) (\FTP.FLUSH.TO.MARK 31339 . 31645) (\FTPERROR 31647
 . 32129)) (32132 34388 (REMOTEDIRECTORY 32142 . 32768) (\FTP.ENUMERATE 32770 . 34126) (
\FTP.COLLECT.DIRECTORY 34128 . 34386)) (34389 36272 (FTPDEBUG 34399 . 34759) (FTPPRINTMARK 34761 . 
35006) (FTPPRINTCODE 35008 . 35290) (FTPGETMARK 35292 . 35577) (FTPPUTMARK 35579 . 35734) (FTPPUTCODE 
35736 . 35885) (FTPGETCODE 35887 . 36030) (FLUSH.FTPCONNECTIONS 36032 . 36270)))))
STOP