(FILECREATED " 2-Feb-86 11:53:27" {ERIS}<SCHOEN>TCP>TCPFTP.;3 39439  

      changes to:  (FNS ARPACMD FTPHELP CMDREADCODE CMDREAD DISCARDLINE GETLINE \TCPFTP.INPUT 
			TELNET.EOL \TCPFTP.GET.OSTYPE \TCPFTP.EVENTFN \TCPFTP.HOSTNAMEP 
			\GET.TCPFTP.CONNECTION \TCPFTP.OPEN.CONNECTION \TCPFTP.ASSURE.CLEANUP 
			\TCPFTP.CLEANUP \TCPFTP.RELEASE.CONNECTION \TCPFTP.LOGIN \TCPFTP.DELETEFILE 
			\TCPFTP.DIRECTORYNAMEP \TCPFTP.ENDOFSTREAMOP \TCPFTP.GENERATEFILES 
			\TCPFTP.GENERATENEXTFILE \TCPFTP.GETFILENAME \TCPFTP.GETFILEINFO 
			\TCPFTP.SETFILEINFO \TCPFTP.CONNECT \TCPFTP.OPENFILE \TCPFTP.CLOSE 
			\TCPFTP.FLUSH \TCP.BYE \TCPFTP.MAYBE.ABORT \TCPFTP.OPEN.DATA.CONNECTION 
			\TCPFTP.PORT.STRING \TCPFTP.SPAWN.DATACONNECTION \TCPFTP.TRANSFER.COMPLETE 
			\TCPFTP.WAIT.FOR.DATACONNECTION \TCPFTP.DELETE.CONNECTION)

      previous date: "19-Dec-85 12:44:22" {ERIS}<SCHOEN>TCP>TCPFTP.;2)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT TCPFTPCOMS)

(RPAQQ TCPFTPCOMS ((COMS (* * FNS from Larry's Interlisp-10 LISPUSERS package)
			   (FNS ARPACMD FTPHELP CMDREADCODE CMDREAD DISCARDLINE GETLINE \TCPFTP.INPUT 
				TELNET.EOL)
			   (INITVARS (\TCPFTP.ARPACMD.LOCK (CREATE.MONITORLOCK "ARPACMD Lock")))
			   (GLOBALVARS \TCPFTP.ARPACMD.LOCK)
			   (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
				     (ADDVARS (NLAMA)
					      (NLAML)
					      (LAMA FTPHELP))))
	(COMS (* * FNS for the Interlisp-D streams facility)
	      (FNS \TCPFTP.GET.OSTYPE \TCPFTP.EVENTFN \TCPFTP.HOSTNAMEP \GET.TCPFTP.CONNECTION 
		   \TCPFTP.OPEN.CONNECTION \TCPFTP.ASSURE.CLEANUP \TCPFTP.CLEANUP 
		   \TCPFTP.RELEASE.CONNECTION \TCPFTP.LOGIN \TCPFTP.DELETEFILE \TCPFTP.DIRECTORYNAMEP 
		   \TCPFTP.ENDOFSTREAMOP \TCPFTP.GENERATEFILES \TCPFTP.GENERATENEXTFILE 
		   \TCPFTP.GETFILENAME \TCPFTP.GETFILEINFO \TCPFTP.SETFILEINFO \TCPFTP.CONNECT 
		   \TCPFTP.OPENFILE \TCPFTP.CLOSE \TCPFTP.FLUSH \TCPFTP.INIT)
	      (RECORDS TCPDATASTREAM TCPFTPCON)
	      (INITVARS (TCP.DEFAULTFILETYPE 'BINARY)
			(TCPFTP.DEFAULT.FILETYPES ' ((DCOM . BINARY)
						   (BIN . BINARY)
						   (NIL . TEXT)))
			(TCP.USE.STANDARD.EOL T)
			(\TCPFTP.DEVICES)
			(\TCPFTP.CLEANUP.PROCESS))
	      (GLOBALVARS \TCPFTP.DEVICES \TCPFTP.CLEANUP.PROCESS TCP.DEFAULTFILETYPE 
			  TCP.USE.STANDARD.EOL))
	(COMS (* * Data connection handling)
	      (FNS \TCP.BYE \TCPFTP.MAYBE.ABORT \TCPFTP.OPEN.DATA.CONNECTION \TCPFTP.PORT.STRING 
		   \TCPFTP.SPAWN.DATACONNECTION \TCPFTP.TRANSFER.COMPLETE 
		   \TCPFTP.WAIT.FOR.DATACONNECTION \TCPFTP.DELETE.CONNECTION)
	      (INITVARS (\TCPFTP.DATACONNECTION.LOCK (CREATE.MONITORLOCK 
								    "TCPFTP Data Connection Lock"))
			(\TCPFTP.CONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Connection Lock"))
			(\TCPFTP.IDLE.TIMEOUT (TIMES 10 60 1000)))
	      (GLOBALVARS \TCPFTP.DATACONNECTION.LOCK \TCPFTP.CONNECTION.LOCK \TCPFTP.IDLE.TIMEOUT))
	(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	       TCPNAMES TCP)
	(P (\TCPFTP.INIT))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA)))))
