(FILECREATED "21-NOV-83 15:34:52" {PHYLUM}<LISPCORE>SOURCES>DPUPFTP.;28 47775
changes to: (VARS FTPNOCODES DPUPFTPCOMS)
(FNS \FTP.HANDLE.NO \FTP.OPENFILE.FROM.PLIST \FTP.EOL.FROM.PLIST)
previous date: " 4-NOV-83 12:10:50" {PHYLUM}<LISPCORE>SOURCES>DPUPFTP.;27)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT DPUPFTPCOMS)
(RPAQQ DPUPFTPCOMS [(FNS \FTPINIT \FTP.OPENFILE \FTP.OPENFILE.FROM.PLIST \FTP.GETFILEPTR
\FTP.SETFILEPTR \FTP.GETFILENAME \FTP.RECOGNIZEFILE \FTP.DIRECTORYNAMEP
\FTP.CLOSEFILE \FTP.RENAMEFILE \FTP.DELETEFILE \FTP.GENERATEFILES
\FTP.NEXTFILE \FTP.GETFILEINFO \FTP.GETFILEINFO.FROM.PROPS \FTP.GETDATEPROP)
(FNS \FTP.OPEN.CONNECTION \FTP.SENDVERSION \FTP.WHENCLOSED \GETFTPCONNECTION
\RELEASE.FTPCONNECTION \FTP.ERRORHANDLER \FTP.FIX.BROKEN.INPUT \FTP.CLEANUP
\FTP.ASSURE.CLEANUP)
(FNS \FTP.HANDLE.NO \FTP.DIRECTORYNAMEONLY \FTP.EOL.FROM.PLIST \FTP.MAKEPLIST \FTP.PRINTPLIST
\FTP.PACKFILENAME \FTP.PACK.DIRECTORYNAMEP \FTP.UNPACKFILENAME \FTP.ADD.USERINFO
\FTP.FLUSH.TO.EOC \FTP.FLUSH.TO.MARK \FTPERROR)
(FNS FTPDEBUG FTPPRINTMARK FTPPRINTCODE FTPGETMARK FTPPUTMARK FTPPUTCODE FTPGETCODE
FLUSH.FTPCONNECTIONS)
(ADDVARS (\FTPCONNECTIONS))
(INITVARS (FTPDEBUGLOG)
(FTPDEBUGFLG)
(\FTPAVAILABLE)
(\FTP.IDLE.TIMEOUT 120000))
(DECLARE: EVAL@COMPILE DONTCOPY (VARS FTPMARKTYPES)
(CONSTANTS \FTP.VERSION)
(CONSTANTS * FTPNOCODES)
(MACROS MARK# .EOC. .FTPDEBUGLOG.)
(RECORDS FTPCONNECTION FTPSTREAM)
(GLOBALVARS FTPDEBUGFLG \FTPCONNECTIONS \FTPAVAILABLE \FTP.IDLE.TIMEOUT)
(FILES (LOADCOMP)
BSP))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\FTPINIT])
(DEFINEQ
(\FTPINIT
[LAMBDA NIL (* bvm: "27-SEP-83 17:29")
(COND
((type? FDEV \BSPFDEV)
(with FDEV \BSPFDEV (SETQ OPENFILE (FUNCTION \FTP.OPENFILE))
(SETQ CLOSEFILE (FUNCTION \FTP.CLOSEFILE))
(SETQ DIRECTORYNAMEP (FUNCTION \FTP.DIRECTORYNAMEP))
(SETQ GETFILENAME (FUNCTION \FTP.GETFILENAME))
(SETQ GETFILEINFO (FUNCTION \FTP.GETFILEINFO))
(SETQ GETFILEPTR (FUNCTION \FTP.GETFILEPTR))
(SETQ SETFILEPTR (FUNCTION \FTP.SETFILEPTR))
(SETQ RENAMEFILE (FUNCTION \FTP.RENAMEFILE))
(SETQ DELETEFILE (FUNCTION \FTP.DELETEFILE))
(SETQ GENERATEFILES (FUNCTION \FTP.GENERATEFILES)))
(SETQ \FTPAVAILABLE T])
(\FTP.OPENFILE
[LAMBDA (FILENAME ACCESS RECOG OTHERINFO) (* bvm: "27-OCT-83 15:34")
(RESETLST (PROG (HOST DESIREDPLIST TYPE BYTESIZE EOLCONVENTION)
(COND
((SELECTQ ACCESS
(INPUT (EQ RECOG (QUOTE NEW)))
(OUTPUT (EQ RECOG (QUOTE OLD)))
T)
(LISPERROR "FILE WON'T OPEN" FILENAME)))
(OR (SETQ HOST (\FTP.UNPACKFILENAME FILENAME))
(RETURN))
(SETQ DESIREDPLIST (CDR HOST))
(SETQ HOST (CAR HOST))
(SELECTQ ACCESS
(OUTPUT
[for PAIR in OTHERINFO when (LISTP PAIR)
do (COND
((SELECTQ (CAR PAIR)
(TYPE (SELECTQ (SETQ TYPE (CADR PAIR))
((TEXT BINARY)
T)
(NIL)
(LISPERROR "ILLEGAL ARG" PAIR)))
(BYTESIZE (SETQ BYTESIZE (OR (FIXP (CADR PAIR))
(LISPERROR
"ILLEGAL ARG"
PAIR)))
NIL)
((EOL EOLCONVENTION)
(SELECTQ (CADR PAIR)
((CR CRLF TRANSPARENT)
(SETQ EOLCONVENTION (CADR PAIR)))
(LISPERROR "ILLEGAL ARG" PAIR))
NIL)
(CREATIONDATE (push DESIREDPLIST
(LIST (QUOTE CREATION-DATE)
(CADR PAIR)))
NIL)
(LENGTH [push DESIREDPLIST
(LIST (QUOTE SIZE)
(OR (FIXP (CADR PAIR))
(LISPERROR "ILLEGAL ARG"
PAIR]
NIL)
(SEQUENTIAL NIL)
T)
(push DESIREDPLIST PAIR]
[COND
((NULL TYPE)
(push DESIREDPLIST (LIST (QUOTE TYPE)
(SETQ TYPE DEFAULTFILETYPE]
(SELECTQ TYPE
[TEXT (push DESIREDPLIST (LIST (QUOTE END-OF-LINE-CONVENTION)
(OR EOLCONVENTION
(QUOTE CR]
[BINARY (push DESIREDPLIST (LIST (QUOTE BYTE-SIZE)
(OR BYTESIZE 8]
NIL))
NIL)
(RETURN (\FTP.OPENFILE.FROM.PLIST HOST DESIREDPLIST ACCESS])
(\FTP.OPENFILE.FROM.PLIST
[LAMBDA (HOST DESIREDPLIST ACCESS) (* bvm: "21-NOV-83 14:49")
(PROG (CONNECTION INS OUTS REMOTEPLIST FULLNAME)
NEWCONNECTION
(OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
(RETURN))
(SETQ INS (fetch FTPIN of CONNECTION))
(SETQ OUTS (fetch FTPOUT of CONNECTION))
RETRY
(FTPPUTMARK OUTS (SELECTQ ACCESS
(INPUT (MARK# RETRIEVE))
(OUTPUT (MARK# NEW-STORE))
NIL))
(\FTP.PRINTPLIST OUTS DESIREDPLIST)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
[(\FTP.HANDLE.NO CONNECTION DESIREDPLIST)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
(T (\RELEASE.FTPCONNECTION CONNECTION)
(RETURN]
[(MARK# HERE-IS-PLIST)
(SETQ REMOTEPLIST (READPLIST INS))
(SETQ FULLNAME (\FTP.PACKFILENAME HOST REMOTEPLIST))
(OR (EQ (FTPGETMARK INS)
(MARK# EOC))
(RETURN (\FTPERROR CONNECTION]
((MARK# BROKEN)
(GO NEWCONNECTION))
(RETURN (\FTPERROR CONNECTION)))
(SELECTQ ACCESS
[INPUT (FTPPUTMARK OUTS (MARK# YES))
(FTPPUTCODE OUTS 0)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
((\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL NIL T)
(CLOSEBSPSTREAM INS 2000)
(* Can't recover from in the middle like this, so just
flush and start over)
(GO NEWCONNECTION))
(T (\RELEASE.FTPCONNECTION CONNECTION)
(RETURN (LISPERROR "FILE WON'T OPEN" FULLNAME]
((MARK# HERE-IS-FILE)
(replace FULLFILENAME of INS with FULLNAME)
(replace FTPFILEPROPS of INS with REMOTEPLIST)
(replace ACCESS of INS with (QUOTE INPUT))
(replace EOLCONVENTION of INS with (\FTP.EOL.FROM.PLIST
REMOTEPLIST))
(replace BSPFILEPTR of INS with 0)
(* For GETFILEPTR)
(RETURN INS))
((MARK# BROKEN)
(GO NEWCONNECTION))
(RETURN (\FTPERROR CONNECTION]
[OUTPUT (COND
((BSPOPENP OUTS (QUOTE OUTPUT))
(FTPPUTMARK OUTS (MARK# HERE-IS-FILE))
(replace FULLFILENAME of OUTS with FULLNAME)
(replace FTPFILEPROPS of OUTS with REMOTEPLIST)
(replace BSPFILEPTR of OUTS with 0)
(replace EOLCONVENTION of OUTS with (\FTP.EOL.FROM.PLIST DESIREDPLIST))
(RETURN OUTS))
(T (GO NEWCONNECTION]
NIL])
(\FTP.GETFILEPTR
[LAMBDA (STREAM) (* bvm: " 2-NOV-83 14:31")
(IPLUS (fetch BSPFILEPTR of STREAM)
(COND
((fetch CPPTR of STREAM)
(fetch COFFSET of STREAM))
(T 0])
(\FTP.SETFILEPTR
[LAMBDA (STREAM INDX) (* bvm: " 1-NOV-83 17:47")
(PROG (SKIPBYTES)
(RETURN (COND
((AND (fetch BSPOUTPUTSTREAM of STREAM)
(IGEQ (SETQ SKIPBYTES (IDIFFERENCE INDX (\FTP.GETFILEPTR STREAM)))
0)) (* Can only move file pointer on input, and then only
forward)
(\BSP.SKIPBYTES STREAM SKIPBYTES))
(T (\IS.NOT.RANDACCESSP STREAM])
(\FTP.GETFILENAME
[LAMBDA (NAME RECOG DEV) (* bvm: "20-SEP-83 16:48")
(\FTP.RECOGNIZEFILE NAME DEV])
(\FTP.RECOGNIZEFILE
[LAMBDA (NAME DEV OPTION) (* bvm: "27-OCT-83 14:41")
(RESETLST (PROG (CONNECTION HOST INS OUTS REMOTEPLIST DESIREDPLIST RESULT)
(OR (SETQ HOST (\FTP.UNPACKFILENAME NAME))
(RETURN))
(SETQ DESIREDPLIST (CDR HOST))
(SETQ HOST (CAR HOST))
(SELECTQ OPTION
[DIRECTORYNAMEP (RPLACA (CDR (ASSOC (QUOTE NAME-BODY)
DESIREDPLIST))
"QXZYQJ")
(push DESIREDPLIST (LIST (QUOTE DESIRED-PROPERTY)
(QUOTE DIRECTORY]
[(NIL NAME)
(for PROP in (QUOTE (DIRECTORY NAME-BODY VERSION))
do (push DESIREDPLIST (LIST (QUOTE DESIRED-PROPERTY)
PROP]
NIL)
NEWCONNECTION
(OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
(RETURN))
(SETQ INS (fetch FTPIN of CONNECTION))
(SETQ OUTS (fetch FTPOUT of CONNECTION))
RETRY
(FTPPUTMARK OUTS (MARK# ENUMERATE))
(\FTP.PRINTPLIST OUTS DESIREDPLIST)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(SELECTC (SETQ CODE (FTPGETCODE INS T))
(\NO.ILLEGAL.DIRECTORY (\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.))
)
[\NO.FILE.NOT.FOUND (\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.))
(COND
((EQ OPTION (QUOTE DIRECTORYNAMEP))
(* Directory exists)
(SETQ RESULT (
\FTP.PACK.DIRECTORYNAMEP
CONNECTION
DESIREDPLIST]
(COND
((\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL CODE)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
[(MARK# HERE-IS-PLIST)
(SETQ REMOTEPLIST (READPLIST INS))
(SETQ RESULT (SELECTQ OPTION
(PROPS REMOTEPLIST)
(DIRECTORYNAMEP (\FTP.PACK.DIRECTORYNAMEP
CONNECTION
REMOTEPLIST))
(\FTP.PACKFILENAME HOST REMOTEPLIST)))
(COND
((OR (NOT (\EOFP INS))
(NEQ (FTPGETMARK INS)
(MARK# EOC)))
(RETURN (\FTPERROR CONNECTION]
((MARK# BROKEN)
(GO NEWCONNECTION))
(RETURN (\FTPERROR CONNECTION)))
(\RELEASE.FTPCONNECTION CONNECTION)
(RETURN RESULT])
(\FTP.DIRECTORYNAMEP
[LAMBDA (HOST/DIR DEV) (* bvm: "27-SEP-83 17:59")
(\FTP.RECOGNIZEFILE HOST/DIR DEV (QUOTE DIRECTORYNAMEP])
(\FTP.CLOSEFILE
[LAMBDA (STREAM) (* bvm: " 4-NOV-83 12:05")
(PROG ((ACCESS (fetch ACCESS of STREAM))
[CONN (find C in \FTPCONNECTIONS suchthat (OR (EQ (fetch FTPIN of C)
STREAM)
(EQ (fetch FTPOUT of C)
STREAM]
(FILENAME (fetch FULLFILENAME of STREAM))
INS)
(replace FTPFILEPROPS of STREAM with NIL)
(COND
((SELECTQ ACCESS
[INPUT (COND
((NOT (BSPOPENP STREAM ACCESS)))
((OR (\EOFP STREAM)
(PROGN (BIN STREAM)
(\EOFP STREAM))
(PROGN (BIN STREAM)
(\EOFP STREAM)))
(* Hack. We are at the end of the file, or within a byte or two of it (typical for LOAD), so we can terminate the
RETRIEVE cleanly)
(SELECTC (FTPGETMARK STREAM)
((MARK# YES) (* File sent ok)
(FTPGETCODE STREAM)
(\FTP.FLUSH.TO.EOC STREAM (.FTPDEBUGLOG.)))
NIL]
(OUTPUT (OR (SELECTC (COND
((SETQ INS (fetch BSPINPUTSTREAM
of (fetch BSPSOC of STREAM)))
(FTPPUTMARK STREAM (MARK# YES))
(FTPPUTCODE STREAM 0)
(.EOC. STREAM)
(FTPGETMARK INS)))
((MARK# YES)
(FTPGETCODE INS)
(\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.)))
((MARK# NO)
(SELECTC [PROG1 (FTPGETCODE INS T)
(\FTP.FLUSH.TO.EOC INS
(\GETSTREAM
PROMPTWINDOW
(QUOTE OUTPUT]
(\NO.STORAGE.FULL (LISPERROR
"FILE SYSTEM RESOURCES EXCEEDED"
FILENAME))
NIL))
NIL)
(PROGN (ERROR "CLOSEF: Remote file not stored" FILENAME)
NIL)))
NIL)
(\RELEASE.FTPCONNECTION CONN))
(CONN (ENDBSPSTREAM (fetch FTPIN of CONN)
1750Q)))
(RETURN FILENAME])
(\FTP.RENAMEFILE
[LAMBDA (OLDFILE NEWFILE) (* bvm: "27-OCT-83 14:42")
(RESETLST (PROG (CONNECTION HOST OLDNAME INS OUTS OLDPLIST NEWPLIST)
(OR (SETQ HOST (\FTP.UNPACKFILENAME OLDFILE))
(RETURN))
(SETQ OLDPLIST (CDR HOST))
(SETQ HOST (CAR HOST))
(OR (SETQ NEWPLIST (\FTP.UNPACKFILENAME NEWFILE))
(RETURN))
[COND
((NEQ (CAR NEWPLIST)
HOST)
(RETURN))
(T (SETQ NEWPLIST (CDR NEWPLIST]
(CLEAR.LEAF.CACHE HOST) (* In case Leaf has this file open for input)
NEWCONNECTION
(OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
(RETURN))
(SETQ INS (fetch FTPIN of CONNECTION))
(SETQ OUTS (fetch FTPOUT of CONNECTION))
RETRY
(FTPPUTMARK OUTS (MARK# RENAME))
(\FTP.PRINTPLIST OUTS OLDPLIST)
(\FTP.PRINTPLIST OUTS NEWPLIST)
(.EOC. OUTS)
(RETURN (PROG1 (SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
((\FTP.HANDLE.NO CONNECTION OLDPLIST)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
((MARK# YES)
(FTPGETCODE INS)
(AND (\FTP.FLUSH.TO.EOC INS (.FTPDEBUGLOG.))
NEWFILE))
((MARK# BROKEN)
(GO NEWCONNECTION))
(\FTPERROR CONNECTION))
(\RELEASE.FTPCONNECTION CONNECTION])
(\FTP.DELETEFILE
[LAMBDA (FILENAME) (* bvm: "27-OCT-83 14:43")
(RESETLST (PROG (CONNECTION HOST REMOTENAME INS OUTS REMOTEPLIST DESIREDPLIST RESULT)
(OR (SETQ HOST (\FTP.UNPACKFILENAME FILENAME))
(RETURN))
(SETQ DESIREDPLIST (CDR HOST))
(SETQ HOST (CAR HOST))
(for PROP in (QUOTE (DIRECTORY NAME-BODY VERSION))
do (push DESIREDPLIST (LIST (QUOTE DESIRED-PROPERTY)
PROP)))
(CLEAR.LEAF.CACHE HOST) (* In case Leaf has this file open for input)
NEWCONNECTION
(OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
(RETURN))
(SETQ INS (fetch FTPIN of CONNECTION))
(SETQ OUTS (fetch FTPOUT of CONNECTION))
RETRY
(FTPPUTMARK OUTS (MARK# DELETE))
(\FTP.PRINTPLIST OUTS DESIREDPLIST)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
[(\FTP.HANDLE.NO CONNECTION DESIREDPLIST)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
(T (\RELEASE.FTPCONNECTION CONNECTION)
(RETURN]
((MARK# HERE-IS-PLIST)
NIL)
((MARK# BROKEN)
(GO NEWCONNECTION))
(RETURN (\FTPERROR CONNECTION)))
NEXTPLIST
(SETQ REMOTEPLIST (READPLIST INS))
(OR (EQ (FTPGETMARK INS)
(MARK# EOC))
(\FTPERROR CONNECTION))
(FTPPUTMARK OUTS (MARK# YES))
(FTPPUTCODE OUTS 0)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
((\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL NIL T)
(CLOSEBSPSTREAM INS 2000)
(GO NEWCONNECTION]
((MARK# YES)
(FTPGETCODE INS)
(\FTP.FLUSH.TO.MARK INS)
(push RESULT (\FTP.PACKFILENAME HOST REMOTEPLIST)))
(RETURN (\FTPERROR CONNECTION)))
(SELECTC (FTPGETMARK INS)
((MARK# HERE-IS-PLIST)
(GO NEXTPLIST))
[(MARK# EOC)
(\RELEASE.FTPCONNECTION CONNECTION)
(RETURN (COND
((CDR RESULT)
(REVERSE RESULT))
(T (CAR RESULT]
(RETURN (\FTPERROR CONNECTION])
(\FTP.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS) (* bvm: "31-OCT-83 17:54")
(RESETLST (PROG (CONNECTION HOST REMOTENAME INS OUTS DESIREDPLIST CODE VERSION EXTENSION NAME
DIRECTORY NAMEBODY OSTYPE INFO)
(for TAIL on (UNPACKFILENAME PATTERN) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
[HOST (SETQ HOST (\CANONICAL.HOSTNAME (CADR TAIL]
(DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
(EXTENSION (SETQ EXTENSION (CADR TAIL)))
(VERSION (SETQ VERSION (CADR TAIL)))
(RETURN)))
(SETQ OSTYPE (GETHOSTINFO HOST (QUOTE OSTYPE)))
(SELECTQ OSTYPE
[(TENEX VMS)
[COND
((STRPOS (QUOTE *)
NAME)
(SETQ NAME (QUOTE *]
(COND
((AND EXTENSION (STRPOS (QUOTE *)
EXTENSION))
(SETQ EXTENSION (QUOTE *]
((TOPS20 D) (* No adjustment needed for these smart systems.)
)
[(NIL IFS)
(COND
((EQ EXTENSION (QUOTE *))
(SETQ EXTENSION NIL)
(COND
((NEQ (NTHCHARCODE NAME -1)
(CHARCODE *))
(SETQ NAME (PACK* NAME (QUOTE *]
[UNIX [COND
((EQ (NTHCHARCODE DIRECTORY -1)
(CHARCODE /))
(SETQ DIRECTORY (SUBSTRING DIRECTORY 1 -2]
(SETQ DIRECTORY (L-CASE (COND
((NEQ (NTHCHARCODE DIRECTORY 1)
(CHARCODE /))
(CONCAT (QUOTE /)
DIRECTORY))
(T DIRECTORY]
NIL)
[SETQ DESIREDPLIST (CONS [LIST (QUOTE USER-NAME)
(CAR (SETQ INFO (\INTERNAL/GETPASSWORD HOST]
(CONS (LIST (QUOTE USER-PASSWORD)
(CDR INFO))
(for PROP
in (NCONC (for PROP in DESIREDPROPS
collect
(SELECTQ PROP
(BYTESIZE (QUOTE
BYTE-SIZE))
(LENGTH (QUOTE SIZE))
((CREATIONDATE
ICREATIONDATE)
(QUOTE CREATION-DATE))
((WRITEDATE IWRITEDATE)
(QUOTE WRITE-DATE))
((READDATE IREADDATE)
(QUOTE READ-DATE))
(EOLCONVENTION
(QUOTE
END-OF-LINE-CONVENTION))
PROP))
(QUOTE (DIRECTORY NAME-BODY VERSION)))
collect (LIST (QUOTE DESIRED-PROPERTY)
PROP]
[COND
((NEQ VERSION (QUOTE *))
(push DESIREDPLIST (LIST (QUOTE VERSION)
(OR VERSION (SELECTQ OSTYPE
((TENEX TOPS20)
0)
(QUOTE H]
[SETQ NAMEBODY (COND
((NULL EXTENSION)
NAME)
(T (CONCAT NAME "." EXTENSION]
[push DESIREDPLIST (LIST (QUOTE NAME-BODY)
(COND
((EQ OSTYPE (QUOTE UNIX))
(L-CASE NAMEBODY))
(T NAMEBODY]
[COND
(DIRECTORY (push DESIREDPLIST (LIST (QUOTE DIRECTORY)
DIRECTORY]
NEWCONNECTION
(OR (SETQ CONNECTION (\GETFTPCONNECTION HOST T))
(RETURN))
(SETQ INS (fetch FTPIN of CONNECTION))
(SETQ OUTS (fetch FTPOUT of CONNECTION))
RETRY
(FTPPUTMARK OUTS (MARK# ENUMERATE))
(\FTP.PRINTPLIST OUTS DESIREDPLIST)
(.EOC. OUTS)
(SELECTC (FTPGETMARK INS)
[(MARK# NO)
(COND
[(\FTP.HANDLE.NO CONNECTION DESIREDPLIST NIL CODE)
(COND
((BSPOPENP INS (QUOTE INPUT))
(GO RETRY))
(T (GO NEWCONNECTION]
(T (\RELEASE.FTPCONNECTION CONNECTION)
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION NILL]
((MARK# HERE-IS-PLIST)
(replace FTPBUSY of CONNECTION with (SETUPTIMER \FTP.IDLE.TIMEOUT))
(* This guy gets a timer because the generator could be
aborted out of our control. Blech)
(\FTP.ASSURE.CLEANUP)
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \FTP.NEXTFILE)
GENFILESTATE ← CONNECTION)))
((MARK# BROKEN)
(GO NEWCONNECTION))
(RETURN (\FTPERROR CONNECTION])
(\FTP.NEXTFILE
[LAMBDA (FTPCONNECTION SCRATCHLIST NOVERSION HOST/DIR) (* bvm: "27-OCT-83 14:51")
(DECLARE (SPECVARS FTPCONNECTION)) (* Seen by \FTP.CLEANUP)
(PROG ((INS (fetch FTPIN of FTPCONNECTION))
NAMEBODY NAME EXT N PLIST)
(COND
((NOT INS)
(GO BROKEN)))
(SETUPTIMER \FTP.IDLE.TIMEOUT (fetch FTPBUSY of FTPCONNECTION))
[COND
((\EOFP INS) (* NEW-ENUMERATE sends plists one after another with no
intervening HERE-IS-PLIST; check here for oldstyle, or
for end of command)
(SELECTC (FTPGETMARK INS)
((MARK# EOC)
(\RELEASE.FTPCONNECTION FTPCONNECTION)
(RETURN NIL))
((MARK# HERE-IS-PLIST) (* Old style)
)
((MARK# BROKEN)
(GO BROKEN))
(RETURN (\FTPERROR FTPCONNECTION]
(COND
([AND (NULL (SETQ PLIST (READPLIST INS)))
(NOT (BSPOPENP INS (QUOTE INPUT]
(GO BROKEN)))
[COND
[(SETQ NAMEBODY (ASSOC (QUOTE NAME-BODY)
PLIST))
(COND
[[SETQ N (STRPOS (QUOTE %.)
(SETQ NAMEBODY (OR (CADR NAMEBODY)
""]
(SETQ EXT (SUBSTRING NAMEBODY (ADD1 N)))
(SETQ NAME (SUBSTRING NAMEBODY 1 (SUB1 N]
(T (SETQ NAME NAMEBODY)))
(SETQ NAME (COND
[HOST/DIR (PACKFILENAME (QUOTE HOST)
(fetch FTPHOST of FTPCONNECTION)
(QUOTE DIRECTORY)
(CADR (ASSOC (QUOTE DIRECTORY)
PLIST))
(QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXT
(QUOTE VERSION)
(AND (NOT NOVERSION)
(CADR (ASSOC (QUOTE VERSION)
PLIST]
(T (PACKFILENAME (QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXT
(QUOTE VERSION)
(AND (NOT NOVERSION)
(CADR (ASSOC (QUOTE VERSION)
PLIST]
((SETQ NAMEBODY (CADR (ASSOC (QUOTE SERVER-FILENAME)
PLIST)))
(SETQ NAME (PACKFILENAME (QUOTE HOST)
(fetch FTPHOST of FTPCONNECTION)
(QUOTE BODY)
NAMEBODY]
(SETUPTIMER \FTP.IDLE.TIMEOUT (fetch FTPBUSY of FTPCONNECTION))
[RETURN (COND
(NAME (DCHCON NAME SCRATCHLIST))
(T (HELP "Uninterpretable filename returned by ENUMERATE" PLIST]
BROKEN
(ERROR
"File server broke connection before directory enumeration finished. RETURN() to terminate enumeration."
(fetch FTPHOST of FTPCONNECTION))
(RETURN NIL])
(\FTP.GETFILEINFO
[LAMBDA (STREAM ATTRIBUTE DEV) (* bvm: "27-SEP-83 17:53")
(\FTP.GETFILEINFO.FROM.PROPS [COND
((type? STREAM STREAM)
(fetch FTPFILEPROPS of STREAM))
(T (\FTP.RECOGNIZEFILE STREAM DEV (QUOTE PROPS]
ATTRIBUTE])
(\FTP.GETFILEINFO.FROM.PROPS
[LAMBDA (PROPS ATTRIBUTE) (* bvm: "27-SEP-83 17:39")
(PROG (TMP)
(RETURN (SELECTQ ATTRIBUTE
(CREATIONDATE (\FTP.GETDATEPROP (QUOTE CREATION-DATE)
PROPS))
(WRITEDATE (\FTP.GETDATEPROP (QUOTE WRITE-DATE)
PROPS))
(READDATE (\FTP.GETDATEPROP (QUOTE READ-DATE)
PROPS))
[ICREATIONDATE (IDATE (\FTP.GETFILEINFO.FROM.PROPS PROPS (QUOTE
CREATIONDATE]
[IWRITEDATE (IDATE (\FTP.GETFILEINFO.FROM.PROPS PROPS (QUOTE WRITEDATE]
[IREADDATE (IDATE (\FTP.GETFILEINFO.FROM.PROPS PROPS (QUOTE READDATE]
(LENGTH (CADR (ASSOC (QUOTE SIZE)
PROPS)))
(SIZE (AND (SETQ TMP (CADR (ASSOC (QUOTE SIZE)
PROPS)))
(FOLDHI TMP BYTESPERPAGE)))
[TYPE (U-CASE (CADR (ASSOC ATTRIBUTE PROPS]
(BYTESIZE (CADR (ASSOC (QUOTE BYTE-SIZE)
PROPS)))
(CADR (ASSOC ATTRIBUTE PROPS])
(\FTP.GETDATEPROP
[LAMBDA (NAME PROPS) (* bvm: " 1-JUN-83 12:48")
(PROG [(DATELIST (CDR (ASSOC NAME PROPS]
(RETURN (AND DATELIST (U-CASE (SUBSTRING DATELIST 2 -2])
)
(DEFINEQ
(\FTP.OPEN.CONNECTION
[LAMBDA (HOST ECHOSTREAM) (* bvm: " 1-NOV-83 15:40")
(PROG ((PORT (BESTPUPADDRESS HOST PROMPTWINDOW))
INSTREAM)
(OR PORT (RETURN))
(SETQ INSTREAM (OPENBSPSTREAM [CONS (CAR PORT)
(COND
((ZEROP (CDR PORT))
\PUPSOCKET.FTP)
(T (CDR PORT]
NIL
(FUNCTION \FTP.ERRORHANDLER)
NIL NIL (FUNCTION \FTP.WHENCLOSED)
"Can't open FTP connection"))
(RETURN (COND
(INSTREAM (SETQ INSTREAM (create FTPCONNECTION
FTPIN ← INSTREAM
FTPOUT ←(BSPOUTPUTSTREAM INSTREAM)
FTPHOST ←[\CANONICAL.HOSTNAME
(COND
((LITATOM HOST)
HOST)
(T (ETHERHOSTNAME PORT]
FTPBUSY ← T))
(COND
((\FTP.SENDVERSION INSTREAM ECHOSTREAM)
(push \FTPCONNECTIONS INSTREAM)
INSTREAM)
(T (CLOSEBSPSTREAM (fetch FTPIN of INSTREAM])
(\FTP.SENDVERSION
[LAMBDA (CONNECTION ECHOSTREAM) (* bvm: " 3-JUN-83 23:58")
(PROG ((INS (fetch FTPIN of CONNECTION))
(OUTS (fetch FTPOUT of CONNECTION)))
(FTPPUTMARK OUTS (MARK# VERSION))
(BOUT OUTS \FTP.VERSION)
(PRIN3 "Interlisp-D Ftp user" OUTS)
(.EOC. OUTS)
(RETURN (SELECTC (FTPGETMARK INS)
[(MARK# VERSION)
(COND
((EQ (BIN INS)
\FTP.VERSION)
(\FTP.FLUSH.TO.EOC INS ECHOSTREAM]
NIL])
(\FTP.WHENCLOSED
[LAMBDA (INSTREAM) (* bvm: "15-SEP-83 23:06")
(PROG [(CONN (find C in \FTPCONNECTIONS suchthat (EQ (fetch FTPIN of C)
INSTREAM]
(COND
(CONN (SETQ \FTPCONNECTIONS (DREMOVE CONN \FTPCONNECTIONS))
(AND FTPDEBUGFLG (printout FTPDEBUGLOG T "{FTP Connection with "
(fetch FTPHOST of CONN)
" closed}" T])
(\GETFTPCONNECTION
[LAMBDA (HOST UNWINDSAVE) (* bvm: "19-AUG-83 22:22")
(PROG ([H (\CANONICAL.HOSTNAME (COND
((LITATOM HOST)
HOST)
(T (ETHERHOSTNAME HOST]
CONNECTION)
(RETURN (COND
([SETQ CONNECTION (OR (for CONN in \FTPCONNECTIONS
when (AND (EQ (fetch FTPHOST of CONN)
H)
(NOT (fetch FTPBUSY of CONN))
(BSPOPENP (fetch FTPIN of CONN)
(QUOTE OUTPUT)))
do (replace FTPBUSY of CONN with T)
(replace ACCESS of (fetch FTPIN of CONN)
with (QUOTE INPUT))
(* Because \CLOSEFILE clobbered this field)
(replace ACCESS of (fetch FTPOUT of CONN)
with (QUOTE OUTPUT))
(RETURN CONN))
(\FTP.OPEN.CONNECTION HOST (.FTPDEBUGLOG.]
[COND
(UNWINDSAVE (RESETSAVE (PROGN (fetch FTPIN of CONNECTION))
(QUOTE (AND RESETSTATE (ENDBSPSTREAM OLDVALUE 0]
CONNECTION])
(\RELEASE.FTPCONNECTION
[LAMBDA (CONN) (* bvm: "18-MAY-83 10:53")
(replace FTPBUSY of CONN with NIL])
(\FTP.ERRORHANDLER
[LAMBDA (INSTREAM ERRCODE) (* bvm: "28-OCT-83 19:17")
(PROG (OUTSTREAM TMP)
(RETURN (SELECTQ ERRCODE
(MARK.ENCOUNTERED (COND
((fetch FTPOPENP of INSTREAM)
(* If reading a file, this is EOF)
(STREAMOP (QUOTE ENDOFSTREAMOP)
INSTREAM INSTREAM))
(T -1)))
(BAD.STATE.FOR.BOUT (COND
((AND (SETQ OUTSTREAM (BSPOUTPUTSTREAM INSTREAM))
(fetch FTPOPENP of OUTSTREAM))
(* Writing a file, and partner timed out.
Hard to recover from this)
(ERROR "File server has broken connection"
(fetch FULLFILENAME of OUTSTREAM)))
(T (* Just protocol stuff. Let it go by, and catch the
error on the next input)
(* (replace BOUTFN of OUTSTREAM with
(FUNCTION NILL)))
NIL)))
(BAD.STATE.FOR.BIN (COND
((fetch FTPOPENP of INSTREAM)
(* Could recover by reopening file)
(\FTP.FIX.BROKEN.INPUT INSTREAM))
((SETQ TMP (STKPOS (QUOTE READPLIST)))
(* Reading a plist, can't just barf in the middle)
(RETFROM TMP NIL T))
(T (* Act like end of file)
-1)))
[BAD.GETMARK (COND
((BSPOPENP INSTREAM (QUOTE INPUT))
(MARK# NOTAMARK))
(T (MARK# BROKEN]
(ERROR ERRCODE (AND INSTREAM (OR (fetch FULLFILENAME of INSTREAM)
(AND (SETQ OUTSTREAM (BSPOUTPUTSTREAM
INSTREAM))
(fetch FULLFILENAME of OUTSTREAM))
(AND (SETQ OUTSTREAM
(fetch BSPSOC of INSTREAM))
(ETHERHOSTNAME (fetch FRNPORT
of OUTSTREAM)
T])
(\FTP.FIX.BROKEN.INPUT
[LAMBDA (INSTREAM) (* bvm: "28-OCT-83 19:21")
(* Called when remote server breaks connection in
midstream. Try to reopen and set fileptr to the right
place)
(PROG ((FULLNAME (fetch FULLFILENAME of INSTREAM))
(PROPS (fetch FTPFILEPROPS of INSTREAM))
(POS (GETFILEPTR INSTREAM))
NEWSTREAM)
(printout PROMPTWINDOW T "File server broke connection while reading " FULLNAME " at byte "
.P2 POS (QUOTE ...))
(COND
((SETQ NEWSTREAM (\FTP.OPENFILE.FROM.PLIST (FILENAMEFIELD FULLNAME (QUOTE HOST))
[\FTP.ADD.USERINFO
(for PAIR in PROPS collect PAIR
when (FMEMB (CAR PAIR)
(QUOTE (NAME-BODY VERSION
DIRECTORY
DEVICE
SERVER-FILENAME]
(QUOTE INPUT)))
(\SMASHBSPSTREAM NEWSTREAM INSTREAM) (* Smash new stream into old, so we are now using
INSTREAM again)
(for CONN in \FTPCONNECTIONS when (EQ (fetch FTPIN of CONN)
NEWSTREAM)
do (replace FTPIN of CONN with INSTREAM)
(replace FTPOUT of CONN with (BSPOUTPUTSTREAM INSTREAM))
(RETURN))
(printout PROMPTWINDOW T "Reopening file and restoring fileptr...")
(SETFILEPTR INSTREAM POS)
(printout PROMPTWINDOW "done.")
(RETURN (BIN INSTREAM)))
(T (ERROR "File server broke connection; unable to reestablish" FULLNAME])
(\FTP.CLEANUP
[LAMBDA NIL (* bvm: "19-AUG-83 16:19")
(* Process that sits watching to see if an FTP
connection has been idle too long)
(DECLARE (SPECVARS CONNS FAIL))
(PROG ((TIMER (SETUPTIMER 0))
(INTERVAL (LRSH \FTP.IDLE.TIMEOUT 1))
CONNS)
SLEEP
(SETUPTIMER INTERVAL TIMER)
(do (BLOCK NIL TIMER) until (TIMEREXPIRED? TIMER))
LP1 (COND
((NULL (SETQ CONNS \FTPCONNECTIONS))
(RETURN)))
LP2 (COND
([AND (FIXP (fetch FTPBUSY of (CAR CONNS)))
(TIMEREXPIRED? (fetch FTPBUSY of (CAR CONNS)))
(NOT (PROG (FAIL)
[MAP.PROCESSES (FUNCTION (LAMBDA (PROC)
(COND
((EQ (PROCESS.EVALV PROC (QUOTE FTPCONNECTION))
(CAR CONNS))
(SETQ FAIL T]
(RETURN FAIL]
(* Timer expired AND there is nobody actively using this connection. Latter is important in case the remote server
was just slow to answer. Ideal solution would be to see if anyone has a pointer to the generator, but that takes
gc changes)
(CLOSEBSPSTREAM (fetch FTPIN of (CAR CONNS)))
(GO LP1)))
(COND
((SETQ CONNS (CDR CONNS))
(GO LP2)))
(GO SLEEP])
(\FTP.ASSURE.CLEANUP
[LAMBDA NIL (* bvm: "19-AUG-83 16:12")
(OR (FIND.PROCESS (QUOTE \FTP.CLEANUP))
(ADD.PROCESS (QUOTE (\FTP.CLEANUP))
(QUOTE RESTARTABLE)
(QUOTE NO])
)
(DEFINEQ
(\FTP.HANDLE.NO
[LAMBDA (CONNECTION BADPLIST ECHOSTREAM CODE LEAVEMARK) (* bvm: "21-NOV-83 14:04")
(PROG ((INSTREAM (fetch FTPIN of CONNECTION))
(HOST (fetch FTPHOST of CONNECTION))
[FLUSHER (COND
(LEAVEMARK (FUNCTION \FTP.FLUSH.TO.MARK))
(T (FUNCTION \FTP.FLUSH.TO.EOC]
INFO)
(SELECTC (OR CODE (SETQ CODE (FTPGETCODE INSTREAM T)))
(\NO.FILE.NOT.FOUND (APPLY* FLUSHER INSTREAM (OR ECHOSTREAM (.FTPDEBUGLOG.)))
(RETURN))
[\NO.BAD.TRANSFER.PARMS (COND
((AND (SETQ INFO (ASSOC (QUOTE END-OF-LINE-CONVENTION)
BADPLIST))
(NEQ (CADR INFO)
(QUOTE CR)))
(RPLACA (CDR INFO)
(QUOTE CR))
(* Fall back on EOL = CR, which everyone must support)
(APPLY* FLUSHER INSTREAM (OR ECHOSTREAM (.FTPDEBUGLOG.)
))
(RETURN T]
[(LIST \NO.ILLEGAL.CONNECTNAME \NO.FILE.PROTECTED)
(COND
((NULL (ASSOC (QUOTE CONNECT-NAME)
BADPLIST))
[NCONC1 BADPLIST (LIST (QUOTE CONNECT-NAME)
(\FTP.DIRECTORYNAMEONLY (CADR (ASSOC (QUOTE DIRECTORY)
BADPLIST]
(APPLY* FLUSHER INSTREAM (OR ECHOSTREAM (.FTPDEBUGLOG.)))
(RETURN T]
NIL)
GENERAL.FAILURE
(printout [OR ECHOSTREAM (SETQ ECHOSTREAM (GETSTREAM PROMPTWINDOW (QUOTE OUTPUT]
T HOST ": ")
(COND
((APPLY* FLUSHER INSTREAM ECHOSTREAM)
(SELECTC CODE
[(LIST \NO.ILLEGAL.USERNAME \NO.ILLEGAL.USERPASSWORD)
(* User Password errors)
(COND
((SETQ INFO (\INTERNAL/GETPASSWORD HOST T NIL NIL))
(for PAIR in BADPLIST do (SELECTQ (CAR PAIR)
(USER-NAME (FRPLACA (CDR PAIR)
(CAR INFO)))
(USER-PASSWORD (FRPLACA (CDR PAIR)
(CDR INFO)))
NIL))
T)
(T (GO WONT.OPEN]
[(LIST \NO.ILLEGAL.CONNECTNAME \NO.ILLEGAL.CONNECTPASSWORD)
(* Connect Password errors)
(COND
((SETQ INFO (\INTERNAL/GETPASSWORD HOST T (CADR (ASSOC (QUOTE CONNECT-NAME)
BADPLIST))
NIL))
[for PAIR in BADPLIST do (SELECTQ (CAR PAIR)
(CONNECT-NAME (FRPLACA (CDR PAIR)
(CAR INFO)))
[CONNECT-PASSWORD
(RETURN (FRPLACA (CDR PAIR)
(CDR INFO]
NIL)
finally (NCONC1 BADPLIST (LIST (QUOTE CONNECT-PASSWORD)
(CDR INFO]
T)
(T (GO WONT.OPEN]
(\NO.ILLEGAL.NAME.ERRORS (LISPERROR "BAD FILE NAME" (\FTP.PACKFILENAME HOST
BADPLIST)))
(\NO.STORAGE.FULL (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED"
(\FTP.PACKFILENAME HOST BADPLIST)))
((LIST \NO.FILE.PROTECTED \NO.FILE.BUSY)
(GO WONT.OPEN))
(GO WONT.OPEN)))
(T (\FTPERROR CONNECTION)))
WONT.OPEN
(LISPERROR "FILE WON'T OPEN" (\FTP.PACKFILENAME HOST BADPLIST])
(\FTP.DIRECTORYNAMEONLY
[LAMBDA (DIRNAME) (* bvm: "16-AUG-83 18:35")
(PROG ((N (STRPOS (QUOTE >)
DIRNAME)))
(RETURN (COND
(N (SUBATOM DIRNAME 1 (SUB1 N)))
(T DIRNAME])
(\FTP.EOL.FROM.PLIST
[LAMBDA (PLIST) (* bvm: "21-NOV-83 15:33")
(for PAIR in PLIST when (EQ (CAR PAIR)
(QUOTE END-OF-LINE-CONVENTION))
do (RETURN (SELECTQ (CADR PAIR)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
CR.EOLC))
finally (RETURN CR.EOLC])
(\FTP.MAKEPLIST
[LAMBDA (FILENAME HOST DESIREDPROPS) (* bvm: " 4-JUN-83 21:35")
(PROG ((INFO (\INTERNAL/GETPASSWORD HOST)))
(RETURN (CONS (LIST (QUOTE USER-NAME)
(CAR INFO))
(CONS (LIST (QUOTE USER-PASSWORD)
(CDR INFO))
(CONS (LIST (QUOTE SERVER-FILENAME)
FILENAME)
(for PROP inside DESIREDPROPS collect (LIST (QUOTE
DESIRED-PROPERTY)
PROP])
(\FTP.PRINTPLIST
[LAMBDA (STREAM PLIST) (* bvm: " 3-NOV-83 22:21")
(BOUT STREAM (CHARCODE %())
(for PAIR in PLIST
do (for ITEM in PAIR bind (BEFORE ←(CHARCODE %())
ISPASSWORD
do (BOUT STREAM BEFORE)
(SETQ BEFORE (CHARCODE SPACE))
(for CH inchars ITEM
do (SELCHARQ (COND
(ISPASSWORD (SETQ CH (\DECRYPT.PWD.CHAR CH)))
(T CH))
((%( %) ')
(BOUT STREAM (CHARCODE ')))
NIL)
(BOUT STREAM CH))
(SELECTQ ITEM
((USER-PASSWORD CONNECT-PASSWORD)
(SETQ ISPASSWORD T))
NIL))
(BOUT STREAM (CHARCODE %))))
(BOUT STREAM (CHARCODE %)))
(COND
(FTPDEBUGFLG (PRIN2 PLIST FTPDEBUGLOG)))
STREAM])
(\FTP.PACKFILENAME
[LAMBDA (HOST PLIST PRESERVECASE) (* bvm: "13-JUN-83 16:36")
(PROG ((NAMEBODY (CADR (ASSOC (QUOTE NAME-BODY)
PLIST)))
NAME EXT N)
[COND
[NAMEBODY (COND
[(SETQ N (STRPOS (QUOTE %.)
NAMEBODY))
(SETQ EXT (SUBSTRING NAMEBODY (ADD1 N)))
(SETQ NAME (SUBSTRING NAMEBODY 1 (SUB1 N]
(T (SETQ NAME NAMEBODY)))
(SETQ NAME (PACKFILENAME (QUOTE HOST)
HOST
(QUOTE DIRECTORY)
(CADR (ASSOC (QUOTE DIRECTORY)
PLIST))
(QUOTE NAME)
NAME
(QUOTE EXTENSION)
EXT
(QUOTE VERSION)
(CADR (ASSOC (QUOTE VERSION)
PLIST]
((SETQ NAMEBODY (CADR (ASSOC (QUOTE SERVER-FILENAME)
PLIST)))
(SETQ NAME (PACKFILENAME (QUOTE HOST)
HOST
(QUOTE BODY)
NAMEBODY]
(RETURN (COND
(PRESERVECASE NAME)
(T (U-CASE NAME])
(\FTP.PACK.DIRECTORYNAMEP
[LAMBDA (CONNECTION PLIST) (* bvm: "27-SEP-83 17:52")
(PROG [(DIRECTORY (CADR (ASSOC (QUOTE DIRECTORY)
PLIST]
(RETURN (PACK* (QUOTE {)
(fetch FTPHOST of CONNECTION)
"}"
(COND
(DIRECTORY (CONCAT (QUOTE <)
DIRECTORY
(QUOTE >)))
(T ""])
(\FTP.UNPACKFILENAME
[LAMBDA (FILENAME) (* bvm: "27-OCT-83 15:51")
(PROG ((FIELDS (UNPACKFILENAME FILENAME))
PLIST HOST DIR NAME EXT INFO)
(for TAIL on FIELDS by (CDDR TAIL) do (SELECTQ (CAR TAIL)
(HOST (SETQ HOST (CADR TAIL)))
(DIRECTORY (SETQ DIR (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
(EXTENSION (SETQ EXT (CADR TAIL)))
[VERSION (push PLIST (LIST (QUOTE VERSION)
(CADR TAIL]
NIL))
(RETURN (COND
(HOST [push PLIST (LIST (QUOTE NAME-BODY)
(COND
(EXT (PACK* NAME (QUOTE %.)
EXT))
(T NAME]
[COND
(DIR (push PLIST (LIST (QUOTE DIRECTORY)
DIR]
(CONS HOST (\FTP.ADD.USERINFO PLIST HOST])
(\FTP.ADD.USERINFO
[LAMBDA (PLIST HOST) (* bvm: "27-OCT-83 15:50")
(PROG ((INFO (\INTERNAL/GETPASSWORD HOST)))
(push PLIST (LIST (QUOTE USER-NAME)
(CAR INFO))
(LIST (QUOTE USER-PASSWORD)
(CDR INFO)))
(RETURN PLIST])
(\FTP.FLUSH.TO.EOC
[LAMBDA (INSTREAM ECHOSTREAM) (* bvm: "13-JUN-83 15:36")
(* Eat bytes from the input side of CONNECTION up to next mark, copying bytes to ECHOSTREAM if given, and return T
if the mark is EOC)
(PROG ([STREAM (AND ECHOSTREAM (GETSTREAM ECHOSTREAM (QUOTE OUTPUT]
CH)
(while (NEQ (SETQ CH (BIN INSTREAM))
-1)
do (AND STREAM (\OUTCHAR STREAM CH)))
(RETURN (EQ (FTPGETMARK INSTREAM)
(MARK# EOC])
(\FTP.FLUSH.TO.MARK
[LAMBDA (INSTREAM ECHOSTREAM) (* bvm: " 7-JUL-83 12:08")
(bind CH [STREAM ←(AND ECHOSTREAM (GETSTREAM ECHOSTREAM (QUOTE OUTPUT]
while (NEQ (SETQ CH (BIN INSTREAM))
-1)
do (AND STREAM (\OUTCHAR STREAM CH)))
T])
(\FTPERROR
[LAMBDA (CONNECTION ERRMSG ERRARG) (* bvm: "19-AUG-83 22:16")
(COND
(FTPDEBUGFLG (printout FTPDEBUGLOG T "{FTP Protocol violation, aborted}" T)
(HELP)))
(ENDBSPSTREAM (COND
((type? STREAM CONNECTION)
CONNECTION)
(T (fetch FTPIN of CONNECTION)))
1000)
(COND
(ERRMSG (ERROR (COND
((EQ ERRMSG T)
"FTP Protocol violation")
(T ERRMSG))
ERRARG])
)
(DEFINEQ
(FTPDEBUG
[LAMBDA (FLG REGION) (* bvm: "27-OCT-83 14:57")
(SETQ FTPDEBUGLOG (CREATEW REGION "FTP Debug info"))
[WINDOWPROP FTPDEBUGLOG (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(AND (EQ (WINDOWPROP WINDOW (QUOTE DSP))
FTPDEBUGLOG)
(SETQ FTPDEBUGLOG (SETQ FTPDEBUGFLG NIL]
(SETQ FTPDEBUGLOG (WINDOWPROP FTPDEBUGLOG (QUOTE DSP)))
(DSPFONT (FONTCREATE (QUOTE GACHA)
8)
FTPDEBUGLOG)
(DSPSCROLL T FTPDEBUGLOG)
(SETQ FTPDEBUGFLG T)
FTPDEBUGLOG])
(FTPPRINTMARK
[LAMBDA (MARK) (* bvm: "20-AUG-83 18:59")
[COND
(FTPDEBUGFLG (printout FTPDEBUGLOG "[" (OR (CADR (FASSOC MARK FTPMARKTYPES))
MARK)
"]")
(COND
((EQ MARK (MARK# EOC))
(TERPRI FTPDEBUGLOG]
MARK])
(FTPPRINTCODE
[LAMBDA (CODE NOCODEP) (* bvm: "20-AUG-83 00:12")
(COND
(FTPDEBUGFLG (PRIN1 (QUOTE {)
FTPDEBUGLOG)
(COND
(NOCODEP (PRINTCONSTANT CODE FTPNOCODES FTPDEBUGLOG "\NO."))
(T (PRINTNUM (QUOTE (FIX 1))
CODE FTPDEBUGLOG)))
(PRIN1 (QUOTE })
FTPDEBUGLOG)))
CODE])
(FTPGETMARK
[LAMBDA (STREAM) (* bvm: " 4-JUN-83 21:51")
(bind MARK while (EQ (SETQ MARK (FTPPRINTMARK (BSPGETMARK STREAM)))
(MARK# COMMENT))
do (\FTP.FLUSH.TO.MARK STREAM) finally (RETURN MARK])
(FTPPUTMARK
[LAMBDA (STREAM MARK) (* bvm: "12-MAY-83 10:24")
(BSPPUTMARK STREAM (FTPPRINTMARK MARK])
(FTPPUTCODE
[LAMBDA (STREAM CODE NOCODEP) (* bvm: "20-AUG-83 00:12")
(BOUT STREAM (FTPPRINTCODE CODE NOCODEP])
(FTPGETCODE
[LAMBDA (STREAM NOCODEP) (* bvm: "20-AUG-83 00:17")
(FTPPRINTCODE (BIN STREAM)
NOCODEP])
(FLUSH.FTPCONNECTIONS
[LAMBDA NIL (* bvm: "14-JUN-83 12:35")
(while \FTPCONNECTIONS do (CLOSEBSPSTREAM (fetch FTPIN of (CAR \FTPCONNECTIONS))
11610Q])
)
(ADDTOVAR \FTPCONNECTIONS )
(RPAQ? FTPDEBUGLOG )
(RPAQ? FTPDEBUGFLG )
(RPAQ? \FTPAVAILABLE )
(RPAQ? \FTP.IDLE.TIMEOUT 120000)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ FTPMARKTYPES ((1 RETRIEVE)
(2 STORE)
(3 YES)
(4 NO)
(5 HERE-IS-FILE)
(6 EOC)
(7 COMMENT)
(8 VERSION)
(9 NEW-STORE)
(10 ENUMERATE)
(11 HERE-IS-PLIST)
(12 NEW-ENUMERATE)
(14 DELETE)
(15 RENAME)
(16 STORE-MAIL)
(17 RETRIEVE-MAIL)
(18 FLUSH-MAILBOX)
(19 MAILBOX-EXCEPTION)
(253 NOTAMARK)
(254 BROKEN)))
(DECLARE: EVAL@COMPILE
(RPAQQ \FTP.VERSION 1)
(CONSTANTS \FTP.VERSION)
)
(RPAQQ FTPNOCODES ((\NO.UNIMPLEMENTED 1)
(\NO.PROTOCOL.ERROR 3)
(\NO.BAD.PLIST 8)
(\NO.ILLEGAL.DIRECTORY 10)
(\NO.ILLEGAL.NAME.ERRORS (QUOTE (9 10 11 12 25)))
(\NO.ILLEGAL.USERNAME 16)
(\NO.ILLEGAL.USERPASSWORD 17)
(\NO.ILLEGAL.CONNECTNAME 19)
(\NO.ILLEGAL.CONNECTPASSWORD 20)
(\NO.FILE.NOT.FOUND 64)
(\NO.FILE.PROTECTED 65)
(\NO.BAD.TRANSFER.PARMS 66)
(\NO.DISK.ERROR 67)
(\NO.STORAGE.FULL 68)
(\NO.FILE.BUSY 73)
(\NO.RENAME.DESTINATION.EXISTS 74)))
(DECLARE: EVAL@COMPILE
(RPAQQ \NO.UNIMPLEMENTED 1)
(RPAQQ \NO.PROTOCOL.ERROR 3)
(RPAQQ \NO.BAD.PLIST 8)
(RPAQQ \NO.ILLEGAL.DIRECTORY 10)
(RPAQQ \NO.ILLEGAL.NAME.ERRORS (9 10 11 12 25))
(RPAQQ \NO.ILLEGAL.USERNAME 16)
(RPAQQ \NO.ILLEGAL.USERPASSWORD 17)
(RPAQQ \NO.ILLEGAL.CONNECTNAME 19)
(RPAQQ \NO.ILLEGAL.CONNECTPASSWORD 20)
(RPAQQ \NO.FILE.NOT.FOUND 64)
(RPAQQ \NO.FILE.PROTECTED 65)
(RPAQQ \NO.BAD.TRANSFER.PARMS 66)
(RPAQQ \NO.DISK.ERROR 67)
(RPAQQ \NO.STORAGE.FULL 68)
(RPAQQ \NO.FILE.BUSY 73)
(RPAQQ \NO.RENAME.DESTINATION.EXISTS 74)
(CONSTANTS (\NO.UNIMPLEMENTED 1)
(\NO.PROTOCOL.ERROR 3)
(\NO.BAD.PLIST 8)
(\NO.ILLEGAL.DIRECTORY 10)
(\NO.ILLEGAL.NAME.ERRORS (QUOTE (9 10 11 12 25)))
(\NO.ILLEGAL.USERNAME 16)
(\NO.ILLEGAL.USERPASSWORD 17)
(\NO.ILLEGAL.CONNECTNAME 19)
(\NO.ILLEGAL.CONNECTPASSWORD 20)
(\NO.FILE.NOT.FOUND 64)
(\NO.FILE.PROTECTED 65)
(\NO.BAD.TRANSFER.PARMS 66)
(\NO.DISK.ERROR 67)
(\NO.STORAGE.FULL 68)
(\NO.FILE.BUSY 73)
(\NO.RENAME.DESTINATION.EXISTS 74))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS MARK# MACRO [X (OR [CAR (find M in FTPMARKTYPES suchthat (EQ (CADR M)
(CAR X]
(HELP "Unknown mark type" (CAR X])
(PUTPROPS .EOC. MACRO ((STREAM)
(FTPPUTMARK STREAM (MARK# EOC))))
(PUTPROPS .FTPDEBUGLOG. MACRO (NIL (AND FTPDEBUGFLG FTPDEBUGLOG)))
)
[DECLARE: EVAL@COMPILE
(RECORD FTPCONNECTION (FTPIN FTPOUT FTPHOST FTPBUSY FTPCURRENTFILE))
(ACCESSFNS FTPSTREAM ((FTPFILEPROPS (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE)))
(SYNONYM FTPFILEPROPS (FTPOPENP)))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS FTPDEBUGFLG \FTPCONNECTIONS \FTPAVAILABLE \FTP.IDLE.TIMEOUT)
)
(FILESLOAD (LOADCOMP)
BSP)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\FTPINIT)
)
(PUTPROPS DPUPFTP COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1696 24750 (\FTPINIT 1706 . 2430) (\FTP.OPENFILE 2432 . 4364) (\FTP.OPENFILE.FROM.PLIST
4366 . 7221) (\FTP.GETFILEPTR 7223 . 7488) (\FTP.SETFILEPTR 7490 . 7977) (\FTP.GETFILENAME 7979 .
8131) (\FTP.RECOGNIZEFILE 8133 . 10542) (\FTP.DIRECTORYNAMEP 10544 . 10725) (\FTP.CLOSEFILE 10727 .
12710) (\FTP.RENAMEFILE 12712 . 14177) (\FTP.DELETEFILE 14179 . 16443) (\FTP.GENERATEFILES 16445 .
20647) (\FTP.NEXTFILE 20649 . 23209) (\FTP.GETFILEINFO 23211 . 23526) (\FTP.GETFILEINFO.FROM.PROPS
23528 . 24521) (\FTP.GETDATEPROP 24523 . 24748)) (24751 33423 (\FTP.OPEN.CONNECTION 24761 . 25727) (
\FTP.SENDVERSION 25729 . 26284) (\FTP.WHENCLOSED 26286 . 26733) (\GETFTPCONNECTION 26735 . 27879) (
\RELEASE.FTPCONNECTION 27881 . 28052) (\FTP.ERRORHANDLER 28054 . 30132) (\FTP.FIX.BROKEN.INPUT 30134
. 31795) (\FTP.CLEANUP 31797 . 33172) (\FTP.ASSURE.CLEANUP 33174 . 33421)) (33424 42273 (
\FTP.HANDLE.NO 33434 . 36597) (\FTP.DIRECTORYNAMEONLY 36599 . 36851) (\FTP.EOL.FROM.PLIST 36853 .
37198) (\FTP.MAKEPLIST 37200 . 37665) (\FTP.PRINTPLIST 37667 . 38432) (\FTP.PACKFILENAME 38434 . 39421
) (\FTP.PACK.DIRECTORYNAMEP 39423 . 39799) (\FTP.UNPACKFILENAME 39801 . 40634) (\FTP.ADD.USERINFO
40636 . 40944) (\FTP.FLUSH.TO.EOC 40946 . 41479) (\FTP.FLUSH.TO.MARK 41481 . 41787) (\FTPERROR 41789
. 42271)) (42274 44518 (FTPDEBUG 42284 . 42830) (FTPPRINTMARK 42832 . 43146) (FTPPRINTCODE 43148 .
43515) (FTPGETMARK 43517 . 43802) (FTPPUTMARK 43804 . 43959) (FTPPUTCODE 43961 . 44118) (FTPGETCODE
44120 . 44276) (FLUSH.FTPCONNECTIONS 44278 . 44516)))))
STOP