perm filename FTPS[NET,SYS]4 blob
sn#039786 filedate 1973-05-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00036 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE FTPS
C00010 00003 DEFINITIONS OF A "GLOBAL" NATURE
C00012 00004 ICP: INITIAL CONTROL LINK CONNECTION ESTABLISHMENT ROUTINE
C00015 00005 IDCON: INITIIZE DATA LINK CONNECTION ROUTINE
C00020 00006 ILDDEV - INITIALIZE LOCAL DATA DEVICE
C00024 00007 MAIN PROGRAM STARTS HERE
C00026 00008 AT THIS POINT, WE HAVE GOT A LETTER BACK FROM THE LOGGER
C00029 00009 MAIN LOOP OF FTPS
C00031 00010 ACUMULATOR SAVE, RESTORE ROUTINES, ALSO CLOCK TURNING-ON ROUTINE
C00033 00011 DISPATCH ROUTINES
C00036 00012 CI ROUTINE - READ COMMANDS FROM CONTROL LINK, SEND ANSWERS, ETC.
C00037 00013 APPEND, STOR, MLFL ROUTINE : RECEIVE A FILE FROM FOREIGN USER
C00040 00014 RNFR (RNTO), DELE ROUTINE : ZAP LOCAL FILES
C00043 00015 MAIL -- ACCEPT NETWORK MAIL
C00048 00016 STAT, FLST -- Send directory status
C00049 00017 RETR ROUTINE
C00050 00018 TYPE, MODE, STRU ROUTINES
C00053 00019 BYTE, SOCK ROUTINES
C00055 00020 BYTE: PUSHJ P,DECIN
C00057 00021 USER, PASS ROUTINES
C00058 00022 COMMAND STRING READER
C00060 00023 CONVERT COMMAND STRING TO INDEX
C00061 00024 PUTCHR - SEND ASCII CHARACTER OUT ON IMP CONTROL CONNECTION
C00064 00025 GETCHR - GET ASCII CHARACTER FROM IMP CONTROL CONNECTION
C00067 00026 ROUTINES TO OUTPUT ASCII INFORMATION ON CONTROL CHANNEL
C00070 00027 ANOTHER ROUTINE TO OUTPUT ASCII STRING TO IMP CONTROL CHANNEL
C00073 00028 SIXIN - READ SIXBIT FROM TTY (UP TO 6 CHARACTERS, FLUSH THE REST).
C00076 00029 ROUTINE TO READ A FILE SPECIFIER (OR PPN) FROM CONTROL CONNECTION
C00079 00030 DI ROUTINE - GET DATA FROM IMP, STORE IN SAIL FILE SYSTEM
C00083 00031 GETDAT - GET DATA BYTE FROM IMP DATA CONNECTION
C00086 00032 DOROUT - GET DATA FROM LOCAL FILE SYSTEM, TRANSMIT TO IMP
C00090 00033 GETFIL
C00091 00034 COURTESY DATGEN.FAI[SLS,DCS] -- DATE GENERATOR
C00095 00035 INTERRUPT LEVEL ROUTINE
C00096 00036 MISCELLANEOUS ERROR MESSAGES
C00101 ENDMK
C⊗;
TITLE FTPS
; CONTROL OF THE MULTIFARIOUS TELETYPE INFORMATION MESSAGES:
IFNDEF VERBOSE,<
VERBOSE ←← 1 ;SET TO 0 FOR QUIET
>;VERBOSE
; ACCUMULATOR DEFINITIONS:
↓A ← 1 ;TEMP
↓B ← 2 ;TEMP
C ← 3
D ← 4
E ← 5
F ← 6
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
MAILBOX:BLOCK 40;LETTER FROM LOGGER GOES HERE
ENVELOPE: SIXBIT/LOGGER/
MAILBOX
CONECB: BLOCK 7
CNIBTS: 0 ;INTERRUPT LEVEL ROUTINES PUTS BITS HERE
; 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
HLNUM: 0 ;HOST-LINK NUMBER FOR FOREIGN SITE
HOSTNO: 0 ;FOREIGN SITE NUMBER
UPPN: SIXBIT/NETGUE/ ;"LOCAL" PPN OF USER FTP
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
IMODES: 0 ↔ 10
FMODES: 0 ↔ 10
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
SCHEKF: 0 ;IF MINUSE, IT'S TIME TO CHECK IMP STATUS
OUTINSTR:0 ;FOR DATGEN, WHICH OUTPUT SINK TO WRITE CHARS TO
; 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
CPOPJ2: AOS (P)
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
DEFINE MES(TEXT) <
IFN 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
; DEFINITIONS OF A "GLOBAL" NATURE
ERRBTS ←← 0;
DEFINE X(BIT,VAL) <
BIT ← VAL ↔ ERRBTS ← ERRBTS!VAL
>
X(RSET,400) ; HOST SEND US A RESET
X(CTROV,1000) ; HOST OVERFLOWED OUR ALLOCATION
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
DEFINE NAMES <
; X(RNTO) ;MUST BE INDEX 1 WHEN DEFINED
X(USER)
X(PASS)
X(TYPE)
X(SOCK)
X(STRU)
X(MODE)
X(BYTE)
X(RETR)
X(STOR)
X(APPE)
; X(RNFR)
; X(DELE)
X(MAIL)
X(MLFL)
X(STAT)
X(HELP)
X(BYE)
>
INTINP ←← 000010
INTIMS ←← 000020
INTCLK ←← 000200
;OPCODE DEFINITONS:
OPDEF CLKINT [717B8]
OPDEF INTMSK [720B8]
OPDEF INTUUO [723B8]
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
OPDEF PTYUUO [711B8]
OPDEF PTOCNT [PTYUUO 3,]
; ICP: INITIAL CONTROL LINK CONNECTION ESTABLISHMENT ROUTINE
ICP: ;THIS ROUTINE ESTABLISHES BOTH CONTROL CONNECTIONS
; TO THE USER FTP, AND SKIP RETURNS. NON-SKIP RETURN
; INDICATES SOME KIND OF FAILURE.
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
SETZM CONECB
SETZM CONECB+FSLOC ;DON'T WAIT FOR CONNECTION
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
MOVE A,FCRS
MOVEM A,CONECB+FSLOC
MOVE A,HOSTNO
MOVEM A,CONECB+HNLOC
MOVEI A,10
MOVEM A,CONECB+BSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION OUT
MOVE A,LCRS
MOVEM A,CONECB+LSLOC
MOVE A,FCSS
MOVEM A,CONECB+FSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION IN
MOVEI A,4
MOVEM A,CONECB
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
MTAPE IMP,CONECB ;WAIT FOR OUT CONNECTION
STATZ IMP,ERRBTS ;TIMEOUT? (OR OTHER RANDOM ERROR)?
JRST ICPTO ; YES
PUSHJ P,ICPCHK
MOVE A,LCRS
MOVEM A,CONECB+LSLOC
MTAPE IMP,CONECB ;WAIT FOR IN CONNECTION
STATZ IMP,ERRBTS ;TIMEOUT OR OTHER ERROR?
JRST ICPTO ; YES
ifn verbose,<
outstr [asciz /CONTROL LINK ESTABLISHED TO ***** /]
move c,mailbox+4
movei a,5
iclp: movei b,
lshc b,6
addi b,40
outchr b
sojg a,iclp
mes (*****)
>;verbose
JRST CPOPJ1
ICPCHK: MOVE A,CONECB+STLOC
TRNN A,-1
STATZ IMP,ERRBTS
JRST ICPX
POPJ P,
ICPX: POP P,A ;RETURN UPLEVEL ON ERROR
MES (ERROR IN CONTROL CONNECTIONS)
POPJ P,
ICPTO: ;ICP Time Out
MES (ICP TIMES OUT)
MOVE A,['KILL-1']
MOVEM A,KFLAG
JRST QUIT
KFLAG: 0
ICPGTO: =16 ↔ 0
ICPSTO: =15 ↔ 0
; IDCON: INITIIZE DATA LINK CONNECTION ROUTINE
; 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:
IFN VERBOSE, <
OUTSTR [ASCIZ /INITIALIZING DATA LINK /]
JUMPN B,.+2
OUTSTR [ASCIZ /OUT/]
JUMPE B,.+2
OUTSTR [ASCIZ /IN/] >
PUSHJ P,IDSOCK ;TELL USER WHICH DATA SOCKET WE'RE USING
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,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
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,HOSTNO
MOVEM A,CONECB+HNLOC
MOVE A,DOBS(B)
MOVEM A,CONECB+BSLOC
SETZM CONECB+WFLOC ;DON'T WAIT FOR CONNECTION
IDCONC: MTAPE 000,CONECB ;INITIATE DATA CONNECTION W/ USER
IDCONX: INTOFF ;ARRIVE HERE IF WE MUST WAIT FOR CONNECTION
IDCONY: MTAPE 000,IDCONS ;GET STATUS OF DIMP
INTON
MOVE A,IDCONS+1(B)
TRNE A,77 ;ANY ERROR CODES?
POPJ P, ; YES
TLNE A,CLS ;ANYBODY CLOSING CONNECTION?
POPJ P, ; YES
TLC A,RFC
TLCN A,RFC ;CONNECTION COMPLETE?
JRST IDCONF ; YES, SUCCESS RETURN
ifn verbose,<
tlne a,200000 ;rfcs?
outchr ["S"]
tlne a,100000 ;rfcr?
outchr ["R"]
>;verbose
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)
XCT IDCONA(B) ;GET 2 BUFFERS
MOVE A,DOBS(B) ;GET CONNECTION BYTE SIZE
DPB A,IDCONP(B) ;SET BYTE SIZE IN BUFFER HEADER
JRST CPOPJ1
IDCONA: OUTBUF DOMP,2
INBUF DIMP,2
IDSOCS: ASCIZ /255 SOCK 0000000000XX/
IDSOCK: PUSHJ P,IDSOC0 ;PUT SOCKET NUMBER INTO ABOVE STRING
MOVEI D,15 ;PUT CRLF INTO ABOVE STRING
IDPB D,C
MOVEI D,12
IDPB D,C
SETZ D,
IDPB D,C
MOVE E,[POINT 7,IDSOCS]
MOVEI A,DOMP
ADD A,B ;C(A) = DIMP or DOMP
PUSHJ P,GSR ;GET PERMISSION TO OUTPUT ON CONTROL LINK
PUSHJ P,ASCIIE
SOS IMPSTF
POPJ P,
IDSOC0: MOVE C,[POINT 7,IDSOCS+1,27] ;POINTS TO " " AFTER "SOCK" IN IDSOCS
MOVE D,LDSS(B) ;GET DATA SOCKET NUMBER
IDSOC1: IDIVI D,12
PUSH P,E ;PUSH LOW ORDER DIGIT ONTO STACK
SKIPE D ;WAS IT HIGH ORDER DIGIT ALSO?
PUSHJ P,IDSOC1 ; NO, GET ANOTHER DIGIT
IDSOC2: POP P,D ;GET DIGIT
ADDI D,"0" ;CONVERT TO ASCIZ
IDPB D,C ;STUFF INTO STRING
POPJ P, ;GET NEXT DIGIT OR RETURN IF NONE
;; ILDDEV - INITIALIZE LOCAL DATA DEVICE
;;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,[XWD <DEVICE NAME IN SIXBIT>,0]
;; 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)
;; ,2 (FOR DATA IN FROM IMP, LOCAL ENTER)
;; ,3∨7 (FOR DATA IN FROM IMP, LOCAL UPDATE)
;; ,10 (FOR RENAME)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; SUCCESS RETURN
ILDDEV:
TRZ B,4
IFN VERBOSE, <
OUTSTR [ASCIZ /OPENING LOCAL FILE SYSTEM... /]
>
MOVE A,DOTYPE
TRNE B,1
MOVE A,DITYPE
MOVE A,FMODES(A)
MOVEM A,ILDD
CAIN C,0
MOVE C,UPPN
MOVEM C,ILDD+1
MOVEI A,2 ;ASSUME RENAME, USE INPUT CHANNEL
TRNE B,10 ;FORGET OPEN STUFF IF RENAMING
JRST DPBIT
MOVE A,[FOBUF
FIBUF,,0
FIBUF,,FOBUF]-1(B) ;BUFFER STRUCTURE
MOVEM A,ILDD+2
MOVE A,[2↔3↔3]-1(B) ;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,ILDDRN,12]
TRNE B,10 ;NO OPEN ON RENAME
JRST NOOPEN
ILDDO: OPEN 000,ILDD
POPJ P, ;ERROR RETURN, CAN'T OPEN DEVICE
NOOPEN:
IFN VERBOSE, <OUTSTR [ASCIZ / OPEN/]>
MOVEM F,ILDD
MOVEM E,ILDD+1
SETZM ILDD+2
TRNN D,-1 ;WAS A PROGRAMMER NAME SPECIFIED?
MOVE D,UPPN ; NO, USE THE DEFAULT PPN
MOVEM D,ILDD+3
TRNN B,1
JRST ILDDET
ILDDL1: INBUF 000,13
ILDDL: LOOKUP 000,ILDD
JRST [CAIE B,3 ;IF UPDATING, LOOKUP FAILURE IS OK
POPJ P, ; OTHERWISE, IT ISN'T
JRST .+1]
ILDDET: TRNN B,2
JRST ILDDD ;INPUT ONLY
ILDDE1: OUTBUF 000,13
MOVEM D,ILDD+3 ;REPLACE ZAPPED PPN
ILDDE: ENTER 000,ILDD
POPJ P, ;ERROR RETURN, CAN'T ENTER DEVICE
CAIN B,3 ;UPDATE FILE?
ILDDUG: UGETF 000,A ;DOES USETO TO NEXT FREE
ILDDD: TRNN B,10 ;RENAME TIME
JRST ILD123
ILDDRN: RENAME 000,ILDD ;DO IT
POPJ P, ;DIDN'T DO IT
ILD123: MES ( DONE)
JRST CPOPJ1
ILDD: BLOCK 4
; MAIN PROGRAM STARTS HERE
START: MOVE P,[XWD -PDLL,PDL] ;GET A PUSH DOWN LIST
MOVE CIP1
MOVEM CIP
MOVE DIP1
MOVEM DIP
MOVE DOP1
MOVEM 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
SETO B,
TTYUUO 6,B
MOVEM B,TTYNUM#
CAMN B,[-1] ;ARE WE DETATCHED?
JRST START2 ; YES
MOVE A,[SIXBIT /FTPS-D/];NO, SET DEBUGGING NAME
SETNAM A,
START1: WRCV MAILBOX ;WAIT FOR A LETTER
MOVE A,MAILBOX+3
CAME A,[SIXBIT /DEBUG?/];IS LETTER FROM THE MOGGER?
JRST START1 ; NO, CONTINUE WAITING
JRST START3 ; YES, WE GOT THE GOODIES!
START2: PJOB A, ;TELL THE LOGGER
MOVEM A,MAILBOX ; WHAT OUR JOB NUMBER IS
MOVE A,[SIXBIT /FTPS /] ; AND WHAT
MOVEM A,MAILBOX+1 ; OUR NAME IS.
MOVNI B,=120*=60 ;WE WILL WAIT FOR 2 MINUTES
SEND ENVELOPE ;SEND LETTER TO LOGGER
SRCV MAILBOX ;ANSWER YET?
JRST [MOVEI A,0 ; NO, SLEEP FOR
SLEEP A, ; ONE TICK
AOJL B,.-1 ;LOOK FOR LETTER AGAIN
MES(NO LETTER FROM LOGGER)
JRST QUIT ]
; FALL THROUGH ; YES
;AT THIS POINT, WE HAVE GOT A LETTER BACK FROM THE LOGGER
START3: MOVE A,MAILBOX ;LOCAL SOCKET NUMBER
MOVEM A,LCRS
MOVE B,TTYNUM
CAMN B,[-1]
JRST .+2
PUSHJ P,INIMES
ADDI A,1
MOVEM A,LCSS
ADDI A,1
MOVEM A,LDRS
ADDI A,1
MOVEM A,LDSS
MOVE A,MAILBOX+1 ;FOREIGN SOCKET
ADDI A,2
MOVEM A,FCRS
ADDI A,1
MOVEM A,FCSS
ADDI A,1
MOVEM A,FDRS
ADDI A,1
MOVEM A,FDSS
MOVE A,MAILBOX+2
MOVEM A,HLNUM
LSH A,-10
MOVEM A,HOSTNO
MOVE A,MAILBOX+4 ;GET CONNECTING SITE NAME IN SIXBIT
LSH A,-=12
TLO A,'F- '
SETNAM A, ;RENAME THIS JOB TO "F-<SITE NAME>"
INIT IMP,1
SIXBIT /IMP/
XWD OBUF,IBUF
JRST NOIMP
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]
MOVEI A,ILEVEL
MOVEM A,JOBAPR
; CLKINT 1,=1800 ;CLOCK INTERRUPTS WILL COME EVERY 30 SECONDS
MOVSI A,INTINP!INTIMS ; !INTCLK -- disable clock for a while
INTENB A, ;ENABLE FOR IMP INPUT INTERRUPTS
;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,GREET ;SEND USER OUR GREETING MESSAGE
;; MAIN LOOP OF FTPS
;; 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:
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 1,[0]
AOSLE XACTV ;ANYTHING STILL WANTING ATTENTION?
INTUUO 1,[-1 ↔ 1] ; NO, ENABLE INTERRUPTS AND WAIT
INTMSK 1,[1] ;ENABLE INTERRUPTS IN CASE WE SKIPPED
JRST LOOP
SCHEK: MTAPE IMP,STATUS
MOVE A,STATUS+1
OR A,STATUS+2
TLNN A,CLS ;CONTROL LINK CLOSING?
POPJ P, ; NO, ALL IS OK
IFN VERBOSE,<
OUTSTR [ASCIZ / CONTROL LINK CLOSED!/]
>;
JRST ERRKIL
STATUS: 2 ↔ 0 ↔ 0
;; ACUMULATOR SAVE, RESTORE ROUTINES, ALSO CLOCK TURNING-ON ROUTINE
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
; 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
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: 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,GSRCI ;GET PERMISSION TO OUTPUT ON CONTROL CHANNEL
PUSHJ P,IMPST0
ASCIZ /500 UNRECOGNIZED COMMAND: /
PUSHJ P,ASCII1
C
PUSHJ P,IMPST0
ASCIZ /
/
SOS IMPSTF ;RETURN PERMISSION
JRST FLUSCS
;; APPEND, STOR, MLFL ROUTINE : RECEIVE A FILE FROM FOREIGN USER
APPE: SKIPA B,[3] ;APPEND
STOR: MOVEI B,2 ;STORE
MOVEM B,STORTYP# ;SAVE FOR MESSAGE LATER
SKIPE DIACTV ;DATA CHANNEL ALREADY IN USE?
JRST STORX0 ; YES
PUSHJ P,GFN ;GET FILE NAME
JRST STORX1 ; DIDN'T GET ONE
MOVE B,STORTYP
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST STORX2 ; 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
MLFL: SKIPE DIACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST STORX3
PUSHJ P,MLFLNM ;GET A MESSAGE FILE NAME
JRST USER2 ;ERROR
MOVEI B,7 ;SPECIAL MAIL STORE TYPE
MOVEM B,STORTYP
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST STORX2 ; 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
PUSHJ P,WRHDR ;WRITE HEADER INFO INTO FILE
SETOM DIACTV ;STARTUP DI ROUTINE
JRST FLUSCS ;FLUSH COMMAND STRING & RETURN
STORX0: PUSHJ P,DIMPSTR
ASCIZ /505 STOR REJECTED: YOU ARE ALREADY TRANSMITTING
/
STOR1: JRST FLUSCS ;FLUSH REST OF COMMAND STRING
STORX1: PUSHJ P,DIMPSTR
ASCIZ /501 CAN'T PARSE YOUR PATHNAME
/
JRST FLUSCS
STRX22: MOVE A,DITSAV
MOVEM A,DITYPE
STORX2: PUSHJ P,DIMPSTR
ASCIZ /449 CAN'T INITIALIZE LOCAL FILE SYSTEM - SORRY
/
JRST FLUSCS
;; RNFR (RNTO), DELE ROUTINE : ZAP LOCAL FILES
RNFR: SKIPA B,[30] ;RENAME
DELE: MOVEI B,10 ;DELETE
MOVEM B,STORTYP ;SAVE WHICH
SKIPE DIACTV
JRST STORX0
PUSHJ P,GFN ;FIRST OR ONLY FILE
JRST STORX1
MOVEI B,1
PUSHJ P,ILDDEV ;DO THE LOOKUP
JRST STORX2 ; COULDN'T FIND
MOVEI C,0 ;ASSUME DELETION
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 /200 RNFR OK, Please issue RNTO
/
GCRNTO: PUSHJ P,GETCOM ;NOW GET THE NEXT
JRST RELDMP ;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 /254 File Deleted Successfully
/
JRST RELDMP
RNMOK: PUSHJ P,IMPSTR ;OK RESPONSE
ASCIZ /253 File Renamed Successfully
/
RELDMP: RELEASE DIMP, ;CLOSE DOWN
JRST FLUSCS
BADTO: PUSHJ P,IMPSTR
ASCIZ /505 Must have RNTO after RNFR, rename sequence aborted.
/
JRST RELDMP
BDTONM: PUSHJ P,IMPSTR
ASCIZ /501 Can't parse your pathname, rename sequence aborted.
/
JRST RELDMP
BADDRN: JUMPN F,BDRN
PUSHJ P,IMPSTR
ASCIZ /451 Delete Operation Failed
/
JRST RELDMP
BDRN: PUSHJ P,IMPSTR
ASCIZ /451 Rename Operation Failed
/
JRST RELDMP
RNTO: PUSHJ P,IMPSTR ;Shouldn't get here bare, RNFR traps good ones.
ASCIZ /505 Must have RNFR before RNTO, rename sequence aborted.
/
JRST FLUSCS
;; MAIL -- ACCEPT NETWORK MAIL
MAIL: SKIPE DIACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST STORX3
PUSHJ P,MLFLNM ;GET A MESSAGE FILE NAME
JRST USER2 ;ERROR
PUSHJ P,FLUSCS ;FLUSH USER ID LINE
PUSH P,E
PUSHJ P,IMPSTR
ASCIZ /350 Type mail, ended by a line with only a "."
/
POP P,E
MOVEI A,0 ;TYPE ASCII
EXCH A,DITYPE ;LOCAL FILE COUNTS ON ASCII
MOVEM A,DITSAV#
MOVEI B,7 ;CODE FOR MAIL STORE
MOVEM B,STORTYPE
PUSHJ P,ILDDEV ;OPEN FILE FOR OUTPUT
JRST STRX22
PUSHJ P,WRHDR
; here at every new mail line
MAILIN: PUSHJ P,GETCHR ;CHARACTER OF MAIL
CAIE A,"." ;".", MAY BE END OF MSG
JRST NODOT
PUSHJ P,GETCHR ;SEE
CAIN A,15 ;END OF MAIL
JRST EOMAIL
MOVE B,A ;WRITE THE DOT, THEN THE CHAR
MOVEI A,"."
PUSHJ P,WRTCHR
MOVE A,B
;here with each new char
NODOT: PUSHJ P,WRTCHR
CAIN A,12 ;END OF LINE?
JRST MAILIN
PUSHJ P,GETCHR
JRST NODOT
EOMAIL: RELEASE DIMP,0 ;FINISH MAIL
MOVE A,DITSAV
MOVEM A,DITYPE
PUSHJ P,IMPSTR
ASCIZ /256 Mail completed successfully
/
JRST FLUSCS
WRHDR: MOVE B,[PUSHJ P,WRTCHR]
MOVEM B,OUTINSTR
MOVEI B,RCDFRM
PUSHJ P,WRTSTR ;Net mail from
MOVE A,UPPN
CAMN A,['NETGUE']
JRST NOUSER
MOVEI B,RCDUSR
PUSHJ P,WRTSTR ;User
HRLZ B,UPPN
PUSHJ P,WRTSIX ; PN
MOVEI B,COMSPC
PUSHJ P,WRTSTR ;,
NOUSER: MOVEI B,RCDWHR
PUSHJ P,WRTSTR ;site
MOVE B,MAILBOX+4
PUSHJ P,WRTSIX
MOVEI B,RCDWHEN
PUSHJ P,WRTSTR ; rcvd at
PUSHJ P,DATGEN ; DD-MMM-YY TTTT PXT
MOVEI B,RCDCR
JRST WRTSTR ; <CRLF>
RCDFRM: ASCIZ /Net mail from /
RCDUSR: ASCIZ /user /
COMSPC: ASCIZ /, /
RCDWHR: ASCIZ /site /
RCDWHEN:ASCIZ / rcvd at /
RCDCR: ASCIZ /
/
WRTSTR: HRLI B,(<POINT 7,0>)
WRTST1: ILDB A,B
JUMPE A,CPOPJ
XCT OUTINSTR
JRST WRTST1
wrtsix: movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,wrtchr
wrsoj: sojg c,wrlp
popj p,
WRTCHR: SOSG FIBUF+2
OUT FIMP,
CAIA
JRST IERR4
IDPB A,FIBUF+1
POPJ P,
IERR4: PUSHJ P,IMPSTR
ASCIZ /050 Local file system error, mail aborted
/
JRST ERRKIL
STORX3: PUSHJ P,IMPSTR
ASCIZ /505 STOR REJECTED: YOU ARE ALREADY TRANSMITTING
/
JRST FLUSCS
HELP: PUSHJ P,IMPSTR
ASCIZ /050 Implemented Commands: HELP,USER,TYPE,MODE,BYTE,
050 RETR,STOR,APPE,MAIL,DELE,RNFR,RNTO.
050 Image (36 bits) or Ascii (8 bits) Type only at present, Stream Mode only.
050 Report problems to Ralph Gorin (MAIL REG).
/
JRST FLUSCS
USER2: PUSHJ P,IMPSTR
ASCIZ *451 NO SUCH USER. USER NAMES ARE PPP OR PRJ,PPP
*
JRST FLUSCS
;; STAT, FLST -- Send directory status
STAT: SKIPE DIACTV ;DON'T DO IT IF THINGS ARE HAPPENING
JRST STORX3
PUSHJ P,MLFLNM ;GET A MESSAGE FILE NAME
JRST USER2 ;ERROR
MOVSI E,'UFD'
MOVE D,['2 2']
PUSHJ P,FLUSCS ;FLUSH USER ID LINE
PUSH P,E
PUSHJ P,IMPSTR
ASCIZ /350 Type mail, ended by a line with only a "."
/
POP P,E
MOVEI A,0 ;TYPE ASCII
EXCH A,DITYPE ;LOCAL FILE COUNTS ON ASCII
;; RETR ROUTINE
RETR: SKIPE DOACTV
JRST RETRX0
PUSHJ P,GFN ;GET FILE NAME
JRST RETRX1 ; DIDN'T GET ONE
MOVEI B,1
PUSHJ P,ILDDEV ;INITIALIZE LOCAL DATA DEVICE
JRST RETRX2
MOVEM F,DOACS+F
MOVEM F,DOACS+F
MOVEM F,DOACS+F
MOVEM F,DOACS+F
SETOM DOACTV
JRST FLUSCS
RETRX0: PUSHJ P,DOMPSTR
ASCIZ /505 RETR REJECTED: YOU ARE ALREADY RECEIVING
/
JRST FLUSCS
RETRX1: PUSHJ P,DOMPSTR
ASCIZ /501 CAN'T PARSE YOUR PATHNAME
/
JRST FLUSCS
RETRX2: PUSHJ P,DOMPSTR
ASCIZ /449 CAN'T INITIALIZE LOCAL FILE SYSTEM - SORRY
/
JRST FLUSCS
;; TYPE, MODE, STRU ROUTINES
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 (400 UNRECOGNIZED TYPE)]
JRST .+1(A)
JRST TYPEOK
JRST TYPEOK
JRST TYPEUN
JRST TYPEUN
JRST TYPEUN
TYPEUN: REPMES (400 UNIMPLEMENTED TYPE)
TYPEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (504 BOTH DATA CHANNELS BUSY)]
TYPEGO: SKIPN DOACTV
MOVEM A,DOTYPE
SKIPN DIACTV
MOVEM A,DITYPE
CAIN A,0 ;SETING TYPE TO ASCII?
PUSHJ P,BYTE8 ; YES, MAKE SURE BYTE SIZE IS 8
REPMES (200 TYPE OK)
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 (400 UNIMPLEMENTED MODE)
MODEOK: SKIPN DIACTV
SKIPE DOACTV
JRST [REPMES (504 BOTH DATA CHANNELS BUSY)]
SKIPN DOACTV
MOVEM A,DOMODE
SKIPN DIACTV
MOVEM A,DIMODE
REPMES (200 MODE OK)
STRU: PUSHJ P,GETCAP
CAIN A,"F"
JRST [REPMES (200 FILE STRUCTURE OK)]
CAIN A,"R"
JRST [REPMES (400 RECORD STRUCTURE NOT IMPLEMENTED)]
REPMES (501 UNRECOGNIZED STRUCTURE)
;; BYTE, SOCK ROUTINES
DECIN: ;READ A DECIMAL ARGUMENT (TERMINATED BY SPACE OR CR) FROM IMP
;CALL: PUSHJ P,DECIN
; ERROR RETURN (NON NUMERIC IN ARGUMENT)
; NORMAL RETURN (C(B) = NUMBER, C(A)=DELIMETER)
SETZ B,
DECIN0: PUSHJ P,GETCHR
CAIE A,15 ;CR?
CAIN A," " ;SPACE?
JRST CPOPJ1 ; YES TO EITHER
CAIL A,"0"
CAILE A,"9"
POPJ P, ;ILLEGAL CHARACTER
IMULI B,=10
ADDI B,-"0"(A)
JRST DECIN0
BYTE8: MOVEI B,=8
BYTEIT: SKIPN DOACTV
MOVEM B,DOBS
SKIPN DIACTV
MOVEM B,DIBS
POPJ P,
SOCK: PUSHJ P,DECIN
JRST [REPMES (501 BAD SOCK ARGUMENT)]
CAIL B,1B4 ;SOCKET NUMBER WILL FIT IN 32 BITS?
JRST [REPMES (503 SOCKET NUMBER TOO BIG)]
ILDB C,[POINT 1,B,35]
MOVEM B,FDRS(C) ;STORE IN FDRS OR FDSS
CAIE A,15 ;C.R. WAS THE TERMINATING CHR.?
JRST SOCK ; NO, GET ANOTHER ARGUMENT
REPMES (<200 SOCK ARGUMENT(S) O.K.>)
BYTE: PUSHJ P,DECIN
JRST [REPMES (501 BAD ARGUMENT TO BYTE)]
SKIPE DIACTV
SKIPN DOACTV
CAIA
JRST [REPMES (504 CAN'T RESET BYTE SIZE - BOTH DATA CHANNELS ARE BUSY!)]
CAILE B,=255
JRST [REPMES (503 BYTE SIZE TOO BIG)]
CAIN B,=8 ;BYTE SIZE IS EIGHT?
JRST BYTE1 ; YES
SKIPN DIACTV ; NO, MAKE SURE IS DOSN'T CONFLICT WITH ASCII TYPE
SKIPN DIMODE
CAIA
JRST [REPMES (505 BYTE SIZE MUST BE 8 FOR TYPE ASCII)]
SKIPN DOACTV
SKIPN DOMODE
JRST BYTE4
JRST .-4
BYTE1: MOVE A,DITYPE
SKIPN DIACTV
CAIE A,1
JRST BYTE3 ;NO NEED TO CHECK BYTE-IMAGE COMPATIBLIITY FOR DIMP
PUSHJ P,BYTE9 ;IS 36 MOD BYTESIZE = 0?
BYTE2: JRST [REPMES (505 BAD BYTE SIZE FOR IMAGE MODE)]
BYTE3: MOVE A,DOTYPE
SKIPN DOACTV
CAIE A,1
JRST BYTE4 ;BYTE SIZE HAS PASSED ALL TESTS
PUSHJ P,BYTE9
JRST BYTE2
BYTE4: PUSHJ P,BYTEIT
REPMES (200 BYTE SIZE OK)
BYTE9: MOVEI C,=36
IDIV C,B ;IS 36 MOD (BYTESIZE) = ZERO?
JUMPE D,CPOPJ1 ; YES
POPJ P, ; NO
; USER, PASS ROUTINES
PASS: PUSHJ P,IMPSTR
ASCIZ /200 NO PASSWORD REQUIRED
/
JRST FLUSCS
USER: PUSHJ P,GPPN ;GET PPN IN SIXBIT INTO ACCUMULATOR D
JRST USER1 ; DIDN'T GET IT
MOVEM D,UPPN
PUSHJ P,IMPSTR
ASCIZ /230 USER NAME OK
/
JRST FLUSCS
USER1: PUSHJ P,IMPSTR
ASCIZ *431 INVALID NAME. USERS ARE PRJ,PRG.
*
JRST FLUSCS
; COMMAND STRING READER
GETCOM: ;CALL: PUSHJ P,GETCOM
; RETURN HERE, NON-SYNTACTICAL COMMAND
; RETURN HERE, C(C) = COMMAND (IN ASCIZ),
;CLOBBERS A,B,C,D
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 /501 COMMAND MORE THAN 4 CHARACTERS/
PUSHJ P,ASCII1
C
PUSHJ P,IMPCR
SOS IMPSTF
FLUSCS: ;FLUSCH COMMAND STRING
ifn verbose,<
outchr [173] ;flushing (dcs: 4-12-73)
>;
flcs1: PUSHJ P,GETCHR ;GET CHARACTER
CAIN A,15 ;C.R.?
JRST FLCS1 ; YES, IGNORE
CAIE A,12 ;L.F.?
JRST FLCS1 ;LOOP FOR NEXT
ifn 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: ;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
;; PUTCHR - SEND ASCII CHARACTER OUT ON IMP CONTROL CONNECTION
PUTCH1:
ifn verbose,<
OUTCHR A
>;
PUTCHR: ;CALL: MOVE A,<ASCII CHARACTER>
; PUSHJ P,PUTCHR
; RETURN HERE ALWAYS, ALL ACCUMULATORS INTACT
JUMPE A,CPOPJ ;DON'T OUTPUT NULL CHARACTER
SOSG OBUF+2 ;ROOM IN BUFFER FOR THIS CHARACTER?
PUSHJ P,PUTBUF ; NO, MAKE ROOM BY OUTPUTTING BUFFER
IDPB A,OBUF+1 ; YES, STUFF IT IN
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
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,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)
;; GETCHR - GET ASCII CHARACTER FROM IMP CONTROL CONNECTION
GETCHR: ;CALL: PUSHJ P,GETCHR
; RETURN HERE ALWAYS, C(A) HAS CHARACTER
; CLOBBER NO ACCUMULATORS
SOSG IBUF+2 ;CHR IN BUFFER?
JRST GETCH2 ; NO, DO AN INPUT
GETCH1: ILDB A,IBUF+1
CAIN A,202 ;NOP?
JRST GETCHR ; YES, GET ANOTHER CHARACTER
JUMPE A,GETCHR ;IGNORE NULLS
ifn verbose,<
trne a,200
outchr ["↑"]
outchr a
>;verbose
TRNN A,200 ;CONTROL CHARACTER?
POPJ P, ; NO, RETURN IMMEDIATELY
POPJ P, ;RETURN, WHATEVER IT IS
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,
; ROUTINES TO OUTPUT ASCII INFORMATION ON CONTROL CHANNEL
; 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
ifn verbose,<
outchr a ;how are we responding?
>;verbose
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
ifn verbose,<
outchr a
>;verbose
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
;; ANOTHER ROUTINE TO OUTPUT ASCII STRING TO IMP CONTROL CHANNEL
;; IMPST0 IS A ROUTINE TO OUTPUT AN ASCII STRING TO THE IMP CONTROL
;;CHANNEL. HOWEVER, SERVERAL 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
ifn verbose,<
outstr @(p) ;what are we telling him?
>;verbose
POP P,E
HRLI E,(<POINT 7,0>)
PUSH P,A
IMPST1: ILDB A,E
JUMPE A,IMPST2
PUSHJ P,PUTCHR
JRST IMPST1
IMPST2: POP P,A
SOS IMPSTF
JRST 1(E)
IMPCR: PUSHJ P,IMPSTR
ASCIZ /
/
POPJ P,
; SIXIN - READ SIXBIT FROM TTY (UP TO 6 CHARACTERS, FLUSH THE REST).
;CR'S ARE IGNORED, ALSO LEADING SPACES AND TABS
;CALL: MOVE T3,[POINT 7,[ASCIZ /<BREAK CHARACTERS>/]]
; PUSHJ P,SIXIN
; RETURN HERE ALWAYS,
; C(T) = LEFT JUSTIFIED SIXBIT
; C(T1)= BREAK CHARACTER:
; ILLEGAL 6BIT(1-37),LF(12),OR FROM TABLE(1-177)
SIXIN:
SIXINL: PUSH P,[SIXINN] ;RETURN THROUGH SIXINN TO NORMALIZE LEFT
SIXINR: SETZ T, ;PUSHJ TO HERE FOR RIGHT NORMALIZATION
PUSH P,A
PUSH P,T3 ;SAVE POINTER TO BREAK CHARACTERS
SIXIN1: PUSHJ P,GETCHR ;C(A) GETS CHARACTER
MOVE T1,A
CAIE T1,40
CAIN T1,11
JRST [JUMPE T,SIXIN1 ;IGNORE LEADING BLANKS AND TABS
JRST SIXIN4 ];ELSE RETURN
CAIE T1,15
CAIN T1,12
JRST SIXIN4 ;RETURN ON CR OR LF
MOVE T3,(P) ;T3 ← POINTER TO BREAK CHARACTERS
SIXIN2: ILDB T2,T3 ;T2 ← BREAK CHARACTER FROM TABLE
JUMPE T2,SIXIN3 ;JUMP ON END OF BREAK TABLE
CAMN T2,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
CAIG T1,40
JRST SIXIN4 ;RETURN IF CHAR. HAS NO SIXBIT CODE
SUBI T1,40
ANDI T1,77
TLNE T,770000 ;ALREADY HAVE 6 CHARACTERS?
JRST SIXIN1 ; YES, FLUSH EXTRA CHARACTERS
LSH T,6
IOR T,T1
JRST SIXIN1 ;READ NEXT CHARACTER
SIXINN: JUMPE T,.+2
SIXIN5: TLNE T,770000 ;CAN 6BIT BE SHIFTED LEFT?
POPJ P, ; NO
LSH T,6 ; YES
JRST SIXIN5
SIXIN4: POP P,T3 ;RESTORE POINTER TO BREAK CHARACTERS
POP P,A ;RESTORE ACCUMULATOR A
POPJ P, ;AND RETURN
;; ROUTINE TO READ A FILE SPECIFIER (OR PPN) FROM CONTROL CONNECTION
;; 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: MOVSI C,'DSK' ;DISK IS ASSUMED DEVICE
SETZB D,E
MOVE T3,[POINT 7,[ASCIZ /.[/]]
PUSHJ P,SIXINL
MOVE F,T ;SET FILE NAME
CAIE T1,"." ;EXTENSION IS NEXT?
JRST GFN1 ; NO
MOVE T3,[POINT 7,[ASCIZ /[/]]
PUSHJ P,SIXINL
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
GPPN: ;ENTER HERE FOR PPN ONLY
MOVE T3,[POINT 7,[ASCIZ /,/]]
PUSHJ P,SIXINR
TLNE T,-1 ;PROJECT NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
MOVS D,T
CAIE T1,"," ;PROJECT & PROGRAMMER NAMES DELIMITED OK?
POPJ P, ; NO, ERROR RETURN
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
;; MLFLNM
MLFLNM: MOVSI C,'DSK'
MOVSI E,'MSG'
PUSHJ P,GPPN
JRST [MOVE D,T ;IF NO COMMA WAS FOUND, THAT'S
TLNN T,-1 ; OK, MAILING TO PROGRAMMER ONLY
JRST OKMF ; ELSE P OR PN WAS
POPJ P,] ;TOO LONG
OKMF: MOVE F,D
MOVE D,['2 2] ;PERSON.MSG[2,2]
JRST CPOPJ1 ;SUCCESS RETURN
;; DI ROUTINE - GET DATA FROM IMP, STORE IN SAIL FILE SYSTEM
;; ENVIRONMENTAL PREQUISITES FOR CALLING DIROUT:
;; 1) SAIL FILE SYSTEM IS INITIALIZED, AND HAS BEEN
;; "ENTERED". THE DI ROUTINE WILL STORE THE FILE IN SAIL
;; 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
;; SAIL, 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 SAIL FILE
;; SYSTEM.
;; 4) CLOSES DATA CONNECTION AND RELEASES SAIL 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 SAIL FILE SYSTEM
DIROUT: MOVEI B,1 ;INDICATE DATA DIRECTION "IN"
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST DIERR ;ERROR
;;# DCS 10-15-72 ADD FTP START RESPONSE HERE PER CMU REQUEST
PUSHJ P,DIMPSTR
ASCIZ /250 STOR COMMAND OK, PLEASE BEGIN TRANSFER
/
;;# DCS
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 DIEOF ; EOF RETURN
SOSG FIBUF+2 ;ROOM IN BUFFER?
OUT FIMP, ; NO, DO AN OUTPUT
CAIA
JRST DIERR2 ; OUTPUT FAILS
IDPB A,FIBUF+1 ;STUFF DATA BYTE INTO BUFFER
AOJL C,DIROU2
PUSHJ P,SXACTV
PUSHJ P,DIWAIT
JRST DIROU1
DIERR: PUSHJ P,DIMPSTR
ASCIZ /050 DATA LINK FROM YOU TO US CLOSED EARLY?
/
JRST DIEOF
DIERR2: PUSHJ P,DIMPSTR
ASCIZ /050 LOCAL FILE SYSTEM ERROR, DATA FROM YOU TO US
/
; JRST DIEOF
DIEOF: PUSHJ P,DIMPSTR
ASCIZ /252 DATA TRANSFER COMPLETE, FROM YOU TO US
/
RELEASE FIMP,
RELEASE DIMP,
SETZM DIACTV
SKIPN QUITNG ;IF TRIED TO QUIT, TRY
POPJ P, ; AGAIN (MULTIPLE-SUICIDE MODE)
JRST BYE1
DIERR3: PUSHJ P,DIMPSTR
ASCIZ /??????
/
JRST DIERR2
;; GETDAT - GET DATA BYTE FROM IMP DATA CONNECTION
;; 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
TLNE A,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 COSES
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.
;; DOROUT - GET DATA FROM LOCAL FILE SYSTEM, TRANSMIT TO IMP
;; ENVIRONMENTAL PREREQUISITES FOR CALLING DOROUT:
;; 1) SAIL 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: MOVEI B,0
PUSHJ P,IDCON ;INITIALIZE DATA CONNECTION
JRST DOERR ; CAN'T MAKE DATA CONNECTION
PUSHJ P,DOMPSTR
ASCIZ /250 RETR OK, FTP TRANSFER IS BEGINNING
/
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 /252 EOF FOR DATA, US TO YOU
/
DOEOF1: PUSHJ P,DOROU3
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 /050 LOCAL FILE SYSTEM ERROR, DATA FROM US TO YOU
/
JRST DOEOF1
;; GETFIL
GETFIL: ;CALL: PUSHJ P,GETFIL
; ERROR RETURN
; EOF RETURN
; NORMAL RETURN
SOSG FOBUF+2
JRST GETFI2 ; NO, DO AN INPUT
GETFI1: ILDB A,FOBUF+1 ; YES, GET THE BYTE
JRST CPOPJ2 ; AND RETURN
;;GETFI2: ifn verbose, < outstr [asciz/ in fomp: /]
;; pushj p,pause >
GETFI2: IN FOMP, ;DO AN INPUT
JRST GETFI1 ; INPUT IS SUCCESSFUL
;; ifn verbose, < outstr [asciz / non-normal return from in fomp!! /]
;; pushj p,pause >
GETSTS FOMP,B ;C(B) ← STATUS BITS
TRNE B,IODEND ;END OF FILE?
JRST CPOPJ1 ; YES
MES (ERROR DETECTED ON FOMP)
POPJ P,
;COURTESY DATGEN.FAI[SLS,DCS] -- DATE GENERATOR
BEGIN DATGEN
AC1←←T1
AC2←←T2
AC3←←T3
DEFINE SETSTK < >
OPDEF RETURN [POPJ P,]
; ALL TESTS SUCCEED
FOR X ⊂ (DOTIME,DODATE,DOZONE) <DEFINE X(Y) < >
>
; OUTPUT IS TO DISK FILE
DEFINE STROUT(X) <
MOVEI B,X
PUSHJ P,WRTSTR
>
IFNDEF PRNUM, <
DEFINE OUT1 (X) <MOVE A,X
XCT OUTINSTR
>
DEFINE PRNUM(X,N) <
IFN X-AC2,<MOVE AC2,X ;arranged to be ok for this routine,
; to clobber AC2 whenever prnum called>
PUSHJ P,NUMPR ;ok to generate multiple words
N ; in PRNUM -- this is min width
>;PRNUM
NUMPR:PUSH P,AC1
MOVE AC1,@-1(P)
PUSHJ P,NUMPR1
POP P,AC1
AOS (P)
POPJ P,
NUMPR1:IDIVI AC2,=10
IORI AC3,"0"
HRLM AC3,(P)
SUBI AC1,1
JUMPE AC2,.+2
PUSHJ P,NUMPR1
JUMPLE AC1,DON0
OUT1 (["0"])
SOJG AC1,.-1
DON0:HLRZ AC2,(P)
OUT1 AC2
POPJ P,
>;NO PRNUM DEFINED
; THE DATGEN ROUTINE
DEFINE DOZON(X) <DODATE(X)↔DOZONE(X)>
↑↑DATGEN:
DATE AC1,
IDIVI AC1,=31
ADDI AC2,1
DODATE (NODA1)
PRNUM (AC2,0)
NODA1: IDIVI AC1,=12
MOVEI AC3,PDDATE
CAILE AC2,3
CAILE AC2,=9
MOVEI AC3,PSDATE
MOVEM AC3,DTKIND
MOVE AC2,MONTAB(AC2)
DODATE (NODATE)
STROUT (AC2) ;AC3 HAS LH BYTE 0
MOVEI AC2,=64(AC1)
PRNUM (AC2,2)
NODATE:DOTIME NOTIME
STROUT (<[ASCIZ / /]>)
MSTIME AC2,
IDIVI AC2,=1000*=60
IDIVI AC2,=60
MOVE AC1,AC3
PRNUM (AC2,2)
MOVE AC2,AC1
PRNUM (AC2,2)
NOTIME:DOZON (NOZON)
STROUT (@DTKIND)
NOZON: RETURN
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
; INTERRUPT LEVEL ROUTINE
ILEVEL: MOVE A,JOBCNI
ifn verbose, <
PTOCNT LOOK
MOVE b,LOOK+1
CAILE b,=120
JRST DNTSAY
outchr ["↔"]
tlne a,intclk
outchr ["c"]
tlne a,intinp
outchr ["p"]
tlne a,intims
outchr ["s"] >
DNTSAY: TLNE A,INTIMS!INTCLK
SETOM SCHEKF ;Status CHecK Flag
MOVE A,[-3]
MOVEM A,XACTV
DISMIS
SXACTV: PUSH P,[-3] ;HANDY ROUTINE TO SET XACTV
POP P,XACTV ; WITHOUT CLOBBERING ANY
POPJ P, ; ACCUMULATORS
ifn verbose, <
LOOK: 0↔0
>
; MISCELLANEOUS ERROR MESSAGES
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 /232 BYE received, will terminate after transfer.
/
POPJ P,]
BYE2: PUSHJ P,IMPSTR
ASCIZ /231 BYE command received. Good bye.
/
ERRKIL: RELEASE IMP,
RELEASE DIMP,
RELEASE DOMP,
RELEASE FIMP,
RELEASE FOMP,
MOVE A,['KILL-2']
MOVEM A,KFLAG
QUIT: RESET ;IF ATTACHED TO A TERMINAL,
MOVNI B,1 ; START OVER (TEST AGAIN
GETLIN B ; IN CASE IT'S CHANGED).
AOJN B,START
EXIT
NOIMP: MES(CANNOT INIT IMP)
JRST ERRKIL
GREET: PUSHJ P,IMPSTR
ASCIZ /300 SU-AI FTP Server 3.7 -- at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
PUSHJ P,IMPSTR
ASCIZ /
/
POPJ P,
INIMES: ;ARRIVE HERE TO TYPE OUT OUR SOCKET NUMBER
OUTSTR [ASCIZ /FTPS GETS SOCKET /]
MOVSI B,-14
MOVE D,A
SETZ C,
LSHC C,3
ADDI C,"0"
OUTCHR C
AOBJN B,.-4
OUTSTR [ASCIZ / FROM LOGGER
/]
POPJ P,
END START