(FILECREATED " 1-Jul-85 13:27:07" {ERIS}<LISPCORE>LIBRARY>TCPFTP.;31 36274
changes to: (FNS \TCPFTP.GETFILENAME)
previous date: "28-Jun-85 14:36:18" {ERIS}<LISPCORE>LIBRARY>TCPFTP.;29)
(* Copyright (c) 1985 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.CONNECT \TCPFTP.OPENFILE \TCPFTP.CLOSE \TCPFTP.FLUSH
\TCPFTP.INIT)
(RECORDS TCPDATASTREAM TCPFTPCON)
(INITVARS (TCP.DEFAULTFILETYPE (QUOTE BINARY))
(TCPFTP.DEFAULT.FILETYPES (QUOTE ((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: "28-Jun-85 14:35")
(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 NILL)
SETFILEINFO ←(FUNCTION NILL)
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) (* ejs: " 4-Jun-85 17:37")
(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: "24-Jun-85 17: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 530)))
(230 (RETURN T))
((331 530)
(LOGIN HOST)
(GO RETRY))
(FTPHELP)))
(332 (SELECTQ (ARPACMD TCPFTPCON "ACCT" (PROMPTFORWORD (CONCAT
"Account for logging into "
HOST)))
(230 (RETURN T))
(332 (GO RETRY1))
(FTPHELP)))
(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: "25-Jun-85 19:54")
(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 D)))
(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 D))))))
(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: " 1-Jul-85 13:27")
(* * 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
((CAR ALLPOSSIBILITIES)))))))
(PROGN (DEL.PROCESS (fetch (EVENT EVENTNAME) of DATASTREAMEVENT))
(\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
NIL)))))
(\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: "24-Jun-85 17:13")
(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))))
(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 (QUOTE BINARY))
(RPAQ? TCPFTP.DEFAULT.FILETYPES (QUOTE ((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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2463 7019 (ARPACMD 2473 . 4545) (FTPHELP 4547 . 4725) (CMDREADCODE 4727 . 4915) (
CMDREAD 4917 . 5125) (DISCARDLINE 5127 . 5687) (GETLINE 5689 . 6197) (\TCPFTP.INPUT 6199 . 6797) (
TELNET.EOL 6799 . 7017)) (7353 29025 (\TCPFTP.GET.OSTYPE 7363 . 7776) (\TCPFTP.EVENTFN 7778 . 8629) (
\TCPFTP.HOSTNAMEP 8631 . 9966) (\GET.TCPFTP.CONNECTION 9968 . 10993) (\TCPFTP.OPEN.CONNECTION 10995 .
12127) (\TCPFTP.ASSURE.CLEANUP 12129 . 12602) (\TCPFTP.CLEANUP 12604 . 14112) (
\TCPFTP.RELEASE.CONNECTION 14114 . 14513) (\TCPFTP.LOGIN 14515 . 16016) (\TCPFTP.DELETEFILE 16018 .
16677) (\TCPFTP.DIRECTORYNAMEP 16679 . 17668) (\TCPFTP.ENDOFSTREAMOP 17670 . 17878) (
\TCPFTP.GENERATEFILES 17880 . 20413) (\TCPFTP.GENERATENEXTFILE 20415 . 21960) (\TCPFTP.GETFILENAME
21962 . 23600) (\TCPFTP.CONNECT 23602 . 24290) (\TCPFTP.OPENFILE 24292 . 27767) (\TCPFTP.CLOSE 27769
. 28332) (\TCPFTP.FLUSH 28334 . 28719) (\TCPFTP.INIT 28721 . 29023)) (29954 35626 (\TCP.BYE 29964 .
30648) (\TCPFTP.MAYBE.ABORT 30650 . 31365) (\TCPFTP.OPEN.DATA.CONNECTION 31367 . 32282) (
\TCPFTP.PORT.STRING 32284 . 32842) (\TCPFTP.SPAWN.DATACONNECTION 32844 . 33782) (
\TCPFTP.TRANSFER.COMPLETE 33784 . 34615) (\TCPFTP.WAIT.FOR.DATACONNECTION 34617 . 35059) (
\TCPFTP.DELETE.CONNECTION 35061 . 35624)))))
STOP