(* * FNS from Larry's Interlisp-10 LISPUSERS package)

(DEFINEQ

(ARPACMD
  (LAMBDA (TCPFTPCON CMD ARG WANT DISCARD WANTARG)           (* ejs: "26-Apr-85 12:00")
                                                             (* lmm "16-OCT-78 02:57")
    (DECLARE (GLOBALVARS \TCPFTP.ARPACMD.LOCK))
    (WITH.MONITOR \TCPFTP.ARPACMD.LOCK
		  (LET ((INC (fetch (TCPFTPCON TCPIN) of TCPFTPCON))
			(OUTC (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)))
		       (RESETLST (RESETSAVE NIL (BQUOTE (COND
								(RESETSTATE
								  (AND (OPENP , INC (QUOTE
										    INPUT))
									 (CLOSEF , INC))
								  (AND (OPENP , OUTC
										  (QUOTE OUTPUT))
									 (CLOSEF , OUTC))))))
				   (PROG NIL
				           (COND
					     (CMD (COND
						    (FTPDEBUGFLG (printout FTPDEBUGLOG CMD " " ARG)))
						  (PRIN3 CMD OUTC)
						  (PRIN3 " " OUTC)
						  (PRIN3 ARG OUTC)
						  (TELNET.EOL OUTC)
						  (FORCEOUTPUT OUTC)
                                                             (* flush)
						  (COND
						    (FTPDEBUGFLG (TERPRI FTPDEBUGLOG)))))
				       LP  (COND
					     (FTPDEBUGFLG (printout FTPDEBUGLOG "< ")))
				           (SETQ CMD (\TCPFTP.INPUT INC))
				           (COND
					     (FTPDEBUGFLG (printout FTPDEBUGLOG CMD " ")))
				           (COND
					     ((EQMEMB CMD WANTARG)
					       (AND (EQ (BIN INC)
							    (CHARCODE -))
						      (FTPHELP CMD))
					       (RETURN CMD)))
				           (COND
					     ((EQ (BIN INC)
						    (CHARCODE -))
					       (do (DISCARDLINE INC) repeatuntil
									  (EQ (\TCPFTP.INPUT
										  INC)
										CMD))))
				           (COND
					     ((EQMEMB CMD WANT)
					       (DISCARDLINE INC)
					       (RETURN CMD))
					     ((EQMEMB CMD DISCARD)
					       (DISCARDLINE INC)
					       (GO LP)))
				           (SELECTQ (AND (FIXP CMD)
							     (IQUOTIENT CMD 100))
						      ((2 3)
							(FTPHELP CMD))
						      ((4 5)
							(ERROR (GETLINE INC T)))
						      NIL)
				           (DISCARDLINE INC)
				           (GO LP)))))))

(FTPHELP
  (LAMBDA (ARG)                                            (* ejs: "29-Jan-85 17:02")
    (ERROR ARG " unrecognized response from remote FTP server")))

(CMDREADCODE
  (LAMBDA (IN)                                             (* lmm "31-MAY-78 00:45")
    (PACK* (CMDREAD IN)
	     (CMDREAD IN)
	     (CMDREAD IN))))

(CMDREAD
  (LAMBDA (IN)                                             (* ejs: "12-Jan-85 14:28")
    ((LAMBDA (CH)
	(COND
	  (FTPDEBUGFLG (BOUT CH FTPDEBUGLOG)))
	CH)
      (BIN IN))))

(DISCARDLINE
  (LAMBDA (IN)                                             (* ejs: "29-Jan-85 15:22")
                                                             (* lmm "31-MAY-78 00:45")
    (DECLARE (GLOBALVARS FTPDEBUGFLG FTPDEBUGLOG))
    (COND
      (FTPDEBUGFLG (\BACKFILEPTR IN)
		   (bind CH until (EQ (SETQ CH (BIN IN))
					    (CHARCODE LF))
		      do (BOUT FTPDEBUGLOG CH) finally (TERPRI FTPDEBUGLOG)))
      (T (until (EQ (BIN IN)
			(CHARCODE LF)))))))

(GETLINE
  (LAMBDA (IN FLG)                                         (* ejs: "12-Jan-85 14:40")
                                                             (* lmm "31-MAY-78 00:46")
    (bind CH (STRING ← (ALLOCSTRING 80)) for POS from 1 while (NEQ (SETQ CH
										 (BIN IN))
									       (CHARCODE LF))
       do (COND
	      ((LEQ POS 80)
		(RPLCHARCODE STRING POS CH)))
       finally (RETURN (SUBSTRING STRING 1 (SUB1 POS))))))

(\TCPFTP.INPUT
  (LAMBDA (STREAM)                                           (* ejs: " 3-Feb-85 16:21")
    (PROG ((CODE 0)
	     GOTCODE)
	    (bind CH until (OR (EQ CH (CHARCODE -))
				     (EQ CH 0)
				     (EQ CH (CHARCODE SPACE)))
	       do (SETQ CH (BIN STREAM))
		    (COND
		      ((AND (NOT GOTCODE)
			      (GEQ CH (CHARCODE 0))
			      (LEQ CH (CHARCODE 9)))
			(SETQ CODE (PLUS (TIMES CODE 10)
					     (DIFFERENCE CH (CHARCODE 0)))))
		      (T (SETQ GOTCODE T))))
	    (RETURN CODE))))

(TELNET.EOL
  (LAMBDA (STREAM)                                           (* ejs: " 5-Jan-85 18:44")
    (BOUT STREAM (CHARCODE CR))
    (BOUT STREAM (CHARCODE LF))
    (FORCEOUTPUT STREAM)))
)

(RPAQ? \TCPFTP.ARPACMD.LOCK (CREATE.MONITORLOCK "ARPACMD Lock"))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \TCPFTP.ARPACMD.LOCK)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA FTPHELP)
)
(* * FNS for the Interlisp-D streams facility)

(DEFINEQ

(\TCPFTP.GET.OSTYPE
  (LAMBDA (DEVICE)                                           (* ejs: "23-Feb-85 16:40")
    (LET* ((HOST (fetch (FDEV DEVICENAME) of DEVICE))
	   ENTRY)
          (COND
	    ((AND (FASSOC HOST \HOSTNAMES)
		    (GETHOSTINFO HOST (QUOTE OSTYPE))))
	    ((SETQ ENTRY (GETHASH HOST \IP.HOSTNAMES))
	      (fetch (HOSTS.TXT.ENTRY HTE.OS.TYPE) of ENTRY))))))

(\TCPFTP.EVENTFN
  (LAMBDA (FDEV FLG)                                         (* ejs: "23-Apr-85 18:56")

          (* * Called when a major event happens)


    (SELECTQ FLG
	       ((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS)
		 (bind TCPIN TCPOUT DATASTREAM for TCPFTPCON in (fetch (FDEV DEVICEINFO)
									 of FDEV)
		    do (SETQ TCPIN (fetch (TCPFTPCON TCPIN) of TCPFTPCON))
			 (SETQ TCPOUT (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))
			 (SETQ DATASTREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))
			 (COND
			   ((OPENP TCPIN (QUOTE INPUT))
			     (CLOSEF TCPIN)))
			 (COND
			   ((OPENP TCPOUT (QUOTE OUTPUT))
			     (CLOSEF TCPOUT)))
			 (COND
			   ((OPENP DATASTREAM)
			     (CLOSEF DATASTREAM)))))
	       NIL)))

