(FILECREATED "12-Mar-85 14:50:02" {ERIS}<LISPCORE>LIBRARY>TCPFTP.;8 24493
changes to: (FNS \TCPFTP.LOGIN \TCPFTP.OPENFILE \TCP.BYE \TCPFTP.TRANSFER.COMPLETE)
(VARS TCPFTPCOMS)
previous date: " 9-Mar-85 18:26:09" {ERIS}<LISPCORE>LIBRARY>TCPFTP.;5)
(* 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)
(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.HOSTNAMEP \GET.TCPFTP.CONNECTION
\TCPFTP.OPEN.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))
(COMS (* * Data connection handling)
(FNS \TCP.BYE \TCPFTP.OPEN.DATA.CONNECTION \TCPFTP.SPAWN.DATACONNECTION
\TCPFTP.TRANSFER.COMPLETE \TCPFTP.WAIT.FOR.DATACONNECTION))
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCP FILENAMES)
(P (\TCPFTP.INIT))
(ADVISE \CANONICAL.HOSTNAME)
(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: " 3-Feb-85 16:13")
(* lmm "16-OCT-78 02:57")
(PROG ((INC (fetch (TCPFTPCON TCPIN) of TCPFTPCON))
(OUTC (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)))
(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)))
)
(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.HOSTNAMEP
(LAMBDA (HOST DEVICE) (* ejs: " 9-Feb-85 16:27")
(DECLARE (GLOBALVARS \TCP.DEVICE))
(PROG ((SERVER (DODIP.HOSTP 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 ←(create TCPFTPCON
TCPHOST ← SERVER))))
DEVICE))))))
(\GET.TCPFTP.CONNECTION
(LAMBDA (DEVICE) (* ejs: " 9-Mar-85 17:27")
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
INSTREAM)
(RETURN (COND
((AND (type? STREAM (SETQ INSTREAM (fetch (TCPFTPCON TCPIN) of DEVINFO)))
(OPENP INSTREAM)
(NOT (EOFP INSTREAM)))
(while (READP INSTREAM) do (BIN INSTREAM))
DEVICE)
(T (AND (\TCPFTP.OPEN.CONNECTION DEVICE)
DEVICE)))))))
(\TCPFTP.OPEN.CONNECTION
(LAMBDA (DEVICE) (* ejs: " 3-Feb-85 16:31")
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
INSTREAM)
(SETQ INSTREAM (TCP.OPEN (fetch (TCPFTPCON TCPHOST) of DEVINFO)
\TCP.FTP.PORT NIL (QUOTE ACTIVE)
(QUOTE INPUT)))
(replace (STREAM ENDOFSTREAMOP) of INSTREAM with (FUNCTION (LAMBDA (STREAM)
(ZERO))))
(COND
(INSTREAM (replace (TCPFTPCON TCPIN) of DEVINFO with INSTREAM)
(replace (TCPFTPCON TCPOUT) of DEVINFO with (TCP.OTHER.STREAM INSTREAM))
(SELECTQ (\TCPFTP.INPUT INSTREAM)
(220 (RETURN (\TCPFTP.LOGIN DEVICE)))
(RETURN)))))))
(\TCPFTP.LOGIN
[LAMBDA (DEVICE) (* edited: "12-Mar-85 14:48")
(* * Log us in)
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
HOST INFO)
(SETQ HOST (fetch (TCPFTPCON TCPHOST) of DEVINFO))
RETRY
(SETQ INFO (\INTERNAL/GETPASSWORD HOST))
RETRY1
(SELECTQ (ARPACMD DEVINFO "USER" (CAR INFO)
(QUOTE (202 230 331 332 530)))
((230 202) (* We're logged in)
(RETURN T))
(331 (* Needs a password)
(SELECTQ (ARPACMD DEVINFO "PASS" (\DECRYPT.PWD (CDR INFO))
(QUOTE (230 331 530)))
(230 (RETURN T))
((331 530)
(LOGIN HOST)
(GO RETRY))
(FTPHELP)))
(332 (SELECTQ (ARPACMD DEVINFO "ACCT" (PROMPTFORWORD (CONCAT
"Account for logging into "
HOST)))
(230 (RETURN T))
(332 (GO RETRY1))
(FTPHELP)))
(530 (* No such user?)
(LOGIN HOST)
(GO RETRY))
(FTPHELP])
(\TCPFTP.DELETEFILE
(LAMBDA (NAME DEVICE) (* ejs: "23-Feb-85 17:01")
(* * FTP delete request)
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
(OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
CODE)
(\GET.TCPFTP.CONNECTION DEVICE)
(SETQ CODE (CAR (NLSETQ (ARPACMD DEVINFO "DELE" (REPACKFILENAME.STRING (PACKFILENAME.STRING
(QUOTE HOST)
NIL
(QUOTE BODY)
NAME)
OSTYPE)
(QUOTE (200 226 250))))))
(SELECTQ CODE
((250 226 200)
(* * Here we go)
(RETURN NAME))
NIL))))
(\TCPFTP.DIRECTORYNAMEP
(LAMBDA (HOST/DIR DEVICE) (* ejs: "12-Jan-85 22:54")
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE)))
(RETURN (RESETLST (RESETSAVE NIL (BQUOTE (COND
(RESETSTATE (AND (OPENP (fetch (TCPFTPCON TCPIN)
of (QUOTE , DEVINFO)))
(CLOSEF (fetch (TCPFTPCON
TCPIN)
of (QUOTE , DEVINFO))
))
(replace (TCPFTPCON TCPIN)
of (QUOTE , DEVINFO)
with NIL)
(AND (OPENP (fetch (TCPFTPCON TCPOUT)
of (QUOTE , DEVINFO)))
(CLOSEF (fetch (TCPFTPCON
TCPOUT)
of (QUOTE , DEVINFO))
))
(replace (TCPFTPCON TCPOUT)
of (QUOTE , DEVINFO)
with NIL)))))
(\TCPFTP.CONNECT (\GET.TCPFTP.CONNECTION DEVICE)
(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: "23-Feb-85 16:35")
(* * FTP directory request)
(LET* ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
(OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
DATASTREAMEVENT DATASTREAM CODE)
(\GET.TCPFTP.CONNECTION DEVICE)
(SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION DEVINFO (QUOTE INPUT)))
(BLOCK)
(SETQ CODE (CAR (NLSETQ (ARPACMD DEVINFO "NLST" (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 DATASTREAMEVENT
(QUOTE INPUT)))
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \TCPFTP.GENERATENEXTFILE)
FILEINFOFN ←(FUNCTION NILL)
GENFILESTATE ← DEVINFO))))
NIL))))
(\TCPFTP.GENERATENEXTFILE
(LAMBDA (GENFILESTATE NAMEONLY) (* ejs: " 9-Mar-85 16:04")
(PROG ((DATASTREAM (fetch (TCPFTPCON DATASTREAM) of GENFILESTATE))
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 GENFILESTATE NIL NIL (QUOTE (226 250))))
((250 226)
(AND (OPENP DATASTREAM)
(CLOSEF DATASTREAM))
NIL)
(FTPHELP CODE))))))))
(\TCPFTP.GETFILENAME
(LAMBDA (NAME RECOG DEVICE) (* ejs: "23-Feb-85 16:35")
(* * FTP directory request)
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
(OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
DATASTREAMEVENT DATASTREAM CODE GENERATOR ALLPOSSIBILITIES)
(\GET.TCPFTP.CONNECTION DEVICE)
(SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION DEVINFO (QUOTE INPUT)))
(BLOCK)
(SETQ CODE (CAR (NLSETQ (ARPACMD DEVINFO "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
DATASTREAMEVENT
(QUOTE INPUT)))
(SETQ GENERATOR (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION
\TCPFTP.GENERATENEXTFILE)
FILEINFOFN ←(FUNCTION NILL)
GENFILESTATE ← DEVINFO)))
(SETQ ALLPOSSIBILITIES (bind FILE while (SETQ FILE (\GENERATENEXTFILE
GENERATOR))
collect FILE))
(RETURN (COND
((CAR ALLPOSSIBILITIES)
(PACK* (QUOTE {)
(FILENAMEFIELD NAME (QUOTE HOST))
(QUOTE })
(CAR ALLPOSSIBILITIES))))))))
NIL))))
(\TCPFTP.CONNECT
(LAMBDA (DEVICE DIRECTORY) (* ejs: " 9-Mar-85 18:09")
(PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE)))
(RETURN (SELECTQ (ARPACMD DEVINFO "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) (* edited: "12-Mar-85 13:33")
(LET* ((HOST (fetch (FDEV DEVICENAME) of DEVICE))
(OSTYPE (\TCPFTP.GET.OSTYPE DEVICE))
(FILENAME (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE HOST)
NIL
(QUOTE BODY)
NAME)
OSTYPE))
(DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
(TYPE (OR (CADR (FASSOC (QUOTE TYPE)
PARAMETERS))
DEFAULTFILETYPE))
DATASTREAMEVENT DATASTREAM STREAMDEV CODE FTPCMD) (* COND ((FILENAMEFIELD NAME
(QUOTE VERSION)) (SETQ FILENAME
(PACK* (QUOTE %") FILENAME (QUOTE %")))))
(\GET.TCPFTP.CONNECTION DEVICE) (* ARPACMD DEVINFO "TYPE" "L 8" 200)
(* Can't get file info. For UNIX, this is OK;
for Tops-20, this will make all text files unreadable
at the destination)
(SELECTQ TYPE
(TEXT (ARPACMD DEVINFO "TYPE" "A N" 200))
(ARPACMD DEVINFO "TYPE" "L 8" 200))
[SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION DEVINFO (COND
((EQ ACCESS (QUOTE OUTPUT))
(QUOTE APPEND))
(T ACCESS]
(BLOCK)
(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 DEVINFO 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 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)
(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))
DATASTREAM)))
((450 550)
NIL)
(FTPHELP CODE])
(\TCPFTP.CLOSE
(LAMBDA (DEVICE) (* ejs: "12-Jan-85 20:35")
(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: "12-Jan-85 22:19")
(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: "12-Jan-85 15:10")
(\DEFINEDEVICE NIL (create FDEV
DEVICENAME ←(QUOTE TCPFTP)
HOSTNAMEP ←(FUNCTION \TCPFTP.HOSTNAMEP)
EVENTFN ←(FUNCTION NILL)))))
)
[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))))
(RECORD TCPFTPCON (TCPIN TCPOUT DATASTREAM TCPHOST))
]
(* * Data connection handling)
(DEFINEQ
(\TCP.BYE
[LAMBDA (HOST) (* edited: "12-Mar-85 13:32")
(LET* ((DEVICE (\GETDEVICEFROMNAME HOST NIL T))
(DEVINFO (AND DEVICE (fetch (FDEV DEVICEINFO) of DEVICE)))
(INSTREAM (fetch (TCPFTPCON TCPIN) of DEVINFO)))
(COND
(DEVINFO (while (READP INSTREAM) do (BIN INSTREAM))
(ARPACMD DEVINFO "QUIT" "" (QUOTE (221 500)))
[COND
((OPENP (fetch (TCPFTPCON DATASTREAM) of DEVINFO))
(CLOSEF (fetch (TCPFTPCON DATASTREAM) of DEVINFO]
(CLOSEF INSTREAM)
(CLOSEF (fetch (TCPFTPCON TCPOUT) of DEVINFO))
T])
(\TCPFTP.OPEN.DATA.CONNECTION
(LAMBDA (TCPFTPCON ACCESS EVENT) (* ejs: "12-Jan-85 20:18")
(PROG ((TCB (fetch (TCPSTREAM TCB) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON))))
(replace (TCPFTPCON DATASTREAM) of TCPFTPCON with (TCP.OPEN (fetch (TCPFTPCON TCPHOST)
of TCPFTPCON)
(SUB1 (fetch (TCP.CONTROL.BLOCK
TCB.DST.PORT)
of TCB))
(fetch (TCP.CONTROL.BLOCK
TCB.SRC.PORT)
of TCB)
(QUOTE PASSIVE)
ACCESS))
(AND (TYPENAMEP EVENT (QUOTE EVENT))
(NOTIFY.EVENT EVENT))
(RETURN (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)))))
(\TCPFTP.SPAWN.DATACONNECTION
(LAMBDA (TCPFTPCON ACCESS) (* ejs: "12-Jan-85 20:16")
(PROG ((EVENT (CREATE.EVENT))
PROCESS)
(SETQ PROCESS (ADD.PROCESS (BQUOTE (\TCPFTP.OPEN.DATA.CONNECTION (QUOTE , TCPFTPCON)
(QUOTE , ACCESS)
, EVENT))))
(RESETSAVE NIL (BQUOTE (AND RESETSTATE (DEL.PROCESS , PROCESS))))
(RETURN EVENT))))
(\TCPFTP.TRANSFER.COMPLETE
[LAMBDA (DATASTREAM) (* edited: "12-Mar-85 13:32")
(LET ((DEVICE (fetch (TCPDATASTREAM TCPCONTROLDEVICE) of DATASTREAM)))
(STREAMPROP DATASTREAM (QUOTE AFTERCLOSE)
NIL)
(COND
((AND DEVICE (NOT (fetch (TCPDATASTREAM SEENEOS) of DATASTREAM)))
(AND (OPENP DATASTREAM (QUOTE INPUT))
(TCP.CLOSE.SENDER (TCP.OTHER.STREAM DATASTREAM)))
(ARPACMD (fetch (FDEV DEVICEINFO) of DEVICE)
NIL NIL (QUOTE (226 250)))
(replace (TCPDATASTREAM SEENEOS) of DATASTREAM with T)
(replace (TCPDATASTREAM TCPCONTROLDEVICE) of DATASTREAM with NIL])
(\TCPFTP.WAIT.FOR.DATACONNECTION
(LAMBDA (DEVICE EVENT ACCESS) (* ejs: "29-Jan-85 13:34")
(PROG ((TCPFTPCON (fetch (FDEV DEVICEINFO) of DEVICE))
STREAM)
(AWAIT.EVENT EVENT 120000)
(RETURN (COND
((OPENP (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)
ACCESS)
(SETQ STREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))
(replace (TCPDATASTREAM TCPCONTROLDEVICE) of STREAM with DEVICE)
STREAM))))))
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCP FILENAMES)
(\TCPFTP.INIT)
(PUTPROPS \CANONICAL.HOSTNAME READVICE [NIL (AROUND NIL (COND ((NUMBERP NAME)
NAME)
(T *])
(READVISE \CANONICAL.HOSTNAME)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TCPFTP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1616 5693 (ARPACMD 1626 . 3219) (FTPHELP 3221 . 3399) (CMDREADCODE 3401 . 3589) (
CMDREAD 3591 . 3799) (DISCARDLINE 3801 . 4361) (GETLINE 4363 . 4871) (\TCPFTP.INPUT 4873 . 5471) (
TELNET.EOL 5473 . 5691)) (5886 20358 (\TCPFTP.GET.OSTYPE 5896 . 6309) (\TCPFTP.HOSTNAMEP 6311 . 7639)
(\GET.TCPFTP.CONNECTION 7641 . 8196) (\TCPFTP.OPEN.CONNECTION 8198 . 9024) (\TCPFTP.LOGIN 9026 . 10254
) (\TCPFTP.DELETEFILE 10256 . 10983) (\TCPFTP.DIRECTORYNAMEP 10985 . 12077) (\TCPFTP.ENDOFSTREAMOP
12079 . 12287) (\TCPFTP.GENERATEFILES 12289 . 13406) (\TCPFTP.GENERATENEXTFILE 13408 . 14437) (
\TCPFTP.GETFILENAME 14439 . 16001) (\TCPFTP.CONNECT 16003 . 16481) (\TCPFTP.OPENFILE 16483 . 19189) (
\TCPFTP.CLOSE 19191 . 19715) (\TCPFTP.FLUSH 19717 . 20063) (\TCPFTP.INIT 20065 . 20356)) (20751 24041
(\TCP.BYE 20761 . 21453) (\TCPFTP.OPEN.DATA.CONNECTION 21455 . 22265) (\TCPFTP.SPAWN.DATACONNECTION
22267 . 22743) (\TCPFTP.TRANSFER.COMPLETE 22745 . 23484) (\TCPFTP.WAIT.FOR.DATACONNECTION 23486 .
24039)))))
STOP