Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
stanford/ftp/tcpftp.mac
There are 3 other files named tcpftp.mac in the archive. Click here to see a list.
;<FTP>TCPFTP.MAC.309, 27-Apr-85 13:15:38, Edit by LOUGHEED
; To avoid error handler loops, TCPERR doesn't try to send a QUIT
;<FTP>TCPFTP.MAC.308, 20-Apr-85 12:36:06, Edit by LOUGHEED
; TCPCLS is a no-op if no connection is open yet. Prevents LUUO
; routines from erring ungracefully when a connection attempt fails.
;<FTP>TCPFTP.MAC.307, 12-Feb-85 21:31:15, Edit by LOUGHEED
; From Rutgers:
; - if we don't know the O/S, default to text mode
; - Print out a TOPS-20 file's protection on a SEND/GET
;<FTP>TCPFTP.MAC.306, 29-Oct-84 16:27:01, Edit by LOUGHEED
; From Rutgers: make CTRL-G work during a directory listing
;<FTP>TCPFTP.MAC.305, 15-Oct-84 12:55:06, Edit by LOUGHEED
; Support more operating systems
;<FTP>TCPFTP.MAC.304, 2-Oct-84 09:24:27, Edit by SATZ
; Move STTXT8 routine to FTP.MAC
;<FTP>TCPFTP.MAC.303, 17-Sep-84 02:03:02, Edit by LOUGHEED
;<FTP>TCPFTP.MAC.302, 17-Sep-84 01:29:31, Edit by LOUGHEED
; Fix TCPSCF to handle SENDS.TXT.1;T as a single filename, instead of
; one filename with generations "1" and "T".
; For UNIX a DIRECTORY command with no argument uses "*" instead of "."
; as the default pathname.
;<FTP>TCPFTP.MAC.301, 16-Sep-84 18:38:19, Edit by LOUGHEED
; Fix TCPFXN to wildcard a TOPS-20 filename extension if none was specified
;<FTP>TCPFTP.MAC.300, 16-Sep-84 14:54:31, Edit by LOUGHEED
; Default transfer type for Multics is stream mode ASCII
;<FTP>TCPFTP.MAC.299, 4-Sep-84 01:29:35, Edit by LOUGHEED
; Support for automatic ANONYMOUS login if F%ANON set, no username has
; been specified, and there is no default username for that site.
;<FTP>TCPFTP.MAC.298, 4-Sep-84 00:41:17, Edit by LOUGHEED
; Call TIMEIN before TCDSND to get correct timing statistics for SEND
;<FTP>TCPFTP.MAC.297, 3-Sep-84 14:45:27, Edit by KRONJ
; Make GET use transfer type given in FILPRP not DEFPRP
; Save a bunch of registers in TCPGET and TCPSND
; Change calling conventions of TCPSCN and TCPPRP
;<FTP>TCPFTP.MAC.296, 3-Sep-84 14:29:13, Edit by LOUGHEED
; Default transfer type for ITS operating systems is 36-bit binary
;<FTP>TCPFTP.MAC.295, 31-Aug-84 15:25:37, Edit by SATZ
; Make setting default transfer information protocol dependant
;<FTP>TCPFTP.MAC.294, 28-Aug-84 00:41:14, Edit by SATZ
; Open the TCP FTP command connection in interactive wait mode
;<FTP>TCPFTP.MAC.293, 25-Aug-84 16:23:16, Edit by LOUGHEED
;<FTP>TCPFTP.MAC.292, 25-Aug-84 15:50:41, Edit by LOUGHEED
;<FTP>TCPFTP.MAC.291, 25-Aug-84 14:32:40, Edit by LOUGHEED
; Support QUOTE command
;<FTP>TCPFTP.MAC.290, 24-Aug-84 14:51:07, Edit by SATZ
; TENEX doesn't always output author/last write for STAT
;<FTP>TCPFTP.MAC.289, 24-Aug-84 14:43:24, Edit by SATZ
; Change SKTERS to SKVERB in TCPPRE so errors will be output
;<FTP>TCPFTP.MAC.288, 20-Aug-84 23:04:32, Edit by SATZ
; Make Unix default directory more intelligent
;<FTP>TCPFTP.MAC.287, 20-Aug-84 21:08:14, Edit by KRONJ
; CWD only needs one space before dir spec
;<FTP>TCPFTP.MAC.286, 26-Apr-84 14:45:48, Edit by KRONJ
; Use OPNSTO, now available in FTPUTL, for PRINT
;<FTP>TCPFTP.MAC.285, 31-Mar-84 17:07:07, Edit by LOUGHEED
; Fix credits.
;<FTP>TCPFTP.MAC.284, 30-Mar-84 15:59:41, Edit by KRONJ
; Extend sign of version in TCPFXN
SEARCH FTPDEF
TTITLE(TCPFTP, -- User-PI for TCP FTP)
SUBTTL David Eppstein / Stanford University / January, 1984
;; Frank M. Fujimoto was responsible for a preliminary version
;; of this FTP module.
;;
;; Copyright (C) 1984 Board of Trustees, Stanford University
;; The information in this software is subject to change without
;; notice and should not be construed as a commitment by Stanford
;; University. Stanford assumes no responsibility for the use or
;; reliability of this software.
.REQUIRE TCPDAT ; Data transfer protocol routines
EXTERN HSTNUM,HSTSTR,SNDCNF,RECFIL,TIMEIN,FILOUT,DELCNF,KILFIL
EXTERN USRNAM,USRACT,USRPSW,CONNAM,STRCMP,CHKDSK,SKPDIR,JFNVRS
EXTERN OPSYS,FRECOR,FORMAT,R2SKIP,PUSHIO,FILEIN,FILOUT,TMPPRP
EXTERN LOGCMD,SETCMD,SAVPDL,DOCONF,GETPSW,COMLP,EDISC,DISCON
EXTERN DIRJFN,TYPBUF,FILJFN,NETJFN,MULGET,NOUPDA,NXTFIL
EXTERN FILPRP,DEFPRP,DIRPNT,TEMP,NETBUF,TIMOUT,OPNSTO
EXTERN TCDOPN,TCXCLS,TCPSET,TCDREC,TCDSND,TCPZRO,DOANON
EXTERN STPAGE,ST36BN,STNOPG,STIMAG,STTEXT,STTXT8
DEFINE FTPM (STRING) <UFTPM [ASCIZ\STRING\]>
TCPVEC::TCPCLS ; .CLOSE - close connection
TCPOPN ; .OPEN - open connection
TCPLGN ; .LOGIN - TCP login
TCPCWD ; .CWDIR - connect to directory
TCPCFL ; .CFLAG - set connection flags
TCPOPS ; .OPSYS - look up operating system
TCPSND ; .SEND - send a file
TCPGET ; .RECV - receive a file
TCPDEL ; .DELFL - delete a file
TCPPNT ; .PRINT - print on lineprinter
TCPRNM ; .RENAM - change name of a remote file
TCPDIR ; .DIREC - directory of remote files
TCPPSK ; .PARSK - Parse socket in OPEN
TCPFTM ; .UFTPM - Protocol-dependant yoyo
TCPSTS ; .STAT - Connection-dependant info
TCPQUO ; .QUOTE - quote command
TCPDEF ; .SDEFS - Setup defaults based on opsys
CHKVEC TCPVEC ; Make sure vector is right
BUFLEN==100 ; Length for buffers
LS TCPFNP ; Remote port number if user wants other than 21
; .CLOSE - close a connection
TCPCLS: TXNN F,F%COPN ; Open connection?
RET ; No, return now
SAVEAC <A,B,C>
FTPM <QUIT> ; Tell server bye bye
DO.
CALL TCPRSP ; Get the response
NOP ; Ignore errors
NOP ; Shouldnt get "not logged in error" but ignore
CAIE A,^D221 ; Is it what we expected?
IFSKP.
SKTERS VB.VRB ; Yes, if being verbose
CALL TCPTFM ; Then type farewell message
ELSE.
TYPE <%% Unexpected response [%1D] %3S%/>
ENDIF.
CAIN B,"-" ; Continued?
LOOP. ; Yes, get continuation
ENDDO.
; Here when want to close connection without sending QUIT
TCPCLZ: CALL TCXCLS ; Flush data connection if still there
MOVE A,NETJFN ; Get net connection
CALL TCPBIN ; Do protocol one last time
IFSKP.
TYPE <%% Garbage at end of TELNET connection%/>
DO.
CALL TCPBIN ; Get another char
IFSKP. <LOOP.> ; Back until no more
ENDDO.
ENDIF.
CLOSF% ; Close the connection
IFJER.
TYPE <%% Unexpected error closing connection - %J%/>
MOVE A,NETJFN ; Get connection again
HRLI A,(CZ%ABT) ; Aborting
CLOSF% ; Try this close
NOP ; Ignore more errors
ENDIF.
TXZ F,F%COPN ; Flag we don't have an open connection
RET
; .OPEN - open a connection
LS LCLPRT ; Local port, also used to open data conn
TCPOPN: SAVEAC <A,B,C,D> ; Save some registers
SETZM LCLPRT ; No port yet
MOVX A,.HPELP ; Time since system was up in 10's of usec's
HPTIM% ; Get high precision time
JFATAL ; Some strange error
DPB A,[POINT 8,LCLPRT,35] ; Use time as low byte
GJINF% ; Get job information
DPB C,[POINT 8,LCLPRT,27] ; Use job number as high byte
HRROI A,NETBUF ; Use this buffer area
MOVE B,LCLPRT ; Get port number
MOVE C,HSTNUM ; Foreign host number
MOVE D,TCPFNP ; Foreign socket number
WRITE <TCP:%2D.%3O-%4D;CONNECTION:ACTIVE;PERSIST:30> ; Make JFN string
MOVX A,GJ%SHT ; Short form of GTJFN%
HRROI B,NETBUF ; Filestring
GTJFN% ; Get a handle on the connection
JRST TO.ER2 ; Couldn't
MOVEM A,NETJFN
MOVE B,[FLD(8,OF%BSZ)!FLD(.TCMWI,OF%MOD)!OF%RD!OF%WR]
OPENF% ; Open the connection
JRST TO.ERR ; Couldn't
;; Connection open, read server banner
DO.
CALL TCPRSP ; Get the response
JRST TCPCLS ; Failure response??? Shut down
LOOP. ; Login required??? Get new response
CAIE A,^D120 ; Expected server delay?
IFSKP.
SKTERS VB.VRB ; Being verbose?
CALL TCPTFM ; Yes, type delay message
LOOP. ; And go get more banner
ENDIF.
CAIN A,^D220 ; Open acknowledgement?
IFSKP.
TYPE <%% Unexpected response [%1D] %3S%/>
LOOP. ; Oh well, try for another
ENDIF.
SKTERS VB.NRM ; Unless terse
CALL TCPTFM ; Show the reply
CAIN B,"-" ; Continuation line?
LOOP. ; Yes, loop
ENDDO.
;; Banner read, now finish setting up connection
TXO F,F%COPN ; Say we have an open connection
HRRZS MULGET ; Assume we can use MULTIPLE GET (NLST)
SETZM TCPUSR ; No user name yet
SETZM TCPORS ; No old response waiting to be finished
CALL TCPZRO ; Clear data transmisssion variables
RETSKP ; Go back winningly
; Here when the GTJFN or OPENF failed, print error and return failure
TO.ERR: EXCH A,NETJFN ; Some failure, get back JFN
RLJFN% ; Release it
NOP ; Ignore an error here
MOVE A,NETJFN ; Get error code back
SETZM NETJFN ; Say no more JFN
TO.ER2: HRROI B,HSTSTR
ETYPE <Couldn't connect to %2S - %1J%/>
RET ; Return failure from OPEN
; .LOGIN - Check logged in user name
LS TCPUSR,USRSTL ; Place to store user names for comparison
TCPLGN: SAVEAC <A,B,C>
HRROI A,USRNAM ; Pointer to the username
HRROI B,TCPUSR ; And what we think we are logged in as
CALL STRCMP ; See if same
IFSKP. <RETSKP> ; Is, don't try to log in as this again
HRROI A,USRNAM ; Else get string for user name again
FTPM <USER %1S> ; Want to login a user
TL.RTY: CALL TCPRSQ ; Get the response
JRST TCPRLG ; 530 error aborted or error other than 530
RETSKP ; Got 530 response, now handled
CAIN A,^D331 ; Need password?
JRST TL.PAS ; Yes
CAIN A,^D332 ; Need account?
JRST TL.ACT ; Yes
CAIE A,^D230 ; Login Ok?
CAIN A,^D202 ; Or not implemented but ok???
IFSKP. ; No, protocol violation
TYPE <%% Unexpected response [%1D] %3S%/>
JRST TL.RTY ; Try for something more reasonable
ENDIF.
SKTERS VB.NRM ; If not terse
CALL TCPTFM ; Type success message
CAIN B,"-" ; Continued?
JRST TL.RTY ; Yes get continuation
HRROI A,TCPUSR ; Into our user string
HRROI B,USRNAM ; With user name
WRITE <%2S> ; Copy strings
RETSKP ; All done successfully
; Here when response is "331 User name okay, need password"
TL.PAS: SKTERS VB.VRB ; Being verbose?
CALL TCPTFM ; Yes, type message
CAIN B,"-" ; Continued?
JRST TL.RTY ; Yes, get continuation
DO.
MOVE A,[POINT 7,USRPSW] ; Point to password
ILDB A,A ; Get first byte
JUMPN A,ENDLP. ; If have a password, done
HRROI A,USRPSW ; Point to where to look
HRROI B,USRNAM ; Location to clear on abort
CALL GETPSW ; Get a password
RET ; Propagate failure
LOOP. ; Try this one for nullity
ENDDO.
HRROI A,USRPSW ; Point to password
FTPM <PASS %1S> ; Send it off
JRST TL.RTY ; Wait for another response
; Here when response is "332 Need account for login"
TL.ACT: SKTERS VB.VRB ; Being verbose?
CALL TCPTFM ; Yes, type message
CAIN B,"-" ; Continued?
JRST TL.RTY ; Yes, get continuation
HRROI A,USRACT ; Point to account string
FTPM <ACCT %1S> ; Send it off
JRST TL.RTY ; Wait for another response
; Routines to be called from elsewhere to retry login
; Here when we get a 530 or a failure in the LOGIN command, try again
; returns +2/always (jumps to command loop on failure)
; should not have printed error before calling this
TCPRL1: CALL TCPRSQ ; Here with another response
IFSKP. <RETSKP> ; +2, return success, otherwise (+1, +3) go on
TCPRLG: CALL TCPTFQ ; Report error
CAIN B,"-" ; Continued?
JRST TCPRL1 ; Yes, get continuation
DO.
SKIPE TCPUSR ; Got a user?
RETSKP ; Yah, keep it
CALL DOANON ; Perhaps we should try ANONYMOUS login?
LOOP. ; Yes, see if we have a user now
CALL PUSHIO ; Make sure talking to the terminal
SETZM USRNAM ; Remember not yet logged in
PROMPT [ASCIZ \LOGIN (user) \] ; Create a prompt
SETABORT (COMLP) ; If we abort, throw all the way to top level
CALL SETCMD
MOVE P,SAVPDL
CALL LOGCMD ; Try to login again
CLRABORT
LOOP. ; Try again, checking if we have a user yet
ENDDO.
; Here when we think we might have a 332 "need account" message
; e.g. call this immediately after the TCPRSP for a STOR command
; Enter at TCPRSA to do a TCPRSP first. Same return conventions as TCPRSP.
TCPRSA: CALL TCPRSP ; Read more response
RET ; Bad, propagate
RETSKP ; Needed to be logged in but Ok now, retry
CAIE A,^D332 ; 332?
JRST R2SKIP ; No, all right so leave alone and return
TCPACT: SKTERS VB.VRB ; If verbose
CALL TCPTFM ; Type out
CAIN B,"-" ; Continued?
JRST TCPRSA ; Yes, get continuation
HRROI A,USRACT ; Point to account string
FTPM <ACCT %1S> ; Send it off
CALL TCPRSQ ; Go read reply
JRST TCPRLG ; Lost, try getting a new account
RETSKP ; Something else wrong but all fixed now
JRST R2SKIP ; +3 success, propagate
; .CWDIR - Check connected directory
TCPCWD: SAVEAC <A,B,C> ; Save some AC's
TC.RTY: HRROI A,CONNAM ; Pointer to the dir name
FTPM <CWD %1S> ; Say we want to connect
TC.RSP: CALL TCPRSA ; Get the response
RET ; Lose
JRST TC.RTY ; Retry
;; Normally we would check here for the numeric code returned.
;; However some servers are flaky in this respect; for instance
;; The TOPS-20 server will give 331 ostensibly asking for a password
;; But if you give it one will say "password? what's this for?".
;; There is no way included in the standard for giving a password
;; and the return code here is likely to be strange, so I'll just
;; Assume that since it isn't a 500 code it means success.
SKTERS VB.NRM ; Unless terse
CALL TCPTFM ; Print out confirmation message
CAIN B,"-" ; Continued?
JRST TC.RSP ; Yes, type another one
RETSKP ; Good return to caller
; .CFLAG - set flags for connection
TCPCFL: RET ; No checksumming or other such flags
; .OPSYS - Look up operating system type, return +1 with number in A
TCPOPS: SAVEAC <B,C,D>
MOVX A,.GTHHN ; Want status
MOVE C,HSTNUM ; Get host number
GTHST% ; Try to get it
TDZA A,A ; Probably bad host number, set to unknown
LOAD A,HS%STY,D ; Got information, extract system type
SKIPL A ; If negative
CAILE A,OS.MAX ; Or bigger than greatest known opsys
MOVX A,OS.UNK ; Then set to unknown
RET ; Go back
; .SDEFS - setup default transfer info based on operating system
TCPDEF: MOVE A,OPSYS ; Get host info pointer
CALLRET @[ STTEXT ; Unknown
STPAGE ; Tenex, normal paging
ST36BN ; ITS, 36-bit binary
ST36BN ; TOPS-10 and WAITS, 36-bit binary
STTEXT ; TIP???
STTEXT ; MTIP???
STTEXT ; ELF???
STTEXT ; ANTS???
STTEXT ; MULTICS, stream mode text
STPAGE ; TOPS-20
STTXT8 ; UNIX
STTEXT ; Network???
STTEXT ; Fuzzballs???
STTXT8 ; VMS
STTEXT ; TAC???
STTEXT ](A) ; MS-DOS
; .SEND - send file to remote filesystem
TCPSND: SAVEAC <A,B,C,D,P1,P2> ; Save caller registers
CALL TCPSTU ; Can use STAT to get file properties?
IFSKP.
CALL TS.PRP ; Yes, get them
JRST TS.SKR ; Bad filename, give up
ELSE.
HRROI A,[ASCIZ/Can't get file properties/]
CALL NOUPDA ; STAT not available, make sure not INSTALL
ENDIF.
CALL TCPSET ; Set up modes and types
JRST TS.RET ; Lost, don't try again
CALL TCDOPN ; Make sure data conn is open
JRST TS.RET ; Lost
; Here to send off STOR command
TS.RTY: CALL TCPFXN ; Get filename to send
FTPM <STOR %2S> ; Ask to send it
TS.RSP: CALL TCPRSA ; Get response
JRST TS.SKR ; Lost, ignore this file
JRST TS.RTY ; Retry
SKTERS VB.VRB ; Success. Verbose?
CALL TCPTFM ; Yes, type reply
CAIN B,"-" ; Continued?
JRST TS.RSP ; Yes, get rest
IFVERB VB.NRM ; If at least normal verbosity
SKTERS VB.DEB ; But not debugging
ANSKP.
MOVE A,OPSYS ; If TOPS-20, use real dest file spec
CAIN A,OS.T20
CALL TCPF20
CALL TCPFXN ; With name we asked for
HRRZ A,FILJFN ; and JFN we are sending
TYPE( %1F => %2S ) ; Make start of message
ENDIF.
CALL TIMEIN ; Start collecting timing statistics
CALL TCDSND ; Send data to net
IFSKP.
HRRZ A,FILJFN ; Get local file
CALL TIMOUT ; Finish stat timing.
ENDIF.
; Here to return from send command
TS.SKR: AOS (P) ; Set up success return
TS.RET: MOVE A,FILJFN ; Get JFN again
HRLI A,(CO%NRJ) ; Not releasing JFN, just closing
CLOSF% ; Close it
TYPE <%_%% Unlikely failure to close SEND source - %J%/>
RET ; All done
; SEND continued
; Here to read file properties when SMART-DIRECTORY available
; returns +1/bad, ignore this file, +2/ok
TS.PRP: CALL TCPFXN ; Get filename again
MOVE A,[POINT 7,TEMP] ; Point to temporary buffer
MKPTR(B) ; Make a real byte pointer
;; Want to strip off generation and replace with zero - first find it
;; TXPFXN guarantees a generation so we just look for last . or ;
SETZ D, ; No pointer found yet
DO.
ILDB C,B ; Get char
IDPB C,A ; Drop in
CAIE C,"." ; Period
CAIN C,";" ; or semi?
MOVE D,A ; Yes, copy pointer
JUMPN C,TOP.
ENDDO.
;; Make sure we really got a generation
IFE. D
CALL TCPFXN ; Get name we would use
TYPE <%_%% Bad remote file name - no version - "%2S"%/>
RET
ENDIF.
;; Get version number from string for later
MOVE A,D ; Copy pointer
MOVEI C,^D10 ; Decimal
NIN% ; Read filename
IFJER.
TYPE <%_%% Bad remote file version - %J - "%4S"%/>
RET
ENDIF.
IFLE. B ; If not particularly specified
SKIPN FILPRP+P.VERS ; See if what we have is any better
SETOM FILPRP+P.VERS ; -1 is better than 0, so use that
ELSE.
MOVEM B,FILPRP+P.VERS ; We have a real version, so use it
ENDIF.
;; Now we can write over old version
MOVEI C,.CHNUL ; Get a null
IDPB C,D ; Drop over version string
; Here to ask for remote filespec
TS.PRS: HRROI A,TEMP ; Point to filename we made
FTPM <STAT %1S0> ; Ask for version zero
TS.PRR: CALL TCPRSQ ; Get response
JRST TS.PRF ; Lost, probably means doesn't already exist
JRST TS.PRS ; Retry
CAIN B,"-" ; Continued?
JRST TS.PRR ; Yes, only want one line
CAIN A,^D212 ; Wildcard return?
JRST TS.PRW ; Yes, go complain
CAIE A,^D213 ; Strange status?
JRST TS.PRB ; Yes, bad response
;; Got a nice 213 response, scan it for properties
MOVEI P2,TMPPRP ; Get temporary property list
CALL TCPPRP ; Scan property list
JRST TS.PRE ; Lost
MV. TMPPRP+P.WDAT,FILPRP+P.PWDT ; Copy write to previous-write
;; Now make sure install is Ok
MOVEI D,FILPRP ; With file prop list (where write date put)
CALL SNDCNF ; Confirm send
RET ; Not confirmed, skip this file
;; Canonicalize filespec for prettyprinting
MOVX A,GJ%SHT!GJ%OFG ; Short form, unchecked wildcard filespec
HRROI B,TMPPRP+P.SFIL ; With filename we read in
GTJFN% ; Get JFN
RETSKP ; Lost, give up on canonicalization
MOVE B,A ; Move JFN to appropriate place
HRROI A,FILPRP+P.SFIL ; Into file name we want to use
MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!JS%PAF
JFNS% ; Make string for JFN
ERNOP ; Ignore failure
MOVE A,B ; Move JFN back
RLJFN% ; Flush the JFN
TYPE <%_%% Unlikely failure to close default file - %J%/>
RETSKP ; Say to send the file
; Here when we couldn't read the property list from the STAT reply
TS.PRB: TYPE <%% Unexpected STAT reply [%1D] %3S%/>
TS.PRE: HRROI A,[ASCIZ/Error reading file properties/]
CALL NOUPDA ; Make sure this isn't INSTALL
RETSKP ; Get the file
; Here when we got a wildcard response to our STAT
; Don't even try to send the string through in a STOR command
TS.PRW: HRROI A,TEMP ; Point to the filename we used
MOVE B,FILPRP+P.VERS ; Get version
ETYPE <Invalid use of wildcards - "%1S%2D"%/>
RET ; Give up on this file
; Here when we got failure response to our STAT
; Assume it means file does not already exist
TS.PRF: CAIN B,"-" ; Continued?
JRST TS.PRR ; Yes, get rest
RETSKP ; No, just get the file
; .RECV - retrieve file from remote file system
TCPGET: SAVEAC <A,B,C,D,P1,P2> ; Don't mung caller registers
CALL TCPSTU ; Can use smart directory stuff?
IFSKP.
MOVE A,[FILPRP,,TMPPRP] ; Set up for BLT
BLT A,TMPPRP+PLSIZE-1 ; Save this transfer's props in a safe place
MOVE P2,[TMPPRP,,FILPRP] ; Set up where to copy properties
JSP P1,TCPSCN ; Scan filenames matching spec
CALL TG.NNL ; Retrieve one file from name in FILPRP
RET ; All done, go on
ENDIF.
;; Here for normal get w/o STAT - check if we want to use NLST
HRROI A,[ASCIZ/Can't get file properties/]
CALL NOUPDA ; Let user know that UPDATE will lose
SKIPL B,MULGET ; Get MULTIPLE GET status
CAIN B,MG.OFF ; Turned off?
JRST TG.NNL ; Off or host can't handle, don't use NLST
CAIN B,MG.HEU ; Heuristic?
JRST TG.HEU ; Yes, use that
; We don't know that the host will barf on it, so we try doing a MULTIPLE GET
; using NLST first. I suppose we could run some heuristic on stars in the
; filename before doing this to avoid two data transfers for every file
; transfer, but that doesn't seem useful or necessary.
TG.TNL: STKVAR <OLDTYP,OLDXTY> ; Place to save old transfer type
MV. FILPRP+P.TYPE,OLDTYP ; Save it
MV. FILPRP+P.XTYP,OLDXTY ; And remote copy of same
MVI. TT.TXT,FILPRP+P.TYPE ; Set up transfer type as text
MVI. TT.TXT,FILPRP+P.XTYP ; Set up transfer type as text
HRRO A,FRECOR ; Point to free storage
MOVEM A,FILJFN ; Use as destination (yes string ptr works)
CALL TCPSET ; Set up connection parameters
RET ; Lost
CALL TCDOPN ; Get the data port
RET ; Didn't work
; Here to send off the NLST command
TG.NLS: CALL TCPFXN ; Point to filename
FTPM <NLST %2S> ; Ask for list of file names
; Here to read the reply
TG.NLR: CALL TCPRSQ ; Quiet response
JRST TG.NLE ; Failure, maybe NLST is unimplemented
JRST TG.NLS ; Retry
CAIN B,"-" ; Continued?
JRST TG.NLR ; Yes, get continuation
ABTSET ; Be able to notice aborts
TXOE F,F%STYO ; Suppress typeout
TXOA F,F%NPRF ; Was on, remember so
TXZ F,F%NPRF ; Not on
TXZ F,F%DSKF ; To memory, so don't try to treat as disk
CALL TCDREC ; Receive listing
RET ; Failure, give up
TXZN F,F%NPRF ; Was F%STYO on before?
TXZ F,F%STYO ; No so turn it off again
MV. OLDTYP,FILPRP+P.TYPE ; Get transfer type back
MV. OLDXTY,FILPRP+P.XTYP ; and remote transfer type
;; Now we have a list of filenames in core - read in one at a time
MOVE A,FRECOR ; Point to top of core again
HRLI A,(POINT 7) ; As a byte pointer
MOVEM A,TCPFNP ; Save file name pointer
DO.
ABTSKIP ; Aborted?
CALL TG.NL1 ; Do one line
RET ; All done
MOVE A,TCPFNP ; Get next pointer
LOOP. ; Back for more
ENDDO.
; GET continued
; Here with A,TCPFNP/pointer to line of filename
; retrieve that filename, return +1/nothing left, +2/try again
TG.NL1: ILDB B,A ; Get next char
JUMPE B,R ; If null then give up
CAIE B,.CHCRT ; Carriage return?
JRST TG.NL1 ; No, more to come
SETZ B, ; Yes, get a null
DPB B,A ; And drop over it
IBP A ; Skip over linefeed
EXCH A,TCPFNP ; Save new pointer and get old again
AOS (P) ; Set up skip return
JRST TG.FIL ; Go get file
; Here when MULGET contains MG.HEU
; check over file name for possible wildcards and decide
; whether or not to use MULTIPLE GET on that basis.
TG.HEU: MOVE A,[POINT 7,FILPRP+P.SFIL] ; Point to filename
DO.
ILDB B,A ; Get character
JUMPE B,TG.NNL ; Null means no wildcards, do just one file
CAIE B,"*" ; This wildcard
CAIN B,"%" ; Or this wildcard?
JRST TG.TNL ; Yes, use MULTIPLE GET
LOOP. ; Not interesting, back for another char
ENDDO.
; Here with failure response from NLST, see whether unimplemented
; or whether filename or some such is bad.
TG.NLE: CAIE A,^D500 ; Unimplemented
CAIN A,^D502 ; Or this unimplemented?
IFSKP.
CALL TCPTFQ ; No, type failure response
CAIN B,"-" ; Continued?
JRST TG.NLR ; Yes, get rest
RET ; Return failure from command
ENDIF.
CAIN B,"-" ; Continued?
JRST TG.NLR ; Yes, get rest
HRROS MULGET ; Can't use NLST any more
JRST TG.NNL ; Go get the file
; GET continued
; Here to get one file, byte (well actually HRROI) pointer to filename in A
; enter at TG.NNL when FILPRP+P.SFIL is already set up.
; returns +1/always
TG.FIL: HRROI B,FILPRP+P.SFIL ; Into server filename
WRITE B,<%1S> ; Copy name we have
TG.NNL: MOVEI A,^D8 ; Get number of bits
SKIPN FILPRP+P.BYTE ; To use if byte size unspecified
MOVEM A,FILPRP+P.BYTE ; Was, set 8 bits
CALL RECFIL ; Ask FTP.MAC for a JFN
RET ; Didn't want this file, ignore it
TG.NTY: CALL TCPSET ; Set up for data transfer
JRST KILFIL ; Lost
MOVE A,FILJFN ; Get where to put it
CALL CHKDSK ; See if on disk
IFXE. F,F%DSKF ; Is it?
MOVE A,FILPRP+P.TYPE ; Yes, get transfer type
CAIE A,TT.PAG ; If paged
CAIN A,TT.MEI ; or this paged
ANNSK.
SETZM FILPRP+P.TYPE ; Ask user instead
SETZM FILPRP+P.XTYP ; Clear this too for consistency
JRST TG.NTY ; Go set type again
ENDIF.
CALL TCDOPN ; Get the data port
JRST KILFIL ; Couldn't, don't get file
TG.RTY: CALL TCPFXN ; Get remote filename again
FTPM <RETR %2S> ; Ask for it
TG.RSP: CALL TCPRSA ; Get server reply
JRST KILFIL ; Couldn't get it
JRST TG.RTY ; Retry, ask again
SKTERS VB.VRB ; Verbose?
CALL TCPTFM ; Yes, say starting
CAIN B,"-" ; Continuation line?
JRST TG.RSP ; Yes, get rest
CALL FILEIN ; Start counting
CALL TCDREC ; Get file
JRST KILFIL ; Lost
CALLRET FILOUT ; File all received, finish up
; .DELFL - delete file from FILPRP
TCPDEL: SAVEAC <A,B,C,D,P1,P2>
CALL TCPSTU ; Can use STAT for properties?
JRST TD.DEL ; No, can only delete one file
ABTSET ; Let TCPSCN not lose with aborts
MOVE P2,[DEFPRP,,FILPRP] ; Set up where to default properties
JSP P1,TCPSCN ; Scan files
CALL TD.DEL ; Delete one file
RET ; All done
; Here to delete one file, properties in FILPRP
TD.DEL: CALL DELCNF ; Confirm if necessary
RET
TD.RTY: CALL TCPFXN ; Get file to delete
FTPM <DELE %2S> ; Say we want to delete
TD.RSP: CALL TCPRSA ; Get the response
RET ; Lose
JRST TD.RTY ; Retry
SKTERS VB.NRM ; Unless terse
CALL TCPTFM ; Type confirmation message
CAIN B,"-" ; If continued
JRST TD.RSP ; Then get continuation
RET ; Return to caller
; .PRINT - send file to LPT: in type text
TCPPNT: SAVEAC <A,B,C,D> ; Don't mung caller registers
MOVE A,OPSYS ; Get operating system looked up earlier
CAIE A,OS.10X ; TENEX
CAIN A,OS.T20 ; or TOPS-20?
IFSKP.
IFVERB VB.TRS ; If super-terse assume knows what's happening
TYPE <%% Don't know how to print files on that system%/>
PROMPT [ASCIZ/Sending to LPT: anyway [Confirm] /]
CALL DOCONF ; Ask user to say he really wants to print it
JRST TP.ERR ; Doesn't, give up
ENDIF.
ENDIF.
MVI. TT.TXT,FILPRP+P.TYPE ; Set transfer type text
MVI. TT.TXT,FILPRP+P.XTYP ; for both ends of connection
TP.FIL: CALL TCPSET ; Set up connection
JRST TP.ERR ; Couldn't
CALL TCDOPN ; Open it
JRST TP.ERR ; Couldn't
CALL OPNSTO ; Open file for read
JRST TP.NXJ ; Couldn't, try for another
HRROI A,FILPRP+P.SFIL ; Point to server-filename
WRITE <LPT:> ; Start filename
HRRZ B,FILJFN ; Get JFN
MOVX C,FLD(.JSAOF,JS%NAM) ; Just the filename
JFNS% ; Write it out
ERNOP ; Don't care if it doesn't make it
TP.RTY: HRROI B,FILPRP+P.SFIL ; With that filename
FTPM <STOR %2S> ; Ask to store file
TP.RSP: CALL TCPRSA ; Get response
JRST TP.NXT ; Lost, go on
JRST TP.RTY ; Needed account or login, try again
SKTERS VB.VRB ; Being verbose?
CALL TCPTFM ; Yes, type out reply
CAIN B,"-" ; Continued?
JRST TP.RSP ; Yes, get continuation
IFVERB VB.NRM ; If at least normal verbosity
SKTERS VB.DEB ; But not debugging
ANSKP.
HRRZ A,FILJFN ; With JFN we are sending
HRROI B,FILPRP+P.SFIL ; and filename at other end
TYPE( %1F => %2S ) ; Make start of message
ENDIF.
CALL TCDSND ; Send file
NOP ; Ignoring failures
TP.NXT: MOVE A,FILJFN ; Get JFN again
HRLI A,(CO%NRJ) ; Don't release JFN
CLOSF% ; Close it
TYPE <%_%% Unlikely file open or close error - %J%/>
TP.NXJ: CALL NXTFIL ; Step filespec
RET ; None, all done
JRST TP.FIL ; Have one, go do another file
; Here when fail permanently - message should already be typed
TP.ERR: MOVE A,FILJFN ; Get JFN again
RLJFN% ; Release it
TYPE <%_%% Unlikely JFN release error - %J%/>
RET
; .RENAM - change name of a remote file
TCPRNM: SAVEAC <A,B,C,D>
STKVAR <FILNAM>
MOVEM A,FILNAM ; Save pointer to the name
TR.RTY: CALL TCPFXN ; Get the file to rename
FTPM <RNFR %2S> ; Rename from
TR.RSP: CALL TCPRSA
RET ; Lose
JRST TR.RTY ; Retry
SKTERS VB.VRB ; If being verbose
CALL TCPTFM ; Then type response
CAIN B,"-" ; If continued
JRST TR.RSP ; Get continuation
MOVE A,FILNAM ; Get pointer to the destination name
FTPM <RNTO %1S> ; Rename to
TR.RST: CALL TCPRSA
RET ; Lose
JRST TR.RTY ; Retry
SKTERS VB.NRM ; Terse?
CALL TCPTFM ; No, type server confirmation
CAIN B,"-" ; Continued?
JRST TR.RST ; Yes, get continuation
RET
; .DIREC - directory of remote files
; we get DIRJFN in A but by the time we use it we have smashed it
; and have to look it up in DIRJFN again...
TCPDIR: SAVEAC <A,B,C,D,P1,P2>
CALL TCPSTU ; Can use STAT for properties?
IFSKP.
MOVE P2,[DEFPRP,,FILPRP] ; Set up default property list
JSP P1,TCPSCN ; Scan files
CALL DIRPNT ; Print a property list
RET ; All done
ENDIF.
;; Here when have to do directory the hard way with LIST command
TXO FX,L%HDR ; Don't expect formatted data
MVI. TT.TXT,FILPRP+P.TYPE ; Transfer type text
MVI. TT.TXT,FILPRP+P.XTYP ; Remote transfer type too
CALL TCPSET ; Set up connection parameters
RET ; Lost
CALL TCDOPN ; Get the data port
RET ; Didn't work
TI.RTY: CALL TCPFXN ; Get list to do a directory of
FTPM <LIST %2S> ; Want a directory
TI.RSP: CALL TCPRSA ; See what they say
RET ; Lose
JRST TI.RTY ; Retry
CAIN B,"-" ; Continued?
JRST TI.RSP ; Yes, get continuation
MOVE A,DIRJFN ; Get directory JFN
MOVEM A,FILJFN ; Save for transfer
CALL CHKDSK ; See if it is on disk
TXO F,F%STYO ; Suppress typeout
MVI. TT.TXT,FILPRP+P.TYPE ; Type text
CALL TCDREC ; Receive listing
NOP ; Ignore failure
RET
; .PARSK - parse an alternate socket
; Called during OPEN command parse in case we can handle alternate sockets.
; We can, so we parse a decimal socket number defaulting to FTP, socket 21.
TCPPSK: SAVEAC <A,B,C,D> ; Save registers
NOISE <socket> ; Guide words
MOVEI B,[FLDDB. .CMNUM,CM%SDH,^D10,<decimal socket number>,<21>]
CALL .COMND ; Parse it
ERMSG <Invalid socket number>
MOVEM B,TCPFNP ; Save as socket to use
JUMPG B,R ; If reasonable, return with it
ERMSGX <Socket number must be positive>
; .UFTPM - send message to server
TCPFTM: CALL FORMAT ; Call formatter
MOVE A,[POINT 7,TYPBUF] ; Using same buffer as TYPE macro
CALL TF.SND ; Send off buffered text
RET ; All done
TF.SND: MOVEI B,.CHCRT ; CR
IDPB B,A ; Add to buffer
MOVEI B,.CHLFD ; LF
IDPB B,A ; Add to make CRLF
SETZ B, ; Get a null
IDPB B,A ; Tie off buffer with it
MOVE A,NETJFN ; With connection JFN
HRROI B,TYPBUF ; With buffer
SETZ C, ; Ending on null
SOUTR% ; Send it off
ERJMP TF.ERR ; Error, go complain
SKVERB VB.DEB ; Debugging?
RET ; No, done
HRROI A,[ASCIZ/U: /] ; Don't use TYPE, we are stealing its buffer...
PSOUT%
HRROI A,TYPBUF ; Point to buffer again
PSOUT%
RET ; All done for sure
TF.ERR: CALL TCPRSP ; Try reading, maybe it's a disconnect
NOP ; If returned then must be something else
NOP
ETYPE <Couldn't send string to server - %J%/>
JRST TCPER2 ; Blow it away
; .STAT - Connection-dependant information
TCPSTS: FTPM <STAT> ; We don't know, ask the server
TSTAT0: CALL TCPRSQ ; Read reply being quiet about errors
JRST TSTAT1 ; If error go on
JRST TCPSTS ; Retry
CAIE A,^D211 ; System status message?
JRST TSTAT1 ; No, ignore it
SKVERB VB.DEB ; If debugging already seen
TYPE <%3S%/> ; Else type server response without angles
TSTAT1: CAIN B,"-" ; Continued?
JRST TSTAT0 ; Yes, get rest
RET ; All done
; .QUOTE - quote a command to the remote server
; AC A contains the pointer to the command string
TCPQUO: FTPM <%1S> ; Send off quoted command
TQUOT1: CALL TCPRSQ ; Read reply being quiet about errors
NOP ; Error, just fall through
NOP ; Retry needed, just fall through
SKVERB VB.DEB ; If debugging already seen
CALL TCPTFM ; Else print out server reply
CAIN B,"-" ; Continuation line?
JRST TQUOT1 ; Yes, keep on reading
RET ; All done
; TCPSTU - see if TCPSCN and TCPPRP can be used for this operating system
; returns +1/can't, +2/can
TCPSTU: JN F%NSMD,F,R ; If disabled, don't allow it
SAVEAC <A> ; Save register
MOVE A,OPSYS ; Get operating system looked up earlier
CAIE A,OS.10X ; Tenex?
CAIN A,OS.T20 ; TOPS-20?
RETSKP ; Yes, can do smart stuff
RET ; Nothing we know how to talk to
; TCPSCN - do STAT and collect SMART-DIRECTORY results
; call with JSP P1,TCPSCN
; FILPRP/filename to use
; LH[P2]/property list to default from (usually DEFPRP)
; RH[P2]/property list to fill props into (usually FILPRP)
; executes instruction at +1 with property list filled for each file
; returns +2 when no more files
; smashes A-D
; Free core is split up into blocks as follows:
; first word of block is block type value
; second word is pointer to next block
; rest of block is ASCIZ string for dir, filename, or gen
; block type values are:
TD.END==0 ; Sequence of blocks ends with zero word
TD.DIR==1 ; Directory used for next set of files
TD.FIL==2 ; File name without generation
TD.GEN==3 ; Generation for that file name and directory
LS TDPTR ; Pointer to next input space
LS TDDIR ; Last directory block found
LS TDFIL ; Last file block found
LS TDGEN ; Last generation block found
TCPSCN: MOVE A,FRECOR ; Point to some free storage
MOVEM A,TDPTR ; Start storing
MOVEM A,TDGEN ; And picking up names there
SETZM (A) ; Don't have anything yet
SETZM TDDIR ; No dir either
SETZM TDFIL ; Or file
CALL TCPFXN ; Get filename to use
FTPM <STAT %2S> ; Want a formatted directory
TCPSCR: CALL TCPRSA ; See what they say
JRST TCPSCX ; Lost
JRST TCPSCN ; Retry
CALL TCPSCP ; Print or stash response
JRST TCPSCR ; More to come, pull it in
TCPSCB: MOVE A,TDGEN ; Get generation pointer
MOVE B,1(A) ; Get next block pointer
MOVEM B,TDGEN ; Save for next time
MOVE B,(A) ; Find word saying what kind of block this is
XCT [ JRST 1(P1) ; TD.END done with list
MOVEM A,TDDIR ; TD.DIR Save directory
MOVEM A,TDFIL ; TD.FIL Save file
CAIA ](B) ; TD.GEN Generation, go on
JRST TCPSCB ; Not generation, get another block
;; Have a full filename, go send off request for specific info on it
ABTSKIP ; Stop if aborted
IFSKP. <JRST 1(P1)>
HRROI B,2(A) ; Point to generation string
MOVE C,OPSYS ; Get operating system
MOVEI D,"." ; Get generation char
CAIN C,OS.10X ; Tenex?
MOVEI D,";" ; Yes, different generation char
SKIPN A,TDDIR ; Get last dir block
TDZA C,C ; None, use null string
HRROI C,2(A) ; Point to that string
SKIPN A,TDFIL ; Get last file block
FATAL <Generation block with no previous file block>
HRROI A,2(A) ; Point to that string
FTPM <STAT %3S%1S%4C%2S> ; Make STAT command
JRST TCPSCR ; Get new response
; TCPSCN continued
; Here with a response. If it is a 213 we give it to caller, if it is
; a 212 we stach it in a block as a directory, or file and gens.
; We return +1/more responses expected
; +2/that was last, free to do another STAT or return.
TCPSCP: CAIE B,"-" ; More to come?
AOS (P) ; No, set skip return
ABTSKIP ; Aborted?
IFSKP. <RET> ; Yes, ignore this one
CAIN A,^D212 ; Just the name?
JRST TCPSCF ; Yes, stash filename
CAIN A,^D213
IFSKP.
TYPE <%% Unexpected response [%1D] %3S%/>
RET ; Maybe 211? Not what we want anyway
ENDIF.
;; Got a 213 file response, go parse it and print resulting plist.
MOVE D,P2 ; From default properties into file properties
BLT D,PLSIZE-1(P2) ; Copy property lists
CALL TCPPRP ; Scan 213 file response
RET ; Lost, ignore that one
XCT (P1) ; Give property list to caller
RET ; That's all for this one
; Here when we got an error reply from the original STAT.
; Error message has been printed so don't let DIR command do so too.
; Return success to user without having given any property lists.
TCPSCX: TXO FX,L%HDR ; Shut up FTP about nothing found
JRST 1(P1) ; Return +2
; TCPSCN continued
; Here with filename pointed to in C, stash it away
TCPSCF: MOVE A,TDPTR ; Point to next free block
HRROI B,2(A) ; Point to where to put string
HRLI B,(POINT 7) ; As a real byte pointer
CALL TCPSCL ; Run through filename
JRST TCPSCD ; Directory, handle
RET ; Null, shouldn't be there yet
CALL TCPSCL ; Now extension
JRST TCPSCD ; More directory
RET ; Null, shouldn't be there yet
MVI. TD.FIL,(A) ; Set block type to file name
TCPSF0: SETZ D, ; Get null
DPB D,B ; To terminate string over comma or period
CALL TCPSCZ ; Finish block
TCPSF1: MOVE A,TDPTR ; Get pointer to next
HRROI B,2(A) ; Point to string in that block
HRLI B,(POINT 7) ; As a real byte pointer
CALL TCPSCL ; Get next field
RET ; Open bracket, we lose
JRST TCPSF2 ; Null, done
CAIE D,";" ; A semi? If so, then probably an attribute
IFSKP.
MVI. TD.GEN,(A) ; Say that current block is generation
CALL TCPSCZ ; Tie off free storage
MOVE B,[POINT 7,TEMP] ; Dump attribute into scratch area
CALL TCPSCL ; Continue scanning
RET ; If bracket, we just quit
RET ; If null, we are done
JRST TCPSF1 ; If semi/period/comma, we try again
ELSE.
MVI. TD.GEN,(A) ; This is a generation block
JRST TCPSF0 ; Back for next block
ENDIF.
TCPSF2: MVI. TD.GEN,(A) ; This is a generation block
JRST TCPSCZ ; Finish block
; Here to copy field, returns +1/bracket, +2/null, +3/comma/period/semi found
TCPSCL: DO.
ILDB D,C ; Get next char
IDPB D,B ; Drop it in
CAIE D,.CHCNV ; Control V?
IFSKP.
ILDB D,C ; Get next char
IDPB D,B ; Drop it in
LOOP. ; Back for next without usual checks
ENDIF.
CAIN D,"<" ; Open bracket?
RET ; Yes, must be directory
CAIN D,";" ; Semicolon?
JRST R2SKIP ; Yes, +3 return
CAIE D,"." ; File/ext divider?
CAIN D,"," ; Or generation divider?
AOSA (P) ; Yes, set up +3 return
JUMPN D,TOP. ; No, if null ret +2 else back for another
ENDDO.
RETSKP ; Found period, return from loop
; Here when the string is a directory name
TCPSCD: WRITE B,<%3S> ; Finish copying string
MVI. TD.DIR,(A) ; Save block type
; Here to finish up a block - set up links to next block
TCPSCZ: MOVEI B,1(B) ; Point to next free space
SETZM (B) ; Clear out that location
MOVEM B,1(A) ; Save as next pointer block
MOVEM B,TDPTR ; And as next free block place
RET
; TCPPRP - given 213 reply to STAT message, construct property list
; Smart directory code (or for otherwise when we want a nice plist)
; call TCPSTU before using to make sure it's ok to use.
; Here to scan 213 file responses into a property list
; call with A,B,C/returned from TCPRSP, P2/plist pointer
; returns +1/lost, +2/property list scanned
TCPPRP: SAVEAC <A,B,C,D,P1> ; Get another register or two
MOVE P1,OPSYS ; Get operating system
CAIE P1,OS.10X ; Tenex
CAIN P1,OS.T20 ; TOPS-20?
JRST TCPP20 ; Yes
RET ; Nothing we know, lose
TCPP20: MOVE P1,C ; Save pointer to old text
TXZ FX,L%TYPE ; Can't display type
;; First part of string is fully-specified filename
HRROI A,P.SFIL(P2) ; Point to server file
CALL TCPPRS ; Stash field
JRST TCPPRE ; Null, don't understand
JRST TCPPRE ; Comma, don't understand
;; Somebody might want a version, so make one out of the filename
MOVX A,GJ%SHT!GJ%OFG ; Short form, wildcard unparsed
HRROI B,P.SFIL(P2) ; With name we just read in
GTJFN% ; Try letting TOPS-20 parse it
IFNJE.
CALL JFNVRS ; Get version
MOVEM B,P.VERS(P2) ; Save for later
RLJFN% ; Release the JFN
TYPE <%% Unexpected error releasing JFN - %J%/>
ENDIF.
;; Got file name, now do attributes
DO.
ILDB A,C ; Get next char
CAIE A,"P" ; Protection?
IFSKP.
MOVEI D,^D8 ; Radix octal
CALL TCPPRB ; Read number
MOVEM B,P.PROT(P2) ; Save file protection
JRST TCPPRL ; Back for another attribute
ENDIF. ; End of file protection code
;; Tenex generation numbers start with a semicolon rather than
;; a period, so they look like attributes rather than filename
;; parts. We read it into the Version property here, and the
;; code that calls us is expected to be smart enough to handle
;; it not also being in the file name.
CAIL A,"0" ; In range
CAILE A,"9" ; To be version number (for Tenex)?
IFSKP.
MOVEI B,-"0"(A) ; Yes, set up number start
MOVEI D,^D10 ; Decimal
CALL TCPPRI ; Read number
MOVEM B,P.VERS(P2) ; Save generation number
JRST TCPPRL ; Back for another attribute
ENDIF.
;; Here for an attribute other than ; P
HRROI A,TEMP ; No, into scratch space
CALL TCPPRS ; Stuff trash
JRST TCPPRE ; Null, don't understand
EXIT. ; Comma, done with file attributes
LOOP. ; Semi, back for another attribute
; Here after reading number i.e. protection or Tenex generation
TCPPRL: CAIN A,"," ; Comma?
EXIT. ; Yes,
CAIN A,";" ; Semi?
LOOP. ; Yes, back for another
JRST TCPPRE ; Strange character
ENDDO.
;; Done with attributes, next comes number of pages
MOVEI D,^D10 ; Decimal
CALL TCPPRB ; Read number
MOVEM B,P.SIZE(P2) ; Save file size
CAIE A,"," ; Next char must be comma
JRST TCPPRE ; Not, complain
;; Now the various read and write times
MOVEI D,P.CDAT(P2) ; Creation date
CALL TCPPRT ; Get date and time
JRST TCPPRE ; Some lossage
MOVEI D,P.WDAT(P2) ; write date
CALL TCPPRT ; Get date and time
JRST TCPPRE ; Some lossage
MOVEI D,P.RDAT(P2) ; Read date
CALL TCPPRT ; Get date and time
JRST RSKP ; Handle case with no writer/author (TENEX)
;; Now both writer names
HRROI B,P.OAUT(P2) ; Creator
CALL TCPPRS ; Stuff
JRST TCPPRE ; Null
CAIA ; Comma (what we want)
JRST TCPPRE ; Semicolon
HRROI A,P.AUTH(P2) ; Last-writer
WRITE <%3S> ; Stuff rest
RETSKP ; All done
; TCPPRP subroutines
; Here when we don't understand the line
TCPPRE: SKVERB VB.NRM ; Terse?
RET ; Yes, give up quietly
MOVE A,P1 ; Get pointer back
TYPE <%% Unrecognized format for file status response:
%% 213 %1S%/>
RET
; Here to stuff field into string (pointed to in A)
; returns +1/null +2/comma +3/semicolon
TCPPRS: MKPTR (A) ; Make sure we have a real byte pointer
TCPPS0: ILDB B,C ; Next byte
IDPB B,A ; Drop in
JUMPE B,R ; Check for null
CAIE B,.CHCNV ; Control V?
IFSKP.
ILDB B,C ; Yes ,get another
IDPB B,A ; and drop in
JRST TCPPS0 ; Without checking for other specials
ENDIF.
CAIN B,"," ; Comma?
IFSKP. ; No...
CAIE B,";" ; Semi?
JRST TCPPS0 ; No, back for more
AOS (P) ; Else set up double skip
ENDIF.
SETZ B, ; Get a null
DPB B,A ; To tie off string
RETSKP ; Return +2 or +3
; Here to parse time into word pointed to by D
; returns +1/strange format, +2/success
TCPPRT: HRROI A,TEMP ; Point to temporary storage
CALL TCPPRS ; Stuff string
RET ; Null?
TDZA B,B ; Success, clear flags for IDTIM
RET ; Semi?
HRROI A,TEMP ; From temp buffer
IDTIM% ; Input date and time
RET ; Lost
MOVEM B,(D) ; Won
RETSKP ; So return success
; Here to read number, radix in D
; returns +1 always with A/delimiter, B/number
TCPPRB: SETZ B, ; Clear number
TCPPRI: DO.
ILDB A,C ; Get next char
CAIL A,"0" ; Below
CAILE A,"0"-1(D) ; or above protection range?
RET ; Yes, done with number
IMULI B,(D) ; Multiply by radix
ADDI B,-"0"(A) ; Include digit
LOOP. ; Back for next
ENDDO.
; TCPF20 - get remote TOPS-20 filespec from response string
; arg: C - pointer to response
; returns:
; +1 - couldn't make sense of argument
; +2 - B is the filespec. It is a pointer into the original string
;the response is of the form
; 150 fooed store of <DIR>NAME.EXT.VER;P000000;Aaccount started.
;We want the full filespec and protection. We scan for the second
; semicolon, remembering blanks. We return the location of the most
; recent blank, and null the semicolon.
TCPF20: SAVEAC <A,D>
MOVEI D,2 ; Semicolon counter
TCPF21: ILDB A,C
CAIE A,"V"-100 ; Handle quoting
IFSKP.
ILDB A,C ; Skip quoted char
JRST TCPF21
ENDIF.
CAIN A," " ; Remember blanks
MOVE B,C
CAIN A,";" ; And stop at second semicolon
SOJE D,TCPF22 ; Count them and exit at second
JUMPN A,TCPF21 ; Keep on looping
RET ; Didn't find a TOPS-20 filespec
TCPF22: DPB D,C ; Kill off the semicolon. Slightly tricky.
RETSKP ; D must be 0 to have gotten here
; TCPFXN - get remote filespec as string rather than spread over property list
; Returns +1 always with B/byte pointer to filename (uses NETBUF)
TCPFXN: SAVEAC <A,C,D> ; Get some registers
STKVAR <<FNPTRS,2>> ; Make some storage
MOVE A,OPSYS ; Get operating system
;; If UNIX(tm) we handle default directory by prepending to the
;; filename being careful about slashes.
CAIE A,OS.UNX ; UNIX?
IFSKP.
SKIPE FILPRP+P.DIRE ; No default directory
IFSKP.
SKIPE FILPRP+P.SFIL ; and specified file is null
IFSKP.
HRROI B,[ASCIZ/*/] ; Point to buffer
RET ; Back with this name
ENDIF.
ELSE. ; Default directory exists
MOVE B,[POINT 7,FILPRP+P.SFIL] ; Yes, look at given file
ILDB C,B ; In particular, the first character
CAIN C,"/" ; Is it an absolute path name?
ANSKP. ; Yes, absolute, just use given filename
HRROI A,NETBUF ; No, relative, point to net buffer
HRROI D,FILPRP+P.DIRE ; and default directory
WRITE <%4S> ; Copy one into the other
LDB D,A ; Get the last character
CAIE D,"/" ; If not a slash
WRITE </> ; Then add one in
WRITE <%3C%2S> ; Now finish filename
HRROI B,NETBUF ; Point to buffer again
RET ; Return with new filename
ENDIF.
ENDIF.
;; Only other operating systems we can handle are TOPS-20 and Tenex.
;; If not those, we just return remote file string as given to us.
CAIE A,OS.T20 ; TOPS-20?
CAIN A,OS.10X ; Tenex?
IFSKP.
HRROI B,FILPRP+P.SFIL ; Neither, just use file name as is
RET ; Return with it
ENDIF.
;; Here for Tenex and TOPS-20. First copy directory part of name...
MOVE A,[POINT 7,NETBUF] ; Make destination pointer
MOVE B,[POINT 7,FILPRP+P.SFIL] ; and source pointer
SETZM FNPTRS ; No colon found yet either
DO.
ILDB C,B ; Get char
IDPB C,A ; Drop in
CAIE C,.CHCNV ; Control V?
IFSKP.
ILDB C,B ; Yes, get next
IDPB C,A ; And drop in without looking at it
LOOP. ; Go get more
ENDIF.
CAIE C,">" ; Close bracket
CAIN C,"]" ; Or obsolete style of close?
EXIT. ; Yes, done copying dir part
CAIN C,":" ; Device terminator?
DMOVEM A,FNPTRS ; Yes, save source and dest
JUMPN C,TOP. ; No, back for another if there is more
;; Got through entire filename without finding directory.
;; but maybe we found a colon - if so start over there.
SKIPN FNPTRS ; Any colons?
IFSKP.
DMOVE A,FNPTRS ; Yes, get pointers back
EXIT. ; And treat as directory end
ENDIF.
;; No colon either, so no directory in file.
;; If there is a default directory, we want to use it
;; otherwise start over at the start of the filenames.
MOVE A,[POINT 7,NETBUF] ; Point to buffer again
SKIPN FILPRP+P.DIRE ; Default directory?
IFSKP.
HRROI B,FILPRP+P.DIRE ; Yes, point to it
CALL SKPDIR ; Skip to terminator
ILDB B,B ; So we can see if there is anything after it.
HRROI C,FILPRP+P.DIRE ; In any case point to start of dir again
IFN. B ; Were there terminators on directory?
WRITE <<%3S>> ; No, add dir with terminators
ELSE.
WRITE <%3S> ; Yes, add as is
ENDIF.
ENDIF.
;; Now we have maybe added default dir, use rest of given filename.
MOVE B,[POINT 7,FILPRP+P.SFIL] ; Point to filename yet again
ENDDO.
;; Here with A/pointer to rest of buffer, B/ptr to filename part
;; If there is nothing to the filename use *.* instead
MOVE C,B ; Copy pointer
ILDB C,C ; Get first char
SKIPN C ; See if something there
MOVE B,[POINT 7,[ASCIZ/*.*/]] ; Nothing, use wildcards
;; Go through counting dots and semicolons so that we can know
;; if there is a generation included in the filename
SETO D, ; No dots found yet
DO.
ILDB C,B ; Get char
IDPB C,A ; Drop in
CAIE C,"." ; Dot?
CAIN C,";" ; or semicolon?
AOJA D,TOP. ; Yes, count it
JUMPN C,TOP. ; Else continue if more to get
ENDDO.
;; Now we have copied whole filename. If it included a generation
;; then we are done, else add that too.
IFL. D ; No dots? i.e., no extension or generation?
MOVEI C,"." ; Yes, get one
DPB C,A ; Drop a dot over the null
MOVEI C,"*" ; Wildcard for the file extension
IDPB C,A ; ...
MOVEI C,.CHNUL ; Tie off string with a null
IDPB C,A ; ...
ENDIF.
IFLE. D ; At least two dots?
MOVEI D,"." ; No, get generation separator
MOVE C,OPSYS ; But check operating system
CAIN C,OS.10X ; And if it is Tenex
MOVEI D,";" ; then get their different separator
DPB D,A ; In either case drop it over the null
HRRZ B,FILPRP+P.VERS ; Get version from property list
CAIE B,.GJALL ; Wildcard?
IFSKP.
WRITE <*> ; Yes, write like that
ELSE.
HRRES B ; Extend sign
WRITE <%2D> ; Normal gen, write in decimal
ENDIF.
ENDIF.
;; Now we have a complete filename in NETBUF, just return it
HRROI B,NETBUF ; Point to start of name again
RET ; All done
; TCPRSP - Get response over TELNET connection
; Returns +1 - failure, error string written (also if response .GE. 400)
; +2 - was not logged in and now is, retry
; +3 - success, A/ response number
; B/ terminating character
; C/ Pointer to string received
; If debugging, then will type whole line of server response
; (including code number), so caller should not do same. If reponse .GE. 500
; then will automatically type "no" reponse string (without numbers).
; Otherwise caller should type response with CALL TCPTFM at own discretion.
; Mungs register D
LS TCPORS ; Old code for making sure of reply code matches
TCPRSE: CALL TCPTFQ ; Here with error
CAIE B,"-" ; If not continuation
RET ; Then return with failure
TCPRSP::CALL TCPRSQ ; TCPRSP with quiet errors
JRST TCPRSE ; Error, don't be so quiet
RETSKP ; +2
JRST R2SKIP ; +3
TCPRSQ::CALL TCPFIL ; Fill buffer
IFVERB VB.DEB ; Debugging?
HRROI A,NETBUF ; Get a pointer to the string
TYPE <S: %1S> ; Type the message
ENDIF.
;; Have read input line, now see what the starting number is.
;; Have to be careful to preserve C for overflow check.
MOVE D,[POINT 7,NETBUF] ; Pointer to the input buffer
SETZ A, ; Start off with zero response
DO.
ILDB B,D ; Get the char
CAIL B,"0" ; Is it a non-digit?
CAILE B,"9"
EXIT. ; Not a digit, done collecting numeric part.
IMULI A,^D10 ; Shift over previous digits by base (decimal)
ADDI A,-"0"(B) ; to make room for the new digit that we add in.
LOOP. ; Go get the next char and process it.
ENDDO.
;; RFC765, page 33 gives the following example:
;; 123-First line
;; Second line
;; 234 A line beginning with numbers
;; 123 The last line
;; So we make sure here that we really got a matching number...
CALL TCPRSF ; Finish transfer in case of overflow
SKIPE TCPORS ; Do we have an old response?
CAMN A,TCPORS ; Yes, did this match?
IFSKP.
MOVE A,TCPORS ; No, must be numberless continuation
MOVEI B,"-" ; So make it look normal
MOVE C,[POINT 7,NETBUF] ; And use whole line of text
ELSE.
CAIE B,"-" ; Is this a continuation line?
SETZM TCPORS ; No, clear old response
CAIN B,"-" ; Is this a continuation line?
MOVEM A,TCPORS ; Yes, remember to match it later
MOVE C,D ; Copy pointer into right place
ENDIF.
;; Now handle some specific reply codes.
;; 0xx codes are not strictly legal, but they existed in NCP days
;; and there are rumors of some sites still sending them.
CAIL A,^D100 ; Response .LT. 100 (comment)?
IFSKP.
CALL TCPTFM ; Yes, type it out
JRST TCPRSQ ; And try for another one
ENDIF.
;; If the code is 1xx, 2xx, or 3xx, then we return success now
CAIGE A,^D400 ; Response .GE. 400?
JRST R2SKIP ; No, good, return +3
;; Some failure, see which it is. Special codes handled are:
;; 421 Service not available, cloaing TELNET connection
;; 530 Not logged in
;; 532 Need account for storing files
;; All other failures merely return +1 to the caller.
CAIE A,^D532 ; Account needed?
IFSKP. ; Yes, maybe can handle quietly
CALL TCPACT ; Try sending off account string
RET ; Strange return (more likely to go to COMLP)
RETSKP ; Need to retry, already knew that
RETSKP ; Even if we won we still need to retry
ENDIF.
CAIN A,^D530 ; Fail because not logged in?
JRST TCPRLG ; If here, then need to login. Try it
CAIE A,^D421 ; Shutting down?
RET ; No, something else, return +1
;; Here on 421 response - server autologged us out
CALL TCPTFQ ; Ok to be noisy here
CAIN B,"-" ; Continued?
JRST TCPRSQ ; Yes, get continuation
CALL TCPCLZ ; Close connection nicely
JRST DISCON ; And tell user we got blown away
; TCPRSP subroutines
; Here when finished reading response, make sure line is all read in
; call with C/return value from last buffer
; returns +1/always with no registers munged
TCPRSF: SAVEAC <A,B,C,D> ; Save used registers
JUMPN C,TCPRSD ; If no overflow, done now
TYPE <%% FTP input buffer overflowed%/>
DO.
CALL TCPFIL ; Fill buffer
IFVERB VB.DEB ; Debugging?
HRROI A,NETBUF ; Point to start of newly read buffer
PSOUT% ; Then want to see overflow too
ENDIF.
JUMPE C,TOP. ; If still overflowing, get more
ENDDO.
TCPRSD: SKTERS VB.DEB ; See if debugging
TYPE <%/> ; Debugging, add nice CRLF
RET ; All done
; Here to fill NETBUF with text from connection
; returns +1/success, C/zero on buffer overflow, nonzero otherwise
; on error may jump to random places
TCPFIL: MOVE D,[POINT 7,NETBUF] ; Point to net buffer
MOVEI C,BUFLEN*5-1 ; Length of buffer (max)
MOVE A,NETJFN ; Get net connection
DO.
CALL TCPBIN ; Get a byte with TELNET protocol
JRST TCPERR ; Lost
;; Got a TELNET byte. Some servers send us nulls and dels
;; (in the middle of CRLFs even) so we have to ignore them.
CAIN B,177 ; Del?
JRST TOP. ; Yes, ignore
JUMPE B,TOP. ; Ignore nulls
;; Real char. If EOL then handle specially else just add to string.
CAIN B,.CHLFD ; Linefeed?
JRST TCPFLE ; Yes end of line
IDPB B,D ; Drop into buffer
SOJG C,TOP. ; Then back for more
ENDDO.
RET ; Buffer full or linefeed, return
; Here when we got a LF. This being NVT ASCII we should have had a
; CR just before it, but it is possible that some server will send
; us something wrong - thus the paranoia here.
TCPFLE: LDB B,D ; Get last char of string
CAIE B,.CHCRT ; Is it the CR we expect?
IFSKP.
SETZ B, ; Get a null instead
DPB B,D ; Drop over carriage return
RET
ENDIF.
TYPE <%_%% Server response does not end with CRLF%/>
SETZ B, ; Get a null anyway
IDPB B,D ; But add it one further along
RET
; TCPERR - connection lost big.
; have to close connection before jumping to EDISC so we don't recurse
; where EDISC calls TCPCLS calls TCPRSP calls TCPFIL jumps to here...
; Don't try to write to the connection at this point since it is probably
; dead with a device/data error. Trying to do so causes recursive errors.
TCPERR: ETYPE <Unexpected error in connection - %J%/>
TCPER2: CALL TCPCLZ ; Close connection nicely
JRST EDISC ; Tell FTP program we lost things
; TCPBIN - read a character from the TELNET connection doing protocol
; call with JFN in A, returns +1/some error, +2/input char in B
IAC==^D255 ; Interpret as command
IACWIL==^D251 ; Sender will do
IACWNT==^D252 ; Sender won't do
IACDO==^D253 ; Receiver asked to do
IACDNT==^D254 ; Receiver must not do
; Enter here to do a null SOUTR% first
TCPBNS: PUSH P,C ; Save reg
HRROI B,C ; Point to location
SETZ C, ; That contains zero
SOUTR% ; Send off null string
IFJER. ; Lost?
POP P,C ; Don't return with flaky stack
RET ; Now ok to return failure
ENDIF.
POP P,C ; Restore reg
; Real entry point here
TCPBIN: BIN% ; Read in next byte
ERJMP R ; Some error, return failure
CAIE B,IAC ; Is it an IAC?
RETSKP ; No, return with it
BIN% ; Yes, get next char
ERJMP R
CAIN B,IAC ; This one an IAC too?
RETSKP ; Yes, send it through
CAIE B,IACWNT ; Won't?
CAIN B,IACDNT ; Don't?
JRST TCPBNI ; Yes, ignore option
CAIN B,IACWIL ; Will?
JRST TCPBNW ; Yes
CAIN B,IACDO ; Do?
JRST TCPBND ; Yes
SKVERB VB.DEB ; Something else. Debugging?
JRST TCPBIN ; Back for a real byte
CAIL B,IACMIN ; In range?
IFSKP.
TYPE <S: [IAC] <%2D>%/> ; No, use number
JRST TCPBIN ; And type out
ENDIF.
HRRO B,IACTAB-IACMIN(B) ; Get name for that IAC
TYPE <S: [IAC] [%2S]%/> ; Say what
JRST TCPBIN ; Get something real
; TCPBIN continued
; Here when server sends IAC WONT or IAC DONT
TCPBNI: IFTERS VB.DEB ; If not debugging
BIN% ; Just read option
ERJMP R
JRST TCPBIN ; Ignore and get next
ENDIF.
HRRO B,IACTAB-IACMIN(B) ; Else get name for WON'T or DON'T
TYPE <S: [IAC] [%2S]> ; Start typeout
BIN% ; Read option
ERJMP R
HRRO B,OPTTAB(B) ; Now get option name
TYPE < [%2S]%/> ; Finish debugging typeout
JRST TCPBIN ; Now back for next byte
; Here when server sends IAC WILL <option>
TCPBNW: MOVEI B,IAC ; IAC
BOUT% ; Send it
ERJMP R
MOVEI B,IACDNT ; Don't
BOUT% ; Send it
ERJMP R
BIN% ; Now read option
ERJMP R
BOUT% ; Echo option back
ERJMP R
SKVERB VB.DEB ; Debugging?
JRST TCPBNS ; Back for new byte after sending Don't off
CAIG B,OPTMAX ; If out of range
IFSKP.
TYPE <S: [IAC] [Will] <%2D>%/U: [IAC] [Don't] <%2D>%/>
JRST TCPBNS
ENDIF.
HRRO B,OPTTAB(B) ; Get name of option
TYPE <S: [IAC] [Will] [%2S]%/U: [IAC] [Don't] [%2S]%/>
JRST TCPBNS
; Here when server sends IAC DO <option>
TCPBND: MOVEI B,IAC ; IAC
BOUT% ; Send it
ERJMP R
MOVEI B,IACWNT ; Won't
BOUT% ; Send it
ERJMP R
BIN% ; Now read option
ERJMP R
BOUT% ; Echo option back
ERJMP R
SKVERB VB.DEB ; Debugging?
JRST TCPBNS ; Back for new byte after sending Won't off
CAIG B,OPTMAX ; If out of range
IFSKP.
TYPE <S: [IAC] [Do] <%2D>%/U: [IAC] [Won't] <%2D>%/>
JRST TCPBNS
ENDIF.
HRRO B,OPTTAB(B) ; Get name of option
TYPE <S: [IAC] [Do] [%2S]%/U: [IAC] [Won't] [%2S]%/>
JRST TCPBNS
; TCPBIN continued
; Table of IAC names
IACMIN==^D239 ; First known IAC number
IACTAB: [ASCIZ/End-of-Record/] ; 239 End of Record
[ASCIZ/Subnegotiation-End/] ; 240 Subnegotiation end
[ASCIZ/No-op/] ; 241 No-op
[ASCIZ/Data-Mark/] ; 242 Data mark
[ASCIZ/Break/] ; 243 Break key
[ASCIZ/Interrupt-Process/] ; 244 Interrupt process
[ASCIZ/Abort-Output/] ; 245 Abort output
[ASCIZ/Are-You-There/] ; 246 Are you there?
[ASCIZ/Erase-Char/] ; 247 Erase character
[ASCIZ/Erase-Line/] ; 248 Erase line
[ASCIZ/Go-Ahead/] ; 249 Go ahead
[ASCIZ/Subnegotiation/] ; 250 Subnegotiation
[ASCIZ/Will/] ; 251 Sender will do
[ASCIZ/Won't/] ; 252 Sender won't do
[ASCIZ/Do/] ; 253 Receiver asked to do
[ASCIZ/Don't/] ; 254 Receiver must not do
[ASCIZ/IAC/] ; 255 Interpret as command
; Table of WILL/WON'T/DO/DON'T options
OPTTAB: [ASCIZ/Transmit-Binary/] ; 0 Transmit binary
[ASCIZ/Echo/] ; 1 Echo
[ASCIZ/Reconnect/] ; 2 Reconnect
[ASCIZ/Suppress-GA/] ; 3 Suppress GA
[ASCIZ/Neg-Appx-Msg-Size/] ; 4 Negotiate approx. message size
[ASCIZ/Status/] ; 5 Status option
[ASCIZ/Timing-Mark/] ; 6 Timing mark
[ASCIZ/Rmt-Ctrl-Trans-Echo/] ; 7 Remote controlled trans/echo
[ASCIZ/Neg-Out-Line-Wid/] ; 8 Negotiate output line width
[ASCIZ/Neg-Page-Size/] ; 9 Negotiate page size
[ASCIZ/Neg-Out-CR/] ; 10 Negotiate output CR
[ASCIZ/Neg-Out-Tab-Stops/] ; 11 Negotiate output horizontal tab stops
[ASCIZ/Neg-Out-HT/] ; 12 Negotiate output HT
[ASCIZ/Neg-Out-FF/] ; 13 Negotiate output FF
[ASCIZ/Neg-Out-VTab-Stops/] ; 14 Negotiate output vertical tab stops
[ASCIZ/Neg-Out-VT/] ; 15 Negotiate output VT
[ASCIZ/Neg-Out-LF/] ; 16 Negotiate output LF
[ASCIZ/Extended-ASCII/] ; 17 Tovar's idea of extended ASCII
[ASCIZ/Logout/] ; 18 Logout option
[ASCIZ/Byte-Macro/] ; 19 Byte macro
[ASCIZ/Data-Entry/] ; 20 Data entry terminal option
[ASCIZ/Supdup/] ; 21 Supdup (not TELNET) protocol
[ASCIZ/Supdup-Output/] ; 22 Supdup output
[ASCIZ/23/]
[ASCIZ/Terminal-Type/] ; 24 Terminal type
[ASCIZ/End-of-Record/] ; 25 End of Record
OPTMAX==.-OPTTAB-1 ; This is the largest option we know the name of
; TCPTFM - Type out server response
; Alternate entry point for overriding F%STYO
TCPTFQ: PUSH P,F ; Save flags
TXZ F,F%STYO ; Not suppressing output
CALL TCPTFM ; Type message
POP P,F ; Restore flags
RET
; Normal entry point
TCPTFM::SKTERS VB.DEB ; Debugging?
RET ; Yes, already seen
SKVERB VB.TRS ; If terser than terse
RET ; Don't want to see it
SAVEAC <D> ; Don't mung this register
;; Some FTP servers, such as MIT-MC and SAIL, like to put
;; an extra space after the "-" signifying continuation.
;; We don't want to strip this space in TCPRSP because
;; then it might mess up things like the STAT command, but
;; when we display responses here we don't want extra spaces.
;;
;; Also, TOPS-20 servers sometimes put question marks at the
;; starts of their error messages. I think those are ugly,
;; so I flush them too.
DO.
MOVE D,C ; Copy text pointer
ILDB D,D ; Get next byte from pointer
CAIE D," " ; Another space?
CAIN D,"?" ; or a question mark?
IFSKP. <EXIT.> ; Neither, done now
IBP C ; Space, skip over it
LOOP. ; And try for another char
ENDDO.
;; Now we have the string to type. If being extra-verbose then
;; we also type the number and divider char, else just the text.
IFTERS VB.EVB ; If want normal typeout
DTYPE "< %3S%/" ; Then do it
RET ; And return
ENDIF.
DTYPE "< %1D%2C%3S%/" ; Extra verbose, type fancy string
RET
END