(\TCPFTP.HOSTNAMEP
  (LAMBDA (HOST DEVICE)                                      (* ejs: " 9-Nov-85 14:24")
    (DECLARE (GLOBALVARS \TCP.DEVICE \TCPFTP.DEVICES))
    (PROG ((SERVER (OR (DODIP.HOSTP HOST)
			   (\IP.READ.STRING.ADDRESS HOST)))
	     FULLHOSTNAME FILINGNAME)
	    (RETURN (COND
			((NOT SERVER)
			  NIL)
			((\GETDEVICEFROMNAME (SETQ FULLHOSTNAME (MKATOM (U-CASE HOST)))
					       T T))
			(T (SETQ FILINGNAME (PACK* HOST " Filing"))
			   (\DEFINEDEVICE FULLHOSTNAME
					    (SETQ DEVICE
					      (create FDEV using \TCP.DEVICE DEVICENAME ← 
								     FULLHOSTNAME OPENFILE ←
								     (FUNCTION \TCPFTP.OPENFILE)
								     REOPENFILE ←
								     (FUNCTION NILL)
								     GETFILEINFO ←
								     (FUNCTION \TCPFTP.GETFILEINFO)
								     SETFILEINFO ←
								     (FUNCTION \TCPFTP.SETFILEINFO)
								     GETEOFPTR ←
								     (FUNCTION \TCPFTP.GETEOFPTR)
								     DELETEFILE ←
								     (FUNCTION \TCPFTP.DELETEFILE)
								     HOSTNAMEP ←
								     (FUNCTION NILL)
								     GETFILENAME ←
								     (FUNCTION \TCPFTP.GETFILENAME)
								     DIRECTORYNAMEP ←
								     (FUNCTION 
								       \TCPFTP.DIRECTORYNAMEP)
								     GENERATEFILES ←
								     (FUNCTION 
								       \TCPFTP.GENERATEFILES)
								     EVENTFN ←
								     (FUNCTION NILL)
								     DEVICEINFO ← NIL)))
			   (push \TCPFTP.DEVICES DEVICE)
			   DEVICE))))))

(\GET.TCPFTP.CONNECTION
  (LAMBDA (DEVICE)                                           (* ejs: " 4-Jun-85 17:54")
    (LET ((CONNECTIONS (fetch (FDEV DEVICEINFO) of DEVICE))
	  TCPFTPCON INSTREAM OUTSTREAM)
         (WITH.MONITOR \TCPFTP.CONNECTION.LOCK (COND
			 ((SETQ TCPFTPCON (for TCPFTPCON in CONNECTIONS
					       thereis (NULL (fetch (TCPFTPCON BUSY?)
								    of TCPFTPCON))))
			   (COND
			     ((AND (SETQ INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON))
				     (SETQ OUTSTREAM (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))
				     (OPENP INSTREAM (QUOTE INPUT))
				     (OPENP OUTSTREAM (QUOTE OUTPUT))
				     (NOT (EOFP INSTREAM)))
			       (while (READP INSTREAM) do (BIN INSTREAM))
			       (replace (TCPFTPCON BUSY?) of TCPFTPCON with T)
			       TCPFTPCON)
			     (T (\TCPFTP.DELETE.CONNECTION TCPFTPCON DEVICE)
				(\TCPFTP.OPEN.CONNECTION DEVICE))))
			 (T (\TCPFTP.OPEN.CONNECTION DEVICE)))))))

(\TCPFTP.OPEN.CONNECTION
  (LAMBDA (DEVICE)                                           (* ejs: "27-Jun-85 12:42")
    (LET* ((HOST (DODIP.HOSTP (fetch (FDEV DEVICENAME) of DEVICE)))
	   (TCPFTPCON (create TCPFTPCON
				BUSY? ← T))
	   (INSTREAM (TCP.OPEN HOST \TCP.FTP.PORT NIL (QUOTE ACTIVE)
				 (QUOTE INPUT)))
	   (OUTSTREAM (COND
			(INSTREAM (TCP.OTHER.STREAM INSTREAM)))))
          (COND
	    (INSTREAM (replace (STREAM ENDOFSTREAMOP) of INSTREAM with (FUNCTION (LAMBDA (
										   STREAM)
										 (ZERO))))
		      (replace (STREAM DEVICE) of INSTREAM with DEVICE)
		      (replace (STREAM DEVICE) of OUTSTREAM with DEVICE)
		      (replace (TCPFTPCON TCPIN) of TCPFTPCON with INSTREAM)
		      (replace (TCPFTPCON TCPOUT) of TCPFTPCON with OUTSTREAM)
		      (SELECTQ (\TCPFTP.INPUT INSTREAM)
				 (220 (\TCPFTP.LOGIN DEVICE TCPFTPCON)
				      (push (fetch (FDEV DEVICEINFO) of DEVICE)
					      TCPFTPCON)
				      TCPFTPCON)
				 (PROGN (\TCPFTP.DELETE.CONNECTION TCPFTPCON DEVICE)
					  NIL)))))))

(\TCPFTP.ASSURE.CLEANUP
  (LAMBDA NIL                                                (* ejs: "27-Apr-85 14:08")

          (* * Spawn a cleanup function if necessary)


    (COND
      ((AND (PROCESSP \TCPFTP.CLEANUP.PROCESS)
	      (NOT (PROCESS.FINISHEDP \TCPFTP.CLEANUP.PROCESS))))
      (T (SETQ \TCPFTP.CLEANUP.PROCESS (ADD.PROCESS (QUOTE (\TCPFTP.CLEANUP))
							(QUOTE RESTARTABLE)
							(QUOTE NO)))))))

