1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-14 15:45:47 +00:00
PDP-10.its/src/sysnet/ftpu.161
2016-11-24 21:43:54 +01:00

2817 lines
75 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;-*- Mode: MIDAS -*-
TITLE FTPU - NEW FTP USER FOR ITS
.SYMTAB 5001.,7000.
SUBTTL Basic Definitions
;Accumulators
F=0 ; Flags
A=1 ;Standard ACs
B=2
C=3
D=4
E=5
T=6
TT=7
R=10
; =11 ;Not used
OC=12 ; Output package
U1=13 ;UUO accs
U2=14
U3=15
U4=16
P=17 ;Stack pointer.
;Channels
ICPCH==0 ;ICPCH must be 0 for socket table hackery to win!!
TMPC==1 ;temp
NETI==2 ;Net input ch (telnet connection)
NETO==3 ;Net output ch (telnet connection)
NETDI==4 ;Net data input channel
NETDO==5 ;Net data output channel
STRC==6 ;UUO string output channel
DC==7 ;general purpose dsk channel (in and out)
TYIC==10 ;TTY input
TYOC==11 ;TTY output
ERRC==12 ;ERR device
SCRIPC==13 ;Script file out
COMC==14 ;Command file in
; Flags
%LTCP==1 ; LH 1 = Using TCP
%TMP==1 ; RH temporary flag
TIMOUT=30.*120. ;Timeout value is two minutes.
;Subroutine Packages.
DEFINE %%.CRLF C,ARG
IFSN ARG,, .ERR non-null argument "ARG" after CRLF in FWRITE
CRLF C,
TERMIN
$$OUT==1
$$OFLT==1
UAREAS==1 ; Assemble UUO areas
USTRGS==1 ; and string hackery.
UFLOAT==1 ; and floating point typeout
.INSRT KSC;NUUOS >
;and wonderful filename parser
.INSRT KSC;NFNPAR >
$$HST3==1
$$SYMLOOK==1 ;and miraculous network routines
$$HSTMAP==1 ;and routines for the host names table file
$$HOSTNM==1
$$OWNHST==1
$$ICP==1 ;and network connection routines
$$CONNECT==1 ;and tcp net connection routines
$$ANALYZE==1 ;include network error analysis routine
$$ARPA==1 ;handle Arpanet (only, for now)
$$TCP==1 ;handle Internet host parsing.
USETCP: -1 ;For the hostname parser (default)
USENCP: 0 ;For the hostname parser.
.INSRT SYSENG;NETWRK >
FTPSKT==3 ;standard ICP socket #
FTPORT==25 ;TCP FTP port #
SUBTTL Random locations
TMPLOC 41, <JSR 1,UUOH> ;"1," means illegal instructions cause fatal interrupts.
TMPLOC 42, JSR TSINT
PAT:
PATCH: BLOCK 100
PDLLEN==100
PDL: -PDLLEN,,.
BLOCK PDLLEN
POPTJ: POP P,T
POPJ P,
POPBA1: AOS -2(P)
POPBAJ: POP P,B
POP P,A
POPJ P,
POPJ1: AOSA (P)
POP1J: POP P,JUNK
CPOPJ: POPJ P,
POPAJ1: AOS -1(P)
POPAJ: POP P,A
APOPJ: POPJ P,
POPCBJ: POP P,C
POPBJ: POP P,B
POPJ P,
JUNK: 0 ;for random useless writes
VERSHN: .FNAM2
VERSION==.FNAM2
SCRIPT: 0 ;nonzero if writing script file.
READIN: 0 ;nonzero while rubout processing - inhibits script file output.
COMFIL: 0 ;nonzero if reading command file.
TYITTY: 0 ;nonzero if TTY can be read from.
TYOTTY: 0 ;nonzero if TTY can be written on.
TRITTY: 0 ;nonzero if TTY input was translated (not really device TTY)
TROTTY: 0 ;similar, for TTY output.
DISTTY: 0 ;nonzero if TTY is display (can rub out)
HDXTTY: 0 ;nonzero if half duplex TTY and shouldn't echo.
SILENT: 0 ;nonzero if shouldn't type on TTY (cleared if try to read tty).
INHIDE: 0 ;nonzero if TYILIN shouldn't echo input. (eg for pwd)
DEBUG: 0 ;nonzero inhibits death, disowning, etc.
PRREP: 0 ; -1 if printing server replies.
IFNDEF BUFFL,BUFFL==4000
BUFFER: BLOCK BUFFL ;Buffer for the actual file transfer.
XFRBFL==:BUFFL
XFR8BL==<<<XFRBFL*9>+7>/8.> ; # words in 8-bit byte buffer
TMPBUF: BLOCK XFR8BL ; Buffer for packing 8-bit bytes (TCP)
XFRLBV: 0 ;length of buffer except for one word, in characters,
; (used by XFRASC.)
XFRLWP: 0 ;Address of last word in used part of buffer
XFRDIR: 0 ;-1 if writing to net
XFRBPW: 0 ;Bytes per word
DCTYPE: 0 ;Transfer Type. 0=ASCII, -1=Image, 1=Local.
; These are what we think server believes,
DCBYTE: 0 ;Byte size. One of 8., 32., 36.
; not what user has said he prefers. If user wants to
; change it, we ask the server before setting these.
DCSENT: 0 ;-1 => The server knows DCTYPE and DCBYTE, either because they
; are the default (TYPE A, BYTE 8) or because we sent them
; and they were accepted.
;0 => The server doesn't know them, they must be TYPE I,BYTE 36
; so try sending those before next data transfer operation.
; For TCP the desired settings are TYPE L 36.
DKIOSW: 0 ;0 Disk input, -1 Disk output
NTIOSW: 0 ;0 Net input, -1 Net output
ICPSOC: 0 ;frn skt to ICP to
LPORT: 0 ;lcl port we listen for data connection on
LDSOC: 0 ;lcl skt for data skt open
FDSOC: 0 ;frn skt for data skt open
FDHST: 0 ;frn hst for data skt open
OWNHST: 0 ; # of own site.
MACHNM: 0 ; Machine name (AI,MC,ML,DM)
ITSVER: 0 ; ITS version # in sixbit
OWNNAM: 0 ; Addr of ASCIZ string for own site-name.
CNECTD: 0 ;nonzero => connected to a foreign host
NBITS: 0 ;# bits transferred
NTIME: 0 ;starting time in 30ths
FILDEV: SIXBIT /DSK/
FILDIR: 0
FILFN1: 0
FILFN2: SIXBIT />/
SCRIPF: SIXBIT /DSK/
SCRIPS: 0
SCRIP1: SIXBIT /FTPOUT/
SCRIP2: SIXBIT />/
COMDEV: SIXBIT /DSK/
COMDIR: 0
COMFN1: SIXBIT /FTPCOM/
COMFN2: SIXBIT />/
FTPOF1: SIXBIT /_FTPU_/
FTPOF2: SIXBIT /OUTPUT/
THOSTB: BLOCK 10 ;Block for THOSTN to store its host name in.
IFNDEF JCLBFL,JCLBFL==50
JCLFLG: 0 ;-1 => executing command that came from DDT
SUICID: 0 ;-1 => commit suicide after this command if it wins.
JCLTRN: 0 ;-1 => this is implicit TRAN from JCL.
; (Suppresses "N bits in M seconds".)
JCLBF1: ASCII/TRAN /
JCLBUF: BLOCK JCLBFL ;Command Line (read from DDT or from TTY) as ASCIZ string.
BLOCK 400
JCLBFE: ,,-1 ;Nonzero to stop DDT's xfer of JCL. Top byte 0 to end JCL.
JCLBFP: 440700,,JCLBUF ;Addr of block to store JCL in. These 2 words bound
JCLP: 440700,,JCLBUF ;Pointer to read JCL out of. if must "push JCLBUF".
JCLBF2: BLOCK JCLBFL ;Alternate block to read tty input into.
ARGBUF: BLOCK JCLBFL ;ARG reads stuff from JCLBUF, making ASCIZ sting in ARGBUF.
ARGCT: 0 ;These two words are a string variable containing ARGBUF.
ARGPT: 440700,,ARGBUF
ALTARG: BLOCK JCLBFL ;Used to save a way one arg while reading another.
NCPJNM: SIXBIT /NCPFTP/ ;Name of job to do old-style (NCP based) FTPing.
SUBTTL Initialization and Main Loop
GO: MOVE P,PDL ;Set up PDL and TTY
SETOM TYITTY
SETOM TYOTTY
SETZM TRITTY
SETZM TROTTY
SETZM DISTTY
SETZM HDXTTY
SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TYIC ? [SIXBIT /TTY/]]
SETZM TYITTY ;Sometimes we dont have a TTY to read from.
SYSCAL RFNAME,[%CLIMM,,TYIC ? %CLOUT,,B]
.LOSE %LSFIL
CAME B,['TTY,,] ;If the device name is not "TTY"
SETOM TRITTY ; there must be an input translation.
SYSCAL TTYGET,[%CLIMM,,TYIC ? %CLOUT,,B ? %CLOUT,,C]
JRST GO1
ANDCM B,[606060606060] ;If TYIC really has a TTY, turn off echo.
ANDCM C,[606060606060]
TLO C,010000 ;Enable ^G/^S interrupts
SYSCAL TTYSET,[%CLIMM,,TYIC ? B ? C]
.LOSE 1400
GO1: SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TYOC ? [SIXBIT /TTY/]]
SETZM TYOTTY ;No typeout is maybe OK, if have script XFILE.
SYSCAL RFNAME,[%CLIMM,,TYOC ? %CLOUT,,B]
.LOSE %LSFIL
CAME B,['TTY,,] ;If the device name is not "TTY"
SETOM TROTTY ; there must be an output translation.
SETZM DISTTY
SYSCAL CNSGET,[%CLIMM,,TYOC ? REPEAT 4,[%CLOUT,,JUNK ?] %CLOUT,,A]
JRST GO2
TLNE A,%TOOVR ;DISTTY on also for glass TTY's
TLNE A,%TOERS ;DISTTY gets -1 if we are on a display TTY.
SETOM DISTTY
TLNE A,%TOHDX ;HDXTTY gets -1 if half duplex (shouldn't echo).
SETOM HDXTTY
GO2: .SUSET [.RXJNAM,,B] ;Look at our job name.
TLO F,%LTCP ;We usually do TCP based FTPing.
CAMN B,NCPJNM ;But if our jname is the magic one
JRST [ TLZ F,%LTCP ; we wont use the Internet FTP.
SETZM USETCP
SETZM USENCP
JRST .+1]
MOVEI A,FTPORT ;TCP means we use this port.
TLNN F,%LTCP
MOVEI A,FTPSKT ;NCP means this is the ICP socket
MOVEM A,ICPSOC ;Remember which port or socket to use.
MOVEI A,LSTPAG
MOVEI B,0
PUSHJ P,NETWRK"HSTMAP ;Read in HOSTS3 at LSTPAG
.LOSE
MOVE B,A ;Then make ARPAGS point at all pages left above it.
SUBI B,400 ;HSTMAP leaves A pointing to first unused page.
HRL A,B
MOVEM A,ARPAGS
UARINIT ARPAGS ;initialize core
STRINIT ;initialize strings
OUTOPN TYOC,[$UCXCT,,[PUSHJ P,UUOTYO]]
OUTOPN SCRIPC, ;allow uuos to type out
MOVE A,[NETWRK"NW%ARP] ;Get own host number, on Arpanet
PUSHJ P,NETWRK"OWNHST
.LOSE ;Not connected to Arpanet?
MOVEM A,OWNHST
.SUSET [.RSNAME,,FILDIR]
MOVE A,FILDIR
MOVEM A,COMDIR
MOVEM A,SCRIPS
.SUSET [.ROPTION,,TT] ;Get JCL if present
TLZN TT,OPTCMD
JRST NOJCL
SETZM JCLBUF
MOVE A,[JCLBUF,,JCLBUF+1]
BLT A,JCLBFE
.BREAK 12,[5,,JCLBUF]
MOVE A,JCLP ;If JCL contains an underscore, an implied TRAN
SETOM JCLFLG
TRNCH1: ILDB B,A
CAIE B,^C
CAIN B,^M
JRST TRNCH2
JUMPE B,TRNCH2
CAIE B,"_
CAIN B,"
JRST TRNCH3
CAIE B,"=
JRST TRNCH1
TRNCH3: SOS JCLP ;insert TRAN<sp> in front of JCL
SETOM SUICID ;and exit after completing the transfer.
SETOM JCLTRN ;Suppress the "n bits in m seconds" printout.
TRNCH2: SKIPN JCLBUF
NOJCL: SETZM JCLP
.SUSET [.ROPTION,,TT]
TLO TT,%OPOPC
.SUSET [.SOPTION,,TT]
.SUSET [.SMASK,,[%PIIOC]] ;Enable IOC interrupts
SKIPN TRITTY
.SUSET [.SMSK2,,[1_TYIC]] ;Enable ^G/^S interrupts
JRST MAIN
SUBTTL Main loop.
;Come here after finishing a command, or after an error.
MAIN: PUSHJ P,STILOPN ;If connection was closed by other side, tell user.
PUSHJ P,GRATU ;Check for gratuitous reply from server
TLNE F,%LTCP ;If using Internet FTP,
JRST [ .CLOSE NETDI, ; we use a new PORT each time.
.CLOSE NETDO,
JRST .+1 ]
SKIPE JCLFLG ;Prompt for input unless supplied by superior.
JRST MAIN2
SKIPN CNECTD
OUTI TYOC,"$ ;Prompt with $ if connected, $$ if not.
OUTI TYOC,"$
MAIN2: PUSHJ P,ARGSPC
[ASCIZ //]
LDB A,[350700,,ARGBUF]
JUMPE A,MAIN1 ;Null command is OK. Do nothing.
MOVEI A,ARGBUF
MOVE E,[-COMTBL,,COMTAB]
PUSHJ P,NETWRK"SYMLOOK ;Gobble Command
JRST MAIN3 ; Not a command - try it as a host name.
CAMN B,[-1] ;Numbers are not allowed as commands.
JRST ERRCOM
HLRZ A,(B)
PUSHJ P,(A) ;get address out of table and call the command.
JRST ERRTR1 ;No skip => failed; flush typeahead of all sorts.
MAIN1: SKIPE SUICID
JRST QUIT
JRST ERRTR2
MAIN3: MOVE P,PDL
MOVEI A,ARGBUF ;Couldn't parse command as command name => rescan it
PUSHJ P,NHOSTN ;and try it as a host name.
JRST ERRCOM ; Doesn't make sense as either?
PUSHJ P,CONN ;Command is host number, connect to it
JRST ERRTR1 ;Failure to conect is an error.
JRST MAIN1
ERRCOM: OUTZ TYOC,[ASCIZ /Invalid command or host name?
/]
JRST ERRTR1
ERRCTX: OUTZ TYOC,[ASCIZ /Command not supported under TCP
/]
JRST ERRTR1
ERRHST: OUTZ TYOC,[ASCIZ/Invalid host name?
/]
ERRTR1: SKIPE TYITTY
.RESET TYIC,
SKIPE COMFIL
OUTZ TYOC,[ASCIZ /Closing Command File
/]
.CLOSE COMC,
SETZM COMFIL
SETZM JCLBUF
MOVE A,[440700,,JCLBUF]
MOVEM A,JCLP
SETZM JCLTRN
SETZM SUICID
ERRTR2: MOVE P,PDL ;Fix up PDL before re-entering main loop.
MOVE A,JCLP ;If there's no JCL, next ARG would find out,
ILDB A,A ;but check now so that we prompt before next ARG.
SKIPN A
SETZM JCLFLG
JRST MAIN ;Now go reenter main loop.
SUBTTL Command Tables
COMTAB:
DEFINE CMD NAME,LOC,HELP/
IFNB [HELP] TMPLOC HLPTAB+.-COMTAB, [ASCIZ\HELP\]
LOC,,[ASCIZ\NAME\]
TERMIN
IF1 HLPTAB==0 ;loc of HLPTAB not known until size of COMTAB known
CMD ?,AHELP
CMD NCP,DONCP,Switch to NCP mode.
CMD TCP,DOTCP,Switch to TCP mode.
CMD ACCT,AACCT,Send Account Name
CMD ALLOCATE,AALLOC,Give Size of File to be STOREd
CMD APPEND,AAPPE,Append Local File to Foreign File
CMD ASCII,ATEXT,Transfer File as ASCII Text (TYPE A, BYTE 8)
CMD BYE,ABYE,Disconnect, Giving Server Warning
CMD BYTE,ABYTE,Set Byte Size
CMD CONNECT,ACONN,Connect to Host
CMD CWD,ACWD,Change Foreign Working Directory
CMD DBGET,ADBGET,Debugging get file
CMD DBPUT,ADBPUT,Debugging put file
CMD DEBUG,ADBUG,Toggle Whether to Print Server Replies
CMD DEFAULTS,ADEFA,Set Local Filename Defaults
CMD DELETE,ADELE,Delete File
CMD DIRECTORY,ALSTF,List Foreign File Directory
CMD DISCONNECT,ADISC,Disconnect from Host
CMD DISOWN,ADISOW,Run disowned
CMD ESCRIPT,AESCRIP,Close Script File
CMD GET,AGET,Get File from Foreign Host
CMD HELP,AHELP,List Commands and What They Do
CMD HOSTS,AHSTS,List Hosts
CMD ICPSOCKET,AICPS,Set ICP Socket Number
CMD LISTB,ALSTB,List Foreign Directory Briefly (filenames only)
CMD LISTF,ALSTF,List Foreign File Directory
CMD LISTL,ALSTL,List Local File Directory
CMD LOGIN,ALOGIN,Login to Foreign Host
CMD PASS,APASS,Send Password
CMD PRINT,APRIN,Print File on ML TPL
CMD PROCEED,APROCD,Run without the TTY
CMD PUT,APUT,Put File onto Foreign Host
CMD Q,AQUIT,Leave FTP
CMD QUIT,AQUIT,Leave FTP
CMD QUOTE,AQUOT,Send Arbitrary Command to Server
CMD RENAME,ARENAM,Rename a File at Foreign Host
CMD RETRIEVE,AGET,Get File from Foreign Host
CMD SCRIPT,ASCRIP,Open Script File (gets all typeout)
CMD SEND,APUT,Put File onto Foreign Host
CMD SILENT,ASILNT,Stop typing on the TTY
CMD SOAK,ASOAK,Wait for and Print One Reply From Server
CMD STATUS,ASTAT,Print Server Status
CMD STORE,APUT,Put File onto Foreign Host
CMD TEN,ATEN,Transfer File in Most Efficient Mode (If Both Hosts PDP10s)
CMD TEXT,ATEXT,Transfer File as ASCII Text (TYPE A, BYTE 8)
CMD TRANSFER,ATRAN,Transfer host1filespec_host2filespec
CMD TYPE,ATYPE,Specify Type of Transfer
CMD VALRET,AVALR,Return to superior, not suicidally
CMD XFILE,AXFILE,Read Commands From File
COMTBL==.-COMTAB
IF1 EXPUNGE HLPTAB
HLPTAB: BLOCK COMTBL
SUBTTL Routines called by NETWRK
;PUTCHR Routine. Writes character from T, clobbers no ACs, never skips.
;Called by NETWRK's error analysis routine ANALYZE.
PUTCHR:
;Output to script file if any.
;Output to TTY unless have both com file and script file.
TYO: SKIPE SCRIPT ;Write to script file if we have one.
SKIPE READIN ; Except inside TYILIN.
CAIA
.IOT SCRIPC,T
SKIPE SILENT
POPJ P,
SKIPN SCRIPT
SKIPE TYOTTY
CAIA
JRST DIE ;Nothing to type out on???
SKIPE COMFIL
SKIPN SCRIPT
SKIPN TYOTTY
POPJ P,
.IOT TYOC,T ;Type on TTY if we can
POPJ P, ;unless we have an XFILE and a script.
;IO UUOs on channel "TYOC" XCT UUOTYO for each char.
UUOTYO: PUSH P,T
MOVE T,U1
PUSHJ P,TYO
POP P,T
POPJ P,
;Call "HSTLOOK to translate asciz string <- A into a host number.
;Then set bit 4.9 in A if the host is a PDP10.
NHOSTN: PUSHJ P,NETWRK"HSTLOOK
POPJ P,
MOVE B,A ;Host number in B
PUSHJ P,NETWRK"HSTSRC ;Get SITES table entry addr in D.
JRST [ MOVE A,B ? JRST POPJ1]
MOVE A,B
HLRZ T,NETWRK"STLSYS(D) ;Find host's operating system.
ADD T,NETWRK"HSTADR ;If we guess it's a PDP10,
MOVE T,(T) ; we will be able to use 36 bit mode.
MOVSI TT,-NTENS
NHOST1: CAMN T,TENS(TT)
TLO A,400000 ;Set bit 4.9 in A if machine is a PDP10.
AOBJN TT,NHOST1
JRST POPJ1
;;; Well-known PDP-10 operating systems (machine types are too varied).
TENS: ASCII /ITS/ ;Incompatible Timesharing System
ASCII /WAITS/ ;Wise-assed incompatible timesharing system
ASCII /TOPS1/ ;TOPS-10
ASCII /TOPS2/ ;TOPS-20
ASCII /TENEX/ ;BBN TENEX
ASCII /FOONE/ ;Foonly
ASCII /AUGUS/ ;Foonly
ASCII /TYCOM/ ;Foonly
NTENS==.-TENS
INCHR: ILDB T,JCLP ;Get next JCL char or 0 if exhausted.
JUMPN T,CPOPJ
;If exhausted, read in another line and return its 1st char.
PUSHJ P,TYILIN
JRST INCHR
;Read an argument from the terminal. If there is any of a previous line left,
;we use that; otherwise we read a new line, prompting first. The call should
;be followed by a pointer to the prompt string. Leading and trailing spaces
;are discarded, as is the CR at the end.
;On return, A points at ARGCT, which looks like a string var containing the
;argument, which is an ASCIZ string in ARGBUF.
ARGCON: PUSHJ P,CONTST ;Read arg, but first establish connection if nec.
ARG: SETZM TRANFL'
CAIA
ARGTRN: SETOM TRANFL ;Here to read arg for TRAN command -
;Stop on = or _ or .
SETZM SPCFL'
CAIA
ARGSPC: SETOM SPCFL ;Here to read an arg that a space can terminate.
PUSH P,B
PUSH P,T
MOVE B,JCLP ;Is there any input already?
ILDB B,B
MOVE T,@-2(P)
SKIPN B
OUTZ TYOC,(T) ;If not, prompt the user for some.
MOVE B,[440700,,ARGBUF]
MOVEM B,ARGPT
SETZM ARGCT
ARG1: PUSHJ P,INCHR
CAIN T,40
JRST ARG1
ARGLP: CAIN T,^M
JRST ARGFIN
CAIN T,^C
SETOM SUICID
CAIE T,^C ;Can appear in JCL, not snarfed by TYILIN.
CAIN T,^N
JRST ARGFIN
CAIN T,40 ;In ARGSPC, space terminates once arg is non-null.
SKIPN SPCFL
CAIA
JRST ARGFIN
SKIPN TRANFL ;In TRAN, filenames are terminated by _ or = or 
JRST ARGNRM
CAIE T,"= ;so we must be able to ^Q those characters.
CAIN T,"_
JRST ARGFIN
CAIN T,"
JRST ARGFIN
CAIN T,^Q
JRST ARGCTQ
ARGNRM: IDPB T,B
AOS ARGCT
PUSHJ P,INCHR
JRST ARGLP
ARGCTQ: IDPB T,B ;Here for "^Q - put it in the string, then don't
; look for _ or  or = in next char.
AOS ARGCT
PUSHJ P,INCHR
CAIE T,"= ;^Q followed by a _, , = or ^Q =>
CAIN T,"_ ; store the quoted character only.
JRST ARGNRM
CAIN T,"
JRST ARGNRM
CAIN T,^Q
JRST ARGNRM
CAIN T,^M ;CR isn't suppressed by ^Q.
JRST ARGFIN
PUSH P,T ;^Q followed by anything else.
;Store both the ^Q and it.
MOVEI T,^Q
IDPB T,B
AOS ARGCT
POP P,T
JRST ARGNRM
ARGFIN: LDB T,B ;Here for a CR "( or _ or  or = in TRAN command),
CAIE T,40 ; to end the arg.
JRST ARGFI2 ;Flush trailing spaces.
D7BPT B
SOS ARGCT
JRST ARGFIN
ARGFI2: SETZ T, ;Make sure the arg is an ASCIZ string.
IDPB T,B
POP P,T
POP P,B
MOVEI A,ARGCT ;Return a pointer to a string var
; containing our stuff.
JRST POPJ1
;Throw away rest of line if already read, but if no buffered input don't read any.
FLSLIN: PUSH P,T
MOVE T,JCLP ;If last char read was "EOL",
;we have nothing to flush.
LDB T,T
CAIE T,^M ;This happens when you type,
;eg, PROCEED<cr> with no space.
CAIN T,^N
JRST POPTJ
CAIN T,^C
JRST POPTJ
FLSLI1: PUSHJ P,INCHR
CAIN T,^C
SETOM SUICID
CAIN T,^N
JRST POPTJ
CAIE T,^M
CAIN T,^C
JRST POPTJ
JRST FLSLI1
SUBTTL Connect/Disconnect commands
;CONNECT command.
ACONN: PUSHJ P,ARG
[ASCIZ /host: /]
MOVEI A,ARGBUF
PUSHJ P,NHOSTN
JRST ERRHST
JRST CONN
;Connect to host specified in bits 4.8-1.1 of A.
;For NCP, sign(A) should be 1 to try to use image mode.
;For TCP, we only know how to do ASCII for now.
CONN: JUMPE A,ERRHST ;Meaningless host name.
PUSH P,A
PUSHJ P,BYE ;Flush any existing connection.
JFCL
POP P,A ;A has host number.
SETZM DCTYPE ;Start out assuming ASCII mode
MOVEI B,8.
MOVEM B,DCBYTE ;8-bit bytes.
SETOM DCSENT ;And we are probably content with that too.
TLZE A,(SETZ) ;If it's a PDP10, try to use 36-bit Image.
JRST [ SETZM DCSENT
SKIPE JCLTRN
JRST .+1 ;No message if doing JCL tran command
FWRITE TYOC,[[Will use 36-bit image transfer (TEXT command gives 8-bit ascii mode)],CRLF,,]
JRST .+1 ]
TLNN F,%LTCP
JRST NCPCON ; Dispatch for NCP/TCP processing
TCPCON: MOVEM A,FDHST ;Remember foreign host number.
MOVE B,FDHST
MOVEI A,NETI
MOVE C,ICPSOC
PUSHJ P,NETWRK"TCPCON
JRST NETERR
SETOM CNECTD ;We are now connected sompleace.
JRST ACONN1
NCPCON: MOVE B,A ;Host #
MOVEM B,FDHST
MOVEI A,ICPCH ;Pin #
MOVE C,ICPSOC ;Foreign socket
MOVEI T,FTPSKT
MOVEM T,ICPSOC
MOVE D,[40+.UAI,,40+.UAO] ;Modes
PUSHJ P,NETWRK"ARPICP ;Connect it up
JRST NETERR ;Failed => return error message.
SETOM CNECTD
SYSCAL RCHST,[MOVEI NETI
MOVEM JUNK ;NET
MOVEM LDSOC ;Local socket
MOVEM FDSOC ] ;Foreign socket
.LOSE 1000
MOVEI A,2
ADDM A,LDSOC ;Relocate to data socket base
AOS FDSOC
ACONN1: OUTOPN NETO, ;Prepare for using output UUOs on NETO.
MOVEI A,300. ;Expect 300 Initial Greeting
TLNE F,%LTCP ;If using TCP
MOVEI A,220. ; the greeting is 220.
PUSHJ P,REPLY ;Get reply, skip if winning
JRST ERDISC ;Reply says connection no good => disconnect.
PUSHJ P,REPDIS ;Print the text of the greeting message.
JRST POPJ1
ERDISC: PUSHJ P,DISC
JFCL
JRST ERRTR1
ADISC:
ABYE: PUSHJ P,FLSLIN ;BYE command. No-op if we have no server.
BYE: PUSHJ P,STILOPN
PUSHJ P,GRATU ;Check for gratuitous reply from server.
SKIPN CNECTD
JRST POPJ1
OUTZ NETO,[ASCIZ /QUIT
/]
MOVEI A,221. ;Wait for acknowledgement, then disconnect.
PUSHJ P,REPLY
JFCL ;You don't want to disconnect?
;Too bad! We will anyway.
DISC: SKIPN CNECTD ;Disconnect. No-op if not connected.
JRST POPJ1
SETZM CNECTD
.CLOSE NETO,
.CLOSE NETI,
JRST POPJ1
SUBTTL A few simple commands
AHELP: PUSHJ P,FLSLIN
MOVSI A,-COMTBL
AHELP1: SKIPN HLPTAB(A)
JRST AHELP2
FWRITE TYOC,[CRLF,,TZ$,COMTAB(A),TI,^I,TZ$,HLPTAB(A)]
AHELP2: AOBJN A,AHELP1
OUTZ TYOC,[ASCIZ\
You may also give just a host name or number if not already connected.
Terminate input with CR or LF. Use rubout to delete last character typed.
Commands and Host names may be abbreviated (if the abbreviation is
unambiguous).
\]
JRST POPJ1
AHSTS: PUSHJ P,FLSLIN ;HOSTS command - list all hosts. (Arpanet only)
MOVE A,NETWRK"HSTADR
MOVE B,NETWRK"NAMPTR(A)
ADD B,A ;Get addr of HOSTS3 file NAMES table.
MOVE C,(B) ;C gets number of entries.
MOVE D,1(B) ;D gets words per entry
ADDI B,2 ;B -> first entry
AHSTS1: HLRZ A,NETWRK"NMLSIT(B)
ADD A,NETWRK"HSTADR ;A gets addr of SITES table entry for this host.
HLRZ TT,NETWRK"STLNAM(A) ;Get relative address of the official name
HRRZ T,NETWRK"NMRNAM(B) ;Get relative address of this name
CAME T,TT
JRST AHSTS2 ;Don't mention nicknames
HLRZ TT,NETWRK"STLSYS(A)
ADD TT,NETWRK"HSTADR ;A gets addr of string containing type of system
MOVE TT,(TT)
CAME TT,[ASCIZ /TIP/] ;Dont mention TIPs. Can't FTP to them.
SKIPL NETWRK"STLFLG(A) ;Only mention servers
JRST AHSTS2
HRRZ A,NETWRK"STRADR(A) ;See if this guy is on Internet
AHSTS3: ADD A,NETWRK"HSTADR
MOVE TT,NETWRK"ADDADR(A)
TLNN TT,(NETWRK"NE%UNT) ; Skip if not an internet address.
JRST AHSTS4
HRRZ A,NETWRK"ADRCDR(A)
JUMPN A,AHSTS3
JRST AHSTS2
AHSTS4: ADD T,NETWRK"HSTADR
FWRITE TYOC,[TZ$,T,CRLF,,]
AHSTS2: ADD B,D ;B -> next entry
SOJG C,AHSTS1
JRST POPJ1
AQUOT: PUSHJ P,ARGCON
[ASCIZ /FTP protocol command to give to server: /]
JRST SNDARG
ASTAT: PUSHJ P,ARGCON
[ASCIZ /Server-dependent status-type: /]
OUTZ NETO,[ASCIZ /STAT/]
HRRZ D,(A) ;Get length of arg.
SKIPE D ;If user said anything,
OUTZ NETO,[ASCIZ / /] ;delimit cmd and arg.
JRST SNDARG
AICPS: PUSHJ P,ARG
[ASCIZ /Socket number: /]
PUSHJ P,RDOCT
MOVEM A,ICPSOC
JRST POPJ1
ASOAK: PUSHJ P,FLSLIN
ASOAK0: SETO A, ;Read in and print one reply from server.
PUSH P,PRREP
SETOM PRREP
PUSHJ P,REPLY
JFCL
POP P,PRREP
JRST POPJ1
ADBUG: PUSHJ P,FLSLIN
SETCMM PRREP ;DEBUG - complement printing of server replies.
SKIPN PRREP
OUTZ TYOC,[ASCIZ\not \]
OUTZ TYOC,[ASCIZ\printing server replies.\]
CRLF TYOC,
JRST POPJ1
DONCP: PUSHJ P,ABYE ;Can't change mode with conns open.
JFCL
OUTZ TYOC,[ASCIZ /Switching to NCP mode, which probably do anything good./]
CRLF TYOC,
TLZ F,%LTCP ;Say not doing TCP.
MOVEI A,FTPSKT ;NCP means this is the ICP socket
MOVEM A,ICPSOC ;Remember which port or socket to use.
MOVE A,[NETWRK"NW%ARP] ;Get own host number, on Arpanet
PUSHJ P,NETWRK"OWNHST
.LOSE ;Not connected to Arpanet?
MOVEM A,OWNHST
JRST POPJ1
DOTCP: PUSHJ P,ABYE ;Can't change mode with conns open.
JFCL
OUTZ TYOC,[ASCIZ /Switching to TCP mode./]
CRLF TYOC,
TLO F,%LTCP ;Say doing TCP.
MOVEI A,FTPORT ;TCP means we use this port.
MOVEM A,ICPSOC ;Remember which port or socket to use.
MOVE A,[SQUOZE 0,/IMPUS3/]
.EVAL A, ;If TCP, need the HOSTS3 format address instead.
.LOSE %LSSYS
MOVEM A,OWNHST
JRST POPJ1
AQUIT: PUSHJ P,FLSLIN
QUIT: PUSHJ P,BYE
JFCL
DIE: .CLOSE SCRIPC,
SKIPE DEBUG
.VALUE
.LOGOUT 1,
AVALR: PUSHJ P,FLSLIN ;Flush typed-ahead commands.
.BREAK 16,100000 ;Return to superior. Can be $P'd or $G'd.
JRST POPJ1
APROCD: SKIPA C,[[ASCIZ //]] ;Proceed command.
ADISOW: MOVEI C,[ASCIZ /  /];Disown command - disown self, keep running.
PUSHJ P,FLSLIN
MOVE A,JCLP
ILDB A,A ;If have input already buffered, it might
;contain an XFILE and SCRIPT, so we can't be
JUMPN A,ADISO1 ;sure user is losing.
SKIPN TRITTY ;If TTY input is translated,
SKIPE COMFIL ;or redirected with an XFILE, then input is OK.
CAIA
JRST ADISO2
SKIPN TROTTY ;If TTY output is translated
SKIPE SCRIPT ; or redirected with a SCRIPT,
CAIA ; OK.
ADISO2: JRST [ OUTZ TYOC,[ASCIZ /Can't DISOWN or PROCEED if using the TTY
/]
JRST ERRTR1]
ADISO1: SKIPE DEBUG
.VALUE
.VALUE (C)
SKIPN TROTTY ;If TTY output isn't translated,
SETOM SILENT ; we mustn't use it any more.
JRST POPJ1
ASILNT: PUSHJ P,FLSLIN
SETOM SILENT
JRST POPJ1
ALOGIN: PUSHJ P,ARGCON
[ASCIZ /as User name: /]
OUTZ NETO,[ASCIZ /USER /] ;Send the command name.
JRST SNDARG ;Send the arg, handle reply.
APASS: PUSHJ P,ARGCON
[ASCIZ/password: /]
OUTZ NETO,[ASCIZ /PASS /]
SNDARG: FWRITE NETO,[TZ,ARGBUF,CRLF,,]
MOVEI A,200.
JRST REPLY
AACCT: PUSHJ P,ARGCON
[ASCIZ /account number to log in under: /]
OUTZ NETO,[ASCIZ /ACCT /] ;Send the command name.
JRST SNDARG ;Send the arg, handle reply.
ACWD: PUSHJ P,ARGCON
[ASCIZ/to Directory: /]
OUTZ NETO,[ASCIZ /CWD /] ;Send the command name.
JRST SNDARG ;Send the arg, handle reply.
ADEFA: PUSHJ P,ARG ;DEFAULTS - just set local filename.
[ASCIZ /filename defaults: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR
JRST POPJ1
AALLOC: PUSHJ P,ARGCON ;ALLOC - send size for file to be STOREd.
[ASCIZ /# bytes: /]
OUTZ NETO,[ASCIZ /ALLO /]
JRST SNDARG
;Delete command.
ADELE: PUSHJ P,ARGCON
[ASCIZ /file: /]
OUTZ NETO,[ASCIZ /DELE /]
JRST SNDARG
;Rename command.
ARENAM: PUSHJ P,ARGCON
[ASCIZ /old file: /]
FWRITE NETO,[[RNFR ],TZ,ARGBUF,CRLF,,] ;Send the old name.
MOVEI A,350.
PUSHJ P,REPLY ;Wait for acceptance.
POPJ P,
PUSHJ P,ARG
[ASCIZ /to new name: /]
FWRITE NETO,[[RNTO ],TZ,ARGBUF,CRLF,,]
MOVEI A,250.
JRST REPLY
;PRINT command - print file on ML's TPL.
APRIN: MOVE B,FDHST
CAIN B,306
SKIPN CNECTD
CAIA
JRST APRIN2
MOVE A,[SETZ 306]
PUSHJ P,CONN ;First connect to ML (if not already connected).
POPJ P,
APRIN2: PUSHJ P,ARG ;Then ask for and open the disk file.
[ASCIZ/local file: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR
PUSHJ P,DCSEND ;Tell ML to use image mode.
SKIPLE TT,DCTYPE
SETO TT, ; Assume local-byte means image.
SYSCAL OPEN,[ (TT)1+[.BII,,DC ? .UAI,,DC]
FILDEV ? FILFN1 ? FILFN2 ? FILDIR ]
JRST FILERR
PUSHJ P,NETWLS
OUTZ NETO,[ASCIZ /STOR TPL:
/]
JRST APRIN1 ;Then go do a PUT to TPL:.
SUBTTL Connection Checking
;Commands that need to be connected before they can work call here
;If we aren't connected to a server, ask user which host and try to connect now.
CONTST: SKIPN CNECTD ;If no connection, ask for host name.
JRST CONTS1
PUSHJ P,STILOPN ;If have a server, check that it's really there.
SKIPE CNECTD ;If it is, we win.
POPJ P, ;Otherwise, ask for host to connect to.
SKIPE TYITTY ;In this case, any type-ahead
.RESET TYIC, ;must be intended for something else.
CONTS1: PUSHAE P,[A,JCLBFP,JCLP] ;? *******
MOVE A,[440700,,JCLBF2] ;Read host name using alternate buffer.
MOVEM A,JCLBFP
MOVEM A,JCLP
SETZM JCLBF2
PUSHJ P,ACONN
JRST ERRTR1
POPAE P,[JCLP,JCLBFP,A]
POPJ P,
SUBTTL Error Handling
;Handle File Error
FILERR: .OPEN ERRC,[.UAI,,'ERR ? 1]
.VALUE
FILER1: .IOT ERRC,TT
CAIL TT,40
JRST [ OUTI TYOC,(TT) ? JRST FILER1 ]
FWRITE TYOC,[[ - ],6F,FILDEV,[: ],6F,FILDIR,[; ],6F,FILFN1,[ ],6F,FILFN2,CRLF,,]
JRST ERRTR1
NOTTY: OUTZ TYOC,[ASCIZ /No TTY or Script file to read from
/]
JRST QUIT
;Here for error making data connection. We need to reset.
DCBORE: OUT(TYOC,("Timed out waiting for server to make data connection."),EOL)
JRST NETCLS
;Here for error making data connection. A server reply is expected
;and should be soaked up.
DCNERR: .LOGOUT 0,
PUSHJ P,NETWRK"ANALYZ
.VALUE
CRLF TYOC,
PUSHJ P,STILOPN
SKIPE CNECTD
PUSHJ P,ASOAK0
JFCL
JRST NETCLS
;Here is call to CONNEC or ICP loses.
NTERDI: MOVEI A,NETDI
NETERR: .LOGOUT 0, ;Die if no one to complain to.
PUSHJ P,NETWRK"ANALYZ ;Else print an error message.
.VALUE ; Sigh?
CRLF TYOC,
PUSHJ P,STILOPN ;See if TELNET connection seems to be closed.
;Here if lose inside GET or PUT. Close the files.
NETCLS: .CLOSE NETDO,
.CLOSE DC,
.CLOSE NETDI,
JRST ERRTR1 ;Go fix up stuff and safely restart main loop.
;Do nothing if we are not supposedly connected, or if we really
;are still connected. If supposedly connected but connection
;broken, make it official and tell the user.
STILOPN:SKIPN CNECTD ;Do nothing if we know there's no connection.
POPJ P,
SYSCAL WHYINT,[%CLIMM,,NETI ? %CLOUT,,A ? %CLOUT,,B]
JRST STILLS ;If channel is closed
ANDI B,-1 ;or socket state is closed
JUMPN B,CPOPJ ; then connection is broken.
STILLS: PUSHJ P,DISC ;So close channels, zero CNECTD, etc.
JFCL
OUTZ TYOC,[ASCIZ /Connection to Server has broken.
/]
POPJ P,
;If there is gratuitous input from the server, say so
GRATU: SKIPN CNECTD
POPJ P,
PUSHAE P,[A,B,C]
SYSCAL WHYINT,[%CLIMM,,NETI ? MOVEM A ? MOVEM B ? MOVEM C ]
JRST GRATU9
CAIN A,%WYNET
CAIG C,0 ;Have any input?
JRST GRATU9
OUTZ TYOC,[ASCIZ/
Note: gratuitous response from server:
/]
GRATU1: .IOT NETI,A
.IOT TYOC,A
SOJG C,GRATU1
CRLF TYOC,
GRATU9: POPAE P,[C,B,A]
POPJ P,
;Give final bullshit about bits per second
FRATE: SKIPE JCLTRN
JRST QUIT ;Skip this printout for implicit TRAN's from DDT.
SKIPN SCRIPT ;If we are disowned with no file to write in,
SKIPE TROTTY ;log out now rather than hanging up.
CAIA
.LOGOUT
.RDTIME T,
SUB T,NTIME
PUSH P,T
IMULI T,100.
IDIVI T,30. ;Time in hundredths of a second.
IDIVI T,100. ;T has time in seconds, TT has extra hundredths.
FWRITE TYOC,[N9,NBITS,[ bits in ],N10,T,N9,TT,[ seconds (]]
POP P,T
FSC T,233
FDVRI T,(30.0)
MOVE A,NBITS
FSC A,233
FDVRI A,(1000.0) ;kilobits
FDVR A,T
FWRITE TYOC,[NFL,A,[ kbps).],CRLF,,]
POPJ P,
SUBTTL NCP data transfer commands
AAPPE: TLNE F,%LTCP
JRST ERRCTX
PUSHJ P,APUT1
MOVEI A,[ASCIZ/APPE /]
JRST APUT2
APUT: TLNE F,%LTCP
JRST PUTTCP ;TCP is different.
PUSHJ P,APUT1
MOVEI A,[ASCIZ /STOR /]
APUT2: PUSH P,A
PUSHJ P,ARG
[ASCIZ/to foreign file: /]
PUSHJ P,NETWLS
POP P,B
FWRITE NETO,[TZ,(B),TS,(A),CRLF,,]
APRIN1: PUSHJ P,SOCK ;Look for 255 SOCK mumble
JRST NETCLS
MOVEI A,NETDO
PUSHJ P,NETWRK"CONFIN
JRST DCNERR ;lossage
.NETAC NETDO,
JRST DCNERR ;lossage
MOVEI A,250. ;Look for 250 socket to me
TLNE F,%LTCP
MOVEI A,125.
PUSHJ P,REPLY
JRST NETCLS ;lossage
PUSHJ P,REPDIS ;tell user transfer started successfully
SETZM NBITS
.RDTIME TT,
MOVEM TT,NTIME
MOVEI A,DC
MOVEI B,NETDO
SETOM XFRDIR
PUSHJ P,XFR ;Do the transfer (looks at the transfer mode).
SYSCAL FINISH,[MOVEI NETDO]
JFCL
.CLOSE NETDO,
MOVEI A,252. ;look for 252 finis
TLNE F,%LTCP
MOVEI A,226.
PUSHJ P,REPLY
JRST NETCLS ;lossage
PUSHJ P,FRATE
JRST POPJ1 ;winnage
;Do a listen on the output data socket.
NETWLS: PUSH P,A
SKIPE DCTYPE ;Ascii?
JRST NETWL1 ;Image.
MOVEI D,160+.UAO
MOVE A,DCBYTE
CAIN A,8
JRST NETWL2
FWRITE TYOC,[[Byte size ],N9,A,[ illegal with TYPE A; use BYTE 8],CRLF,,]
JRST ERRTR1
NETWL1: MOVE A,DCBYTE
MOVEI D,44160+.BIO
CAIN A,36.
JRST NETWL2
PUSHJ P,BSETUP
IORI D,160+.UIO
NETWL2: MOVEI A,NETDO ;Listen data connection
MOVE B,FDHST
HRLI D,400000
PUSHJ P,NETWRK"ARPCON
JRST NETERR ;lossage
POP P,A
POPJ P,
;Set up for doing image-mode transfer with strange byte size
BSETUP: CAIL A,1
CAILE A,36.
JRST [ FWRITE TYOC,[[Byte size ],N9,A,[ illegal with TYPE I, not between 1 and 36],CRLF,,]
JRST ERRTR1 ]
MOVE D,A
MOVEI A,36.
IDIV A,D
FWRITE TYOC,[[Will transfer ],N9,DCBYTE,[-bit bytes packed ],N9,A,[ per pdp-10 word, left-justified.],CRLF,,]
LSH D,9
POPJ P,
APUT1: PUSHJ P,CONTST ;Make sure we have a server set up.
PUSHJ P,DCSEND ;Make sure server knows about data type etc.
PUSHJ P,ARG
[ASCIZ/local file: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR
SKIPLE TT,DCTYPE
JRST [ MOVE TT,DCBYTE ; If logical-byte being used,
CAIE TT,36. ; Then if not 36-bit bytes
TDZA TT,TT ; we must use unit-mode for SIOT
SETO TT, ; otherwise hack block image for 36-bit xfers
JRST .+1]
SYSCAL OPEN,[ (TT)1+[.BII,,DC ? .UAI,,DC]
FILDEV ? FILFN1 ? FILFN2 ? FILDIR ]
JRST FILERR
POPJ P,
;Debugging version of PUT.
ADBPUT: TLNE F,%LTCP
JRST ERRCTX
PUSHJ P,APUT1
PUSHJ P,ARG
[ASCIZ/protocol command: /]
PUSHJ P,NETWLS
FWRITE NETO,[TZ,ARGBUF,CRLF,,]
JRST APRIN1
;PUT command for TCP
PUTTCP: PUSHJ P,CONTST ;Make sure we have a server set up.
PUSHJ P,DCSEND ;Make sure server knows about data type etc.
PUSHJ P,ARG
[ASCIZ/From local file: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR ;Read desired source file name.
SKIPLE TT,DCTYPE
JRST [ MOVE TT,DCBYTE ; If logical-byte being used,
CAIE TT,36. ; Then if not 36-bit bytes
TDZA TT,TT ; we must use unit-mode for SIOT
SETO TT, ; otherwise hack block image for 36-bit xfers
JRST .+1]
SYSCAL OPEN,[(TT)1+[.BII,,DC ? .UAI,,DC]
FILDEV ? FILFN1 ? FILFN2 ? FILDIR]
JRST FILERR ;Eh? cant open source file?
PUSHJ P,ARG
[ASCIZ/to foreign file: /]
PUSHJ P,TCPLSN ;Do a listen on the data socket.
FWRITE NETO,[[STOR ],TS,(A),CRLF,,]
.NETS NETO, ;Send the transfer command.
PUSHJ P,TCPWRI ;Transfer the file.
PUSHJ P,FRATE ;Print out statistics.
JRST POPJ1
;Send file over data socket (for TCP).
;This routine assumes we are listening for a data connection, and that
;we have given the storage command. Waits for the server to connect to
;us, and writes the file from channel DC to channel NETDO.
TCPWRI: PUSH P,A
PUSH P,B
MOVEI A,125. ;Make sure he is ready to send receive it.
PUSHJ P,REPLY ;This should be a "Socket to me".
JRST NETCLS
MOVEI A,%NSLSN ;Initial state to hang on.
MOVEI T,TIMOUT
TCPWR0: JUMPE T,DCBORE
SYSCAL NETBLK,[%CLIMM,,NETDO ? A ? T ? %CLOUT,,A ? %CLOUT,,TT]
JRST DCNERR
MOVE T,TT
CAIN A,%NSRFC ; If in SYN-RECEIVED state
JRST TCPWR0 ; then it's OK to keep waiting.
CAIE A,%NSOPN ; Else should be open now.
CAIN A,%NSRFN
CAIA
JRST TCPWR0
PUSHJ P,REPDIS ;Tell user transfer started successfully.
SETZM NBITS
.RDTIME TT,
MOVEM TT,NTIME
SETOM XFRDIR ; Outputting to network
MOVEI A,DC ;Source file open on this channel.
MOVEI B,NETDO ;Data connection open on this channel.
PUSHJ P,XFR ;Do the transfer.
TCPWR9: .CLOSE DC, ;Close file.
SYSCAL FINISH,[MOVEI NETDO]
JFCL
.CLOSE NETDO, ;Close data socket.
.CLOSE NETDI, ; Close unused reverse direction channel
MOVEI A,226. ;Look for 226 Finis reply.
PUSHJ P,REPLY
JRST NETCLS
POP P,B
POP P,A
POPJ P,
;GET command
AGET: PUSHJ P,CONTST ;Make sure we have a server set up.
PUSHJ P,DCSEND ;Make sure server knows about data type etc.
PUSHJ P,ARG
[ASCIZ/from foreign file: /]
MOVE A,[ARGBUF,,ALTARG]
BLT A,ALTARG+JCLBFL-1 ;Save it away.
PUSHJ P,ARG
[ASCIZ/into local file: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR ;Read desired local name.
SKIPLE TT,DCTYPE
JRST [ MOVE TT,DCBYTE ; If logical-byte being used,
CAIE TT,36. ; Then if not 36-bit bytes
TDZA TT,TT ; we must use unit-mode for SIOT
SETO TT, ; otherwise hack block image for 36-bit xfers
JRST .+1]
SYSCAL OPEN,[(TT)1+[.BIO,,DC ? .UAO,,DC]
FILDEV ? FTPOF1 ? FTPOF2 ? FILDIR]
JRST FILERR ;Eh? cant open temporary output file?
PUSHJ P,NETRLS ;Do a listen on the data socket.
ATRGET: FWRITE NETO,[[RETR ],TZ,ALTARG,CRLF,,]
ADBGT1: .NETS NETO,
MOVEI B,DC ;For GET, send output to Disk.
PUSHJ P,NETREAD ;Read the whole file and write it to DC.
MOVE B,FILDEV
CAMN B,[SIXBIT/TTY/] ;If outputting to the TTY
JRST AGET90 ; do not renaming.
SYSCAL RENMWO,[%CLIMM,,DC ? FILFN1 ? FILFN2]
JRST FILERR
AGET90: .CLOSE DC, ;Close file.
PUSHJ P,FRATE ;Print out statistics.
JRST POPJ1
;Listen for data connection we want to receieve.
;For NCP, do a listen on our input data socket.
;For TCP, use the PORT command for the "Quiet-Time" SYN hackery first.
;For both, we complete and accept the connection later.
;This routine returns always.
NETRLS: PUSH P,A
PUSH P,B
TLNN F,%LTCP
JRST NCPRLS ;If NCP FTPing, things are not necessarily ASCII.
TCPRLS: PUSHJ P,TCPLSN ;Offer and listen for a data connection.
JRST RLSDUN ;We are ready for the transferring command.
NCPRLS: SKIPE DCTYPE ;Ascii?
JRST NETRL1 ;Image or logical-byte
MOVEI D,160+.UAI ;THIS ROUTINE SMASHES D!
MOVE A,DCBYTE
CAIN A,8
JRST NETRL2
FWRITE TYOC,[[Byte size ],N9,A,[ illegal with TYPE A; use BYTE 8],CRLF,,]
JRST ERRTR1
NETRL1: MOVE A,DCBYTE
MOVEI D,44160+.BII
CAIN A,36.
JRST NETRL2
PUSHJ P,BSETUP
IORI D,160+.UII
NETRL2: MOVEI A,NETDI
MOVE B,FDHST
HRLI D,400000
PUSHJ P,NETWRK"ARPCON
JRST NETERR ;lossage
RLSDUN: POP P,B
POP P,A
POPJ P,
SUBTTL TCP Listen for data connection
;Start listening for a data connection from the foreign server on some port.
;When we have receieved the reply to the PORT command, return.
TCPLSN: PUSH P,A
MOVE A,ICPSOC ;Take the FTP server port number.
SUBI A,1 ;Subtract one.
SYSCAL TCPOPN,[%CLBIT,,%NOLSN ;Say we want to listen.
%CLIMM,,NETDI ;Data Receive channel.
%CLIMM,,NETDO ;Data Transmit channel.
[-1] ;Gensym a local listening port
A ;Try this foreign port.
FDHST] ;Frn host to listen for.
JRST NTERDI
SYSCAL RFNAME,[ %CLIMM,,NETDI ? %CLOUT,,JUNK
%CLOUT,,LPORT] ;This port is where we are listening.
.LOSE %LSSYS
OUT(NETO,("PORT ")) ;Need to tell server where to connect to.
MOVSI TT,-4 ;There are four fields in the address.
MOVE T,[401000,,OWNHST] ;Each field is 8. bits long.
TCPLS1: ILDB A,T ;Get the field.
OUT(NETO,D(A),(",")) ;Print that part as a decimal number.
AOBJN TT,TCPLS1 ;Print the entire address this way.
MOVE T,[201000,,LPORT] ;Now we want the port number.
ILDB A,T ;Get high eight bits of the port number.
OUT(NETO,D(A),(",")) ;Print them.
ILDB A,T ;Get low eight bits of th port number.
OUT(NETO,D(A),EOL) ;Print them, and wrap up the command.
.NETS NETO,
PUSHJ P,SOCK ;Wait for a reply that we are winning.
JRST [ OUT(TYOC,("Negative reply to PORT command."),CRLF)
JRST NETCLS]
POP P,A
POPJ P, ;Return, ready for transferring command.
SUBTTL Wait for 255 SOCK COMMAND.
;Skip return on success.
SOCK: PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,255. ;If NCP, look for 255 "SOCK mumble".
TLNE F,%LTCP ;If TCP,
MOVEI A,200. ; Look for 200 "PORT Ok".
PUSHJ P,REPLY
JRST [ POP P,C ? POP P,B ? POP P,A ? JRST CPOPJ ]
POP P,C
POP P,B
POP P,A
JRST POPJ1
;We used to store the argument to the SOCK reply into FDSOC; kludge,kludge.
IFN 0,[ MOVEI A,REPLYS
MOVEI B,40
PUSHJ P,PRSWRD ;255
MOVEI B,40
PUSHJ P,PRSWRD ;SOCK
HRRZ C,(B)
CAIE C,4
JRST SCKLOS
IRPC CH,,SOCK
ILDB C,1(B)
CAIE C,"CH
JRST SCKLOS
TERMIN
MOVEI B,0 ;Now get the decimal number
SOCK1: ILDB C,REPLYS+1
CAIL C,"0
CAILE C,"9
JRST SOCK2
IMULI B,10.
ADDI B,-"0(C)
JRST SOCK1
SOCK2: MOVEM B,FDSOC
POPJ P,
SCKLOS: OUTZ TYOC,[ASCIZ/Host did not send proper "255 SOCK nnnn" reply.
/]
JRST ERRTR1
] ;End IFN 0.
SUBTTL Read file over data socket
;This routine assumes we are listening on NETDI for a data connection,
;and that we have given the retreival command. Waits for the server to
;connect to us, and writes the file to the channel in B.
;Closes the data connection when done, and returns.
NETREAD:PUSH P,A ;Save an AC.
PUSH P,B ;Save channel to write to here.
TLNN F,%LTCP
JRST NETRE1 ;If NCP, go do ICP.
MOVEI A,125. ;For TCP, wait for positive "Here Comes"
PUSHJ P,REPLY ;reply before doing the listen,
JRST NETCLS ; since the file might not be there.
MOVEI A,%NSLSN ; Initial state to hang on.
MOVEI T,TIMOUT
TCPRD0: JUMPE T,DCBORE
SYSCAL NETBLK,[%CLIMM,,NETDO ? A ? T ? %CLOUT,,A ? %CLOUT,,TT]
JRST DCNERR
MOVE T,TT ; Boredom sets in eventually.
CAIN A,%NSRFC ; If in SYN-RECEIVED state
JRST TCPRD0 ; then it's OK to keep waiting.
CAIE A,%NSOPN ; Else should be open now.
CAIN A,%NSRFN
CAIA
JRST TCPRD0 ;If not OPEN or RFNM, keep waiting.
JRST NETRE2 ;When connected, go read data.
NETRE1: PUSHJ P,SOCK ;NCP needs a 255 SOCK mumble.
JRST [ OUT(TYOC,("Unexpected reply, should have been SOCK."),EOL)
JRST NETCLS ]
MOVEI A,NETDI
PUSHJ P,NETWRK"CONFIN ;NCP needs messy ICP too!
JRST DCNERR ; lossage
.NETAC NETDI, ;Accept the connection we were listening for.
JRST DCNERR
MOVEI A,250.
TLNE F,%LTCP
MOVEI A,125. ;Look for 125. Here it comes.
PUSHJ P,REPLY
JRST NETCLS
NETRE2: SETZM NBITS
.RDTIME TT,
MOVEM TT,NTIME
MOVEI A,NETDI
POP P,B ;Get back channel to write to (DC or TYOC).
SETZM XFRDIR
PUSHJ P,XFR ;Do the transfer (looks at DCTYPE, closes NETDI).
.CLOSE NETDO, ; TCP: make sure reverse chan closed too.
MOVEI A,252. ;If NCP, look for 252 "FINIS".
TLNE F,%LTCP ;If TCP,
MOVEI A,226. ; look for 226 "Transfer Complete".
PUSHJ P,REPLY
JRST [ OUT(TYOC,("Unexpected reply, should have been FINIS."),EOL)
JRST .+1 ]
POP P,A ;Pop saved ACs back off. (B already popped).
POPJ P,
;Debugging version of GET.
ADBGET: TLNE F,%LTCP
JRST ERRCTX
PUSHJ P,CONTST
PUSHJ P,ARG
[ASCIZ/into local file: /]
MOVE B,[FILDEV,,FILDEV] ;Read desired local filename
PUSHJ P,FILPAR
MOVE TT,FILDEV ;Output to TTY means use text mode
CAMN TT,[SIXBIT/TTY/]
JRST [ SKIPE DCSENT ;If server knows that we are in image mode
SKIPN DCTYPE
JRST [SETOM DCSENT
JRST .+1 ]
PUSHJ P,ATEXT ;then tell it to use ascii
JFCL
JRST .+1 ]
PUSHJ P,DCSEND
SKIPLE TT,DCTYPE
JRST [ MOVE TT,DCBYTE ; If logical-byte being used,
CAIE TT,36. ; Then if not 36-bit bytes
TDZA TT,TT ; we must use unit-mode for SIOT
SETO TT, ; otherwise hack block image for 36-bit xfers
JRST .+1]
SYSCAL OPEN,[ (TT)1+[.BIO,,DC ? .UAO,,DC]
FILDEV ? FTPOF1 ? FTPOF2 ? FILDIR ]
JRST FILERR
PUSHJ P,ARG
[ASCIZ/protocol command: /]
PUSHJ P,NETRLS ;Do listen on data socket before sending the command.
FWRITE NETO,[TZ,ARGBUF,CRLF,,]
MOVE B,FILDEV ;Output to TTY is special case
CAME B,[SIXBIT/TTY/]
JRST ADBGT1 ;Go join regular GET command
.CLOSE DC,
MOVEI B,TYOC
PUSHJ P,NETREAD
JRST POPJ1
SUBTTL TRAN Command
ATRAN: MOVE B,JCLP
ILDB B,B
SKIPN B ;If there's no input on same line as TRAN, prompt.
OUTZ TYOC,[ASCIZ /to-hostfile = from-hostfile:
/]
PUSHJ P,THOSTN ;Read the To-host.
JRST ERRTR1
LDB B,[4300,,A] ;All but sign
CAME B,OWNHST ;If to-host is us, this TRAN is a GET.
JRST ATRPUT
PUSHJ P,ARGTRN ;So read in the to-filenames,
[ASCIZ /To-filename: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR ;and parse them
PUSHJ P,THOSTN ;Read the From-host.
JRST ERRTR1
LDB B,[4300,,A] ;All but sign
SKIPE CNECTD
CAME B,FDHST ;If not already connected to it, connect.
CAIA
JRST ATRGE1
PUSHJ P,CONN
JRST ERRTR1
ATRGE1: PUSHJ P,DCSEND
MOVEI A,ARGCT
MOVE B,JCLP
ILDB B,B
CAIN B,^M ;If the from-file is null, default to the to-file.
JRST [ PUSHJ P,FLSLIN ;READ PAST THE CR.
JRST ATRGE2]
MOVE C,ARGCT
PUSHJ P,ARG ;Else read the from-file.
[ASCIZ/from foreign file: /]
MOVE B,[FILDEV,,FILDEV]
SKIPN C ;If the to-file was null, default to from-file.
PUSHJ P,FILPAR
ATRGE2: SKIPLE TT,DCTYPE ;Now open the local (to-) file.
JRST [ MOVE TT,DCBYTE ; If logical-byte being used,
CAIE TT,36. ; Then if not 36-bit bytes
TDZA TT,TT ; we must use unit-mode for SIOT
SETO TT, ; otherwise hack block image for 36-bit xfers
JRST .+1]
SYSCAL OPEN,[ (TT)1+[.BIO,,DC ? .UAO,,DC]
FILDEV ? FTPOF1 ? FTPOF2 ? FILDIR ]
JRST FILERR
FWRITE NETO,[[RETR ],TS,(A),CRLF,,]
ATRPUT: SKIPE CNECTD ;Here if to-host isn't us. This TRAN is a PUT.
CAME B,FDHST ;If not already connected to it, connect.
CAIA
JRST ATRPU1
PUSHJ P,CONN
JRST ERRTR1
ATRPU1: PUSHJ P,DCSEND ;If it's a PDP10, switch to TYPE I BYTE 36.
PUSHJ P,ARGTRN ;Read in the To-filename.
[ASCIZ /to foreign file: /]
MOVE A,[ARGBUF,,ALTARG]
BLT A,ALTARG+JCLBFL-1 ;Save it away.
;Will send after we read rest of command.
PUSHJ P,THOSTN ;Read the From-host.
JRST ERRTR1
LDB B,[4300,,A] ;All but sign
CAME B,OWNHST ;It must be us, if this is to be a PUT.
JRST [ OUTZ TYOC,[ASCIZ /TRAN must be either to or from the local host.
/]
JRST ERRTR1]
MOVE B,JCLP
ILDB B,B
MOVEI A,ARGCT
CAIN B,^M ;If the from-filename is null, default it to the
JRST [ PUSHJ P,FLSLIN
JRST ATRPU2] ; to-filename.
MOVE C,ARGCT
PUSHJ P,ARG
[ASCIZ/from local file: /]
JUMPN C,ATRPU2 ;If the to-file was null, use the from-file for it.
MOVE C,[ARGBUF,,ALTARG]
BLT C,ALTARG+JCLBFL-1 ;Save it away.
;Will send after we read rest of command.
ATRPU2: MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR
SKIPLE TT,DCTYPE
JRST [ MOVE TT,DCBYTE ; If logical-byte being used,
CAIE TT,36. ; Then if not 36-bit bytes
TDZA TT,TT ; we must use unit-mode for SIOT
SETO TT, ; otherwise hack block image for 36-bit xfers
JRST .+1]
SYSCAL OPEN,[ (TT)1+[.BII,,DC ? .UAI,,DC]
FILDEV ? FILFN1 ? FILFN2 ? FILDIR ]
JRST FILERR
PUSHJ P,NETWLS
FWRITE NETO,[[STOR ],TZ,ALTARG,CRLF,,]
JRST APRIN1
;HOSTNM for TRAN command - if there is no Altmode, we assume the host name
;was not specified, and default it to the local host.
;For TCP, I think this breaks.
THOSTN: MOVE B,JCLP ;Look ahead. See if next filespec preceded by altmode.
MOVE A,[440700,,THOSTB]
TSYMGL: ILDB T,B
CAIN T,^Q
JRST TSYMGQ ;^Q'd _'s, 's, and ='s don't count.
CAIE T,"=
CAIN T,"_ ;Reached the end of the next filename with no altmode
JRST TSYMDF ; => default the hostname.
CAIN T,"
JRST TSYMDF
TSYMG1: CAIE T,^C ;If end of jcl, stop
CAIN T,^M
JRST TSYMDF
CAIN T,^_ ;I bet you didn't know this ends JCL
JRST TSYMDF
JUMPE T,TSYMDF
CAIE T,33 ;Reached an altmode => host name explicitly spec'd,
JRST [ IDPB T,A
JRST TSYMGL]
MOVEM B,JCLP ;Mark it (and altmode) gobbled so filename doesn't
SETZ T, ;include them.
IDPB T,A
MOVEI A,THOSTB
JRST NHOSTN ;Read the host name and convert to number.
TSYMGQ: ILDB T,B
JRST TSYMG1
TSYMDF: MOVE A,OWNHST
TLO A,400000 ;Can lose if not running on a PDP10!
JRST POPJ1
SUBTTL Directory Listing Commands
ALSTL: PUSHJ P,ARG ;LISTL - list local directory
[ASCIZ /Directory: /]
MOVE B,[FILDEV,,FILDEV]
PUSHJ P,FILPAR ;Parse the directory specified.
;It becomes our default too.
SYSCAL OPEN,[ [.UAI,,DC]
FILDEV ? ['.FILE.] ? [SIXBIT /(DIR)/] ? FILDIR]
JRST FILERR
MOVEI A,DC
MOVEI B,TYOC
PUSHJ P,XFRASC ;Read whole file off DC and write to TYOC,
;flushing padding.
JRST POPJ1
;LISTF - list foreign directory
ALSTF: SKIPA A,[[ASCIZ /LIST /]]
ALSTB: MOVEI A,[ASCIZ /NLST /] ;LISTB - brief (names only) listing of directory.
PUSH P,DCBYTE
PUSH P,DCTYPE
PUSH P,DCSENT ;Save current connection status
PUSH P,A ;Save away the command type (FTP command to use).
PUSHJ P,CONTST ;If not connected yet, ask for host and connect.
MOVE A,DCBYTE
CAIN A,8 ;Switch to TYPE A BYTE 8 (if not there already).
SKIPE DCTYPE
JRST [ PUSHJ P,ATEXT
JRST ERRTR1
JRST .+1]
PUSHJ P,ARG ;Read in directory name, send to server.
[ASCIZ /Directory: /]
POP P,B ;Recover FTP command (LIST or NLST).
PUSHJ P,NETRLS
FWRITE NETO,[TZ,(B),TS,(A),CRLF,,]
.NETS NETO,
MOVEI B,TYOC
PUSHJ P,NETREAD ;Read what the LIST command sends us, and type on TTY.
POP P,C ;Now restore the old status.
JUMPE C,[ MOVEM C,DCSENT
SUB P,[2,,2] ;If DCSENT was 0, just restore it - thats all!
JRST POPJ1]
POP P,B ;Otherwise restore the TYPE, then the BYTE.
MOVE A,(P) ;If restoring to TYPE A, BYTE 8, don't bother
CAIN A,8
JUMPE B,[ MOVEM A,DCBYTE
MOVEM B,DCTYPE
SETOM DCSENT
POP P,A
JRST POPJ1 ]
MOVEI D,[ASCIZ /A/]
SKIPGE B
MOVEI D,[ASCIZ /I/]
SKIPLE B
JRST [ MOVEI D,[ASCIZ /L 36/]
CAIE A,36.
MOVEI D,[ASCIZ /L 8/]
JRST .+1]
PUSHJ P,ATYPE3
JRST ERRTR1
POP P,A
TLNE F,%LTCP
JRST POPJ1
PUSHJ P,ABYTE2
JFCL
JRST POPJ1
SUBTTL Type and Byte Commands.
;If have just connected, to a PDP10, try negotiating 36 bit image mode.
DCSEND: SKIPE DCSENT
POPJ P,
PUSHJ P,ATEN ;Specify TYPE I, BYTE 36.
POPJ P, ;He doesn't like them => proceed, using ASCII mode.
POPJ P,
;Set the transfer TYPE, and possibly the byte size.
ATYPE: TLNE F,%LTCP
JRST [ CALL ARGCON
[ASCIZ /A for ASCII, or L <size> for LOGICAL: /]
JRST ATYPE1 ]
PUSHJ P,ARGCON
[ASCIZ /A for ASCII, I for IMAGE: /]
ATYPE1: HRRZ D,(A)
MOVE D,1(A)
ILDB D,D ;Check the type he specified.
CAIL D,140 ;Uppercasify.
SUBI D,40
CAIE D,"L ;Logical type is hairy.
JRST ATYPE2
TLNN F,%LTCP ;Only allowed if doing TCP.
JRST ATYPEL
MOVE D,[ASCIZ "L 36"]
MOVEM D,ALTARG
MOVEI D,ALTARG ;Actual argument string for server.
HRLZI T,260700
HRR T,D ;Bp to byte size in it.
MOVE B,1(A) ;Bp to user's string.
ATYPL1: ILDB C,B
JUMPE C,[ OUT(TYOC,("Defaulting logical byte size to 36 bits."),EOL)
JRST ATYPE3 ]
CAIL C,60 ;Look for a number.
CAILE C,71
JRST ATYPL1
IDPB C,T ;Deposit first digit.
ILDB C,B ;There may be a second digit.
JUMPE C,ATYPL2
CAIL C,60
CAILE C,71
ATYPL2: SETZ C,
IDPB C,T ;Deposit second (and last) digit.
JRST ATYPE3
ATYPE2: CAIN D,"A
JRST [ MOVEI D,[ASCIZ /A/]
JRST ATYPE3 ]
CAIN D,"I
JRST [ TLNE F,%LTCP ;If doing NCP, allow type "I".
JRST ATYPEL
MOVEI D,[ASCIZ /I/]
JRST ATYPE3 ]
ATYPEL: FWRITE TYOC,[[? "],TS,(A),[" is not a type that I understand.],CRLF,,]
JRST ERRTR1
;Select TYPE according to ASCIZ string in D (e.g. "L 36").
ATYPE3: SETOM DCSENT ;Override defaults now.
FWRITE NETO,[[TYPE ],TZ,(D),CRLF,,]
PUSH P,D
MOVEI A,200. ;See whether server it likes it.
PUSHJ P,REPLY
JRST POPAJ
POP P,D ;Accepted.
SETOM DCTYPE ;DCTYPE gets 0 for ASCII, -1 for image.
HRLI D,350700
LDB T,D ;Get 1st char
CAIN T,"A
SETZM DCTYPE
CAIN T,"L
MOVMS DCTYPE ;Logical byte, set 1
JRST POPJ1
;Set data connection byte size. We only handle 8, 32 or 36-bit bytes.
ABYTE: TLNN F,%LTCP
JRST [ CALL ARGCON
[ASCIZ /Byte size (8 or 36): /]
CALL RDDEC
JRST ABYTE1]
PUSHJ P,ARGCON
[ASCIZ /Byte Size (8, 32 or 36): /]
PUSHJ P,RDDEC ;Now convert arg to binary in A.
CAIN A,32.
JRST ABYTE2 ;Is the byte size ok with us?
ABYTE1: CAIE A,8.
CAIN A,36.
JRST ABYTE2
ABYTEL: FWRITE TYOC,[[? "],N9,A,[" is not a byte size I can handle.],CRLF,,]
JRST ERRTR1
;Select BYTE size in A.
ABYTE2: TLNE F,%LTCP
JRST [ FWRITE NETO,[[TYPE L ],N9,A,CRLF,,]
JRST ABYTE3 ]
FWRITE NETO,[[BYTE ],N9,A,CRLF,,]
ABYTE3: SETOM DCSENT ;No need to send him our defaults - they are overridden now.
PUSH P,A
MOVEI A,200. ;Yes, send it to server and see if ok with him.
PUSHJ P,REPLY
JRST POPAJ
POP P,DCBYTE ;If so, remember it as the one we are using.
JRST POPJ1
;Select 36-bit Image mode.
ATEN: PUSHJ P,CONTST
MOVEI D,[ASCIZ /L 36/] ;TCP says it this way.
TLNN F,%LTCP
MOVEI D,[ASCIZ /I/] ;NCP says it this way.
PUSHJ P,ATYPE3
POPJ P,
TLNE F,%LTCP
JRST [ MOVEI A,36.
MOVEM A,DCBYTE
JRST POPJ1]
MOVEI A,36. ;If it wins, do the BYTE 36.
JRST ABYTE2
;Select 8-bit ASCII mode. Shorthand for TYPE A, BYTE 8.
ATEXT: PUSHJ P,CONTST
MOVEI D,[ASCIZ /A/]
PUSHJ P,ATYPE3 ;Try the TYPE A.
POPJ P,
TLNE F,%LTCP
JRST POPJ1
MOVEI A,8
JRST ABYTE2 ;If it wins, do the BYTE 8.
SUBTTL Script Files and Command Files
ASCRIP: PUSHJ P,ARG
[ASCIZ/Script file: /]
MOVE B,[SCRIPF,,SCRIPF]
PUSHJ P,FILPAR
SETZM SCRIPT
SYSCAL OPEN,[ [.UAO,,SCRIPC]
SCRIPF ? SCRIP1 ? SCRIP2 ? SCRIPS]
JRST FILERR
SETOM SCRIPT
JRST POPJ1
AESCRI: PUSHJ P,FLSLIN ;ESCRIPT - close script file. Flush the rest of the line.
SKIPN TYOTTY ;Closing script and can't type on tty =>
OUTZ TYOC,[ASCIZ /Note: committing suicide since can't type on TTY
/]
.CLOSE SCRIPC,
SETZM SCRIPT
JRST POPJ1
AXFILE: PUSHJ P,ARG
[ASCIZ/Command file: /]
MOVE B,[COMDEV,,COMDEV]
PUSHJ P,FILPAR
SETZM COMFIL
SYSCAL OPEN,[ [.UAI,,COMC]
COMDEV ? COMFN1 ? COMFN2 ? COMDIR]
JRST FILERR
SETOM COMFIL
JRST POPJ1
SUBTTL Reply Processing
;Call here with A containing the decimal number of expected reply.
;Skips if success reply seen, non-skip return if error reply seen,
;Handles intermediate conditions, requests for password, printing of replies, etc.
;Returns with B containing reply code found.
;The reply will be in the string variable REPLYS
REPLY: .NETS NETO, ;just in case
REPLY0: BCONC
PUSHJ P,REPLIN ;get a line, number prefix in RH(B), hyphen flag in SIGN(B)
JUMPGE B,REPLY2 ;jump if single-line
HRRZ C,B
AOJE B,[ECONC REPLYS ;Line with no reply code! Show it to user
SKIPN JCLTRN
OUTS TYOC,REPLYS
JRST REPLY0] ;and then ignore it.
PUSH P,C ;multi-line, gobble rest of it, concatenating all together.
REPLY1: PUSHJ P,REPLIN
JUMPL B,REPLY1 ;no number, get more
POP P,B
REPLY2: ECONC REPLYS ;REPLYS := reply string
SKIPE PRREP
OUTS TYOC,REPLYS
CAMN B,A ;expected reply?
JRST POPJ1 ;Yes, winning
CAILE B,999. ;range check reply code
JRST REPTY9 ;Anything over 999 is considered to be in the 900's
MOVE C,B ;No, get type of reply
IDIVI C,100. ; which is the hundreds digit
REPLY3: JRST @.+1(C) ;Jump to reply handler based on code first digit.
REPTY0
REPTY1
REPTY2
REPTY3
REPTY4
REPTY5
REPTY6
REPTY7
REPTY8
REPTY9
;0xx useless information. [Old protocol only.] Might be interesting, type it out.
REPTY0: PUSHJ P,REPDIS
JRST REPLY
;1xx positive preliminary reply. Might be interesting, type it out.
REPTY1: PUSHJ P,REPDIS
CAIL A,100. ; If expected reply was in 1xx range,
CAILE A,199.
JRST REPLY
JRST POPJ1 ; then take win return anyway...
;2xx positive completion reply.
;Indicates winnage, except not same code as expected so print.
REPTY2: PUSHJ P,REPDIS
JRST POPJ1
;4xx temporary error, 5xx permanent error, 6xx, 7xx, 8xx, 9xx undefined.
REPTY4: REPTY5: REPTY6: REPTY7: REPTY8: REPTY9:
REPTYE: SKIPN PRREP ;If PRREP, we already printed it, so don't do it again.
OUTS TYOC,REPLYS ;error message - print it including reply code.
POPJ P, ;lose
;3xx User action required.
;Special cases are 330 give password, 331 give account, 332 login please
;Others handled by caller saying e.g. 354 is what I expect.
REPTY3: TLNE F,%LTCP
JRST [ CAIN B,331.
JRST REP3PA
CAIN B,332.
JRST REP3AC
JRST REPTYE]
CAIN B,330.
JRST REP3PA
CAIN B,331.
JRST REP3AC
CAIN B,332.
JRST REP3LO
JRST REPTYE ;Unexpected 300 code - treat it as an error.
REP3PA: SETOM INHIDE ; Don't echo next input line. TYILIN resets.
JSP E,REP3GT
[ASCIZ/Password (safety of this password not guaranteed): /]
[ASCIZ/PASS/]
REP3AC: JSP E,REP3GT
[ASCIZ/Account: /]
[ASCIZ/ACCT/]
REP3LO: JSP E,REP3GT
[ASCIZ/Login Name: /]
[ASCIZ/USER/]
REP3GT: OUTZ TYOC,@(E)
PUSHJ P,ARG ;read the password or whatever.
[0]
OUTZ NETO,@1(E) ;send command the server wanted
OUTI NETO,40
OUTS NETO,(A) ;with the arg we read.
CRLF NETO,
JRST REPLY ;try again
;Routine to display a non-error reply. Doesn't print the reply code.
REPDIS: SKIPN JCLTRN ;Don't show it for :FTP FOO=BAR.
SKIPE PRREP ;or if it was already typed out.
POPJ P,
PUSHAE P,[A,B]
HRRZ A,REPLYS ;byte count
MOVE B,REPLYS+1 ;byte pointer
REPDS0: SOJL A,REPDS9
ILDB T,B ;flush reply code number and space or hyphen following it
CAIL T,"0
CAILE T,"9
CAIA
JRST REPDS0
CAIE T,40
CAIN T,"-
CAIA
REPDS1: PUSHJ P,TYO
CAIN T,^J
JRST REPDS0
SOJL A,REPDS9
ILDB T,B
JRST REPDS1
REPDS9: POPAE P,[B,A]
POPJ P,
;Routine to read in a line of reply.
;Returns in B: -1 if no reply code, reply code for single-line reply,
;400000,,reply code for first line of multi-line reply.
;If connection gets closed, returns via POP1J with -1 in B
REPLIN: SETO B,
REPLN0: .IOT NETI,TT
JUMPL TT,POP1J ;EOF
CAIN TT,^G ;rumor that BBN sends bells
JRST REPLN0
CAIN TT,177 ;Ignore random rubouts from Multics
JRST REPLN0
CAIN TT,377
JRST [ .IOT NETI,TT ;Ignore new-TELNET control codes from Multics.
JRST REPLN0]
CAIL TT,"0
CAILE TT,"9
JRST REPLN1
SKIPGE B
TDZA B,B
IMULI B,10.
ADDI B,-"0(TT)
OUTI STRC,(TT)
JRST REPLN0
REPLN1: CAIN TT,"-
HRLI B,(SETZ)
REPLN2: OUTI STRC,(TT)
JUMPL TT,POP1J ;EOF
CAIN TT,^J
POPJ P,
.IOT NETI,TT
JRST REPLN2
SUBTTL TTY Line Input
;Reads a line from the TTY or command file into JCLBUF (or wherever JCLBFP points).
;Clobbers no ACs
TYILIN: PUSHAE P,[A,B,C,E,T]
PUSH P,READIN ;For now, echo only on the TTY. After rubout processing
SETOM READIN ;is finished, we echo the edited command line on script file.
TYIOVR: SKIPE COMFIL
JRST TYILN4
SYSCAL RCPOS,[MOVEI TYOC ? MOVEM E]
.LOSE 1000
TYILN4: MOVE B,JCLBFP
MOVEM B,JCLP ;B is B.P. to store chars through.
TYILN0: SKIPN COMFIL
JRST TYILN2
.IOT COMC,A ;IF HAVE COMMAND FILE, READ FROM IT,
JUMPGE A,TYILN3
OUTZ TYOC,[ASCIZ /End of Command file
/]
.CLOSE COMC, ;(EOF => IT'S NOT OPEN ANY MORE)
SETZM COMFIL
SKIPN TRITTY ;If disowned and tty not input-translated, we can't read anything.
.LOGOUT
JRST TYILN9 ;Now pretend to read a null command, so we make the main loop prompt.
TYILN2: SETZM SILENT
SKIPN TYITTY ;ELSE IF HAVE TTY INPUT, READ FROM IT, ELSE BARF.
JRST NOTTY
.IOT TYIC,A
TYILN3: CAIE A,177
CAIGE A,40
JRST TYIRUB ;Jump if control
TYILN1: MOVE T,B
SUB T,JCLBFP
HRRES T
CAIL T,JCLBFL-1
JRST [ OUTI TYOC,^G ;Buffer full? Complain, don't store character.
JRST TYILN0]
SKIPE INHIDE ; Hiding input?
JRST TYILND ; Yes, don't echo.
SKIPE HDXTTY
SKIPE COMFIL
OUTI TYOC,(A) ;echo, if reading from TTY and it is full duplex.
TYILND: IDPB A,B ;stash away.
JRST TYILN0
TYIRUB: SKIPN COMFIL ;Don't recognize Rubout from command files.
CAIE A,177
JRST TYICTL
MOVE A,B
MOVE C,JCLBFP
IBP A
IBP C
CAMN A,C ;Rubout when buffer empty types a CRLF.
JRST [ CRLF TYOC, ? JRST TYIOVR ]
LDB A,B ;char getting rubbed
D7BPT B ;officially remove it from buffer.
SKIPE INHIDE ; If hiding input,
JRST TYILN0 ; needn't hack cursor.
SKIPN DISTTY
JRST TYIRUP ;jump if printing terminal
CAIL A,40
JRST [ OUTI TYOC,^P ? OUTI TYOC,"X ? JRST TYILN0 ]
TYIRDS: OUTI TYOC,^P
OUTI TYOC,"H
OUTI TYOC,10(E)
HLRZ A,E
OUTI TYOC,^P
OUTI TYOC,"V
OUTI TYOC,10(A)
OUTI TYOC,^P
OUTI TYOC,"L
TYILN8: SETZ A,
MOVE T,B
IDPB A,T ;Make the string ASCIZ.
SKIPN INHIDE ; Don't output if hiding it.
OUTZ TYOC,@JCLBFP
JRST TYILN0
TYIRUP: SKIPN INHIDE
.IOT TYOC,A
JRST TYILN0
TYICTL: CAIE A,33 ;altmode and tab are printing characters
CAIN A,11
JRST TYILN1
CAIN A,10 ;so is backspace
JRST TYILN1
CAIN A,^Q ;^Q is needed for quoting chars in filenames.
JRST TYILN1
CAIE A,^N ;^N also ends line (for JCL from DDT).
CAIN A,15 ;CR ends the line
JRST TYILN9
CAIN A,^J ;Ignore line feed
JRST TYILN0
SKIPE COMFIL ;Input editing controls not recognized in command files.
JRST [ CAIN A,^C
JRST TYILN0 ;Ignore ^C in command files.
JRST TYILN1]
CAIN A,^L ;^L redisplays input
JRST TYIFF
CAIN A,^U
JRST TYIKIL
CAIE A,^G ;^D and ^G flush input buffer
CAIN A,^D
JRST TYIKIL
CAIN A,^C ;^C ends input and requests suicide after command.
JRST TYICTC
JRST TYILN1 ;Other controls taken as ordinary characters. This really sucks,
;the right way to do this is to make ^Q quote the next character,
;unfortunately this code is too bad for me to fix it easily.
;This mainly for Tenex control-V.
TYIKIL: SKIPN DISTTY ; if printing tty,
JRST [ MOVE B,JCLP ? JRST TYIRS0 ] ; flush buffer, reprompt
MOVE A,B ; else, display terminal, wipe all chars
MOVE C,JCLBFP ; one at a time
IBP A
IBP C
CAMN A,C
JRST TYILN0
LDB A,B ;char getting rubbed
D7BPT B ;officially remove it from buffer.
SKIPE INHIDE ; If hiding input,
JRST TYIKIL ; needn't hack cursor.
CAIL A,40 ; else erase char from screen
JRST [ OUTI TYOC,^P ? OUTI TYOC,"X ? JRST .+1 ]
JRST TYIKIL
TYIRST: MOVE B,JCLP ;flush input we got so far.
TYIFF: SKIPE DISTTY
JRST [ OUTI TYOC,^P ;On display tty,
OUTI TYOC,"C ; set horzontial position to
MOVEI E,0 ;Change display-point to top-left corner
JRST TYIRDS ] ;and redisplay input
TYIRS0: SKIPN HDXTTY
.IOT TYOC,A ;echo the mumble
CRLF TYOC, ;redisplay on printing tty
JRST TYILN8
TYICTC: SETOM SUICID ;^C - say we should suicide soon.
SKIPN HDXTTY
.IOT TYOC,A ;Echo the ^C, then end the command.
TYILN9: SETZ A, ;Make input line end with null, for sake of outputting to SCRIPC.
IDPB A,B
POP P,READIN
SKIPN INHIDE
JRST [ SKIPE SCRIPT ;Output the line to the script file if any.
OUTPZ SCRIPC,JCLP
JRST .+1]
CRLF TYOC, ;This CRLF goes to TTY and to script file.
MOVEI A,^M ;Now make input line end properly, with CR-Null
DPB A,B
SETZ A,
IDPB A,B
SETZM INHIDE ; Crock, always reset after each call.
POPAE P,[T,E,C,B,A]
POPJ P,
SUBTTL Interrupt Level
TSINT: 0 ? 0
PUSHAE P,[T,TT,A]
SKIPGE A,TSINT
JRST TSINT2 ;I/O interrupts
TRNN A,%PIIOC
.VALUE ;non-enabled interrupt
.SUSET [.RBCHN,,A]
CAIL A,NETI
CAILE A,NETDO
JRST TSINT1 ;Not network
.DISMIS [NETERR] ;Network, inform user
TSINT1: HRLZ A,TSINT+1 ;Give error to DDT
HRRI A,1+.LZ %PIIOC ;and allow it to be continued
MOVEM A,TSINT
POPAE P,[A,TT,T]
.CALL [ SETZ ? 'DISMIS ? MOVEI ? TSINT+1 ? MOVEI ? MOVEI ? SETZ TSINT ]
.LOSE %LSSYS
TSINT2: TRNN A,1_TYIC
.VALUE
MOVEI A,TYIC
.ITYIC A,
JRST TSINT3
CAIE A,^G
JRST TSINT3
OUTZ TYOC,[ASCIZ/
QUIT
/]
.DISMISS [ERRTR1]
TSINT3: POPAE P,[A,TT,T]
.DISMISS TSINT+1
SUBTTL Data Transfer Routines
;Transfer the file open on the channel in A to the channel in B,
;using whichever mode is appropriate. Closes the input channel,
;but not the output. If the output channel specified is TYOC, we
;output via TYO to the TTY and/or script file.
; TCP transfers always use 8-bit bytes. The storage format to use
; is determined by DCBYTE and DCTYPE and the server is told which
; to use with the TYPE command.
; Svr cmd DCTYPE DCBYTE Description
; TYPE A 0 8 ASCII text. User stores as 7-bit bytes
; TYPE I -1 8, 36 Image. User stores as packed 36-bit words
; TYPE L 8 1 8 Logical byte 8. User stores as 8-bit bytes.
; TYPE L 36 1 36 Logical byte 36. Same as Image, but the right
; thing for PDP-10 binary file xfers.
XFR: SETZM NBITS
SETZM BUFFER ;Clear buffer - else, an ascii xfr after an image one
MOVE C,[BUFFER,,BUFFER+1] ;might set some low bits.
BLT C,BUFFER+BUFFL-1
SKIPE DCTYPE
JRST XFRIMG
;Transfer the file open on channel in A to the channel in B, in ASCII mode.
XFRASC: MOVEI D,BUFFL*5-5 ;Compute buffer size
CAIN B,TYOC
MOVEI D,20.
MOVEM D,XFRLBV
MOVEI D,BUFFER+BUFFL-1 ;And last-word pointer
CAIN B,TYOC
MOVEI D,BUFFER+4
MOVEM D,XFRLWP
MOVE C,[440700,,BUFFER]
MOVEI D,5 ;First read ahead one word.
SYSCAL SIOT,[A ? C ? D] ;When we output the buffer we always save 1 word,
.LOSE 1400 ;so that we can always flush up to 5 chars
;of padding (^C's or ^@'s).
JUMPG D,XFRAS2 ;Didn't get even 1 word => at EOF.
XFRASL: MOVE C,[440700,,BUFFER+1] ;Try to fill up buffer.
MOVE D,XFRLBV
SYSCAL SIOT,[A ? C ? D]
.LOSE 1400
JUMPG D,XFRAS1 ;Didn't fill it all up => at EOF, flush some padding.
MOVE C,[440700,,BUFFER]
MOVE D,XFRLBV ;Did fill it => output it, but save the last word,
PUSHJ P,XFRASO
MOVEI D,<BUFFL-1>*40.;8-bit ASCII, remember? 1 word is 5 bytes = 40 bits.
CAIN B,TYOC
MOVEI D,20.*8
ADDM D,NBITS
MOVE C,@XFRLWP ;Move last word down into first word.
MOVEM C,BUFFER
JRST XFRASL
XFRAS2: ADD D,XFRLBV
XFRAS1: MOVNS D
ADD D,XFRLBV
ADDI D,5 ;# chars we have in buffer now.
SYSCAL CLOSE,[A] ; Close empty input chan
.LOSE %LSFIL
SETZ A,
PTSKIP A,C ; Make BP canonical (can be 440700 from SIOT...)
XFRAS4: JUMPE D,CPOPJ ;Discard any number of ^@'s or ^C's, then one ^L.
LDB T,C
CAIE T,^C
JUMPN T,XFRAS3
D7BPT C
SOJA D,XFRAS4
XFRAS3: CAIE T,^L
JRST XFRAS5
D7BPT C
SOJE D,CPOPJ
XFRAS5: MOVE C,[440700,,BUFFER] ;Output what's left after flushing padding.
MOVE T,D
IMULI T,8
ADDM T,NBITS
;Output c(D) chars from b.p. in C to channel in B, handling TYOC specially.
XFRASO: CAIN B,TYOC
JRST XFRTTY
SYSCAL SIOT,[B ? C ? D]
.LOSE 1400
POPJ P,
XFRTTY: ILDB T,C
PUSHJ P,TYO
SOJG D,XFRTTY
POPJ P,
; Image transfer from channel in A to channel in B.
XFRIMG: TLNE F,%LTCP
JRST XFRIT ; Hack TCP local/image transfer
SKIPLE DCTYPE
JRST XFRLCL ; Logical-byte transfer
MOVE C,DCBYTE
CAIE C,36.
JRST XFRIM1 ; Go transfer bytes, not words
XFRIM4: MOVE C,[-BUFFL,,BUFFER] ; Read a bufferfull.
SYSCAL IOT,[A ? C]
.LOSE %LSFIL
JUMPGE C,[MOVE C,[-BUFFL,,BUFFER] ; Restore AOBJN ptr
SYSCAL IOT,[B ? C] ; And use to output buffer.
.LOSE %LSFIL
MOVEI C,36.*BUFFL
ADDM C,NBITS
JRST XFRIM4]
HRLOI C,-BUFFER-1(C) ; Put <#wds-1> in LH, -1 in RH
EQVI C,BUFFER ; And convert to AOBJN pointing to buffer.
MOVE D,C
SYSCAL IOT,[B ? C] ; And output rest of stuff.
.LOSE %LSFIL
SUBI C,(D) ; C gets number of words IOTed
IMULI C,36.
ADDM C,NBITS
XFRIM9: SYSCAL CLOSE,[A] ; Aha, got it all. Close empty input chan.
.LOSE %LSFIL
POPJ P,
XFRIM1: MOVEI C,36. ;Get bytes per word
IDIV C,DCBYTE
MOVEM C,XFRBPW
MOVE T,DCBYTE ;Get byte pointer to buffer
MOVE D,[440000,,BUFFER]
DPB T,[300600,,D]
SKIPL XFRDIR
JRST XFRIM2 ; Reading from net
MOVE C,[-BUFFL,,BUFFER] ; Read a bufferfull from disk
SYSCAL IOT,[A ? C]
.LOSE %LSFIL
MOVEI C,-BUFFER(C) ; Number of words read
IMUL C,XFRBPW ; Number of bytes to send
JUMPE C,XFRIM9 ; EOF
IMUL T,C
ADDM T,NBITS
SYSCAL SIOT,[B ? D ? C] ;Output them to net
.LOSE %LSFIL
JRST XFRIM1
XFRIM2: MOVEI C,BUFFL ;Read a bufferfull from net
IMUL C,XFRBPW
MOVE E,C
SYSCAL SIOT,[A ? D ? C]
.LOSE %LSFIL
SUBB E,C ;Number of bytes read
JUMPE E,XFRIM9 ;EOF
IMUL T,E
ADDM T,NBITS
IDIV C,XFRBPW
SKIPE D
ADDI C,1 ;Part word possible at EOF
MOVNS C
HRLZS C
HRRI C,BUFFER
SYSCAL IOT,[B ? C] ;Write to disk
.LOSE %LSFIL
JRST XFRIM1
; Local-byte Transfer.
XFRLCL: PUSHAE P,[C,D,E]
MOVEI C,BUFFER
MOVE D,DCBYTE ; Get byte-size
DPB D,[$SFLD,,C] ; Stick into size field of BP
TLO C,440000 ; Start at beg of word
MOVEI D,36.
IDIV D,DCBYTE ; Find # bytes in a word
MOVEM D,XFRBPW ; Save
IMULI D,XFRBFL ; Find # bytes in buffer
MOVE E,D ; Save cnt
PUSH P,C ; Save BP
XFRLC2: MOVE D,E ; Get # bytes max to read
MOVE C,(P) ; Restore BP
SKIPE XFRDIR
JRST [ MOVEI D,XFRBFL ; Nope, DSK... set # wds
HRLI C,444400 ; and use word-size bytes.
JRST .+1] ;
SYSCAL SIOT,[A ? C ? D] ; Slurp up
JSR AUTPSY
SKIPE XFRDIR
IMUL D,XFRBPW ; convert count to # bytes.
SUBM E,D ; Get # bytes read in D
MOVE T,D ; Stat cruft
IMUL T,DCBYTE
ADDM T,NBITS
JUMPLE D,XFRLC9
SKIPN XFRDIR
JRST [ PUSH P,E ; Pad out.
IDIV D,XFRBPW ; Find # words
CAILE E, ; Round up
AOS D
CAILE E, ; Pad out with zeros
PUSHJ P,[PUSH P,D
SETZ D,
IDPB D,C
POP P,D
SOS (P)
SOS (P) ; Call again til done.
SOJA E,APOPJ ]
POP P,E
JRST .+1]
MOVE C,(P) ; Restore BP
SKIPN XFRDIR
HRLI C,444400 ; use word-size bytes.
SYSCAL SIOT,[B ? C ? D] ; Output them
JSR AUTPSY
JRST XFRLC2
XFRLC9: POP P,C
POPAE P,[E,D,C]
POPJ P,
; XFRIT - TCP Image transfer. Network 8-bit bytes are packed into
; disk 36-bit words, and vice versa.
; A/ input channel
; B/ output channel
; XFRDIR/ -1 if outputting to net
XFRIT: SKIPLE DCTYPE ; Do a test of logical byte mode
JRST [ MOVE T,DCBYTE
CAIN T,36. ; Currently must be 36
JRST .+1
CAIN T,8.
JRST XFRLCL ; Hmm, try to hack this bytesize (shd be 8)
OUT(TYOC,("Cannot handle TYPE L "),D(DCBYTE),(", using TYPE L 8."),EOL)
JRST XFRLCL]
PUSHAE P,[C,D,E,R]
; TRNE F,%NTDIR
SKIPE XFRDIR
JRST XFRITO ; Output, from disk to net.
; TCP Image Input, network 8-bit bytes must be packed into
; 36-bit words.
XFR8BL==<<<XFRBFL*9>+7>/8.> ; # words in 8-bit byte buffer
; UAROPN [%ARTZM,,BUFFAR ? [XFRBFL]]
; UAROPN [%ARTZM,,TMPAR ? [XFR8BL]]
; MOVE E,$ARLOC+BUFFAR
MOVEI E,BUFFER
HRLI E,-XFRBFL ; Set up initial AOBJN to word buffer
MOVEI R,0 ; Point to beginning of cycle
XFRIT2: MOVEI D,4*XFR8BL ; # bytes to slurp from net
PUSH P,D
; MOVE C,$ARLOC+TMPAR
MOVEI C,TMPBUF
HRLI C,441000
SYSCAL SIOT,[A ? C ? D] ; Get input
JSR AUTPSY
; AOS ALIVEC ; Say we're still active
TRZ F,%TMP
CAILE D,
TRO F,%TMP ; Set flag if last slurp.
POP P,C ; Restore # bytes we asked for
SUBI C,(D) ; Find # bytes we got
MOVE D,C ; Stat cruft
LSH D,3
ADDM D,NBITS
IDIVI C,4 ; Get # words (rem in D)
JUMPE C,[
; HRR C,$ARLOC+TMPAR ; If no full words, skip stuff.
HRRI C,TMPBUF
JRST XFRIT4]
MOVN C,C
HRLZS C
; HRR C,$ARLOC+TMPAR ; Now have AOBJN to the fullwords we got
HRRI C,TMPBUF
JRST @XFITCT(R) ; Re-enter cycle at right place
; C has AOBJN to full words we received (4 8-bit bytes)
; D has # remaining bytes in last word
; E has AOBJN to disk output buffer
; R has # nibbles needed to fill out word in T. If 0, nothing in T.
XFITC0:
MOVE T,(C) ; Get word with 4 bytes left justified
LSH T,-4 ; Right-justify it.
AOBJP C,[MOVEI R,1 ; Jump if no more words
JRST XFRIT4] ; Handle wrapup stuff
IRP CNT,,[1,2,3,4,5,6,7,8]
XFITC!CNT: MOVE TT,(C) ; Get next one
LSHC T,CNT*4 ; Shift in to fill up word in T
MOVEM T,(E) ; Deposit word in buff
AOBJN E,.+2 ; Increment ptr, skip unless full
CALL XFITCB ; Force out word buff, reset E
IFN CNT-8,[ LSHC T,<32.-<CNT*4>> ; Shift in unused portion
AOBJP C,[MOVEI R,CNT+1 ; Jump if no more input
JRST XFRIT4] ; Go handle wrapup stuff
] ; all but last subcycle
TERMIN
AOBJN C,XFITC0 ; Back to start of cycle
MOVEI R,0 ; No more data. Say no nibbles needed
; Drop through
; No more 32-bit full words from input buffer.
; T contains partial data, right-justified.
; TT is empty, awaiting the next input word.
; D contains the # of bytes in the next input word.
; R has the # of nibbles left to fill out word in T (0-8)
XFRIT4: JUMPE D,XFRIT5 ; If no remaining data, just get new entry point!
MOVE TT,(C) ; Get last data word
LSH D,1 ; Turn # bytes into # nibbles
JUMPE R,XFRIT3 ; If nothing currently in T, must skip some stuff.
MOVEI C,(R) ; Assume enough data to fill last word
CAIG D,(R)
MOVEI C,(D) ; Not enough data nibbles, just shift in all
LSH C,2 ; 4 bits per nibble
LSHC T,(C) ; Shift in desired amount
CAIGE D,(R) ; Did we have enough to fill out the word?
JRST XFRIT3 ; Nope, don't deposit anything.
MOVEM T,(E) ; Have full word for deposit
AOBJN E,.+2
CALL XFITCB ; Output buff full, force out.
; Now shift in unused portion of data
XFRIT3: SUBI R,(D) ; Get new # nibbles needed
JUMPGE R,XFRIT5 ; If zero or positive, easy to set up.
MOVE C,R ; Negative, has # of data nibbles left in TT
IMUL C,[-4] ; 4 bits per nibble (make positive)
LSHC T,(C) ; Right-justify remaining data in T
ADDI R,9. ; Find # nibbles needed to fill out word
XFRIT5: TRNN F,%TMP ; Last slurp?
JRST XFRIT2 ; Nope, go get another slurp.
; Last slurp, so must left-justify any remaining data and deposit it.
; This code applies a heuristic to determine whether the remaining
; data should actually be written or not. Normally if the user
; FTP isn't buggy, R will either be 0 (no nibbles left) or
; 8 (1 nibble left over, since end fell in middle of an octet).
; If R isn't one of these, there was at least one full data byte
; that shouldn't have been sent. In that case we pad out the word
; and write it anyway.
JUMPN R,[
CAIN R,8. ; If only 1 nibble left (partial byte)
JRST .+1 ; then ignore and assume all's well.
LSH R,2 ; 4 bits per nibble
LSH T,(R) ; Note pad with zeros!
MOVEM T,(E) ; Store last (partial) word.
AOBJN E,.+1
JRST .+1]
CALL XFITCB ; Always force out.
JRST XFRIT9
XFITCT: XFITC0 ? XFITC1 ? XFITC2 ? XFITC3
XFITC4 ? XFITC5 ? XFITC6 ? XFITC7 ? XFITC8
; Force out word buffer, and reset write pointer in E
XFITCB: HRRZS E
; SUB E,$ARLOC+BUFFAR ; Find # words deposited
SUBI E,BUFFER
MOVNS E
HRLZS E
; HRR E,$ARLOC+BUFFAR ; Make it an AOBJN pointer
HRRI E,BUFFER
SYSCAL IOT,[B ? E] ; Image output (E has AOBJN)
JSR AUTPSY
; MOVE E,$ARLOC+BUFFAR ; Now initialize write ptr again
MOVEI E,BUFFER
HRLI E,-XFRBFL
RET
; XFR TCP Image Output, Disk to Net
XFRITO:
; UAROPN [%ARTZM,,BUFFAR ? [XFRBFL]]
; UAROPN [%ARTZM,,TMPAR ? [XFR8BL]]
XFRIT6: MOVSI C,-XFRBFL
; HRR C,$ARLOC+BUFFAR
HRRI C,BUFFER
MOVE D,C
SYSCAL IOT,[A ? C] ; Slurp stuff up
JSR AUTPSY
; AOS ALIVEC
TRZ F,%TMP
CAIGE C,
TRO F,%TMP ; Not counted out, this is last slurp.
HLRES C
HRLOI C,XFRBFL-1(C)
EQVI C,(D) ; Now have AOBJN to words we read in.
JUMPGE C,XFRIT9
HLRE D,C
IMUL D,[-9.] ; Find # of 4-bit nibbles
ADDI D,1
IDIVI D,2. ; Find # of 8-bit bytes.
MOVE T,D ; Stat cruft
LSH T,3
ADDM T,NBITS
PUSH P,D
; HRRZ E,$ARLOC+TMPAR
MOVEI E,TMPBUF
SUBI E,1 ; Allow for increment of first PUSH
TLO E,(SETZ) ; Make PDL ptr
XFRIT7: MOVE TT,(C) ; Get word 0
LSHC T,32. ; Get 1st 32 bits right justified
LSH T,4. ; Left justify it
PUSH E,T ; Store bytes 0-3
AOBJP C,XFRIT8 ; If counted out, must store last 4 bits.
REPEAT 7,[
LSHC T,4*<.RPCNT+1> ; Get low 4 bits of wd 0
MOVE TT,(C) ; Glom onto wd 1
LSHC T,<32.-<4*<.RPCNT+1>>> ; Fill out to 32 bits from wd 1
LSH T,4 ; Make left justified
PUSH E,T ; Store bytes 4-7
AOBJP C,XFRIT8 ; If counted out, store last 8 bits.
]
PUSH E,TT ; Reached alignment, store last wd directly
JRST XFRIT7 ; then repeat the cycle
XFRIT8: PUSH E,TT
POP P,D
; MOVE C,$ARLOC+TMPAR
MOVEI C,TMPBUF
HRLI C,441000
SYSCAL SIOT,[B ? C ? D]
JSR AUTPSY
TRNN F,%TMP
JRST XFRIT6
XFRIT9:
; UARCLS TMPAR
SYSCAL CLOSE,[A] ; Close empty input chan
.LOSE %LSFIL
; UARCLS BUFFAR
POPAE P,[R,E,D,C]
RET
SUBTTL String hacking rtns
UUODEF EQUSTR,UEQSTR ;extra UUO for easy string comparision
UEQSTR: MOVE U1,40
LDB U2,[$ACFLD,,U1]
MOVE U2,(U2) ;get addr of string AC points to
HRRZ U3,(U1) ;GET CNT 1
HRRZ U4,(U2) ;AND 2
CAIE U3,(U4)
JRST UUORET ;NOT EQUAL, DIFFERENT LENGTHS
MOVE U1,1(U1)
MOVE U2,1(U2)
PUSH P,U3 ; Save cnt on stack.
UEQST2: SOSGE (P)
JRST UEQST5
ILDB U3,U1
ILDB U4,U2
CAIN U3,(U4)
JRST UEQST2
SUB P,[1,,1]
JRST UUORET
UEQST5: SUB P,[1,,1]
AOS UUOH
JRST UUORET
; Parse a word off string pointed to by A, leaves ptr to word in
; B and updates string read from. B furnishes char to break on.
PRSWRD: PUSHAE P,[C,D]
MOVE D,B ; Save desired break char in D.
BCONC
HRRZ C,(A) ;make sure something there
JUMPG C,PRSW5
JRST PRSW6
PRSW2: ILDB B,1(A)
CAIN B,(D)
JRST PRSW6
OUTI STRC,(B) ; Collect string.
PRSW5: SOJGE C,PRSW2
SETZ C,
PRSW6: ECONC WRDSTR
HRRM C,(A)
MOVEI B,WRDSTR
POPAE P,[D,C]
POPJ P,
; CVSIX - converts a string in A to 6bit wd in A
; stops when reach 0 or get 6 chars, or hit blank and previous
; chars were nonblank
CVSIX: PUSHAE P,[B,C,D,E]
MOVE C,1(A)
HRRZ B,(A)
CAILE B,6
MOVEI B,6
CVT760: SETZ A,
MOVE D,[440600,,A]
CVT761: ILDB E,C
CAIN E,40
JUMPN A,CVT762 ;if hit blank, stop only if something already accumulated
JUMPE E,CVT762
CAIL E,141 ;convert to uppercase
CAILE E,172
CAIA
SUBI E,40
SUBI E,40 ;convert to 6bit
IDPB E,D
SOJG B,CVT761
CVT762: POPAE P,[E,D,C,B]
POPJ P,
CVSUPR: PUSHAE P,[B,C,D]
MOVE B,1(A)
HRRZ C,(A)
JUMPG C,CVSUP5
JRST CVSUP7
CVSUP2: ILDB D,B
CAIL D,"a
CAILE D,"z
JRST CVSUP5
SUBI D,40
DPB D,B
CVSUP5: SOJGE C,CVSUP2
CVSUP7: POPAE P,[D,C,B]
POPJ P,
;Convert the decimal digit string ARG to a number in A.
;Clobbers B and T and TT.
RDDEC: SKIPA TT,[10.]
;Similar, but reads an octal number.
RDOCT: MOVEI TT,10
SETZ A,
MOVE B,ARGPT
RDDEC2: ILDB T,B
CAIL T,"0
CAILE T,"9
POPJ P,
IMUL A,TT
ADDI A,-"0(T)
JRST RDDEC2
; A - ptr to string descriptor
; B - [default file block],,[result file block]
; However, default FN2 is always > if only a FN1 was given.
FILPAR: PUSHAE P,[(A),1(A),A,B,C,D,E]
HRRZ E,B ;get result addr
BLT B,3(E) ;zap default values into result block
PUSHJ P,FNPARD ;parse string as filename, DDT style
CAIE A,
MOVEM A,(E) ;device
CAIE B,
MOVEM B,1(E) ;dir
CAIN E,FILDEV
.SUSET [.SSNAM,,B] ;If main default SNAME changed, show it in who-line.
CAIE C,
MOVEM C,2(E) ;fn1
MOVSI B,(SIXBIT/>/)
CAIN C,
MOVEM B,3(E) ;Default FN2 is > if no FN1.
CAIE D,
MOVEM D,3(E) ;fn2
POPAE P,[E,D,C,B,A,1(A),(A)]
POPJ P,
;;; String Vars
IFE @, REPLYS: WRDSTR:
STRNAM REPLYS ;Reply from server
STRNAM WRDSTR ;Used by PRSWRD
STRNGS: SBLOCK
NSTRS==<.-STRNGS>/2
CONSTANTS
VARIABLES
ARPAGS: <LSTPAG-400>,,LSTPAG ; Define free area to be everything above this.
; Note that we gobble from here to call HSTMAP
; before we initialize the storage allocator.
LSTPAG==<.+1777>/2000
END GO