(FILECREATED " 3-Feb-86 16:16:33" {ERIS}<SCHOEN>TCP>TCPFTP.;5 38858
changes to: (FNS DISCARDLINE)
previous date: " 2-Feb-86 11:53:27" {ERIS}<SCHOEN>TCP>TCPFTP.;3)
(* 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: " 3-Feb-86 16:16")
(* lmm "31-MAY-78 00:45")
(DECLARE (GLOBALVARS FTPDEBUGFLG FTPDEBUGLOG))
(COND
(FTPDEBUGFLG (\BACKFILEPTR IN)
(bind CH until (FMEMB (SETQ CH (BIN IN))
(CONSTANT (LIST (CHARCODE LF)
(CHARCODE NULL))))
do (BOUT FTPDEBUGLOG CH) finally (TERPRI FTPDEBUGLOG)))
(T (until (FMEMB (BIN IN)
(CONSTANT (LIST (CHARCODE LF)
(CHARCODE NULL)))))))))
(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 (2483 7363 (ARPACMD 2493 . 4739) (FTPHELP 4741 . 4917) (CMDREADCODE 4919 . 5109) (
CMDREAD 5111 . 5317) (DISCARDLINE 5319 . 6000) (GETLINE 6002 . 6523) (\TCPFTP.INPUT 6525 . 7141) (
TELNET.EOL 7143 . 7361)) (7697 31313 (\TCPFTP.GET.OSTYPE 7707 . 8132) (\TCPFTP.EVENTFN 8134 . 8984) (
\TCPFTP.HOSTNAMEP 8986 . 10541) (\GET.TCPFTP.CONNECTION 10543 . 11610) (\TCPFTP.OPEN.CONNECTION 11612
. 12780) (\TCPFTP.ASSURE.CLEANUP 12782 . 13251) (\TCPFTP.CLEANUP 13253 . 14950) (
\TCPFTP.RELEASE.CONNECTION 14952 . 15391) (\TCPFTP.LOGIN 15393 . 17177) (\TCPFTP.DELETEFILE 17179 .
17845) (\TCPFTP.DIRECTORYNAMEP 17847 . 18907) (\TCPFTP.ENDOFSTREAMOP 18909 . 19117) (
\TCPFTP.GENERATEFILES 19119 . 21921) (\TCPFTP.GENERATENEXTFILE 21923 . 23560) (\TCPFTP.GETFILENAME
23562 . 25478) (\TCPFTP.GETFILEINFO 25480 . 25633) (\TCPFTP.SETFILEINFO 25635 . 25794) (
\TCPFTP.CONNECT 25796 . 26496) (\TCPFTP.OPENFILE 26498 . 30081) (\TCPFTP.CLOSE 30083 . 30628) (
\TCPFTP.FLUSH 30630 . 31007) (\TCPFTP.INIT 31009 . 31311)) (32247 38205 (\TCP.BYE 32257 . 32940) (
\TCPFTP.MAYBE.ABORT 32942 . 33688) (\TCPFTP.OPEN.DATA.CONNECTION 33690 . 34741) (\TCPFTP.PORT.STRING
34743 . 35284) (\TCPFTP.SPAWN.DATACONNECTION 35286 . 36279) (\TCPFTP.TRANSFER.COMPLETE 36281 . 37143)
(\TCPFTP.WAIT.FOR.DATACONNECTION 37145 . 37610) (\TCPFTP.DELETE.CONNECTION 37612 . 38203)))))
STOP