(\TCPFTP.CLEANUP
  (LAMBDA NIL                                                (* ejs: " 4-Jun-85 19:52")
    (DECLARE (GLOBALVARS \TCPFTP.IDLE.TIMEOUT \TCPFTP.DEVICES \TCPFTP.CONNECTION.LOCK))
    (LET ((INTERVAL (QUOTIENT \TCPFTP.IDLE.TIMEOUT 4))
	  CONNECTIONSP)
         (repeatwhile (NOT (ZEROP CONNECTIONSP))
	    do (SETQ CONNECTIONSP 0)
		 (for DEVICE in \TCPFTP.DEVICES
		    do (for CONNECTION in (fetch (FDEV DEVICEINFO) of DEVICE)
			    do (add CONNECTIONSP 1)
				 (WITH.MONITOR \TCPFTP.CONNECTION.LOCK
					       (NLSETQ (COND
							   ((AND (NULL (fetch (TCPFTPCON BUSY?)
									      of CONNECTION))
								   (TIMEREXPIRED?
								     (fetch (TCPFTPCON IDLETIMER)
									of CONNECTION)))
							     (CLOSEF? (fetch (TCPFTPCON TCPIN)
									   of CONNECTION))
							     (CLOSEF? (fetch (TCPFTPCON TCPOUT)
									   of CONNECTION))
							     (COND
							       ((fetch (TCPFTPCON DATASTREAM)
								   of CONNECTION)
								 (CLOSEF? (fetch (TCPFTPCON
										       DATASTREAM)
									       of CONNECTION))))
							     (add CONNECTIONSP -1)
							     (\TCPFTP.DELETE.CONNECTION CONNECTION 
											  DEVICE T))
							   ((NOT (OPENP (fetch (TCPFTPCON
										       TCPIN)
									       of CONNECTION)
									    (QUOTE INPUT)))
							     (add CONNECTIONSP -1)
							     (\TCPFTP.DELETE.CONNECTION CONNECTION 
											  DEVICE)))))
				 (BLOCK)))
		 (COND
		   ((NOT (ZEROP CONNECTIONSP))
		     (BLOCK INTERVAL)))))))

(\TCPFTP.RELEASE.CONNECTION
  (LAMBDA (TCPFTPCON)                                        (* jmh "11-Oct-85 13:43")
    (COND
      (TCPFTPCON (replace (TCPFTPCON BUSY?) of TCPFTPCON with NIL)
		 (replace (TCPFTPCON DATASTREAM) of TCPFTPCON with NIL)
		 (replace (TCPFTPCON IDLETIMER) of TCPFTPCON with (SETUPTIMER 
									     \TCPFTP.IDLE.TIMEOUT))
		 (\TCPFTP.ASSURE.CLEANUP)))))

(\TCPFTP.LOGIN
  (LAMBDA (DEVICE TCPFTPCON)                                 (* ejs: "19-Aug-85 12:06")

          (* * Log us in)


    (PROG (HOST INFO)
	    (SETQ HOST (fetch (FDEV DEVICENAME) of DEVICE))
	RETRY
	    (COND
	      ((OR (EQ 0 (NCHARS (CAR INFO)))
		     (EQ 0 (NCHARS (CDR INFO))))       (* Need to login. Can't send Unix hosts a string of no
							     chars as name or password!)
		(LOGIN HOST)
		(GO RETRY))
	      (T (SETQ INFO (\INTERNAL/GETPASSWORD HOST))))
	RETRY1
	    (SELECTQ (ARPACMD TCPFTPCON "USER" (CAR INFO)
				  (QUOTE (202 230 331 332 500 503 530)))
		       ((230 202)                            (* We're logged in)
			 (RETURN T))
		       (331                                  (* Needs a password)
			    (SELECTQ (ARPACMD TCPFTPCON "PASS" (\DECRYPT.PWD (CDR INFO))
						  (QUOTE (230 331 332 530)))
				       (230 (RETURN T))
				       (332 (SELECTQ (ARPACMD TCPFTPCON "ACCT"
								  (PROMPTFORWORD (CONCAT 
								      "Account for logging into "
											     HOST))
								  (QUOTE (230 202 530)))
						       (230 (RETURN T))
						       (GO RETRY1)))
				       ((331 530)
					 (LOGIN HOST)
					 (GO RETRY))
				       (FTPHELP)))
		       (332 (SELECTQ (ARPACMD TCPFTPCON "ACCT" (PROMPTFORWORD (CONCAT 
								      "Account for logging into "
											      HOST))
						  (QUOTE (230 202 530)))
				       (230 (RETURN T))
				       (GO RETRY1)))
		       (503 (GO RETRY1))
		       ((500 530)                            (* No such user?)
			 (LOGIN HOST)
			 (GO RETRY))
		       (FTPHELP)))))

(\TCPFTP.DELETEFILE
  (LAMBDA (NAME DEVICE)                                      (* ejs: "27-Apr-85 14:03")

          (* * FTP delete request)


    (LET* ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE))
	   (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
	   (CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "DELE" (REPACKFILENAME.STRING
					       (PACKFILENAME.STRING (QUOTE HOST)
								      NIL
								      (QUOTE BODY)
								      NAME)
					       OSTYPE)
					     (QUOTE (200 226 250)))))))
          (\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
          (SELECTQ CODE
		     ((250 226 200)
		       NAME)
		     NIL))))

(\TCPFTP.DIRECTORYNAMEP
  (LAMBDA (HOST/DIR DEVICE)                                  (* ejs: "27-Apr-85 14:04")
    (LET ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE)))
         (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (TCPFTPCON)
						  (\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
						  (COND
						    (RESETSTATE (AND (OPENP (fetch
										  (TCPFTPCON TCPIN)
										   of TCPFTPCON))
								       (CLOSEF (fetch
										   (TCPFTPCON TCPIN)
										    of TCPFTPCON)))
								(replace (TCPFTPCON TCPIN)
								   of TCPFTPCON with NIL)
								(AND (OPENP (fetch
										  (TCPFTPCON TCPOUT)
										   of TCPFTPCON))
								       (CLOSEF (fetch
										   (TCPFTPCON TCPOUT)
										    of TCPFTPCON)))
								(replace (TCPFTPCON TCPOUT)
								   of TCPFTPCON with NIL)))))
					      TCPFTPCON))
		     (\TCPFTP.CONNECT DEVICE TCPFTPCON (FILENAMEFIELD HOST/DIR (QUOTE DIRECTORY)
									  ))))))

(\TCPFTP.ENDOFSTREAMOP
  (LAMBDA (STREAM SILENTLY)                                  (* ejs: " 3-Feb-85 17:01")
    (\TCPFTP.TRANSFER.COMPLETE STREAM)
    (OR SILENTLY (\EOSERROR STREAM))))

