;-*- 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, ;"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==<<+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 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 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. 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 NETERR 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 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,*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==<<+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.-> ; 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 ; 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