perm filename FTP.FAI[S,NET]34 blob
sn#854215 filedate 1988-03-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00043 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00013 00002 TITLE FTP History NEWPRO DEBMOD VERBOSE BUFOUT ICPSOK
C00028 00003 AC DEFINTIONS, VARIABLE STORAGE, RANDOM DEFINITIONS ac1 ac2 ac3 ac4 ac5 ac6 ac7 ac8 ac9 ac10 ac11 rsock ssock p PLN PDL OBUF IBUF NUMARG CBITS CTRL1 FCSF ECHOF SPCIN SPCOUT OUTDON LSTCR NOTSNT CRLFF NOTYPE DPY DDDPY BEEPC DIRFLC TYOBLN TYOBUF TYOBP TYOCNT LOCKCT LUKTTY CONSCK ITSFLG UNXFLG HOSTNS HOSTNO USEPRT IPNBRS NWPTCM INSCNT DAMFLG ECREPY ECREPN NWPTEX RECHOF NEARLY intb conecb GETPRT escchr IOSSAV LUPPRV se nop datam break ip ao ayt ec el ga sb will wont do dont iac NIORTS HSTTAB ERRTNS WHYWHY
C00034 00004 More definitions imp log infl outfl DOMP DIMP FOMP FIMP UFDC MFDC inttty intclk inttti errbts ERRBTS UFDN
C00036 00005 stloc lsloc wfloc bsloc fsloc hloc terblk anyc sttblk dislin ddlin DMLIN PTYLIN IMPBIT spcbrk FULTWX xon
C00038 00006 Break table, other random things savtab brktab bsactt ttyall ttybrk CRLF CPOPJ2 CPOPJ1 CPOPJ PAT PATCH RSCCNT SYSMOD HSTBLN HSTBUF HNMBUF
C00040 00007 Startup and initialization TSTART START RSTART RSTRT0
C00043 00008 Get host name addresses GETHST OPTRET GETHN1 GETHN2 HPRIL0 HPRILP HSTNXT HSTERR GOTHDB NONAME GOTST1 SLURPU SLURPA SLURPG SLURPF SLURPH SLURPE OPTXT OPTXTL OPTXTN OPTXTF OPTXTT OPTXTP OPTXTH OPTXTC OPTXTM OPTXTR OPTXBP OPTXLN OPTXOK OPTXNX OPTXCH OPTXDZ OPTXZR OPTXDN OPTCHR OPTCH1 NOOPTT RDHOST RDHOS1 RDHNOH ENDHSH ENDHST RDHNUM
C00057 00009 Try to initiate connection. loginj conini CONIN1 CONIN2 TRYNXT conwat
C00062 00010 IMP single character input and output impget impge2 impout impou1 impou2 impoug impodb impod1 outagn allocs
C00066 00011 Terminate a connection gracefully QUITCL QUIT
C00067 00012 File name reading program term tloop isalpn lcheck rjust rjloop
C00068 00013 Program to read a file rdfile rdppm errspc winxit errlf rstx ttysav
C00071 00014 Print octal POCT poctl
C00072 00015 Routine to see if socket has been closed under us. Skips if not closed. clschk inpskp
C00073 00016 Interrupts get to here intdsp intend inunlk insr inttst insflg inrflg
C00075 00017 Error returns and such NOIMP NOINIT IMPERR IMPER1 RSFAIL intbts concls
C00079 00018 More error messages noconn nowait inperr outerr
C00080 00019 DATGEN Date Generator c/o Datgen.fai[sls,dcs] NUMPR NUMPR1 DON0 DATGEN NODA1 NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00083 00020 The FTP FTPACT DIACTV DOACTV XACTV DIBUF DOBUF FIBUF FOBUF LDOSOC LDISOC FDISOC FDOSOC SVOTYP DTYPE DRTYPE SAILFL IMODES FMODES DBS CNIBTS OUTCON SAVP CHAR1 SNDMOD SNDTYP SNDBYT MAILNG ACTION GIVELF PKUNAM PKUEXT PKURNM HAIRY HAIRBP HAIRBF HAIRLS HAIRRS HAIRPT HAIRLR HASCII HSTEND USRSTR ACCSTR PASSTR OPOPEN OTBUF TYPTAB FNBUF FNBUF2 FNBPT
C00088 00021 FTP Opcode Definitions OCDISP OCS
C00091 00022 FQUIT TTCINK STAT PXCWD WIDENT TTCIWT TTCIW1 QWAIT RHELP IDENT IDENT0 IDENT1 IDENT2 RPLX PASS PUSER USER PASS2 USER1
C00096 00023 HAGGLE HAGASC HAGLUZ ASCOK IMGOK HAGTYP STREAM
C00099 00024 TYPE TYPDSP TYPEUN TYPET TEXSET TYPEA ASCSET TYPES SAISET IMGSET TYPEX TYPEOK TYPINC TYPIN2 TYPFIX BADTYP BDTYMS WHICHA WHICHB DFCOM COMOUT IMPCRL TYPEL LCLSET BYTE BYTE1 BYTE2 BYTE3 BADARG BADBYT BDBYMS BYTOU0 BYTOUT DECOUT SNDPAR STYP NOPORT PORT SNDPRT SNDPR2 SNDPRH PICKUP PKUNU1 PKUNUL PKUERR TYPDEC
C00115 00025 QUOTE LINOUT RLNOUT LINOLF CHAROUT WRTSIX WRSXLP SJSX NOOP NOOP1 SYST PWD
C00117 00026 TEMPA PLIST LIST TTY PRETR RETR TRETR RETR0 RETR01 RETR02 RETR1 RETRLP RETNPK RETPKF TYPWRT SAFASK SAFEOK TYPFIL RETRL1 SAFLKF SAFAOS SAFAUT SAFAU1 SAFEAA SAFEA1 SAFEAB CCR SAFENM TYPSIX RETRLX TYPNLS RETLX1 SAFX0 RET1ST RETRST NLSTST DIDOXX DIDOX1 DIDOXY DIDOLZ DIDOLZ SAFX1 PSTOR STOR STOR0 STORLP STORL1 STONPK STOPKF TYPREA STO1DO STORDO UFDPPN NOUFD UFDIN UFDIN1 FLUSCS SCANTO MLCHK SV2INC ERRWAT ERRWA1 GOWAIT LPPN RPPN DEBG
C00139 00027 Small Utility Routines For FTP Program TTSTROUT STROUT STROU1 STROUF TTCHROUT DOCHRO GETTTY CRGETY RGETTY GETTT1 GETTT2 FAKELF SPCRD SPCRDE GETCAP SXACTV
C00142 00028 Locus of FTP control FTPINI RESET FTLOOP FTLOP1 FTLOP3 FTLOP2 FTLCHK TTESCI ESCI ESCI1 INSBLK ILEVEL ILEVE1 IORSET RESET1 UFDOPN UBUF
C00149 00029 Process-switching AC Utility routines SAVACX SAVACS GETACS
C00151 00030 Ttdisp -- TTY Process Control TTDISP TTREEN TTWAIT CHKABO TTACS TTP TTHUNG TTPDL TTROUT TTROU1 HAIREX DOHAIR HGETSP HGETL HAIRTY HDELIM HGETS2 HGETR HFOO HGETR1 HNEED2 HNOEQU TWOARR NUTTIN HAIRDO HAIRD1 OTPASS ANONYM INFRE1 INFREE NOACCT HAIRNO HAIRCR HAIRBY HAIRFN
C00163 00031 Cidisp -- Control In Process Control CIDISP CIREEN CIWAIT CIACS CIP CIHUNG CIPDL CINUM CIGAG CIINIT CIFLAG CIDEBG CIGRQA CIGRQ HYPHEN CISVG CIHYNO MSGPTR MSGSTK MSGCNT GAG200 IACFLG CIROUT CIROPE CIROXX CIROU0 CIROU6 CIROU1 CIROU4 CIRO41 CIROU3 CIROU2 CIRO22 CIROU7 CIROUX CIRO81 CIROU9 CIROU8 IACCOM OPTNEG OPTDUN
C00174 00032 Didisp -- Data In (Imp) Process Control. DIDISP DIREEN DIWAIT DIACS DIP DIHUNG DIPDL DISTART DIROUT DIROU1 DIEOF DIEOF1 BAUD NOTBAU BAUDWT
C00180 00033 Dodisp -- Data Out (Imp) Process Control. DODISP DOREEN DOWAIT DOACS DOP DOHUNG DOPDL DOSTART DOROUT DOROU1 DOROU2 DOTERM
C00184 00034 Getoc -- Command Op Codes. GETOC GETOX1 GETOX0 GETOC1 GETOCC GETOCQ SPCRDL GETOC9 GETOCA GETOC7 GETOC2 POP32 EMPTYL GETOCN GETOC3 GETOC4 GETOC5 GETOC6 GETOC0 SPCFTC XIND SPCFTI SPCFTE SPCFTN
C00191 00035 Getfil -- Get data byte from local file system. GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI9 GETFI6 GETFI7 GETF71 GETFI8 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK GETDAT GETDA1 GETDA2 GETDA3 GETDA4 GETDA5 GETDA6
C00199 00036 Putdat, Putfil - data byte into imp or local file system PUTDAT PUTDA1 PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI6 COREOK CORLUZ PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
C00203 00037 Initialize data link connection IDCON IDCONZ IDCONI IDCONC IDCONW IDCONX IDCONY IDCONS IDCONB IDCON0 IDFUCK IDCOS0 IDCON2 IDCON1 IDCO11 IDCOND IDCONA IDCONP IDCONF IMPIBF IMPOBF
C00208 00038 Initialize local data device ILDDEV ILDDO ILDDSH ILDDE ILDDE2 ILDDL ILDDL2 ILDSSZ ILDSS1 ILDSS2 LEERR LEERRX LEETAB LEEMAX ILDD ILDDIO DSKIBF DSKOBF FASTAB FASLEN
C00214 00039 FNREAD FNREA1 FNSEND FNSEN1 FNSPPL FNSENP FNSE10 FNSE11 FNS111 FNSE12 FNSEN2 FNSEN3 FNSEN4 GFNY GFN GFNX GFNY1 NXTSKP NXTTOK GOTTOK TNONUL GFNLUZ PKUALT SYNBAD SAFOPT DEVICE ITSNM1 EXTNXT ITSNM2 NULDOT T20VER SETFIL TNXPP2 TNXPPN UNIXPN PPNNXT PPNZB PPNLZ1 PPNXIT PPNLUZ GETPNM GETPN1 SEMICL GFNEOL GFNEO1 GFNEO2 EQUALS GFNDUN SKIPS1 SKIPSP SKIPS2 LETTS3 LETTST LETTS0 LETTS1 LETTS5 LETTS2 LETTS6 LETTS4 GETSI4 GETSIX ANCHR6 GETSI1 GETSI2 GETSI3
C00231 00040 OPRINT OPRINN DPRINT DPRINN DPRIN0 DPRIN1 DPRIN2 DPRIN3 DPRIN4 SIZE NCHRS RADIX
C00233 00041 WAITS/ASCII translation PTOASC PTOSAI PFRASC PFRSAI ASCTAB
C00235 00042 FTP local HELP command LHELP LHELP1 LHELP2 LHELP3 LHNCOL LHLIST LHLI1 LHLI2 LHLI3 LHLI4 H.TTTT H.ACCT H.ALIA H.APPE H.ASCI H.BYE H.BYTE H.CWD H.DEBG H.DEBU H.DELE H.DIRE H.DISC H.GET H.HELP H.IMAG H.LIST H.LOCA H.LOGI H.LPPN H.RPPN H.NLST H.NOOP H.NOPO H.PASS H.PICK H.PORT H.PUT H.PWD H.QUIT H.QUOT H.RENA H.RNFR H.RNTO H.RETR H.RHEL H.SAIL H.SEND H.STAT H.STOR H.SYST H.TTY H.TYPE H.USER H.XCWD H.XIND HLPTAB HLPNUM HLPDSP
C00255 00043 SYSTEM STARTUP CODE SYSINI SYSINH SYSIN1 HAIRSP HAIRT HAIRA HAIRSW HAIRQ HAIRR HAIRL HAIRX HAIRIN HAIRIM NOHAIR SYSIN0 SYSRST SYSSIX SYSSX1 SYSSX2 SYSSX3 SYSSXE
C00260 ENDMK
C⊗;
TITLE FTP ;⊗ History NEWPRO DEBMOD VERBOSE BUFOUT ICPSOK
SUBTTL FTP USER PROGRAM
COMMENT ⊗
This file is now the source only for FTP, nothing else!
This file is the descendant of TELNET[CSP,SYS], which started as the
source for TELNET. With the aid of assembly switches, it also became the
source for FTP, several other network programs and even some non-network
programs. By then it was a real mess. Only the code used for FTP remains
now. Restore an old version of TELNET[CSP,SYS] or FTP.FAI[S,NET] if you
want to see how things used to be.
Things that need to be done:
(1) Fix problem with BAUDWT. Sometimes loops if call to SXACTV included,
sometimes hangs if removed.
(2) Reset of data connection by foreign host doesn't seem to get noticed.
(3) Allow HOST↑ notation and switches in non-one-line FTPs.
(4) Implement block mode transfers, avoiding need for new data port for
each file.
(5) Use NETWRK code where appropriate, instead of current code.
History (please record changes):
All comments from FTP.FAI[S,NET] (or TELNET[CSP,SYS], before 1983) are
listed below even though some of them apply to FTP and some to DIAL.
15 Dec 82 JJW DIAL now runs spacewar to empty TTY input buffer, and maps
system FS with SETPR2. No longer locks in core, since spw
takes care of this. LOCKing when spw active would suspend it.
21 Nov 82 JJW Added LOTSA and LOTSB to DIAL names, with default 1200 baud.
08 Jan 83 JJW Spacewar process turns off after no input for some time.
10 Jan 83 ME Changed dialer error message for dialer timeouts.
12 Jan 83 JJW No parity generated when dialing to LOTS (for EMACS).
21 Jan 83 JJW Bugfix in reading speed switches, speed included in log file.
LOTSA, LOTSB, and SAIL try 300 baud if no high-speed lines.
LOTSA has separate numbers for 1200 and 300 dialing.
24 Jan 83 ME Made FTP translate WAITS 33 ↔ ASCII 32 (not-equals), making
character set translation reversible.
13 Feb 83 ME DIAL sets no-PK bit to hide input buffer and line editor.
16 Feb 83 JJW Spacewar now turned off at QUIT in DIAL.
20 Mar 83 ME DIAL exits after dialing failure.
23 Mar 83 ME Interchanged high/low speed of all Vadic modems; now 4 hi-speed.
25 Apr 83 ME,JJW IP/TCP changes under FTIP. Includes switch to new FTP protocol.
04 May 83 ME DOROU2 and DIEOF1 wait for close of data connection; they
even sleep a little to make sure ports can be re-used.
12 May 83 ME Fixed (X)CWD and Alias user cmds to use CWD not XCWD FTP cmd.
Flushed MAIL et al. user commands.
17 May 83 ME Inserted use of PORT command to avoid re-using ports that
may still be closing.
18 May 83 JJW Allow user to type IP host numbers.
20 May 83 ME Fix to FTLCHK not to MOVEM into CNIBTS lest it clobber bits
just set there at interrupt level. Also fixed FTLCHK to
type "connection has been closed" before going to QUIT(CL).
Improved error typeout by INTBTS. Flushed sleeps from 4 May.
22 May 83 ME Suppressed typeout of success reply to PORT command (GAG200).
29 May 83 ME SNDPRT uses MTAPE 7 to get our own IP host number. Also,
it now uses MTAPE 21 to gensym a port number when the original
bunch run out.
04 Jun 83 JJW FTHST3 code for using HOSTS3 host table.
04 Jun 83 ME DIAL fixed not to try to dial out on the line you've dialed in on!
07 Jun 83 ME Fixed BAUDWT to call SXACTV once again, to fix hanging at end.
22 Jun 83 JJW Added FTF2 switch, to prevent LLL from trying SU-Net first.
03 Jul 83 ME Made TYPE L parse following decimal byte size. BYTE n
same as TYPE L n. TYPE L byte size must be 8, 32 or 36.
TYPE A or I or X sets byte size to 8. TYPE L 36 treated as
TYPE I here. DBS always set to 8 since transfer byte size is 8.
Fixed TYPEOK, TYPINC to be able to restore TYPE L.
03 Jul 83 ME SNDPRT cycles through 7 ports over and over, since otherwise
we use up all of Score's TCBs (?) for multiple file transfer.
03 Jul 83 ME FTF2 defined by using WATSIT[S,SYS].
12 Aug 83 JJW NBUFS different for FTF2 to provide optimal disk buffering.
24 Aug 83 JJW Removed FTHST3 switch; NETWRK now only uses HOSTS3 format.
24 Sep 83 JJW Changed error reporting to use NETWRK's NIOERR.
18 Nov 83 JJW Show password rejection messages in one-line FTP and allow retry.
03 Dec 83 JJW Fixed image mode FTP of odd-length files (partial byte at EOF).
23 Jan 84 JJW Removed FTIP switch and all IFE FTIP code. Also removed
RSEXEC, LIMRIK, SPCL, and GRFPRO code. Improved some error
messages.
30 Jan 84 JJW Telnet Option negotiation on FTP control channel. HAGGLE uses
TYPE L 36 instead of TYPE I, so foreign host can reject if it
doesn't like our word size. NOOP command added.
31 Jan 84 JJW Changed TELENET number for DIAL.
02 Feb 84 JJW Made WAITS/ASCII translation use byte ptrs into ASCTAB.
Implemented text mode with TYPE T and TEXT commands.
04 Feb 84 JJW Sleep one second before SXACTV call in BAUDWT to prevent looping.
15 Feb 84 JJW Test RFCS and RFCR instead of CLSS and CLSR to determine whether
connections are closed.
20 Feb 84 JJW Unix pathname parsing in GFN.
13 Mar 84 GFF Changed TYMNET number for DIAL and added Metanet number.
22 Oct 84 JJW Fixed IDENT and RETR0 to send <command><cr><lf> instead of
<command><sp><lf> if no parameter on command line (this affects
HELP, STAT and LIST mainly). Reset TYPECM in TTY command.
Flushed code at IMPOUU.
26 Oct 84 JJW Changed DIAL CCRMA to use 1200-baud number.
06 Dec 84 BH Use lowercase in multiple STOR substitution to Unix system.
27 Dec 84 ME WAITS mode added for DD/IIIs (βT) (see WAITSI/WAITSO). Works
just like WAITS mode in DTN, using αβ<vt>/αβ<form> as escapes
for commands. βN command (DIAL) sends a null, αβN an EDIT-NULL.
Also, DMHGT (DM simulator height) changed from 24 to 33.
23 Apr 85 ME DSTATE does a TTY EXIST 14 if dialer didn't respond, redials.
05 Jul 85 ME Fixed RDFIL and STBAUD to clear image mode and ALLACT/BSACT
while reading response from user; uses TTYSAV/RSTX.
Also, a bare CR or LF typed as phone number makes DIAL exit.
01 Aug 85 JJW Updated CCRMA 1200 baud number for DIAL.
25 Oct 85 JJW Added SYST and PWD commands to FTP.
26 Feb 86 JJW Local HELP command for FTP. RHELP gets help from remote host.
13 May 86 JJW New CCRMA 1200 baud number for DIAL.
04 Aug 86 JJW Lowercase "anonymous" to satisfy $%#! 4.3 Unix FTP server.
18 Aug 86 JJW Simplified some switches, and took out some inaccessible code.
Began rewriting RDHOST (formerly RDSITE) and host name lookup code.
20 Aug 86 JJW Moved DIAL to DIAL.FAI[CSP,SYS].
07 Sep 86 JJW Took out all non-FTP code. Fixed bug in LOCAL command parsing.
10 Sep 86 JJW Finished rewriting RDHOST, and added code to try multiple
addresses when making connection.
16 Sep 86 JJW Fixed some bugs in previous changes. Updated INTBTS (error
reporting) to new code at IMPERR.
25 Nov 86 JJW Changed ASCII translation to include "_" and "←" interchange,
formerly done by TEXT mode. Flushed TEXT mode and added new
SAIL mode, which doesn't interchange those chars. Updated all
help messages, etc.
06 Jan 87 JJW LispM/Multics pathname parsing.
22 Jan 87 JJW Fixed SYSINI code (broken in Sep 86) to allow abbreviations
for FTP and TEST monitor commands.
06 Apr 87 JJW Ignore underscores in remote filenames (at LETTST).
15 Aug 87 JJW Moved calls to TTDISP and CIDISP to beginning of FTLOOP
(before INTIMS check) to allow all messages from remote host
to be typed before exiting.
29 Feb 88 ME Made DIDOXX do a PUSHJ P,TTWAIT so that main loop will call
DISTART to open data connection before we send the command
requesting a transfer.
01 Mar 88 JJW Added CD command as a synonym for CWD.
01 Mar 88 ME IDCONY changed not to check for data connection CLSR!CLSS bits
since Fin may have come quickly with short batch of data.
GETDA4 also doesn't check CLSR!CLSS bits for same reason.
History: end of comment ⊗
PRINTS /Have you listed your changes at History: on page 2?
/
;Set default values of switches
NEWPRO←←0 ;Non-zero for new Telnet protocol
;JJW note: maybe we should set NEWPRO←←1, since TCP/FTP is supposed to
;use TCP/TELNET on the control connection, which is the "new" protocol.
DEBMOD←←0 ;Non-zero for some debugging features
VERBOSE←←0 ;Non-zero for some debugging typeout
BUFOUT←←1 ;Do OUTSTR of buffer instead of OUTCHR
.INSERT WATSIT[S,SYS] ;Get site specific assembly switches, incl FTF2.
IFE FTF2,<NBUFS←←11;>NBUFS←←40 ;Optimum number of disk buffers (one more than one tk)
ICPSOK←←=21 ;FTP's port
DEFINE ISNEWP<IFN NEWPRO>
DEFINE NONEWP<IFE NEWPRO>
DEFINE DEB<IFN DEBMOD>
DEFINE NODEB<IFE DEBMOD>
ifndef impbug,<↓impbug←←0> ;System inserts spurious nulls, kludge around this
IFN VERBOSE,<
PRINTS/Assembling debugging version that has Verbose typeout.
/
>;IFN VERBOSE
LOC 124 ;JOBREN
JRST TTESCI ;SIMULATE ESC-I
RELOC
LOC 137
JRST TSTART
RELOC
DEFINE EPILOG(ACC)<
SOS RSCCNT
>
DEFINE READW(AC)<
INCHWL AC
EPILOG(AC)
>
DEFINE READS(AC,FAIL)<
INCHSL AC
FAIL
EPILOG(AC)
>
;AC DEFINTIONS, VARIABLE STORAGE, RANDOM DEFINITIONS ;⊗ ac1 ac2 ac3 ac4 ac5 ac6 ac7 ac8 ac9 ac10 ac11 rsock ssock p PLN PDL OBUF IBUF NUMARG CBITS CTRL1 FCSF ECHOF SPCIN SPCOUT OUTDON LSTCR NOTSNT CRLFF NOTYPE DPY DDDPY BEEPC DIRFLC TYOBLN TYOBUF TYOBP TYOCNT LOCKCT LUKTTY CONSCK ITSFLG UNXFLG HOSTNS HOSTNO USEPRT IPNBRS NWPTCM INSCNT DAMFLG ECREPY ECREPN NWPTEX RECHOF NEARLY intb conecb GETPRT escchr IOSSAV LUPPRV se nop datam break ip ao ayt ec el ga sb will wont do dont iac NIORTS HSTTAB ERRTNS WHYWHY
↓ac1←2 ↓A ←← AC1
↓ac2←3 ↓B ←← AC2
↓ac3←4 ↓C ←← AC3
ac4←5 ↓D ←← AC4
ac5←6 E ←← AC5
ac6←7 F ←← AC6
ac7←10
ac8←11 T ←← AC8
ac9←12 ↓T1 ←← AC9
ac10←13 ↓T2 ←← AC10
ac11←14 ↓T3 ←← AC11
;AC10,AC11 USED BY SITE-NAME-TO-NUMBER ROUTINES, ONLY (?)
;T,T1 USED BY NUMBER PRINTING ROUTINES (OPRINT, ETC.)
rsock←15
ssock←16
↓p←17
PLN←←20
PDL: BLOCK PLN
OBUF: BLOCK 3
IBUF: BLOCK 3
NUMARG: 0 ;NUMERIC ARGUMENT ACCUMULATED HERE
CBITS: 0 ;CONTROL AND META BITS COLLECTED HERE
CTRL1: 0 ;-1 → CTRL-1 BIT SET IN TYPEIN
FCSF: 0 ;-1 → ACTIVATE ON ALL INPUT CHARACTERS
ECHOF: -1 ;-1 → ECHO LOCALLY, 0 → INHIBIT ECHOING
SPCIN: 0 ;-1 → TAKE INPUT FROM DISK
SPCOUT: 0 ;-1 → OUTPUT TO DISK AS WELL AS TTY
OUTDON: 0 ;-1 → HAVE DONE A SPCOUT AT SOME POINT
LSTCR: 0 ;-1 → LAST CHARATER TYPED IN WAS CR
NOTSNT: 0 ;NUMBER OF CHARACTERS IN BUFFER NOT SENT OUT YET
CRLFF: 0 ;-1 → LAST NET CHAR WAS A CR
NOTYPE: 0 ;-1 → SUPRESS ALL TYPEOUT
DPY: 0 ;NON ZERO IF DATA DISC OR DATAMEDIA OR III (LINE CHARACTERISTICS)
DDDPY: 0 ;NON ZERO IF DATA DISC
BEEPC: -1 ;-1 → BEEP FOR π
DIRFLC: 0 ;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES
IFN BUFOUT,<
TYOBLN←←3
TYOBUF: BLOCK TYOBLN ;BUFFER FOR ACCUMULATING OUTPUT CHARACTERS
0 ;MAKE IT ASCIZ
TYOBP: 440700,,TYOBUF
TYOCNT: TYOBLN*5
>;BUFOUT
LOCKCT: 0 ;≤ 0 → TIME TO LOCK IN TTY LOOP
LUKTTY: 0 ;-1 → JUST GOT TTY INPUT INTERRUPT, DO INCHRS IN CLOOP
CONSCK: 0 ;Port NUMBER WE WILL CONNECT TO
ITSFLG: 0 ;-1 IF CONNECTING TO AN ITS
UNXFLG: 0 ;-1 if connecting to a Unix
HOSTNS←←5 ;Max number of addresses for a host
HOSTNO: BLOCK HOSTNS ;Table of host addresses
USEPRT: -1 ;nonzero means we'll use PORT cmd when doing transfers
IPNBRS: 7 ;block for IMP MTAPE 7 to get port/host nbrs, incl our IP host nbr
BLOCK 6 ;our IP host number is returned in the WFLOC word
ISNEWP,<
NWPTCM: 0 ;-1 → NEXT IMP INPUT CHAR IS PART OF A NEW PROTOCOL COMMAND
INSCNT: 0 ;COUNT OF INSs RECEIVED
DAMFLG: 0 ;-1 → DATA MARK HAS BEEN SEEN
ECREPY: 0 ;-1 → EXPECTING WILL ECHO REPLY
ECREPN: 0 ;-1 → EXPECTING WONT ECHO REPLY
NWPTEX: -1 ;INDEX INTO NWPTTB FOR WILL, WONT, DO, DONT
RECHOF: 0 ;-1 → REMOTE HOST IS ECHOING
>;ISNEWP
NEARLY: 0 ;-1 → OUTPUT TO IMP NEARLY BLOKCKED
intb: 11
block 2
conecb: block 7
GETPRT: 21 ;block for IMP MTAPE to gensym a port nbr for data connection
0 ;port nbr returned here
escchr: 36 ; Escape character
IOSSAV: 0 ;saved copy of image mode bit during RDFIL and STBAUD (ttysav/rstx)
;PRIVILEGE BITS (LEFT HALF)
LUPPRV←←1 ;LOCAL USER PRIVILEGE
;new protocol telnet command codes
ISNEWP,<
se←←360
nop←←361
datam←←362
break←←363
ip←←364
ao←←365
ayt←←366
ec←←367
el←←370
ga←←371
sb←←372
will←←373
wont←←374
do←←375
dont←←376
iac←←377
>;ISNEWP
NIORTS←←-1 ;Select the network I/O routines
HSTTAB←←-1 ;and the marvelous host table scanner
ERRTNS←←-1 ;and the error report routines
.INSERT NETWRK.FAI[S,NET]
WHYWHY: 0 ;Unused, but ref'd by NETWRK's HSTDED (not called)
;More definitions ;⊗ imp log infl outfl DOMP DIMP FOMP FIMP UFDC MFDC inttty intclk inttti errbts ERRBTS UFDN
external jobapr,jobcni,jobtpc
imp←←1 ;Control channel connection. Must agree with NETWRK's NET
IFN IMP-NET,<.FATAL Channels IMP and NET disagree>
infl←←4
outfl←←5
DOMP←←6 ;DATA OUT CONNECTIONS ON CHANNEL 6 (FTP)
DIMP←←7 ;DATA IN CONNECTIONS ON CHANNEL 7 (FTP)
FOMP←←10 ;LOCAL FILE SYSTEM CHANNEL, FOR USE WITH DOMP
FIMP←←11 ;LOCAL FILE SYSTEM CHANNEL, FOR USE WITH DIMP
;NOTE: FIMP=DIMP+2, FOMP=DOMP+2. THIS FACT USED BY ILDDEV SUBR.
UFDC←←12 ;FOR READING UFD FOR MULTIPLE SEND
MFDC←←13 ;FOR READING MFD FOR DITTO WITH WILDCARD PPN
;BITS IN JOBAPR
inttty←←<020000,,0>
intclk←←<000200,,0>
inttti←←<000004,,0>
;BITS IN IOS
; IO error bits
errbts←←0
DEFINE X (BIT,VAL) <
ERRBTS←←ERRBTS!VAL
>
x(tmo,200) ; Internal timeout
x(rset,400) ; Host sent us a reset
x(hdead,2000) ; Host is dead
x(iodend,020000) ; End of file
x(iobktl,040000) ; Block too large
x(iodter,100000) ; Data error
x(ioderr,200000) ; Device error
x(ioimpm,400000) ; Improper mode
UFDN←←20 ;NUMBER OF WORDS IN A DIRECTORY ENTRY
;⊗ stloc lsloc wfloc bsloc fsloc hloc terblk anyc sttblk dislin ddlin DMLIN PTYLIN IMPBIT spcbrk FULTWX xon
; Positions in MTAPE block
stloc←←1 ; Status bits returned here
lsloc←←2 ; Local port
wfloc←←3 ; Wait flag
bsloc←←4 ; Byte size location
fsloc←←5 ; Foreign port
hloc←←6 ; Host number
terblk: 3 ; Terminate block
0 ; Status bits
. ; Local port loc
0 ; Don't wait
; Bits in LH of state word in IMPSTB
anyc←←400000 ; Any change of state
sttblk: 2
block 2
; Bits in LH of line status word (GETLIN UUO)
dislin←←400000 ; III display
ddlin←←20000 ; Data Disc display
DMLIN←←40000 ; Datamedia-type display
PTYLIN←←4000 ; THIS IS A PTY
IMPBIT←←1000 ; IMP PTY
spcbrk←←100 ; Enter special activation mode
FULTWX←←4 ; ON FOR HALF DUPLEX
xon←←2 ; don't generate lf after CR
;Break table, other random things ;⊗ savtab brktab bsactt ttyall ttybrk CRLF CPOPJ2 CPOPJ1 CPOPJ PAT PATCH RSCCNT SYSMOD HSTBLN HSTBUF HNMBUF
savtab: block 4 ;break table saved by TTYSAV
brktab: -1
-1
-1
-1,,600000
bsactt: -1
-1
-1
-1,,600020 ;backspace activates
ttyall: -1
-1
-1
-1,,600062 ;allact, bsact, supccr -- used by WAITS mode
ttybrk: -1,,777760 ;control characters 0-37
0
0
1,,0 ;alt mode
CRLF: BYTE (7)15,12
CPOPJ2: AOS (P)
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
PAT:
PATCH: BLOCK 40
RSCCNT: 0 ; COUNT OF NUMBER OF CHARS RESCANED
SYSMOD: 0 ; -1 IF STARTED BY SYSTEM COMMAND
HSTBLN←←10
HSTBUF: BLOCK HSTBLN ;Host name as typed by user
HNMBUF: BLOCK HSTBLN ;Official host name
;Startup and initialization ;⊗ TSTART START RSTART RSTRT0
TSTART: CLRBFI
START: MOVE P,[IOWD PLN,PDL] ; PICK UP A PUSHDOWN LIST
PUSHJ P,SYSINI ;INIT FOR SYSTEM MODE
JRST RSTRT0
RSTART: UNLOCK
PUSHJ P,SYSRST ;CLEAR ANYTHING LEFT FROM SYSTEM COMMAND
RSTRT0: RESET ; CLEAR THE SYSTEM'S WORLD
; MOVNI AC1,1 ; See if we are on TTY or DPY
; GETLIN AC1
; MOVE AC2,AC1
; TLNE AC2,PTYLIN
; TDZA AC2,AC2
hrroi ac2,[3000,,ac2] ;Get only our line characteristics into ac2
ttyset ac2, ;This doesn't get display bit of pty owner
AND AC2,[DDLIN!DISLIN!DMLIN,,]
MOVEM AC2,DPY
TLZ AC2,DISLIN!DMLIN ;Leave only DD bit
MOVEM AC2,DDDPY
; MOVE AC2,DPY
; TLZ AC2,DISLIN!DDLIN ;Leave only DM bit
; MOVEM AC2,DMDPY
MOVEI AC7,36 ; default escape character for non display
MOVEM AC7,ESCCHR
move p,[iowd pln,pdl] ; Pick up a pushdown list
IFN BUFOUT,<
MOVE AC1,[440700,,TYOBUF]
MOVEM AC1,TYOBP
MOVEI AC1,TYOBLN*5
MOVEM AC1,TYOCNT
>;BUFOUT
setzm spcout ; Start out with no dump output
setzm outdon
setom numarg
setzm fcsf ; line mode
setom echof ; local echoing
setzm lstcr ; last char typed in not a cr
setzm crlff ; last char from outside world not a cr
setzm spcin ; no dump input
setzm cbits ; Clear control bits
setzm notype ; Allow typeout
setzm notsnt ; # of chars in buffer not sent (for FCS mode)
setom beepc ; start out beeping π
setzm lockct ;lock in core next time at cloop
ISNEWP,<
setzm nwptcm ; not doing new prot command now
setzm insflg
setzm inrflg
setzm inscnt
setzm damflg
setzm ecrepy
setzm ecrepn
setom nwptex
setzm rechof
SETZM EXTARQ
SETZM EXTAOK
>;ISNEWP
SETZM LUKTTY
MOVEI AC2,ICPSOK
movem ac2,consck ;connect here
;Get host name addresses ;⊗ GETHST OPTRET GETHN1 GETHN2 HPRIL0 HPRILP HSTNXT HSTERR GOTHDB NONAME GOTST1 SLURPU SLURPA SLURPG SLURPF SLURPH SLURPE OPTXT OPTXTL OPTXTN OPTXTF OPTXTT OPTXTP OPTXTH OPTXTC OPTXTM OPTXTR OPTXBP OPTXLN OPTXOK OPTXNX OPTXCH OPTXDZ OPTXZR OPTXDN OPTCHR OPTCH1 NOOPTT RDHOST RDHOS1 RDHNOH ENDHSH ENDHST RDHNUM
GETHST: SKIPG RSCCNT
OUTSTR [ASCIZ /Host = /]
SETZM HNMBUF
SETZM HOSTNO ;Clear host number table
MOVE AC1,[HOSTNO,,HOSTNO+1]
BLT AC1,HOSTNO+HOSTNS-1
PUSHJ P,RDHOST ;Parse host name or number
JRST [ OUTSTR [ASCIZ /
Illegal host name or number
/]
PUSHJ P,SYSRST
JRST GETHST]
MOVEM AC3,HOSTNO ;Save host number if given
MOVE AC4,HSTEND
CAIN AC4,"↑"
JRST OPTXT ;Read OPTION.TXT if needed
OPTRET: PUSHJ P,ATTHST ;Attach host table in high segment
SKIPE HOSTNO ;Did user give host number?
JRST [ PUSHJ P,HSTNUM ;Yes, look it up in table
JRST GOTST1 ;Not in tables, so hope for the best
JRST GOTHDB]
MOVEI 0,HSTBUF ;POINTER TO NAME STRING
PUSHJ P,HSTNAM ;GET HDB
JRST [ OUTSTR [ASCIZ/No such host
/]
JRST HSTERR]
JRST [ OUTSTR [ASCIZ/Ambiguous host name
/]
JRST HSTERR]
repeat 1,<
;Go through address list, which we assume is presented to us
;in order of decreasing preference.
MOVSI 4,-HOSTNS
GETHN1: TLNE 0,(NN%IP) ;IP address?
JRST GETHN2 ;No, then ignore it
MOVEM 0,HOSTNO(4) ;Store address in table
AOBJP 4,GOTHDB ;Jump if table full
GETHN2: PUSHJ P,HSTNXA ;Get next address
JRST .+2 ;All done
JRST GETHN1
SKIPE HOSTNO ;Make sure we got at least one address
JRST GOTHDB
OUTSTR [ASCIZ\Sorry, can't reach this host via IP/TCP.
\]
;fall into HSTERR
>;repeat 1
repeat 0,<
;Loop through HDBs looking for the best network to get to this host.
SETOM HSTPRI# ;Set initial priority to -1
HPRIL0: MOVSI AC3,-NETNUM
PUSH P,0 ;Save host number
HPRILP: AND 0,NETMSK(AC3) ;Get bits to match
CAME 0,NETTAB(AC3) ;See if it matches a known network
AOBJN AC3,HPRILP
POP P,0 ;Restore host number
JUMPGE AC3,HSTNXT ;Jump if net not in table
MOVE AC3,NETPRI(AC3) ;Get priority
CAMG AC3,HSTPRI ;See if any better than previous
JRST HSTNXT ;No, get next host number
MOVEM AC3,HSTPRI ;Yes, save as current best priority
MOVEM 0,HOSTNO ;And save host number
HSTNXT: PUSHJ P,HSTNXA ;Get another HDB if any
CAIA ;No more
JRST HPRIL0
MOVE 0,HOSTNO ;Get preferred host number
SKIPL HSTPRI ;Did we find a usable network?
JRST GOTHDB ;Yes
OUTSTR [ASCIZ/Host not directly accessible.
/]
;fall into HSTERR
>;repeat 0
HSTERR: PUSHJ P,DETHST ;Flush host table
PUSHJ P,SYSRST
JRST GETHST
;Got an HDB, now play with it
GOTHDB: TRNN 1,-1 ;This host got a name?
JRST NONAME
HRLZ AC4,1
HRRI AC4,HNMBUF
BLT AC4,HNMBUF+HSTBLN-1 ;Copy name to HNMBUF
NONAME: SETZM ITSFLG
SETZM UNXFLG ;BH 12/6/84
HLRZ 0,1 ;NUMSYS
MOVE 0,@0 ;GET O.S. NAME
CAMN 0,[ASCII/ITS/]
SETOM ITSFLG
CAMN 0,[ASCII/UNIX/] ;BH 12/6/84
SETOM UNXFLG ;BH Use lowercase in wildcard replacement.
GOTST1: PUSHJ P,DETHST ;Done with host table
SKIPN HAIRY ;BH 11/27/77 HAIRY ONE-LINE TRANSFER?
JRST LOGINJ ;NO
MOVE AC1,HSTEND ;YES, GET DELIM AFTER HOST NAME
CAIN AC1,"↑"
JRST SLURPH ;ALREADY GOT THIS STUFF FROM OPTION.TXT
SETZM USRSTR
SETZM ACCSTR
SETZM PASSTR
CAIE AC1,"/" ;ENDS WITH SLASH?
JRST SLURPH ;NO, GO SLURP REST OF COMMAND LINE
MOVE AC3,[POINT 7,USRSTR]
SLURPU: READW(AC1) ;YES, SLURP THE USER NAME (S)HE WANTS
;{
CAIE AC1,"}" ;END HERE
CAIN AC1,15 ; OR HERE
JRST SLURPG
CAIE AC1,12 ;END OF LINE
CAIN AC1,175
JRST SLURPF
CAIN AC1,"/"
JRST SLURPA ;SLURP ACCOUNT
IDPB AC1,AC3
JRST SLURPU
SLURPA: MOVEI AC4,0
IDPB AC4,AC3 ;FINISH OFF USER ID
MOVE AC3,[POINT 7,ACCSTR]
SKIPN ACCSTR ;CAN'T HAVE TWO ACCTS
JRST SLURPU
OUTSTR [ASCIZ /? Too many fields in host specification.
/]
EXIT ;F**K IT
SLURPG: READW(AC1)
SLURPF: MOVEI AC4,0
IDPB AC4,AC3
JRST SLURPE
SLURPH: CAIE AC1,12
CAIN AC1,175
JRST SLURPE
READW(AC1) ;YES, GET THE REST OF THE LINE
;{
CAIN AC1,"}"
JRST SLURPH ;TO DEAL WITH {HOST↑} CASE
SLURPE: IDPB AC1,HAIRBP ;(WE'VE CLEVERLY OMITTED THE HOST NAME)
CAIE AC1,12 ;GO TO END OF LINE
CAIN AC1,175
JRST LOGINJ
JRST SLURPH
OPTXT: JUMPN AC3,[ OUTSTR [ASCIZ /? No OPTION.TXT with numeric host.
/]
EXIT]
OPEN FOMP,OPOPEN ;OPEN A DISK TO READ OPTION.TXT
JRST NOOPTT ;CAN'T
MOVE T,['OPTION']
HRLZI T1,'TXT'
GETPPN T3, ;USE PPN NOT ALIAS (BETTER NOT BE JACCT!)
LOOKUP FOMP,T ;READ OPTION.TXT
JRST NOOPTT ;NOOP!
PUSH P,JOBFF ;GET SOME BUFFER SPACE
MOVEI T,DSKOBF
MOVEM T,JOBFF
INBUF FOMP,2 ;NOT SO MANY FOR THIS SMALL FILE
POP P,JOBFF
OPTXTL: PUSHJ P,OPTCHR ;HERE AT BEGINNING OF LINE
JRST NOOPTT
CAIE AC1,"F" ;VERY COMPLEX SCANNER
CAIN AC1,"f"
JRST OPTXTF
OPTXTN: CAIE AC1,14 ;NOT OUR LINE, SKIP TO END
CAIN AC1,12
JRST OPTXTL
PUSHJ P,OPTCHR
JRST NOOPTT
JRST OPTXTN
OPTXTF: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,"T"
CAIN AC1,"t"
JRST OPTXTT
JRST OPTXTN
OPTXTT: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,"P"
CAIN AC1,"p"
JRST OPTXTP
JRST OPTXTN
OPTXTP: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,":"
JRST OPTXTN
OPTXTH: PUSHJ P,OPTCHR ;FOUND LINE, LOOK FOR A HOST
JRST NOOPTT
CAIE AC1,14 ;MAYBE EOL
CAIN AC1,12
JRST OPTXTL
CAIE AC1,"{" ;}
JRST OPTXTH
MOVE AC3,[POINT 7,HSTBUF] ;COMPARE THIS ENTRY TO WHAT (S)HE TYPED
OPTXTC: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,14
CAIN AC1,12
JRST OPTXTL
ILDB AC2,AC3 ;TYPED CHAR
JUMPE AC2,OPTXTM ;END OF NAME, IT'S A MATCH MAYBE
CAIL AC1,140
SUBI AC1,40 ;LC TO UC
CAMN AC1,AC2 ;COMPARING ASCII TO ASCII
JRST OPTXTC ;SAME, KEEP READING
JRST OPTXTH ;NOT SAME, LOOK FOR ANOTHER
OPTXTM: CAIN AC1,"/" ;FILE NAME END WITH SLASH?
JRST OPTXOK ;YES, USE EXISTING HOST NAME
CAIE AC1,":" ;NO, WHAT ABOUT COLON?
JRST OPTXTH ;NO, LOOK FOR ANOTHER ENTRY
SETZM HSTBUF
MOVE AC2,[HSTBUF,,HSTBUF+1]
BLT AC2,HSTBUF+HSTBLN-1
MOVE AC2,[POINT 7,HSTBUF]
OPTXTR: PUSHJ P,OPTCHR
JRST NOOPTT
CAIE AC1,14
CAIN AC1,12
JRST OPTXTL
CAIE AC1,"/" ;DONE WITH NAME?
;{
CAIN AC1,"}"
JRST OPTXOK ;YES
CAIL AC1,140 ;NO, CONVERT CHAR TO SIXBIT
SUBI AC1,40
IDPB AC1,AC2
JRST OPTXTR
OPTXBP: POINT 7,USRSTR
POINT 7,ACCSTR
POINT 7,PASSTR
OPTXLN←←.-OPTXBP
OPTXOK: HRLZI AC3,-OPTXLN ;POINT TO 0TH ENTRY
OPTXNX: ;{
CAIN AC1,"}"
JRST OPTXDN ;DONE AT RT BRACE
MOVE AC2,OPTXBP(AC3)
OPTXCH: PUSHJ P,OPTCHR ;COPY INTO PROPER FIELD
JRST OPTXDZ
CAIE AC1,14
CAIN AC1,12
JRST OPTXDZ
;{
CAIN AC1,"}"
JRST OPTXDZ
CAIN AC1,"/"
JRST OPTXZR
IDPB AC1,AC2
JRST OPTXCH
OPTXDZ: MOVEI AC3,0 ;PREVENT AOBJN FROM LOOPING
OPTXZR: MOVEI AC1,0
IDPB AC1,AC2
AOBJN AC3,OPTXNX
OPTXDN: RELEAS FOMP,
MOVEI AC3,0
JRST OPTRET ;FINITO
OPTCHR: SOSG OTBUF+2
IN FOMP,
JRST OPTCH1
POPJ P,
OPTCH1: ILDB AC1,OTBUF+1
JRST CPOPJ1
NOOPTT: OUTSTR [ASCIZ /Can't find your host name in OPTION.TXT
/]
EXIT ;EXEUNT
;RDHOST -- Read host name. Skips on success. AC3=0 means host name
;in HSTBUF, AC3≠0 means host number typed directly (and is in AC3).
;Rewritten by JJW, 8/86. Relies more on NETWRK code, no longer parses
;port numbers since this isn't needed for FTP.
RDHOST: SETZM HSTBUF ;Clear HSTBUF
MOVE AC3,[HSTBUF,,HSTBUF+1]
BLT AC3,HSTBUF+HSTBLN-1
MOVEI AC4,HSTBLN*5-1 ;Max number of chars
MOVE AC6,[POINT 7,HSTBUF]
RDHOS1: READW(AC5) ;Get a char
CAIE AC5," " ;Some chars to ignore
CAIN AC5,11
JRST RDHOS1
CAIE AC5,14
CAIN AC5,15
JRST RDHOS1
CAIN AC5,175
OUTSTR CRLF
CAIE AC5,12 ;Some chars to terminate on
CAIN AC5,175
JRST ENDHST
SKIPN HAIRY ;Check for terminators in one-liner?
JRST RDHNOH ;No
CAIE AC5,"/" ;{
CAIN AC5,"}"
JRST ENDHSH
CAIN AC5,"↑" ;Flag to read OPTION.TXT
JRST ENDHSH
RDHNOH: SOJLE AC4,RDHOS1 ;Check for overflow
CAIL AC5,"a"
CAILE AC5,"z"
CAIA
SUBI AC5,"a"-"A"
IDPB AC5,AC6 ;Store char in HSTBUF
JRST RDHOS1
ENDHSH: MOVEM AC5,HSTEND ;Save delimiter
ENDHST: MOVE AC6,[POINT 7,HSTBUF]
ILDB AC5,AC6 ;Check first char
CAIL AC5,"0" ;Start of a host number?
CAILE AC5,"9"
CAIN AC5,"[" ;]
JRST RDHNUM ;Yes, parse number
SETZ AC3, ;No, indicate name found
JRST CPOPJ1
RDHNUM: MOVEI 0,HSTBUF ;Point to start of numeric text
PUSHJ P,HSTNBR ;Call NETWRK to parse number
POPJ P, ;Improper format
TLNN 1,(NN%IP) ;IP number?
SKIPN AC3,1 ;Yes, make sure non-zero
POPJ P, ;Non-IP, or zero
JRST CPOPJ1 ;Skip return with number in AC3
;Try to initiate connection. ;⊗ loginj conini CONIN1 CONIN2 TRYNXT conwat
;Note: before TCP, separate connections had to be made for the "send"
;and "receive" sides. Some symbols and comments may still refer to this.
loginj: setzm conecb ;make us do a Connect
MOVEI AC3,ICPSOK ; default port for FTP
MOVEM AC3,FRS# ; foreign receive port
MOVEM AC3,FSS# ; foreign send port
SUBI AC3,1 ; FTP/TCP foreign data port is one less
MOVEM AC3,FDISOC ; foreign data in port
MOVEM AC3,FDOSOC ; foreign data out port
SETOB RSOCK,LRS# ; port nbr of -1 means make system generate nbr
SETOB SSOCK,LSS# ; same for send side
MOVSI AC1,-HOSTNS
MOVEM AC1,HOSTNP# ;Point to first host no
;Port numbers are set, now open connection.
conini: init imp,0
sixbit /IMP/
xwd obuf,ibuf
jrst noinit
mtape imp,[17 ↔ byte (6) 5,=15,=60,=15,0,0] ;Set timeouts
inbuf imp,2
outbuf imp,2
movei ac1,10
dpb ac1,[point 6,ibuf+1,11]
dpb ac1,[point 6,obuf+1,11]
movem rsock,conecb+lsloc
move ac3,hostno
CONIN1: movem ac3,conecb+hloc
OUTSTR [ASCIZ/Trying /]
OUTSTR HNMBUF
OUTCHR [" "]
MOVE 0,AC3
MOVEI 1,HSTBUF ;Reuse this buffer
PUSHJ P,HNUMST ;Clobbers ACs 2-4
OUTSTR HSTBUF
OUTSTR [ASCIZ/ ... /]
;; setzm conecb+wfloc
setom conecb+wfloc
movei ac3,10
movem ac3,conecb+bsloc
move ac3,fss
movem ac3,conecb+fsloc
mtape imp,conecb ; Make connection
;; move ac1,conecb+stloc
;; trne ac1,-1
;; jrst rsfail
;; statz imp,errbts
;; jrst noconn ; Can't connect
MOVE 0,CONECB+STLOC
TRNE 0,-1
JRST [ PUSHJ P,MTPERR
TRYNXT: MOVE AC1,HOSTNP ;Try next host number
AOBJP AC1,RSTART ;Jump if end of table
MOVEM AC1,HOSTNP
SKIPN AC3,HOSTNO(AC1)
JRST RSTART ;No more addresses to try
SETSTS IMP,0 ;Clear error bits
JRST CONIN1]
GETSTS IMP,0
TRNE 0,ERRBTS
JRST [ PUSHJ P,NIOERR
JRST TRYNXT]
OUTSTR [ASCIZ/Open
/]
output imp, ; Dummy output to set up buffer header
aos obuf+2 ; don't get out of sync at impout
DEB,<
move ac1,obuf+1
movem ac1,debptr#
>;DEB
MOVE AC3,CONECB+LSLOC ; get gensym'd port number
MOVEM AC3,LDISOC ; save for use as data input port
MOVEM AC3,LDOSOC ; save for use as data output port
repeat 0,<
pushj p,clschk ; check to see if world has been closed
jrst intbts
;Connection has been requested, now wait for it to complete
conwat: movei ac3,4
movem ac3,conecb
mtape imp,conecb ; wait for send side to connect
move ac1,conecb+stloc
tlc ac1,300000
tlcn ac1,300000
tlne ac1,060000
jrst intbts
statz imp,errbts
jrst nowait
DEB,<
outstr [asciz / Connection is open
/]
>;DEB
pushj p,clschk
jrst intbts
>;repeat 0
mtape imp,[15 ↔ 3] ;allocate
jrst ftpini
;IMP single character input and output ;⊗ impget impge2 impout impou1 impou2 impoug impodb impod1 outagn allocs
impget: sosg ibuf+2
in imp,
caia
jrst inperr
ildb ac1,ibuf+1
ISNEWP,<
skipe nwptcm
popj p, ;don't mung char if it is part of a command
>;ISNEWP
CAIGE AC1,200 ;Range check for translation
LDB AC1,PFRASC ;Convert ASCII to WAITS
SKIPE CIDEBG ;BH 12/10/77 TYPE ALL INPUT IF DEBUGGING
OUTCHR AC1
popj p,
impout: sosg obuf+2 ; OUTPUT CHR IN AC1 ON IMP CONTROL CHANNEL
pushj p,impoug ; MAY ALSO CLOBBER AC2
impou1: SKIPE CIDEBG ;BH 12/10/77 TYPE ALL INPUT IF DEBUGGING
OUTCHR AC1
push p,ac1
CAIGE AC1,200 ;Range check for translation
LDB AC1,PTOASC ;Convert WAITS to ASCII
idpb ac1,obuf+1
pop p,ac1
andi ac1,377 ;stop faking out cains (with 1000 bit)
caie ac1,12
popj p,
setom nearly
impoug:
DEB,<
push p,ac1
push p,ac2
outstr [asciz / {/]
move ac1,notsnt
pushj p,[impdpt:idivi ac1,=10
hrlm ac2,(p)
skipe ac1
pushj p,impdpt
hlrz ac1,(p)
addi a,"0"
outchr a
popj p,]
SKIPN NOTSNT ;Anything to send?
JRST IMPOD1 ; No, don't print randomness (TVR May76)
outchr [":"]
impodb: ildb ac1,debptr
trne ac1,200
jrst [ outchr ["<"]
pushj p,impdpt
outchr [">"]
jrst impod1]
cain ac1,15
jrst [ outstr [asciz /<CR>/]
jrst impod1]
cain ac1,12
jrst [ outstr [asciz /<LF>
/]
jrst impod1]
outchr ac1
impod1: move ac1,debptr
came ac1,obuf+1
jrst impodb
outstr[asciz /} /]
pop p,ac2
pop p,ac1
>;DEB
setzm notsnt ;ok, we're sending everything
outagn: out imp,
aosa obuf+2
jrst outerr
DEB,<
push p,obuf+1
pop p,debptr#
>;DEB
popj p,
allocs: =14
block 10
;Terminate a connection gracefully ;⊗ QUITCL QUIT
QUITCL: outstr [asciz /Connection has been closed
/]
QUIT: close imp,
release imp,
releas outfl,
releas infl,
RELEASE DIMP,
RELEASE DOMP,
RELEASE FIMP,3
RELEASE FOMP,3
SKIPN SYSMOD
JRST RSTART
PUSHJ P,SYSRST
EXIT
;File name reading program ;⊗ term tloop isalpn lcheck rjust rjloop
array ifbuf[3],ofbuf[3],lblock[4],soblk[4]
term: setz ac1,
movei ac2,6
move ac3,[point 6,ac1]
tloop:
MOVE AC4,AC1 ;GETTTY USES AC1
PUSHJ P,GETTTY ;TAKE COMMANDS FROM FILE, TOO
EXCH AC1,AC4
cail ac4,"a"
caile ac4,"z"
jrst lcheck
subi ac4,"a"-"A"
isalpn: subi ac4,"A"-'A'
sojl ac2,tloop
idpb ac4,ac3
jrst tloop
lcheck: caige ac4,"0"
popj p,
caig ac4,"9"
jrst isalpn
cail ac4,"A"
caile ac4,"Z"
popj p,
jrst isalpn
rjust: movei ac2,6
rjloop: trnn ac1,77
sojg ac2,[
lsh ac1,-6
jrst rjloop]
popj p,
;Program to read a file ;⊗ rdfile rdppm errspc winxit errlf rstx ttysav
rdfile: setzm lblock
setzm lblock+1
setzm lblock+2
setzm lblock+3
pushj p,ttysav ;save tty state and normalize it for reading
pushj p,term
movem ac1,lblock
cain ac4,15
jrst winxit
caie ac4,175
cain ac4,12
jrst winxit
caie ac4,"."
jrst rdppm
pushj p,term
movem ac1,lblock+1
cain ac4,15
jrst winxit
caie ac4,175
cain ac4,12
jrst winxit
rdppm: caie ac4,"["
jrst [
errspc: outstr [asciz /Illegal File specification
/]
jrst errlf]
pushj p,term
pushj p,rjust
hrlzm ac1,lblock+3
caie ac4,"."
cain ac4,","
caia
jrst errspc
pushj p,term
pushj p,rjust
hrrm ac1,lblock+3
CAIN AC4,15
JRST WINXIT ;Can omit right braket
CAIE AC4,12
cain ac4,"]"
JRST WINXIT
JRST ERRSPC
winxit: aos (p)
errlf: caie ac4,12
cain ac4,175
jrst rstx
PUSHJ P,GETTTY
MOVE AC4,AC1
jrst errlf
rstx: setlin ac6 ;put line characteristics back the way they were
setact [savtab] ;restore previous break table
skipn echof
ptjobx [0 ↔ sixbit /DOFF/] ;put echoing back
popj p,
ttysav: PTJOBX [0 ↔ SIXBIT /DON/] ;Get our echoing back
MOVE AC7,[-4,,[ 13000,,IOSSAV ;save IO status word (for image mode bit)
12000,,10 ;clear image mode bit, in case it was on
3000,,AC6 ;Save line characteristics in AC6
2000,,SPCBRK]] ;Then turn off these bits
TTYSET AC7,
MOVEI AC7,10 ;leave only the image mode bit
ANDM AC7,IOSSAV ; in the saved IO status
SETACT [SAVTAB,,TTYBRK] ;save break table, clear ALLACT & BSACT
popj p,
;Print octal ;⊗ POCT poctl
POCT: PUSH P,AC2
MOVE AC2,AC1
push p,ac3
movei ac3,=12
poctl: SETZ AC1,
LSHC AC1,3
ADDI AC1,"0"
OUTCHR AC1
sojg ac3,poctl
pop p,ac3
POP P,AC2
POPJ P,
;Routine to see if socket has been closed under us. Skips if not closed. ;⊗ clschk inpskp
clschk: mtape imp,sttblk
move ac1,sttblk+1
or ac1,sttblk+2
stato imp,errbts
tlnn ac1,(<rfcs!rfcr>)
JRST INPSKP ;WAS POPJ P, -- DON'T DIE IF INPUT WAITING
aos (p)
popj p,
;Routine to skip if any IMP input present
inpskp: move ac1,ibuf+2
caile ac1,1
jrst cpopj1
hrrz ac1,ibuf
hrrz ac1,(ac1)
skipge (ac1)
jrst cpopj1
mtape imp,[10]
popj p,
jrst cpopj1
;Interrupts get to here ;⊗ intdsp intend inunlk insr inttst insflg inrflg
intdsp: move 1,jobcni
TLNE 1,(<INTTTY>)
SETOM LUKTTY
ISNEWP,<
tlne 1,(<intins!intinr>) ;IMP interrupt by sender or receiver?
jrst insr
>;ISNEWP
tlne 1,(<intclk>)
jrst inunlk ;time to unlock
intend:
ISNEWP,<
move 1,[intclk!intins!intinr!inttty]
>;ISNEWP
NONEWP,<
movsi 1,(<intclk!inttty>)
skipe luktty
tlz 1,(<inttty>)
>;NONEWP
intmsk 1
dismis
inunlk: unlock
movei 1,4 ;lock in again soon.
movem 1,lockct
clkint 0
jrst intend
ISNEWP,<
insr: uwait
intmsk [intclk!intins!intinr!inttty]
debreak
mtape imp,inttst ;find out about ins and inr
jrst 2,@jobtpc ;back to main program level
inttst: 14
insflg: 0
inrflg: 0
>;ISNEWP
;Error returns and such ;⊗ NOIMP NOINIT IMPERR IMPER1 RSFAIL intbts concls
NOIMP: RELEAS FIMP,3 ;flush any file being written
RELEAS FOMP,3 ;just for good measure
NOINIT: OUTSTR [ASCIZ /Can't INIT the IMP
/]
EXIT
IMPERR: GETSTS IMP,0
TRNE 0,ERRBTS
JRST [ PUSHJ P,NIOERR
JRST IMPER1]
MTAPE IMP,STTBLK
MOVE 0,STTBLK+1
TRNE 0,-1
JRST [ PUSHJ P,MTPERR
JRST IMPER1]
OUTSTR [ASCIZ/Network error. Please report this via GRIPE FTP.
/]
IMPER1: EXIT
repeat 0,<
RSFAIL: MOVE 0,AC1 ;Error code where MTPERR wants it
PUSHJ P,MTPERR
intbts: mtape imp,sttblk
getsts imp,ac2
move ac1,sttblk+1
or ac1,sttblk+2
tlnn ac1,(<rfcs!rfcr>)
concls: outstr [asciz /Connection has been closed
/]
trne ac2,rset
outstr [asciz /Reset received from host
/]
trne ac2,hdead
outstr [asciz /Host dead
/]
trne ac2,iodend
outstr [asciz /End of file
/]
close imp,
release imp,
release infl,
release outfl,
tlne ac1,(<rfcs!rfcr>)
trne ac2,rset!hdead!iodend
EXIT
TRNE AC2,400000 ;IOIMPM
OUTSTR [ASCIZ/?Improper-mode error
/]
TRNE AC2,200000 ;IODERR sometimes means connection was reset
OUTSTR [ASCIZ/?IMP IO device error
/]
TRNE AC2,100000 ;IODTER
OUTSTR [ASCIZ/?IO data error -- timeout
/]
MOVE 0,CONECB+STLOC
PUSHJ P,MTPERR ;Print failure reason
JRST RSTART
>;repeat 0
;More error messages ;⊗ noconn nowait inperr outerr
repeat 0,<
noconn: outstr [asciz /Failed to open connection
/]
jrst intbts
nowait: outstr [asciz /Error while waiting for connection
/]
jrst intbts
>;repeat 0
inperr: outstr [asciz /Error on input
/]
;; jrst intbts
JRST IMPERR
outerr: outstr [asciz /Error on output
/]
;; jrst intbts
JRST IMPERR
;DATGEN Date Generator c/o Datgen.fai[sls,dcs] ;⊗ NUMPR NUMPR1 DON0 DATGEN NODA1 NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
BEGIN DATGEN
DEFINE STROUT(X) <
MOVE C,[POINT 7,X]
PUSHJ P,TTSTROUT
>
DEFINE OUT1 (X) <
MOVE A,X
PUSHJ P,TTCHROUT
>
DEFINE PRNUM(X,N) <
IFN X-T2,<MOVE T2,X ;arranged to be ok for this routine,
; to clobber T2 whenever prnum called>
PUSHJ P,NUMPR ;ok to generate multiple words
N ; in PRNUM -- this is min width
>;PRNUM
NUMPR:PUSH P,T1
MOVE T1,@-1(P)
PUSHJ P,NUMPR1
POP P,T1
AOS (P)
POPJ P,
NUMPR1:IDIVI T2,=10
IORI T3,"0"
HRLM T3,(P)
SUBI T1,1
JUMPE T2,.+2
PUSHJ P,NUMPR1
JUMPLE T1,DON0
OUT1 (<["0"]>)
SOJG T1,.-1
DON0:HLRZ T2,(P)
OUT1 T2
POPJ P,
↑↑DATGEN:
DATE T1,
IDIVI T1,=31
ADDI T2,1
PRNUM (T2,0)
NODA1: IDIVI T1,=12
MOVEI T3,PDDATE
CAILE T2,3
CAILE T2,=9
MOVEI T3,PSDATE
MOVEM T3,DTKIND
MOVE T2,MONTAB(T2)
STROUT (T2) ;T3 HAS LH BYTE 0
MOVEI T2,=64(T1)
PRNUM (T2,2)
NODATE: STROUT (<[ASCIZ / /]>)
MSTIME T2,
IDIVI T2,=1000*=60
IDIVI T2,=60
MOVE T1,T3
PRNUM (T2,2)
MOVE T2,T1
PRNUM (T2,2)
NOTIME: STROUT (@DTKIND)
NOZON: POPJ P,
MONTAB: ASCII /-JAN-/
ASCII /-FEB-/
ASCII /-MAR-/
ASCII /-APR-/
ASCII /-MAY-/
ASCII /-JUN-/
ASCII /-JUL-/
ASCII /-AUG-/
ASCII /-SEP-/
ASCII /-OCT-/
ASCII /-NOV-/
ASCII /-DEC-/
PDDATE: ASCIZ / PDT/
PSDATE: ASCIZ / PST/
DTKIND: 0
BEND DATGEN
;The FTP ;⊗ FTPACT DIACTV DOACTV XACTV DIBUF DOBUF FIBUF FOBUF LDOSOC LDISOC FDISOC FDOSOC SVOTYP DTYPE DRTYPE SAILFL IMODES FMODES DBS CNIBTS OUTCON SAVP CHAR1 SNDMOD SNDTYP SNDBYT MAILNG ACTION GIVELF PKUNAM PKUEXT PKURNM HAIRY HAIRBP HAIRBF HAIRLS HAIRRS HAIRPT HAIRLR HASCII HSTEND USRSTR ACCSTR PASSTR OPOPEN OTBUF TYPTAB FNBUF FNBUF2 FNBPT
EXTERN JOBFF ;FOR PREALLOCATED BUFFERS
EXTERN JOBREL ;FOR STORING NLST OUTPUT ON TOP
FTPACT: 0 ;FLAG THAT FTP IS BEING INVOKED
DIACTV: 0 ;NON-ZERO MEANS DATA-IN CHANNEL IS ACTIVE
DOACTV: 0 ;NON-ZERO MEANS DATA-OUT CHANNEL IS ACTIVE
XACTV: 0 ;NON-ZERO MEANS DON'T GO INTO A WAIT STATE
DIBUF: BLOCK 3 ;BUFFER HEADER FOR DATA IN
DOBUF: BLOCK 3 ;BUFFER HEADER FOR DATA OUT
FIBUF: BLOCK 3 ;BUFFER HEADER FOR DATA IN (LOCAL FILE SYSTEM OUT)
FOBUF: BLOCK 3 ;BUFFER HEADER FOR DATA OUT (LOCAL FILE SYSTEM IN)
LDOSOC: 0 ;LOCAL DATA-OUT Port NUMBER
LDISOC: 0 ;LOCAL DATA-IN Port NUMBER
FDISOC: 0 ;FOREIGN DATA-IN Port NUMBER
FDOSOC: 0 ;FOREIGN DATA-OUT Port NUMBER
SVOTYP: 0 ;SAVE TYPE DURING MAILING
DTYPE: 1 ;0 - ASCII, 1-IMAGE, 2 - LOCAL BYTE
DRTYPE: 1 ;"REAL" TYPE: IF DIFFERENT FROM ABOVE CAN BE 3 (ASCII PRINT)
; ≡ 0 HERE, 1 IF IMAGE BYTE DIVIDES 36, OR 5 FOR LOCAL BYTE
; ON THIS END BUT IMAGE ON THAT END
SAILFL: 0 ;Non-0 for SAIL mode: don't exchange "_" and "←".
IMODES: 0 ↔ 10 ↔ 10
FMODES: 0 ↔ 10 ↔ 10
DBS: =8
CNIBTS: 0 ;JOBCNI BITS OR'D INTO HERE AT INTERRUPT LEVEL
OUTCON: 0 ;ON IF DATA CONNECTION MADE FOR OUTPUT (STOR, ETC.)
;USED WHEN FLUSHING OUTPUT (RSTR COMMAND, INVALID
; STOR COMMAND, ETC.) TO DETERMINE WHETHER CONNECTION
; SHOULD BE TERMINATED
SAVP: 0 ;SAVE MAIN PROCESS PDL FOR RESET
CHAR1: 0 ;←-1 BEF. OPCODE SCAN, ←0 WHEN CHAR THERE, "*" CONTROL
SNDMOD: 0 ;MODE SENT TO SERVER
SNDTYP: 0 ;TYPE SENT TO SERVER
SNDBYT: 0 ;BYTE SENT TO SERVER
MAILNG: 0 ;ON IF MAILING, FOR TYPE RESTORATION LATER
ACTION: 0 ;-1 ALLOWS SENDING ABOR COMMAND EVEN IF NO DxACTV
GIVELF: 0 ;-1 TELLS GETTTY TO RETURN LF WITHOUT READING TTY
PKUNAM: 0 ;FILENAME FOR PICKUP COMMAND
PKUEXT: 0 ;EXT DITTO
PKURNM: 0 ;FN ACTUALLY USED FOR PICKUP (PHASE CONTROL)
HAIRY: 0 ;-1 IF HAIRY ONE-LINE TRANSFER MONITOR CMD
HAIRBP: 0 ;BPT INTO HAIRBF
HAIRBF: BLOCK 50 ;BUFFER TO HOLD THE COMMAND
HAIRLS: 0 ;BPT TO LOCAL SPEC
HAIRRS: 0 ;BPT TO REMOTE SPEC
HAIRPT: 0 ;-1 IF PUTTING (STOR)
HAIRLR: 0 ;-1 IF HOST NAME ON THE LEFT
HASCII: 0 ;-1 FOR /A (ASCII) TRANSFER
HSTEND: 0 ;DELIMITER WHICH ENDS HOST (RBRACE OR SLASH)
USRSTR: BLOCK 10 ;USER NAME FOR REMOTE HOST
ACCSTR: BLOCK 10 ;ACCT FOR REMOTE HOST
PASSTR: BLOCK 10 ;PASSWORD FOR REMOTE HOST
OPOPEN: 0
'DSK '
OTBUF
OTBUF: BLOCK 3
TYPTAB: "A"
"I"
"L"
"P"
"E"
"I" ;CROCK MODE, LOCAL BYTE FOR US, IMAGE FOR THEM
FNBUF: BLOCK 30 ;BUFFER FOR FILE XFER COMMAND ARGS
FNBUF2: BLOCK 30 ;DITTO FOR INSTEAD FILE READ FOR SAFETY CHECK
FNBPT: POINT 7,FNBUF ;BYTE POINTER TO ABOVE
DEFINE MESSG (X)
< OUTSTR [ASCIZ ⊗X
⊗]>
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
;FTP Opcode Definitions ;⊗ OCDISP OCS
DEFINE OCX <
X(USER,USER)
X(LOGI,PUSER) ;PSEUDONYM FOR USER
X(PASS,PASS) ;PASSWORD NOW GOBBLED BY USER COMMAND, this for CWD, etc.
x(ACCT,WIDENT)
X(XCWD,PXCWD) ;now looks for password just like USER
X(CWD,PXCWD)
X(ALIA,PXCWD)
X(CD,PXCWD) ;for Unix junkies
X(TYPE,TYPE)
X(ASCI,ASCSET) ;TYPE A
X(IMAG,IMGSET) ;TYPE I
X(LOCA,LCLSET) ;TYPE L
X(SAIL,SAISET) ;TYPE S
X(TEXT,TEXSET) ;TYPE T (obsolete)
; X(MODE,MODE) BH 3/17/75 Flush losing text mode, was all wrong anyway
X(BYTE,BYTE)
X(RETR,RETR)
X(GET,PRETR) ;TENEX RETR
X(TTY,TTY) ;BH 12/2/77 TTY IS SYNONYM OF RETR BUT TO DEVICE TTY
X(STOR,STOR)
X(PUT,PSTOR)
X(SEND,PSTOR) ;TENEX STOR
X(APPE,STOR)
X(LIST,LIST)
X(NLST,LIST)
X(DIRE,PLIST) ;"DIRECTORY" IS TENEX LIST
X(QUOT,QUOTE) ;WHO KNOWS WHAT THIS ONE DOES
X(STAT,STAT) ;WAITS FOR 200 END OF STATUS
X(RNFR,WIDENT)
X(RNTO,WIDENT)
X(DELE,WIDENT)
; X(RSTR,RSTR) FLUSHED AT LAST!!!
X(QUIT,FQUIT)
X(BYE,FQUIT)
X(DISC,FQUIT) ;TENEX BYE
X(XIND,XIND)
X(PICK,PICKUP) ;CONTINUE MULTIPLE XFER AFTER ERROR
X(LPPN,LPPN) ;BH 4/4/76 LOCAL PPN MODE
X(RPPN,RPPN) ; AND REMOTE PPN MODE
X(DEBG,DEBG) ;BH 12/10/77 TYPE OUT ALL IMP INPUT
X(DEBU,DEBG) ;MRC HOW CAN ANYBODY EVER REMEMBER DEBG?
X(NOPO,NOPORT) ;disable use of PORT command
X(PORT,PORT) ;enable use of PORT command
X(NOOP,NOOP)
X(SYST,SYST)
X(PWD,PWD)
X(HELP,LHELP) ;HELP used to get remote help, now local help
X(RHEL,RHELP) ;RHELP gets remote help
>
DEFINE X!(A,B) <
..!A←←.-OCDISP
0+B↔>
OCDISP: OCX
NOCS ←← .-OCDISP
DEFINE X(A,B) <[ASCIZ /A/]↔>
OCS: OCX
;⊗ FQUIT TTCINK STAT PXCWD WIDENT TTCIWT TTCIW1 QWAIT RHELP IDENT IDENT0 IDENT1 IDENT2 RPLX PASS PUSER USER PASS2 USER1
FQUIT: MOVE AC3,[POINT 7,[ASCIZ /QUIT
/]]
PUSHJ P,TTSTROUT
CLKINT =3*=60 ;WAIT FOR TIMEOUT OR REPLY
PUSHJ P,TTCIWT ;WAIT FOR REPLY
JRST QUIT
TTCINK: MOVEI T1,MSGSTK ;CHECK FOR EARLY-ARRIVING MESSAGE
CAML T1,MSGPTR
JRST TTCIW1 ;NO, WE REALLY HAVE TO WAIT
MOVE T1,MSGSTK ;YES, GET A MESSAGE CODE
MOVEM T1,CIFLAG ;SAVE FOR CALLER
MOVE T1,[MSGSTK+1,,MSGSTK] ;FLUSH FROM STACK
BLT T1,MSGSTK+6
AOS MSGCNT
SOS MSGPTR
POPJ P,
STAT: SETOM ACTION ;STAT JUST LIKE WIDENT BUT ALLOWS ABORT
PUSHJ P,WIDENT
SETZM ACTION
POPJ P,
PXCWD: MOVEI AC2,..CWD ;FOR "ALIAS" COMMAND, BECOMES CWD
JRST USER ;CWD acts like USER in looking for password
WIDENT: PUSHJ P,IDENT ;HERE TO FORWARD COMMAND AND WAIT FOR REPLY
TTCIWT: MOVEI T1,MSGSTK ;SYNCHRONIZE--IGNORE SAVED MESSAGES
MOVEM T1,MSGPTR
MOVEI T1,10
MOVEM T1,MSGCNT
TTCIW1: SETZM RPLY# ;SET BY CLOCK OR LF CONTROL STREAM
PUSHJ P,SXACTV ;MAKE SURE SOMETHING HAPPENS?
QWAIT: PUSHJ P,TTWAIT ;AND GO WAIT
SKIPN RPLY# ;CONTINUE DOING THAT UNTIL REPLY
JRST QWAIT ; OR TIMEOUT
POPJ P,
RHELP: SETOM HELPER# ;BH 12/30/77 CATCH ERROR REPLY TO HELP
MOVE T1,[ASCIZ/HELP/]
JRST IDENT0
IDENT: MOVE T1,@OCS(AC2)
IDENT0: MOVE AC3,[POINT 7,T1]
PUSHJ P,TTSTROUT ;Send the command
SKIPE NOPARM# ;Are there any parameters?
JRST IMPCRL ;No, send CRLF and return
MOVEI AC1," " ;Yes, send a space
PUSHJ P,IMPOUT
JRST IDENT2 ;Now scan and send params (ending with CRLF)
IDENT1: PUSHJ P,TTSTROUT ;send string pointed to by AC3 to IMP
SKIPE NOPARM#
JRST RPLX
IDENT2: PUSHJ P,GETTTY
PUSHJ P,IMPOUT
ifn verbose, <
outchr ["<"]
outchr ac1
outchr [">"]
>;ifn verbose
CAIE AC1,12
JRST IDENT2
RPLX: POPJ P,
PASS: SKIPE NOPARM# ;skip unless EOL at end of cmd
JRST PASS2
PUSHJ P,GETTTY ;read to end of command line, ignoring
CAIE AC1,12
CAIN AC1,175
JRST PASS2 ;now ask user for password
JRST PASS
PUSER: MOVEI AC2,..USER ;"LOGIN" COMMAND SAME AS USER
USER: PUSHJ P,IDENT ;USER COMMAND: FIRST SEND IT
PUSHJ P,TTCIWT ;NOW WAIT FOR RESPONSE
MOVE T1,CIFLAG ;GET THE RESPONSE CODE
CAIL T1,=300
CAILE T1,=399 ;DO THEY WANT PASSWORD?
JRST USER1 ;NO, THAT'S ALL (OR HAGGLE)
PASS2: MOVE AC3,[POINT 7,[ASCIZ /PASS /]]
PTJOBX [0↔3] ;NO ECHO
HRROI T1,[030000,,1] ;TTYSET NO PEEK INPUT BUFFER
TTYSET T1,
LEYPOS 1400 ;NO LINE EDITOR
OUTSTR [ASCIZ /Password=/] ;ASK FOR PASSWORD
SETZM GIVELF ;HOO HAH
SETZM TTCHSV
SETZM NOPARM# ;make us read password from TTY
PUSHJ P,IDENT1 ;GET AND FORWARD PASSWORD
OUTSTR [ASCIZ /
/]
HRROI T1,[10000,,] ;Suppress Control-CR once only
TTYSET T1,
LEYPOS 0 ;RESTORE THE WORLD
PTJOBX [0↔4]
HRROI T1,[030000,,0] ;TTYSET OK PEEK INPUT BUFFER
TTYSET T1,
PUSHJ P,TTCIWT ;NOW HANG ON FOR THE PASS REPLY
MOVE T1,CIFLAG
USER1: CAIGE T1,=400 ;NO POINT IN RETRYING HAGGLE IF FAILED
SKIPE AGREED ;NEGOTIATE A BYTE SIZE
POPJ P, ; UNLESS WE ALREADY HAVE
; JRST HAGGLE
;⊗ HAGGLE HAGASC HAGLUZ ASCOK IMGOK HAGTYP STREAM
;FALLS THROUGH
HAGGLE: SETOM CIGRQA ;TELL CI NOT TO TYPE RESPONSES
SKIPE HASCII ;BH 11/27/77 WANT ASCII?
JRST HAGASC ;YES
;JJW 1/84 send TYPE L 36 even though our defaults are set for Image.
;This doesn't hurt us, and will stimulate rejection from non-PDP-10s.
MOVE AC3,[POINT 7,[ASCIZ /TYPE L 36
/]] ;PITTS JARVIS CORRECTION FEATURE
PUSHJ P,TTSTROUT ;SEND IMAGE REQUEST FIRST
PUSHJ P,TTCIWT
MOVE T1,CIFLAG ;DON'T ANALYZE RESPONSE NOW,
CAIGE T1,=300
JRST IMGOK
;IMAGE rejected, try ASCII
MOVE AC3,[POINT 7,[ASCIZ /TYPE A
/]]
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT
MOVE T1,CIFLAG
CAIGE T1,=300
JRST ASCOK
OUTSTR [ASCIZ /Unable to use either TYPE LOCAL 36 or TYPE ASCII with this host.
Please report this to Bug-FTP.
/]
JRST HAGLUZ
HAGASC: MOVE AC3,[POINT 7,[ASCIZ /TYPE A
/]]
PUSHJ P,TTSTROUT ;Here if ASCII wanted
PUSHJ P,TTCIWT
MOVE T1,CIFLAG
CAIGE T1,=300
JRST ASCOK
OUTSTR [ASCIZ /Host rejects ASCII type.
Please report this to Bug-FTP.
/]
HAGLUZ: SETZM HAIRY
SETZM HASCII
SETZM AUTOLF
SETZM AUTOAL ;no auto abort on overwrite, yet
POPJ P,
ASCOK: SKIPN HAIRY
OUTSTR [ASCIZ /Using ASCII transfers.
/]
SETZM DTYPE
SETZM DRTYPE
JRST HAGTYP
IMGOK: SKIPN HAIRY
OUTSTR [ASCIZ /Using 36-bit transfers.
/]
HAGTYP: SETOM SNDTYP ;DECLARE TYPE SENT
STREAM: MOVE AC3,[POINT 7,[ASCIZ /MODE S
/]]
PUSHJ P,TTSTROUT ;WE DON'T REPORT SUCCESS OF MODE S
PUSHJ P,TTCIWT ;BECAUSE EVERYBODY TAKES IT
MOVE T1,CIFLAG ;AND BESIDES,
CAIGE T1,=300
SETOM SNDMOD ;IF NOT, USER WILL FIND OUT IN TIME
SETZM CIGRQA
SETOM AGREED#
POPJ P,
;⊗ TYPE TYPDSP TYPEUN TYPET TEXSET TYPEA ASCSET TYPES SAISET IMGSET TYPEX TYPEOK TYPINC TYPIN2 TYPFIX BADTYP BDTYMS WHICHA WHICHB DFCOM COMOUT IMPCRL TYPEL LCLSET BYTE BYTE1 BYTE2 BYTE3 BADARG BADBYT BDBYMS BYTOU0 BYTOUT DECOUT SNDPAR STYP NOPORT PORT SNDPRT SNDPR2 SNDPRH PICKUP PKUNU1 PKUNUL PKUERR TYPDEC
TYPE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /AILPEXST/]]
PUSHJ P,WHICHA
JUMPL C,BADTYP
TYPDSP: JRST .+1(C)
JRST TYPEA ;A (0) normal ASCII
JRST TYPEOK ;I (1) Image
JRST TYPEL ;L (2) Local byte size, read byte size from user
JRST TYPEUN ;P (3)
JRST TYPEUN ;E (4)
JRST TYPEX ;X (5) THIS ISN'T A REAL TYPE. L 8 FOR US AND I FOR THEM.
JRST TYPES ;S (6) Set SAILFL and then TYPE A
JRST TYPET ;T (7) Obsolete TEXT mode
TYPEUN: OUTSTR [ASCIZ /Unimplemented type
/]
JRST FLUSCS
TYPET:
TEXSET: OUTSTR [ASCIZ/TEXT mode no longer exists; ASCII mode now does what you want.
/]
TYPEA:
ASCSET: SETZM SAILFL ;Normal ASCII conversion
MOVEI C,0
JRST TYPEOK
TYPES:
SAISET: SETOM SAILFL ;SAIL mode ASCII conversion
MOVEI C,0
JRST TYPEOK
IMGSET: MOVEI C,1 ;Image mode
JRST TYPEOK
TYPEX: MOVEI B,10 ;"TYPE X" set byte size to 8, to simulate TYPE L 8 here
MOVEM B,SAVBYT
TYPEOK: PUSHJ P,FLUSCS
;Enter here to restore saved type after it was temporarily changed by
;something like the LIST command.
TYPINC: MOVEM C,NEWTYP# ;save it
CAIN C,2 ;local byte mode?
JRST [ PUSHJ P,BYTOU0 ;yes, send TYPE cmd with saved byte size
JRST TYPIN2 ]
MOVE A,TYPTAB(C) ;get letter back
MOVE AC3,[POINT 7,[ASCII /TYPE/]]
PUSHJ P,COMOUT ;forward to network
TYPIN2: PUSHJ P,TTCIWT ;wait for reply
MOVE C,CIFLAG ;get reply
CAIL C,=400 ;error?
POPJ P, ;yes, do nothing here
MOVE C,NEWTYP ;no, change our type
;Enter here from end of TYPEL (having just read new byte size into SAVBYT)
;Now we set the "convenient" type for ourselves depending on the "official" type.
TYPFIX: MOVEM C,DRTYPE ;save "real" type name
SETZM MAILNG ;no longer saving old type
MOVE B,SAVBYT ;need to check byte size for certain types
CAIN C,2 ;L?
CAIE B,=36 ;yes, L 36?
CAIA ;no
MOVEI C,1 ;yes, use Image mode locally
CAIN C,3 ;BH 3/17/75 change P to A
MOVEI C,0
CAIN C,5 ;and X to L
MOVEI C,2
MOVEM C,DTYPE
SETOM SNDTYP ;we've sent a TYPE cmd now
;Always set byte size to 8, since in TCP transfer byte size is always 8.
;Here from TYPE A, TYPE I, TYPE L, TYPE X commands and after type was temporarily
;set to TYPE A for some command like LIST.
MOVEI B,10
MOVEM B,DBS ;always set byte size to 8
POPJ P,
BADTYP: OUTSTR BDTYMS ;HARD TIMES!
JRST FLUSCS
BDTYMS: ASCIZ \Types are:
A - ASCII. Conversion is done to/from WAITS character set. Output from WAITS
in this mode will discard nulls, E directory pages, and SOS line numbers.
This is the mode you should use when moving text files.
S - SAIL. Like ASCII, except that "_" and "←" are not interchanged. This is
need for programs written in SAIL or FAIL.
I - Image. Bits are sent or received contiguously. Good for 36-bit
machines, may or may not be best for 32-bit.
L - Local byte; specify a byte size of 8, 32 or 36 after the "L",
e.g., "TYPE L 36". Bytes are stored as convenient for each host.
On the WAITS end, TYPE L 36 is equivalent to image, since 36 bits
are stored in each word. If the byte size is 8 or 32, only the
high-order 32 bits of each WAITS word are used, corresponding to
one word of a 32-bit machine.
E - EBCDIC. Not implemented here.
X - Not a real type; this tells the other end TYPE I but is treated as
TYPE L 8 on this end. Use it if you are talking to an 8-, 16- or
32-bit machine and want TYPE L 8 (or 16 or 32) but they refuse it.
\
WHICHA: ;CALL: MOVE B,[POINT 7,[ASCIZ /<CHARACTERS>/]]
; MOVE A,<ASCII CHARACTER>
; PUSHJ P,WHICHA
; RETURN HERE, C(C) = -1, OR # OF CHARACTER IN A
SETZ C,
WHICHB: ILDB D,B
JUMPE D,[SETO C, ↔ POPJ P,]
CAMN D,A
POPJ P,
AOJA C,WHICHB
DFCOM: ;DeFault COMmand - JUST PASS IT ON TO THE SERVER TELNET
;CALL: ;MOVE A,<ONE CHARACTER (EATEN FROM COMMAND STRING)>
; ;MOVE AC3,[POINT 7,[ASCII /<COMMAND>/]]
; ;PUSHJ P,DFCOM
; ; ACTION: ON THE CONTROL LINK, OUTPUT THE COMMAND,
; ; THEN A SPACE, THEN THE ONE CHARACTER, THEN
; ; CRLF, THEN JRST FLUSCS
PUSHJ P,COMOUT ;SEND THE COMMAND
JRST FLUSCS
;COMand OUT - Same as above, but no flushing
COMOUT: PUSH P,A ;SAVE THE FIRST CHARACTER ARGUMENT
PUSHJ P,TTSTROUT ;SEND OUT THE 1,2,3, OR 4 COMMAND CHARACTERS
MOVEI AC1," "
PUSHJ P,IMPOUT ;SEND OUT THE DELIMITING SPACE
POP P,A ;RETREIVE THE ARGUMENT CHARACTER
PUSHJ P,IMPOUT ;SEND IT OFF
IMPCRL: MOVE AC3,[POINT 7,CRLF]
JRST TTSTROUT
TYPEL: PUSHJ P,GETTTY ;get space
CAIE A," "
JRST BADARG
LCLSET: ;LOCAL command
BYTE: SETZB B,D ;BYTE command
SETZB E,F
MOVSI C,-3 ;AT MOST THREE CHARS IN ARGUMENT
BYTE1: PUSHJ P,GETTTY ;GET DIGIT
CAIN A,15 ;CR?
JRST BYTE2 ; YES
CAIL A,"0"
CAILE A,"9"
JRST BADARG
IMULI B,=10
ADDI B,-"0"(A)
AOBJN C,BYTE1
PUSHJ P,GETTTY ;GET CR
CAIE A,15 ;CR?
JRST BADARG ; NO
BYTE2: CAIE B,=8 ;MAKE SURE SIZE OK
CAIN B,=32 ;THESE TWO ARE SPECIAL
JRST BYTE3
CAIE B,=36 ;ELSE MUST BE 36.
JRST BADBYT ;LOSES
BYTE3: MOVEM B,NEWBYT# ;SAVE NEW BYTE SIZE
PUSHJ P,BYTOUT ;SEND IT TO THEM (from NEWBYT)
PUSHJ P,TTCIWT ;WAIT FOR ANSWER
MOVE B,CIFLAG ;GET ANSWER CODE
CAIL B,=400 ;ERROR?
JRST FLUSCS ;YES, FORGET IT
MOVE B,NEWBYT ;OTHERWISE SET OUR BYTE SIZE(S)
MOVEM B,SAVBYT ;Save Real byte size specified
PUSHJ P,FLUSCS ;flush rest of cmd line
MOVEI C,2 ;set type to Local byte size
JRST TYPFIX ;adjust type and byte size if necessary
BADARG: OUTSTR [ASCIZ /TYPE L (or BYTE, or LOCAL) must be followed by a space and a decimal byte size.
/]
BADBYT: OUTSTR BDBYMS ;BEDDY-BYE MESSAGE?
JRST FLUSCS
BDBYMS: ASCIZ /The byte size must be 8, 32, or 36. As far as WAITS is concerned, sizes
8 and 32 are equivalent, using only the bits 0:31 of the 36-bit PDP-10
word. TYPE L 36 is equivalent to TYPE I (image) at the WAITS end.
/
BYTOU0: MOVE A,SAVBYT ;here to reaffirm TYPE L with old byte size
MOVEM A,NEWBYT
BYTOUT: MOVE AC3,[POINT 7,[ASCIZ /TYPE L /]]
PUSHJ P,TTSTROUT
MOVE A,NEWBYT
PUSHJ P,DECOUT
MOVE AC3,[POINT 7,CRLF]
JRST TTSTROUT
DECOUT: IDIVI A,=10
ORI B,"0"
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,DECOUT
HLRZ A,(P)
JRST IMPOUT
SNDPAR: SKIPE SNDMOD
JRST STYP ;MODE ALREADY SENT
SETOM SNDMOD
MOVE AC3,[POINT 7,[ASCII /MODE/]]
MOVEI A,"S"
PUSHJ P,COMOUT ;SEND THE COMMAND
STYP: SKIPE SNDTYP
POPJ P, ;TYPE ALREADY SENT
SETOM SNDTYP
MOVE A,DTYPE
CAIN A,2 ;skip unless local byte size
JRST BYTOU0 ;send TYPE L <size>
MOVE AC3,[POINT 7,[ASCII /TYPE/]]
MOVE A,TYPTAB(A) ;MODE CHAR
PUSHJ P,COMOUT ;specify type
POPJ P,
;Here from NOPORT cmd from user -- disable use of PORT cmd.
NOPORT: SETZM USEPRT
POPJ P,
;Here from PORT cmd from user -- enable use of PORT cmd.
PORT: SETOM USEPRT
POPJ P,
;Send PORT command prior to attempting data connection.
;Skips on success. Fails only if foreign host doesn't swallow PORT cmd.
SNDPRT: SKIPN USEPRT ;skip if want to use PORT cmd.
JRST CPOPJ1 ;no PORT cmd
MTAPE IMP,IPNBRS ;get host&port nbrs for control connection
SKIPN IPNBRS+WFLOC ;make sure we really have an IP host number
JRST CPOPJ1 ;hmm, none. have to use default port then.
AOS AC3,LDISOC ;see if we have another port nbr in old sequence
TRNE AC3,7 ;if up to next group of 8, then need new nbr
JRST SNDPR2 ;just use incremented port nbr
repeat 1,< ;avoid using infinite nbr of ports
SUBI AC3,7 ;go back to the first data port number
>;repeat 1
repeat 0,<
MTAPE IMP,GETPRT ;have system gensym a port nbr for us
MOVE AC3,GETPRT+1 ;get gensym'd port nbr
>;repeat 0
MOVEM AC3,LDISOC ;use this port for data connection,
SNDPR2: MOVEM AC3,LDOSOC ; in either direction
NODEB,< SETOM GAG200 > ;NODEB ;don't type out PORT response if OK
MOVE AC3,[POINT 7,[ASCIZ/PORT /]]
PUSHJ P,TTSTROUT ;SEND OUT COMMAND NAME AND SPACE
MOVE AC3,[POINT 8,IPNBRS+WFLOC,3] ;byte ptr to our host nbr
SNDPRH: ILDB A,AC3 ;get next byte of our own host number
PUSHJ P,DECOUT ;output to IMP
MOVEI A,"," ;
PUSHJ P,IMPOUT ;output comma
TLNE AC3,770000 ;end of host number?
JRST SNDPRH ;nope, keep outputting dotted host number
MOVE AC3,[POINT 8,LDISOC,19] ;byte ptr to our port number (for in or out)
ILDB A,AC3 ;get next byte of our PORT number
PUSHJ P,DECOUT ;output to IMP
MOVEI A,"," ;
PUSHJ P,IMPOUT ;output comma
ILDB A,AC3 ;get next byte of our PORT number
PUSHJ P,DECOUT ;output to IMP
PUSHJ P,IMPCRL ;output a CRLF
PUSHJ P,TTCIWT ;wait for a reply
SETZM GAG200 ;OK to type out 2XX type msgs now
MOVE A,CIFLAG ;get reply
CAIN A,=200 ;should be this number
AOS (P) ;success, take skip return
POPJ P,
PICKUP: SETOM NOWILD# ;PICKUP COMMAND TO CONTINUE MULTIPLE XFER
SETZM PKUAOS# ;FLAG USER WANTS ONE AFTER THIS IF ALT
SKIPE A,NOPARM# ;SKIP IF ARG TO COMMAND
JRST PKUNUL ;NO FN, SEE IF WE HAVE ONE STORED
PUSHJ P,GFNY ;READ LOCAL FN TO RESTART WITH
JRST PKUERR
SKIPN BADSYN ;NO GOOD IF NOT LOCAL SYNTAX
SKIPE FNDLIM ; OR IF NOT THE ONLY ONE
JRST PKUERR
MOVEM E,PKUEXT ;OK, SAVE THE PARAMETERS
MOVE A,SAFDLM
PKUNU1: CAIN A,175
SETOM PKUAOS
MOVEM F,PKURNM
SETOM PKUSET# ;TELL TTROUT NOT TO CLOBBER IT
OUTSTR [ASCIZ /Retype the file transfer command.
/]
SKIPE PKUNAM ;MAYBE WE ALREADY HAVE A COMMAND
OUTSTR [ASCIZ /Type [RETURN] to use the previous command.
/]
POPJ P, ;COMMAND SCANNER WILL GOBBLE THE COMMAND.
PKUNUL: SKIPE F,PKUNAM
JRST PKUNU1 ;XFER COMMAND GAVE US A NAME
PKUERR: OUTSTR [ASCIZ /The PICKUP command takes a LOCAL pathname as argument.
The multiple transfer command to be resumed can be entered after the command.
/]
JRST FLUSCS
DEB,<
TYPDEC: IDIVI A,=10
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,TYPDEC
HLRZ A,(P)
ADDI A,"0"
OUTCHR A
POPJ P,
>;DEB
;⊗ QUOTE LINOUT RLNOUT LINOLF CHAROUT WRTSIX WRSXLP SJSX NOOP NOOP1 SYST PWD
QUOTE:
LINOUT: SKIPE GIVELF
JRST LINOLF ;FAKE A CRLF ON ENTRY HERE WHEN WEDGED
RLNOUT: PUSHJ P,CHAROUT ;SEND OUT REST OF TTY INPUT LINE (ASSUMING CRLF)
CAIE A,12
JRST RLNOUT
POPJ P,
LINOLF: MOVEI A,15
PUSHJ P,TTCHROUT
MOVEI A,12
JRST TTCHROUT
CHAROUT:PUSHJ P,CRGETY ;GET CHARACTER FROM TTY
JRST TTCHROUT ;SEND IT OUT AND RETURN
WRTSIX: PUSH P,T3
MOVEI T3,6
WRSXLP: MOVEI A,
LSHC A,6
JUMPE A,SJSX
ADDI A,40
PUSHJ P,TTCHROUT
SJSX: SOJG T3,WRSXLP
POP P,T3
POPJ P,
NOOP: MOVE AC3,[POINT 7,[ASCIZ/NOOP
/]]
NOOP1: PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;Wait for reply
POPJ P, ;Do we care what they say?
SYST: MOVE AC3,[POINT 7,[ASCIZ/SYST
/]]
JRST NOOP1 ;No need to interpret results
PWD: MOVE AC3,[POINT 7,[ASCIZ/PWD
/]]
JRST NOOP1
;⊗ TEMPA PLIST LIST TTY PRETR RETR TRETR RETR0 RETR01 RETR02 RETR1 RETRLP RETNPK RETPKF TYPWRT SAFASK SAFEOK TYPFIL RETRL1 SAFLKF SAFAOS SAFAUT SAFAU1 SAFEAA SAFEA1 SAFEAB CCR SAFENM TYPSIX RETRLX TYPNLS RETLX1 SAFX0 RET1ST RETRST NLSTST DIDOXX DIDOX1 DIDOXY DIDOLZ DIDOLZ SAFX1 PSTOR STOR STOR0 STORLP STORL1 STONPK STOPKF TYPREA STO1DO STORDO UFDPPN NOUFD UFDIN UFDIN1 FLUSCS SCANTO MLCHK SV2INC ERRWAT ERRWA1 GOWAIT LPPN RPPN DEBG
;Set type to ASCII temporarily, to be restored later
TEMPA: SKIPE MAILNG
POPJ P,
MOVE C,DRTYPE ;remember the real type to be restored later
MOVEM C,SVOTYP
MOVEI C,0
PUSHJ P,SV2INC ;select type in C (0=ASCII), preserving AC2
SETOM MAILNG ;THIS MUST COME AFTER SV2INC CALL!
SETZM PKUNAM ;THESE COMMANDS DO NOT ADMIT OF PICKUP OPTION
POPJ P,
PLIST: MOVEI AC2,..LIST ;FOR "DIRECTORY" COMMAND
;LIST AND NLST JUST LIKE RETR BUT ASCII
LIST: PUSHJ P,TEMPA ;set temporary TYPE A, restore real type later
SETOM LISTNG# ;NO LOCAL PATHNAME IMPLIES TTY
JRST RETR0
TTY: PUSH P,DRTYPE ;SAVE OLD TYPE
SETOM CIGRQ ;BH 8/20/80 Don't confuse the issue with replies
MOVEI C,0 ;(THIS WAY SINCE ASCSET EATS COMMAND!)
PUSHJ P,TYPINC ;DO IMPLICIT ASCII COMMAND
MOVEI AC2,..RETR ;TTY COMMAND IS RETR
SETOM TYPECM ; WITH DEFAULT OUTPUT DEVICE TTY
SETZM CIGRQ ;BH 8/20/80 Make sure no-such-file gets told
PUSHJ P,TRETR
SETZM TYPECM ;JJW 10/22/84 Someone forgot to reset this
SETZM CIGRQ ;JJW 10/22/84 Gotta do this one too
POP P,C ;RESTORE OLD TYPE
SKIPE HAIRY ;BH 8/4/80 ONE-LINER?
POPJ P, ;YES, FINISHED.
JRST TYPEOK
PRETR: MOVEI AC2,..RETR ;FOR "GET" COMMAND
RETR: SETZM TYPECM
TRETR: PUSHJ P,MLCHK
SETZM LISTNG
SETZM PKUNAM ;NO PICKUP ALLOWED UNLESS MULTIPLE
RETR0: SETZM NOHACK# ;IMPLICIT LOCAL PATHNAME OK
SETZM NOWILD ;SO IS WILDCARD FN
MOVE AC2,@OCS(AC2) ;COMMAND -- LIST OR RETR
SKIPN NOPARM# ;JJW 10/22/84 Handle LIST with no param
JRST RETR01
MOVEM AC2,COMBUF ;Store command (without extra space)
MOVE AC2,CRLF ;Store CRLF as "parameter"
MOVEM AC2,FNBUF
MOVE AC2,[POINT 7,FNBUF];Point to it
MOVEM AC2,FNBPT ;This all seems rather kludgey
JRST RETR02 ;JJW 10/22/84 (end added code)
RETR01: TRO AC2,100 ;LOW ORDER SPACE
MOVEM AC2,COMBUF
MOVEM AC2,PKUCMD#
PUSHJ P,GFN ;GET FILE NAME
POPJ P, ; DIDN'T GET ONE
MOVE B,FNDLIM ;GET DELIMITER
CAIN B,"→" ;ANYTHING BUT THIS OK
JRST GFNLUZ
JUMPN B,RETR1 ;IF NO DELIMITER (NO LOCAL PATHNAME),
RETR02: SKIPN TYPECM# ; (BH 12/2/77 TYPE COMMAND)
SKIPE LISTNG ; AND COMMAND WAS LIST OR FRIENDS,
MOVSI C,'TTY' ; OUTPUT LISTING TO TTY
RETR1: SKIPN LISTNG ;IF COMMAND IS RETR,
SKIPN WILDCD ; AND WE HAVE WILD NAME,
JRST RET1ST ; THEN SPECIAL, ELSE GO DO ONE.
MOVEM C,WCDEV# ;SAVE THE LOCAL SPEC
MOVEM D,WCPPN#
MOVEM E,WCEXT#
MOVEM F,WCFIL#
MOVE B,[ASCII /NLST /] ;FIRST WE MUST DO NLST
MOVEM B,COMBUF
SETOM GAG200 ;FLUSH SOME CRUFTY MESSAGES
PUSHJ P,TEMPA ;temporary TYPE A
SETOM NLSTFL# ;FLAG WHERE THE RESPONSE GOES
MOVE B,JOBFF ;PREPARE BYTE PTR
HRLI B,440700 ;IDCON WON'T USE THIS JOBFF
MOVEM B,NLSBPT#
MOVEM B,NLSBP1# ;ALSO SAVE FOR LATER READING
SETZM WILDCD ;SO WE FLUSH ON FAILURE HERE
PUSHJ P,NLSTST ;DO IT!
SETOM WILDCD
PUSHJ P,MLCHK ;GET OUT OF ASCII
SETZM GAG200 ;BACK TO ALLOWING RESPONSES
MOVEI A,0
IDPB A,NLSBPT ;MARK END OF LIST
MOVE B,NLSBP1
MOVEM B,NLSBPT
MOVE B,[ASCII /RETR /]
MOVEM B,COMBUF
SETZM LPPNOW ;BH 4/4/76 DON'T PREVENT SENDING PPN BACK
RETRLP: MOVE B,NLSBPT ;THIS IS THE LOOP FOR EACH FILE
MOVEM B,FNBPT ;INIT LOCAL FN SCAN
ILDB A,B ;GET FIRST CHAR
JUMPE A,CPOPJ ;THIS IS THE VERY END TEST!!!
PUSHJ P,GFNX ;READ A FN
JRST RETRLX ;OOPS, COULDN'T HACK IT
MOVE C,WCDEV ;GET BACK OUR LOCAL SPEC
MOVE D,WCPPN
MOVE A,WCEXT
CAME A,['* ']
MOVE E,A
MOVE A,WCFIL
CAME A,['* ']
MOVE F,A
SKIPN PKURNM ;ARE WE IN PICKUP MODE?
JRST RETNPK ;NOPE
CAMN F,PKURNM ;YES, COMPARE FN AND EXT
CAME E,PKUEXT
JRST RETPKF ;NOT EQUAL
SETZM PKURNM ;FROM NOW ON WE DO EVERYTHING
SKIPE PKUAOS
JRST RETPKF ;IF HE TYPED ALTMODE WE SKIP THIS ONE TOO
RETNPK: PUSHJ P,TYPWRT
PUSHJ P,SAFX0 ;PRE-MESSAGE TELLING REMOTE FN
JRST SAFX1 ;FAILED
MOVE B,NLSBPT ;PTR TO BEGINNING OF THIS FN
MOVEM B,FNBPT ;SET UP FOR REMOTE SCAN
PUSHJ P,RETRST ;DO OUR BOOGEY
SKIPA B,FNBPT ;FNSEND HAS NICELY LEFT THIS
RETPKF: MOVE B,PKUBPT#
MOVEM B,NLSBPT ; POINTING TO THE LF
JRST RETRLP
TYPWRT: CAME C,['DSK ']
JRST CPOPJ2
SKIPE AUTOLF# ;FLAG TO NOT ASK EVER
JRST SAFAOS
MOVEM F,SAFENM ;PREPARE FOR SAFETY LOOKUP
MOVEM E,SAFENM+1
MOVEM D,SAFENM+3
LOOKUP UFDC,SAFENM
JRST SAFLKF ;LOOKUP FAILED, MAYBE OK
SAFASK: XCT @(P) ;FIRST HE SEES REMOTE NAME MAYBE
AOS (P)
SKIPE AUTOAL ;skip unless want to abort automatically
JRST SAFEAA ;abort since file exists
OUTSTR [ASCIZ /File already exists: /]
PUSHJ P,TYPFIL
OUTSTR [ASCIZ /Type <cr> to overwrite it, <lf> to overwrite this and all similar cases,
<alt> to abort this transfer, CONTROL-<alt> to abort this and similar cases,
or a filename to write: /]
MOVEM D,SAFENM+3 ;SAVE PPN AGAIN
CLOSE UFDC, ;DONE WITH THIS LOOKUP
PUSHJ P,GFNY
JRST SAFEAB ;LOSING LOCAL FN
SKIPLE A,SAFDLM ;JUST DELIMITER?
JRST SAFAUT ;YUP
SKIPN WILDCD ;DON'T ALLOW WILDCARD
SKIPE BADSYN ; OR FOREIGN SYNTAX
JRST GFNLUZ
SKIPE FNDLIM ;DONT ALLOW FOO=BAR EITHER
JRST GFNLUZ ;ELSE WE HAVE FN AND ACS ARE SET UP
SAFEOK: OUTSTR [ASCIZ /Writing /]
AOS (P) ;MADE IT
TYPFIL: MOVEM F,PKUNAM ;SAVE FOR PICKUP COMMAND
MOVEM E,PKUEXT
MOVE B,F ;TELL THE USER WHAT WE'RE WRITING
PUSHJ P,TYPSIX
SKIPN B,E
JRST RETRL1
OUTCHR ["."]
PUSHJ P,TYPSIX
RETRL1: OUTCHR ["["]
HLLZ B,D
PUSHJ P,TYPSIX
OUTCHR [","]
HRLZ B,D
PUSHJ P,TYPSIX
OUTSTR [ASCIZ /]
/]
POPJ P,
SAFLKF: HRRZ A,SAFENM+1 ;SAFETY LOOKUP FAILED, WHY?
SOJG A,SAFASK ;BAD REASON
SAFAOS: AOS (P) ;SKIP PRE-MESSAGE
JRST SAFEOK
SAFAUT: CAIE A,12 ;JUST A DELIMITER:
JRST SAFAU1
SETOM AUTOLF ;IF LF, LIKE CR BUT NEVER ASK AGAIN
OUTCHR CCR ;BACK TO THE BAYOU
SAFAU1: CAIN A,175
JRST SAFEA1 ;ABORT ON ALT
MOVSI C,'DSK' ;ELSE RESTORE OLD FN
MOVE D,SAFENM+3
HLLZ E,SAFENM+1
MOVE F,SAFENM
JRST SAFEOK
SAFEAA: OUTSTR [ASCIZ /Skipping file that already exists: /]
JRST TYPFIL ;type filename and take direct return
SAFEA1: SKIPN ALTBKY ;see CONTROL on the altmode?
JRST SAFEAB
SETOM AUTOAL ;yup, abort automatically hereafter
OUTSTR [ASCIZ /
OK, pre-existing files will now be skipped automatically./]
SAFEAB: OUTSTR [ASCIZ /
/] ;HE TYPED ALT, NO CRLF
CCR: POPJ P,15 ;NON SKIP RETURN
SAFENM: BLOCK 4
TYPSIX: JUMPE B,CPOPJ
MOVEI A,0
LSHC A,6
JUMPE A,TYPSIX
ADDI A,40
OUTCHR A
JRST TYPSIX
RETRLX: OUTSTR [ASCIZ / (Pathname from remote host: /]
PUSHJ P,TYPNLS
OUTSTR [ASCIZ /)
Error in file list, can't do multiple RETR.
/]
POPJ P,
TYPNLS: MOVE B,NLSBPT ;TYPE LOSING LINE
RETLX1: ILDB A,B
JUMPE A,CPOPJ
CAIE A,15
CAIN A,12
POPJ P,
OUTCHR A
JRST RETLX1
SAFX0: OUTSTR [ASCIZ /RETR of remote file /]
PUSHJ P,TYPNLS
OUTSTR [ASCIZ /
/]
POPJ P,
RET1ST: SETZM WILDCD ;SO "WILD" LIST WINS
SKIPN LISTNG
SKIPE FNDLIM
JRST RETRST
PUSHJ P,TYPWRT ;TELL USER WHAT FILE WE'RE WRITING IF NOT EXPLICIT
JFCL ;NO PRE-MESSAGE NEEDED
POPJ P, ;ALREADY EXISTS AND ABORTED
RETRST: MOVEI B,DIMP
PUSHJ P,ILDDEV ;INIT LOCAL DATA DEVICE
JRST FLUSCS ; DIDN'T INIT
MOVEM C,DIACS+C ;SAVE DEVICE NAME,
MOVEM D,DIACS+D ; PROJECT-PROGRAMMER NAME,
MOVEM E,DIACS+E ; EXTENSION,
MOVEM F,DIACS+F ; FILE NAME FOR DI ROUTINE
NLSTST: SETOM NOERRS# ;DON'T ALLOW I/O-TYPE ERROR MSGS UNTIL THEY OK IT
PUSHJ P,SNDPRT ;SEND PORT
POPJ P, ;They didn't take it
PUSHJ P,SNDPAR ;SEND MODE, TYPE, BYTE IF NEEDED
SETOM DIACTV ;START UP DI ROUTINE
SETZM WILDCD ;MAY HAVE BEEN SET BY TYPWRT SAFETY GFNY
DIDOXX: PUSHJ P,TTWAIT ;pause so that data connection listen can go out
MOVE AC3,[POINT 7,COMBUF]
SETZM BAUDOK# ;HOLD UP OUR MESSAGE UNTIL AFTER THEIRS
PUSHJ P,FNSEND
DIDOX1: PUSHJ P,TTCINK ;WAIT FOR REPLY, BUT MAYBE IT CAME EARLY
MOVE AC3,CIFLAG
CAIL AC3,=300
JRST DIDOLZ
; CAIN AC3,=255
; JRST DIDOX1 ;THIS WAS SOCK MESSAGE, NOT XFER START MSG
SETZM NOERRS ;ERRORS ARE REAL NOW
SKIPE TYPECM ;BH 8/20/80 If TTY command,
SETOM CIGRQ ;BH 8/20/80 don't confuse the issue with replies
PUSHJ P,TTCINK ;BY GOLLY THERE'S NO POINT IN OVERLAPPING!
SETOM BAUDOK ;OK TO END DX ROUTINE NOW (PUN, PRETTY FUNNY HUH)
DIDOXY: SKIPN DIACTV ;WE MUST GET BOTH ENDS FINISHED BEFORE
SKIPE DOACTV ; ACCEPTING ANY MORE COMMANDS.
JRST .+2
JRST SXACTV ;OK NOW
PUSHJ P,TTWAIT
JRST DIDOXY ;WAIT FOR INACTIVE HERE
REPEAT 0,< ;NOW THAT WE CAN PICKUP THERE IS NO REASON NOT TO STOP ON ERRORS
DIDOLZ: CAIE AC3,=433 ;NEED ACCT TO WRITE, MULTIPLE WILL KEEP LOSING
SKIPN WILDCD ;FILE OP LOST, MULTIPLE?
JRST RESET ;NO, FLUSH
JRST IORSET ;JUST FLUSH IO
>;REPEAT 0
DIDOLZ: JRST RESET
SAFX1: ILDB A,NLSBPT ;SKIP THE LOSING REMOTE FILE
JUMPE A,CPOPJ
CAIE A,12
JRST SAFX1
JRST RETRLP
PSTOR: MOVEI AC2,..STOR ;"SEND" COMMAND
STOR: PUSHJ P,MLCHK
SETZM NOHACK
SETZM NOWILD
SETZM PKUNAM
STOR0: MOVE AC2,@OCS(AC2) ;COMMAND -- APPE OR STOR
TRO AC2,100 ;LOW ORDER SPACE
MOVEM AC2,[COMBUF: 0↔0]
MOVEM AC2,PKUCMD
PUSHJ P,GFN
POPJ P, ; NO FILE NAME
MOVE B,FNDLIM
CAIN B,"←" ;ANYTHING ELSE OK
JRST GFNLUZ
SKIPN WILDCD ;WILDCARD STOR?
JRST STO1DO ;NOPE, JUST DO IT
MOVEM C,WCDEV ;WILD, SAVE STUFF
MOVEM D,WCPPN
MOVEM E,WCEXT
MOVEM F,WCFIL
MOVEM D,UFDPPN ;PREPARE TO LOOK UP UFD
MOVE A,[' 1 1']
MOVEM A,UFDPPN+3 ;BOO, DEC
LOOKUP UFDC,UFDPPN
JRST NOUFD
STORLP: PUSHJ P,UFDIN ;LOOP THROUGH UFD
MOVEM A,GFNFIL ;SAVE FN (EVEN IF ZERO)
PUSHJ P,UFDIN ; AND EXT
HLLZM A,GFNEXT
MOVEI A,UFDN-2 ;FLUSH THE REST OF THE ENTRY
MOVEM A,DIRFLC
STORL1: PUSHJ P,UFDIN
SOSLE DIRFLC
JRST STORL1
SKIPN A,GFNFIL ;REALLY A FILE?
JRST STORLP ;NOPE
CAME F,['* '] ;MATCH TEMPLATE?
CAMN F,A
SKIPA A,GFNEXT ;YES, TRY EXT
JRST STORLP
CAME E,['* ']
CAMN E,A
JRST .+2
JRST STORLP
MOVE F,GFNFIL ;SET UP ILDDEV
MOVE E,GFNEXT
SKIPN PKURNM
JRST STONPK ;NOT DOING PICKUP
CAMN F,PKURNM
CAME E,PKUEXT
JRST STOPKF ;NOT A MATCH
SETZM PKURNM
SKIPE PKUAOS
JRST STOPKF ;IF HE TYPED ALTMODE WE SKIP THIS ONE TOO
STONPK: MOVE D,WCPPN
MOVE C,WCDEV
PUSHJ P,TYPREA
PUSH P,FNBPT ;SAVE THIS
PUSHJ P,STORDO ;DO IT!
POP P,FNBPT
STOPKF: MOVE F,WCFIL
MOVE E,WCEXT
JRST STORLP
TYPREA: CAME C,['DSK ']
POPJ P,
OUTSTR [ASCIZ /Reading /]
JRST TYPFIL
STO1DO: JUMPE B,STORDO
SKIPN NOHACK
PUSHJ P,TYPREA
STORDO: MOVEI B,DOMP ;INDICATE DIRECTION OF DATA FLOW
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEFICE
JRST FLUSCS ; COULDN'T
MOVEM C,DOACS+C ;SAVE DEVICE NAME,
MOVEM D,DOACS+D ; PROJECT PROGRAMMER NAME,
MOVEM E,DOACS+E ; EXTENSION,
MOVEM F,DOACS+F ; FILE NAME FOR DO ROUTINE
SETOM NOERRS
PUSHJ P,SNDPRT ;SEND PORT
POPJ P, ;They didn't take it
PUSHJ P,SNDPAR ;SEND MODE, TYPE, BYTE IF NEEDED
SETOM DOACTV ;START UP DATA OUT ROUTINE
JRST DIDOXX ;**** JOIN RETR HERE
UFDPPN: 0
'UFD '
0
' 1 1'
NOUFD: OUTSTR [ASCIZ /Can't read UFD for multiple STOR.
/]
POPJ P,
UFDIN: SOSG UBUF+2 ;YE OLDE ROUTINE
IN UFDC, ; BUT WITH UPLEVEL RETURN
JRST UFDIN1
STATO UFDC,20000
OUTSTR [ASCIZ /Input error reading UFD for multiple STOR, quitting.
/]
CLOSE UFDC,
POP P,(P)
POPJ P,
UFDIN1: ILDB A,UBUF+1
POPJ P,
FLUSCS: SKIPE HAIRY ;BH 8/22/82 For error in one-liner,
POPJ P, ; avoid waiting forever for tty.
MOVEI B,12 ;SET CHARACTER SEARCH FOR LINE FEED
SCANTO: PUSHJ P,GETTTY
CAIE B,12 ;UNLESS WE ARE LOOKING FOR LF
CAIE A,"=" ; WE ACCEPT EQUAL SIGN FOR ANYTHING
CAMN A,B ;CHARACTER SAME AS ONE WE'RE SCANNING TO?
POPJ P, ; YES, EXIT
CAIE A,12 ;LINE FEED YET?
JRST SCANTO ; NO
OUTSTR [ASCIZ /ILLEGAL FORMAT
/]
POP P,A ; YES, RETURN UPLEVEL
POPJ P,
MLCHK: SKIPN MAILNG
POPJ P,
SETZM MAILNG
MOVE C,SVOTYP
SV2INC: PUSH P,AC2
PUSHJ P,TYPINC ;SEND TYPE AND BYTE
POP P,AC2
POPJ P,
;;ERRWAT -- USED TO WAIT UNTIL XFER IS APPROVED OR REJECTED BY SERVER
;;IT RETURNS AT ONCE IF NOERRS IS ZERO, OTHERWISE SETS A CLOCK INTERRUPT
;;(SO IF HE FLUSHED US WE FIND OUT) AND WAITS FOR NOERRS TO CLEAR.
;;IF THE XFER IS REJECTED, IT NEVER RETURNS, BUT GOES TO RESET INSTEAD.
;; PUSHJ P,ERRWAT
;; PUSHJ P,<DOWAIT OR DIWAIT>
;; RETURN HERE
;;GOWAIT -- VERSION OF ERRWAT WHICH DOES NOT ENABLE CLOCK INTERRUPT, USED
;;TO DELAY START OF ACTUAL DATA TRANSFER UNTIL ARRIVAL OF APPROVAL. CLOCK
;;IS NEEDED FOR ERROR MSG WAIT BECAUSE THE ERROR MIGHT MEAN WE HAVE BEEN
;;DESERTED AND WILL NEVER GET A MSG, BUT WE SHOULD WAIT FOREVER TO START
;;THE TRANSFER IF NECESSARY.
ERRWAT: SKIPN NOERRS
JRST CPOPJ1
CLKINT 5*=60
ERRWA1: XCT @(P)
GOWAIT: SKIPN NOERRS
JRST CPOPJ1
JRST ERRWA1
;;LPPN AND RPPN SET AND RESET THE LPPNON FLAG, WHICH DETERMINES WHETHER
;;A PPN IN A HERE-AND-THERE FILESPEC (NO = OR EQUIVALENT) IS A REMOTE
;;(NORMAL CASE, FLAG OFF) OR A LOCAL (FLAG ON) PPN.
LPPN: SETOM LPPNON
JRST FLUSCS
RPPN: SETZM LPPNON
JRST FLUSCS
;;DEBG SETS CIDEBG FLAG, SO THAT ALL IMP CONTROL LINK INPUT IS TYPED
;;INCLUDING THE MAGIC NUMBERS AND REGARDLESS OF CIGRQ AND FRIENDS
;;USEFUL FOR DEBUGGING.
DEBG: SETOM CIDEBG
JRST FLUSCS
;Small Utility Routines For FTP Program ;⊗ TTSTROUT STROUT STROU1 STROUF TTCHROUT DOCHRO GETTTY CRGETY RGETTY GETTT1 GETTT2 FAKELF SPCRD SPCRDE GETCAP SXACTV
TTSTROUT:
STROUT: ;OUTPUT CHR STRING ON IMP CONTROL CHANNEL
;CALL: MOVE AC3,<BYTE POINTER TO STRING>
; PUSHJ P,STROUT
; RETURN HERE, AC1,AC2,AC3 ALL CLOBBERED
ILDB AC1,AC3
JUMPE AC1,STROU1
PUSHJ P,IMPOUT
JRST STROUT
STROU1: POPJ P,
STROUF: -1 ;-1 IF STROUT ROUTINE IS AVAILABLE
TTCHROUT:
DOCHRO: PUSHJ P,IMPOUT
JRST STROU1
GETTTY: SKIPE GIVELF
JRST FAKELF
CRGETY: MOVEI A,0 ;ENTRY FROM LINOUT VIA CHAROUT
EXCH A,TTCHSV ;LOOK FOR SAVED TTY CHAR
JUMPN A,CPOPJ ;YES, RETURN IT
RGETTY: READS(AC1,< ;LINE AT A TIME ONLY!
JRST [ SKIPE SPCIN
JRST [ PUSHJ P,SPCRD
JRST GETTT1
JRST GETTT2 ]
GETTT1: PUSHJ P,TTWAIT
JRST RGETTY ]
>)
GETTT2: CAIN A,12
SETOM GIVELF ;LF, KEEP GIVING LF FROM NOW ON
POPJ P,
FAKELF: MOVEI A,12
POPJ P,
SPCRD: SOSG IFBUF+2
IN INFL,
JRST .+2
JRST SPCRDE
ILDB AC1,IFBUF+1
OUTCHR AC1
AOS (P)
POPJ P,
SPCRDE: SETZM SPCIN
POPJ P,
GETCAP: PUSHJ P,GETTTY ;SAME AS GETTTY, ONLY RETURNS CAPITAL ASCII
CAIL A,"a"
CAILE A,"z"
POPJ P,
SUBI A,"a"-"A"
POPJ P,
SXACTV: PUSH P,[-2] ;ROUTINE TO SET SACTV WITHOUT
POP P,XACTV ; CLOBBERING ACCMULATORS
POPJ P,
;Locus of FTP control ;⊗ FTPINI RESET FTLOOP FTLOP1 FTLOP3 FTLOP2 FTLCHK TTESCI ESCI ESCI1 INSBLK ILEVEL ILEVE1 IORSET RESET1 UFDOPN UBUF
FTPINI: MOVEM P,SAVP ;FOR RESET
OPEN UFDC,UFDOPN ;OPEN UFD/SAFETY LOOKUP CHANNEL
JRST 4,.-1
SKIPN HAIRY ;FTP/Q SETS AUTOLF
SETZM AUTOLF#
SETZM AUTOAL# ;no auto abort if file already exists
SETZM GIVELF
SETZM TTCHSV
SETZM CNIBTS
SETOM CIINIT
MOVEI AC1,1 ;default to Image mode
MOVEM AC1,DRTYPE
MOVEM AC1,DTYPE
SETZM SNDTYP
SETZM SNDMOD
SETZM SNDBYT
SETZM MAILNG
SETZM AGREED ;-1 WHEN WE NEGOTIATE A BYTE SIZE
MOVEI AC1,=8
MOVEM AC1,DBS
MOVEM AC1,SAVBYT#
MOVEI AC1,ILEVEL
MOVEM AC1,JOBAPR
MOVSI AC1,(<INTTTY!INTIMS!INTINP!INTTTI>)
INTENB AC1,
SETOM STROUF
;; HERE AFTER ERROR RETURN ON DATA TRANSFER CMND
RESET: PUSHJ P,IORSET ;RESET DO AND DI STUFF
MOVE P,SAVP
SETZM CINUM
SETZM CISVG
MOVEI AC1,4
MOVEM AC1,CIGAG
SETZM CIGRQ
SETZM HYPHEN
SETZM ESCIFL ;CLEAR ESC-I ABORT FLAG
SETZM ACTION ;FLAG TO ALLOW ABORT WITHOUT ACTIVE IO
SETZM TTHUNG
SETZM CIHUNG
SETZM NOERRS ;IDCON MAY COMPLAIN ABOUT LOSSAGE
SETZM PKURNM ;NOT JUST AFTER PICKUP
MOVEI C,MSGSTK ;FLUSH SAVED REPLY CODES
MOVEM C,MSGPTR
MOVEI C,10
MOVEM C,MSGCNT
MOVE AC1,[XWD -20,TTPDL]
MOVEM AC1,TTP
MOVE AC1,[XWD -20,CIPDL]
MOVEM AC1,CIP
;; CLRBFI
FTLOOP: PUSHJ P,TTDISP
PUSHJ P,CIDISP
MOVE AC1,CNIBTS
TLNE AC1,(<INTIMS>)
JRST FTLCHK ;CHECK STATUS OF CONNECTIONS
FTLOP1: TLNE AC1,(<INTTTI>)
PUSHJ P,ESCI ;USER WANTS TO ABORT
SKIPE DIACTV
PUSHJ P,DIDISP
SKIPE DOACTV
PUSHJ P,DODISP
INTMSK [0] ;DISABLE INTERRUPTS
AOSLE XACTV ;IS THERE STILL ACTION SOMEWHERE?
JRST FTLOP2
FTLOP3: INTMSK [-1] ;REENABLE
JRST FTLOOP
FTLOP2: SKIPN DIACTV
SKIPE DOACTV
JRST .+2
SKIPN SPCIN
IMSTW [-1] ;GO INTO WAIT, RE-MASKING INTERRUPTS ON
JRST FTLOP3
FTLCHK: MOVSI AC1,(<INTIMS>) ;turn off this interrupt bit before checking status
ANDCAM AC1,CNIBTS
MTAPE IMP,STTBLK
MOVE AC2,STTBLK+1
IOR AC2,STTBLK+2
TLNN AC2,(<RFCS!RFCR>)
JRST QUITCL ;closed -- say so and quit gracefully
;;; MOVEM AC1,CNIBTS
JRST FTLOP1
TTESCI: PUSH P,AC1
MOVSI AC1,(<INTTTI>)
INTGEN AC1,
POP P,AC1
JRST 2,@130 ;JOBOPC
ESCI: MOVSI AC1,(<INTTTI>) ;turn off this interrupt bit before checking status
ANDCAM AC1,CNIBTS
;;; MOVEM AC1,CNIBTS
SETZM TTIFLG
SKIPN DIACTV
SKIPE DOACTV
JRST ESCI1
SKIPE ACTION
JRST ESCI1 ;ALLOW ABORT IN SOME NON-IO SITUATIONS (STAT, MAIL)
OUTSTR [ASCIZ /
No transfer in progress.
/]
JRST RESET
ESCI1: SETZM DIACTV ;NO MORE DATA THRASHING ALLOWED
SETZM DOACTV
OUTSTR [ASCIZ /
Aborting transfer.
/]
MOVEI AC1,200 ;OLD PROTOCOL DATA MARK
PUSHJ P,IMPOUT
MOVEM SSOCK,INSBLK+2
MTAPE IMP,INSBLK ;SEND INS
MOVE AC3,[POINT 7,[ASCIZ /ABOR
/]]
PUSHJ P,STROUT ;SEND ABORT COMMAND
SETOM ESCIFL# ;THIS TELLS TT TO WAIT FOR ANSWER
POPJ P, ;TT IS NEXT IN LINE
INSBLK: 11↔0↔0
ILEVEL: MOVE AC1,JOBCNI
IORM AC1,CNIBTS
TLNE AC1,(<INTTTI>)
SETOM TTIFLG# ;SET FLAG FOR CI ROUTINE, SIGH
TLNN AC1,(<INTCLK>) ;DID YE OLD CLOCK TICK?
JRST ILEVE1
SETOM RPLY# ;YES, FEIGN A REPLY (SPCL PRPS, FOR QUIT)
MOVSI AC2,(<INTCLK>)
ANDCAM AC2,CNIBTS ;FLUSH IRRELEVANCY
INTACM AC2, ;WE ONLY TAKE ONE CLOCK INT PER ENABLING
ILEVE1:
IFN VERBOSE,<
outchr ["↑"]
tlne ac1,(<inttty>)
outchr ["t"]
tlne ac1,(<intims>)
outchr ["s"]
tlne ac1,(<intinp>)
outchr ["p"]
>;IFN VERBOSE
MOVNI AC1,2
MOVEM AC1,XACTV
DISMIS
IORSET: SETZM DOACTV
SETZM DIACTV
SETZM DIHUNG
SETZM DOHUNG
SETZM GAG200 ;COULD BE LEFT SET BY ERROR IN NLST FOR MULT-RETR
MOVE C,LDOSOC ;CLEAR OUTPUT DATA CONNECTION
MOVEM C,DOTERM+2 ; IF THERE IS ONE
SKIPN OUTCON
JRST RESET1
CHNSTS DOMP,AC1 ;CAN GET HERE WITH OUTCON SET BUT NO CHANNEL
SETZM DOTERM+WFLOC ;don't wait for close
TRNE AC1,400000 ;THIS SKIPS IF NO CHANNEL
MTAPE DOMP,DOTERM ;TERMINATE CONNECTION
SETZM OUTCON
RESET1: RELEAS DIMP,3 ;RELEASE WITHOUT CLOSING
RELEAS FIMP,3
RELEAS DOMP,3
RELEAS FOMP,3
MOVE AC1,[XWD -20,DIPDL]
MOVEM AC1,DIP
MOVE AC1,[XWD -20,DOPDL]
MOVEM AC1,DOP
POPJ P,
UFDOPN: 10
'DSK '
UBUF
UBUF: BLOCK 3
;Process-switching AC Utility routines ;⊗ SAVACX SAVACS GETACS
SAVACX: 0
SAVACS: ;CALL: PUSH P,[XWD 0,<ADDRESS OF 17 WORD BLOCK>]
; JRST SAVACS
; ROUTINE DOES NOT RETURN. THE ARGUMENT
; ON THE STACK IS POPPED OFF, AND THEN A POPJ
; IS PERFORMED.
MOVEM 0,@(P) ;SAVE AC0
MOVE 0,(P)
ADD 0,[XWD 1,16] ;C(0) = 1,,LOC+16
HRRZM 0,SAVACX
SUBI 0,15 ;C(0) = 1,,LOC+1
BLT 0,@SAVACX ;SAVE AC1-16
SUB P,[XWD 1,1] ;DELETE ARGUMENT FROM STACK
POPJ P, ;RETURN UPLEVEL
GETACS: ;CALL: PUSHJ P,GETACS
; XWD 1,<ADDRESS OF 17 WORD BLOCK>
; RETURN HERE ALWAYS
HRLZ 16,@(P) ;C(16) = XWD <ADDR>,0
BLT 16,15 ;RESTORE ACS 0-15
HRRZ 16,@(P)
MOVE 16,16(16) ;RESTORE AC16
JRST CPOPJ1 ;RETURN
;Ttdisp -- TTY Process Control ;⊗ TTDISP TTREEN TTWAIT CHKABO TTACS TTP TTHUNG TTPDL TTROUT TTROU1 HAIREX DOHAIR HGETSP HGETL HAIRTY HDELIM HGETS2 HGETR HFOO HGETR1 HNEED2 HNOEQU TWOARR NUTTIN HAIRDO HAIRD1 OTPASS ANONYM INFRE1 INFREE NOACCT HAIRNO HAIRCR HAIRBY HAIRFN
TTDISP: SKIPE TTHUNG ;IS TT ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST TTREEN ; YES, REENTER TT ROUTINE
EXCH P,TTP
PUSHJ P,CHKABO ;MAYBE AN ABORT
PUSHJ P,TTROUT ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,TTP ;SAVE TT PDL, GET OLD PDL
SETZM TTHUNG ;INDICATE THAT TT ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
TTREEN: PUSHJ P,GETACS
XWD 1,TTACS
EXCH P,TTP ;RETRIEVE TT PUSHDOWN POINTER
JRST CHKABO ;FIRST CHECK FOR ESC I THEN GO TO WAITING RTN
TTWAIT: SETOM TTHUNG ;PUSHJ TO HERE TO MAKE TT ROUTINE WAIT
EXCH P,TTP ;SAVE TT PDL, GET OLD PDL
PUSH P,[XWD 0,TTACS]
JRST SAVACS ;SAVE TT ACCUMULATORS, RETURN TO MAIN LOOP
CHKABO: SKIPN ESCIFL ;DID HE TYPE ESC I?
POPJ P, ;NO, NOTHING TO DO HERE
SETZM ESCIFL ;(THIS AVOIDS INFINITE LOOP AND PDLOV)
CLKINT 5*=60 ;MANY PEOPLE (MOST? ALL?) DON'T HACK ABORT
PUSHJ P,TTCIWT ;YES, WE WAIT FOR ANSWER TO ABORT
JRST RESET ;AND FLUSH THE WORLD WHEN WE GET IT
TTACS: BLOCK 17 ;STORAGE FOR TT ACCUMULATORS 0-16
TTP: XWD -20,TTPDL
TTHUNG: 0 ;NON ZERO MEANS TT ROUTINE IS WAITING
TTPDL: BLOCK 20
TTROUT: SKIPL CIINIT ;DO WE HAVE HERALD?
JRST TTROU1
PUSHJ P,TTCIWT ;NO, WAIT FOR IT
PUSHJ P,HAGGLE ;TRY TO NEGOTIATE A BYTE SIZE
JFCL ;WON'T WORK FOR MULTICS OF COURSE, NOTHING DOES
TTROU1: SKIPE HAIRY ;BH 11/27/77 HAIRY MODE?
JRST DOHAIR ;YES, ALL IN MONITOR COMMAND
PUSHJ P,GETOC ;C(AC1) ← OpCode IN ASCIZ (FROM TTY)
; PUSH P,AC1
; PUSHJ P,MLCHK ;RETURN STATE IF WAS MAILING
; POP P,AC1
PUSHJ P,GETOCN ;C(AC2) ← INDEX INTO OPCODE TABLE
POPJ P, ; UNKNOWN OR AMBIGUOUS OPCODE
HAIREX: SETZM PKUSET
PUSHJ P,@OCDISP(AC2) ;DISPATCH TO APPROPRIATE ROUTINE & RETURN
AOSE PKUSET ;IF IT WASN'T A PICKUP COMMAND
SETZM PKURNM ; WE CAN'T DO A PICKUP!
POPJ P,
DOHAIR: SKIPL HAIRY ;FIRST TIME HERE?
JRST HAIRBY ;NO, TIME TO FLUSH
MOVNS HAIRY ;YES. NEXT TIME GO AWAY
MOVE AC1,[POINT 7,HAIRBF]
SETZM HAIRLR
SKIPE TYPESW
JRST HAIRTY ;FTP/T SO PRETEND WE SAW ←
HGETSP: MOVE AC2,AC1
HGETL: ILDB T1,AC1 ;SCAN LEFT SPEC
CAIE T1,12
CAIN T1,175
JRST HNEED2 ;ERROR IF NO DIRECTION INDICATED
CAIN T1,"{" ;}
SETOM HAIRLR ;FLAG LEFT IS REMOTE (OR LOCAL IS RIGHT)
CAIN T1,"="
JRST HNOEQU ;= NOT ALLOWED
CAIE T1,"←"
CAIN T1,"→"
JRST HDELIM ;FOUND THE DELIMITER
CAIE T1,40
CAIN T1,11
JUMPN AC2,HGETSP
CAIN T1,"{" ;}
JUMPN AC2,HGETSP
JUMPE AC2,HGETL ;JUMP IF ALREADY SAVED INITIAL BPT
MOVEM AC2,HAIRLS ;SAVE BPT TO FIRST SIGNIFICANT CHAR
MOVEI AC2,0 ;DON'T SAVE AGAIN
JRST HGETL
HAIRTY: MOVEI T1,"←"
HDELIM: MOVE AC2,HAIRLR ;-1 IF BRACE SEEN
CAIN T1,"→"
MOVNI AC2,1(AC2) ;NOW -1 IF PUTTING (STOR)
MOVEM AC2,HAIRPT ;SAVE DIRECTION FOR LATER
HGETS2: MOVE AC2,AC1 ;NOW SCAN THE OTHER HALF
HGETR: ILDB T1,AC1
CAIE T1,12
CAIN T1,175
JRST HAIRDO ;OK, READY TO FLY
CAIN T1,"{" ;}
SKIPN HAIRLR
JRST HGETR1
OUTSTR [ASCIZ /Can't have remote host on both ends.
/]
HFOO: SETZM HAIRY
SETZM HASCII
SETZM AUTOLF
SETZM AUTOAL ;no auto abort if file already exists, yet
JRST TTROU1 ;FLUSH THE MODE
HGETR1: CAIN T1,"="
JRST HNOEQU ;STILL NOT ALLOWED
CAIE T1,"←"
CAIN T1,"→"
JRST TWOARR ;HUH? THREE FILES?
CAIE T1,40
CAIN T1,11
JUMPN AC2,HGETS2
CAIE T1,15
CAIN T1,"{" ;}
JUMPN AC2,HGETS2
JUMPE AC2,HGETR
MOVEM AC2,HAIRRS
MOVEI AC2,0
JRST HGETR
HNEED2: OUTSTR [ASCIZ /Must have two pathnames separated by arrow
indicating direction of transfer.
/]
JRST HFOO
HNOEQU: OUTSTR [ASCIZ /Pathnames must be separated by arrow, not =.
/]
JRST HFOO
TWOARR: OUTSTR [ASCIZ /Only two pathnames, not three.
/]
JRST HFOO
NUTTIN: OUTSTR [ASCIZ /No pathname specified.
/]
JRST HFOO
HAIRDO: MOVEI T1,3 ;JJW 11/83 Give him 3 tries
MOVEM T1,PASTRY# ;to guess remote password
MOVE AC2,HAIRLS
SKIPE HAIRLR
EXCH AC2,HAIRRS ;GET LOCAL/REMOTE RIGHT
MOVEM AC2,HAIRLS
JUMPN AC2,HAIRD1
SKIPN HAIRRS
JRST NUTTIN
HAIRD1: SETOM CIGRQ ;DON'T SHOW USER THIS NONSENSE
MOVE AC3,[POINT 7,[ASCIZ /USER /]]
PUSHJ P,TTSTROUT
SKIPN USRSTR ;GET REQUESTED USER NAME, IF ANY
JRST ANONYM ;NONE, BE ANONYMOUS
MOVE AC3,[POINT 7,USRSTR]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,[ASCIZ /
/]]
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;NOW WAIT FOR RESPONSE
SETZM CIGRQ ;JJW 11/83 Show failed password replies
SETOM GAG200 ;But not successful ones
MOVE T1,CIFLAG ;GET THE RESPONSE CODE
CAIL T1,=300
CAILE T1,=399 ;DO THEY WANT PASSWORD?
JRST INFREE ;NO, THAT'S ALL
SKIPE PASSTR
JRST OTPASS ;FOUND PASSWORD IN OPTION.TXT
MOVE AC3,[POINT 7,[ASCIZ /PASS /]]
PTJOBX [0↔3] ;NO ECHO
LEYPOS 1400 ;NO LINE EDITOR
OUTSTR [ASCIZ /Password=/] ;ASK FOR PASSWORD
SETZM GIVELF ;HOO HAH
SETZM TTCHSV
PUSHJ P,IDENT1 ;GET AND FORWARD PASSWORD
OUTSTR [ASCIZ /
/]
HRROI T1,[10000,,] ;Suppress Control-CR once only
TTYSET T1,
LEYPOS 0 ;RESTORE THE WORLD
PTJOBX [0↔4]
PUSHJ P,TTCIWT ;NOW HANG ON FOR THE PASS REPLY
MOVE T1,CIFLAG ;JJW 11/83 Get response code
SOSLE PASTRY ;Skip if too many tries
CAIGE T1,=400
JRST INFREE ;Password OK, or 3 tries expired
JRST HAIRD1 ;Loser, let our user try again
OTPASS: MOVE AC3,[POINT 7,[ASCIZ /PASS /]]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,PASSTR]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,[ASCIZ /
/]]
JRST INFRE1
ANONYM: MOVE AC3,[POINT 7,[ASCIZ /anonymous
/]] ;JJW 8/86 - $%#! Unix
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;NOW WAIT FOR RESPONSE
MOVE T1,CIFLAG ;GET THE RESPONSE CODE
CAIL T1,=300
CAILE T1,=399 ;DO THEY WANT PASSWORD?
JRST INFREE ;NO, THAT'S ALL
MOVE AC3,[POINT 7,[ASCIZ /PASS SAIL
/]]
INFRE1: PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT ;NEVER MIND WHAT THEY SAY
INFREE: SKIPN ACCSTR
JRST NOACCT ;(S)HE DIDN'T SUPPLY AN ACCT
MOVE AC3,[POINT 7,[ASCIZ /ACCT /]]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,ACCSTR]
PUSHJ P,TTSTROUT
MOVE AC3,[POINT 7,[ASCIZ /
/]]
PUSHJ P,TTSTROUT
PUSHJ P,TTCIWT
NOACCT: SETZM GAG200 ;JJW 11/83 Back to normal
MOVE AC2,[POINT 7,FNBUF] ;NOW SET UP FNBUF RIGHT
SKIPN AC1,HAIRLS ;IF EXPLICIT LOCAL, USE IT
JRST HAIRNO ;NOPE
PUSHJ P,HAIRFN ;COPY THE SPEC
SKIPN HAIRRS
JRST HAIRCR ;DONE IF NO REMOTE
MOVEI T1,"="
IDPB T1,AC2 ;AND AN EQUALS
HAIRNO: MOVE AC1,HAIRRS
PUSHJ P,HAIRFN
HAIRCR: MOVEI T1,15
IDPB T1,AC2
MOVEI T1,12
IDPB T1,AC2
SETOM PKUFLG ;FLAG CMD SHOULDN'T READ TTY
MOVEI AC2,..RETR ;PICK THE RIGHT COMMAND
SKIPE HAIRPT
MOVEI AC2,..STOR
SKIPE TYPESW
MOVEI AC2,..TTY
JRST HAIREX
HAIRBY: MOVEI AC2,..BYE
SETOM CIGRQ
JRST HAIREX
HAIRFN: ILDB T1,AC1 ;COPY PATHNAME INTO FNBUF
CAIE T1,15
CAIN T1,"{" ;}
JRST HAIRFN
CAIE T1,"←"
CAIN T1,"→"
POPJ P,
CAIN T1,12
POPJ P,
IDPB T1,AC2
JRST HAIRFN
;Cidisp -- Control In Process Control ;⊗ CIDISP CIREEN CIWAIT CIACS CIP CIHUNG CIPDL CINUM CIGAG CIINIT CIFLAG CIDEBG CIGRQA CIGRQ HYPHEN CISVG CIHYNO MSGPTR MSGSTK MSGCNT GAG200 IACFLG CIROUT CIROPE CIROXX CIROU0 CIROU6 CIROU1 CIROU4 CIRO41 CIROU3 CIROU2 CIRO22 CIROU7 CIROUX CIRO81 CIROU9 CIROU8 IACCOM OPTNEG OPTDUN
CIDISP: SKIPE CIHUNG ;IS CI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST CIREEN ; YES, REENTER CI ROUTINE
EXCH P,CIP
PUSHJ P,CIROUT ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,CIP ;SAVE TT PDL, GET OLD PDL
SETZM CIHUNG ;INDICATE THAT CI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
CIREEN: PUSHJ P,GETACS
XWD 1,CIACS
EXCH P,CIP ;RETREIVE CI PUSHDOWN POINTER
POPJ P, ;AND RETURN TO WAITING CI ROUTINE.
CIWAIT: SETOM CIHUNG ;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
PUSH P,[XWD 0,CIACS]
JRST SAVACS ;SAVE CI ACCUMULATORS, RETURN TO MAIN LOOP
CIACS: BLOCK 17 ;STORAGE FOR CI ACCUMULATORS 0-16
CIP: XWD -20,CIPDL
CIHUNG: 0 ;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL: BLOCK 20
CINUM: 0 ;NUMBER FROM MESSAGE
CIGAG: 4 ;IF POSITIVE, # CHARS TO NOT TYPE. NEG = ∞.
CIINIT: -1 ;-1 UNTIL 300 HERALD SEEN. LATER 3XX NOT TYPED.
CIFLAG: -1 ;CINUM SAVED FROM MESSAGE JUST FINISHED
CIDEBG: 0 ;-1 TO DEBUG: TYPE EVERY CHAR FROM IMP
CIGRQA: 0 ;SETOM TO GAG ALL INCOMING MESSAGES
CIGRQ: 0 ;SETOM TO GAG INCOMING MESSAGES less than 400
HYPHEN: 0 ;-1 IF FIRST CHAR AFTER DIGITS IS HYPHEN
CISVG: 0 ;SAVED CIGAG FOR 1ST CHAR OF NTH LINE
CIHYNO: 0 ;SAVED NUMBER FROM 1ST LINE OF MULTI-LINER
MSGPTR: MSGSTK
MSGSTK: BLOCK 10
MSGCNT: 10
GAG200: 0 ;-1 TO GAG 2XX MESSAGES
IACFLG: 0 ;-1 if IAC just seen, ;<
;>0 for option negotiation
CIROUT: PUSHJ P,INPSKP ;ANY IMP INPUT ?
JRST [PUSHJ P,CIWAIT ↔ JRST CIDISP]
PUSHJ P,IMPGET ; YES, GET IT
SKIPLE IACFLG ;Are we negotiating Telnet options?
JRST OPTNEG ;Yes
SKIPGE IACFLG ;Are we following an IAC?
JRST IACCOM ;Yes
CAIN AC1,=255 ;Is this an IAC?
SETOM IACFLG ;Yes, flag for next char
jumpe ac1,cirout
trne ac1,200 ;is it a protocol command?
jrst cirout ; yes
CAIE AC1,12
JRST CIROU1
SKIPE TTIFLG ;IF ABORT INTERRUPT WAITING,
PUSHJ P,CIWAIT ; GIVE IT A CHANCE (FOR STAT)
MOVE AC1,CINUM
CAIL AC1,=900 ;**** FIX FOR CRETINOUS SERVERS
SUBI AC1,=900 ;**** TURN ILLEGAL MESSAGES INTO OK ONES
SKIPE HYPHEN ;NOT DONE IF MULTI-LINER
JRST CIROU0 ;multi-line reply, keep reading
CAIE AC1,=125 ;maybe data connection open
CAIN AC1,=150 ;or opening
JRST CIROPE ;yes, this is serious message
CAIGE AC1,=200 ;IF THIS WASN'T A SERIOUS MESSAGE,
JRST CIROU0 ; DON'T SET READY FLAG FOR TT
CIROPE: SKIPE RPLY ;IF WE ARE WAITING FOR THIS MESSAGE,
SOSG MSGCNT ; OR THERE IS NO ROOM TO STORE IT,
JRST CIROXX ; WE JUST SET THE FLAG AND LEAVE
SKIPE HELPER ;BH 12/30/77 KLUDGE SO ERROR REPLY FROM HELP CMD
JRST CIROXX ; WON'T HANG AROUND AND MESS UP NEXT COMMAND
MOVEM AC1,@MSGPTR ;STACK THE MESSAGE CODE IN THE BUFFER
AOS MSGPTR ;THE NEXT TTCIWT WILL FIND IT W/O WAITING
CIROXX: SETOM RPLY# ;FLAG COMPLETE REPLY,
PUSHJ P,SXACTV ; GO ROUND THE MULBERRY BUSH,
MOVEM AC1,CIFLAG ; AND SAVE LAST MESSAGE TYPE FOR TT ROUTINE
CIROU0: SETZM CINUM ;NEXT CHAR FROM IMP WILL BE A NUMBER
SKIPN HYPHEN
SETZM CISVG
MOVEI AC1,4
EXCH AC1,CIGAG ;DON'T TYPE THE NUMBER
CIROU6: JUMPN AC1,CIROUT ;DON'T TYPE THE LF IF GAGGED
OUTCHR [12]
SKIPE CHAR1
OUTCHR ["*"] ;WE SCREWED UP A COMMAND PROMPT
JRST CIROUT
CIROU1: SKIPN CIGAG ;IS THIS BEGINNING OR SPECIAL?
JRST CIROU9 ;NO, JUST TYPE AND FORGET IT
SOSGE CIGAG ;YES, EITHER GAGGED MESSAGE OR REPLY NUMBER
JRST CIROUT ;GAGGED MESSAGE, DO NOTHING
SKIPN CIGAG
JRST CIROU4 ;SPACE OR HYPHEN
CAIL AC1,"0" ;NUMBER GOTTA BE NUMBER
CAILE AC1,"9"
JRST CIROUX ;OOPS, LOSING MESSAGE
SUBI AC1,"0" ;TURN INTO NUMBER
EXCH AC1,CINUM
IMULI AC1,12
ADDM AC1,CINUM ;ACCUMULATE DECIMAL NUMBER
JRST CIROUT
CIROU4: SKIPE HYPHEN ;LAST GAGGED CHAR OF LINE IS END OF NUMBER
JRST CIROU7
CIRO41: EXCH AC1,CINUM ;SAVE SPACE-OR-HYPHEN AND GET TYPE
CAIL AC1,=200
CAILE AC1,=299 ;IF 2XX MESSAGE
CAIA
AOS CIINIT ; MAKE SURE WE COUNT IT EVEN IF GAGGED
SKIPE CIDEBG ;BH 12/10/77 DEBUGGING, DON'T TYPE MSG TWICE
JRST CIROU3
CAIGE AC1,=400 ;JJW 2/84
SKIPN CIGRQ ;Not 4xx or 5xx, skip if gagging
SKIPE CIGRQA ;Show 4xx or 5xx unless gagging all replies
JRST CIROU3
SKIPE GAG200 ;TT CAN REQUEST GAGGING 200 MESSAGES
CAIGE AC1,=200 ; JUST LIKE 300S
CAIL AC1,=300
CAILE AC1,=399 ;IF 3XX MESSAGE
JRST CIROU2
;Fall thru to CIROU3 to gag 3xx messages (and 2xx msgs if GAG200 is on)
CIROU3: SETOM CIGAG ;GAG IT. (PASSWORD REQUEST)
JRST CIRO22
CIROU2: OUTCHR ["<"] ;ELSE INDICATE MESSAGE FROM SERVER > (STUPID FAIL)
CIRO22: EXCH AC1,CINUM ;RESTORE TYPE AND NEW CHAR
CAIE AC1,"-" ;CHAR AFTER NUMBER
JRST CIROU1 ;IF NOT HYPHEN, JUST TYPE IT UNLESS GAGGED
SETOM HYPHEN ;HYPHEN FLAGS MULTI-LINE MESSAGE
MOVE AC1,CIGAG ;SAVE STATE OF GAGGAGE
MOVEM AC1,CISVG
MOVE AC1,CINUM ;SAVE ORIGINAL NUMBER
MOVEM AC1,CIHYNO
MOVEI AC1," " ;TYPE A SPACE ANYWAY
JRST CIROU1
CIROU7: CAIE AC1," " ;CHAR AFTER NUMBER ON NOT-1ST LINE
JRST CIROUX ; HAD BETTER BE SPACE OR WE IGNORE NUMBER
MOVE AC1,CINUM ;GET THE NUMBER ON THIS LINE
CAME AC1,CIHYNO ;IS IT THE SAME AS THE FIRST NUMBER?
JRST CIROU8 ;NO, AN INTERLOPER
SETZM HYPHEN ; NO MORE HYPHENIZATION
MOVEI AC1," " ;RESTORE SPACE FOR OUTPUT
CIROUX: PUSH P,CISVG ;LINE DOESN'T START WITH DIGIT
POP P,CIGAG ;SET GAGGAGE TO 0 (MAYBE NOT IF MULTI-LINER)
SKIPE CIGAG ;IF GAGGED (NON-1ST LINE OF 3XX MULTI),
JRST CIROUT ; DO NOTHING
CIRO81: OUTSTR [ASCIZ /< /] ;> STUPID FAIL
CIROU9: OUTCHR AC1 ; TYPE IT
JRST CIROUT
CIROU8: MOVEI AC1," "
SETZM CIGAG ;NEVR GAG AN INTERLOPER
JRST CIRO81 ;(SOUNDS LIKE "TO CATCH AN ELEPHANT...")
IACCOM: CAIE AC1,=255 ;Quoted IAC?
CAIGE AC1,=251 ;Option negotiation?
JRST CIROUT ;IAC IAC or not negotiation. Ignore
MOVEM AC1,IACFLG ;Set flag for next byte
JRST CIROUT
OPTNEG: EXCH AC1,IACFLG ;Get back negotiation type, save option code
TRNN AC1,1 ;WILL or DO?
JRST OPTDUN ;Ignore WONT and DONT
CAIN AC1,=251 ;WILL?
PUSH P,[=254] ;Reply DONT
CAIN AC1,=253 ;DO?
PUSH P,[=252] ;Reply WONT
MOVEI AC1,=255 ;First send IAC
PUSHJ P,IMPOUT
POP P,AC1 ;Send DONT or WONT
PUSHJ P,IMPOUT
MOVE AC1,IACFLG ;Send back option code
PUSHJ P,IMPOUT
OPTDUN: SETZM IACFLG ;Negotiation done
JRST CIROUT
;Didisp -- Data In (Imp) Process Control. ;⊗ DIDISP DIREEN DIWAIT DIACS DIP DIHUNG DIPDL DISTART DIROUT DIROU1 DIEOF DIEOF1 BAUD NOTBAU BAUDWT
DIDISP: SKIPE DIHUNG ;IS DI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST DIREEN ; YES, REENTER DI ROUTINE
EXCH P,DIP
PUSHJ P,DISTART ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,DIP ;SAVE TT PDL, GET OLD PDL
SETZM DIHUNG ;INDICATE THAT DI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
DIREEN: PUSHJ P,GETACS
XWD 1,DIACS
EXCH P,DIP ;RETREIVE DI PUSHDOWN POINTER
POPJ P, ;AND RETURN TO WAITING DI ROUTINE.
DIWAIT: SETOM DIHUNG ;PUSHJ TO HERE TO MAKE DI ROUTINE WAIT
EXCH P,DIP ;SAVE DI PDL, GET OLD PDL
PUSH P,[XWD 0,DIACS]
JRST SAVACS ;SAVE DI ACCUMULATORS, RETURN TO MAIN LOOP
DIACS: BLOCK 17 ;STORAGE FOR DI ACCUMULATORS 0-16
DIP: XWD -20,DIPDL
DIHUNG: 0 ;NON ZERO MEANS DI ROUTINE IS WAITING
DIPDL: BLOCK 20
DISTART:MOVEI B,DIMP
PUSHJ P,IDCON ;INITIALIZE DATA LINK CONNECTION
JRST RESET ;BOTH IDCON AND SERVER HAVE COMPLAINED BY NOW
PUSHJ P,GOWAIT ;WAIT FOR POSSIBLE REFUSAL BY SERVER
PUSHJ P,DIWAIT
CALLI C,22 ;TIME IN 60THS
MOVEM C,GOTIME#
SETZM WORDS#
DIROUT: HRROI C,-40 ;MAXIMUM 40 BYTES AT A TIME WITHOUT PAUSING
DIROU1: PUSHJ P,GETDAT ;GET DATA BYTE FROM IMP
JRST RESET
JRST DIEOF ;EOF ON IMP
AOS WORDS ;COUNT NO BITS XFERED
PUSHJ P,PUTFIL ;PUT DATA BYTE INTO LOCAL FILE SYSTEM
JRST RESET
AOJL C,DIROU1 ;LOOP FOR NEXT BYTE
PUSHJ P,SXACTV
PUSHJ P,DIWAIT
JRST DIROUT
DIEOF: MOVE T,DTYPE ;SPECIAL EOF FOR IMAGE TYPE
SOJN T,DIEOF1 ;ELSE JUST CLOSE EVERYTHING
;JJW 12/83 If other host is 36-bit and file length in words is even, FIWORD is
;now full and we need to store it. If file length is odd, we've already stored
;the 4 data bits in the last 8-bit byte, and the other 4 are padding. I'm not
;sure what happens, though, with non-36-bit hosts.
SKIPE FIBTSL ;Do store if full word (even length file)
JRST DIEOF1
MOVE A,FIWORD ;GET LAST PARTIAL WORD
PUSHJ P,PUTFI0
JRST RESET
DIEOF1: MOVE C,LDISOC
MOVEM C,DOTERM+LSLOC
SETZM DOTERM+WFLOC ;don't wait for close
MTAPE DIMP,DOTERM ;TERMINATE CONNECTION
CLOSE DIMP,
CLOSE FIMP,
RELEASE DIMP,
RELEASE FIMP,
PUSHJ P,BAUDWT
PUSHJ P,DIWAIT
SKIPN TYPECM ;BH 8/20/80 No message to clutter file typeout
SKIPE NLSTFL ;SKIP THE POOP IF DOING
JRST NOTBAU ; NLST FOR A MULT-RETR
OUTSTR [ASCIZ /Input complete: /]
BAUD: MOVE T,WORDS
PUSHJ P,DPRINT
SKIPE DTYPE ;FIND TRANSFER BYTE SIZE
SKIPA T,DBS
MOVEI T,10
MOVEI T+1,[ASCIZ / words transfered (/]
CAIE T,=36
MOVEI T+1,[ASCIZ / bytes transferred (/]
OUTSTR (T+1)
CALLI T+1,22
SUB T+1,GOTIME
IMULI T+1,=100/=20
MOVE T,WORDS
IMULI T,=60/=20
SKIPE DTYPE
IMUL T,DBS
SKIPN DTYPE
LSH T,3 ;IMULI T,10
IDIV T,T+1
IDIVI T,=10
PUSH P,T+1
PUSHJ P,DPRINT
OUTCHR ["."]
POP P,T
ADDI T,"0"
OUTCHR T
OUTSTR [ASCIZ / Kbaud)
/]
NOTBAU: SETZM DIACTV ;FLAG ISN'T CLEARED TILL AFTER BAUD
SETZM DOACTV ; SO THE * WON'T GET BURIED
POPJ P,
BAUDWT: SKIPE BAUDOK
JRST CPOPJ1
;; JJW 4-Feb-84 sleep here to prevent looping while waiting
MOVEI T,1
SLEEP T,
PUSHJ P,SXACTV ;8/10/75 BH, MAYBE IT'LL FIX THE HANGING AT END
XCT @(P) ;call DIWAIT or DOWAIT...
JRST BAUDWT
;Dodisp -- Data Out (Imp) Process Control. ;⊗ DODISP DOREEN DOWAIT DOACS DOP DOHUNG DOPDL DOSTART DOROUT DOROU1 DOROU2 DOTERM
DODISP: SKIPE DOHUNG ;IS DO ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST DOREEN ; YES, REENTER DO ROUTINE
EXCH P,DOP
PUSHJ P,DOSTART ; NO, START AT BEGINNING OF TT ROUTINE
EXCH P,DOP ;SAVE TT PDL, GET OLD PDL
SETZM DOHUNG ;INDICATE THAT DO ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
DOREEN: PUSHJ P,GETACS
XWD 1,DOACS
EXCH P,DOP ;RETREIVE DO PUSHDOWN POINTER
POPJ P, ;AND RETURN TO WAITING DO ROUTINE.
DOWAIT: SETOM DOHUNG ;PUSHJ TO HERE TO MAKE DO ROUTINE WAIT
EXCH P,DOP ;SAVE DO PDL, GET OLD PDL
PUSH P,[XWD 0,DOACS]
JRST SAVACS ;SAVE DO ACCUMULATORS, RETURN TO MAIN LOOP
DOACS: BLOCK 17 ;STORAGE FOR DO ACCUMULATORS 0-16
DOP: XWD -20,DOPDL
DOHUNG: 0 ;NON ZERO MEANS DO ROUTINE IS WAITING
DOPDL: BLOCK 20
DOSTART:MOVEI B,DOMP
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST RESET
PUSHJ P,GOWAIT ;WAIT FOR SERVER TO APPROVE
PUSHJ P,DOWAIT
CALLI C,22 ;TIME IN 60THS
MOVEM C,GOTIME#
SETZM WORDS#
SETOM NOEDIR#
DOROUT: HRROI C,-40 ;MAXIMUM OF 40 BYTES OUT BEFORE PAUSING
DOROU1: PUSHJ P,GETFIL ;GET A BYTE FROM FILE SYSTEM
JRST RESET
JRST DOROU2 ;EOF ON INPUT FILE
AOS WORDS
PUSHJ P,PUTDAT ;PUT DATA BYTE OUT ON IMP
JRST RESET
AOJL C,DOROU1 ;LOOP FOR NEXT BYTE
PUSHJ P,SXACTV
PUSHJ P,DOWAIT
JRST DOROUT
DOROU2: PUSHJ P,PUTDA1 ;ONE FINAL OUTPUT
MOVE C,LDOSOC ;ARRIVE HERE ON EOF FROM LOCAL FILE SYSTEM
MOVEM C,DOTERM+LSLOC
SETOM DOTERM+WFLOC ;wait for close, so we can reuse ports in next xfer
MTAPE DOMP,DOTERM ;TERMINATE CONNECTION
CLOSE DOMP,
CLOSE FOMP,
RELEASE DOMP,
RELEASE FOMP,
PUSHJ P,BAUDWT
PUSHJ P,DOWAIT
OUTSTR [ASCIZ /Output complete: /]
SETZM OUTCON ;DATA CONNECTION COMPLETE
JRST BAUD
DOTERM: 3 ↔ 0 ↔ 000 ↔ 0
;Getoc -- Command Op Codes. ;⊗ GETOC GETOX1 GETOX0 GETOC1 GETOCC GETOCQ SPCRDL GETOC9 GETOCA GETOC7 GETOC2 POP32 EMPTYL GETOCN GETOC3 GETOC4 GETOC5 GETOC6 GETOC0 SPCFTC XIND SPCFTI SPCFTE SPCFTN
GETOC: PUSH P,AC2
PUSH P,AC3
SETZ AC1,
SETZM GIVELF ;UNWEDGE GETTTY TO STOP GIVING FAKE LFS FOREVER
SETZM TTCHSV ;NO SAVED LOOKAHEAD CHAR
GETOX1: MOVE AC2,[POINT 7,AC1]
GETOX0: SKIPE CIGAG ;IF CIGAG IS ZERO WE ARE IN THE MIDST OF TYPING A
JRST GETOC1 ; SERVER REPLY, SO LET'S HOLD OFF ON THE *
PUSHJ P,TTWAIT
JRST GETOX0
GETOC1: OUTCHR ["*"]
SETOM CHAR1 ;IF A SERVER REPLY COMES LATER, I'LL GIVE ANOTHER *
SETZM NOPARM#
GETOCC: READS(AC3,<
JRST [ SKIPN DIACTV
SKIPE DOACTV
JRST GETOCQ ;I DON'T THINK THIS IS POSSIBLE ANYMORE
SKIPE SPCIN
JRST SPCFTI
GETOCQ: PUSHJ P,TTWAIT ;WAIT FOR WHOLE LINE
JRST GETOCC]
>)
SPCRDL: TRNE AC3,600
JRST SPCFTC
SETZM CHAR1
CAIE AC3,11
CAIN AC3," "
JRST GETOC2 ;DONE, PARAMS FOLLOW
CAIN AC3,175 ;ALTMODE ENDS IT
JRST GETOCA
CAIN AC3,12
JRST GETOC7 ;DONE, NO PARAMS FOLLOW
CAIN AC3,15
JRST GETOCC
CAIL AC3,"a"
CAILE AC3,"z"
CAIA
SUBI AC3,"a"-"A"
CAIL AC3,"0"
CAILE AC3,"Z"
JRST GETOC9 ;OUT OF RANGE CHAR STARTS PARAMS
CAILE AC3,"9"
CAIL AC3,"A"
CAIA ;ALPHAMERICS OK
JRST GETOC9 ;OTHERS ARE OUT OF RANGE
TLNE AC2,760000 ;JUST IGNORE EXTRA CHARS
IDPB AC3,AC2
JRST GETOCC
GETOC9: MOVEM AC3,TTCHSV# ;SAVE CHARACTER TO START PARAMS
JRST GETOC2
GETOCA: OUTSTR CRLF
GETOC7: JUMPE AC1,EMPTYL ;EMPTY LINE
MOVEM AC3,NOPARM# ;EOL AT END OF COMMAND
SETOM GIVELF ;PREVENT FLUSCS AND FRIENDS FROM LOSING
GETOC2: JUMPE AC1,GETOCC
SETZM PKUFLG
POP32: SETZM HELPER ;BH 12/30/77. -1 FLUSHES ERR MSGS FROM HELP
POP P,AC3
POP P,AC2
ifn verbose, <
outstr [asciz /getoc returns /]
outstr ac1
outstr crlf
>;ifn verbose
POPJ P,
EMPTYL: SKIPE PKURNM ;EMPTY COMMAND LINE,
SKIPN PKUCMD
JRST GETOX1 ;IGNORE UNLESS AFTER PICKUP
SETOM PKUFLG# ;FLAG GFN SHOULDN'T READ FROM TTY
MOVE AC1,PKUCMD ;RETURN THE SAVED COMMAND
JRST POP32
GETOCN: TRZ AC1,377 ;**** TRUNCATE TO 4 CHARS FOR NOW *****
TLNN AC1,3760 ;AC1 CONTAINS AT LEAST 2 ASCII CHARACTERS?
JRST [HRLZI AC3,774000 ↔ JRST GETOC3] ; NO
TDNN AC1,[17700000] ;AC1 CONTAINS AT LEAST 3 ASCII CHARACTERS?
JRST [HRLZI AC3,777760 ↔ JRST GETOC3] ; NO
TRNN AC1,77400 ;AC1 CONTAINS AT LEAST 4?
JRST [HRROI AC3,700000 ↔ JRST GETOC3] ; NO
TRNN AC1,376 ;AC1 CONTAINS AT LEAST 5?
SKIPA AC3,[XWD -1,777400] ; NO
HRROI AC3,777776
GETOC3: ;AC3 IS NOW A MASK FOR ASCII OPCODES
HRLZI AC2,-NOCS
PUSH P,AC4
PUSH P,AC5
SETZ AC5,
GETOC4: MOVE AC4,@OCS(AC2) ;AC4←A LEGAL OPCODE IN ASCIZ(UP TO 5 CHRS)
AND AC4,AC3 ;MASK OUT ANY UNTYPED CHARACTERS
CAMN AC1,AC4 ;MATCH?
AOJA AC5,.+2 ; YES, INCREMENT # OF MATCHES
CAIA ; NO
HRL AC5,AC2 ; YES, SAVE NUMBER OF OPCODE
AOBJN AC2,GETOC4 ;JUMP TO EXAMINE NEXT OPCODE
JUMPE AC5,[MESSG (Unrecognized command) ↔ JRST GETOC6]
HLRZ AC2,AC5 ;AC2 ← INDEX OF A MATCH
TRNE AC5,777776 ;SKIP IF ONE AND ONLY ONE MATCH
JRST [MESSG (Ambiguous command) ↔ JRST GETOC6]
AOS -2(P) ;SET SKIP RETURN
GETOC5: POP P,AC5
POP P,AC4
POPJ P, ;RETURN
GETOC6: READS (AC3,JRST GETOC0) ;FLUSH REST OF COMMAND LINE
CAIE AC3,12
JRST GETOC6
SETOM GIVELF ;GETTTY WILL REPEAT THE LF FOREVER
GETOC0: AOJN AC1,GETOC5
POPJ P, ;AC1 WAS -1, GOT HERE VIA GETOC9 (???? -BH)
SPCFTC: CAIE AC3,400+"I"
CAIN AC3,400+"i"
JRST .+2
JRST GETOCC
OUTSTR [ASCIZ /Type input file name - /]
PUSH P,[GETOCC]
XIND: SETOM ECHOF
PUSH P,AC1
PUSH P,AC2
PUSHJ P,RDFILE
JRST [ SETZM GIVELF
SETZM TTCHSV
POP P,AC2
POP P,AC1
POPJ P,]
SETZM GIVELF
SETZM TTCHSV
POP P,AC2
POP P,AC1
INIT INFL,0
SIXBIT /DSK/
IFBUF
JRST 4,.
LOOKUP INFL,LBLOCK
JRST SPCFTN ;FILE NOT FOUND
SETOM SPCIN
POPJ P,
SPCFTI: SOSG IFBUF+2
IN INFL,
JRST .+2
JRST SPCFTE ;EOF
ILDB AC3,IFBUF+1
JUMPE AC3,SPCFTI
OUTCHR AC3
JRST SPCRDL
SPCFTE: SETZM SPCIN
RELEAS INFL,
outstr [asciz /
*** Closing input file ***
/]
JRST GETOCC
SPCFTN: OUTSTR [ASCIZ /File not found
/]
; JRST GETOCC
POPJ P,
;Getfil -- Get data byte from local file system. ;⊗ GETFIL GETFI0 GETFI1 GETFI2 GETFI3 GETFI4 GETFI5 GETFI9 GETFI6 GETFI7 GETF71 GETFI8 GETFI8 FOBTSL FOWORD FOBPT FOTEMP FOMASK GETDAT GETDA1 GETDA2 GETDA3 GETDA4 GETDA5 GETDA6
GETFIL: MOVE A,DTYPE ;GETTING FROM FILE IS HAIRY
CAIN A,1 ; IF IMAGE TYPE
JRST GETFI3 ; ELSE DROP THROUGH TO STANDARD ROUTINE
GETFI0: SOSG FOBUF+2 ;DATA BYTE IN BUFFER?
JRST GETFI2 ; NO, DO AN INPUT
GETFI1: ILDB A,FOBUF+1 ; YES, GET DATA BYTE
JRST GETFI6 ; AND RETURN UNLESS ASCII
GETFI2: IN FOMP, ;DO AN INPUT
JRST GETFI1 ; INPUT WAS SUCCESSFUL
GETSTS FOMP,B ; EOF OR ERROR, GET STATUS BITS IN B
TRNE B,IODEND ;EOF?
JRST CPOPJ1 ; YES
OUTSTR [ASCIZ /Error reading local file./]
MOVSI B,(<INTTTI>)
INTGEN B, ;ABORT
JRST DOWAIT ;THIS WILL NEVER RETURN MAYBE
;Here for Image mode transfer only.
GETFI3: SKIPE A,FOBTSL ;IMAGE MODE: MORE BITS IN THE CURRENT FILE WORD?
JRST GETFI4 ; YES, CARRY ON
MOVS A,DBS ;ELSE CREATE A NEW BPT
LSH A,6 ;BYTE SIZE INTO S FIELD
IOR A,[POINT 0,FOWORD] ;POSITION TO BEGINNING OF WORD
MOVEM A,FOBPT
PUSHJ P,GETFI0 ;GET ANOTHER WORD
POPJ P, ;ERROR RETURNS
JRST CPOPJ1
MOVEM A,FOWORD ;SAVE FILE WORD FOR BYTE EXTRACTION
MOVEI A,=36 ;INIT BITS LEFT
GETFI4: SUB A,DBS ;SUBTRACT BYTE SIZE FROM BITS LEFT IN WORD
MOVEM A,FOBTSL
JUMPL A,GETFI5 ;JUMP IF NOT ENOUGH
ILDB A,FOBPT ;THIS IS AN EASY ONE
JRST CPOPJ2
;Here for Image mode transfer only.
GETFI5: PUSHJ P,GETFI0 ;WRAPAROUND CASE, GET NEXT WORD
POPJ P,
JRST GETFI9 ;JJW 12/83 Deal with partial word at EOF
MOVEM A,FOTEMP ;SAVE NEXT WORD
MOVE B,A ;POSITION FOR LSHC
MOVE A,FOWORD
MOVN D,FOBTSL ;*** NOTE WE ARE USING AC D. C IS IN USE UPLEVEL.
LSHC A,(D) ;POSITION COMBINATION BYTE
AND A,FOMASK ;FLUSH CRUFT
MOVE B,FOTEMP
MOVEM B,FOWORD ;SET UP FOR NEW WORD
MOVEI B,=36
ADDB B,FOBTSL
LSH B,6 ;MAKE NEW BPT
ADD B,DBS
LSH B,=24
HRRI B,FOWORD
MOVEM B,FOBPT
JRST CPOPJ2
;Here for Image mode at EOF when there is a partial byte left.
GETFI9: MOVE A,FOWORD
SETZ B, ;Pad it with zeros
MOVN D,FOBTSL ;Same as above
LSHC A,(D)
AND A,FOMASK
SETZM FOBTSL ;Make next call to GETFIL fail
JRST CPOPJ2
GETFI6: SKIPE DTYPE ;DONE EXCEPT FOR ASCII MODE
JRST CPOPJ2
JUMPE A,GETFIL ;FOR ASCII, WE FLUSH NULLS
MOVE B,@FOBUF+1 ; CHECK FOR SOS LINE NUMBERS
TRNN B,1
JRST GETFI7
MOVNI B,5
ADDM B,FOBUF+2
AOS FOBUF+1
JRST GETFIL
GETFI7: AOSE NOEDIR ; CHECK FOR E DIRECTORY
JRST GETFI8
MOVE D,FOBUF+1
MOVE B,(D)
CAME B,[ASCII /COMME/]
JRST GETFI8
MOVE B,1(D)
CAME B,[ASCII /NT ⊗ /]
JRST GETFI8
MOVE B,2(D)
CAME B,[ASCII / VAL/]
JRST GETFI8
GETF71: PUSHJ P,GETFIL
POPJ P,
JRST CPOPJ1
CAIE A,14
JRST GETF71
JRST GETFIL
GETFI8: SKIPN SAILFL ;Skip if SAIL mode
SKIPA B,PTOASC ;Normal ASCII
MOVE B,PTOSAI ;SAIL mode
CAIGE A,200 ;Range check for translation
LDB A,B ;Convert WAITS to ASCII
JRST CPOPJ2
FOBTSL: 0
FOWORD: 0
FOBPT: 0
FOTEMP: 0
FOMASK: 0
GETDAT: ;GET DTAT BYTE FROM IMP
SOSG DIBUF+2 ;BYTE IN BUFFER?
JRST GETDA2 ; NO, THINK ABOUT AN INPUT
GETDA1: ILDB A,DIBUF+1 ;GET THE DATA BYTE
JRST CPOPJ2 ; AND RETURN
GETDA2: HRRZ A,DIBUF
HRRZ A,(A)
SKIPGE (A) ;IS THERE DATA IN NEXT BUFFER?
JRST GETDA3 ; YES, DO AN INPUT
INTMSK 1,[0] ;TURN OFF INTERRUPTS
MTAPE DIMP,[10] ;INPUT DATA WAITING IN FREE STORAGE?
JRST GETDA4 ; NO
INTMSK 1,[-1] ;TURN ON INTERRUPTS
GETDA3: IN DIMP,
JRST GETDA1 ;SUCCESSFUL INPUT
POPJ P, ;ERROR ON INPUT, GIVE ERROR RETURN
;There's no data in buffers or in system FS for us to read.
GETDA4: INTMSK 1,[-1] ;TURN ON INTERRUPTS
GETSTS DIMP,A ;GET STATUS BITS
TRNE A,IODEND ;EOF?
JRST CPOPJ1 ; YES
TRNE A,ERRBTS ;ERROR?
POPJ P, ; YES
;repeat 0,< ;IODEND always comes on after we've read last data byte. This was wrong.
MTAPE DIMP,GETDA6 ;GET STATUS OF CONNECTION
MOVE A,GETDA6+2
TLC A,(<RFCS!RFCR>) ;BOTH RFC BITS SHOULD BE ON: COMPLEMENT THEM
TLNN A,(<RFCS!RFCR!CLSS!CLSR>) ;CONNECTION CLOSED OR CLOSING? OR NOT THERE AT ALL?
JRST GETDA5 ; NO, GO INTO WAIT STATE
; MOVE A,DMODE ; YES, EITHER AN ERROR OR EN EOF
; CAIE A,1 ;ARE WE IN IMAGE MODE?
AOS (P) ; YES, EOF RETURN
POPJ P, ; NO, ERROR RETURN
;>;repeat 0
GETDA5: PUSHJ P,DIWAIT ;WAIT AROUND FOR AWHILE
JRST GETDA2 ; ..AND TRY AGAIN
;repeat 0,<
GETDA6: 2 ↔ 0 ↔ 0 ;DATA BLOCK FOR GET STATUS MTAPE UUO
;>;repeat 0
;Putdat, Putfil - data byte into imp or local file system ;⊗ PUTDAT PUTDA1 PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI6 COREOK CORLUZ PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
PUTDAT: SOSG DOBUF+2 ;ROOM IN BUFFER FOR BYTE?
PUSHJ P,PUTDA1 ; NO, DO AN OUTPUT
IDPB A,DOBUF+1 ; YES, STUFF IT IN
JRST CPOPJ1 ; SUCCESS RETURN
PUTDA1:
OUT DOMP, ;DO AN OUTPUT
POPJ P, ; OUTPUT WORKED
OUTSTR [ASCIZ /Output to IMP failed./]
MOVSI B,(<INTTTI>)
INTGEN B,
JRST DOWAIT
;; CALL: MOVE A,<BYTE TO GO INTO LOCAL FILE SYSTEM>
;; PUSHJ P,PUTFIL
;; ERROR RETURN
;; NORMAL RETURN
PUTFIL: MOVE B,DTYPE ;PROCESSING DEPENDS ON TYPE
JRST .+1(B) ;DISPATCH
JRST PUTFI2 ;ASCII, DO CHAR TRANSLATION
JRST PUTFI3 ;IMAGE, HAIRY CROCK. ELSE LOCAL BYTE
PUTFI0: SOSG FIBUF+2 ;ROOM IN BUFFER FOR THIS BYTE?
OUT FIMP, ; NO, OUTPUT THE BUFFER
JRST PUTFI1 ;ROOM IN BUFFER, OR SUCCESSFUL OUTPUT
POPJ P, ; ERROR RETURN
PUTFI1: IDPB A,FIBUF+1 ;PUT BYTE INTO BUFFER
JRST CPOPJ1 ;SUCCESS RETURN
PUTFI2: JUMPE A,CPOPJ1 ;ASCII, IGNORE NULLS,
CAIL A,200
JRST CPOPJ1 ; IGNORE FUNNY NVT CODES,
SKIPN SAILFL ;Skip if SAIL mode
SKIPA B,PFRASC ;Normal ASCII
MOVE B,PFRSAI ;SAIL mode
LDB A,B ;Convert ASCII to WAITS
PUTFI6: SKIPN NLSTFL ;DOING NLST FOR MULTIPLE RETR?
JRST PUTFI0 ;NO, NORMAL IO STUFF
HRRZ B,NLSBPT ;YES, MAKE SURE THERE'S ROOM IN CORE
CAMLE B,JOBREL
JRST COREOK
ADDI B,2 ;FUDGE FACTOR
CORE B,
JRST CORLUZ ;OOPS
COREOK: IDPB A,NLSBPT ;WIN
JRST CPOPJ1
CORLUZ: OUTSTR [ASCIZ /Not enough core available for file list.
/]
JRST RESET ;FLUSHO!
;Here only for Image mode transfer.
PUTFI3: SKIPE B,FIBTSL ;HAIRY IMAGE MODE WRAPAROUND BYTE CROCK
JRST PUTFI4
EXCH A,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVE A,FIWORD
SETZM FIWORD
MOVS B,DBS
LSH B,6
IOR B,[POINT 0,FIWORD]
MOVEM B,FIBPT
MOVEI B,=36
PUTFI4: SUB B,DBS
MOVEM B,FIBTSL
JUMPL B,PUTFI5
IDPB A,FIBPT
JRST CPOPJ1
;Here for Image mode transfer only.
PUTFI5: MOVEI B,0
MOVE D,FIBTSL
LSHC A,(D) ;POSITION THE NEW BYTE
IOR A,FIWORD
MOVEM B,FIWORD
PUSHJ P,PUTFI0
POPJ P,
MOVEI A,=36
ADDB A,FIBTSL
LSH A,6 ;MAKING NEW BPT
ADD A,DBS
LSH A,=24
HRRI A,FIWORD
MOVEM A,FIBPT
JRST CPOPJ1
FIBTSL: 0
FIWORD: 0
FIBPT: 0
;Initialize data link connection ;⊗ IDCON IDCONZ IDCONI IDCONC IDCONW IDCONX IDCONY IDCONS IDCONB IDCON0 IDFUCK IDCOS0 IDCON2 IDCON1 IDCO11 IDCOND IDCONA IDCONP IDCONF IMPIBF IMPOBF
; CALL: MOVEI B,DOMP ;FOR DATA OUT CONNECTION
; MOVEI B,DIMP ;FOR DATA IN
; PUSHJ P,IDCON
; ERROR RETURN
; SUCCESS RETURN
IDCON: MOVE A,DTYPE
MOVE A,IMODES(A)
HRRM A,IDCONI
MOVE A,IDCONB-DOMP(B)
MOVEM A,IDCONI+2
DPB B,[POINT 4,IDCONI,12]
DPB B,[POINT 4,IDCONC,12]
DPB B,[POINT 4,IDCONW,12]
DPB B,[POINT 4,IDCOS0,12]
IDCONZ: DPB B,[POINT 4,IDCONY,12]
IDCONI: INIT 000,000
SIXBIT /IMP/
XWD DOBUF,DIBUF
JRST NOIMP
MOVEI A,1
MOVEM A,CONECB ;Do a listen
MOVE A,LDOSOC-DOMP(B)
MOVEM A,CONECB+LSLOC
MOVEI A,10 ;ASCII ALWAYS 8 BITS
MOVEM A,CONECB+BSLOC
SETZM CONECB+WFLOC ;DON'T WAIT FOR CONNECTION
MOVE A,FDOSOC ;Get foreign input/output port (both use same port)
MOVEM A,CONECB+FSLOC ;Store for connect
IDCONC: MTAPE 000,CONECB ;INITIATE DATA CONNECTION W/ USER
DEB,< OUTSTR [ASCIZ/{Listening for data connection on port /]
PUSH P,B
MOVE A,CONECB+LSLOC ;get local port
PUSHJ P,TYPDEC ;type port number
OUTSTR [ASCIZ/.}/]
POP P,B
>;DEB
CAIN B,DIMP ;ARE WE DOINT DATA INPUT?
IDCONW: MTAPE 000,[=13 ↔ 1] ; YES, GIVE ALLOCATION
IDCONX: INTOFF ;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY: MTAPE 000,IDCONS ;GET STATUS OF DIMP
INTON
MOVE A,IDCONS+1-DOMP(B)
TRNE A,77 ;ANY ERROR CODES?
JRST IDCON1 ; YES
repeat 0,<
;Don't check for close that might have happened immediately after data sent.
TLNE A,(<CLSS!CLSR>) ;ANYBODY CLOSING CONNECTION?
JRST IDCON2 ; YES
>;repeat 0
TLC A,(<RFCS!RFCR>)
TLCN A,(<RFCS!RFCR>) ;CONNECTION COMPLETE?
JRST IDCON0 ; YES, SUCCESS RETURN
PUSHJ P,@IDCOND-DOMP(B) ;PUSHJ TO DIWAIT OR DOWAIT
XCT IDCONZ ;THIS INSTRUCTION MAKES IDCON REENTRANT
; - OR ENOUGH SO TO WORK, ANYWAY!
JRST IDCONX
IDCONS: 2 ↔ 0 ↔ 0
IDCONB: XWD DOBUF,0
XWD 0,DIBUF
IDCON0: PUSH P,JOBFF
DEB,< OUTSTR [ASCIZ/{Data connection open.}/] >;DEB
MOVE A,IDCONF-DOMP(B)
MOVEM A,JOBFF
XCT IDCONA-DOMP(B) ;INBUF DIMP,2 OR OUTBUF DOMP,2
POP P,JOBFF
CAIN B,DOMP ;MARK OUTPUT CONNECTION COMPLETE
SETOM OUTCON ;IF OUTPUT (STOR, ETC.) OPERATION
MOVEI A,10 ;ASCII ALWAYS 8 BITS
DPB A,IDCONP-DOMP(B) ;SET BYTE SIZE IN BUFFER HEADER
PUSHJ P,SXACTV
PUSHJ P,@IDCOND-DOMP(B) ;TRY FOR SIMULTANEOUS Port ARRIVAL
IDFUCK: MOVEI A,7
MOVEM A,CONECB
MOVE A,LDOSOC-DOMP(B)
MOVEM A,CONECB+LSLOC
IDCOS0: MTAPE 000,CONECB ;GET HOST AND Port NUMBERS
MOVE A,CONECB+FSLOC ;GET PROPER Port NUMBER
JRST CPOPJ1
repeat 0,<
IDCON2: PUSHJ P,ERRWAT ;DON'T BOTHER COMPLAINING IF
PUSHJ P,@IDCOND-DOMP(B) ; SERVER COMPLAINED ANYWAY
OUTSTR [ASCIZ /Data port closed--/]
JRST IDCO11
>;repeat 0
IDCON1: PUSHJ P,ERRWAT
PUSHJ P,@IDCOND-DOMP(B)
IDCO11: MESSG (Error making data connection)
POPJ P,
IDCOND: DOWAIT
DIWAIT
IDCONA: UOUTBF DOMP,[2 ↔ 337]
UINBF DIMP,[2 ↔ 337]
IDCONP: POINT 6,DOBUF+1,11
POINT 6,DIBUF+1,11
IDCONF: IMPOBF
IMPIBF
IMPIBF:
IMPOBF: BLOCK 2*341
;Initialize local data device ;⊗ ILDDEV ILDDO ILDDSH ILDDE ILDDE2 ILDDL ILDDL2 ILDSSZ ILDSS1 ILDSS2 LEERR LEERRX LEETAB LEEMAX ILDD ILDDIO DSKIBF DSKOBF FASTAB FASLEN
;; CALL: MOVE C,<DEVICE NAME>
;; MOVE D,<PROJECT PROGRAMMER NAME>
;; MOVE E,<EXTENSION NAME>
;; MOVE F,<FILE NAME>
;; MOVE B,<DIMP or DOMP> ;(FOR INPUT OR OUTPUT TO IMP)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; NORMAL RETURN
ILDDEV:
SETZM NLSTFL ;OUR SIDE GOES TO FILE, NOT CORE
MOVE A,DTYPE
MOVE A,FMODES(A)
MOVEM A,ILDD
MOVEM C,ILDD+1
MOVE A,ILDDIO-DOMP(B)
MOVEM A,ILDD+2
MOVEI A,2(B)
DPB A,[POINT 4,ILDDO,12]
DPB A,[POINT 4,ILDDE,12]
DPB A,[POINT 4,ILDDL,12]
DPB A,[POINT 4,ILDDL2,12]
DPB A,[POINT 4,ILDDE2,12]
HRRM A,ILDDSH ;Channel number for filestatus display
MOVE A,C ;Check device for high bandwidth
PNAME A, ;Just in case it was redefined.
JRST [ OUTSTR [ASCIZ/NO SUCH DEVICE.
/]↔ POPJ P,]
MOVSI T,-FASLEN
CAMN A,FASTAB(T)
JRST [ OUTSTR [ASCIZ/DEVICE IS INAPPROPRIATE FOR FTP.
/]↔ POPJ P,] ;Usually because network isn't fast enough for it.
AOBJN T,.-2
MOVE A,ILDD ;Check to see if mode is valid, so we don't
ANDI A,17 ;get a message from moniter.
MOVEI T,1
ROT T,(A)
MOVE A,C
DEVCHR A,
MOVEM A,DVICE# ;SAVE FOR POSSIBLE LOOKUP/ENTER ERROR MSG
TDNN A,T
JRST [ OUTSTR [ASCIZ/ILLEGAL MODE.
/]↔ POPJ P,]
ILDDO: OPEN 000,ILDD
POPJ P, ;CAN'T OPEN FILE SYSTEM
ILDDSH: MOVEI A,000
SHOWIT A, ;ENABLE FILESTATUS DISPLAY
JUMPN D,.+2
DSKPPN D,
MOVEM F,ILDD
MOVEM E,ILDD+1
SETZM ILDD+2
MOVEM D,ILDD+3
CAIE B,DIMP
JRST ILDDL
ILDDE: ENTER 000,ILDD
JRST [OUTSTR [ASCIZ /ENTER failed/]
JRST LEERR]
PUSH P,JOBFF
MOVEI A,DSKOBF
MOVEM A,JOBFF
ILDDE2: OUTBUF 000,NBUFS ;WAS 13
POP P,JOBFF
MOVEI A,=36
MOVEM A,FIBTSL
SETZM FIWORD
MOVS A,DBS
LSH A,6
IOR A,[POINT 0,FIWORD]
MOVEM A,FIBPT
JRST ILDSSZ
ILDDL: LOOKUP 000,ILDD
JRST [OUTSTR [ASCIZ /LOOKUP failed/]
JRST LEERR]
PUSH P,JOBFF
MOVEI A,DSKIBF
MOVEM A,JOBFF
ILDDL2: INBUF 000,NBUFS
POP P,JOBFF
SETZM FOBTSL
MOVEI A,1
LSH A,@DBS
SUBI A,1
MOVEM A,FOMASK ;SET UP MASK FOR IMAGE MODE
ILDSSZ: MOVE A,DTYPE
XCT ILDSS1(A) ;GET BYTE SIZE FOR FILE
DPB A,ILDSS2-DOMP(B) ;PUT IN HEADER
JRST CPOPJ1
ILDSS1: MOVEI A,7 ;ASCII, DSK BYTE SIZE IS 7
MOVEI A,=36 ;IMAGE, DSK BYTE SIZE IS 36
MOVE A,DBS ;LOCAL, GET SIZE FROM USER SPEC
ILDSS2: POINT 6,FOBUF+1,11
POINT 6,FIBUF+1,11
LEERR: MOVE A,DVICE ;GET DEVCHR
TLNN A,200000 ;IS IT A DSK?
JRST LEERRX ;NOPE, NO ERROR CODE
HRRZ A,ILDD+1 ;YUP, GET ERROR CODE
CAILE A,LEEMAX
MOVEI A,LEEMAX
OUTSTR @LEETAB(A) ;GIVE THE MESSAGE
LEERRX: OUTSTR [ASCIZ /
/]
POPJ P, ;TAKE ERROR RETURN
LEETAB: [ASCIZ /: no such file/]
[ASCIZ /: no such PPN/]
[ASCIZ /: protection violation/]
[ASCIZ /: file busy/]
LEEMAX←←.-LEETAB
[ASCIZ /: unknown error code!/]
ILDD: BLOCK 4
ILDDIO: XWD 0,FOBUF
XWD FIBUF,0
DSKIBF: BLOCK NBUFS*203
DSKOBF: BLOCK NBUFS*203
;List of devices which should not be used with FTP, usually for bandwidth reasons.
FASTAB: SIXBIT/XGP/
SIXBIT/ADC/
SIXBIT/DAC/
SIXBIT/AD/
SIXBIT/PTR/ ;Reader needs tending
SIXBIT/TV/
SIXBIT/ELF/ ;PDP-11 interface. NO!
FASLEN←←.-FASTAB
;⊗ FNREAD FNREA1 FNSEND FNSEN1 FNSPPL FNSENP FNSE10 FNSE11 FNS111 FNSE12 FNSEN2 FNSEN3 FNSEN4 GFNY GFN GFNX GFNY1 NXTSKP NXTTOK GOTTOK TNONUL GFNLUZ PKUALT SYNBAD SAFOPT DEVICE ITSNM1 EXTNXT ITSNM2 NULDOT T20VER SETFIL TNXPP2 TNXPPN UNIXPN PPNNXT PPNZB PPNLZ1 PPNXIT PPNLUZ GETPNM GETPN1 SEMICL GFNEOL GFNEO1 GFNEO2 EQUALS GFNDUN SKIPS1 SKIPSP SKIPS2 LETTS3 LETTST LETTS0 LETTS1 LETTS5 LETTS2 LETTS6 LETTS4 GETSI4 GETSIX ANCHR6 GETSI1 GETSI2 GETSI3
FNREAD: MOVE B,[POINT 7,FNBUF] ;READ AND SAVE FILE XFER CMD ARGS
MOVEM B,FNBPT ;INIT BPT WHILE WE'RE AT IT
SETZM LPPNOW#
FNREA1: PUSHJ P,GETTTY ;READ A CHAR
IDPB A,B ;STUFF IT IN THE BUFFER
CAIE A,12 ;LF?
CAIN A,175 ;OR ALT?
POPJ P,
TRZE A,200 ;flush CONTROL bit, skip if off
CAIE A,175 ;was this an altmode with CONTROL?
JRST FNREA1 ;NO, GET THE REST
SETOM ALTBKY ;Yup, remember for SAFASK
POPJ P,
FNSEND: PUSHJ P,TTSTROUT ;SEND COMMAND
SETOM FNSENF# ;FLAG FOR WILDCARD SUBSTITUTION
SETZM DOWNFL
FNSEN1: ILDB A,FNBPT ;NOW SEND THE REMOTE PATHNAME
SKIPE DOWNFL
JRST FNSEN3
CAIN A,"↓"
JRST FNSEN4
CAIN A,"["
SKIPN LPPNOW
JRST FNSENP ;JUMP UNLESS LOCAL PPN
FNSPPL: ILDB A,FNBPT
CAIN A,"]"
JRST FNSEN1
CAIE A,15
CAIN A,12
JRST FNSENP
CAIE A,175
JRST FNSPPL
FNSENP: SKIPN WILDCD ;SPECIAL PROCESSING IF MULT STOR
JRST FNSEN2 ; ELSE JUST OUTPUT
CAIN A,"."
SETZM FNSENF
CAIE A," "
JRST FNSE10
PUSHJ P,IMPOUT ;SPACE IN WILDCARD: PUT IT OUT,
SKIPE ITSFLG ; AND IF ITS, TREAT LIKE .
SETZM FNSENF
JRST FNSEN1
FNSE10: CAIE A,"*" ;* IN WILDCARD, SPECIAL ACTION
JRST FNSE12 ;ELSE NORMAL
AOSG FNSENF ;WHICH ONE WE WANT?
SKIPA B,GFNFIL
MOVE B,GFNEXT
PUSHJ P,FNSE11
JRST FNSEN1
FNSE11: JUMPE B,CPOPJ ;SEND THE SIXBIT OUT
MOVEI A,0
LSHC A,6
JUMPE A,FNSE11
ADDI A,40
SKIPN UNXFLG ;BH 12/6/84 If Unix system,
JRST FNS111
TRNE A,100
ADDI A,40 ; make substituted name lowercase.
FNS111: PUSHJ P,IMPOUT
JRST FNSE11
FNSE12: CAIN A,15 ;CR IN WILDCARD
AOSLE FNSENF ; AND NO WILD YET?
JRST FNSEN2 ;NO, NORMAL
MOVE B,GFNFIL ;YES, PUT OUT *.* EQUIVALENT NOW
PUSHJ P,FNSE11 ;GROSS HEURISTIC, COULD BE ALL WRONG!
MOVEI A,"."
SKIPE ITSFLG ;PUNCTUATION HERE IS HOST-DEPENDENT
MOVEI A," "
PUSHJ P,IMPOUT
MOVE B,GFNEXT
PUSHJ P,FNSE11
MOVEI A,15
FNSEN2: PUSHJ P,IMPOUT
CAIE A,12
JRST FNSEN1
POPJ P,
FNSEN3: CAIE A,"↓"
JRST FNSEN2
FNSEN4: SETCMM DOWNFL
JRST FNSEN1
GFNY: SETZM GIVELF ;SIGH, REALLY READ TTY
SETZM TTCHSV
PUSH P,FNBPT ;SAVE FNBPT TOO
MOVE B,[POINT 7,FNBUF2]
MOVEM B,FNBPT
SETZM ALTBKY# ;NO BUCKIES ON ALTMODE YET
PUSHJ P,FNREA1
SETOM GIVELF ;JUST IN CASE OF ALTMODE
SETZM SAFDLM# ;SAVE NON-FN SAFETY RESPONSES.
AOS -1(P)
PUSHJ P,GFNY1
SOS -1(P)
POP P,FNBPT
POPJ P,
GFN: MOVE B,[POINT 7,FNBUF]
MOVEM B,FNBPT
SKIPN PKUFLG ;DON'T READ TTY IF WE HAVE SAVED PICKUP
PUSHJ P,FNREAD ;READ AND SAVE THE STRING FROM THE TTY
GFNX: SETOM SAFDLM# ;DON'T SAVE NON-FN SAFETY RESPONSES
GFNY1: SETZM BADSYN# ;FN SCANNER. THIS FLAGS NOT WAITS SYNTAX
SETZM BADPPN#
SETZM GOTDOT# ;BH 4/7/77 ADD TOPS-20 NAME.EXT.VERSION FORMAT
SETZM FNDLIM# ;TO SAVE DELIMITER (ARROW OR =)
SETZM DOWNFL#
SKIPE NOHACK
SETOM NOWILD ;NOHACK (LOCAL FN REQUIRED) IMPLIES NOWILD (NO *)
MOVSI A,'DSK' ;INITIALIZE OUR VARIABLES
MOVEM A,GFNDEV#
SKIPE NOWILD ;FOR MLFL,
TDZA A,A ; NO WILDCARD DEFAULT
MOVSI A,'* '
MOVEM A,GFNFIL#
MOVEM A,GFNEXT#
MOVEM A,WILDCD# ;THIS FLAGS * IN PATHNAME
MOVEI A,0
DSKPPN A,
MOVEM A,GFNPPN#
NXTSKP: ILDB A,FNBPT ;WHAT A RELIEF TO BE IN 1-LOOKAHEAD MODE!
NXTTOK: PUSHJ P,GETSIX ;GET A TOKEN
GOTTOK: PUSHJ P,SKIPSP ;SKIP (BUT NOTE) FOLLOWING SPACES
JUMPN B,TNONUL ;JUMP IF TOKEN FOUND
SKIPE SAFDLM ;OR IF NOT THE FIRST TIME THROUGH
JRST TNONUL
CAIN A,175 ;INTERESTED IN ALT, CR, OR LF
JRST SAFOPT
CAIE A,15
CAIN A,12
JRST SAFOPT
TNONUL: SETOM SAFDLM
CAIN A,":" ;DISPATCH ON INTERESTING TERMINATORS
JRST DEVICE ;DEVICE NAME
CAIN A,"."
JRST EXTNXT ;THIS IS FN, NEXT IS EXT
CAIN A,"["
JRST PPNNXT ;THIS IS FN, NEXT IS PPN
CAIN A,"="
JRST EQUALS ;DONE WITH local WAITS PART
CAIE A,"←"
CAIN A,"→"
JRST EQUALS ;WHAT A BAD IDEA
CAIN A,12
JRST GFNEOL
CAIN A,"<" ;> STUPID FAIL
JRST TNXPPN ;TENEX PPN STARTS HERE
;< Stupid FAIL
CAIN A,">"
JRST LISPMP ;LispM/Multics pathname
CAIE A,"/"
CAIN A,"~"
JRST UNIXPN ;Unix pathname
CAIN A,";"
JRST SEMICL ;HAIRY. TENEX CRUD OR ITS SNAME
CAIN A,175
JRST PKUALT ;ALTMODE NOT CAUGHT BY SAFDLM, MAYBE FOR PICKUP
SKIPE SPACE# ;FLAG SET BY SKIPSP
JRST ITSNM1 ;ITS FN1 (B CAN'T BE 0 HERE)
GFNLUZ: OUTSTR [ASCIZ /Can't parse your pathname
/]
POPJ P,
PKUALT: SKIPE NOWILD ;SEE IF THIS IS FROM PICKUP
SKIPE NOHACK ; I.E. NOWILD ON BUT NOHACK OFF
JRST GFNLUZ ;NOPE, A LOSER
MOVEM A,SAFDLM ;YUP, SAVE THE ALT
JRST GFNEOL
SYNBAD: SETOM BADSYN ;SET BAD SYNTAX FOR WAITS FILENAME
JRST NXTTOK ;IGNORE THIS TOKEN
SAFOPT: MOVEM A,SAFDLM ;BARE CR, LF, OR ALT:
JRST CPOPJ1 ;SAVE IT AND RETURN
DEVICE: JUMPE B,SYNBAD ;DEVICE MAYN'T BE NULL
MOVEM B,GFNDEV ;SAVE THE DEVICE
CAMN B,['* ']
SETOM BADSYN
JRST NXTSKP ;READY FOR ANOTHER TOKEN
ITSNM1: SETOM BADSYN
JUMPE B,GFNLUZ ;FN MAYN'T BE NULL
JRST ITSNM2
EXTNXT: ILDB A,FNBPT ;SKIP THE DOT
SKIPE GOTDOT ;BH 4/7/77 HAVE WE ALREADY READ AN EXTENSION?
JRST T20VER ; YES, THIS IS TOPS-20 VERSION NUMBER
;BH 11/24/77 KLUDGE FOR .INFO.; TURN IT INTO JUST INFO
;JJW 2/84 Since Unix systems also allow names starting with ".",
;this check is no longer dependent on ITSFLG.
JUMPE B,NULDOT
SETOM GOTDOT ; NO, BUT FLAG WE HAVE AN EXTENSION
ITSNM2: PUSHJ P,SETFIL ;SET FN
PUSHJ P,GETSIX ;WE'LL GET THE EXT HERE
JUMPE B,GOTTOK ;IF NO EXT, IGNORE
HLLZM B,GFNEXT ;SAVE EXT
CAMN B,['* ']
SETOM WILDCD
JRST NXTTOK
NULDOT: PUSHJ P,ANCHR6 ;ANCHORED SIXBIT TOKEN (IE NO SPACES ALLOWED)
JUMPE B,GFNLUZ ;BARE DOT STILL INCOMPREHENSIBLE
CAIE A,"."
ILDB A,FNBPT ;SKIP TRAILING DOT
SETOM BADSYN ;This not allowed in WAITS name
JRST GOTTOK ;END .INFO. HACK
T20VER: SETOM BADSYN ;BH 4/7/77 NO VERSION NUMBERS IN WAITS FILENAME
PUSHJ P,GETSIX ;NOW JUST FLUSH THE TOKEN
JRST NXTTOK
SETFIL: MOVEM B,GFNFIL ;SAVE FN
CAME B,['* ']
SETZM WILDCD ;NOT WILDCARD UNLESS IT WAS *
SETZM GFNEXT ;FLUSH WILDCARD DEFAULT
POPJ P,
TNXPP2: CAIE A,"."
JRST NXTTOK ;I give up, what is it?
ILDB A,FNBPT ;skip over the dot
TNXPPN: SKIPE ITSFLG
JRST ITSNM1 ;IF ITS THEN THIS IS IGNORED TOKEN
ILDB A,FNBPT ;TENEX PPN, SKIP LESSTHAN
SETOM BADSYN ;NONE ALLOWED IN WAITS NAME
PUSHJ P,GETSIX ;SKIP OVER THE DIRECTORY NAME
PUSHJ P,SKIPSP
;< STUPID FAIL
CAIE A,">" ;MUST END RIGHT
JRST TNXPP2 ;maybe it's a dot!
ILDB A,FNBPT
JRST NXTTOK
LISPMP: ILDB A,FNBPT ;LispM/Multics pathname, skip right broket
PUSHJ P,GETSIX ;Skip over directory name
SETOM BADSYN ;Flag non-WAITS syntax
JRST GOTTOK
UNIXPN: ILDB A,FNBPT ;Unix pathname, skip / or ~
PUSHJ P,GETSIX ;Skip over directory name
SETOM BADSYN ;Flag non-WAITS syntax
JRST GOTTOK
PPNNXT: JUMPE B,PPNZB ;PPN, IS THERE A FN?
PUSHJ P,SETFIL
PPNZB: PUSHJ P,GETPNM ;GET PRJ
JUMPE B,PPNLUZ ;MUST BE ONE
HRLM B,GFNPPN ;MIGHT BE [PRJ] SO KEEP PRG
PPNLZ1: PUSHJ P,SKIPSP
CAIE A,","
JRST PPNXIT
PUSHJ P,GETPNM
JUMPE B,PPNLUZ
HRRM B,GFNPPN ;SAVE PRG
PUSHJ P,SKIPSP ;READ REMOTE TOPS-10 SFD PPN FORMAT
CAIN A,","
JRST PPNLUZ ;BUT DON'T ALLOW IT TO BE LOCAL
PPNXIT: CAIN A,"]"
ILDB A,FNBPT
JRST NXTTOK
PPNLUZ: SETOM BADSYN
SETOM BADPPN
JRST PPNLZ1
GETPNM: ILDB A,FNBPT ;SKIP LEFT BRACKET OR COMMA
PUSHJ P,SKIPSP ;READ PRJ OR PRG
MOVEI B,0
GETPN1: PUSHJ P,LETTST ;ALPHAMERIC?
POPJ P,
LSH B,6
IORI B,(A)
TLNE B,-1
SETOM BADSYN ;PROTECT US FROM TOO-LONG ONES
ILDB A,FNBPT
JRST GETPN1
SEMICL: SETOM BADSYN
SKIPE ITSFLG ;SEMICOLON, DEPENDS ON WHO
JRST NXTSKP ;ITS, WE JUST HAD SNAME
GFNEOL: JUMPE B,GFNEO1 ;IF NO TOKEN, WE'RE DONE
PUSHJ P,SETFIL ;ELSE SET FILENAME
GFNEO1: MOVE B,[POINT 7,FNBUF] ;GOT TO EOL WITH NO EQUAL,
EXCH B,FNBPT ; THIS FN IS FOR REMOTE HOST TOO
MOVEM B,PKUBPT ;THIS MAY BE NEEDED FOR PICKUP RETR
SKIPE NOHACK ;FLAG IS SET EXCEPT FOR STOR AND RETR
JRST GFNLUZ ; TO REQUIRE EXPLICIT LOCAL PATHNAME
MOVSI B,'DSK'
MOVEM B,GFNDEV
SKIPN LISTNG ;BH 12/10/77 NO LPPN FOR LIST ET AL
SKIPN LPPNON# ;BH 4/4/76 LOCAL PPN MODE
JRST GFNEO2
SKIPE BADPPN
JRST GFNLUZ
SETOM LPPNOW
JRST GFNDUN
GFNEO2: MOVEI B,0 ;DON'T BELIEVE THEIR DEV OR PPN
DSKPPN B,
MOVEM B,GFNPPN
JRST GFNDUN
EQUALS: MOVEM A,FNDLIM ;SAVE ARROW OR EQUAL FOR CALLER TO CHECK
SKIPE BADSYN ;FN WAS JUST FOR US,
JRST GFNLUZ ; SYNTAX MUST BE PERFECT
JUMPE B,GFNDUN
PUSHJ P,SETFIL
GFNDUN: MOVE C,GFNDEV
MOVE D,GFNPPN
MOVE E,GFNEXT
MOVE F,GFNFIL
JRST CPOPJ1 ;NOTE: AC A MUST HAVE DELIMITER ON RETURN
SKIPS1: ILDB A,FNBPT ;IT'S A SPACE, SKIP IT
SOSA SPACE ; AND FLAG IT
SKIPSP: SETZM SPACE ;SKIP ANY SPACES HERE AND FLAG
SKIPS2: CAIE A,11 ;TABS ARE SPACES, SORRY PITTS
CAIN A,40
JRST SKIPS1
CAIN A,15 ;IGNORE CR
SKIPN SAFDLM ; UNLESS FOR SAFETY ANSWER
POPJ P,
ILDB A,FNBPT
JRST SKIPS2
LETTS3: ILDB A,FNBPT
SETOM BADSYN
LETTST: SKIPE DOWNFL
JRST LETTS4
CAIE A,"@"
CAIN A,"-" ;UNLESS HYPHEN OR AT,
JRST LETTS3 ; DON'T IGNORE
CAIN A,"_" ;JJW 4/87 Ignore underscores too
JRST LETTS3
CAIL A,"A" ;CHECK FOR ALPHAMERIC
CAILE A,"Z"
JRST LETTS1 ;NOT UC
LETTS0: SUBI A,40 ;OK, MAKE SIXBIT
JRST CPOPJ1 ;TAKE WIN RETURN
LETTS1: CAIL A,"a"
CAILE A,"z"
JRST LETTS2
LETTS5: SUBI A,100 ;MAKE LC INTO SIXBIT
JRST CPOPJ1
LETTS2: CAIL A,"0"
CAILE A,"9"
CAIA
JRST LETTS0
CAIE A,"↓"
POPJ P,
LETTS6: SETCMM DOWNFL
ILDB A,FNBPT
JRST LETTST
LETTS4: CAIN A,"↓"
JRST LETTS6
CAIL A,"a"
CAILE A,"z"
JRST LETTS0
JRST LETTS5
GETSI4: ILDB A,FNBPT
GETSIX: PUSHJ P,SKIPSP ;GET SIXBIT TOKEN
ANCHR6: MOVE C,[POINT 6,B] ;HO HUM
MOVEI B,0
GETSI1: PUSHJ P,LETTST ;CHECK FOR OK CHAR
JRST GETSI2 ;NOPE, MAYBE *
TRNN B,77 ;IGNORE OVERRUN
IDPB A,C
SETOM SAFDLM ;NO MORE NON-FN RESPONSES
ILDB A,FNBPT
JRST GETSI1
GETSI2: JUMPN B,CPOPJ ;CAN'T BE WILDCARD IF ALREADY GOT SOME
SKIPN ITSFLG
JRST GETSI3 ;ABSORB BROKETS FOR ITS ONLY
CAIE A,"<"
CAIN A,">"
JRST GETSI4 ;COMPLETELY IGNORE THE BROKET
GETSI3: SKIPN NOWILD ;NO WILDCARD FOR MLFL
CAIE A,"*"
POPJ P,
MOVSI B,'* ' ;* ONLY OK BY ITSELF
ILDB A,FNBPT ; SO WE LET UPLEVEL WORRY ABOUT WHAT'S NEXT
POPJ P,
;⊗ OPRINT OPRINN DPRINT DPRINN DPRIN0 DPRIN1 DPRIN2 DPRIN3 DPRIN4 SIZE NCHRS RADIX
; Dprint: print in decimal the number in accumulator T,
; DESTROYING BOTH T AND T+1.
;DPRINN ROUTINE: SAME AS DPRINT, EXCEPT PRINTS NUMBER IN A FIELD OF
; C(T+1) POSITIONS, WITH LEADING SPACES IF NECESSARY.
; C(T+1) IGNORED IF IT IS TOO SMALL.
;NOT REENTRANT.
OPRINT: SETZ T+1,
OPRINN: MOVNM T+1,SIZE
MOVEI T+1,=8
JRST DPRIN0
DPRINT: SETZ T+1,
DPRINN: MOVNM T+1,SIZE
MOVEI T+1,=10
DPRIN0: MOVEM T+1,RADIX
SETOM NCHRS
DPRIN1: IDIV T,RADIX
HRLM T+1,(P) ;SAVE REMAINDER
JUMPE T,DPRIN3 ;JUMP IF ALL DIGITS ARE FORMED
SOS NCHRS ;BUMP COUNT OF DIGITS
PUSHJ P,DPRIN1 ;GO COMPUTE NEXT DIGIT
DPRIN2: HLRZ T,(P) ;GET NEXT DIGIT TO PRINT
ADDI T,60 ;CONVERT TO ASCII
OUTCHR T ;TYPE IT
POPJ P, ;RETURN TO DPRIN2 OR CALLING ROUTINE
DPRIN3: SKIPN T,SIZE ;DEFAULT FIELD SIZE?
JRST DPRIN2 ; YES
DPRIN4: CAML T,NCHRS ;MORE POSITIONS THAN CHARACTERS?
JRST DPRIN2 ; NO
OUTCHR [40] ;TYPE SPACE
AOJA T,DPRIN4
SIZE: 0
NCHRS: 0
RADIX: 0
;WAITS/ASCII translation ;⊗ PTOASC PTOSAI PFRASC PFRSAI ASCTAB
;Conversion between WAITS and ASCII characters is done by using the character
;as an index into a =128-word table. Four bytes are stored in each word: the
;translations for normal ASCII mode and for SAIL mode, in both directions. The
;following byte pointers do the indexing. (Make sure the byte in A (or AC1,
;which is the same) is in range before indexing!)
PTOASC: POINT 7,ASCTAB(A),8 ;Convert WAITS to ASCII
PTOSAI: POINT 7,ASCTAB(A),17 ;Convert WAITS to ASCII, in SAIL mode
PFRASC: POINT 7,ASCTAB(A),26 ;Convert ASCII to WAITS
PFRSAI: POINT 7,ASCTAB(A),35 ;Convert ASCII to WAITS, in SAIL mode
DEFINE NOTRAN(I)<BYTE (9)I,I,I,I>
ASCTAB:
FOR I←0,27<
NOTRAN(I)
>;FOR
BYTE(9)137,30,137,30
NOTRAN(31)
BYTE(9)176,176,33,33
BYTE(9)32,32,175,175
FOR I←34,136<
NOTRAN(I)
>;FOR
BYTE(9)30,137,30,137
FOR I←140,174<
NOTRAN(I)
>;FOR
BYTE(9)33,33,176,176
BYTE(9)175,175,32,32
NOTRAN(177)
;FTP local HELP command ;⊗ LHELP LHELP1 LHELP2 LHELP3 LHNCOL LHLIST LHLI1 LHLI2 LHLI3 LHLI4 H.TTTT H.ACCT H.ALIA H.APPE H.ASCI H.BYE H.BYTE H.CWD H.DEBG H.DEBU H.DELE H.DIRE H.DISC H.GET H.HELP H.IMAG H.LIST H.LOCA H.LOGI H.LPPN H.RPPN H.NLST H.NOOP H.NOPO H.PASS H.PICK H.PORT H.PUT H.PWD H.QUIT H.QUOT H.RENA H.RNFR H.RNTO H.RETR H.RHEL H.SAIL H.SEND H.STAT H.STOR H.SYST H.TTY H.TYPE H.USER H.XCWD H.XIND HLPTAB HLPNUM HLPDSP
;Scan possible command-line argument and type out useful help message.
LHELP: SKIPE NOPARM ;Any parameters to scan?
JRST LHLIST ;No, list local help topics
SETZ B,
MOVE C,[POINT 6,B]
LHELP1: PUSHJ P,GETCAP ;A ← char from TTY
CAIN A,15
JRST LHELP1
CAIE A,12
CAIN A,175
JRST LHELP2
SUBI A,40 ;Convert to sixbit
TRNN B,77
IDPB A,C
JRST LHELP1
LHELP2: MOVSI A,-HLPNUM
LHELP3: MOVE C,B
XOR C,HLPTAB(A) ;Check for match
TDNE C,[777777,,770000] ;in first 4 chars
AOBJN A,LHELP3
JUMPL A,@HLPDSP(A)
OUTSTR [ASCIZ/Sorry, no help available for that topic. Type HELP<return> for a list of
topics.
/]
POPJ P,
;List local help topics in a nice multi-column format (8 columns).
LHNCOL←←=8 ;Number of columns
LHLIST: OUTSTR [ASCIZ/All FTP commands can be abbreviated to their first four letters. Full
documentation is available in the Monitor Command Manual. (Type READ
MONCOM to the monitor to read it online.) Type HELP followed by any of
the following for a short description:
/]
MOVEI A,HLPNUM ;Number of topics
IDIVI A,LHNCOL
PUSH P,A ;Number of rows in short columns
PUSH P,B ;Number of long columns
MOVEI E,HLPNUM ;Total number of topics
MOVEI C,0 ;C ← row number
PUSH P,C
LHLI1: MOVEI D,0 ;D ← column number
LHLI2: SOJL E,LHLI4 ;Exit loop when all done
OUTCHR [11] ;Tab to next column
MOVE B,HLPTAB(C) ;Name of a topic
PUSHJ P,TYPSIX
CAIL D,LHNCOL-1 ;Last column?
JRST LHLI3 ;Yes
ADD C,-2(P) ;Point to next topic assuming short column
CAMGE D,-1(P) ;Is this a long column?
ADDI C,1 ;Yes
AOJA D,LHLI2
LHLI3: OUTSTR [ASCIZ/
/]
AOS C,(P) ;Advance to next row
JRST LHLI1
LHLI4: SKIPE D
OUTSTR [ASCIZ/
/]
ADJSP P,-3 ;Flush stack
POPJ P,
;List of help topics. Must be distinct in first 4 letters, since "H." is
;prepended to form dispatch address.
DEFINE HELPS<
H ACCT
H ALIAS
H APPEND
H ASCII
H BYE
H BYTE
H CD
H CWD
H DEBG
H DEBUG
H DELETE
H DIRECT
H DISCON
H GET
H HELP
H IMAGE
H LIST
H LOCAL
H LOGIN
H LPPN
H NLST
H NOOP
H NOPORT
H PASS
H PICKUP
H PORT
H PUT
H PWD
H QUIT
H QUOTE
H RENAME
H RETR
H RHELP
H RNFR
H RNTO
H RPPN
H SAIL
H SEND
H STAT
H STOR
H SYST
H TTY
H TYPE
H USER
H XCWD
H XIND
>;DEFINE HELPS
;The following is used as part of several help messages below.
H.TTTT: OUTSTR [ASCIZ/Type HELP TYPE for more information about transfer types.
/]
POPJ P,
H.ACCT: OUTSTR [ASCIZ\The ACCT command sends an account name to the remote host. Some hosts may
require this for billing/accounting purposes. The format of the command is
ACCT x
where x is an account name or number.
\]
POPJ P,
H.ALIA: OUTSTR [ASCIZ/The ALIAS command is a synonym for CWD.
/]
JRST H.CWD
H.APPE: OUTSTR [ASCIZ/The APPEND command appends a local file to the end of an exising remote
file. The format of the command is
APPE x→y (or APPE x=y)
where x is the local file and y is the remote file. (There is no command
to append in the other direction.)
/]
POPJ P,
H.ASCI: OUTSTR [ASCIZ/The ASCII command is a synonym for TYPE A, used for transferring text
files between WAITS and non-WAITS hosts. The WAITS character set is
converted to the standard ASCII character set. The SAIL command is
similar, except that the characters "_" and "←" are not interchanged.
/]
JRST H.TTTT
H.BYE: OUTSTR [ASCIZ/The BYE command terminates the connection with the remote host.
/]
POPJ P,
H.BYTE: OUTSTR [ASCIZ/The BYTE command is a synonym for TYPE L, used to set the byte size for a
file transfer. E.g., BYTE 8 is the same as TYPE L 8.
/]
JRST H.TTTT
H.CD: OUTSTR [ASCIZ/The CD command is a synonym for CWD.
/]
JRST H.CWD
H.CWD: OUTSTR [ASCIZ/The CWD command (Change Working Directory) is used to change the default
directory for files on the remote host. The format of the command is
CWD x
where x is a directory name.
/]
POPJ P,
H.DEBG:
H.DEBU: OUTSTR [ASCIZ/The DEBUG command (also spelled DEBG) causes FTP to type out all of the
protocol commands sent and responses received from the remote host.
/]
POPJ P,
H.DELE: OUTSTR [ASCIZ/The DELETE command deletes a file at the remote host. The format of the
command is
DELETE x
where x is a filename.
/]
POPJ P,
H.DIRE: OUTSTR [ASCIZ/The DIRECTory command is a synonym for LIST.
/]
JRST H.LIST
H.DISC: OUTSTR [ASCIZ/The DISCONnect command is a synonym for BYE.
/]
JRST H.BYE
H.GET: OUTSTR [ASCIZ/The GET command is a synonym for RETR.
/]
JRST H.RETR
H.HELP: OUTSTR [ASCIZ/The HELP command prints information about FTP. Type HELP<return> for a
list of topics. The RHELP command gets help from the remote host.
/]
POPJ P,
H.IMAG: OUTSTR [ASCIZ/The IMAGE command is a synonym for TYPE I, and causes files to be
transferred as a continuous stream of bits.
/]
JRST H.TTTT
H.LIST: OUTSTR [ASCIZ/The LIST command lists a directory on the remote host. The format of the
command is
LIST y
to type the listing on your terminal, or
LIST x←y (or LIST x=y)
to output the listing to the local file x. y is a remote pathname.
/]
POPJ P,
H.LOCA: OUTSTR [ASCIZ/The LOCAL command is a synonym for TYPE L, and sets the byte size for a
file transfer. E.g., LOCAL 8 is the same as TYPE L 8.
/]
JRST H.TTTT
H.LOGI: OUTSTR [ASCIZ/The LOGIN command is a synonym for USER.
/]
JRST H.USER
H.LPPN:
H.RPPN: OUTSTR [ASCIZ/The LPPN command selects local PPN mode. In a RETR or STOR command with
only one pathname, any part of the name between "[" and "]" will not be
sent to the remote host, but will be considered part of the local
filename.
The RPPN command selects remote PPN mode. In a RETR or STOR command with
only one pathname, any part of the name between "[" and "]" will be sent
to the remote host, and will not be considered part of the local filename.
Your login or alias PPN will be used in the local filename.
Remote PPN mode is the default when FTP is started.
/]
POPJ P,
H.NLST: OUTSTR [ASCIZ/The NLST command is like LIST, but the listing returned is guaranteed to
have no extraneous information, just one pathname per line. The format of
the command is
NLST y
to type the listing on your terminal, or
NLST x←y (or NLST x=y)
to output the listing to the local file x. y is a remote pathname.
/]
POPJ P,
H.NOOP: OUTSTR [ASCIZ/The NOOP command performs no operation, but simply asks the remote host
to acknowledge with a response.
/]
POPJ P,
H.NOPO: OUTSTR [ASCIZ/The NOPORT command disables the use of separate data ports for each file
transfer. You should not normally need to do this, unless the remote host
does not implement the PORT command.
/]
POPJ P,
H.PASS: OUTSTR [ASCIZ/The PASS command lets you give a password to the remote host. Usually you
are asked for a password when you log in with the USER command, but if not
you can type
PASS <return>
and you will then be asked to type the password.
/]
POPJ P,
H.PICK: OUTSTR [ASCIZ/The PICKUP command is used to resume an interrupted file transfer. Type
PICKUP x
where x is the name of the local file for which the transfer should resume,
and then repeat the RETR or STOR command that was interrupted.
/]
POPJ P,
H.PORT: OUTSTR [ASCIZ/The PORT command enables the use of separate data ports for each file
transfer. This is the default, but can be disabled with the NOPORT
command.
/]
POPJ P,
H.PUT: OUTSTR [ASCIZ/The PUT command is a synonym for STOR.
/]
JRST H.STOR
H.PWD: OUTSTR [ASCIZ/The PWD (Print Working Directory) command asks the remote host to return
the name of the current working directory.
/]
POPJ P,
H.QUIT: OUTSTR [ASCIZ/The QUIT command is a synonym for BYE.
/]
JRST H.BYE
H.QUOT: OUTSTR [ASCIZ/The QUOTE command sends an uninterpreted FTP command string to the remote
host. You should know the FTP protocol to use this command. Note that
this does not work for commands that require a data connection, because
the local FTP is not being told to open a data connection.
/]
POPJ P,
H.RENA:
H.RNFR:
H.RNTO: OUTSTR [ASCIZ/To rename a file on the remote host, first type
RNFR x
where x is the old pathname, and then type
RNTO y
where y is the new pathname. Some hosts accept * for wildcard pathnames
in these commands.
/]
POPJ P,
H.RETR: OUTSTR [ASCIZ/The RETR command retrieves a file from the remote host. The format of the
command is
RETR x←y (or RETR x=y)
where x is the local filename and y is the remote filename. You can type just
RETR y
and the local file name will be constructed from the remote filename.
/]
POPJ P,
H.RHEL: OUTSTR [ASCIZ/The RHELP command asks the remote host for information about the commands
it accepts, and types the reply on your terminal.
/]
POPJ P,
H.SAIL: OUTSTR [ASCIZ\The SAIL command is a synonym for TYPE S, used for transferring certain
text files between WAITS and non-WAITS hosts. It differs from the ASCII
command only in that the characters "_" and "←" are not interchanged.
This is necessary for programs written in SAIL and FAIL, and for some
other files.
\]
JRST H.TTTT
H.SEND: OUTSTR [ASCIZ/The SEND command is a synonym for STOR.
/]
JRST H.STOR
H.STAT: OUTSTR [ASCIZ/The STAT command with no argument asks the remote host to send back
information describing the current status of the FTP connection. The form
STAT x
where x is a directory name, lists that directory.
/]
POPJ P,
H.STOR: OUTSTR [ASCIZ/The STOR command stores a file onto the remote host. The format of the
command is
STOR x→y (or STOR x=y)
where x is the local filename and y is the remote filename. You can type just
STOR x
and the remote file name will be constructed from the local filename.
/]
POPJ P,
H.SYST: OUTSTR [ASCIZ/The SYST command asks the remote host to type out the name of its
operating system.
/]
POPJ P,
H.TTY: OUTSTR [ASCIZ/The TTY command retrieves a remote file and types it on your terminal
instead of storing it into a local file. The format of the command is
TTY x
where x is a remote filename.
/]
POPJ P,
H.TYPE: OUTSTR [ASCIZ/The TYPE command tells FTP and the remote host what type of
file you want to transfer. The allowable types are
TYPE A - Ascii
TYPE S - SAIL
TYPE I - Image
TYPE L n - Local byte size n (n is a decimal number)
TYPE X - Treated as TYPE L locally, but tells the remote host TYPE I
If your file contains text, including input to TeX, Metafont, or Web, then
TYPE A is generally correct. However, if it contains a program written in
SAIL or FAIL, which should not have the "_" and "←" characters interchanged,
then you should use TYPE S.
If your file contains 8-bit binary data, such as a Press, imPress or DVI
file, use TYPE L 8. Only use TYPE I or TYPE L 36 if the remote host is a
36-bit machine, or if your real intention is to send a bit stream of data.
See the Monitor Command Manual Appendix on FTP for further information.
/]
POPJ P,
H.USER: OUTSTR [ASCIZ/The USER command identifies you to the remote host. The format of the
command is
USER x
where x is your user name on the remote host. If a password is required,
you will be asked to type it.
/]
POPJ P,
H.XCWD: OUTSTR [ASCIZ/The XCWD command is a synonym for the CWD command.
/]
JRST H.CWD
H.XIND: OUTSTR [ASCIZ/The XIND command is used to read an "indirect file" of FTP commands. The
format of the command is
XIND x
where x is a local filename. The file x is read and the commands in it are
processed.
/]
POPJ P,
DEFINE H(TOPIC)<SIXBIT/TOPIC/>
HLPTAB: HELPS
HLPNUM←←.-HLPTAB
DEFINE H ' (TOPIC)<H.'TOPIC>
HLPDSP: HELPS
;SYSTEM STARTUP CODE ;⊗ SYSINI SYSINH SYSIN1 HAIRSP HAIRT HAIRA HAIRSW HAIRQ HAIRR HAIRL HAIRX HAIRIN HAIRIM NOHAIR SYSIN0 SYSRST SYSSIX SYSSX1 SYSSX2 SYSSX3 SYSSXE
SYSINI: SETOM HAIRY ;BH 11/27/77 ASSUME HAIRY FTP COMMAND
SETZM HASCII
SETZM AUTOLF ;NOT /Q
SETZM AUTOAL ;no auto abort if file already exists, yet
SETZM LPPNON ;DAMNIT I HATE LPPN! -- MRC
SETZM TYPESW# ;NOT FTP/T
SYSINH: SETOM SYSMOD ;ASSUME STARTED IN SYSTEM MODE
RESCAN RSCCNT ;RESCAN AND SAVE COUNT
PUSHJ P,SYSSIX
JUMPE AC1,SYSIN0
repeat 0,<
AND AC2,['FTP ']
CAME AC1,AC2 ;WAS IT SYSTEM FTP COMMAND?
JRST SYSIN0 ;NO
>;repeat 0
repeat 0,< ;JJW 9/86
CAME AC1,['FTP '] ;Was it FTP command?
CAMN AC1,['TEST '] ;Or TEST command?
CAIA
JRST SYSIN0 ;No
>;repeat 0
repeat 1,< ;JJW 1/87
XOR AC1,['FTP ']
TDNN AC1,AC2 ;Was it FTP command?
JRST SYSIN1 ;Yes
XOR AC1,['FTP '≠'TEST ']
TDNE AC1,AC2 ;Was it TEST command?
JRST SYSIN0 ;No
>;repeat 1
SYSIN1: SKIPN HAIRY
POPJ P, ;SECOND TIME THROUGH, NOT HAIRY
MOVE AC1,[POINT 7,HAIRBF]
MOVEM AC1,HAIRBP ;BH
HAIRSP: CAIE AC4,40 ;SKIP SPACES
CAIN AC4,11
JRST HAIRSW
CAIE AC4,"/" ;MAYBE /A SWITCH?
JRST HAIRIM
READW(AC4)
CAIE AC4,"A"
CAIN AC4,"a"
JRST HAIRA
CAIE AC4,"R"
CAIN AC4,"r"
JRST HAIRR
CAIE AC4,"L"
CAIN AC4,"l"
JRST HAIRL
CAIE AC4,"T"
CAIN AC4,"t"
JRST HAIRT
CAIE AC4,"Q"
CAIN AC4,"q"
JRST HAIRQ
CAIE AC4,"X"
CAIN AC4,"x"
JRST HAIRX
CAIE AC4,"D" ;dammit BH, can't you have switches and commands
CAIN AC4,"d" ;people would think of?
JRST HAIRX
OUTSTR [ASCIZ /Bad switch
/]
JRST SYSIN0 ;FLUSH
HAIRT: SETOM TYPESW ;/T, O/P TO TTY IN ASCII MODE
HAIRA: SETOM HASCII
HAIRSW: READW(AC4)
JRST HAIRSP
HAIRQ: SETOM AUTOLF ;/Q, DON'T ASK FOR OVERWRITE CONFIRMATION
JRST HAIRSW
HAIRR: SETZM LPPNON ;/R, RPPN MODE
JRST HAIRSW
HAIRL: SETOM LPPNON ;/L, LPPN MODE
JRST HAIRSW
HAIRX: SETOM CIDEBG ;/X, TYPE OUT ALL IMP INPUT FOR DEBUGGING
JRST HAIRSW
HAIRIN: READW (AC4) ;BH 11/27/77 READ POSSIBLE HAIRY MIT-STYLE CMD
HAIRIM: IDPB AC4,HAIRBP
CAIN AC4,"{" ;} BEGINNING OF HAIRY HOST SPEC?
POPJ P, ;YES, DONE FOR NOW
CAIE AC4,12 ;NO, EOL?
CAIN AC4,175
JRST NOHAIR ;YES, NOT A HAIRY CMD
JRST HAIRIN ;NO, CONTINUE
NOHAIR: SETZM HAIRY ;NOT HAIRY
SETZM HASCII
SETZM AUTOLF
SETZM AUTOAL ;no auto abort if file already exists, yet
JRST SYSINH ;SO TRY AGAIN
SYSIN0: SETZM SYSMOD
SETZM HAIRY
SETZM AUTOLF
SETZM AUTOAL ;no auto abort if file already exists, yet
SYSRST: SKIPG RSCCNT
POPJ P,
READS(AC1,<JRST [SETZM RSCCNT
POPJ P,]
>)
JRST SYSRST
SYSSIX: MOVE AC3,[POINT 6,AC1]
SETZ AC1,
SETO AC2,
SYSSX1: READW(AC4)
CAIE AC4,40
CAIN AC4,11
JRST SYSSX1 ;SKIP LEADING SPACES AND TABS
SYSSX2: CAIN AC4,15
JRST SYSSX3
CAIL AC4,"a"
CAILE AC4,"z"
CAIA
SUBI AC4,40
CAIL AC4,"A"
CAILE AC4,"Z" ;JUST LETTERS IS GOOD ENOUGH FOR THIS
JRST SYSSXE ; quit on non-letter
SUBI AC4,40 ; make into sixbit
TLNE AC3,770000
IDPB AC4,AC3
LSH AC2,-6
SYSSX3: READW(AC4)
JRST SYSSX2
SYSSXE: SETCA AC2,
POPJ P,
END START