(\TCPFTP.GENERATEFILES
  (LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS)              (* ejs: "21-Jun-85 18:48")

          (* * FTP directory request)


    (LET* ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE))
	   (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
	   DATASTREAMEVENT DATASTREAM CODE)
          (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON (QUOTE INPUT)))
          (BLOCK)
          (SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "NLST"
						   (COND
						     ((EQ OSTYPE (QUOTE UNIX))
						       (COND
							 ((AND (EQ (FILENAMEFIELD PATTERN
											(QUOTE
											  VERSION))
								       (QUOTE *))
								 (EQ (FILENAMEFIELD PATTERN
											(QUOTE
											  EXTENSION))
								       (QUOTE *))
								 (EQ (FILENAMEFIELD PATTERN
											(QUOTE
											  NAME))
								       (QUOTE *)))
							   (REPACKFILENAME.STRING
							     (PACKFILENAME.STRING (QUOTE HOST)
										    NIL
										    (QUOTE VERSION)
										    NIL
										    (QUOTE 
											EXTENSION)
										    NIL
										    (QUOTE NAME)
										    "*"
										    (QUOTE BODY)
										    PATTERN)
							     (QUOTE UNIX)))
							 ((EQ (FILENAMEFIELD PATTERN
										 (QUOTE VERSION))
								(QUOTE *))
							   (REPACKFILENAME.STRING
							     (PACKFILENAME.STRING (QUOTE HOST)
										    NIL
										    (QUOTE VERSION)
										    NIL
										    (QUOTE BODY)
										    PATTERN)
							     (QUOTE UNIX)))
							 (T (REPACKFILENAME.STRING
							      (PACKFILENAME.STRING (QUOTE HOST)
										     NIL
										     (QUOTE BODY)
										     PATTERN)
							      (QUOTE UNIX)))))
						     (T (REPACKFILENAME.STRING (
									      PACKFILENAME.STRING
										   (QUOTE HOST)
										   NIL
										   (QUOTE BODY)
										   PATTERN)
										 OSTYPE)))
						   150))))
          (SELECTQ CODE
		     (150 

          (* * Here we go)


			  (COND
			    ((SETQ DATASTREAM (\TCPFTP.WAIT.FOR.DATACONNECTION DEVICE TCPFTPCON 
										  DATASTREAMEVENT
										   (QUOTE INPUT)))
			      (replace (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON
				 with (FILENAMEFIELD PATTERN (QUOTE DIRECTORY)))
			      (create FILEGENOBJ
					NEXTFILEFN ← (FUNCTION \TCPFTP.GENERATENEXTFILE)
					FILEINFOFN ← (FUNCTION NILL)
					GENFILESTATE ← TCPFTPCON))))
		     (PROGN (DEL.PROCESS (fetch (EVENT EVENTNAME) of DATASTREAMEVENT))
			      (\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
			      (\NULLFILEGENERATOR))))))

(\TCPFTP.GENERATENEXTFILE
  (LAMBDA (TCPFTPCON NAMEONLY)                               (* ejs: "30-Oct-85 20:46")
    (PROG ((DATASTREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))
	     CODE NAME)
	    (RETURN (COND
			((AND (OPENP DATASTREAM (QUOTE INPUT))
				(NOT (EOFP DATASTREAM))
				(SETQ NAME
				  (CAR (NLSETQ (READ DATASTREAM
							   (DEFERREDCONSTANT
							     (PROG ((R (COPYREADTABLE
									   (QUOTE ORIG))))
								     (SETBRK NIL NIL R)
								     (SETSYNTAX (QUOTE %%)
										  (QUOTE OTHER)
										  R)
								     (SETSEPR (QUOTE
										  (13 10 31))
										NIL R)
								     (RETURN R))))))))
			  (COND
			    (NAMEONLY (REPACKFILENAME.STRING NAME (QUOTE INTERLISP)))
			    (T (PACKFILENAME.STRING (QUOTE HOST)
						      (fetch (FDEV DEVICENAME)
							 of (fetch (STREAM DEVICE)
								 of (fetch (TCPFTPCON TCPIN)
									 of TCPFTPCON)))
						      (QUOTE DIRECTORY)
						      (fetch (TCPFTPCON GENERATEFILESDIRECTORY)
							 of TCPFTPCON)
						      (QUOTE BODY)
						      (REPACKFILENAME.STRING NAME (QUOTE 
											INTERLISP)))))
			  )
			(T (AND (OPENP DATASTREAM)
				  (CLOSEF DATASTREAM))
			   (SELECTQ (SETQ CODE (ARPACMD TCPFTPCON NIL NIL (QUOTE
								(226 250))))
				      ((250 226)
					(AND (OPENP DATASTREAM)
					       (CLOSEF DATASTREAM))
					(\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
					NIL)
				      (FTPHELP CODE))))))))

(\TCPFTP.GETFILENAME
  (LAMBDA (NAME RECOG DEVICE)                                (* ejs: " 2-Feb-86 11:53")

          (* * FTP directory request)


    (PROG ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE))
	     (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
	     DATASTREAMEVENT DATASTREAM CODE GENERATOR ALLPOSSIBILITIES)
	    (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON (QUOTE INPUT)))
	    (BLOCK)
	    (SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "NLST" (REPACKFILENAME.STRING
						       (PACKFILENAME.STRING (QUOTE HOST)
									      NIL
									      (QUOTE BODY)
									      NAME)
						       OSTYPE)
						     150))))
	    (SELECTQ CODE
		       (150 

          (* * Here we go)


			    (COND
			      ((AND (SETQ DATASTREAM (\TCPFTP.WAIT.FOR.DATACONNECTION
					  DEVICE TCPFTPCON DATASTREAMEVENT (QUOTE INPUT)))
				      (SETQ GENERATOR (create FILEGENOBJ
								  NEXTFILEFN ←
								  (FUNCTION 
								    \TCPFTP.GENERATENEXTFILE)
								  FILEINFOFN ←
								  (FUNCTION NILL)
								  GENFILESTATE ← TCPFTPCON)))
				(replace (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON
				   with (FILENAMEFIELD NAME (QUOTE DIRECTORY)))
				(SETQ ALLPOSSIBILITIES (bind FILE while (SETQ FILE
										(\GENERATENEXTFILE
										  GENERATOR))
							    collect FILE))
				(RETURN (COND
					    ((AND (OR (EQ OSTYPE (QUOTE TOPS-20))
							  (EQ OSTYPE (QUOTE TOPS20)))
						    (STRPOS "? Not found" (CAR ALLPOSSIBILITIES)
							      NIL NIL NIL NIL UPPERCASEARRAY))
					      NIL)
					    (T (CAR ALLPOSSIBILITIES)))))))
		       (PROGN (DEL.PROCESS (fetch (EVENT EVENTNAME) of DATASTREAMEVENT))
				(\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
				NIL)))))

