perm filename FTPSER.FAI[S,NET]21 blob
sn#828970 filedate 1986-11-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00039 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00010 00002 TITLE FTPSER History FLG A B C D E F T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF HOSTNO FDHOST CONECB CNIBTS OURSTR HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD MFRBUF DSKIBF DSKOBF MFDIBF OLDIBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY VERBOSE IVERBOSE SILENT DOMODE DIMODE DOTYPE DITYPE SAILFL IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .PASS UFDC MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL QUOTEF LEFTF CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS
C00026 00003 Definitions of a "global" nature UFDN ERRBTS RFCS RFCR CLSS CLSR RFC CLS STLOC LSLOC WFLOC BSLOC FSLOC HNLOC INTINP INTIMS INTINS INTCLK
C00029 00004 Initial control link connection establishment ICP ICPCHK ICPX ICPX1 ICPTO KFLAG ICPGTO ICPSTO
C00032 00005 Initializa data link connection IDCON IDCON1 IDCONZ IDCONI IDCNFI IDCNFO IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCNY1 IDCONS IDCONB IDCONP IDCOND IDCONF
C00037 00006 Initialize local data device ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
C00049 00007 Main program starts here START %SITE% REGO
C00054 00008 Main loop of FTPSER LOOP SCHEK STATUS
C00056 00009 Accumulator save, restore routines, also clock turning-on routine SAVACX SAVACS GETACS
C00058 00010 Dispatch routines CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
C00061 00011 CI routine - Read commands from control link, send answers, etc. CIROUT COMDIS BADCOM
C00062 00012 Receive a file APPE STOR WAITIL GETSET GETSE1 GETSEL C2 STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRFN ERRFN1
C00071 00013 Zap local files RNFR DELE GCRNTO RENFIL RNMOK RELFMP RNTO BADTO BDTONM BADDRN ALLO NOOP
C00074 00014 WRTSTR WRTST1 WRTST2 HELP SYST
C00076 00015 GETMFD MFDIN MFDIN1 MOPEN MBUF MFDNAM NOMFD VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
C00083 00016 Send directory status NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STNUFD LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
C00093 00017 Send a file RETR RETRX0 ASCERR
C00095 00018 WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEL MODE MODEUN MODEOK STRU
C00099 00019 PORT PORT2 PORT3 DECIN DECIN0
C00102 00020 USER, PASS routines PASS NOPRVS WRONGP GIVUSR MUSTLG USEROK PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE PWD
C00109 00021 Command String reader GETCOM GETCO1 FLUSCS FLCS1 GETCO2
C00112 00022 Convert command string to index GETIDX ANAMES NNAMES
C00113 00023 Send ASCII character out on IMP control connection PUTCHR PUTBUF PUTBU2 PUTBU2 PUTBU3
C00117 00024 Get ASCII character from IMP control connection GETCHR RGETCH GETCH1 GETCH6 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
C00121 00025 Routines to output ASCII information on control channel GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
C00124 00026 Another routine to output ASCII string to IMP control channel DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH
C00127 00027 SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
C00130 00028 Get file name GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL
C00135 00029 DI routine - Get data from IMP, store in WAITS file system DIROUT DIROU1 DIROU2 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOF1 DIFINI DIEOML DIERR3 PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
C00144 00030 Get data byte from IMP data connection GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
C00147 00031 Get data from local file system, transmit to IMP DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR DOERRC OCONER
C00151 00032 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
C00157 00033 NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00160 00034 Interrupt level routine ILEVEL DNTSAY timout SXACTV LOOK
C00162 00035 Host name magic using NETWRK GETHNM COPYUS GOTUS CPYHST CPYDUN HSTTAB HSTSIX ERRTNS WHYWHY
C00164 00036 Miscellaneous error messages QUIT BYE BYE1 BYE2 ERRKIL QUITX QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
C00170 00037 WAITS/ASCII translation PTOASC PTOSAI PFRASC PFRSAI ASCTAB
C00172 00038 Site-specific commands SITE
C00173 00039 Unimplemented commands REIN PASV REST CDUP SMNT STOU RMD MKD IABORT
C00174 ENDMK
C⊗;
TITLE FTPSER ;⊗ History FLG A B C D E F T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF HOSTNO FDHOST CONECB CNIBTS OURSTR HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD MFRBUF DSKIBF DSKOBF MFDIBF OLDIBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY VERBOSE IVERBOSE SILENT DOMODE DIMODE DOTYPE DITYPE SAILFL IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC PATCH IMP DIMP DOMP FIMP FOMP .MFD .PASS UFDC MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL QUOTEF LEFTF CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS
COMMENT ⊗ History (please record changes):
TCP server for the File Transfer Protocol, as defined in RFC 959. This
program was originally written for NCP/FTP, then converted for TCP/FTP, so
there may still be places where we don't adhere to the protocol exactly.
FTPSER used to be used to receive mail, but this is now done by SMTPSR.
Most of the FTPSER code to deal with mail has been removed.
24 Jan 83 ME Made FTPSER translate WAITS 33 ↔ ASCII 32 (not-equals), making
character set translation reversible.
13 Feb 83 ME To-string saved and inserted in mail for debugging returned mail.
26 Apr 83 ME,JJW IP/TCP code under FTIP.
06 May 83 ME Fix to set FDSS correctly (fixing typo), to allow STOR to work.
Also implemented NOOP, fixed ALLO, flushed BYTE.
17 May 83 JJW Fix to convert IP addresses to/from HOSTS2 format.
14 May 83 ME Added PORT command, fixed some reply codes for TCP/FTP,
fixed bug at STATDO going to DOERR with data on stack.
15 May 83 ME Fixed ICONER and OCONER to clear HOLDIL since transfer is
aborted at that point.
11 Jun 83 ME Conversion to HOSTS3. Also uses dotted host number string
if no known host name for given host number. Allows connection
if from any of our alias host numbers when system down. Uses
exec 355 ptr to our host numbers.
23 Jun 83 ME Turned off "verbose" mode, to speed up I-level.
24 Jun 83 ME Fixed ILEVEL's verbose mode output buffer check to be more
conservative to avoid attempt to reschedule at I-level.
01 Jul 83 ME Fixed TYPE L to parse following byte size. All other types
(namely, A and I) assume 8-bit "real" byte size (RBS).
Fixed up response to HELP cmd. Only byte sizes allowed in
TYPE L are 8, 32, and 36; the latter is treated as TYPE I
locally, since it has same meaning with our 36-bit words.
21 Jul 83 JJW Reads WATSIT[S,SYS] to set FTREQL for S1-A.
12 Aug 83 JJW NBUFS different for FTF2 to provide optimal disk buffering.
16 Sep 83 JJW Removed FTHST3 switch and non-HOSTS3 code. Changed failure
return from HSTNUM to call HNUMST in NETWRK.
18 Nov 83 JJW Made password rejection return code 530 instead of 501.
03 Dec 83 JJW Fixed image mode FTP of odd-length files (partial byte at EOF).
22 Jan 84 JJW Recognize commands REIN, PASV, REST, SITE as unimplemented.
24 Jan 84 JJW Removed FTIP switch and all IFE FTIP code. Also removed
%XRCP, FTMSJ, and FTTOS (mail server) code.
12 Feb 84 JJW Made WAITS/ASCII translation use byte ptrs into ASCTAB.
Implemented text mode with SITE TEXT and SITE NOTEXT commands.
14 Feb 84 JJW Fixed some reply codes in STAT command.
Made VERBOSE and IVERBOSE runtime switches rather than assembly.
25 Oct 85 JJW Added new SYST and PWD commands.
02 Nov 85 JJW FTPSER runs with PROPRV so rename can work, rename preserves
file protection and releases FOMP (not DIMP) when done.
08 Sep 86 JJW Updated GETHNM to store our host name for IMPSTH. Cleaned up
some code and removed some useless code.
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.
History: end of comment ⊗
PRINTS /Have you listed your changes at History: on page 2?
/
.INSERT WATSIT[S,SYS] ;See who we are
IFN FTLLL,<FTREQL←←1> ;LLL wants to be paranoid
IFNDEF FTREQL,<FTREQL←←0> ;set nonzero to require login for main stuff
IFN FTREQL,<PRINTS/Will require login for file operations.
/>
IFNDEF FTPSKT,<FTPSKT←←=21> ;Port number for FTP
PRINTS/To put up a new FTPSER, save core image as TCP021.DMP[NET,SYS].
/
EXTERN JOBFF,JOBSA
; ACCUMULATOR DEFINITIONS:
FLG← 0 ;High order bit for EOF from MAIL command, see below
↓A← 1 ;TEMP
↓B← 2 ;TEMP
C← 3
D← 4
E← 5
F← 6
;; FLG2← 7 ;USED TO INSERT INITIAL SPACES IN MLFL LINES
;; MBP← 10 ;USED FOR MAIL "FROM" LINE FINDER
;; MCH← 11 ;DITTO
T← 13
↓T1← 14
↓T2← 15
↓T3← 16
↓P← 17 ;PUSH DOWN LIST
; STORAGE ASSIGNMENTS:
PDLL←← 20 ;PDL LENGTH
PDL: BLOCK PDLL
DIBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM IMP DATA CONNECTION
DOBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO IMP DATA CONNECTION
FOBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM (DSK,MTA,DTA,ETC.)
FIBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO (DSK,MTA,DTA,ETC.)
IBUF: BLOCK 3 ;INPUT CONTROL BUFFER HEADER
OBUF: BLOCK 3 ;OUTPUT CONTROL BUFFER HEADER
HOSTNO: 0 ; foreign host (IP format)
FDHOST: 0 ; foreign host for data connection, IP format
CONECB: BLOCK 7
CNIBTS: 0 ;INTERRUPT LEVEL ROUTINES PUTS BITS HERE
OURSTR: BLOCK =10 ;our host name gets stuck here
HSTSTR: BLOCK =10 ;HOST STRING
PRIVS: 0 ;SAVE USER'S PRIVILEGES HERE
UFDFIL: 0
SIXBIT/UFD/
0
SIXBIT/ 1 1/
PASMTA: SIXBIT/GODMOD/
15
0
0
PRVMTA: SIXBIT /GODMOD/
14
IOWD 17,PRVBUF
PRVBUF: BLOCK 13
PASWD: 0 ;PASSWORD RETURNED HERE IF INF
PRIVWD: 0 ;PRIVILEGES RETURNED HERE
0 ;LAST LOGIN TIME RETURNED HERE
GRPWD: 0 ;GROUP ACCESS BITS RETURNED HERE
MFRBUF: BLOCK 40 ;FOR "FROM" LINE STORAGE
IFE FTF2,<NBUFS←←11;>NBUFS←←40 ;optimum number of disk buffers (one more than one tk)
;I/O BUFFERS
DSKIBF: BLOCK NBUFS*203 ;A WHOLE TRACK'S WORTH FOR THE MAIN DISK CHANNELS
DSKOBF: BLOCK NBUFS*203
MFDIBF: BLOCK 2*203 ;NOT WORTH IT FOR THESE LOW-USE ONES
OLDIBF: BLOCK 2*203
LOURH3←←10 ;number of host numbers to allow for ourselves
OURH3: BLOCK LOURH3 ;our host number(s), copied from system via lowcore 355
; VARIABLE DEFINITONS:
LCSS: 0 ;LOCAL CONTROL SEND SOCKET
LCRS: 0 ;LOCAL CONTROL RECEIVE SOCKET
FCSS: 0 ;FOREIGN CONTROL SEND SOCKET
FCRS: 0 ;FOREIGN CONTROL RECEIVE SOCKET
LDSS: 0 ;LOCAL DATA SEND SOCKET
LDRS: 0 ;LOCAL DATA RECEIVE SOCKET
FDRS: 0 ;FOREIGN DATA RECEIVE SOCKET
FDSS: 0 ;FOREIGN DATA SEND SOCKET
UPPN: SIXBIT/NETGUE/ ;"LOCAL" PPN OF USER FTP
ALIPPN: SIXBIT/NETGUE/ ;ALIAS PPN OF USER FTP
UPRG: 'GUE' ;JUST PRG FROM UPPN (FOR CAME IN ILDDEV)
PPNTMP: 0 ;Save user name here until password is given
PASTRY: 0 ;Number of try user has left to guess password
VERBOSE: 0 ;Non-0 to type various things on TTY
IVERBOSE: 0 ;Non-0 to type at interrupt level
SILENT: 0 ;Hide password from spies running FTPS
DOMODE: 0 ;LEGAL MODES ARE: 0-Stream, 1-Block, 2-Text,
DIMODE: 0 ; 3-Hasp
DOTYPE: 0 ;LEGAL TYPES ARE: 0-Ascii, 1-Image, 2-Local byte,
DITYPE: 0 ; 3-Print file ascii, 4-Ebcdic
SAILFL: 0 ;Non-0 for SAIL mode: don't exchange "_" and "←".
IMODES: 1000 ↔ 1010 ↔ 1010
FMODES: 1000 ↔ 1010 ↔ 1010
DOBS: =8 ;BYTE SIZE, DATA CONNECTION OUT
DIBS: =8 ;BYTE SIZE, DATA CONNECTION IN
DOACTV: 0 ;DATA OUT LINE IS ACTIVE
DIACTV: 0 ;DATA IN LINE IS ACTIVE
XACTV: 0
RTYPE: 0 ;REAL TYPE, LATEST GOTTEN FROM USER
RBS: =8 ;REAL BYTE SIZE, LATEST GOTTEN FROM USER
SCHEKF: 0 ;IF MINUS, IT'S TIME TO CHECK IMP STATUS
OUTINSTR:0 ;FOR DATGEN, WHICH OUTPUT SINK TO WRITE CHARS TO
SYNCH: 0 ;IF +, # OF UNMATCHED DATA MARK CHARS (200)
;IF -, # OF UNMATCHED INS INTERRUPTS
;WHILE -, FLUSH ALL INPUT CHARS EXCEPT DM
DIRFLC: 0 ;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES
PATCH: BLOCK 40 ;patch space
; I/O CHANNEL DEFINITONS
IMP←← 4 ;CONTROL CONNECTIONS
DIMP←← 1 ;DATA IN FROM IMP CHANNEL
DOMP←← 0 ;DATA OUT TO IMP CHANNEL
FIMP←← 3 ;FILE IN (IN FROM IMP, OUT TO DEVICE) CHANNEL
FOMP←← 2 ;FILE OUT (OUT TO IMP, IN FROM DEVICE) CHANNEL
; NOTE: DIMP,FIMP ARE USED TOGETHER,
; SIMILARLY, DOMP,FOMP GO TOGETHER
; SOME OF THE ABOVE ARE USED NON-SYMBOLICALLY IN CODE!!!
.MFD←←5 ;READ MFD
;; .OLD←←6 ;READ OLD MAIL FILE
.PASS←←7 ;USED TO CHECK PASSWORD
UFDC←←10 ;USED TO READ UFD FOR ACCESS CHECK
; FLG bits
MEOFBT←← 1B0 ;EOF on MAIL (must be 4.9 bit!)
USREBT←← 1B1 ;User command given, expecting password
PASSBT←← 1B2 ;Password given, OK to STOR, etc.
MFRWIN←← 40000 ;MAIL "FROM" LINE FINDER IS ON THE RIGHT LINE
MFRLUZ←← 20000 ;MAIL "FROM" LINE FINDER IS ON THE WRONG LINE
MFRDUN←← 10000 ;MAIL "FROM" LINE FINDER IS FINISHED READING IT
MFNMF←← 4000 ;MLFLNM IN PROGRESS
LFSEEN←← 2000 ;LF HAS BEEN EATEN IN INCOMING COMMAND LINE
LISTFL←← 1000 ;DO OPERATION IS LIST (OR NLST) AS OPPOSED TO RETR OR STAT
QUOTEF←← 40 ;QUOTED STRING IN PROGRESS
LEFTF←← 20 ;LEFT JUSTIFIED SIXBIT
;ABOVE ARE LH FLAGS
;; .MAIL←← 1 ;MAIL COMMAND LIKE LOCAL MAIL
;; .XSEN←← 2 ;XSEN COMMAND LIKE LOCAL SEND/N
;; .XSEM←← 4 ;XSEM COMMAND LIKE LOCAL SEND/Y
;; .XMAS←← 10 ;XMAS COMMAND LIKE LOCAL SEND/M
;; ;ABOVE ARE RH FLAGS AND MAYN'T BE MOVED
CPOPJ2: AOS (P)
POPJ1: ;I CAN NEVER REMEMBER
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
DEFINE MES(TEXT) <
SKIPE VERBOSE
OUTSTR [ASCIZ ⊗TEXT
⊗] >
DEFINE REPMES(TEXT) <
MOVE E,[POINT 7,[ASCIZ ⊗TEXT
⊗]]
JRST REPMET >
REPMET: PUSHJ P,GSRCI
PUSHJ P,ASCIIE
SOS IMPSTF
JRST FLUSCS
QUANTM←← =60 ;ONE CLOCK "TICK" IS ONE SECOND
;GROUP ACCESS/PRIVILEGE BITS
;None of these symbols are actually used in the code except GROUPS and MASPRV.
;GROUPS is a fullword value but MASPRV must be right half.
REAPRV←←40000
WRTPRV←←20000
MASPRV←←1
SYSPRV←←2
SCYPRV←←4
DECPRV←←10
ACTPRV←←20
CSPPRV←←40
GROUPS←←47 ;ALL OF THE ABOVE.
;Definitions of a "global" nature ;⊗ UFDN ERRBTS RFCS RFCR CLSS CLSR RFC CLS STLOC LSLOC WFLOC BSLOC FSLOC HNLOC INTINP INTIMS INTINS INTCLK
UFDN←←20 ;NUMBER OF WORDS IN A DIRECTORY ENTRY
ERRBTS←←0
DEFINE X(BIT,VAL) <
BIT ← VAL ↔ ERRBTS ← ERRBTS!VAL
>;DEFINE X
X(RSET,400) ; HOST SEND US A RESET
X(HDEAD,2000) ; HOST IS DEAD
X(IODEND,020000); END OF FILE
X(IOBKTL,040000); BLOCK TOO LARGE
X(IODTER,100000); DEVICE ERROR
X(IODERR,200000); DATA ERROR
X(IOIMPM,400000); IMPROPER MODE
RFCS←← 200000 ; RFC SENT
RFCR←← 100000 ; RFC RECEIVED
CLSS←← 040000 ; CLS SENT
CLSR←← 020000 ; CLS RECEIVED
RFC←← RFCS ! RFCR
CLS←← CLSS ! CLSR
STLOC←← 1
LSLOC←← 2
WFLOC←← 3
BSLOC←← 4
FSLOC←← 5
HNLOC←← 6
EXTERNAL JOBCNI,JOBAPR,JOBREL,JOBFF
DEFINE NAMES <
X(RNTO) ;MUST BE INDEX 1 WHEN DEFINED
X(USER)
X(PASS)
X(TYPE)
X(PORT) ;specifies foreign host and port for data connection
X(STRU)
X(MODE)
X(RETR)
X(STOR)
X(APPE)
X(RNFR)
X(DELE)
X(STAT)
X(HELP)
X(CWD)
X(QUIT)
X(NOOP)
X(ABOR)
X(LIST)
X(NLST)
X(ACCT)
X(ALLO)
X(SYST)
X(PWD)
;Experimental commands
X(SITE) ;Site parameters
;Unimplemented commands
X(REIN) ;Reinitialize
X(PASV) ;Passive
X(REST) ;Restart
X(CDUP) ;Change to Parent Directory
X(SMNT) ;Structure mount
X(STOU) ;Store Unique
X(RMD) ;Remove Directory
X(MKD) ;Make Directory
>;NAMES
INTINP←← 000010
INTIMS←← 000020
INTINS←← 000040
INTCLK←← 000200
;OPCODE DEFINITONS:
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
OPDEF PTOCNT [PTYUUO 3,]
;Initial control link connection establishment ;⊗ ICP ICPCHK ICPX ICPX1 ICPTO KFLAG ICPGTO ICPSTO
;THIS ROUTINE ESTABLISHES BOTH CONTROL CONNECTIONS
; TO THE USER FTP, AND SKIP RETURNS. NON-SKIP RETURN
; INDICATES SOME KIND OF FAILURE.
ICP: MTAPE IMP,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
MTAPE IMP,ICPSTO ;SET TIMEOUTS
MOVEI A,1
MOVEM A,CONECB ;Do a LISTEN, not a connect
SETOM CONECB+WFLOC ;Wait for (duplex) connection
SETZM CONECB+FSLOC ;Listen for any foreign port
SETZM CONECB+HNLOC ;Any foreign host will do
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
MOVEI A,10
MOVEM A,CONECB+BSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION OUT
MOVE A,CONECB+FSLOC ;get foreign port number
MOVEM A,FCSS ;new FTP has all foreign port nbrs the same
MOVEM A,FCRS
MOVEM A,FDRS
MOVEM A,FDSS
MOVE 0,CONECB+HNLOC ;get foreign host number (IP format)
MOVEM 0,FDHOST ;remember default host for data connections
MOVEM 0,HOSTNO ;remember whom we're talking to
STATZ IMP,ERRBTS ;TIMEOUT? (OR OTHER RANDOM ERROR)?
JRST ICPTO ; YES
PUSHJ P,ICPCHK
JRST CPOPJ1
ICPCHK: MOVE A,CONECB+STLOC
TRNN A,-1
STATZ IMP,ERRBTS
JRST ICPX
POPJ P,
ICPX: SKIPN VERBOSE
JRST ICPX1
OUTSTR [ASCIZ/⊗Error in control connections: /]
MOVE 0,A ;Error code where MTPERR wants it
PUSHJ P,MTPERR ;Print error message
ICPX1: POP P,A
POPJ P,
ICPTO: ;ICP Time Out
MES (ICP times out)
MOVE A,['KILL-1']
MOVEM A,KFLAG
JRST QUITX
KFLAG: 0
ICPGTO: =16 ↔ 0
ICPSTO: =15 ↔ 0
;Initializa data link connection ;⊗ IDCON IDCON1 IDCONZ IDCONI IDCNFI IDCNFO IDCNQ1 IDCNQ2 IDCONW IDCONC IDCONX IDCONY IDCNY1 IDCONS IDCONB IDCONP IDCOND IDCONF
; THIS ROUTINE WILL INITIALIZE A DATA CONNECTION TO THE USER.
; CALL: MOVEI B,0 ;FOR DATA OUT CONNECTION
; MOVEI B,1 ;FOR DATA IN
; PUSHJ P,IDCON
; ERROR RETURN
; SUCCESS RETURN
IDCON: SKIPN VERBOSE
JRST IDCON1
OUTSTR [ASCIZ /Initializing data link /]
JUMPN B,.+2
OUTSTR [ASCIZ /out/]
JUMPE B,.+2
OUTSTR [ASCIZ /in/]
IDCON1: MOVE A,DOTYPE(B)
MOVE A,IMODES(A)
HRRM A,IDCONI
MOVE A,IDCONB(B)
MOVEM A,IDCONI+2
DPB B,[POINT 4,IDCONI,12]
DPB B,[POINT 4,IDCNFI,12]
DPB B,[POINT 4,IDCNFO,12]
DPB B,[POINT 4,IDCONC,12]
DPB B,[POINT 4,IDCNQ1,12]
DPB B,[POINT 4,IDCNQ2,12]
DPB B,[POINT 4,IDCONW,12]
IDCONZ: DPB B,[POINT 4,IDCONY,12]
IDCONI: INIT 000,000
SIXBIT /IMP/
XWD DOBUF,DIBUF
JRST NOIMP
JUMPE B,IDCNFO
IDCNFI: INBUF 000,0
JRST IDCNQ1
IDCNFO: OUTBUF 000,0
IDCNQ1: MTAPE 000,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
IDCNQ2: MTAPE 000,ICPSTO ;SET TIMEOUTS
CAIN B,1 ;ARE WE RECEIVING DATA?
IDCONW: MTAPE 000,[=13↔1] ; YES, GIVE ALLOCATION
SETZM CONECB
MOVE A,LDSS(B)
MOVEM A,CONECB+LSLOC
MOVE A,FDRS(B)
MOVEM A,CONECB+FSLOC
MOVE A,FDHOST ;get current default host for data connection
MOVEM A,CONECB+HNLOC ;use that as host to connect to for data
MOVE A,DOBS(B)
MOVEM A,CONECB+BSLOC
SETZM CONECB+WFLOC ;DON'T WAIT FOR CONNECTION
SETZM CONECB+STLOC ;clear any previous status bits
IDCONC: MTAPE 000,CONECB ;INITIATE DATA CONNECTION W/ USER
;Connect always waits under IP/TCP, so check what status we've already got
MOVE A,CONECB+STLOC ;get status
TRNN A,77 ;ANY ERROR CODES?
TLNE A,CLS ;ANYBODY CLOSING CONNECTION?
POPJ P, ;yes, quit now
IDCONX: INTOFF ;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY: MTAPE 000,IDCONS ;GET STATUS OF DIMP
INTON
MOVE A,IDCONS+STLOC(B) ;get status
TRNN A,77 ;ANY ERROR CODES?
TLNE A,CLS ;or ANYBODY CLOSING CONNECTION?
POPJ P, ;YES
TLC A,RFC
TLCN A,RFC ;CONNECTION COMPLETE?
JRST IDCONF ; YES, SUCCESS RETURN
SKIPN VERBOSE
JRST IDCNY1
tlne a,200000 ;rfcs?
outchr ["S"]
tlne a,100000 ;rfcr?
outchr ["R"]
IDCNY1: PUSHJ P,@IDCOND(B)
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
IDCONP: POINT 6,DOBUF+1,11
POINT 6,DIBUF+1,11
IDCOND: DOWAIT
DIWAIT
IDCONF: MES (...done)
MOVE A,DOBS(B) ;GET CONNECTION BYTE SIZE
DPB A,IDCONP(B) ;SET BYTE SIZE IN BUFFER HEADER
JRST CPOPJ1
;Initialize local data device ;⊗ ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
;;THIS ROUTINE DOES THE NECESSARY OPEN'S, LOOKUP'S OR ENTER'S REQUIRED
;;SO THAT INPUT OR OUTPUT UUO'S ON THE CHANNELS FIMP, FOMP WILL FUNCTION.
;;NOTE: THE LOCAL DATA DEVICE NEED NOT NECCESSARILY BE THE DISK.
;; CALL: MOVE C,[<DEVICE NAME IN SIXBIT>]
;; MOVE D,[<PPN IN SIXBIT>]
;; MOVE E,[<XWD <FILE EXTENSION IN SIXBIT>,0]
;; MOVE F,[<FILE NAME IN SIXBIT>]
;; MOVEI B,1 (FOR DATA OUT TO IMP, LOCAL LOOKUP)
;; ,5 (FOR STAT, LOCAL LOOKUP, NO DATA TRANSFER)
;; ,2∨6 (FOR DATA IN FROM IMP, LOCAL ENTER)
;; (6 FOR MAIL OR MLFL, COPIES OLD FILE LATER)
;; ,3 (FOR DATA IN FROM IMP, LOCAL UPDATE)
;; ,10 (FOR RNTO OR DELE)
;; ,21 (FOR RNFR, DOES LOOKUP BUT CHECKS WRITE ACCESS)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; SUCCESS RETURN
ILDDEV: SETZM UFDOKF# ;FLAG WHERE -1 MEANS DON'T CHECK UFD PROTECTION
CAIN B,6 ;HERE FROM MAIL OR MLFL?
SETOM UFDOKF ;YES
TRNN D,-1 ;WAS A PROGRAMMER NAME SPECIFIED?
MOVE D,ALIPPN ; NO, USE THE DEFAULT PPN
CAIN B,10
JRST ILDSTT ;DON'T CHANGE STORED FILENAME FOR RNTO OR DELE
MOVEM C,ERRDEV#
MOVEM F,ERRFIL#
HLLZM E,ERREXT#
MOVEM D,ERRPPN#
ILDSTT: TRZ B,4
TLZ FLG,(MEOFBT) ;STAYS 0 EXCEPT FOR MAIL
SKIPE VERBOSE
OUTSTR [ASCIZ /Opening local file system... /]
SETZM ERRTYP# ;THIS WILL INDICATE WHEN ERROR HAPPENS
MOVEM C,ILDD+1 ;store device name for OPEN
MOVE A,DOTYPE
TRNE B,2
MOVE A,DITYPE
MOVE A,FMODES(A)
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;SKIP IF NOT DISK
TRO A,200 ;***** ONLY IF DEVICE IS DISK!!
MOVEM A,ILDD
MOVEI A,2 ;ASSUME RENAME, USE INPUT CHANNEL
TRNE B,10 ;FORGET OPEN STUFF IF RENAMING
JRST DPBIT
MOVE T,B
ANDI T,3
MOVE A,[FOBUF
FIBUF,,0
FIBUF,,FOBUF]-1(T) ;BUFFER STRUCTURE
MOVEM A,ILDD+2
MOVE A,[2↔3↔3]-1(T) ;CHANNELS
DPBIT: DPB A,[POINT 4,ILDDO,12] ;DEPOSIT CHANNEL NUMBERS EVERYWHERE.
DPB A,[POINT 4,ILDDL,12]
DPB A,[POINT 4,ILDDE,12]
DPB A,[POINT 4,ILDDE1,12]
DPB A,[POINT 4,ILDDL1,12]
DPB A,[POINT 4,ILDDUG,12]
DPB A,[POINT 4,ILDL69,12]
DPB A,[POINT 4,ILDE69,12]
DPB A,[POINT 4,ILDDRN,12]
DPB A,[POINT 4,ASSHOL,12] ;YA MISSED ONE!!!
DPB A,[POINT 4,ILDVC1,12]
DPB A,[POINT 4,ILDVC2,12]
HRRM A,ILDVCH
TRNE B,10 ;NO OPEN ON RNTO
JRST NOOPEN ; BECAUSE RNFR DID IT
ILDDO: OPEN 000,ILDD
POPJ P, ;ERROR RETURN, CAN'T OPEN DEVICE
NOOPEN:
AOS ERRTYP
SKIPE VERBOSE
OUTSTR [ASCIZ / OPEN/]
ILDVCH: MOVEI T,000 ;CHANNEL NUMBER
SHOWIT T, ;JJW 2/84 Show it to interested wizards
DEVCHR T,
TLNN T,200000 ;SKIP IF DISK
JRST [AOS ERRTYP↔JRST ACCOK]
ILDVC1: GETSTS 000,T
TRO T,200
ILDVC2: SETSTS 000,(T)
MOVEI T,217
MOVEM T,ILDD
SETZM ILDD+2
OPEN UFDC,ILDD ;CHANNEL FOR UFD LOOKUPS TO CHECK FILE ACCESS
JRST [MES(Access check OPEN failure)↔POPJ P,]
MOVEM D,ILDD ;PREPARE TO LOOKUP UFD
CAMN D,[' 1 1'] ;DON'T ACCESS CHECK MFD IF READING UFD
JRST NOUFDC
HRLZI T,'UFD'
MOVEM T,ILDD+1
SETZM ILDD+2
MOVE T,[' 1 1']
MOVEM T,ILDD+3
LOOKUP UFDC,ILDD
JRST [MES(No UFD for access check)↔POPJ P,]
PUSHJ P,GRPCHK
SKIPE UFDOKF ;DO WE NEED TO CHECK THE UFD PROTECTION?
JRST NOUFDC ;NO
PUSHJ P,ACCCHK ;CHECK ACCESS
JRST [MES(UFD access prohibited)↔POPJ P,]
NOUFDC: MOVEM D,ILDD+3 ;Store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
LOOKUP UFDC,ILDD ;NOW WE CHECK THE ACTUAL FILE
JRST [AOS ERRTYP↔JRST ACCOK]
CAMN D,[' 1 1'] ;IF READING A UFD,
PUSHJ P,GRPCHK ; NOW IS THE TIME FOR GROUP CHECKING
PUSHJ P,ACCCHK ;CHECK FILE ACCESS
JRST [MES(File access prohibited)↔POPJ P,]
MOVE T,ILDD+2 ;Get protection word
MOVEM T,RNPROT# ;Save for possible rename
RELEAS UFDC, ;DONE READING FILE FOR ACCESS CHECK
ACCOK: AOS ERRTYP
MOVEM D,ILDD+3 ;store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
TRNN B,1 ;going to do input?
JRST ILDDET ;no
PUSH P,JOBFF ;RECYCLE BUFFER SPACE
MOVEI T,DSKIBF ;FIXED LOCATION
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDL1 ;use more buffers for disk
ILDL69: INBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDL1: INBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF ;JUST IN CASE SOMEBODY ELSE USES IT
ILDDL: LOOKUP 000,ILDD
JRST [CAIN B,3 ;IF UPDATING, LOOKUP FAILURE IS OK
JRST ILDDE0
MES(LOOKUP failed)
POPJ P, ; OTHERWISE, IT ISN'T
]
ILDDE0: SETZM FOBTSL ;SET UP FOR IMAGE INPUT
MOVEI T,1
LSH T,@DOBS
SUBI T,1
MOVEM T,FOMASK
ILDDET: TRNN B,2
JRST ILDDD ;INPUT ONLY
PUSH P,JOBFF
MOVEI T,DSKOBF
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDE1 ;use more buffers for disk
ILDE69: OUTBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDE1: OUTBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF
MOVEM D,ILDD+3 ;REPLACE ZAPPED PPN
HLLZS ILDD+1 ;DATE75
SETZM ILDD+2
ILDDE: ENTER 000,ILDD
JRST [MES(ENTER failed)↔POPJ P,]
MOVEI T,=36
MOVEM T,FIBTSL
SETZM FIWORD
MOVS T,DIBS
LSH T,6
IOR T,[POINT 0,FIWORD]
MOVEM T,FIBPT
CAIN B,3 ;UPDATE FILE?
ILDDUG: UGETF 000,A ;DOES USETO TO NEXT FREE
ILDDD: MOVE T,DOTYPE
TRNE B,2
MOVE T,DITYPE
XCT ILDSS1(T)
TRNE B,1
DPB T,[POINT 6,FOBUF+1,11]
TRNE B,2
DPB T,[POINT 6,FIBUF+1,11]
TRNN B,10 ;RENAME TIME
JRST ILD123
ILDDRN: HLLZS ILDD+1
;;; SETZM ILDD+2
MOVS T,RNPROT# ;JJW 11/85 Get protection of old file
ANDI T,777000 ;Other bits 0 to preserve time
MOVSM T,ILDD+2
ASSHOL: RENAME 000,ILDD ;DO IT
JRST [MES(RENAME failed)↔POPJ P,]
ILD123: MES ( Done)
JRST CPOPJ1
ILDD: BLOCK 4
ILDSS1: MOVEI T,7 ;TABLE OF BYTE SIZE GOBBLERS BY XFER TYPE
MOVEI T,=36
PUSHJ P,ILDSS2 ;LOCAL, NEED DOBS OR DIBS
ILDSS2: MOVE T,DOBS
TRNE B,2
MOVE T,DIBS
POPJ P,
ACCCHK: MOVE T,ILDD+2 ;GET PROTECTION
TLZ T,600000 ;FLUSH THESE LOSING BITS
SKIPN OWNER ;IF USER HAS GROUP ACCESS PRIVS TO THIS UFD,
CAMN D,UPPN ; OR IF FILE PPN IS USER'S PPN,
JRST OWNACC ; USE OWNER ACCESS
LSH T,3 ;ELSE EITHER LOCAL OR GUEST ACCESS
TLNN FLG,(PASSBT) ; DEPENDING
LSH T,3
OWNACC: TRNE B,36 ;IF ANYTHING OTHER THAN STRAIGHT READ,
LSH T,1 ; CHECK WRITE ACCESS
TLNN T,200000 ;THE MAGIC BIT SHOULD ALWAYS BE HERE NOW
AOS (P) ;ACCESS OK
POPJ P,
GRPCHK: SETZM OWNER# ;THIS WILL FLAG OWNER ACCESS
AOS ERRTYP ;WE'VE FOUND THE UFD
MTAPE UFDC,PRVMTA ;READ RETRIEVAL
POPJ P, ;CAN'T, NO GROUP ACCESS
SETZM PASWD ;JUST IN CASE WE HAVE INF
MOVE T,GRPWD ;GET FILE ACCESS GROUPS FOR THIS UFD
AND T,[GROUPS] ;JUST THE RIGHT BITS PLEASE
HRRZ A,ILDD ;PRG OF TARGET UFD
CAME A,UPRG ;PRG OF OUR USER
TRZ T,MASPRV ;NOT THE SAME, NO MAS ACCESS
TLO T,REAPRV!WRTPRV ;ALSO ALLOW REA AND WRT ACCESS
TDNE T,PRIVS ;DOES USER HAVE ANY CORRESPONDING PRIVS?
SETOM OWNER ;YES! ALLOW OWNER ACCESS
POPJ P,
;Main program starts here ;⊗ START %SITE% REGO
START: JFCL
RESET
SETOB B,VERBOSE
GETLIN B ;Get our line characteristics
CAMN B,[-1]
SETZM VERBOSE ;Detached, don't type things
MES(FTPSER started)
MOVE [SIXBIT/FTPSER/]
SETNAM
MOVE P,[XWD -PDLL,PDL] ;GET A PUSH DOWN LIST
CLKINT =30*=60*=60
SETZM PRIVS ;PARANOID? ME, PARANOID?
SETZ FLG, ;Zero flags
IFN FTREQL,<
SETZM USEROK ;nonzero indicates login done (can't be flag in FLG)
>;IFN FTREQL
SETZM OURSTR ;clear our own host string
SETZM OURH3 ;clear all our host numbers
MOVE T1,[OURH3,,OURH3+1] ;BLT source,,dest
BLT T1,OURH3+LOURH3-1 ;clear entire array
MOVSI T1,377777
SETPR2 T1, ;peek at system
JRST [ OUTSTR [ASCIZ/?? SETPR2 failed./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
SKIPL T1,400000!355 ;lowcore 355 is aobjn ptr to our HOSTS3 address
JRST [ ;can't tell who we are if no addresses
OUTSTR [ASCIZ /?? No valid host number for us pointed to by exec 355./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
HLRE T2,T1 ;- number of addresses
MOVN T2,T2 ;make positive nbr of host numbers
CAILE T2,LOURH3 ;skip if our table is as at least big as systems
MOVEI T2,LOURH3 ;only store as many as we have room for
MOVSI T3,400000(T1) ;BLT source address -- in system
HRRI T3,OURH3 ;BLT dest -- our table of our host number(s)
BLT T3,OURH3-1(T2) ;copy whole table from system (or what fits)
%SITE%: DETSEG ;flush simulated upper segment (for host table later)
INIT IMP,1
('IMP')
OBUF,,IBUF
JRST NOIMP
MOVEI A,FTPSKT ;listen port
MOVEM A,LCRS ; is used for both send
MOVEM A,LCSS ; and receive of control connection
SUBI A,1 ;port one less
MOVEM A,LDRS ; is used for both send
MOVEM A,LDSS ; and receive of data connection
MOVEI A,ILEVEL ;INTENB USED TO BE AFTER ICP
MOVEM A,JOBAPR ; SO A VERY QUICK CLOSE COULD GO UNNOTICED
MOVSI A,INTINP!INTIMS!INTINS
INTENB A, ;ENABLE FOR IMP INPUT INTERRUPTS
PUSHJ P,ICP ;INITIAL CONNECTION PROTOCOL
JRST ERRKIL
INBUF IMP,2
OUTBUF IMP,2
MOVEI A,=8
DPB A,[POINT 6,IBUF+1,11]
DPB A,[POINT 6,OBUF+1,11]
;dcs: 4-12-73
;Some sites won't send allocation for our control out link until we
; send them some for our control in link. We don't do that (in the NCP)
; until the user program does something to suggest input -- so that
; user-specified allocation, if any, will be used. This test for input
; is sufficient to get our NCP to send allocation.
mtape imp,[=8] ;send them allocation for control conn.
jfcl
PUSHJ P,SAYWHO ;type out name of host we're talking to
PUSHJ P,GREET ;SEND USER OUR GREETING MESSAGE
MOVEM P,SAVPDP#
SETZM SAILFL ;In case we're restarted
REGO: MOVE P,SAVPDP
MOVE A,CIP1
MOVEM A,CIP
MOVE A,DIP1
MOVEM A,DIP
MOVE A,DOP1
MOVEM A,DOP ;BECOMES CLEAR NEED TO
SETZM CIHUNG ; SAVE DATA IN COMMON
SETZM DIHUNG ; AND CLEAR WITH BLT'S!
SETZM DOHUNG
SETZM QUITNG
SETZM DIACTV
SETZM DOACTV
SETZM PRIVS ;PARANOID? ME, PARANOID?
;Main loop of FTPSER ;⊗ LOOP SCHEK STATUS
;; PROGRAM LOOPS UNTIL XACTV IS INCREASED TO ZERO, THEN GOES
;; INTO INTERRUPT WAIT. INTERRUPT-LEVEL MODULE WILL SET XACTV TO
;; A SMALL NEGATIVE INTEGER, AND MAY ALSO SET SCHEKF
LOOP: CLKINT =30*=60*=60
AOSG SCHEKF ;TIME TO CHECK IMP STATUS?
PUSHJ P,SCHEK ; YES
PUSHJ P,CIDISP ;DISPatch to Control Input handler
SKIPE DIACTV ;Data In channel ACTiVe?
PUSHJ P,DIDISP ; YES
SKIPE DOACTV
PUSHJ P,DODISP
INTMSK [0]
AOSLE XACTV ;ANYTHING STILL WANTING ATTENTION?
IMSTW [-1] ; NO, ENABLE INTERRUPTS AND WAIT
INTMSK [-1] ;ENABLE INTERRUPTS IN CASE WE SKIPPED
JRST LOOP
SCHEK: MTAPE IMP,STATUS
MOVE A,STATUS+1
OR A,STATUS+2
TLC A,RFC ;these bits should be on (now off)
TLNN A,RFC!CLS ;CONTROL LINK CLOSING?
POPJ P, ; NO, ALL IS OK
SKIPE VERBOSE
OUTSTR [ASCIZ / Control link closed!/]
JRST ERRKIL
STATUS: 2 ↔ 0 ↔ 0
;Accumulator save, restore routines, also clock turning-on routine ;⊗ 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
;Dispatch routines ;⊗ CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL DIDISP DIREEN DIWAIT DIACS DIP DIP1 DIHUNG DIPDL DODISP DOREEN DOWAIT DOACS DOP DOP1 DOHUNG DOPDL
; CI PREFIX MEANS CONTROL INPUT
; DI PREFIX MEANS DATA INPUT
; DO PREFIX MEANS DATA OUTPUT
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 CI ROUTINE
EXCH P,CIP ;SAVE CI 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 ;RETRIEVE CI PUSHDOWN POINTER
POPJ P, ;AND RETURN WO WAITING CI ROUTINE.
CIWAIT: SETOM CIHUNG ;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
CIWAIX: 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 ;STORAGE FOR CI ACCUMULATOR 20 WHEN CI
CIP1: XWD -20,CIPDL
; ROUTINE IS ACTIVE, MAIN ACC 17 OTHERWISE
CIHUNG: 0 ;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL: BLOCK 20
DIDISP: SKIPE DIHUNG
JRST DIREEN
EXCH P,DIP
PUSHJ P,DIROUT
EXCH P,DIP
SETZM DIHUNG
POPJ P,
DIREEN: PUSHJ P,GETACS
XWD 1,DIACS
EXCH P,DIP
POPJ P,
DIWAIT: SETOM DIHUNG
EXCH P,DIP
PUSH P,[XWD 0,DIACS]
JRST SAVACS
DIACS: BLOCK 17
DIP: XWD -30,DIPDL
DIP1: XWD -30,DIPDL
DIHUNG: 0
DIPDL: BLOCK 30
DODISP: SKIPE DOHUNG
JRST DOREEN
EXCH P,DOP
PUSHJ P,DOROUT
EXCH P,DOP
SETZM DOHUNG
POPJ P,
DOREEN: PUSHJ P,GETACS
XWD 1,DOACS
EXCH P,DOP
POPJ P,
DOWAIT: SETOM DOHUNG
EXCH P,DOP
PUSH P,[XWD 0,DOACS]
JRST SAVACS
DOACS: BLOCK 17
DOP: XWD -30,DOPDL
DOP1: XWD -30,DOPDL
DOHUNG: 0
DOPDL: BLOCK 30
;CI routine - Read commands from control link, send answers, etc. ;⊗ CIROUT COMDIS BADCOM
CIROUT: PUSHJ P,GETCOM ;READ COMMAND FROM IMP
POPJ P, ; IT WAS A BUM COMMAND
PUSHJ P,GETIDX ;C(A) ← # OF COMMAND
PUSHJ P,@COMDIS(A)
JRST SXACTV ;4-28-73 make sure all input is read.
DEFINE X(A) <0+A↔>
COMDIS: BADCOM
NAMES
BADCOM: PUSHJ P,FLUSCS
PUSHJ P,GSRCI ;GET PERMISSION TO OUTPUT ON CONTROL CHANNEL
PUSHJ P,IMPST0
ASCIZ /500 No comprendo "/
PUSHJ P,ASCII1
C
PUSHJ P,IMPST0
ASCIZ /"
/
SOS IMPSTF ;RETURN PERMISSION
JRST FLUSCS
;Receive a file ;⊗ APPE STOR WAITIL GETSET GETSE1 GETSEL C2 STORX3 STORX0 STOR1 RETRX1 STORX1 ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRFN ERRFN1
APPE: SKIPA B,[3] ;APPEND
STOR: MOVEI B,2 ;STORE
PUSHJ P,WAITIL ;WAIT FOR OLD FILENAME, XFERTYPE FREE
MOVEM B,STORTYP# ;SAVE FOR MESSAGE LATER
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
SKIPE DIACTV ;DATA CHANNEL ALREADY IN USE?
JRST STORX0 ; YES
MOVEI B,1
PUSHJ P,GETSET ;SET UP DITYPE, DIBS
JRST ASCERR
PUSHJ P,GFN ;GET FILE NAME
JRST STORX1 ; DIDN'T GET ONE
SETOM HOLDIL ;DON'T LET ANYONE ELSE IN
MOVE B,STORTYP
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR ; FAILED
MOVEM C,DIACS+C ;PASS ON FILE NAME INFORMATION,
MOVEM D,DIACS+D ; ETC. TO THE
MOVEM E,DIACS+E ; DI ROUTINE
MOVEM F,DIACS+F
SETOM DIACTV ;STARTUP DI ROUTINE
JRST FLUSCS ;FLUSH COMMAND STRING & RETURN
WAITIL: SKIPN HOLDIL# ;WAIT FOR HOLDIL FREE
POPJ P, ; WHICH MEANS WE DON'T NEED ERRFIL ETC ANYMORE
PUSHJ P,CIWAIT
JRST WAITIL
;; GETSET SET UP TYPE AND BYTE SIZE FOR TRANSFER
;;CALL: MOVEI B,<0 FOR DO, 1 FOR DI>
;; PUSHJ P,GETSET
;; ERROR RETURN - TYPE A AND NOT BYTE 8
GETSET: MOVE A,RTYPE ;GET TYPE FROM USER
CAIN A,3 ;LOCAL PRINT
MOVEI A,0 ; IS REALLY ASCII
MOVE T,RBS ;ELSE WE GOBBLE REAL BYTE SIZE
CAIE T,=8
JUMPE A,CPOPJ ;jump if TYPE ASCII (and not 8-bit bytes!)
AOS (P)
CAIE A,2 ;skip if TYPE L (local byte)
JRST GETSE1 ;TYPEs A and I always have 8-bit bytes
CAIN T,=36 ;TYPE L 36 is same as Image here
MOVEI A,1 ;make it image mode, with 8-bit bytes
GETSE1: MOVEI T,=8 ;CONSTANT BYTE SIZE FOR ASCII
GETSEL: MOVEM T,DOBS(B) ;SAVE BYTE SIZE
HRRZM A,DOTYPE(B) ; AND TYPE FOR THIS TRANSFER
C2: POPJ P,2
STORX3:
STORX0: PUSHJ P,IMPSTR
ASCIZ /503 You are already STORing!
/
STOR1: JRST FLUSCS ;FLUSH REST OF COMMAND STRING
RETRX1:
STORX1: PUSHJ P,IMPSTR
ASCIZ /501 Pathname unparsable
/
JRST FLUSCS
ILDERR: PUSHJ P,GSRCI ;INTERPRET ILDDEV ERROR FOR LOSER
MOVE F,ERRTYP ;THIS IS THE TYPE OF ERROR
CAIGE F,3 ; UNLESS ERROR WAS FROM LOOKUP ETC
JRST ILDER1 ; IN WHICH CASE WE NEED ERROR CODE
HRRZ C,ILDD+1 ; FROM LOOKUP (ETC) BLOCK
SKIPA D,ERRNM1(C) ;THIS IS THE RESPONSE CODE IN THAT CASE
ILDER1: MOVE D,ERRNUM(F) ;RESPONSE CODE FOR NON-LOOKUP-ETC ERROR
MOVE E,[POINT 7,D]
PUSHJ P,ASCIIE ;PUT OUT CODE
PUSHJ P,STOMES ;PUT OUT TYPE OF OPERATION AND FILE
HRRZ C,ILDD+1 ;RESTORING CLOBBERED AC
MOVE E,[POINT 7,[ASCIZ / failed, /]]
PUSHJ P,ASCIIE
CAIGE F,3 ;DISPATCH ON ERROR AGAIN
SKIPA E,ERRTXT(F)
MOVE E,ERRTX1(C)
PUSHJ P,ASCIIE
MOVE E,[POINT 7,[ASCIZ /
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL ;RELEASE ILDDEV RESOURCE
JRST FLUSCS
STOMES: MOVE D,STORTYP ;FIND OUT WHAT HE WAS DOING
CAIN D,30
MOVEI D,4 ;FILL A BIG HOLE
MOVE E,TYPNAM-1(D) ;GET PTR TO OPERATION NAME
PUSHJ P,ASCIIE
JRST @TYPDSP-1(D) ;PUT OUT FILE NAME OR WHATEVER
ERRNUM: ASCII /450 / ;0 - OPEN FAILED
ASCII /550 / ;1 - UFD LOOKUP FAILED
ASCII /550 / ;2 - ACCESS PROHIBITED
ERRNM1: ASCII /550 / ;0 - NO SUCH FILE
ASCII /550 / ;1 - NO SUCH PPN (CAN'T HAPPEN)
ASCII /550 / ;2 - PROTECTION VIOLATION (CAN'T)
ASCII /450 / ;3 - FILE BUSY
ASCII /450 / ;4 - ALREADY EXISTS (RENAME)
ASCII /451 / ;5 - NO FILE OPEN (CAN'T)
ASCII /451 / ;6 - DIFFERENT FILENAME (R/A, CAN'T)
ASCII /451 / ;7 - CAN'T
ASCII /450 / ;10 - BAD RTVL
ASCII /450 / ;11 - BAD RTVL
ASCII /450 / ;12 - DISK FULL
TYPNAM: POINT 7,[ASCIZ /Retrieve of /]
POINT 7,[ASCIZ /Store of /]
POINT 7,[ASCIZ /Append to /]
POINT 7,[ASCIZ /Rename of /] ;REALLY STORTYP 30
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Mail scratch file open/]
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Delete of /]
ERRTXT: POINT 7,[ASCIZ /can't initialize local device/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
ERRTX1: POINT 7,[ASCIZ /no such file/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
POINT 7,[ASCIZ /file busy/]
POINT 7,[ASCIZ /new filename already exists/]
POINT 7,[ASCIZ /impossible system error (5)/]
POINT 7,[ASCIZ /impossible system error (6)/]
POINT 7,[ASCIZ /impossible system error (7)/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /disk is full/]
TYPDSP: ERRFN ;RETR, WHOLE FILESPEC
ERRFN ;STOR
ERRFN ;APPE
ERRFN ;RENAME
ERRPP ;STAT, FN AS PPN
CPOPJ ;MAIL
ERRFN ;USED FOR START MSG FOR LIST, NLST
ERRFN ;DELE
ERRPP: MOVE D,ERRFIL ;DO FILENAME AS PPN
ERRPP1: TLNN D,-1 ;IF MAIL, MAYBE ONLY PRG
JRST ERRPP2
MOVEI A,"["
PUSHJ P,PUTCHR
HLLZ B,D
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,PUTCHR
ERRPP2: HRLZ B,D
JUMPN B,.+2
MOVEI B,'* ' ;FOR MAIL
PUSHJ P,SIXWRT
TLNN D,-1
POPJ P,
MOVEI A,"]"
JRST PUTCHR
ERRFN: MOVE B,ERRDEV
PUSHJ P,SIXWRT
MOVEI A,":"
PUSHJ P,PUTCHR
MOVE B,ERRFIL
PUSHJ P,SIXWRT
SKIPN B,ERREXT
JRST ERRFN1
MOVEI A,"."
PUSHJ P,PUTCHR
PUSHJ P,SIXWRT
ERRFN1: MOVE D,ERRPPN
JRST ERRPP1
;Zap local files ;⊗ RNFR DELE GCRNTO RENFIL RNMOK RELFMP RNTO BADTO BDTONM BADDRN ALLO NOOP
RNFR: SKIPA B,[30] ;RENAME
DELE: MOVEI B,10 ;DELETE
PUSHJ P,WAITIL
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
MOVEM B,STORTYP ;SAVE WHICH
SKIPE DOACTV
JRST RETRX0
PUSHJ P,GFN ;FIRST OR ONLY FILE
JRST RETRX1
MOVEI B,21 ;20 BIT CHECKS WRITE ACCESS EVEN THO READ OP
PUSHJ P,ILDDEV ;DO THE LOOKUP
JRST ILDERR ; COULDN'T FIND
SETZB E,F
MOVE B,STORTYP ;NOW MUST EITHER DELETE OR RENAME
TRNN B,20 ;RENAME?
JRST RENFIL ;NO, DELETE
PUSHJ P,FLUSCS ;TERMINATE THAT LINE
PUSHJ P,IMPSTR ;REPORT PARTIAL SUCCESS
ASCIZ /350 RNFR OK, Please issue RNTO
/
GCRNTO: PUSHJ P,GETCOM ;NOW GET THE NEXT
JRST RELFMP ;BAD COMMAND, COULDN'T BE RNTO
PUSHJ P,GETIDX
TRNE A,777776 ;NEXT COMMAND MUST BE RNTO, WHOSE
JRST BADTO ; COMMAND INDEX IS 1 (LH JUNK)
PUSHJ P,GFN
JRST BDTONM ;BAD NAME AFTER RNTO
MOVEI B,10 ;ONE MORE TIME
RENFIL: PUSHJ P,ILDDEV ;DELETE (RENAME) THE FILE
JRST BADDRN ; COULDN'T DO THAT
JUMPN F,RNMOK
PUSHJ P,IMPSTR ;OK RESPONSE
ASCIZ /250 File deleted
/
JRST RELFMP
RNMOK: PUSHJ P,IMPSTR ;OK RESPONSE
ASCIZ /250 File renamed
/
RELFMP: RELEASE FOMP, ;CLOSE DOWN
JRST FLUSCS
RNTO:
BADTO: PUSHJ P,IMPSTR
ASCIZ /503 Must have RNTO after RNFR
/
JRST RELFMP
BDTONM: PUSHJ P,IMPSTR
ASCIZ /501 Pathname for rename unparseable
/
JRST RELFMP
BADDRN: RELEAS FOMP,
JRST ILDERR
ALLO: PUSHJ P,IMPSTR
ASCIZ/202 ALLOcations are unnecessary
/
JRST FLUSCS
NOOP: PUSHJ P,IMPSTR
ASCIZ/200 NOOP OK
/
JRST FLUSCS
;⊗ WRTSTR WRTST1 WRTST2 HELP SYST
WRTSTR: HRLI B,(<POINT 7,0>)
WRTST1: ILDB A,B
WRTST2: JUMPE A,CPOPJ
XCT OUTINSTR
JRST WRTST1
HELP: PUSHJ P,IMPSTR
ASCIZ ⊗214-Welcome to sunny California!
Implemented Commands: HELP,USER,PASS,TYPE,MODE,STRU,PORT,SITE,SYST,
RETR,STOR,APPE,DELE,RNFR,RNTO,STAT,LIST,NLST,CWD,QUIT.
MODE S only; STRU F only.
TYPE A implies translation to/from the WAITS character set. Output from WAITS
in TYPE A will discard nulls, E directory pages, and SOS line numbers.
Text files should be FTPed in TYPE A for proper character set conversion.
TYPE L byte size may be 8, 32, or 36. TYPE L 8 and TYPE L 32 use only
bits 0-31 of the 36-bit PDP-10 word.
TYPE I and TYPE L 36 are equivalent at the WAITS end.
SITE SAIL avoids swapping underscore and back-arrow in WAITS/ASCII translation,
for SAIL and FAIL languages and other files that need this.
SITE NOSAIL cancels a SITE SAIL command.
214 Report problems to Bug-FTP @ ⊗
PUSHJ P,IMPSTH ;Output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPCR ;Output crlf
JRST FLUSCS
SYST: PUSHJ P,IMPSTR
ASCIZ/215 WAITS
/
JRST FLUSCS
;⊗ GETMFD MFDIN MFDIN1 MOPEN MBUF MFDNAM NOMFD VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
;Restore MFD reading routine to pre-VALDAT form, fixing [*,*] bugs.
GETMFD: MOVEM C,MOPEN+1
OPEN .MFD,MOPEN ;CHECK DEST LIST AGAINST MFD
POPJ P,
PUSH P,JOBFF
MOVEI T1,MFDIBF
MOVEM T1,JOBFF
INBUF .MFD,2
POP P,JOBFF
MOVE T1,MFDNAM
MOVEM T1,MFDNAM+3
LOOKUP .MFD,MFDNAM
POPJ P,
JRST POPJ1
MFDIN: SOSG MBUF+2 ;READ A WORD FROM MFD
IN .MFD,
JRST MFDIN1
STATO .MFD,20000
JRST NOMFD
POPJ P,
MFDIN1: ILDB T1,MBUF+1
JRST POPJ1
MOPEN: 10
SIXBIT /DSK/
XWD 0,MBUF
MBUF: BLOCK 3
MFDNAM: SIXBIT / 1 1/
SIXBIT /UFD/
0
SIXBIT / 1 1/
NOMFD: REPMES (451 System error, can't read master file directory.)
repeat 0,<
COMMENT ⊗
Modified 8/2/80 by BH, to use VALDAT[RMD,SYS] instead of mfd
for validation. VALDAT's first record is an index into the rest of
the file for USETIing for extra speed; the rest is sorted PRGs from
the mfd. Don't believe any MFDxxx labels, it's really reading VALDAT. ⊗
VALID: SKIPN T1,MLDEST ;ALWAYS OK TO :FILE
JRST VALFIL ; IF THE PPN EXISTS. BH 8/17/80
SKIPE FWDING ;ALWAYS OK IF FORWARDING
JRST VWINS
TLNE T1,-1 ;Cannot mail to prj,prg now
JRST VLDONE ;Nor to prj,*
MOVE T1,[POINT 6,MLDEST,17]
VALCL1: MOVE T2,T1
ILDB T3,T1
JUMPE T3,VALCL1
MOVEM T2,FBPINI
MOVE T2,[PUSHJ P,VSXCHR]
MOVEM T2,FBPXCT
PUSHJ P,TRYFOR
JRST VWINS ;FORWARDING WINS
MOVSI C,'DSK'
PUSHJ P,GETMFD
JRST NOMFD
MFDLP: PUSHJ P,MFDIN ;GET UFD NAME
JRST VTRYFT ;EOF
COMMENT ⊗
MOVE T2,T1
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
MFDLP1: PUSHJ P,MFDIN
JRST VTRYFT
SOSLE DIRFLC
JRST MFDLP1
JUMPE T2,MFDLP ;IGNORE ZERO PPN
MOVE T1,MLDEST
; TLNN T1,-1
HRRZS T2
; TRNN T1,-1
; HLLZS T2
CAME T1,T2
⊗
CAME T1,MLDEST
JRST MFDLP
VWINS: AOS (P)
VLDONE: RELEAS .MFD,
POPJ P,
GETMFD: MOVEM C,MOPEN+1
OPEN .MFD,MOPEN ;CHECK DEST LIST AGAINST MFD
POPJ P,
PUSH P,JOBFF
MOVEI T1,MFDIBF
MOVEM T1,JOBFF
INBUF .MFD,2
POP P,JOBFF
;;; MOVE T1,MFDNAM
MOVE T1,['MAISYS']
MOVEM T1,MFDNAM+3
LOOKUP .MFD,MFDNAM
POPJ P,
INPUT .MFD, ;READ VALDAT INDEX
MOVE T1,MLDEST ;THING TO CHECK IN INDEX
TRNN T1,777700 ;SINGLE-CHAR?
JRST GTM1CH ;YES, START AT BEGINNING OF DATA
MOVEI T2,=27 ;BEGINNING OF 3-CHAR STUFF IN INDEX
TRNN T1,770000 ;TWO-CHAR?
TDZA T2,T2 ;YES, START AT BEGINNING OF INDEX
LSH T1,-6 ;NO, FIRST CHAR IS OVER HERE
LSH T1,-6 ;RIGHT ADJUST FIRST CHAR
SUBI T1,'A'
JUMPGE T1,.+2
MOVNI T1,1 ;ANYTHING BELOW A IS -1
ADDI T2,1(T1) ;FINAL INDEX POSITION
MOVE T1,MBUF+1
IBP T1 ;I FORGET WHAT THE BPT LOOKS LIKE INITIALLY
ADDI T2,(T1) ;THIS IS POINTER TO INDEX WORD IN CORE
USETI .MFD,@(T2)
GTM1CH: SETZM MBUF+2
JRST POPJ1
MFDIN: SOSG MBUF+2 ;READ A WORD FROM MFD
IN .MFD,
JRST MFDIN1
STATO .MFD,20000
JRST NOMFD
POPJ P,
MFDIN1: ILDB T1,MBUF+1
JRST POPJ1
VTRYFT: MOVE T1,MLDEST
TLNE T1,-1 ;IF DEST ISN'T JUST PRG,
JRST VLDONE ;WE'VE HAD IT
JRST TRYFAC ;BUT IF SO GIVE FACT.TXT A CHANCE
MOPEN: 10
SIXBIT /DSK/
XWD 0,MBUF
MBUF: BLOCK 3
COMMENT ⊗
MFDNAM: SIXBIT / 1 1/
SIXBIT /UFD/
0
SIXBIT / 1 1/
⊗
MFDNAM: 'VALDAT'
0
0
SIXBIT /MAISYS/
NOMFD: REPMES (453 System error, can't read master file directory.)
VSXCHR: MOVEI A,0
TLNN F,770000
POPJ P,
ILDB A,F
ADDI A,40
POPJ P,
VALFIL: JUMPE D,CPOPJ ;MAIL TO FILE, MUST BE A PPN
MOVEM D,VALFPP ;SAVE FOR LOOKUP
MOVE T1,[' 1 1'] ;PUT MFD PPN IN LOOKUP BLOCK
MOVEM T1,VALFPP+3
INIT .MFD,17
'DSK '
0
POPJ P, ;GOTTA BE A DISK
LOOKUP .MFD,VALFPP ;LOOK FOR THE UFD
JRST VLDONE ;NO, CAN'T MAIL TO FILE IN IT
JRST VWINS ;YES, OK
VALFPP: 0
'UFD '
0
' 1 1'
>;repeat 0
;Send directory status ;⊗ NLST LIST STAT STAT1 STAT2 REJOIN STDONE LIDONE STWILD STWLP STWLP1 DOSTAT STATLP STALP1 STALP2 STAPOK NXTFL1 NXTFL2 NXTFIL STATEOF STATERR STNUFD LISTIT LISTI1 PUT1 PUT6 PUT61 PUT62 sixwrt wrlp wrsoj STATDO
NLST:
LIST: SKIPE DOACTV ;THIS CHECK MUST BE THE FIRST THING
JRST RETRX0
TLO FLG,LISTFL ;SET FLAG
JRST STAT1
STAT: SKIPE DOACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST RETRX0
TLZ FLG,LISTFL ;CLEAR LIST FLAG
STAT1:
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
PUSHJ P,GPPFIL ;GET A FILE OR PPN
JRST STORX1
JUMPN D,STAT2 ;IF NO NAME, USE CURRENT
MOVE D,ALIPPN
STAT2: MOVEM D,STAPPN# ;SAVE PPN FOR HEADER
MOVEM D,STAPP1# ;SAVE AGAIN FOR WILD PPN HACK
MOVEM C,STADEV#
JUMPN F,.+2
MOVSI F,'* ' ;GFN SOMETIMES ZEROS IT WRONGLY
MOVEM F,STANAM# ;STAT TAKES FN AND EXT TOO
MOVEM E,STAEXT#
PUSHJ P,FLUSCS ;FLUSH USER ID LINE
MOVEI A,2 ;SET LOCAL BYTE TYPE
MOVEM A,DOTYPE
MOVEI A,=36 ;AND 36-BIT BYTES
MOVEM A,DOBS
TLNE FLG,LISTFL ;IF LIST,
JRST [SETOM DOACTV↔POPJ P,] ; WE DO THE REST IN DO MODE
REJOIN: MOVEI F,(D) ;SEPARATE PRJ AND PRG
HLRZ E,D
CAIE F,'*'
CAIN E,'*'
JRST STWILD ;WILD PPN
PUSHJ P,DOSTAT ;NOT WILD PPN, ONLY DO ONCE
STDONE: TLNE FLG,LISTFL
JRST LIDONE ;LIST IS DIFFERENT
PUSHJ P,IMPSTR
ASCIZ /212 That's all, folks!
/
RELEASE FOMP,
POPJ P,
LIDONE: PUSHJ P,DOMPSTR
ASCIZ /250 LIST completed successfully
/
JRST DOEOF1
STWILD: MOVE C,STADEV
PUSHJ P,GETMFD ;WILD PPN, READ THE MFD
JRST NOMFD
STWLP: PUSHJ P,MFDIN
JRST STDONE
MOVE T2,T1 ;SAVE ENTRY
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
STWLP1: PUSHJ P,MFDIN
JRST STDONE
SOSLE DIRFLC
JRST STWLP1
JUMPE T2,STWLP ;SKIP EMPTY SLOTS
HLRZ T1,T2 ;SEPARATE PRJ AND PRG IN MFD ENTRY
HLRZ T3,STAPP1
CAIE T3,(T1) ;COMPARE PRJ
CAIN T3,'*'
JRST .+2
JRST STWLP ;NOPE
HRRZ T3,STAPP1
CAIE T3,(T2) ;COMPARE PRG
CAIN T3,'*'
JRST .+2
JRST STWLP
MOVEM T2,STAPPN ;WIN, SAVE FOR DOSTAT
PUSHJ P,DOSTAT ;HIT ME
JRST STWLP
DOSTAT: MOVE F,STAPPN
MOVE C,STADEV
MOVSI E,'UFD'
MOVE D,['1 1']
PUSHJ P,WAITIL
MOVEI B,5 ;CODE FOR UFD READ
MOVEM B,STORTYPE
PUSHJ P,ILDDEV ;OPEN FILE FOR OUTPUT
JRST STNUFD ;UFD lookup FAILURE
MOVEI C,20
STATLP: TLNN FLG,LISTFL
JRST STALP1 ;STAT AND LIST HAVE DIFFERENT WAIT TESTS
SOJG C,STALP2
PUSHJ P,SXACTV ;I HATE THIS PROGRAM!
PUSHJ P,DOWAIT
MOVEI C,20
JRST STALP2
STALP1: SKIPGE SYNCH
PUSHJ P,CIWAIX ;GIVE ABORT A CHANCE
STALP2: PUSHJ P,GETFIL ;C(A) ← BYTE OF DATA FROM FILE
JRST STATERR
JRST STATEOF
JUMPE A,NXTFIL ;SKIP ALL IF FILE NO EXIST
MOVEM A,STAFL1#
PUSHJ P,GETFIL ;EXTENSION
JRST STATERR ;NEITHER WILL HAPPEN (READS EVEN # OF FILES)
JRST STATEOF
HLLZS A
MOVEM A,STAEX1#
MOVE B,STAEXT
CAME B,A
CAMN B,['* ']
JRST .+2 ;EXT MATCHES OR WILD
JRST NXTFL2
MOVE A,STAFL1
MOVE B,STANAM
CAME B,A
CAMN B,['* ']
JRST .+2
JRST NXTFL2
TLNE FLG,LISTFL
JRST LISTIT ;DIFFERENT OUTPUT ROUTINE FOR LIST CMD
SKIPN STAPPN ;HAVE WE TOLD HIM THE PPN YET?
JRST STAPOK ;YES
PUSHJ P,IMPSTR ;PRINT WHOSE
ASCIZ /212-[/
HLLZ B,STAPPN
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,ASCIIC
HRLZ B,STAPPN
PUSHJ P,SIXWRT
PUSHJ P,IMPSTR
ASCIZ /]
/
SETZM STAPPN ;FLAG NOT TO DO IT AGAIN
STAPOK: MOVE B,STAFL1
MOVEI A," " ;Start continuation line with space
PUSHJ P,ASCIIC ;just in case name starts with digits
PUSHJ P,SIXWRT ;FILE
HLLZ B,STAEX1 ; . EXT?
JUMPE B,NXTFL1
MOVEI A,"." ; . EXT
PUSHJ P,ASCIIC
PUSHJ P,SIXWRT
NXTFL1: PUSHJ P,IMPCR
NXTFL2: SKIPA A,[UFDN-2] ;SKIP UFDN-2 WORDS
NXTFIL: MOVEI A,UFDN-1 ;SKIP UFDN-1 WORDS
ADDM A,FOBUF+1 ;OK TO DO, SINCE INCREMENTAL # OF
MOVNS A ; UFD ENTRIES PER RECORD
ADDM A,FOBUF+2
JRST STATLP
STATEOF:POPJ P, ;Return from DOSTAT
STATERR:POP P,(P) ;Flush return from DOSTAT
TLNE FLG,LISTFL ;GOTTA DO THE RIGHT MPSTR
JRST DOERR
PUSHJ P,IMPSTR ;Already started a 212, must finish it
ASCIZ /212 STAT incomplete, local file system error
/
RELEAS FOMP,
POPJ P,
STNUFD: MOVE A,STAPP1 ;Lookup FAILURE on UFD
TLNN FLG,LISTFL
CAME A,STAPPN ;IF WILD PPN,
POPJ P, ; IGNORE IT
POP P,(P) ;Else flush return from DOSTAT
PUSHJ P,ILDERR ;And tell him about it
RELEAS FOMP,
POPJ P,
LISTIT: MOVE B,STAFL1 ;PUT OUT A FILESPEC ON DATA LINK
PUSHJ P,PUT6
SKIPN B,STAEX1
JRST LISTI1
MOVEI A,"."
PUSHJ P,PUT1
PUSHJ P,PUT6
LISTI1:
REPEAT 0,< ; TENEX DOES NOT INCLUDE THE DIRECTORY NAME,
; AND THIS FUCKS TOPS-20 UP THE ASS!
MOVEI A,"["
PUSHJ P,PUT1
HLLZ B,STAPPN
PUSHJ P,PUT6
MOVEI A,","
PUSHJ P,PUT1
HRLZ B,STAPPN
PUSHJ P,PUT6
MOVEI A,"]"
PUSHJ P,PUT1
>;END REPEAT 0
MOVEI A,15
PUSHJ P,PUT1
MOVEI A,12
PUSHJ P,PUT1
JRST NXTFL2
PUT1: SOSG DOBUF+2
PUSHJ P,DOROU3
IDPB A,DOBUF+1
POPJ P,
PUT6: MOVE D,[POINT 6,B]
PUT61: ILDB A,D
JUMPE A,PUT62
ADDI A,40
PUSHJ P,PUT1
PUT62: TLNN D,770000
POPJ P,
JRST PUT61
begin sixwrt
GLOBAL A,C
↑sixwrt:movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,PUTCHR ;WAS ASCIIC, FUCK IT
wrsoj: sojg c,wrlp
popj p,
bend sixwrt
STATDO: PUSH P,DOTYPE ;HERE FROM DO ROUTINE TO START XFER
PUSH P,DOBS ;IDCON AND ILDDEV USE DIFFERENT VALUES
SETZM DOTYPE ;BECAUSE WE READ UFD IN IMAGE MODE
MOVEI A,10 ;BUT SEND NVT ASCII OVER DATA LINK
MOVEM A,DOBS
MOVEI B,0 ;RETR FLAG
PUSHJ P,IDCON ;SET UP NET LINK
JRST DOERRC ;failed
POP P,DOBS ;WE CONTROL THE NET OUTPUT OURSELF
POP P,DOTYPE ; SO WE CAN LEAVE THESE IN ILDDEV MODE
PUSHJ P,WAITIL ;THIS IS A CROCK
MOVEI B,7 ;WILL CHANGE TO 5 LATER. FOR STOMES.
MOVEM B,STORTYP
MOVE A,STADEV
MOVEM A,ERRDEV
MOVE A,STANAM ;SET UP VARS AS IF FROM ILDDEV
MOVEM A,ERRFIL
MOVE A,STAEXT
HLLZM A,ERREXT
MOVE A,STAPPN
MOVEM A,ERRPPN
SETOM HOLDIL ;PROTECT OURSELF
MOVEI A,DOMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
PUSHJ P,ASCII1
[ASCII /125 /]
PUSHJ P,STOMES ;SEND OPERATION NAME AND FILESPEC
MOVE E,[POINT 7,[ASCIZ / started correctly.
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
MOVE D,STAPPN
JRST REJOIN
;Send a file ;⊗ RETR RETRX0 ASCERR
RETR: SKIPE DOACTV
JRST RETRX0
IFN FTREQL,<
SKIPN USEROK ;logged in?
JRST MUSTLG ;nope, lose
>;IFN FTREQL
TLZ FLG,LISTFL ;NOT LIST COMMAND
MOVEI B,0 ;DO FLAG
PUSHJ P,GETSET ;SET UP TYPE, BYTE SIZE
JRST ASCERR ;ERROR RETURN, TYPE A NOT BYTE 8
PUSHJ P,GFN ;GET FILE NAME
JRST RETRX1 ; DIDN'T GET ONE
PUSHJ P,WAITIL
MOVEI B,1
MOVEM B,STORTYP ;"STOR"TYP IS NOW REALLY ILD-TYPE
SETOM HOLDIL
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST ILDERR
MOVEM F,DOACS+F ;WHAT??????????????????????????
SETOM DOACTV
JRST FLUSCS
RETRX0: PUSHJ P,IMPSTR
ASCIZ /503 You are already RETRing
/
JRST FLUSCS
ASCERR: PUSHJ P,IMPSTR
ASCIZ /503 TYPE A must be BYTE 8
/
JRST FLUSCS
;⊗ WHICHA WHICHB TYPE TYPEUN TYPEOK TYPEL MODE MODEUN MODEOK STRU
WHICHA: ;CALL: MOVEI A,<ASCII CHARACTER>
; MOVE B,[POINT 7,[ASCIZ /<LIST OF ASCII CHARACTERS>/]
; PUSHJ P,WHICHA
; RETURN HERE, B,C,D CLOBBERED, A=0,1,2 DEPENDING ON POSITION
; IN LIST WHICH MATCHED ORIGINAL C(A), OR A=-1 IF NONE.
MOVE C,A
SETZ A,
WHICHB: ILDB D,B
JUMPE D,[SETO A, ↔ POPJ P,]
CAMN D,C
POPJ P,
AOJA A,WHICHB
TYPE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /AILPE/]]
PUSHJ P,WHICHA
JUMPL A,[REPMES (501 Unrecognized type)]
JRST .+1(A)
JRST TYPEOK ;TYPE A (0)
JRST TYPEOK ;TYPE I (1)
JRST TYPEL ;TYPE L (2), read byte size that follows
JRST TYPEUN ;TYPE P (3) (not used in TCP/FTP)
JRST TYPEUN ;TYPE E (4)
TYPEUN: REPMES (504 Unimplemented type)
TYPEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (503 Can't change TYPE while data transfer in progress)]
MOVEM A,RTYPE ;SAVE REAL TYPE AS RECEIVED
CAIE A,2 ;TYPE L?
MOVEI B,8 ;no, implicit byte size of 8
MOVEM B,RBS ;SAVE "REAL" BYTE SIZE
REPMES (200 Type OK)
TYPEL: PUSHJ P,GETCHR ;get char after type identifier, should be space
CAIE A," "
JRST [REPMES (501 Bad syntax in TYPE L command)]
PUSHJ P,DECIN ;read decimal byte size into B
CAIA ;CR seen
JRST [REPMES (501 Bad byte size in TYPE L command)]
MOVEI A,2 ;select TYPE L
CAIE B,=8
CAIN B,=32
JRST TYPEOK ;these byte sizes ok
CAIE B,=36 ;so is this one
JRST [REPMES (<504 TYPE L byte size must be 8, 32 or 36>)]
JRST TYPEOK
MODE: PUSHJ P,GETCAP
MOVE B,[POINT 7,[ASCIZ /SBTH/]]
PUSHJ P,WHICHA
JUMPL A,[REPMES (501 Unrecognized mode)]
JRST .+1(A)
JRST MODEOK
JRST MODEUN
JRST MODEUN
JRST MODEUN
MODEUN: REPMES (504 Unimplemented mode)
MODEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (503 Can't change MODE while data transfer in progress)]
REPMES (200 Mode OK)
STRU: PUSHJ P,GETCAP
CAIN A,"F"
JRST [REPMES (200 File structure OK)]
CAIN A,"R"
JRST [REPMES (504 Record structure not implemented)]
REPMES (501 Unrecognized structure)
;⊗ PORT PORT2 PORT3 DECIN DECIN0
;FTP command to change the default host and port numbers for data connection.
;Format of command is PORT h1,h2,h3,h4,p1,p2 where h1 is high decimal byte of
;host number.
PORT: SETZB D,E ;collect host and port numbers in D and E, resp.
MOVE C,[POINT 8,D,3] ;set up byte ptr to collect 32-bit IP host nbr
PORT2: PUSHJ P,DECIN ;read one decimal field
JFCL ;CR seen before we even got to port nbr is error
JRST [REPMES (501 Bad PORT argument)]
IDPB B,C ;save byte of host number
TLNE C,770000 ;end of host number word?
JRST PORT2 ;no, read more
MOVE C,[POINT 8,E,19] ;set up byte ptr to collect 16-bit port nbr
PORT3: PUSHJ P,DECIN ;read one decimal field
CAMN C,[POINT 8,E,19] ;CR seen, better not be after first arg
JRST [REPMES (501 Bad PORT argument)]
IDPB B,C ;save byte of port nbr
TLNE C,770000 ;end of port number word?
JRST PORT3 ;no, read more
CAIE A,15 ;CR was the terminating char?
JRST [REPMES (<501 Extraneous text after PORT arguments>)]
MOVEM D,FDHOST ;store host number for future data connections
MOVEM E,FDRS ;store port number for each direction of
MOVEM E,FDSS ; future data connections
REPMES (<200 PORT command accepted>)
;Read a decimal argument (terminated by comma or cr) from IMP
;CALL: PUSHJ P,DECIN
; CR seen, end of line
; error return (non numeric in argument, or number bigger than 8 bits)
; normal return (C(B) = number, C(A)=delimeter)
DECIN: SETZ B, ;collect arg here
DECIN0: PUSHJ P,GETCHR
CAIN A,15
POPJ P, ;CR seen, end of line
CAIN A,","
JRST CPOPJ2 ;comma seen, end of number
CAIL A,"0"
CAILE A,"9"
JRST CPOPJ1 ;illegal character seen
IMULI B,=10
ADDI B,-"0"(A) ;collect decimal number in B
CAIL B,1⊗8 ;number less than 8 bits worth?
JRST CPOPJ1 ;no, number too big
JRST DECIN0 ;yes, keep scanning
;USER, PASS routines ;⊗ PASS NOPRVS WRONGP GIVUSR MUSTLG USEROK PASFOO USER USER3 ASKPAS USER1 USER4 CWD XCWD ACCT INFREE PWD
PASS: TLNN FLG,(PASSBT) ;Password already given?
TLNN FLG,(USREBT) ;User not given?
JRST GIVUSR ;Yes, tell him to give user name first
SETZ T3, ;Read password, no break characters
SETOM SILENT ;avoid showing password
PUSHJ P,SIXINL
SETZM SILENT ;password reading done
TRNN T,77 ;Right justified?
JUMPN T,[ROT T,-6 ;No, try advancing a character
JRST .-1]
MOVEM T,PASMTA+3 ;Compare with UFD
MTAPE .PASS,PASMTA
JRST WRONGP
PUSHJ P,IMPSTR
ASCIZ/230 Password OK, happy hacking
/
MOVE T3,PPNTMP ;Copy saved PPN
MOVEM T3,UPPN
MOVEM T3,ALIPPN ;Set alias, too
HRRZM T3,UPRG ;SAVE FOR CAME WRT MASPRV IN ILDDEV
SETZM PRIVS ;NO PRIVILEGES YET
MTAPE .PASS,PRVMTA ;READ PRIVILEGES
JRST NOPRVS
MOVE T3,PRIVWD ;GET PRIVS FROM UFD
MOVEM T3,PRIVS ;SAVE THEM
SETZM PASWD ;JUST IN CASE WE HAVE INF
NOPRVS: TLO FLG,(PASSBT)
IFN FTREQL,<
SETOM USEROK ;note password given
>;IFN FTREQL
RELEASE .PASS,
JRST FLUSCS
WRONGP: PUSHJ P,IMPSTR
ASCIZ/530 Password rejected. Shame on you.
/
SOSLE PASTRY ;Too many attempts?
JRST FLUSCS ;No, let him/her try again
MOVEI D,1 ;Yes, obviously a password hacker. Flush!
SLEEP D, ;Wait a sec to send lose message
JRST ERRKIL ;Now, flush!
GIVUSR: PUSHJ P,IMPSTR
ASCIZ /503 No USER command given
/
JRST FLUSCS
IFN FTREQL,<
MUSTLG: PUSHJ P,IMPSTR
ASCIZ /530 You forgot to log in; must give USER command.
/
JRST FLUSCS
USEROK: 0 ;nonzero if USER command given with password
>;IFN FTREQL
PASFOO: REPMES (451 System error, can't check password.)
USER: SETZM PRIVS ;NO PRIVILEGES ANYMORE
SETOM USRCMD#
PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,UFDFIL ;Check for valid user name
MOVEM D,PPNTMP ;SAVE HERE FOR PASS
IFE FTREQL,< ;if requiring login, don't allow guest login
CAME D,['ANONYM']
CAMN D,['NETGUE'] ;LET THIS ONE IN BUT WITH GUEST STATUS
JRST INFREE
>;IFE FTREQL
MOVE D,[SIXBIT/ 1 1/]
MOVEM D,UFDFIL+3
INIT .PASS,17
SIXBIT/DSK/
0
JRST PASFOO
LOOKUP .PASS,UFDFIL
JRST [ HRRZ D,UFDFIL+1 ;File not found?
JUMPE D,USER4 ;Yes, unknown user
CAIN D,2 ;Protection violation perhaps?
JRST USER3 ;Yes, can't check password then
JRST PASFOO]
SETZM PASMTA+3 ;Check for password
MTAPE .PASS,PASMTA
JRST ASKPAS ;Something there, ask for it
USER3: PUSHJ P,IMPSTR ;None, don't let him/her thru
ASCIZ *530 No remote login for that account.
*
JRST FLUSCS
ASKPAS: TLZ FLG,(PASSBT) ;Forget old user
IFN FTREQL,<
SETZM USEROK ;no password given yet
>;IFN FTREQL
TLO FLG,(USREBT) ;Remember we got a user name
MOVEI D,5 ;Set number of tries for password
MOVEM D,PASTRY
PUSHJ P,IMPSTR ;Tell user we want a password
ASCIZ /331 What's yer password?
/
JRST FLUSCS
USER1: PUSHJ P,IMPSTR
ASCIZ *501 Invalid user name. Format is PRJ,PRG
*
JRST FLUSCS
USER4: PUSHJ P,IMPSTR
ASCIZ *530 I don't know you
*
JRST FLUSCS
CWD:
XCWD: PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,ALIPPN ;Set user ppn
PUSHJ P,IMPSTR
ASCIZ /250 CWD command accepted
/
JRST FLUSCS
ACCT: PUSHJ P,IMPSTR
ASCIZ/202 Acct ID not in hash table, add 1 and try again
/
JRST FLUSCS
IFE FTREQL,<
INFREE: TLZ FLG,(PASSBT+USREBT) ;SET HIS UPPN BUT NO LOCAL ACCESS.
MOVEM D,UPPN ;COULD IN PRINCIPLE BE OTHER THAN NETGUE
MOVEM D,ALIPPN ;IE "SPECIAL GUEST ACCT" HACK
HRRZM D,UPRG
PUSHJ P,IMPSTR
ASCIZ /230 Welcome to sunny California
/
JRST FLUSCS
>;IFE FTREQL
;Print Directory command.
PWD: PUSHJ P,IMPSTR
ASCIZ /257 "[/
HLLZ B,ALIPPN
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,ASCIIC
HRLZ B,ALIPPN
PUSHJ P,SIXWRT
PUSHJ P,IMPSTR
ASCIZ /]" is current directory
/
JRST FLUSCS
;Command String reader ;⊗ GETCOM GETCO1 FLUSCS FLCS1 GETCO2
GETCOM: ;CALL: PUSHJ P,GETCOM
; RETURN HERE, NON-SYNTACTICAL COMMAND
; RETURN HERE, C(C) = COMMAND (IN ASCIZ),
;CLOBBERS A,B,C,D
TLZ FLG,LFSEEN ;OK TO REALLY READ FROM IMP AGAIN (FLUSCS FAKEOUT HACK)
MOVNI D,-5 ;MAXIMUM LENGTH OF COMMAND (INCLUDING DELIMITER)
MOVE B,[POINT 7,C]
SETZ C,
PUSHJ P,GETCAP
CAIE A," "
CAIN A,11
JRST .-3 ;IGNORE LEADING TABS, SPACES
CAIA
GETCO1: PUSHJ P,GETCAP
CAIN A," " ;END OF COMMAND?
JRST CPOPJ1 ; YES, SUCCESS EXIT
CAIN A,15 ;IGNORE CR!
JRST GETCO1
CAIN A,12 ;PREMATURE END OF COMMAND LINE?
JRST GETCO2 ; YES
IDPB A,B
AOJL D,GETCO1 ;LOOP FOR NEXT COMMAND CHARACTER...
PUSHJ P,GSRCI
PUSHJ P,IMPST0 ; ... UNLESS TOO MANY ALREADY
ASCIZ /500 Command more than 4 characters: /
PUSHJ P,ASCII1
C
PUSHJ P,IMPCR
SOS IMPSTF
FLUSCS: SKIPE VERBOSE ;FLUSH COMMAND STRING
outchr [173] ;flushing (dcs: 4-12-73)
FLCS1: PUSHJ P,GETCHR ;GET CHARACTER
CAIE A,12 ;L.F.?
JRST FLCS1 ;NO, LOOP FOR NEXT
SKIPE VERBOSE
outchr [176]
POPJ P, ; YES, EXIT (FAILURE EXIT FROM GETCOM)
;FLUSH WANTS TO SEE SOMETHING PERHAPS
GETCO2:
; AOS IBUF+2 ;BACK UP ONE IN COUNTER
; MOVE B,[100000,,0]
; ADDM B,IBUF+1 ; AND IN BUFFER
MOVEI A," " ;FAKE THE SPACE
JRST CPOPJ1
;Convert command string to index ;⊗ GETIDX ANAMES NNAMES
GETIDX: ;CALL: PUSHJ P,GETIDX
; RETURN HERE, C(A) = XWD <GARBAGE>,N
; N=0 - UNRECOGNIZED COMMAND
MOVSI A,-NNAMES
CAMN C,ANAMES(A)
AOJA A,CPOPJ
AOBJN A,.-2
SETZ A,
POPJ P,
DEFINE X(A) <ASCIZ /A/ ↔ >
ANAMES: NAMES
NNAMES←← .-ANAMES
;Send ASCII character out on IMP control connection ;⊗ PUTCHR PUTBUF PUTBU2 PUTBU2 PUTBU3
PUTCHR: ;CALL: MOVE A,<ASCII CHARACTER>
; PUSHJ P,PUTCHR
; RETURN HERE ALWAYS, ALL ACCUMULATORS INTACT
JUMPE A,CPOPJ ;DON'T OUTPUT NULL CHARACTER
SKIPE VERBOSE
OUTCHR A
SOSG OBUF+2 ;ROOM IN BUFFER FOR THIS CHARACTER?
PUSHJ P,PUTBUF ; NO, MAKE ROOM BY OUTPUTTING BUFFER
PUSH P,A ;JUST IN CASE
CAIGE A,200 ;Range check
LDB A,PTOASC ;Convert WAITS to ASCII
IDPB A,OBUF+1 ; STUFF IT IN
POP P,A
CAIE A,12 ;IT'S A LINE FEED?
POPJ P, ; NO
JRST PUTBUF ; YES, SEND OUT ENTIRE BUFFER, AND RETURN
PUTBUF: ;CALL: PUSHJ P,PUTBUF
; RETURN HERE ALWAYS
; OUTPUTS A BUFFER OF ASCII ON THE CONTROL IMP CONNECTION.
PUSH P,B ;GET AN ACCUMULATOR
PUSH P,A
PUTBU2: LDB B,[POINT 3,OBUF+1,2];PUT MAGIC BITS FOR NULL BYTES
MOVEI A,1
LSH A,(B)
SUBI A,1
IORM A,@OBUF+1
REPEAT 0,<
PUTBU2: LDB B,[POINT 6,OBUF+1,5]
CAIGE B,10 ;IS WORD FILLED OUT?
JRST PUTBU3 ; YES
SOS OBUF+2 ; NO, FILL IT OUT WITH NOP'S
MOVEI B,202
IDPB B,OBUF+1
JRST PUTBU2
>
PUTBU3: ;IT MIGHT BE NICE TO PUT A TEST HERE
; TO MAKE SURE WE CAN DO THE OUTPUT
; WITHOUT HANGING UP FOR ALLOCATION
; OR BLOCKED LINK OR WHATEVER.
; (IN WHICH CASE, IMPSTR,DIMPSTR,DOMPSTR
; SHOULD BE DISTINGUISHED, TO PREVENT
; INTERMIXING OF THEIR MESSAGES.)
POP P,A
POP P,B ;RESTORE ACCUMULATOR
OUT IMP, ;SEND OUT THE BUFFER
POPJ P, ; SUCCESS, RETURN
MES (OUT IMP fails)
; IN THIS CASE, TIS BETTER TO GO ON THAN TO QUIT
POPJ P, ;NO MATTER WHAT THE PROBLEM, IGNORE IT
; OR LET SOMEBODY ELSE FIND IT!
; (BECAUSE SOME MAIL's CLOSE DOWN BEFORE
; ACKNOWLEDGEMENT)
;Get ASCII character from IMP control connection ;⊗ GETCHR RGETCH GETCH1 GETCH6 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
GETCHR: ;CALL: PUSHJ P,GETCHR
; RETURN HERE ALWAYS, C(A) HAS CHARACTER
; CLOBBER NO ACCUMULATORS
TLNE FLG,LFSEEN ;IS THIS COMMAND LINE ALREADY DONE?
JRST FAKELF ;YUP, KEEP RETURNING LF TO MAKE FLUSCS HAPPY.
RGETCH: SOSG IBUF+2 ;CHR IN BUFFER?
JRST GETCH2 ; NO, DO AN INPUT
GETCH1: ILDB A,IBUF+1
CAIN A,200 ;DATA MARK?
AOS SYNCH ; YES, UPDATE COUNT
SKIPL SYNCH ;IF SYNCH IS NEGATIVE, IGNORE INPUT
;;;;; CAIN A,202 ;NOP?
CAIL A,200 ;TELNET CONTROL?
JRST RGETCH ; YES, GET ANOTHER CHARACTER
JUMPE A,RGETCH ;IGNORE NULLS
SKIPE SILENT ;HIDING THEIR INPUT?
JRST GETCH6 ;YES
trne a,200
outchr ["↑"]
outchr a
GETCH6: TRNE A,200 ;CONTROL CHARACTER?
POPJ P, ;RETURN, WHATEVER IT IS
LDB A,PFRASC ;Convert from ASCII to WAITS
CAIN A,12
TLO FLG,LFSEEN ;NO MORE READING UNTIL NEXT GETCOM
POPJ P, ;THANK YOU, MR. WRIGHT
GETCH2: PUSH P,F ;GET AN ACCUMULATOR
HRRZ F,IBUF ;GET POINTER TO BUFFER
HRRZ F,(F) ;GET POINTER TO NEXT BUFFER
SKIPGE (F) ;INPUT WAITING IN NEXT BUFFER?
JRST GETCH3 ; YES
INTMSK 1,[0] ;TURN OFF INTERRUPTS
MTAPE IMP,[10] ;INPUT WAITING IN FREE STORAGE?
JRST GETCH4 ; NO
INTMSK 1,[-1] ; YES, RE-ENABLE INTERRUPTS
GETCH3: POP P,F ;RESTORE ACCUMULATOR
IN IMP, ;DO THE INPUT
JRST GETCH1 ; AND FETCH THE CHARACTER
JRST GETCH5 ; OOPS! INPUT FAILED
GETCH4: INTMSK 1,[-1]
POP P,F ;RESTORE ACCUMULATOR
GETCH5: PUSHJ P,CIWAIT
JRST GETCH2
GETCAP: PUSHJ P,GETCHR ;SAME AS GETCHR, EXCEPT CHANGES
CAIL A,"a" ; LOWER CASE TO UPPER CASE
CAILE A,"z" ; BEFORE RETURNING
POPJ P,
SUBI A,"a"-"A"
POPJ P,
FAKELF: MOVEI A,12
POPJ P,
;Routines to output ASCII information on control channel ;⊗ GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
; NOTE: THE PRIVILEGE OF SENDING ASCII OUT ON CONTROL CHANNEL
; IS A "SCARCE RESOURCE", SINCE THE CI,DI AND DO ROUTINES MAY ALL
; TRY TO DO SO SIMULTANEOUSLY. THE FLAG "INPSTF" GOVERNS THE USE
; OF THESE ROUTINES.
; IMPORTANT: WHEN DONE, THE CALLING ROUTINE MUST RELEASE THE
; RESOURCE BY A "SOS IMPSTF" INSTRUCTION.
GSRCI: MOVEI A,IMP
GSR: ;Get Scarce Resource
;CALL: MOVEI A,<DIMP or DOMP or IMP>
; PUSHJ P,GSR
; RETURN HERE WITH CONTROL OF SCARCE RESOURCE
AOSG IMPSTF ;IS RESOURCE AVAILABLE?
POPJ P, ; YES
SOS IMPSTF ; NO
CAIN A,IMP
PUSHJ P,CIWAIT
CAIN A,DIMP
PUSHJ P,DIWAIT
CAIN A,DOMP
PUSHJ P,DOWAIT
JRST GSR
ASCII1: ;CALL: PUSHJ P,ASCII1
; <ADDRESS OF ONE WORD OF ASCII OR ASCIZ>
; RETURN HERE, 0,1,2,3,4,OR 5 CHARACTERS OUTPUT
;CLOBBERS ACCUMULATORS E,F
MOVNI F,5
PUSH P,A
MOVE E,[POINT 7,0]
HRR E,@-1(P)
ASCII2: ILDB A,E
JUMPE A,ASCII3 ;JUMP ON END OF ASCIZ STRING
PUSHJ P,PUTCHR ;OUTPUT 1 CHARACTER
AOJL F,ASCII2 ;LOOP FOR NEXT CHARACTER
ASCII3: POP P,A
JRST CPOPJ1
ASCIIY: ILDB A,E
JUMPE A,ASCII3
PUSHJ P,PUTCHR
JRST ASCIIY
ASCIIE: ;CALL: MOVE E,[POINT 7,[ASCIZ /MESSAGE TO GO OUT ON IMP/]]
; PUSHJ P,ASCIIE
; RETURN HERE ALWAYS, ACCUMULATOR A LOST
PUSH P,[.+1] ;PUT <RETURN ADDRESS LESS ONE> ON STACK
PUSHJ P,ASCIIY ;THIS IMPLICIT RETURN ADDRESS IS CLOBBERED
POPJ P, ;THIS IS THE RETURN FROM ASCIIE
ASCIIC: PUSH P,A
PUSHJ P,GSRCI ;GET SCARCE RESOURCE -- IMP OUTPUT CONTROL
POP P,A
PUSHJ P,PUTCHR
SOS IMPSTF
POPJ P,
;Another routine to output ASCII string to IMP control channel ;⊗ DIMPSTR DOMPSTR IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH
;; IMPST0 IS A ROUTINE TO OUTPUT AN ASCII STRING TO THE IMP CONTROL
;;CHANNEL. HOWEVER, SEVERAL DIFFERENT ROUTINES MAY WISH SIMULTANEOUS
;;ACCESS TO IMPST0, WHICH WOULD CAUSE THE MESSAGES GOING OUT TO BE INTER-
;;MINGLED, AND THEREFORE GARBLED. THUS, INPST0 IS TREATED AS A "SCARCE
;;RESOURCE", AND THE COUNTER "IMPSTF" INDICATES ITS AVAILIBILITY.
;; SO, IMPST0 HAS 3 ENTRY POINTS: DIMPSTR, DOMPSTR AND IMPSTR.
;;THESE CORRESPOND TO THE 3 ROUTINES DIROUT, DOROUT AND CIROUT.
DIMPSTR:AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,DIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST DIMPSTR
DOMPSTR:AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,DOWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST DOMPSTR
IMPSTR: AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,CIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST IMPSTR
IMPSTF: -1 ;MINUS ONE MEANS IMPST0 ROUTINE IS AVAILABLE
IMPST0: ;CALL: PUSHJ P,IMPST0
; ASCIZ /STRING TO BE OUTPUT/
; RETURN HERE
;CLOBBERS ACCUMULATOR E
POP P,E
PUSHJ P,IMPSTN ;output string pointed to by E
SOS IMPSTF
JRST 1(E)
;Output to IMP the ASCIZ string pointed to by RH E.
IMPSTN: HRLI E,(<POINT 7,0>)
PUSH P,A
IMPST1: ILDB A,E
JUMPE A,IMPST2
PUSHJ P,PUTCHR
JRST IMPST1
IMPST2: POP P,A
POPJ P,
IMPCR: PUSHJ P,IMPSTR
ASCIZ /
/
POPJ P,
;routine to output our host name to the IMP
IMPSTH: MOVEI E,OURSTR ;get ptr to our host name string
JRST IMPSTN
;⊗ SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
;CR'S ARE IGNORED, ALSO LEADING SPACES AND TABS
;CALL: MOVE T3,[POINT 7,[ASCIZ /<BREAK CHARACTERS>/]]
; PUSHJ P,SIXINL/R
; RETURN HERE ALWAYS,
; C(T) = LEFT/RIGHT JUSTIFIED SIXBIT
; C(T1)= BREAK CHARACTER:
; ILLEGAL 6BIT(1-37),LF(12),OR FROM TABLE(1-177)
SIXINL: MOVE T2,[POINT 6,T]
TLOA FLG,LEFTF
SIXINR: TLZ FLG,LEFTF
SETZ T, ;PUSHJ TO HERE FOR RIGHT NORMALIZATION
PUSH P,A
PUSH P,T3 ;SAVE POINTER TO BREAK CHARACTERS
TLZ FLG,QUOTEF ;FLAG NO QUOTING IN PROGRESS
SIXIN1: PUSHJ P,GETCHR ;C(A) GETS CHARACTER
MOVE T1,A
CAIN T1,42 ;QUOTE HACKING?
TLCA FLG,QUOTEF ;YES, TOGGLE FLAG AND CHECK STATE
CAIA
JRST SIXIN1
TLNE FLG,QUOTEF
JRST SIXIN3
CAIE T1,40
CAIN T1,11
JRST [JUMPE T,SIXIN1 ;IGNORE LEADING BLANKS AND TABS
JRST SIXIN4] ;ELSE RETURN
MOVE T3,(P) ;T3 ← POINTER TO BREAK CHARACTERS
SIXIN2: ILDB A,T3 ;A ← BREAK CHARACTER FROM TABLE
JUMPE A,SIXIN3 ;JUMP ON END OF BREAK TABLE
CAMN A,T1 ;MATCH WITH INPUT CHARACTER?
JRST SIXIN4 ; YES, GO EXIT
JRST SIXIN2 ;FETCH NEXT BREAK CHARACTER
SIXIN3: CAIL T1,"a"
CAILE T1,"z"
JRST .+2
TRZ T1,40 ;MAKE LOWER CASE INTO UPPER CASE
CAIGE T1,40
JRST SIXIN4 ;RETURN IF CHAR. HAS NO SIXBIT CODE
SUBI T1,40
ANDI T1,77
TLNE FLG,LEFTF ;LEFT JUSTIFIED SIXBIT?
JRST [ TLNE T2,770000 ;YES, ALREADY HAVE SIX CHARACTERS?
IDPB T1,T2 ;NO, STASH IT IN
JRST SIXIN1]
TLNE T,770000 ;ALREADY HAVE 6 CHARACTERS?
JRST SIXIN1 ; YES, FLUSH EXTRA CHARACTERS
LSH T,6
IOR T,T1
JRST SIXIN1 ;READ NEXT CHARACTER
SIXIN4: POP P,T3 ;RESTORE POINTER TO BREAK CHARACTERS
POP P,A ;RESTORE ACCUMULATOR A
POPJ P, ;AND RETURN
;Get file name ;⊗ GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPN GPPNX GPPWIN GPPFIL
;; CALL: PUSHJ P,GFN ;(Get File Name)
;; ERROR RETURN
;; SUCCESS RETURN, C(F) = FILENAME IN SIXBIT
;; C(E) = EXTENSION IN SIXBIT
;; C(D) = PPN IN SIXBIT
;; C(C) = DEVICE IN SIXBIT
;; CLOBBERS T,T1,T2,T3 ONLY
;; CALL: PUSHJ P,GPPN ;(Get PPN)
;; ERROR RETURN
;; SUCCESS RETURN, C(D) = PPN IN SIXBIT
GFN: SETZB D,E ;DEFAULT EXT AND PPN
TLZ FLG,MFNMF
MOVSI C,'DSK' ;DISK IS ASSUMED DEVICE
MOVE T3,[POINT 7,[ASCIZ /:.[/]]
PUSHJ P,SIXINL
GFN0: CAIE T1,":"
JRST GFN0A
MOVE C,T
MOVE T3,[POINT 7,[ASCIZ/.[/]]
PUSHJ P,SIXINL
GFN0A: MOVE F,T ;SET FILE NAME
CAIE T1,"." ;EXTENSION IS NEXT?
JRST GFN1 ; NO
MOVE T3,[POINT 7,[ASCIZ /[/]]
PUSHJ P,SIXINL
;;; This change installed for the benefit of a multiple STOR
;;; from a tenex with longer filenames, so we truncate the ext instead of
;;; refusing the transfer
HLLZS T
;;; TRNE T,-1 ;EXTENSION NAME MORE THAN 3 CHARACTERS?
;;; POPJ P, ; YES, ERROR RETURN
MOVE E,T ;SET EXTENSION NAME
GFN1: CAIE T1,"[" ;PPN IS NEXT?
JRST CPOPJ1 ; NO, SUCCESS EXIT
GPPN1: ;ENTER HERE FOR PPN ONLY
MOVE T3,[POINT 7,[ASCIZ /,]/]]
PUSHJ P,SIXINR
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
JRST GPPWIN
GPPN2: TLNE T,-1 ;PROJECT NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
MOVS D,T
JUMPE T,CPOPJ1 ;THIS IS NO PPN ON GPPN ENTRY
CAIE T1,"," ;PROJECT & PROGRAMMER NAMES DELIMITED OK?
JRST GPPN3 ; NO, JUST PROJECT CODE
MOVE T3,[POINT 7,[ASCIZ /]/]]
PUSHJ P,SIXINR
TLNE T,-1 ;PROGRAMMER NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
HRR D,T ;SET PPN
JRST CPOPJ1 ;SUCCESS RETURN
GPPN3: TLNE FLG,MFNMF ;IF MLFLNM, TAKE ERROR RETURN SIGH
POPJ P,
HRR D,ALIPPN ;GET DEFAULT PROGRAMMER NAME
JRST CPOPJ1
GPPN: TLZ FLG,MFNMF
GPPNX: MOVE T3,[POINT 7,[ASCIZ /[,/]]
PUSHJ P,SIXINR
JUMPE T,GPPN1
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
GPPWIN: MOVE D,T
JRST CPOPJ1
;; GPPFIL: LIKE GFN BUT ACCEPTS "PRJ,PRG" TO MEAN "*.*[PRJ,PRG]"
;THIS IS COMPLETELY WRONG.
GPPFIL: MOVSI F,'* '
MOVSI E,'* '
MOVEI D,0
MOVSI C,'DSK'
TLZ FLG,MFNMF
MOVE T3,[POINT 7,[ASCIZ /:[.,/]]
PUSHJ P,SIXINL
CAIE T1,","
JRST GFN0 ;WE HAVE FILENAME
TRNN T,77 ;ELSE RIGHT JUSTIFY
JRST [ LSH T,-6
JRST .-1]
JRST GPPN2 ;AND TREAT AS PPN
;DI routine - Get data from IMP, store in WAITS file system ;⊗ DIROUT DIROU1 DIROU2 DIROU3 DIERR ICONER DIERR2 DIER2A DIEOF9 DIEOF DIEOFQ DIEOF1 DIFINI DIEOML DIERR3 PUTFIL PUTFI0 PUTFI1 PUTFI2 PUTFI3 PUTFI4 PUTFI5 FIBTSL FIWORD FIBPT
;; ENVIRONMENTAL PREQUISITES FOR CALLING DIROUT:
;; 1) WAITS FILE SYSTEM IS INITIALIZED, AND HAS BEEN
;; "ENTERED". THE DI ROUTINE WILL STORE THE FILE IN WAITS
;; FILE SYSTEM USING BUFFER HEADER "FIBUF".
;; 2) C(DIMODE) INDICATES MODE OF DATA TRANSFER
;; 4) C(DITYPE) INDICATES TYPE OF DATA (ARPANET FTP CONVENTIONS)
;; 5) C(FOTYPE) INDICATES MOVE OF DATA TRANSFER (LOCAL TO
;; WAITS, THIS INDICATES THE WAY OF HANDLING "FIBUF" BUFFER).
;; WHAT DI ROUTINE DOES:
;; 1) INITS THE IMP, ON CHANNEL DIMP.
;; 2) ESTABLISHES DATA CONNECTION WITH FOREIGN USER TELNET.
;; 3) ACCEPTS DATA FROM IMP, STUFFING IT INTO WAITS FILE
;; SYSTEM.
;; 4) CLOSES DATA CONNECTION AND RELEASES WAITS FILE SYSTEM
;; UPON ANY OF THE FOLLOWING:
;; A) DATA CONNECTION CLOSED FOR ANY REASON
;; B) EOF ARRIVES ON DATA CONNECTION
;; C) "DIABORT" FLAG IS FOUND TO BE SET
;; D) ERROR IN WAITS FILE SYSTEM
DIROUT: MOVEI B,1 ;INDICATE DATA DIRECTION "IN"
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST ICONER ;ERROR
;;# DCS 10-15-72 ADD FTP START RESPONSE HERE PER CMU REQUEST
MOVEI A,DIMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
MOVE E,[POINT 7,[ASCIZ /125 Socket to me!
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
;;# DCS
;; MOVNI FLG2,1
TLO FLG,MEOFBT
MOVE B,[JRST CPOPJ2] ;MOST DATA MODES RETURN SUCCESSFUL WITH ANY BYTE
MOVE A,DIMODE ; BUT TEXT MODE MUST DO AN EOF TEST FIRST
CAIN A,2 ;ARE WE DOING TEXT MODE TRANSFER?
MOVE B,[JRST GETDAE] ; YES, SPECIAL GLITCH
MOVEM B,GETDA0 ;PLANT RETURN INSTRUCTION
DIROU1: HRROI C,-40
DIROU2: PUSHJ P,GETDAT ;C(A) ← BYTE OF DATA FROM IMP
JRST DIERR3 ; FAILURE RETURN
JRST DIEOF9 ; EOF RETURN
DIROU3: PUSHJ P,PUTFIL
JRST DIERR2
;; CAIN A,12
;; MOVNI FLG2,1
AOJL C,DIROU2
PUSHJ P,SXACTV
PUSHJ P,DIWAIT
JRST DIROU1
DIERR: PUSHJ P,DIMPSTR
ASCIZ /426 STOR incomplete, data connection closed early.
/
JRST DIER2A
ICONER: SETZM HOLDIL ;now OK to start up again
PUSHJ P,DIMPSTR
ASCIZ /425 STOR incomplete, can't connect to your data port
/
JRST DIER2A
DIERR2: PUSHJ P,DIMPSTR
ASCIZ /451 STOR incomplete, local file system error
/
DIER2A:
RELEAS FIMP,3 ; BECAUSE WE ARE FLUSHING THE OUTPUT HERE
JRST DIFINI
DIEOF9:
DIEOF: MOVE A,DITYPE ;SPECIAL EOF FOR IMAGE TYPE
SOJN A,DIEOFQ ;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 DIEOFQ
MOVE A,FIWORD ;GET LAST PARTIAL WORD
PUSHJ P,PUTFI0
JFCL ;NEVER MIND ERROR, TOO LATE
DIEOFQ: RELEASE FIMP,
DIEOF1: JUMPL FLG,DIEOML
PUSHJ P,DIMPSTR
ASCIZ /250 Finis; /
PUSHJ P,ERRFN
PUSHJ P,DIMPSTR
ASCIZ/
/
DIFINI: SETZM DIACTV
RELEASE DIMP,
SKIPN QUITNG ;IF TRIED TO QUIT, TRY
POPJ P, ; AGAIN (MULTIPLE-SUICIDE MODE)
JRST BYE1
DIEOML: PUSHJ P,DIMPSTR
ASCIZ /451 Server error, impossible flag set
/
JRST DIER2A ;this should never happen anyway
DIERR3: PUSHJ P,DIMPSTR
ASCIZ /426 STOR incomplete, error reading data connection
/
JRST DIER2A
;; CALL: MOVE A,<BYTE TO GO INTO LOCAL FILE SYSTEM>
;; PUSHJ P,PUTFIL
;; ERROR RETURN
;; NORMAL RETURN
PUTFIL: MOVE B,DITYPE ;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
JRST PUTFI0 ;NOW NORMAL IO STUFF
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,DIBS
LSH B,6
IOR B,[POINT 0,FIWORD]
MOVEM B,FIBPT
MOVEI B,=36
PUTFI4: SUB B,DIBS
MOVEM B,FIBTSL
JUMPL B,PUTFI5
IDPB A,FIBPT
JRST CPOPJ1
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,DIBS
LSH A,=24
HRRI A,FIWORD
MOVEM A,FIBPT
JRST CPOPJ1
FIBTSL: 0
FIWORD: 0
FIBPT: 0
;Get data byte from IMP data connection ;⊗ GETDAT GETDA1 GETDA0 GETDA2 GETDA3 GETDA4 GETDA5 GETDA7 GETDAC GETDAE
;; CALL: PUSHJ P,GETDAT
;; RETURN HERE, ERROR
;; RETURN HERE, EOF
;; RETURN HERE, C(A) = DTAT BYTE
GETDAT: SOSG DIBUF+2 ;BYTE IN BUFFER?
JRST GETDA2 ; NO, THINK ABOUT DOING AN INPUT
GETDA1: ILDB A,DIBUF+1 ;GET THE DATA BYTE
GETDA0: 000 ; [JRST CPOPJ2] OR [JRST GETDAE]
GETDA2: PUSH P,B ;GET AN ACCUMULATOR TO PLAY WITH
HRRZ B,DIBUF ;GET POINTER TO BUFFER
HRRZ B,(B) ;GET POINTER TO NEXT BUFFER
SKIPGE (B) ;IS THERE DATA IN THAT BUFFER?
JRST GETDA3 ; YES, DO AN INPUT
INTOFF ;TURN OFF INTERRUPTS
MTAPE DIMP,[10] ;INPUT DATA WAITING IN FREE STORAGE?
JRST GETDA4 ; NO
INTON
GETDA3: POP P,B
IN DIMP,
JRST GETDA1 ;SUCCESSFUL INPUT
POPJ P, ;ERROR ON INPUT, GIVE ERROR RETURN
GETDA4: INTON ;TURN ON INTERRUPTS
POP P,B
MTAPE DIMP,GETDA7 ;GET STATUS OF CONNECTION
MOVE A,GETDA7+2 ;GET STATUS BITS
TLC A,RFC
TLNE A,RFC!CLS ;IS SOMEBODY CLOSING THIS CONNECTION?
JRST GETDAC ; YES
GETDA5: PUSHJ P,DIWAIT ;WAIT FOR AWHILE, ...
JRST GETDA2 ; ... AND TRY AGAIN
GETDA7: 2 ↔ 0 ↔ 0 ;DATA BLOCK FOR MTAPE UUO
GETDAC: MOVE A,DIMODE ;ARRIVE HERE IF DI CONNECTION CLOSES
JRST .+1(A) ;DISPATCH ACCORDING TO CONNECTION MODE
JRST CPOPJ1 ;STREAM MODE, GIVE EOF RETURN
000 ;BLOCK MODE, UNIMPLEMENTED
POPJ P, ;TEXT MODE, GIVE ERROR RETURN
000 ;HASP MODE, UNIMPLEMENTED
GETDAE: CAIE A,301 ;ARRIVE HERE WITH BYTE IF DI CONNECTION IS
JRST CPOPJ2 ; TEXT MODE, GIVE NORMAL RETURN HERE.
JRST CPOPJ1 ; UNLESS EOF, GIVE EOF RETURN HERE.
;Get data from local file system, transmit to IMP ;⊗ DOROUT DOROU1 DOROU2 DOROU3 DOEOF DOEOF1 DOEOF2 DOERR DOERRC OCONER
;; ENVIRONMENTAL PREREQUISITES FOR CALLING DOROUT:
;; 1) WAITS FILE SYSTEM IS INIT'ED, AND LOOKUP HAS BEEN
;; DONE. DOROUT WILL RETRIEVE THE FILE USING BUFFER
;; HEADER "FOBUF".
;; 2) C(DOMODE) INDICATES MODE OF DATA TRANSFER.
;; 3) C(DOTYPE) INDICATES TYPE OF DATA TRANSFER.
;; WHAT DOROUT DOES:
;; 1) INITS THE IMP, ON CHANNEL DOMP.
;; 2) ESTABLISHED DATA CONNECTION WITH FOREIGH TELNET.
;; 3) READS DATE FROM LOCAL FILE SYSTEM, TRANSMITTING IT
;; TO THE IMP.
;; 4) CLOSES DATA CONNECTION ON EOF FROM FILE SYSTEM
DOROUT: TLNE FLG,LISTFL ;IF THIS IS THE LIST COMMAND,
JRST STATDO ; GO BACK TO STAT ROUTINE FOR OUR PART
MOVEI B,0
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST OCONER ; CAN'T MAKE DATA CONNECTION
MOVEI A,DOMP
PUSHJ P,GSR ;GET PERMISSION TO TALK BACK
MOVE E,[440700,,[ASCIZ /125 Look out! Here comes /]]
PUSHJ P,ASCIIE
PUSHJ P,ERRFN
MOVE E,[440700,,[ASCIZ/
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
SETZM HOLDIL
SETOM NOEDIR# ;FLAG TO HELP ASCII TYPE FLUSH E DIRECTORY
DOROU1: HRROI C,-40
DOROU2: PUSHJ P,GETFIL ;C(A) ← BYTE OF DATA FROM FILE
JRST DOERR
JRST DOEOF
SOSG DOBUF+2 ;ROOM FOR BYTE IN DOMP BUFFER?
PUSHJ P,DOROU3 ; NO, DO OUTPUT TO IMP
IDPB A,DOBUF+1 ; YES, PUT IT IN
AOJL C,DOROU2 ;LOOP FOR NEXT BYTE IF NOT TOO MANY
PUSHJ P,SXACTV ;TOO MANY ALL AT ONCE, PAUSE SO THE
PUSHJ P,DOWAIT ; CONTROL LINK CAN GET IT IF IT WANTS
JRST DOROU1 ;CONTINUE
DOROU3: ;IT MIGHT BE NICE TO PUT A TEST HERE TO
; INSURE THAT THE OUTPUT WILL NOT HANG
OUT DOMP,
POPJ P,
MES (OUT DOMP fails)
JRST ERRKIL
DOEOF: PUSHJ P,DOMPSTR
ASCIZ /250 The End
/
DOEOF1: PUSHJ P,DOROU3
DOEOF2: RELEASE FOMP,
RELEASE DOMP,
SETZM DOACTV
SKIPN QUITNG ;IF TRIED TO QUIT, TRY AGAIN
POPJ P, ; (QUITTERS NEVER QUIT QUITTING)
JRST BYE1
DOERR: PUSHJ P,DOMPSTR
ASCIZ /451 RETR incomplete, local file system error
/
JRST DOEOF1
;Here on error making data connection for listing
DOERRC: POP P,DOBS ;restore saved data
POP P,DOTYPE
CAIA
OCONER: SETZM HOLDIL ;now OK to start up again
PUSHJ P,DOMPSTR
ASCIZ /425 RETR incomplete, can't connect to your data port
/
JRST DOEOF2
;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
;CALL: PUSHJ P,GETFIL
; ERROR RETURN
; EOF RETURN
; NORMAL RETURN
; Getfil -- Get data byte from local file system. GETDAT
GETFIL: MOVE A,DOTYPE ;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
MES (Error detected on FOMP)
POPJ P,
GETFI3: SKIPE A,FOBTSL ;IMAGE MODE: MORE BITS IN THE CURRENT FILE WORD?
JRST GETFI4 ; YES, CARRY ON
MOVS A,DOBS ;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,DOBS ;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
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,DOBS
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 DOTYPE ;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
;⊗ NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
; OUTPUT IS TO DISK FILE
DEFINE STROUT(X) <
MOVEI B,X
PUSHJ P,WRTSTR
>
DEFINE OUT1 (X) <MOVE A,X ↔ XCT OUTINSTR>
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,
; THE DATGEN ROUTINE
DATGEN: DATE T1,
IDIVI T1,=31
ADDI T2,1
PUSH P,T2
NODA1: IDIVI T1,=12
MOVEI T3,261 ;DAYLIT
PEEK T3,
PEEK T3,
SKIPE T3
SKIPA T3,[PDDATE]
MOVEI T3,PSDATE
MOVEM T3,DTKIND
MOVEI B,@MONTAB(T2)
PUSHJ P,WRTSTR
POP P,A
IDIVI A,=10
JUMPE A,ONEDDD
ADDI A,"0"
XCT OUTINSTR
ONEDDD: MOVEI A,"0"(B)
XCT OUTINSTR
MOVEI B,[ASCIZ/, /]
PUSHJ P,WRTSTR
MOVEI T2,=1964(T1)
PRNUM (T2,2)
STROUT ([ASCIZ/ /])
NODATE: 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: [ASCIZ/January /]
[ASCIZ/February /]
[ASCIZ/March /]
[ASCIZ/April /]
[ASCIZ/May /]
[ASCIZ/June /]
[ASCIZ/July /]
[ASCIZ/August /]
[ASCIZ/September /]
[ASCIZ/October /]
[ASCIZ/November /]
[ASCIZ/December /]
PDDATE: ASCIZ/ PDT/
PSDATE: ASCIZ/ PST/
DTKIND: 0
;Interrupt level routine ;⊗ ILEVEL DNTSAY timout SXACTV LOOK
ILEVEL: MOVE A,JOBCNI
SKIPN IVERBOSE
JRST DNTSAY
PTOCNT LOOK
MOVE B,LOOK+1
CAILE B,120 ;make sure plenty of room in output buffer
JRST DNTSAY ;not enough room, avoid I-level schedule attempt
outchr ["↔"]
tlne a,intinp
outchr ["p"]
tlne a,intims
outchr ["s"]
TLNE A,INTINS
OUTCHR ["A"]
DNTSAY: tlne a,intclk
jrst timout
TLNE A,INTINS
SOS SYNCH ;IF THIS GOES NEGATIVE WE STOP TILL IT CATCHES UP
TLNE A,INTINS
SETZM CIHUNG ;PREPARES US FOR A COMMAND AT ONCE (BETTER BE ABOR)
TLNE A,INTIMS
SETOM SCHEKF ;Status CHEcK Flag
MOVE A,[-3]
MOVEM A,XACTV
DISMIS
timout: debreak
jrst errkil
SXACTV: PUSH P,[-3] ;HANDY ROUTINE TO SET XACTV
POP P,XACTV ; WITHOUT CLOBBERING ANY
POPJ P, ; ACCUMULATORS
LOOK: 0↔0
SUBTTL Host name magic using NETWRK ;⊗ GETHNM COPYUS GOTUS CPYHST CPYDUN HSTTAB HSTSIX ERRTNS WHYWHY
GETHNM:
BEGIN NETHAK
PUSH P,A
PUSHJ P,ATTHST ;Attach upper segment host table
SKIPE OURSTR ;know our name yet?
JRST GOTUS ;yup, must have been here before
PUSHJ P,OURNAM ;get our host name
JRST [ MOVE 0,OURH3 ;use first host number
MOVEI 1,OURSTR ;put our number into OURSTR
PUSHJ P,HNUMST
JRST GOTUS]
HRLI 1,440700 ;copy our name to safe place
MOVE 2,[440700,,OURSTR]
COPYUS: ILDB 0,1
IDPB 0,2
JUMPN 0,COPYUS
GOTUS: MOVE 0,HOSTNO ;Get HOSTS3 format host number
PUSHJ P,HSTNUM ;get host name from number
JRST [ MOVEI 1,HSTSTR ;Failed, make NETWRK put number in HSTSTR for us
PUSHJ P,HNUMST
JRST CPYDUN]
PUSH P,1 ;save ptr to name
HRLI 1,440700 ;make byte ptr to name
MOVE 2,[440700,,HSTSTR]
CPYHST: ILDB 1 ;copy host name text to HSTSTR
IDPB 2
JUMPN CPYHST
POP P,1
CPYDUN: PUSHJ P,SETANM ;set alias name to something rep'ing foreign host
PUSHJ P,DETHST ;Flush host table
POP P,A
POPJ P,
HSTTAB←←-1
HSTSIX←←-1
ERRTNS←←-1 ;Also get error routine
WHYWHY: 0 ;unused, but ref'd by NETWRK's HSTDED (not called)
.INSERT NETWRK.FAI[S,NET]
BEND NETHAK
;Miscellaneous error messages ;⊗ QUIT BYE BYE1 BYE2 ERRKIL QUITX QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
QUIT:
BYE: PUSHJ P,FLUSCS ;THE COMMAND
BYE1: SKIPN DIACTV ;IF I/O ACTIVE, CAN'T QUIT YET
SKIPE DOACTV
JRST [SKIPE QUITNG ;GIVE INTERIM MESSAGE BUT ONCE
POPJ P,
SETOM QUITNG# ;THIS IS HOW
PUSHJ P,IMPSTR
ASCIZ /503 I'll split just as soon as the current transfer is done.
/
POPJ P,]
BYE2: PUSHJ P,IMPSTR
ASCIZ /221 CUL
/
ERRKIL: MTAPE IMP,NEWTMO ;Order of RELEASing changed to insure
RELEASE IMP, ;at least the control link gets closed.
PUSHJ P,FLUSH ;FLUSH ALL DATA I/O
MOVE A,['KILL-2']
MOVEM A,KFLAG
QUITX: RELEASE FIMP,3 ;IN CASE OF MAIL ABORT
SETZM PRIVS ;PARANOID? ME, PARANOID?
RESET ;IF ATTACHED TO A TERMINAL,
MOVNI B,1 ; START OVER (TEST AGAIN
GETLIN B ; IN CASE IT'S CHANGED).
AOJN B,QUIT1
EXIT
QUIT1: OUTSTR [ASCIZ /Starting over
/]
JRST START
ABOR: SETZM DIACTV ;FLUSH ALL ACTIVITY
SETZM DOACTV
SETZM DIHUNG ;AND RESET COROUTINES
SETZM DOHUNG
PUSHJ P,IMPSTR ;BARF SO WHAT IF SCARCE RESOURCE
ASCIZ /226 El grande de grosse ABORtion
/
PUSHJ P,FLUSH
JRST REGO ;RESET ALL ACTV, HUNG, AND PDLS
FLUSH: RELEASE FIMP,3 ;(The other mtapes get unassigned I/O
RELEASE FOMP,3 ;sometimes)
CHNSTS DIMP,A ;FIXING ABOVE LOSS
TRNE A,400000
MTAPE DIMP,NEWTMO
RELEASE DIMP,
CHNSTS DOMP,A ;FIXING ABOVE LOSS
TRNE A,400000
MTAPE DOMP,NEWTMO
RELEASE DOMP,
POPJ P,
NEWTMO: 17
BYTE (6) 2,24,24,7,7
NOIMP: MES(CANNOT INIT IMP)
JRST ERRKIL
UFLUSH: PUSHJ P,PUTBUF ; EXCRETE MESSAGE
MOVEI B,5
SLEEP B,
JRST QUITX
GREET:
MOVE E,[-LOURH3,,OURH3] ;aobjn ptr to list of our host nbrs
MOVE B,HOSTNO ;get nbr of foreign host
GREETL: CAMN B,(E) ;is this one of our host nbrs?
JRST GREET0 ;host nbr is ours, let us in even if system down
AOBJN E,GREETL ;no, check other numbers
MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET0
PUSHJ P,IMPSTR
ASCIZ/421- /
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS FTP Server at /
MOVE B,[PUSHJ P,PUTCHR] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
PUSHJ P,IMPSTR
ASCIZ\
421 Sorry, the system is being debugged. Try again later.
\
OUTSTR [ASCIZ/MaintMode: Refusing /]
PUSHJ P,SAYWHO
JRST UFLUSH
GREET0: PUSHJ P,IMPSTR
ASCIZ/220- /
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS FTP Server at /
MOVE B,[PUSHJ P,PUTCHR] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
MOVEI B,256 ; LASTDISASTERTIME
PEEK B,
PEEK B,
JUMPE B,NOFLAK
ACCTIM A,
SUB A,B
TLZE A,1 ;FORGIVE ONE DAY
ADDI A,=24*=60*=60
CAILE A,=15*=60
JRST NOFLAK
PUSHJ P,IMPSTR
ASCIZ/
The system is misbehaving. Proceed with caution!/
NOFLAK: MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET1
PUSHJ P,IMPSTR
ASCIZ/
The system is being debugged./
GREET1: PUSHJ P,IMPSTR
ASCIZ\
220 Bugs/gripes to Bug-FTP @ \
PUSHJ P,IMPSTH ;output our host name (SU-AI, S1-A, ...)
PUSHJ P,IMPCR ;output crlf
POPJ P,
SAYWHO: OUTSTR [ASCIZ /Connection from host /]
PUSHJ P,GETHNM
OUTSTR HSTSTR
OUTSTR [ASCIZ/
/]
POPJ P,
;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)
;Site-specific commands ;⊗ SITE
;Note (JJW 2/84): This is currently experimental, subject to change.
SITE: SETZ T3, ;No break chars
PUSHJ P,SIXINL ;Get sixbit string
CAMN T,[SIXBIT/SAIL/]
JRST [ SETOM SAILFL
PUSHJ P,IMPSTR
ASCIZ/200 Setting SAIL flag for ASCII transfers
/
JRST FLUSCS]
CAMN T,[SIXBIT/NOSAIL/]
JRST [ SETZM SAILFL
PUSHJ P,IMPSTR
ASCIZ/200 Clearing SAIL flag for ASCII transfers
/
JRST FLUSCS]
PUSHJ P,IMPSTR
ASCIZ/501 Only SITE commands implemented are SAIL and NOSAIL
/
JRST FLUSCS
;Unimplemented commands ;⊗ REIN PASV REST CDUP SMNT STOU RMD MKD IABORT
REIN:
PASV:
REST:
CDUP:
SMNT:
STOU:
RMD:
MKD:
PUSHJ P,IMPSTR
ASCIZ/502 Sorry, that command is not implemented
/
JRST FLUSCS
;(For debugging)
IABORT: MTAPE IMP,[22 ↔ 0]
MTAPE DOMP,[22 ↔ 0]
POPJ P,
END START