(FILECREATED "27-Apr-85 15:06:33" {ERIS}<LISPCORE>LIBRARY>TCPFTP.;20 34091
changes to: (FNS \TCPFTP.HOSTNAMEP \TCPFTP.OPEN.CONNECTION \TCPFTP.RELEASE.CONNECTION
\TCPFTP.GENERATEFILES \TCPFTP.TRANSFER.COMPLETE \TCPFTP.DELETEFILE
\TCPFTP.DIRECTORYNAMEP \TCPFTP.GENERATENEXTFILE \TCPFTP.GETFILENAME
\TCPFTP.OPENFILE \TCPFTP.DELETE.CONNECTION \TCPFTP.CLEANUP
\TCPFTP.ASSURE.CLEANUP \GET.TCPFTP.CONNECTION)
(VARS TCPFTPCOMS \TCPFTP.CLEANUP.PROCESS)
(RECORDS TCPFTPCON)
previous date: "26-Apr-85 12:22:56" {ERIS}<LISPCORE>LIBRARY>TCPFTP.;18)
(* 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.DEVICES)
(\TCPFTP.CLEANUP.PROCESS))
(GLOBALVARS \TCPFTP.DEVICES \TCPFTP.CLEANUP.PROCESS))
(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: "27-Apr-85 14:30")
(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)
CLOSEFILE ←(FUNCTION \TCPFTP.CLOSEFILE)
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: "27-Apr-85 14:24")
(LET ((CONNECTIONS (fetch (FDEV DEVICEINFO) of DEVICE))
TCPFTPCON INSTREAM)
(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))
(OPENP INSTREAM)
(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: "23-Apr-85 19:30")
(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))))
(replace (STREAM ENDOFSTREAMOP) of INSTREAM with (FUNCTION (LAMBDA (STREAM)
(ZERO))))
(replace (TCPFTPCON TCPIN) of TCPFTPCON with INSTREAM)
(replace (TCPFTPCON TCPOUT) of TCPFTPCON with (TCP.OTHER.STREAM INSTREAM))
(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: "27-Apr-85 14:19")
(DECLARE (GLOBALVARS \TCPFTP.IDLE.TIMEOUT \TCPFTP.DEVICES \TCPFTP.CONNECTION.LOCK))
(LET ((INTERVAL (QUOTIENT \TCPFTP.IDLE.TIMEOUT 4))
CONNECTIONSP)
(repeatwhile CONNECTIONSP
do (BLOCK INTERVAL)
(SETQ CONNNECTIONSP NIL)
(bind CONNECTIONSP for DEVICE in \TCPFTP.DEVICES
do (for CONNECTION in (COPY (fetch (FDEV DEVICEINFO) of DEVICE))
do (SETQ CONNECTIONSP T)
(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))
(CLOSEF? (fetch (TCPFTPCON DATASTREAM)
of CONNECTION))
(\TCPFTP.DELETE.CONNECTION CONNECTION DEVICE)))))
(BLOCK)))))))
(\TCPFTP.RELEASE.CONNECTION
(LAMBDA (TCPFTPCON) (* ejs: "27-Apr-85 14:28")
(replace (TCPFTPCON BUSY?) of TCPFTPCON with NIL)
(replace (TCPFTPCON IDLETIMER) of TCPFTPCON with (SETUPTIMER \TCPFTP.IDLE.TIMEOUT))
(\TCPFTP.ASSURE.CLEANUP)))
(\TCPFTP.LOGIN
(LAMBDA (DEVICE TCPFTPCON) (* ejs: "23-Apr-85 18:37")
(* * Log us in)
(PROG (HOST INFO)
(SETQ HOST (fetch (FDEV DEVICENAME) of DEVICE))
RETRY
(SETQ INFO (\INTERNAL/GETPASSWORD HOST))
RETRY1
(SELECTQ (ARPACMD TCPFTPCON "USER" (CAR INFO)
(QUOTE (202 230 331 332 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))
(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: "27-Apr-85 15:04")
(* * 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)))
(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: "27-Apr-85 14:04")
(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))))))))
(REPACKFILENAME.STRING NAME (QUOTE D)))
(T (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: "27-Apr-85 14:04")
(* * 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)))
(SETQ ALLPOSSIBILITIES (bind FILE while (SETQ FILE (\GENERATENEXTFILE
GENERATOR))
collect FILE))
(RETURN (COND
((CAR ALLPOSSIBILITIES)
(PACK* (QUOTE {)
(FILENAMEFIELD NAME (QUOTE HOST))
(QUOTE })
(CAR ALLPOSSIBILITIES))))))))
(PROGN (DEL.PROCESS (fetch (EVENT EVENTNAME) of DATASTREAMEVENT))
(\TCPFTP.RELEASE.CONNECTION TCPFTPCON)
NIL)))))
(\TCPFTP.CONNECT
(LAMBDA (DEVICE TCPFTPCON DIRECTORY) (* ejs: "23-Apr-85 18:40")
(SELECTQ (ARPACMD TCPFTPCON "CWD" (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE DIRECTORY)
DIRECTORY)
(\TCPFTP.GET.OSTYPE DEVICE))
(QUOTE (200 250 450 550)))
((200 250)
T)
NIL)))
(\TCPFTP.OPENFILE
(LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* ejs: "27-Apr-85 14:04")
(DECLARE (GLOBALVARS TCP.DEFAULTFILETYPE))
(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))
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 (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))
]
(RPAQ? TCP.DEFAULTFILETYPE (QUOTE BINARY))
(RPAQ? \TCPFTP.DEVICES )
(RPAQ? \TCPFTP.CLEANUP.PROCESS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TCPFTP.DEVICES \TCPFTP.CLEANUP.PROCESS)
)
(* * 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) (* ejs: "27-Apr-85 14:15")
(LET ((INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON)))
(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 (2663 7231 (ARPACMD 2673 . 4757) (FTPHELP 4759 . 4937) (CMDREADCODE 4939 . 5127) (
CMDREAD 5129 . 5337) (DISCARDLINE 5339 . 5899) (GETLINE 5901 . 6409) (\TCPFTP.INPUT 6411 . 7009) (
TELNET.EOL 7011 . 7229)) (7565 27115 (\TCPFTP.GET.OSTYPE 7575 . 7988) (\TCPFTP.EVENTFN 7990 . 8841) (
\TCPFTP.HOSTNAMEP 8843 . 10232) (\GET.TCPFTP.CONNECTION 10234 . 11113) (\TCPFTP.OPEN.CONNECTION 11115
. 12040) (\TCPFTP.ASSURE.CLEANUP 12042 . 12515) (\TCPFTP.CLEANUP 12517 . 13662) (
\TCPFTP.RELEASE.CONNECTION 13664 . 13992) (\TCPFTP.LOGIN 13994 . 15200) (\TCPFTP.DELETEFILE 15202 .
15861) (\TCPFTP.DIRECTORYNAMEP 15863 . 16852) (\TCPFTP.ENDOFSTREAMOP 16854 . 17062) (
\TCPFTP.GENERATEFILES 17064 . 19463) (\TCPFTP.GENERATENEXTFILE 19465 . 20537) (\TCPFTP.GETFILENAME
20539 . 22188) (\TCPFTP.CONNECT 22190 . 22570) (\TCPFTP.OPENFILE 22572 . 25857) (\TCPFTP.CLOSE 25859
. 26422) (\TCPFTP.FLUSH 26424 . 26809) (\TCPFTP.INIT 26811 . 27113)) (27842 33443 (\TCP.BYE 27852 .
28536) (\TCPFTP.MAYBE.ABORT 28538 . 29253) (\TCPFTP.OPEN.DATA.CONNECTION 29255 . 30170) (
\TCPFTP.PORT.STRING 30172 . 30730) (\TCPFTP.SPAWN.DATACONNECTION 30732 . 31670) (
\TCPFTP.TRANSFER.COMPLETE 31672 . 32503) (\TCPFTP.WAIT.FOR.DATACONNECTION 32505 . 32947) (
\TCPFTP.DELETE.CONNECTION 32949 . 33441)))))
STOP