(\TCPFTP.GETFILEINFO
  (LAMBDA (STREAM ATTRIB DEVICE)                             (* ejs: " 9-Nov-85 14:17")
    (STREAMPROP STREAM ATTRIB)))

(\TCPFTP.SETFILEINFO
  (LAMBDA (STREAM ATTRIB VALUE DEVICE)                       (* ejs: " 9-Nov-85 14:20")
    (STREAMPROP STREAM ATTRIB VALUE)))

(\TCPFTP.CONNECT
  (LAMBDA (DEVICE TCPFTPCON DIRECTORY)                       (* ejs: "24-Jun-85 17:10")
    (LET ((DIRECTORYNAME (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE DIRECTORY)
									   DIRECTORY)
						    (\TCPFTP.GET.OSTYPE DEVICE))))
         (COND
	   ((NEQ 0 (NCHARS DIRECTORYNAME))
	     (SELECTQ (ARPACMD TCPFTPCON "CWD" DIRECTORYNAME (QUOTE (200 250 450 550)))
			((200 250)
			  T)
			NIL))
	   (T 

          (* The user specified no connect directory. We'll have to assume he or she meant his or her own login directory, 
	  whose name we can't even accurately guess. Thus, we leave it at this)


	      T)))))

(\TCPFTP.OPENFILE
  (LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE)              (* ejs: " 9-Nov-85 14:16")
    (DECLARE (GLOBALVARS TCP.DEFAULTFILETYPE TCP.USE.STANDARD.EOL TCPFTP.DEFAULT.FILETYPES))
    (LET* ((HOST (fetch (FDEV DEVICENAME) of DEVICE))
	   (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
	   (FILENAME (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE HOST)
								     NIL
								     (QUOTE BODY)
								     NAME)
					      OSTYPE))
	   (TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE))
	   (TYPE (OR (CADR (FASSOC (QUOTE TYPE)
					 PARAMETERS))
		       (CDR (FASSOC (FILENAMEFIELD FILENAME (QUOTE EXTENSION))
					TCPFTP.DEFAULT.FILETYPES))
		       TCP.DEFAULTFILETYPE))
	   DATASTREAMEVENT DATASTREAM CODE FTPCMD STREAMDEV)
          (SELECTQ TYPE
		     (TEXT (ARPACMD TCPFTPCON "TYPE" "A N" 200))
		     (ARPACMD TCPFTPCON "TYPE" "L 8" 200))
          (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON (COND
								    ((EQ ACCESS (QUOTE OUTPUT))
								      (QUOTE APPEND))
								    (T ACCESS))))
          (BLOCK)
          (PROG NIL
	      LOOP(SETQ FTPCMD (SELECTQ ACCESS
					    (INPUT (QUOTE "RETR"))
					    (OUTPUT (QUOTE "STOR"))
					    (APPEND (QUOTE "APPE"))
					    (ERROR "ACCESS must be one of INPUT, OUTPUT, or APPEND" 
						     ACCESS)))
	          (SETQ CODE
		    (CAR (NLSETQ (ARPACMD TCPFTPCON FTPCMD FILENAME
						(QUOTE (125 150 226 250 425 426 450 451 550))))))
	          (SELECTQ CODE
			     ((125 150)

          (* * Here we go)


			       (COND
				 ((SETQ DATASTREAM (\TCPFTP.WAIT.FOR.DATACONNECTION
				       DEVICE TCPFTPCON DATASTREAMEVENT (COND
					 ((EQ ACCESS (QUOTE OUTPUT))
					   (QUOTE APPEND))
					 (T ACCESS))))
				   (replace (STREAM ENDOFSTREAMOP) of DATASTREAM
				      with (FUNCTION \TCPFTP.ENDOFSTREAMOP))
				   (replace (STREAM FULLFILENAME) of DATASTREAM with NAME)
				   (replace (STREAM EOLCONVENTION) of DATASTREAM
				      with (COND
					       (TCP.USE.STANDARD.EOL CRLF.EOLC)
					       (T (SELECTQ OSTYPE
							     (UNIX LF.EOLC)
							     (TOPS-20 CRLF.EOLC)
							     CR.EOLC))))
				   (STREAMPROP DATASTREAM (QUOTE TYPE)
						 TYPE)
				   (replace (TCPDATASTREAM TCPFTPCON) of DATASTREAM with 
											TCPFTPCON)
				   (SETQ STREAMDEV (fetch (STREAM DEVICE) of DATASTREAM))
				   (replace (FDEV GETFILEINFO) of STREAMDEV
				      with (replace (FDEV GETFILENAME) of STREAMDEV
						with (FUNCTION NILL)))
				   (STREAMADDPROP DATASTREAM (QUOTE AFTERCLOSE)
						    (FUNCTION \TCPFTP.TRANSFER.COMPLETE))
				   (RETURN DATASTREAM))))
			     (425                            (* The foreign port is busy)
				  (PROMPTPRINT 
					    "TCPFTP: Please wait; the remote ftp server is busy.")
				  (DEL.PROCESS (fetch (EVENT EVENTNAME) of DATASTREAMEVENT))
				  (DISMISS 5000)
				  (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION
				      TCPFTPCON
				      (COND
					((EQ ACCESS (QUOTE OUTPUT))
					  (QUOTE APPEND))
					(T ACCESS))))
				  (BLOCK)
				  (GO LOOP))
			     ((450 550)
			       (DEL.PROCESS (fetch (EVENT EVENTNAME) of DATASTREAMEVENT))
			       (\TCPFTP.RELEASE.CONNECTION TCPFTPCON))
			     (FTPHELP CODE))))))

(\TCPFTP.CLOSE
  (LAMBDA (DEVICE)                                           (* ejs: "23-Apr-85 18:41")

          (* * This needs work)


    (PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE)))
	    (AND (OPENP (fetch (TCPFTPCON TCPOUT) of DEVINFO)
			    (QUOTE OUTPUT))
		   (CLOSEF (fetch (TCPFTPCON TCPOUT) of DEVINFO)))
	    (AND (OPENP (fetch (TCPFTPCON TCPIN) of DEVINFO)
			    (QUOTE INPUT))
		   (CLOSEF (fetch (TCPFTPCON TCPIN) of DEVINFO))))))

(\TCPFTP.FLUSH
  (LAMBDA (DEVICE)                                           (* ejs: "23-Apr-85 18:56")

          (* * This needs work)


    (PROG ((INSTREAM (fetch (TCPFTPCON TCPIN) of (fetch (FDEV DEVICEINFO) of DEVICE))))
	    (COND
	      ((READP INSTREAM)
		(until (NOT (READP INSTREAM)) do (BIN INSTREAM)))))))

(\TCPFTP.INIT
  (LAMBDA NIL                                                (* ejs: "10-Apr-85 19:25")
    (\DEFINEDEVICE NIL (create FDEV
			       DEVICENAME ←(QUOTE TCPFTP)
			       HOSTNAMEP ←(FUNCTION \TCPFTP.HOSTNAMEP)
			       EVENTFN ←(FUNCTION \TCPFTP.EVENTFN)))))
)
[DECLARE: EVAL@COMPILE 

(ACCESSFNS TCPDATASTREAM ((TCPCONTROLDEVICE (fetch (STREAM F3) of DATUM)
					      (replace (STREAM F3) of DATUM with NEWVALUE))
			    (SEENEOS (fetch (STREAM F4) of DATUM)
				     (replace (STREAM F4) of DATUM with NEWVALUE))
			    (TCPFTPCON (fetch (STREAM F5) of DATUM)
				       (replace (STREAM F5) of DATUM with NEWVALUE))))

(RECORD TCPFTPCON (TCPIN TCPOUT DATASTREAM BUSY? IDLETIMER GENERATEFILESDIRECTORY))
]

(RPAQ? TCP.DEFAULTFILETYPE 'BINARY)

(RPAQ? TCPFTP.DEFAULT.FILETYPES ' ((DCOM . BINARY)
				     (BIN . BINARY)
				     (NIL . TEXT)))

(RPAQ? TCP.USE.STANDARD.EOL T)

(RPAQ? \TCPFTP.DEVICES )

(RPAQ? \TCPFTP.CLEANUP.PROCESS )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \TCPFTP.DEVICES \TCPFTP.CLEANUP.PROCESS TCP.DEFAULTFILETYPE TCP.USE.STANDARD.EOL)
)
(* * Data connection handling)

(DEFINEQ

(\TCP.BYE
  (LAMBDA (HOST)                                             (* ejs: "26-Apr-85 12:11")
    (LET* ((DEVICE (\GETDEVICEFROMNAME HOST NIL T))
	   (CONNECTIONS (AND DEVICE (fetch (FDEV DEVICEINFO) of DEVICE))))
          (bind INSTREAM for TCPFTPCON in CONNECTIONS
	     do (SETQ INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON))
		  (while (READP INSTREAM) do (BIN INSTREAM))
		  (ARPACMD TCPFTPCON "QUIT" "" (QUOTE (221 500)))
		  (CLOSEF? (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))
		  (CLOSEF? INSTREAM)
		  (CLOSEF? (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))
		  T))))

(\TCPFTP.MAYBE.ABORT
  (LAMBDA (DATASTREAM)                                       (* ejs: "23-Apr-85 19:14")
    (LET* ((TCPFTPCON (fetch (TCPDATASTREAM TCPFTPCON) of DATASTREAM))
	   (TCPOUTSTREAM (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)))
          (STREAMPROP DATASTREAM (QUOTE BEFORECLOSE)
			NIL)
          (COND
	    ((AND (NOT (fetch (TCPDATASTREAM SEENEOS) of DATASTREAM))
		    (OPENP DATASTREAM (QUOTE INPUT)))
	      (TCP.CLOSE.SENDER (TCP.OTHER.STREAM DATASTREAM))
	      (BLOCK)
	      (BOUT TCPOUTSTREAM 244)
	      (BOUT TCPOUTSTREAM 242)
	      (TCP.URGENT.MARK TCPOUTSTREAM)
	      (ARPACMD TCPFTPCON "ABOR" "" (QUOTE (226 426 250))))))))

(\TCPFTP.OPEN.DATA.CONNECTION
  (LAMBDA (TCPFTPCON ACCESS EVENT)                           (* ejs: "26-Apr-85 11:57")
    (DECLARE (GLOBALVARS \TCPFTP.DATACONNECTION.LOCK))
    (WITH.MONITOR \TCPFTP.DATACONNECTION.LOCK (LET ((TCB (fetch (TCPSTREAM TCB)
							    of (fetch (TCPFTPCON TCPIN)
								    of TCPFTPCON)))
						    (PORT (\TCP.SELECT.PORT)))
					           (ARPACMD TCPFTPCON "PORT" (\TCPFTP.PORT.STRING
								PORT)
							      (QUOTE (200)))
					           (replace (TCPFTPCON DATASTREAM) of TCPFTPCON
						      with (TCP.OPEN (fetch (TCP.CONTROL.BLOCK
										    TCB.DST.HOST)
									    of TCB)
									 (SUB1 (fetch
										   (TCP.CONTROL.BLOCK
										     TCB.DST.PORT)
										    of TCB))
									 PORT
									 (QUOTE PASSIVE)
									 ACCESS))
					           (AND (TYPENAMEP EVENT (QUOTE EVENT))
							  (NOTIFY.EVENT EVENT))
					           (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)))))

(\TCPFTP.PORT.STRING
  (LAMBDA (PORT)                                             (* ejs: "26-Apr-85 11:54")

          (* * Returns "h1,h2,h3,h4,p1,p3" corresponding to bytes of local IP host and PORT for port command)


    (LET ((IPADDRESS (\LOCAL.IP.ADDRESS)))
         (CONCAT (LOADBYTE IPADDRESS 24 8)
		   ","
		   (LOADBYTE IPADDRESS 16 8)
		   ","
		   (LOADBYTE IPADDRESS 8 8)
		   ","
		   (LOADBYTE IPADDRESS 0 8)
		   ","
		   (LOADBYTE PORT 8 8)
		   ","
		   (LOADBYTE PORT 0 8)))))

(\TCPFTP.SPAWN.DATACONNECTION
  (LAMBDA (TCPFTPCON ACCESS)                                 (* ejs: "10-Apr-85 19:40")
    (PROG ((EVENT (CREATE.EVENT))
	     PROCESS)
	    (SETQ PROCESS (ADD.PROCESS (BQUOTE (\TCPFTP.OPEN.DATA.CONNECTION (QUOTE , 
											TCPFTPCON)
										     (QUOTE , 
											   ACCESS)
										     , EVENT))))
	    (RESETSAVE NIL (BQUOTE (COND
					 (RESETSTATE (DEL.PROCESS , PROCESS)
						     (AND (OPENP , (fetch (TCPFTPCON TCPIN)
									  of TCPFTPCON)
								     (QUOTE INPUT))
							    (CLOSEF , (fetch (TCPFTPCON TCPIN)
									   of TCPFTPCON)))
						     (AND (OPENP , (fetch (TCPFTPCON TCPOUT)
									  of TCPFTPCON)
								     (QUOTE OUTPUT))
							    (CLOSEF , (fetch (TCPFTPCON TCPOUT)
									   of TCPFTPCON)))))))
	    (replace (EVENT EVENTNAME) of EVENT with PROCESS)
	    (RETURN EVENT))))

(\TCPFTP.TRANSFER.COMPLETE
  (LAMBDA (DATASTREAM)                                       (* ejs: "27-Apr-85 14:48")
    (LET ((TCPFTPCON (fetch (TCPDATASTREAM TCPFTPCON) of DATASTREAM)))
         (STREAMPROP DATASTREAM (QUOTE AFTERCLOSE)
		       NIL)
         (COND
	   ((AND TCPFTPCON (NOT (fetch (TCPDATASTREAM SEENEOS) of DATASTREAM)))
	     (COND
	       ((OPENP DATASTREAM (QUOTE INPUT))
		 (TCP.CLOSE.SENDER (TCP.OTHER.STREAM DATASTREAM))))
	     (ARPACMD TCPFTPCON NIL NIL (QUOTE (226 426 250)))
	     (replace (TCPDATASTREAM SEENEOS) of DATASTREAM with T)
	     (replace (TCPDATASTREAM TCPCONTROLDEVICE) of DATASTREAM with NIL)
	     (replace (TCPDATASTREAM TCPFTPCON) of DATASTREAM with NIL)
	     (\TCPFTP.RELEASE.CONNECTION TCPFTPCON))))))

(\TCPFTP.WAIT.FOR.DATACONNECTION
  (LAMBDA (DEVICE TCPFTPCON EVENT ACCESS)                    (* ejs: "23-Apr-85 18:13")
    (LET (STREAM)
         (AWAIT.EVENT EVENT 120000)
         (COND
	   ((OPENP (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)
		     ACCESS)
	     (SETQ STREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))
	     (replace (TCPDATASTREAM TCPCONTROLDEVICE) of STREAM with DEVICE)
	     STREAM)))))

(\TCPFTP.DELETE.CONNECTION
  (LAMBDA (TCPFTPCON DEVICE SENDBYE)                         (* ejs: " 4-Jun-85 19:17")
    (LET ((INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON)))
         (COND
	   (SENDBYE (NLSETQ (ARPACMD TCPFTPCON "BYE"))))
         (COND
	   (INSTREAM (DEL.PROCESS (fetch (TCP.CONTROL.BLOCK TCB.PROCESS)
				       of (fetch (TCPSTREAM TCB) of INSTREAM)))))
         (replace (FDEV DEVICEINFO) of DEVICE with (DREMOVE TCPFTPCON (fetch (FDEV 
										       DEVICEINFO)
										 of DEVICE))))))
)

(RPAQ? \TCPFTP.DATACONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Data Connection Lock"))

(RPAQ? \TCPFTP.CONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Connection Lock"))

(RPAQ? \TCPFTP.IDLE.TIMEOUT (TIMES 10 60 1000))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \TCPFTP.DATACONNECTION.LOCK \TCPFTP.CONNECTION.LOCK \TCPFTP.IDLE.TIMEOUT)
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   TCPNAMES TCP)
(\TCPFTP.INIT)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(PUTPROPS TCPFTP COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3191 7944 (ARPACMD 3201 . 5447) (FTPHELP 5449 . 5625) (CMDREADCODE 5627 . 5817) (
CMDREAD 5819 . 6025) (DISCARDLINE 6027 . 6581) (GETLINE 6583 . 7104) (\TCPFTP.INPUT 7106 . 7722) (
TELNET.EOL 7724 . 7942)) (8278 31894 (\TCPFTP.GET.OSTYPE 8288 . 8713) (\TCPFTP.EVENTFN 8715 . 9565) (
\TCPFTP.HOSTNAMEP 9567 . 11122) (\GET.TCPFTP.CONNECTION 11124 . 12191) (\TCPFTP.OPEN.CONNECTION 12193
 . 13361) (\TCPFTP.ASSURE.CLEANUP 13363 . 13832) (\TCPFTP.CLEANUP 13834 . 15531) (
\TCPFTP.RELEASE.CONNECTION 15533 . 15972) (\TCPFTP.LOGIN 15974 . 17758) (\TCPFTP.DELETEFILE 17760 . 
18426) (\TCPFTP.DIRECTORYNAMEP 18428 . 19488) (\TCPFTP.ENDOFSTREAMOP 19490 . 19698) (
\TCPFTP.GENERATEFILES 19700 . 22502) (\TCPFTP.GENERATENEXTFILE 22504 . 24141) (\TCPFTP.GETFILENAME 
24143 . 26059) (\TCPFTP.GETFILEINFO 26061 . 26214) (\TCPFTP.SETFILEINFO 26216 . 26375) (
\TCPFTP.CONNECT 26377 . 27077) (\TCPFTP.OPENFILE 27079 . 30662) (\TCPFTP.CLOSE 30664 . 31209) (
\TCPFTP.FLUSH 31211 . 31588) (\TCPFTP.INIT 31590 . 31892)) (32828 38786 (\TCP.BYE 32838 . 33521) (
\TCPFTP.MAYBE.ABORT 33523 . 34269) (\TCPFTP.OPEN.DATA.CONNECTION 34271 . 35322) (\TCPFTP.PORT.STRING 
35324 . 35865) (\TCPFTP.SPAWN.DATACONNECTION 35867 . 36860) (\TCPFTP.TRANSFER.COMPLETE 36862 . 37724) 
(\TCPFTP.WAIT.FOR.DATACONNECTION 37726 . 38191) (\TCPFTP.DELETE.CONNECTION 38193 . 38784)))))
STOP