COMMENT ⊗   VALID 00046 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002		TITLE	FTPSRV -- FILE TRANSFER PROTOCOL SERVER
C00011 00003	[96bit]H=	11		HOST TABLE INDEX FOR LOCAL HOST
C00014 00004		SUBTTL	INITIALIZATION
C00017 00005	SEARCH FOR A PTY WE CAN HAVE
C00019 00006	HERE WHEN THERE IS NO TELNET CONNECTION OPEN.  IF FTPSRV IS
C00023 00007	CONTINUATION OF ICP CODE and repeat 0
C00025 00008		SUBTTL	COMMAND TABLES
C00027 00009	ASSEMBLE COMMAND NAMES
C00028 00010	ASSEMBLE COMMAND DISPATCH TABLE
C00029 00011		SUBTTL	FTP COMMAND DECODING AND DISPATCH
C00031 00012	HERE WHEN A MESSAGE ARRIVES FROM THE IMP.  FIRST, READ THE ENTIRE
C00037 00013	HERE WHEN A COMPLETE COMMAND HAS BEEN INPUT.  DECIPHER IT
C00040 00014		SUBTTL	SYSTEM ACCESS COMMANDS
C00041 00015	   PASS <PASSWORD>
C00043 00016	   BYE
C00046 00017		SUBTTL	DATA TRANSFER PARAMETER COMMANDS
C00048 00018	   SOCK <SOCKET>      OR     SOCK <HOST>,<SOCKET>
C00052 00019	repeat 0,<	 con't handle odd types
C00054 00020	repeat 0,<	 not implemented in TCP
C00056 00021	repeat 0,<	 not implemented in this TCP hack
C00058 00022		SUBTTL	FTP DATA TRANSFER FUNCTIONS
C00060 00023	   STOR <PATHNAME>
C00064 00024	     MLFL <PPN>
C00067 00025		SUBTTL	MISCELLANEOUS FTP FUNCTIONS
C00070 00026	   DELE <PATHNAME>
C00073 00027	   STAT	OR	STAT <PATHNAME>
C00076 00028	   HELP
C00079 00029		SUBTTL	NONSTANDARD FUNCTIONS
C00082 00030	    XREP	(REPLAY RECORDED PTY DIALOGUE, FOR DEBUGGING)
C00084 00031		SUBTTL	SUBROUTINES
C00086 00032	ROUTINE TO WAIT FOR COMPLETION OF A DATA TRANSFER FUNCTION
C00088 00033	ROUTINE TO PERFORM A "FREE" FTP LOGIN
C00093 00034	ROUTINE TO LOG THE SUBJOB OUT.
C00096 00035	ROUTINE TO WAIT FOR A RESPONSE FROM THE SUBJOB.
C00101 00036	ROUTINE TO COPY A RESPONSE FROM THE PTY TO THE IMP.
C00104 00037	ROUTINE TO INPUT A DECIMAL NUMBER FROM THE CURRENT INPUT DEVICE
C00107 00038	ROUTINE TO BUFFER PTY OUTPUT SO WE CAN SEND IT SOME DATA
C00110 00039	ROUTINE TO DO WCH OPERATION FOR IMP AND PTY, WHICH WANT TO BREAK
C00113 00040	ROUTINE TO DO THE RCH OPERATION FROM THE IN-CORE IMP BUFFER.
C00116 00041	ROUTINE TO MAKE SURE THE TELNET CONNECTION IS STILL OPEN.
C00121 00042		SUBTTL	INITIAL FILE BLOCKS
C00122 00043	PTY INPUT (SUBJOB'S OUTPUT)
C00123 00044		SUBTTL	LOW-SEGMENT INITIALIZATION DATA
C00124 00045		SUBTTL	OTHER TABLES AND STUFF
C00126 00046		SUBTTL	LOW SEGMENT
C00130 ENDMK
C⊗;
	TITLE	FTPSRV -- FILE TRANSFER PROTOCOL SERVER
	SUBTTL	E.A.TAFT/EW13/EAT/DB33/CFE/drp--  may 80 [96bit]

	TWOSEG
	RELOC	400000

	SEARCH	C,TULIP,IMP	;ACCESS GENERAL PARAMETERS AND IMP STUFF

	VERSION	6,,43,6

; note on IO: all IO to the pty is done via the standard OFile.
; IO to the IMP connection is USUALLY done using the Error UUOs
; (EWsix and EDisix).  it you find it nessecary to change the
; the OFile (via "FoSel ImpObl", for example), make sure to change
; the OFile back when you're done, as the rest of the program
; expects it to go to the PTY.


;[96bit] first, define all the site specific things.


;[96bit] the PPn string that must be passed to login to get
;	 the free login for ftp transfers.  leave undefined if
;	 you do not wish to support free logins
Define FtpLogin<SixPPn(70,70)>	;[96bit] avsail uses 70,70

;[96bit] the octal PPn that FtpSrv should ChgPPN to before trying
;	 to login the free subjob for an Ftp transfer.  leave
;	 undefined if you do not wish the current PPN to be changed.
FtpPPn== 70 ,, 70		;[96bit] avsail uses 70,70

;[96bit] now mail information

;[96bit] define the command that should be issued to the monitor to
;	 accomplish a MLFL (Mail File) command.  The input file must
;	 be "Data:".  the line MUST end with number sign ("#") which
;	 produces a <CRLF>, followed by an exclamation mark ("!")
;	 which represents the end of the sixbit string.  Each percent
;	 sign ("%") in the string causes each successive macro
;	 statement to be executed at that point in the printing of
;	 the string.  for more detailed information, read the
;	 tulip modules.
;	 there is no default.  leave this undefined ONLY if you do
;	 not wish to support the MLFL command.
Define MlFlCommand
<
	Disix	[[SIXBIT\Mail %/IDENTI:%/FILE:DATA:#!\]
		PUSHJ	P,IMPPTY
		PUSHJ	P,HSTPRT]
>

;[96bit] define the MAIL command.  all the notes for the MLFL command
;	 apply here as well, except that this command MUST be defined.
Define MailCommand
<
	Disix	[[SIXBIT\Mail %/IDENTI:%/FILE:TTY:#!\]
		PUSHJ	P,IMPPTY
		PUSHJ	P,HSTPRT]
>

;[96bit] the PPN string that should be passed to login to get the
;	 subjob logged in for MLFL transfers.  Leave undefined if
;	 if MLFL transfers should login in the same way as ftp.
;	 (including the ChgPPn used for ftp.)  if defined, the job
;	 is logged out as soon as the transfer is completed.
;[avsail]Define MailLogin<SixPPN(N900AR0M)>	;[96bit] cmu uses Arpanet.Mail

;[96bit] the octal PPN that FtpSrv should ChgPPN to before trying
;	 to login the subjob for an MLFL transfer.  leave undefined
;	 if you do not wish the current PPN to be changed for mail.
;	 (this is ignored if MailLogin is undefined.)
MailPPn== 33125,,13776			;[96bit] cmu avoids a password


;[96bit] Define the logout routine.  leave undefined if
;	 you just want the standard "Kjob/b".
Define KjFunc
<	; CMU, of course, has to do something different.
	WSix	[SIXBIT\KJOB /F#!\];CMU- SAVE ALL FILES
	PUSHJ	P,CPYRSP	;COPY THIS
	TXNN	F,ERRFLG	;ERROR (OVER QUOTA)
	POPJ	P,		;NOPE ALL IS GOODNESS
	PUSHJ	P,CNCUSR	;STOP HIM
	WSix	[SIXBIT\CORE 0#!\];FREE ALL HIS CORE
	PJRST	PTYFLS		;AND GO AWAY
>	;end of KjFunc

;[96bit] End of site specific information


;[96bit] now clean up a little

IfDef	FtpLogin,<	$FtpLog==-1	>
IfDef	MailLogin,<	$MLogin==-1	>
ND	$FtpLog,0
ND	$MLogin,0
ND	FtpPPn,0
ND	MailPPn,0
ND	FtHarv,0	;code for harvard DIRECT
;[96bit]H=	11		;HOST TABLE INDEX FOR LOCAL HOST

;FLAGS USED IN FTPSRV
	FLAG	(OPNFLG)	;TELNET CONNECTION IS OPEN
	FLAG	(LGIFLG)	;SUBJOB IS LOGGED IN
	FLAG	(USRFLG)	;USER NAME GIVEN BUT NOT PASSWORD
	FLAG	(ERRFLG)	;ERROR MESSAGE ENCOUNTERED IN CPYRSP
	FLAG	(SLGFLG)	;FTPSRV IS A LOGGED-IN JOB
	FLAG	(PTYFLG)	;WE HAVE A PTY
	FLAG	(MAILFG)	;WE'RE IN THE MIDDLE OF A MAIL COMMAND
	FLAG	(WRPFLG)	;PTY DIALOGUE RECORDING HAS WRAPPED AROUND
;[96bit]FLAG	(LGAR0M)	;LOGGED IN AS N900AR0M
	FLAG	(TLogin)	;[96bit] should be logged out after
				;  	the command is done.
	FLAG	(MLFLFG)	;WE'RE IN THE MIDDLE OF A MLFL COMMAND
	Flag	(NlsCom)	;[96bit] processing a NLST command

;MISCELLANEOUS PARAMETERS
	PDLSIZ==100		;SIZE OF STACK
	PTY==	1		;I/O CHANNEL FOR PTY
	IMP==	2		;I/O CHANNEL FOR IMP
	ICPSKT==1		;SOCKET FOR LOCAL ICP
	TLNSKT==↑D64		;TELNET SOCKET FOR LOCAL ICP
	CMDLEN==↑D315		;MAXIMUM LEGAL FTP COMMAND LENGTH
;[CFE] Above line reflects the size of MAIL's TTY input buffer,
;[CFE]  namely about 315 characters as of 3-Jan-1981.
	WATWRN==↑D15		;TIME WE'LL WAIT BEFORE WARNING USER
	WATMAX==↑D20		;TIME WE'LL WAIT BEFORE LOGGING HIM OUT
	RECSIZ==↑D50		;NUMBER OF WORDS FOR RECORDING PTY DIALOGUE

;MACRO TO EXECUTE THE IMPUUO.  DONE AS A DEC-STYLE "CALL" SO AS TO
;   BE TRANSPORTABLE TO CMU.

DEFINE IMPUUO(AC,JUNK) <
	MCALL	AC,[SIXBIT\IMPUUO\]
>

;[96bit] Macro to define the control AC for the impuuo
Define ImpAc(Bits,Funct,Block,TimeOut<0>)
    < [ <Bits>!InSVl.(TimeOut,If.Tim)!InSVl.(Funct,If.Fnc)!<Block> ] >

;[96bit] marco to define a sixbit PPN string for the printing routines
Define SixPPn(Proj,Prog),
    < [
	ifnb <Prog>,< Sixbit \'Proj','Prog'!\ >
	ifb <Prog>,< Sixbit \'Proj'!\ >
      ]
    >
	SUBTTL	INITIALIZATION

FTPSRV:	JFCL			;IN CASE CCL ENTRY
	MOVE	P,[IOWD PDLSIZ,PDL] ;SETUP STACK
	START			;DO INITIALIZATION
	SETZM	ZEROL		;CLEAR ZEROED PART OF LOW SEGMENT
	MOVE	T1,[ZEROL,,ZEROL+1]
	BLT	T1,ZEREND-1
	MOVE	T1,[FILLH,,FILLL] ;INITIALIZE LOW SEGMENT DATA
	BLT	T1,FLLEND-1
	GETPPN	T1,		;GET OUR PPN
	  JFCL			;GETPPN SKIPS IF JACCT
	MOVEM	T1,PRJPRG	;REMEMBER IT
;[96bit] we don't care who we are anymore
;[96bit]MOVE	T1,[.IULHS,,LHOSTP] ;RETURN LOCAL HOST PARAMETERS
;[96bit]IMPUUO	T1,
;[96bit]  PUSHJ	P,Idiocy
;[96bit]HRRZ	T1,.IBHST+LHOSTP ;GET LOCAL HOST NUMBER
;[96bit]MOVSI	H,-NHOSTS	;SEARCH HOST TABLE FOR THIS NUMBER
;[96bit]HLRZ	T2,HSTTAB(H)
;[96bit]CAIE	T1,(T2)
;[96bit]AOBJN	H,.-2
;[96bit]JUMPL	H,.+2		;MAKE SURE WE FOUND ONE, AND REMEMBER INDEX
;[96bit]PUSHJ	P,Idiocy

;[96bit]MOVEI	T1,CONBLK	;SEE IF TELNET CONNECTION IS ALREADY OPEN
	Move	T1,ImpAc(If.New,.IuStt,ConBlk)		;[96bit]
	IMPUUO	T1,
	  JRST	NOTELC		;NO, GO TRY TO OPEN ONE

;HERE WITH TELNET CONNECTION OPEN TO USER
TLNOPN:	TXO	F,OPNFLG	;FLAG CONNECTION OPEN
	MOVEI	T1,IMPOBL	;DIRECT ERRORS TO THE TELNET USER
	MOVEM	T1,EFILE##
	Move	T1,.IBHST+CONBLK ;[96bit] DEFAULT HOST IS this one
	Movem	T1,HstTmp	;[96bit] put where it'll get set up
	move	T1,.IBRMT+CONBLK	; get his socket
	MOVEM	T1,RmtSkt		; and remember it for connections
	sos	t1,.IbLcl+ConBlk	; get our socket minus 1
	MOVEM	T1,LclSkt		; that's where connections go
	FSETUP	IMPIBH		;SETUP IMP I/O BLOCKS
	FSETUP	IMPOBH
	FIGET	IMPIBL		;OPEN IMP CONNECTION FOR I/O

;TYPE THE SIGNON MESSAGE
	MOVEI	T1,4		;FIVE WORDS OF MONITOR NAME
CNFGET:	MOVSI	T2,(T1)		;GET A WORD
	HRRI	T2,.GTCNF
	GETTAB	T2,
	  SETZ	T2,		;OOP......
	MOVEM	T2,SYSNAM(T1)	;STORE IT
	SOJGE	T1,CNFGET	;BACK FOR MORE
	MOVSI	T1,'300'	;OK, START WITH SIGNON MESSAGE
	EDisix	[EXP	SRVMSG
		WSIX	4,T1
		WASC	SYSNAM]
;SEARCH FOR A PTY WE CAN HAVE
	FSETUP	PTYIBH		;SETUP PTY FILE BLOCKS
	FSETUP	PTYOBH
	FoSel	PtyOBl		; start off talking naturally to pty.
	MOVX	T1,%CNPTY	;GET FIRST PTY,,# OF PTY'S
	GETTAB	T1,
NOPTAV:	  EDisix [BYEFR1,,[SIXBIT\401 N&O &PTY&S AVAILABLE.  &T&RY AGAIN LATER.#!\]]
	MOVEI	T1,(T1)		;ISOLATE NUMBER OF PTY'S

;HERE WHEN OPEN FAILS ON A PARTICULAR PTY
PTYTRY:	SOJL	T1,NOPTAV	;JUMP IF THERE AREN'T ANY MORE
	MOVEI	T2,(T1)		;GET NEXT PTY NUMBER
	SETZ	T3,		;CONVERT TO OCTAL DIGITS
	LSHC	T2,-3
	LSH	T3,-3
	TXO	T3, <'0'>B5
	JUMPN	T2,.-3
	HLRM	T3,PTYIBL+FILDEV ;STORE IN RIGHT HALF OF PTY NAME
	HLRM	T3,PTYOBL+FILDEV
	FIGET	PTYIBL		;TRY TO ASSIGN IT.  TO PTYTRY IF FAIL
	TXO	F,PTYFLG	;GOT IT -- SET FLAG
;[96bit]HRRZ	T1,HSTADR	;GET FOREIGN HOST'S ADDRESS
;[96bit]PUSHJ	P,HSTNAM##	;FIND OUT WHAT IT'S NAME IS
;[96bit]  SETZ	T1,		;ERROR, PUNT
;[96bit]MOVEM	T1,SXBHST	;STORE THE RESULTS (MAY BE ZERO)
;[96bit]MOVEM	T2,SXBHST+1
;	Pushj	P,SetNam	;[96bit] get the name, if we can.
; don't delay start up to build host tables: put this off until
; we have a command.
	MOVEI	T1,C.BYE	;GO TO BYE ROUTINE TO LOGOUT SUBJOB
	HRRM	T1,.JBREN##	;on a reenter.
	JRST	COMAND		;BEGIN PROCESSING COMMANDS
;HERE WHEN THERE IS NO TELNET CONNECTION OPEN.  IF FTPSRV IS
;   BEING RUN BY A LOGGED-IN USER, ATTEMPT TO DO AN ICP.
NOTELC:	PJOB	T1,		;GET OUR JOB NUMBER
	MOVN	T1,T1		;NEGATE FOR JOBSTS
	JOBSTS	T1,
	  PUSHJ	P,Idiocy		;SHOULDN'T FAIL
	TXNN	T1,JB.ULI	;ARE WE LOGGED IN?
	DISIX	[DOLOGO,,[SIXBIT\?L&OGIN PLEASE#.!\]]
	WSIX	[SIXBIT\P&RIVATE &FTP& SERVER RUNNING.#&M&ONITORING? !\]
	INCHRW	T1		;ASK FOR RESPONSE FROM TTY
	CAIN	T1,CR		;IF CARRIAGE RETURN
	INCHRW	T1		;  ABSORB LINE FEED
	CAIE	T1,"Y"		;YES IN EITHER UPPER OR LOWER CASE?
	CAIN	T1,"Y"+40
	TXO	F,SLGFLG	;YES, REMEMBER SERVER LOGGED-IN AND MONITORING
	pjob	t1,			; get job again
	LSH	T1,9
	ADDI	T1,ICPSKT	;BUILD LOCAL ICP SOCKET NUMBER
	DISIX	[[SIXBIT\#A&WAITING &ICP& ON SOCKET %#!\]
		WDEC	T1]
;[96bit]MOVE	T1,[7B10+<.IUREQ>B17+ICPCON] ;WAIT FOR ICP REQUEST
	Move	T1,ImpAc(If.New,.IuReq,ConBlk,7)	;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR		;ERROR (MAYBE TIMED OUT)

repeat 0,<	;[tcp] old complex stuff not needed anymore.
;[96bit]HRLI	T1,.IUCON	;OK, CONNECT
	HRLI	T1,.IUCON(If.New)	;[96bit] OK, CONNECT
	IMPUUO	T1,
	  JRST	ICPERR
	MOVE	T1,.IBRMT+ICPCON ;GET HIS SOCKET (INPUT)
	ADDI	T1,3		;STORE HIS CORRECT TELNET OUTPUT SOCKET
	MOVEM	T1,.IBRMT+CONBLK
	MOVE	T1,.IBHST+ICPCON ;GET HOST NUMBER
;[96bit]HRRM	T1,.IBHST+CONBLK ;STORE IN TELNET CONNECTION BLOCK
	Movem	T1,.IBHST+CONBLK ;[96bit] STORE IN TELNET CONNECTION BLOCK
;[96bit]MOVE	T1,[.IULSN,,CONBLK] ;SET TELNET SOCKETS INTO LISTEN STATE
	Move	T1,ImpAc(If.New,.IuLsn,ConBlk)		;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR
	SOS	.IBRMT+CONBLK
	AOS	.IBLCL+CONBLK
	IMPUUO	T1,
	  JRST	ICPERR
	FSETUP	ICPBLH		;OPEN ICP SOCKET FOR OUTPUT
	FOOPEN	ICPBLK
	HRRZ	T1,PRJPRG	;COMPUTE OUR FULL LOCAL SOCKET NUMBER
	LSH	T1,9
	IORI	T1,TLNSKT	;  FOR THE SERVER TELNET CONNECTION
	MOVE	T2,[POINT 8,T1,3] ;UNPACK 8 BITS AT A TIME
	ILDB	T3,T2
	WCHI	(T3)		;STUFF AN 8-BIT BYTE
	TXNE	T2,77B5		;DONE?
	JRST	.-3		;NO, DO MORE
	FOCLOS	ICPBLK		;YES, SEND ICP DATA ON ITS WAY
;[96bit]MOVE	T1,[.IUCLS,,ICPCON] ;  BY CLOSING THE ICP SOCKET
	Move	T1,ImpAc(If.New,.IuCls,ICPCon)		;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR
repeat 0 continues to next page
;CONTINUATION OF ICP CODE and repeat 0

	SETZM	OFILE##		;OUTPUT BACK TO TTY
;[96bit]MOVE	T1,[IF.NWT+<.IUCON>B17+CONBLK] ;CONNECT THE TELNET SOCKETS
	Move	T1,ImpAc(If.Nwt!If.New,.IuCon,ConBlk)	;[96bit]
	IMPUUO	T1,		;DO THE OUTPUT SOCKET FIRST
	  JRST	ICPERR
	AOS	.IBRMT+CONBLK	;NOW THE INPUT SOCKET
	SOS	.IBLCL+CONBLK
;[96bit]HRLI	T1,.IUCON	;WAIT FOR THIS ONE
	HRLI	T1,.IUCON(If.New)	;[96bit] WAIT FOR THIS ONE
	IMPUUO	T1,
	  JRST	ICPERR
	SOS	.IBRMT+CONBLK	;NOW BACK TO LOOK AT THE OUTPUT SIDE
	AOS	.IBLCL+CONBLK
	IMPUUO	T1,		;WAIT FOR SOCKET TO BECOME OPEN
	  JFCL			;PROBABLY ALREADY WAS OPEN
> ;[tcp] end of repeat 0

;[96bit]MOVEI	T1,CONBLK	;GET ITS STATUS
	Move	T1,ImpAc(If.New,.IuStt,ConBlk)		;[96bit]
	IMPUUO	T1,
	  JRST	ICPERR
	LDB	T2,[POINT 6,.IBSTT+CONBLK,35] ;OUTPUT SIDE OPEN NOW?
	CAIN	T2,.ISEst		; established?
	  DISIX	[TLNOPN,,[SIXBIT\ICP &COMPLETED.#!\]]


;HERE WHEN SOMETHING FAILS DURING THE ICP.
ICPERR:	SETZM	OFILE##		;MAKE OUTPUT COME OUT ON THE TTY
	WSIX	[SIXBIT\? S&ERVER &T&ELNET &ICP& FAILED#!\]
;[96bit]MOVE	T1,[IF.NWT+<.IUCLS>B17+ICPBLK] ;CLOSE ICP BLOCK IN CASE OPEN
	Move	T1,ImpAc(If.Nwt!If.New,.IuCls,ICPBlk)	;[96bit]
	IMPUUO	T1,
	  JFCL
	JSP	T4,BYEFRC	;CLOSE CONNECTIONS IF OPEN
	SUBTTL	COMMAND TABLES

;BITS IN LH OF COMMAND DISPATCH ENTRY
	CM.LGI==1B0		;LOGIN REQUIRED FOR THIS COMMAND
	CM.HLP==1B1		;LIST COMMAND IN THE HELP MESSAGE
	CM.LGM==1B2		;[96bit] use mlfl login, and logout
				;	 the job when the transfer's
				;	 done.


DEFINE COMS <

	CC	USER,<HLP>
	CC	PASS,<HLP>
	CC	ACCT,<>
	CC	BYTE,<HLP>
	CC	SOCK,<HLP>
	CC	Pasv,<>		; give "not implemented" for this
	CC	TYPE,<HLP>
	CC	STRU,<HLP>
	CC	MODE,<HLP>
	CC	RETR,<LGI,HLP>
	CC	STOR,<LGI,HLP>
	CC	APPE,<>
	CC	RNFR,<LGI,HLP>
	CC	RNTO,<LGI,HLP>
	CC	DELE,<LGI,HLP>
	CC	LIST,<LGI,HLP>
	CC	NLst,<LGI,HLP>	;[96bit] implement name-list
	CC	ALLO,<>
	CC	REST,<>
	CC	STAT,<HLP>
	CC	ABOR,<>
	CC	BYE ,<HLP>
Ife $MLogin,<	;[96bit] MLFL doesn't need to logout
	CC	MLFL,<LGI,HLP>
>; ife $MLogin
ifn $MLogin,<	;[96bit] MLFL needs to logout
	CC	MLFL,<LGI,LGM,HLP>
>; ifn $MLogin
	CC	MAIL,<HLP>
	CC	HELP,<>
	CC	NoOp,<>		;[96bit] implement NoOp
	CC	XCWD,<LGI,HLP>
	CC	XSRC,<LGI,HLP>
	CC	XTIM,<HLP>
	CC	XREP,<>

>
;ASSEMBLE COMMAND NAMES

DEFINE CC(A,B) <
	<SIXBIT	\A\>
>

	XALL

COMTAB:	COMS

	COMLEN==.-COMTAB	;NUMBER OF COMMANDS IN TABLE
;ASSEMBLE COMMAND DISPATCH TABLE

DEFINE CC(A,B) <
	ZZ==	0
IFNB<B>,<IRP B<
	ZZ==	ZZ+CM.'B
>>
IFDEF C.'A,<
	ZZ +	C.'A
>
IFNDEF C.'A,<
	ZZ +	COMUNI
>>

COMDSP:	COMS

	SALL
	SUBTTL	FTP COMMAND DECODING AND DISPATCH

;HERE WHEN FTPSRV HAS NOTHING BETTER TO DO.  WAIT FOR INPUT FROM
;   EITHER THE IMP OR THE PTY.
COMAND:	PUSHJ	P,IMPCHK	;MAKE SURE TELNET CONNECTION IS STILL OPEN
;[tcp] there's nothing special about FTPSRV IMPs, they are just connected
;[tcp]	to TTYs, and the TTY is what we talk to.  IO.DAT cannot be on for
;[tcp]	a non-imp.
;[tcp]	STATZ	IMP,IO.DAT	;  OR MORE AVAILABLE FROM TELNET CONNECTION?
	skpinl				;[tcp] another command?
	 SKIPle	IMPIBL+FILCTR		;[tcp] perhaps read in already?
	  JRST	IMPGET		;YES, PROCESS IT
	PUSHJ	P,PTYCHK	;NO, HAS ANYTHING COME FROM THE PTY?
	  AOSA	T1,WATCNT	;NO, INCREMENT TIME WE'VE BEEN WAITING
	JRST	PTYGET		;YES, PROCESS IT
	CAIN	T1,WATWRN*↑D60	;TIME TO WARN OUR INACTIVE USER?
	EDisix	[[SIXBIT\030 Y&OU WILL BE LOGGED OFF IN % MINUTES IF YOU CONTINUE TO DO NOTHING.#!\]
		WDECI	WATMAX-WATWRN]
	CAIN	T1,WATMAX*↑D60	;TIME TO GIVE UP ON HIM?
	EDisix	[C.BYE,,[SIXBIT\430 I&NACTIVITY TIMEOUT--GOODBYE.#!\]]
	MOVEI	T1,1		;SLEEP FOR A SECOND
	SLEEP	T1,
	JRST	COMAND		;GO LOOK AGAIN


;HERE WHEN SOMETHING COMES BACK FROM THE PTY.  JUST COPY IT TO THE IMP.
PTYGET:	MOVSI	T1,'050'	;MISC MESSAGE CODE
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO IMP
	JRST	COMAND		;RESUME WAITING
;HERE WHEN A MESSAGE ARRIVES FROM THE IMP.  FIRST, READ THE ENTIRE
;  LINE INTO CORE AND CHECK FOR ILLEGAL CHARACTERS AND IMPROPER TERMINATION.
IMPGET:	HLLZS	WATCNT		;RESET WAIT COUNT
;[CFE]	Clear out CmdBuf before storing into it.  Remember count of
;[CFE]	  characters stored, also; use count reading from buffer.
	setzm	CmdBuf		;[CFE] Clear first word,
	move	t1,[xwd CmdBuf,CmdBuf+1]
	blt	t1,CmdBuf+<CmdLen/5>	;[CFE]  clear the rest.
	MOVE	T1,[POINT 7,CMDBUF] ;POINT TO COMMAND STORAGE BUFFER
	MOVEM	T1,CMDPTR	;STORE FOR LATER USE
	MOVEI	T2,CMDLEN	;MAX LEGAL COMMAND LENGTH
	FISEL	IMPIBL		;INPUT FROM IMP
; IMP output uses Error UUOs.
;	FOSEL	IMPOBL		;OUTPUT POSSIBLE MESSAGES TO IMP

;MAKE SURE THIS IS A REAL MESSAGE COMING AND NOT JUST SOME LEFTOVER NULLS
IMPGE4:	RCHF	P1		;GET A CHAR FROM THE IMP
	JUMPN	P1,IMPGE1	;A REAL CHAR, PROCESS IT
;[tcp]	SKIPG	IMPIBL+FILCTR	;NO, ANY MORE INPUT DATA?
;[tcp]	STATZ	IMP,IO.DAT	;NO, MORE TO GET FROM THE IMP?
;[tcp]	JRST	IMPGE4		;YES, DO IT
	JRST	COMAND		;NO, FORGET IT

;[CFE, 3-Jan-81] If this is MAIL command input, artificially insert
;[CFE] CRLFs to break very-long lines to lengths that MAIL will
;[CFE] handle for us.
IMPGE5:	txnn	F,MAILFG	; Are we doing a MAIL?
	  jrst	IMPGE0		;  Yes: don't test here.
IMPGE7:	caig	T2,2		; More than two spaces left?
	  jrst	IMPGE6		;  No; force a CRLF.
	caig	T2,↑D15		; 15 or fewer spaces left
	 caie	P1," "		;  and this char is a space ( =40 )?
	  jrst	IMPGE0		; No, it's OK: treat ordinarily.
IMPGE6:	movei	P1,15		; Force a CRLF into cmd buffer.
	idpb	P1,T1
	movei	P1,12
	idpb	P1,T1
	subi	T2,2		; Account for spaces used.
	EWSix	[sixbit\051 L&ong &MAIL& line broken into pieces.#!\]
	jrst	CmdFin		; Send buffered text to MAIL subjob.
;[CFE] end of long-line patch

IMPGE0:	RCHF	P1		;GET A CHAR FROM THE IMP
	JUMPE	P1,IMPGE0	;IGNORE NULLS
IMPGE1:	TXNN	F,MAILFG	;MAIL MODE?
	JRST	IMPGE3		;NO, DON'T THROW OUT SPECIAL CHARS
	CAIE	P1,"C"&37	;↑C?
	CAIN	P1,"Z"&37	;OR ↑Z?
	JRST	IMPGE0		;IGNORE SINCE THEY'LL TERMINATE MAIL
;[CFE]	CAIE	P1,33		;CHECK FOR ALL ALTMODES
;[CFE]	CAIL	P1,175		;DON'T WORRY ABOUT LOSING RUBOUTS
	cain	P1,33		;[CFE] Check MAIL's <escape> terminator
	JRST	IMPGE0		;IGNORE...SAME REASON
IMPGE3:	IDPB	P1,T1		;PACK CHARACTER INTO COMMAND BUFFER
	SOJGE	T2,IMPGE2	;COUNT THE CHARACTER
	; more than we can take: load error and go die.
	Movei	T1,[SIXBIT\500 L&AST LINE WAS TOO LONG.#!\]
	JRST	CMDERR
IMPGE2:	TXNE	P2,LETTER!LGLSIX ;LEGAL CHARACTER?
;[CFE]	JRST	IMPGE0		;YES, GO ON TO NEXT
	  jrst	IMPGE5		;[CFE] Check MAIL lines, then go on.
	CAIN	P1,LF		;LINE FEED?
	JRST	CMDFIN		;YES, END OF COMMAND
	TXNE	F,MAILFG	;IN MAIL MODE?
;[CFE]	JRST	IMPGE0		;YES, STORE CHAR WITHOUT FURTHER ADO
	  JRST	IMPGE7		;[CFE] YES, STORE CHAR after size check
	CAIN	P1,CR		;CARRIAGE RETURN?
	RCHF	P1		;YES, GET NEXT
	JUMPE	P1,.-1		;IGNORE NULLS
	CAIN	P1,LF		;IS NEXT LINE FEED?
	JRST	IMPGE1		;YES, FINISH OFF THE LINE
	Movei	T1,[SIXBIT\500 L&AST LINE WAS UNRECOGNIZABLE.#!\]

;HERE WHEN THE COMMAND IS IN ERROR.  error message in T1.
CMDERR:	CAIN	P1,LF		;LINE FEED?
	JRST	CMDER1		;YES
	RCHF	P1		;NO, DISCARD AND GET NEXT
	JRST	CMDERR
CMDER1:	EWSix	(T1)		; send the error message
	JRST	COMAND		;WAIT FOR NEXT COMMAND
;HERE WHEN A COMPLETE COMMAND HAS BEEN INPUT.  DECIPHER IT
CMDFIN:				;THE MAIL FUNCTION ACCEPTS DATA OVER THE
				;TELNET CONNECTION, SO WE HAVE TO CHECK IT
;[CFE]	Set up character count first.
	subi	t2,CmdLen	;[CFE] Get negative character count
	movnm	t2,CmdCnt	;[CFE]  and store for RCHICB.
	TXNN	F,MAILFG	;IN MAIL MODE?
	JRST	CMDIS		;NO, A COMMAND IT IS
	PUSHJ	P,C.MAIX	;HANDLE THIS LINE
	JRST	COMAND		;AND TRY THE NEXT
CMDIS:	FSETUP	IMPCBH		;SETUP IMP INPUT PSEUDO-FILE
	FISEL	IMPCBL		;SELECT IT
	MOVE	T1,[POINT 6,T2]	;PREPARE TO PACK COMMAND NAME
	SETZ	T2,
CMDFN1:	RCHF	P1		;GET A CHAR
	TXNN	P2,LETTER	;IS IT A LETTER?
	JRST	CMDSRC		;NO, END OF COMMAND
	SUBI	P1,40		;CONVERT TO SIXBIT
	TXNE	T1,77B5		;IS THERE ROOM FOR MORE LETTERS?
	IDPB	P1,T1		;YES, STORE IT
	JRST	CMDFN1		;BACK FOR MORE

;HERE WHEN END OF COMMAND NAME REACHED
CMDSRC:	JUMPN	T2,CMDSR1	;JUMP IF NONBLANK
	EWSix	[SIXBIT\500 L&AST LINE WAS UNRECOGNIZABLE.#!\]
	JRST	COMAND		;WAIT FOR NEXT COMMAND
CMDSR1:	CAIE	P1," "		;WAS THE CHAR A SPACE?
	LCHF	P1		;NO, BACK UP OVER IT
	MOVEM	T2,CMDNAM	;REMEMBER COMMAND NAME
	MOVSI	T1,-COMLEN	;NUMBER OF COMMANDS
	CAME	T2,COMTAB(T1)	;SEARCH FOR COMMAND NAME
	AOBJN	T1,.-1
	JUMPGE	T1,CMDNFD	;JUMP IF NOT IN TABLE
	MOVE	P4,COMDSP(T1)	;GET CORRESPONDING DISPATCH ENTRY
	TXNE	P4,CM.LGI	;LOGIN REQUIRED?
	TXNE	F,LGIFLG	;YES, IS SUBJOB LOGGED IN?
	JRST	.+3		;YES, OR NOT REQUIRED
	PUSHJ	P,FRELGI	;NO, ATTEMPT A FREE LOGIN
	  JRST	COMAND		;UNSUCCESSFUL (MSG ALREADY PRINTED)
	Call	SetNam		;[96bit] make sure have set host up.
	PUSHJ	P,(P4)		;DO COMMAND PROCESSING
	JRST	COMAND		;WAIT FOR NEXT COMMAND


;HERE WHEN COMMAND NAME NOT FOUND
CMDNFD:	EDisix	[COMAND,,[SIXBIT\500 % &COMMAND NOT RECOGNIZED.#!\]
		WNAME	CMDNAM]

;HERE WHEN COMMAND IS NOT IMPLEMENTED
COMUNI:	EDisix	[COMAND,,[SIXBIT\506 % &COMMAND NOT IMPLEMENTED.#!\]
		WNAME	CMDNAM]
	SUBTTL	SYSTEM ACCESS COMMANDS

;   USER <USER NAME>

C.USER:	TXZE	F,LGIFLG	;IS USER ALREADY LOGGED IN?
	PUSHJ	P,LGOUSR	;YES, LOG HIM OUT FIRST
	TXOE	F,USRFLG	;USER NAME ALREADY GIVEN?
	PUSHJ	P,CNCUSR	;YES, FORCE SUBJOB TO MONITOR LEVEL
	Disix	[[SIXBIT\LOGIN %#!\] ;SEND LOGIN COMMAND TO SUBJOB
		PUSHJ	P,IMPPTY]
	PUSHJ	P,CHKLGI	;GO TAKE A LOOK AT HOW WE DID
	  PJRST	LGIERR		;DROPPED ON OUR NOSE. TELL USER
	  EDisix [PTYFLS,,[SIXBIT\330 P&ASSWORD, PLEASE.#!\]]
	PJRST	LGIFIN		;NO PSW NEEDED, WELCOME HIM
;   PASS <PASSWORD>

C.PASS:	TXNN	F,USRFLG	;GIVEN USER NAME YET?
	EDisix	[CPOPJ##,,[SIXBIT\504 USER &COMMAND MUST PRECEDE PASSWORD.#!\]]
	PUSHJ	P,IMPPTY	;OK, COPY PASSWORD TO LOGIN
	W2CHI	CRLF		;TERMINATE IT
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	LGIERR		;ERROR
	PUSHJ	P,PTYF1L	;FLUSH LINE OF ASTERISKS
	PUSHJ	P,GETRSP	;CHECK RESPONSE ON NEXT LINE
	  PJRST	LGIERR		;ERROR

;HERE WHEN LOGIN OPERATION FINISHED
LGIFIN:	TXC	F,USRFLG!LGIFLG ;CLEAR USRFLG, SET LGIFLG
	PUSHJ	P,SJBPPN	;FIND OUT THE PPN OF OUR SUBJOB
	MOVEM	T1,PRJPRG	;SAVE FOR LATER USE
	MOVSI	T1,'050'	;COPY RESPONSE TO USER AS SYSTEM INFO
	LCHF	P1		;DON'T MISS FIRST CHAR OF RESPONSE
	PUSHJ	P,CPYRSP
	EWSix	[SIXBIT\230 L&OGIN SUCCESSFUL.#!\]
	POPJ	P,



;   ACCT <ACCOUNT STRING>

C.ACCT:	EWSix	[SIXBIT\200 A&CCOUNTS NOT USED ON THIS SYSTEM.#!\]
	POPJ	P,
;   BYE

C.BYE:	move	p,[iowd PdlSiz,Pdl] ;RESET THE STACK
	txne	f,PtyFlg	;DO WE HAVE A PTY?
	  pushj	p,FreOut	;LOG possible SUBJOB OFF
	EWSix	[SIXBIT\231 B&YE.#!\] ;TRY TO BE FRIENDLY
	Releas	Pty,
	txz	f,PtyFlg	;REMEMBER WE DON'T HAVE A PTY ANY MORE
	jsp	t4,ByeFrc	; Remember how we got here

;HERE TO FORCE BYE COMMAND WHEN WE KNOW THE SUBJOB ISN'T LOGGED IN
BYEFRC:
;[CFE] First, see if the Imp connection is open; don't hang trying
;[CFE]  to send to an absent connection!  Note: this doesn't eliminate
;[CFE]  race conditions between remote-close and this RELEASE, but it
;[CFE]  does narrow the race window.
	pushj	p,ImpChk	;[CFE] One final test.  Will terminate.
	movei	t1,Imp		;[CFE] This is channel to reset, maybe.
	txnn	f,OpnFlg	;[CFE] Is conn still open?
	 ResDv.	t1,		;[CFE]  No; flush the device buffers.
	  jfcl			;[CFE] (ok, we were just trying...)
	pushj	p,ImpChk	;[CFE] Test again.
	RELEASE	IMP,		;FORCE OUT ANY PENDING MESSAGES
;[96bit]MOVE	T1,[IF.NWT+<.IUCLS>B17+CONBLK] ;CLOSE TELNET CONNECTIONS
	Move	T1,ImpAc(If.Nwt!If.New,.IuCls,ConBlk)	;[96bit]
	SETZM	CONBLK+.IBLCL	;INPUT SIDE
	IMPUUO	T1,		;NO WAIT FOR ACTION
	  JFCL
;[tcp]	AOS	CONBLK+.IBLCL	;NOW OUTPUT SIDE
;[tcp]	IMPUUO	T1,
;[tcp]	  JFCL
DOLOGO:	LOGOUT			;GO AWAY.

; Dummy BYEFRC callers for tracing where the hanging comes from.
BYEFR1:	jsp	t4,ByeFrc	; Remember PC
BYEFR2:	jsp	t4,ByeFrc
BYEFR3:	jsp	t4,ByeFrc


FREOUT:
	TXZE	F,USRFLG!MAILFG ;IF IN LOGIN OR MAIL...
	PUSHJ	P,CNCUSR	;FORCE SUBJOB TO COMMAND LEVEL
	TXZE	F,LGIFLG	;IS SUBJOB LOGGED IN?
	PUSHJ	P,LGOUSR	;YES, LOG IT OUT
	pjrst	PTYFLS		;MAKE SURE ALL OUTPUT IS ABSORBED
	SUBTTL	DATA TRANSFER PARAMETER COMMANDS

repeat 0,<	; no byte size in TCP

;   BYTE <BYTE SIZE>

C.BYTE:	PUSHJ	P,GETDEC	;GET BYTE SIZE
	  JRST	BYTERR		;ERROR IN NUMBER
	CAIE	P1,LF		;END OF LINE?
BYTERR:	EDisix	[CPOPJ##,,[SIXBIT\501 B&YTE SIZE SPECIFICATION ERROR.#!\]]
	CAIL	T1,1		;CHECK BYTE SIZE FOR LEGALITY
	CAILE	T1,↑D255
	JRST	BYTERR		;OUT OF RANGE
	CAIE	T1,↑D8		;CHECK FOR BYTE SIZES THAT OUR
	CAIN	T1,↑D36		;  CRUMMY IMPSER CAN HANDLE PROPERLY
	CAIA			;OK
	EDisix	[CPOPJ##,,[SIXBIT\506 B&YTE SIZE % NOT SUPPORTED.#!\]
		WDECI	(T1)]
	MOVEM	T1,BYTSIZ	;OK, STORE BYTE SIZE
	EDisix	[CPOPJ##,,[SIXBIT\200 B&YTE SIZE % ACCEPTED.#!\]
		WDECI	(T1)]

> ; end of repeat 0
;   SOCK <SOCKET>      OR     SOCK <HOST>,<SOCKET>

C.SOCK:	PUSHJ	P,GETDEC	;GET DECIMAL NUMBER
	  JRST	SKTERR		;ERROR
	Caie	P1,"."		;[96bit] <Host>.<Site>?
	 Cain	P1,"/"		;[96bit] or <Host>/<Site>?
	  Jrst	[		;[96bit] one of them: must be host.
		 Move	T2,T1		;[96bit] save host number
		 Pushj	p,GetDec	;[96bit] get the site number
		   Jrst	SockBH		;[96bit] no site: bad format
		 Caie	P1,","		;[96bit] now a socket?
		   Jrst	SktErr		;[96bit] no: not legal.
		 Jrst	Sockt3		;[96bit] ok: go juggle right
		]
	;[96bit] just a straight host or socket number.
	CAIE	P1,","		;COMMA?
	JRST	SOCKT1		;NO, NOT CHANGING HOST
;[96bit]CAIL	T1,1		;YES, CHECK FOR LEGAL HOST NUMBER
	CAILE	T1,↑D255	; does it look like in old format?
	  Jrst	Sockt2		;[96bit] full host: just check and store
	;[96bit] old format: convert to proper format
	LDB	T2,[Point 2,T1,35-6]	;[96bit] host number
	Andi	T1,77			;[96bit] mask out host number
Sockt3:	Dpb	T2,[Pointr (T1,Ih.Hst)]	;[96bit] host in place

Sockt2:	Txnn	T1,Ih.Imp	;[96bit] is there a site?
	  Jrst	SockBH		;[96bit] no: illegal host
	Movem	T1,HstTmp	;[96bit] save the host number
	PUSHJ	P,GETDEC	;GET SOCKET NUMBER
	  JRST	SKTERR		;ERROR
SOCKT1:	CAIN	P1,LF		;CHECK FOR LEGAL FORMAT
	TLNE	T1,(-1←↑D32)	;AND FOR LEGAL SOCKET NUMBER
	  Jrst	SktErr		; out of range
	MOVE	T2,T1		;OK, COPY SOCKET NUMBER
	ANDCAI	T2,1		;HIS INPUT IS OUR OUTPUT, SO COMPLEMENT
	MOVEM	T1,RmtSkt	;STORE NEW REMOTE INPUT OR OUTPUT SOCKET
	Call	SetNam		;[96bit] store HstTmp, and get new name.
				;	 (saves T1 & T2)
	EDisix	[CPOPJ##,,[SIXBIT\200 S&OCKET % AT HOST % (%) ACCEPTED.#!\]
		WDEC	T1
;[96bit]	WDEC	HSTADR
		Call	HstPrt	;[96bit] print host name
		Call	HstNoo	;[96bit] and print number, to make
				;	 clear how we interpreted
		]
SockBH:	EDisix	[CPOPJ##,,[SIXBIT\501 H&OST NUMBER SPECIFICATION ERROR.#!\]]
SKTERR:	Clearm	HstTmp		;[96bit] clear potential new host adr
	EWSix	[SIXBIT\501 S&OCKET NUMBER SPECIFICATION ERROR.#!\]
	Return
repeat 0,<	; con't handle odd types

;   TYPE <TYPE CODE>

C.TYPE:	PUSHJ	P,SPNOR		;IGNORE SPACES
	MOVSI	T1,-TYPLEN	;PREPARE TO SEARCH TYPE TABLE
	HLRZ	T2,TYPCOD(T1)	;GET TYPE CODE
	CAIE	T2,(P1)		;IS THIS IT?
	AOBJN	T1,.-2		;NO, TRY NEXT
	JUMPGE	T1,.+3		;JUMP IF NOT FOUND
	PUSHJ	P,SPNOR1	;OK, CHECK FOR LEGAL FORMAT
	CAIE	P1,LF
	EDisix	[CPOPJ##,,[SIXBIT\501 D&ATA TYPE SPECIFICATION ERROR.#!\]]
	MOVE	T1,TYPCOD(T1)	;FETCH TYPE DESCRIPTOR
	TRNE	T1,400000	;IMPLEMENTED?
	EDisix	[CPOPJ##,,[SIXBIT\506 T&YPE % NOT IMPLEMENTED.#!\]
		WCHI	(T2)]	;NO
	MOVEM	T1,XFRTYP	;YES, STORE NEW TYPE DESCRIPTOR
	EDisix	[CPOPJ##,,[SIXBIT\200 T&YPE % ACCEPTED.#!\]
		WCHI	(T2)]


;TYPE TABLE
TYPCOD:	"A" ,,	0		;ASCII
	"I" ,,	1		;IMAGE
	"L" ,,	-1		;LOCAL BYTE (NOT IMPLEMENTED)
	"P" ,,	-1		;PRINT FILE (NOT IMPLEMENTED)
	"E" ,,	-1		;EBCDIC PRINT FILE (NOT IMPLEMENTED)

	TYPLEN==.-TYPCOD	;NUMBER OF DIFFERENT KNOWN TYPE CODES

> ; end of repeat 0
repeat 0,<	; not implemented in TCP

;   STRU <STRUCTURE CODE>

C.STRU:	PUSHJ	P,SPNOR		;IGNORE SPACES
	MOVSI	T1,-STRLEN	;PREPARE TO SEARCH STRUCTURE TABLE
	HLRZ	T2,STRCOD(T1)	;GET AN ENTRY
	CAIE	T2,(P1)		;IS THIS IT?
	AOBJN	T1,.-2		;NO
	JUMPGE	T1,.+3		;JUMP IF NOT FOUND
	PUSHJ	P,SPNOR1	;CHECK SYNTAX
	CAIE	P1,LF		;DID EOL IMMEDIATELY FOLLOW?
	EDisix	[CPOPJ##,,[SIXBIT\501 S&TRUCTURE SPECIFICATION ERROR.#!\]]
	MOVE	T1,STRCOD(T1)	;OK, GET SPECIFIER WORD
	TRNE	T1,400000	;IS IT IMPLEMENTED?
	EDisix	[CPOPJ##,,[SIXBIT\506 S&TRUCTURE % NOT IMPLEMENTED.#!\]
		WCHI	(T2)]
	MOVEM	T1,STRTYP	;OK, STORE STRUCTURE SPECIFIER
	EDisix	[CPOPJ##,,[SIXBIT\200 S&TRUCTURE % ACCEPTED.#!\]
		WCHI	(T2)]


STRCOD:	"F" ,,	0		;FILE (NO RECORD STRUCTURES)
	"R" ,,	-1		;RECORD (NOT IMPLEMENTED)

	STRLEN==.-STRCOD

> ; end of repeat 0
repeat 0,<	; not implemented in this TCP hack

;   MODE <MODE CODE>

C.MODE:	PUSHJ	P,SPNOR		;IGNORE SPACES
	MOVSI	T1,-MODLEN	;SEARCH MODE TABLE
	HLRZ	T2,MODCOD(T1)
	CAIE	T2,(P1)		;IS THIS IT?
	AOBJN	T1,.-2		;NO, TRY NEXT
	JUMPGE	T1,.+3		;JUMP IF NOT FOUDN
	PUSHJ	P,SPNOR1	;CHECK FOR LEGAL SYNTAX
	CAIE	P1,LF
	EDisix	[CPOPJ##,,[SIXBIT\501 M&ODE SPECIFICATION ERROR.#!\]]
	MOVE	T1,MODCOD(T1)	;OK, FETCH MODE SPECIFIER
	TRNE	T1,400000	;IMPLEMENTED?
	EDisix	[CPOPJ##,,[SIXBIT\506 M&ODE % NOT IMPLEMENTED.#!\]
		WCHI	(T2)]
	MOVEM	T1,MODTYP	;OK, SAVE MODE SPECIFIER
	EDisix	[CPOPJ##,,[SIXBIT\200 M&ODE % ACCEPTED.#!\]
		WCHI	(T2)]


MODCOD:	"S" ,,	0		;STREAM
	"B" ,,	-1		;BLOCK (NOT IMPLEMENTED)
	"T" ,,	-1		;TEXT (NOT IMPLEMENTED)
	"H" ,,	-1		;HASP (NOT IMPLEMENTED)

	MODLEN==.-MODCOD

> ; end of repeat 0
	SUBTTL	FTP DATA TRANSFER FUNCTIONS

;   RETR <PATHNAME>

C.RETR:	MOVE	T1,[SIXBIT\DATA\] ;LOGICAL NAME FOR IMP DEVICE
	HRRZ	T2,XFRTYP	;DATA TYPE FOR TRANSFER
	PUSHJ	P,DoOpen	;OPEN SUBJOB'S IMP OUTPUT CONNECTION
	  POPJ	P,		;ERROR--MESSAGE ALREADY PRINTED
	WSix	[SIXBIT\R PIP#!\] ;START SUBJOB RUNNING PIP
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  JRST	XFRERR		;ERROR??
	HRRZ	T1,XFRTYP	;GET TRANSFER TYPE
	Disix	[[SIXBIT\DATA: = %#!\] ;ENTER PIP COMMAND
		PUSHJ	P,IMPPTY]
RtrEnd:	;[96bit] end a RETR or LIST
	PUSHJ	P,XFRCHK	;CHECK FOR SUCCESSFUL COMPLETION
	  POPJ	P,		;ERROR, MESSAGE ALREADY PRINTED
	PUSHJ	P,CNCUSR	;FORCE SUBJOB TO COMMAND LEVEL
	WSix	[SIXBIT\IMP CLOSE DATA:#!\] ;CLOSE DATA CONNECTION
	MOVSI	T1,'452'	;CODE TO USE IF ERROR
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR--COPY MESSAGE TO USE4R AND QUIT
	EWSix	[SIXBIT\252 T&RANSFER COMPLETED.#!\]
	PJRST	PTYFLS		;FLUSH PTY OUTPUT AND RETURN
;   STOR <PATHNAME>

C.STOR:	MOVE	T1,[SIXBIT\DATA\] ;LOGICAL NAME FOR IMP DEVICE
	HRRZ	T2,XFRTYP	;DATA TYPE FOR TRANSFER
	PUSHJ	P,DoOpen	;OPEN SUBJOB'S IMP INPUT CONNECTION
	  POPJ	P,		;ERROR--MESSAGE ALREADY PRINTED
	WSix	[SIXBIT\R PIP#!\] ;START SUBJOB RUNNING PIP
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  JRST	XFRERR		;COULDN'T START PIP
	HRRZ	T1,XFRTYP	;FETCH TRANSFER TYPE
	Disix	[[SIXBIT\% = DATA:#!\] ;ENTER PIP TRANSFER COMMAND
		PUSHJ	P,IMPPTY
		]
;[tcp]	PUSHJ	P,XFRCHK	;WAIT FOR SUCCESSFUL COMPLETION
;[tcp]	  POPJ	P,		;ERROR, MESSAGE ALREADY PRINTED
;[tcp]	EDisix	[CNCUSR,,[SIXBIT\252 T&RANSFER COMPLETED.#!\]]
	jrst	RtrEnd			;[tcp] standard out


ife FtHarv,<	;[96bit] harvard DIRECT does not support /InDir
;   Nlst <PathName>		[96bit]

C.Nlst:	TXO	F,NlsCom	;[96bit] remember we're doing NLST
;	Jrst	C.List		;[96bit] fall into LIST command
>	;end of IFE FtHarv


;   LIST <PATHNAME>

C.LIST:
;[96bit]WSix	[SIXBIT\ASSIGN IMP LPT#!\] ;KLUDGE TO DIRECT OUTPUT FROM
;[96bit]PUSHJ	P,GETRSP	;  HARVARD DIRECT TO AN IMP DEVICE.
;[96bit]  EDisix [PTYFLS,,[SIXBIT\454 N&O &IMP&S AVAILABLE.#!\]]
;[96bit]PUSHJ	P,PTYFLS	;FLUSH "IMPN ASSIGNED" MESSAGE
;[96bit]MOVSI	T1,'LPT'	;LOGICAL DEVICE NAME
	MOVE	T1,[Sixbit \Data\]	;[96bit] normal logical name
	MOVEI	T2,0		;ASCII DATA TYPE
	PUSHJ	P,DoOpen	;OPEN DATA CONNECTION FOR OUTPUT
	  POPJ	P,		;ERROR, MSG ALREADY PRINTED
Ife FTHarv,<	;[96bit] harvard DIRECT doesn't support /InDirect
	TXZE	F,NlsCom	;[96bit] an NLST? (Clear flag if on)
	  SKIPA	T1,[Sixbit \/Indir\]	;[96bit] yes: do indirect
	SETZ	T1,		;[96bit] LIST command: don't do indirect
;[96bit]Disix	[[SIXBIT\DIRECT /L %#!\]
	Disix	[RtrEnd,,[SIXBIT\DIRECT Data:=% %#!\]
		WNAME	T1	;[96bit] give the /I if it's there
		PUSHJ	P,IMPPTY]
>	;end of IFE FtHarv
ifn FtHarv,<	;[96bit] harvard DIRECT is "non-standard"
	Disix	[RtrEnd,,[SIXBIT\DIRECT %/FILE=Data:#!\]
		PUSHJ	P,IMPPTY]
>	;end of IFN FtHarv
;[96bit]PUSHJ	P,XFRCHK	;WAIT FOR COMPLETION OF DATA TRANSFER
;[96bit]  POPJ	P,		;ERROR--MESSAGE ALREADY PRINTED
;[96bit]PUSHJ	P,PTYFLS	;GET RID OF ANY GARBAGE FROM DIRECT
;[96bit]WSix	[SIXBIT\IMP CLOSE LPT:#!\] ;CLOSE DATA CONNECTION
;[96bit]MOVSI	T1,'452'	;ERROR CODE TO USE IF ERROR
;[96bit]PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
;[96bit]  PJRST	CPYRSP		;ERROR, CPY RESPONSE TO USER
;[96bit]EWSix	[SIXBIT\252 T&RANSFER COMPLETED.#!\]
;[96bit]PJRST	PTYFLS		;FLUSH REMAINING PTY OUTPUT
;     MLFL <PPN>

IfDef MlFlCommand,<	;[96bit] if we are supporting Mail File commands
			;	 then define this, else leave undefined
			;	 and let the command macro sort it out.
C.MLFL:	MOVE	T1,[SIXBIT/DATA/];THE LOGICAL NAME WE WANT TO USE
	MOVEI	T2,0		;TRANSFER IN ASCII MODE
	PUSHJ	P,DoOpen	;TRY TO GET IMP
	  PJRST ML.ERR		;FAILED..GIVE UP
	TXO	F,MLFLFG	;SET INSIDE MLFL FLAG
;[96bit]Disix	[[SIXBIT\MAIL /ZVRF/ZXC/TO:%/IDENTI:%/FILE:DATA:#!\]
;[96bit]	PUSHJ	P,IMPPTY
;[96bit]	PUSHJ	P,HSTPRT]
	MlFlCommand		; do the right mail file command
	PUSHJ	P,XFRCHK	;WAIT TIL THINGS FINISH UP
	  PJRST ML.ERR		;SOMETHING DIED ALONG THE WAY
	MOVSI	T1,'051'	;GENERAL FTP COMMENTARY
	LCHF	P1			;GET FIRST CHAR
	PUSHJ	P,CPYRSP	;COPY ALL RESPONSES FROM MAIL
	;[96bit] assume no trouble
	Movei	T2,[SIXBIT/252 MAIL &TRANSFER COMPLETED.#!/]
	TXNE	F,ERRFLG	;ANY ERRORS IN RESPONSES?
	  Movei	T2,[SIXBIT/454 MLFL &FAILED.#!/]  ;[96bit] trouble.
	EWSix	(T2)		;[96bit] give the error message
	TXZ	F,MlFlFg	;[96bit] clear mail flag
;[96bit]TXZE	F,LGAR0M	;DID WE LOGIN AS AR0M?
	TXZE	F,TLogin	;[96bit] want to undo login?
	PJRST	FREOUT		;DO A LOGOUT AND RETURN
	PJRST	PTYFLS		;GET RID OF EXTRA PTY TRASH

ML.ERR:	TXZ	F,MLFLFG
;[96bit]TXZE	F,LGAR0M
	TXZE	F,TLogin		;[96bit] undo login?
	PUSHJ	P,FREOUT
	POPJ	P,

>	; end IfDef MlFlCommand
	SUBTTL	MISCELLANEOUS FTP FUNCTIONS

;   MAIL <PPN>

C.MAIL:
;[96bit]Disix	[[SIXBIT\MAIL /ZVRF/ZXC/TO:%/IDENTI:%/FILE:TTY:#!\]
;[96bit]	PUSHJ	P,IMPPTY
;[96bit]	PUSHJ	P,HSTPRT]
	MailCommand		;[96bit] do the right mail command
;[CFE]	MOVSI	T1,'507'	;A GENERAL ERROR CODE
	MOVSI	T1,'454'	;[CFE] A temporary-failure code.
	TXO	F,MAILFG	;[CFE] Let GETRSP make badness into
				;[CFE]   permanent-failure type codes.
	PUSHJ	P,GETRSP	;SEE HOW IT GOES
;[CFE]	  PJRST	CPYRSP		;NOT WELL
	  PJRST	[TXZ	F,MAILFG	;[CFE] Clear this state first
		 PJRST	CPYRSP]		;NOT WELL
;[CFE]	TXO	F,MAILFG	;TELL COMAND TO COME HERE FOR A WHILE
	EWSix	[SIXBIT\350 E&NTER MAIL, ENDED BY A LINE WITH JUST A '.'#!\]
	PJRST	PTYFLS		;FORGET ANYTHING ELSE MAIL SAID

C.MAIX:	MOVE	T1,CMDPTR	;HERE WHEN A TELNET LINE COMES IN WHILE IN MAIL
	ILDB	T2,T1		;SEE IF IT IS ONLY A .<CR>
	CAIE	T2,"."		;WHICH IS THE MAIL TERMINATION CHARACTER
	JRST	MAIX1		;WELL, NOT YET
	ILDB	T2,T1		;IS THE NEXT A <CR>?
	CAIE	T2,CR
	JRST	MAIX1		;NO, SEND IT ALL OFF TO THE PTY
	FOSEL	PTYOBL		;IT IS. FINISH UP MAIL
	W2CHI	<"Z"-100>B28+LF	;AND GIVE IT THE CTRL-Z IT WANTS
				;+ A LF TO FORCE OUT THE BUFFER
	PUSHJ	P,XFRCK1	;WAIT TILL THINGS FINISH UP
		POPJ	P,	;SOMETHING WENT WRONG
	MOVSI	T1,'051'	;GENERAL RESPONSE CODE
	LCHF	P1		;GET FIRST CHAR
	PUSHJ	P,CPYRSP	;COPY RESPONSES LOOKING FOR ERRORS
	;[96bit] assume no trouble
	Movei	T2,[SIXBIT/256 MAIL &COMPLETED.#!/]
	TXNE	F,ERRFLG	;ANY ERRORS IN RESPONSES?
	  Movei	T2,[SIXBIT/454 MAIL &FAILED.#!/]  ;[96bit] trouble.
	EWSix	(T2)		;[96bit] give the error message
	TXZ	F,MAILFG	;CLEAR THIS
	PJRST	PTYFLS		;THROW OUT ANY GARBAGE

MAIX1:	Disix	[[SIXBIT\%#!\]
		PUSHJ	P,IMPPTY]
	POPJ	P,		;FINISHED THIS LINE, TRY ANOTHER
;   DELE <PATHNAME>

C.DELE:	Disix	[[SIXBIT\DELETE %#!\]
		PUSHJ	P,IMPPTY]
	MOVSI	T1,'501'	;ONLY POSSIBLE ERROR IS SYNTAX ERROR
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR, PRINT MESSAGE
	LCHF	P1		;BACK OVER FIRST CHAR OF RESPONSE
	MOVSI	T1,'050'	;GENERAL FTP COMMENTARY
	PUSHJ	P,CPYRSP	;COPY DELETE RESPONSE TO USER
	TXNN	F,ERRFLG	;WERE THERE ANY ERRORS?
	EDisix	[CPOPJ##,,[SIXBIT\254 D&ELETE COMPLETED.#!\]]
	EDisix	[CPOPJ##,,[SIXBIT\451 D&ELETE UNSUCCESSFUL.#!\]]



;   ALLO <DECIMAL INTEGER>

C.ALLO:	EWSix	[SIXBIT\200 A&LLOCATION NOT REQUIRED ON THIS SYSTEM.#!\]
	POPJ	P,



;   RNFR <PATHNAME>

C.RNFR:	HLLZ	T1,CMDPTR	;GET LH OF CURRENT BYTE PTR
	HRRI	T1,RNFBUF	;BUILD POINTER TO "RENAME FROM" BUFFER
	MOVEM	T1,RNFPTR	;SAVE IT
	HRL	T1,CMDPTR	;COPY "FROM" PATHNAME TO TEMP BUFFER
	BLT	T1,RNFBUF+CMDLEN/5
;[CFE] Also copy character count.
	move	t1,CmdCnt	;[CFE] From CMD buffer
	movem	t1,RnFCnt	;[CFE]  to RNF buffer.
	EDisix	[CPOPJ##,,[SIXBIT\200 RNFR &PATHNAME STORED.#!\]]

;   RNTO <PATHNAME>

C.RNTO:	SKIPN	T1,RNFPTR	;CHECK FOR PRECEDING RNFR
	EDisix	[CPOPJ##,,[SIXBIT\504 RNFR &COMMAND MUST PRECEDE &RNTO& COMMAND.#!\]]
	move	t2,RnFCnt	;[CFE] Also load character count
	Disix	[[SIXBIT\RENAME % = %%%#!\]
		PUSHJ	P,IMPPTY	;COPY NEW PATHNAME TO PTY
		MOVEM	T1,CMDPTR
		movem	t2,CmdCnt	;[CFE] Copy count, also
		PUSHJ	P,IMPPTY]	;NOW OLD PATHNAME
	SETZM	RNFPTR		;CLEAR OLD POINTER
	MOVSI	T1,'501'	;ERROR IN FIRST LINE IS PROBABLY SYNTAX
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR, COPY RESPONSE AND QUIT
	LCHF	P1		;OK, BACKUP OVER FIRST CHAR
	MOVSI	T1,'050'	;FTP COMMENTARY
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER
	TXNN	F,ERRFLG	;WERE THERE ANY ERRORS?
	EDisix	[CPOPJ##,,[SIXBIT\253 R&ENAME COMPLETED.#!\]]
	EDisix	[CPOPJ##,,[SIXBIT\451 R&ENAME UNSUCCESSFUL.#!\]]
;   STAT	OR	STAT <PATHNAME>

C.STAT:	PUSHJ	P,SPNOR1	;IGNORE BLANKS
	CAIE	P1,LF		;END OF LINE?
	JRST	STATDR		;NO, GO PROCESS PATHNAME
	MOVSI	T1,'050'
	EDisix	[EXP	SRVMSG
		WSIX	4,T1
		WASC	SYSNAM]
	EDisix	[[SIXBIT\100-C&URRENT PARAMETERS:#∨
    &H&OST: %   &L&ocal &S&OCKET: %   &R&emote &S&OCKET: %#!\]
		PUSHJ	P,HstPrt	;[96bit] print name
		WDEC	LclSkt
		WDEC	RmtSkt]

repeat 0,<	; these are implmeneted
	HLRZ	T1,XFRTYP
	HLRZ	T2,STRTYP
	HLRZ	T3,MODTYP
	EDisix	[[SIXBIT\    B&YTE SIZE: %   &T&YPE: %   &S&TRUCTURE: %   &M&ODE: %#!\]
		WDEC	BYTSIZ
		WCHI	(T1)
		WCHI	(T2)
		WCHI	(T3)]
> ; end of repeat 0

	TXNE	F,LGIFLG	;LOGGED IN?
	EDisix	[[SIXBIT\    S&ERVER JOB LOGGED IN UNDER [%]#!\]
		PUSHJ	P,PPNPRT]
	TXNE	F,USRFLG	;PASSWORD EXPECTED?
	EWSix	[SIXBIT\    P&ASSWORD EXPECTED#!\]
	EWSix	[Sixbit \100 E&nd of status.#!\]	;[96bit]
	POPJ	P,

;HERE TO DO STAT <PATHNAME>, I.E. DIRECTORY LISTING.
STATDR:	TXNE	F,LGIFLG	;LOGGED IN?
	JRST	.+3		;YES, PROCEED
	PUSHJ	P,FRELGI	;NO, ATTEMPT FREE LOGIN
	  POPJ	P,		;FAILED (MSG ALREADY TYPED)
	LCHF	P1		;OK, BACKUP OVER FIRST CHAR OF PATHNAME
	Disix	[[SIXBIT\DIRECT %#!\] ;OUTPUT COMMAND TO PTY
		PUSHJ	P,IMPPTY]
	MOVSI	T1,'501'	;ERROR IS PROBABLY A SYNTAX ERROR
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR--COPY RESPONSE TO USER
	MOVSI	T1,'151'	;DIRECTORY LISTING REPLY
	LCHF	P1		;BACK UP OVER FIRST CHAR
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER
	EWSIX	[SIXBIT\200 D&IRECTORY LISTING COMPLETED.#!\]
	POPJ	P,
;   HELP
;[96bit] messages changed slightly to agree with protocol.

C.HELP:	EDisix	[Cpopj##,,HlpMsg
		  Call	HlpLst
		]

; help message.  note the percent sign at the end of the first line.
HlpMsg:	SIXBIT\200-T&HE FOLLOWING &FTP& FUNCTIONS ARE IMPLEMENTED:%#∨
    &O&NLY &ASCII& AND 36-BIT IMAGE TRANSFERS.#∨
    &STAT, LIST, NLST, DELE, RNFR, RNTO& ACCEPT WILDCARD SPECIFICATIONS.#∨
    &N&ONSTANDARD COMMANDS:#∨
      &XCWD  C&HANGE WORKING DIRECTORY.#∨
      &XSRC  C&HANGE DISK SEARCH LIST.#∨
      &XTIM  D&ISABLE INACTIVITY TIMEOUT.#∨
200 &E&nd of &HELP&.#!\

; prints out all the commands which should be printed for help.
; only called from inside EDisix, so the EFile in standard output.
HlpLst:	MOVSI	T1,-COMLEN	;CHECK EACH ONE
	SETZ	T3,		;RESET NUMBER OF ITEMS SO FAR
HELP1:	MOVE	T2,COMDSP(T1)	;GET DISPATCH WORD FOR THIS COMMAND
	TXNN	T2,CM.HLP	;WANT COMMAND LISTED?
	JRST	HELP2		;NO, SKIP IT
	SOJG	T3,.+3		;JUMP IF STILL ROOM ON THE LINE
	WSIX	[SIXBIT\#    !\] ;NO, START ANOTHER
	MOVEI	T3,↑D10		;RESET COUNTER
	WSIX	6,COMTAB(T1)	;LIST THE COMMAND
HELP2:	AOBJN	T1,HELP1	;LOOP FOR REST
Ife $FtpLog,<	;[96bit] tell if we don't allow not logged in access
	WSIX	[SIXBIT	\#    U&SER COMMAND REQUIRED TO ACCESS ANY FILES.\]
>
	Return			; now go back and print the rest.
	SUBTTL	NONSTANDARD FUNCTIONS

;    XTIM

C.XTIM:	HRROS	WATCNT		;DISABLE INACTIVITY TIMEOUT
	PJRST	COMACK		;ACKNOWLEDGE COMMAND


;    XSRC <SETSRC-STYLE SEARCH LIST>

C.XSRC:	WSix	[SIXBIT\R SETSRC#!\] ;CALL THE STANDARD DEC CUSP
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	COMNAK		;ERROR, COMPLAIN
	PUSHJ	P,PTYFLS	;FLUSH PROMPT, HELP MSG, ETC.
	Disix	[[SIXBIT\C %#!\] ;CREATE NEW SEARCH LIST AS SPECIFIED
		PUSHJ	P,IMPPTY]
	PJRST	XCMRSP		;WAIT FOR WINNING OR LOSING RESPONSE


;    XCWD <DIRECTORY>     OR    XCWD [<DIRECTORY>]

C.XCWD:	WSix	[SIXBIT\R SETSRC#!\] ;RUN SETSRC TO DO THE WORK
	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	COMNAK		;CAN'T DO SETSRC STUFF
	PUSHJ	P,PTYFLS	;FLUSH RESPONSE
	FISEL	IMPCBL		;GET INPUT FROM IMP AGAIN
	CCHF	P1
	PUSHJ	P,SPNOR		;SKIP BLANKS
	CAIE	P1,"["		;DID USER TYPE SQUARE BRACKETS?
	LCHF	P1		;NO, BACKUP (SINCE IMPPTY DOES RCHF)
	;[96bit] NOTE: do NOT add a close bracket to the following
	;	 line.  it makes "XCWD [342,231]" illegal.
	Disix	[[SIXBIT\CP [%#!\] ;ENTER SETSRC COMMAND
		PUSHJ	P,IMPPTY]
XCMRSP:	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  PJRST	COMNAK		;LOSES, SAY WHY
	PUSHJ	P,CNCUSR	;WINS, FORCE TO COMMAND LEVEL
				;AND FALL INTO COMACK


;ROUTINE TO REPLY FOR A SUCCESSFUL MISCELLANEOUS COMMAND

C.NoOp:	;[96bit]	No-Op just acknowledges command
COMACK:	EDisix	[CPOPJ##,,[SIXBIT\200 % &COMMAND ACCEPTED.#!\]
		WNAME	CMDNAM]

;ROUTINE TO COMPLAIN ABOUT AN ERROR IN A NONSTANDARD COMMAND

COMNAK:	MOVSI	T1,'507'	;CATCHALL ERROR REPLY CODE
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER FROM PTY
	EDisix	[CNCUSR,,[SIXBIT\507 % &COMMAND NOT ACCEPTED.#!\]
		WNAME	CMDNAM]
;    XREP	(REPLAY RECORDED PTY DIALOGUE, FOR DEBUGGING)

C.XREP:	EDisix	[Cpopj##,,[SIXBIT\050-R&EPLAY OF RECORDED &PTY& DIALOGUE:#∨
%∨
050 &E&nd of replay.#∨
200 &R&EPLAY COMPLETED.#!\]
	 Call	Replay			; do the replay
	]

Replay:	SKIPGE	T1,RECPTR	;IS ANYTHING THERE?
	  Return		; no, forget it.
	TXNN	F,WRPFLG	;YES, DOES IT WRAP AROUND?
	MOVE	T1,RECPT0	;NO, START AT BEGINNING OF BUFFER
XREP1:	CAMN	T1,RECPTZ	;AT END?
	MOVE	T1,RECPT0	;YES, GO BACK TO BEGINNING
	ILDB	T2,T1		;GET A CHAR
	WCHI	(T2)		;SEND IT TO IMP
	CAME	T1,RECPTR	;BACK WHERE WE STARTED?
	JRST	XREP1		;NO, CONTINUE
	CAIE	T2,LF		;YES, WERE WE AT EOL?
	W2CHI	CRLF		;NO, START FRESH LINE
	Return			; all done: go back and print the ending
	SUBTTL	SUBROUTINES

;ROUTINE TO OPEN THE SUBJOB'S IMP DATA CONNECTION.
;	MOVE	T1,[SIXBIT IMP LOGICAL DEVICE NAME TO BE USED]
;	MOVE	T2,[TYPE INDEX -- 0=ASCII, 1=IMAGE]
;	PUSHJ	P,DoOpen
;	  ERROR RETURN--MESSAGE ALREADY TYPED
;	OK RETURN

DoOpen:
	EDisix	[[SIXBIT\255 SOCK %#!\] ;STANDARD MESSAGE
		WDEC	LCLSkt]
	Disix	[[SIXBIT\IMP CONNECT %: % /LOCAL:%/Absolute/REMOTE:%#!\]
		WNAME	T1
		Pushj	P,HstNoo	;[96bit] print host number
		WDEC	LCLSKT
		WDEC	RmtSkt
		]
	MOVSI	T1,'454'	;MESSAGE CODE IN CASE ERROR
	PUSHJ	P,GETRSP	;EAIT FOR RESPONSE
	  PJRST	CPYRSP		;ERROR, COPY MESSAGE TO USER AND QUIT
	PUSHJ	P,PTYFLS	;OK, FLUSH OUTPUT
	JRST	CPOPJ1##		;TAKE GOOD RETURN
;ROUTINE TO WAIT FOR COMPLETION OF A DATA TRANSFER FUNCTION
;	PUSHJ	P,XFRCHK
;	  ERROR--MESSAGE ALREADY PRINTED AND CONNECTION CLOSED
;	OK--NOTHING PRINTED, CONNECTION NOT CLOSED, OUTPUT NOT FLUSHED

XFRCHK:	MOVEI	T1,1		;WAIT ONE SECOND FOR THINGS TO GET STARTED
	SLEEP	T1,
	PUSHJ	P,PTYCHK	;HAS ANYTHING COME BACK FROM THE SUBJOB?
	  EDisix [XFRCK1,,[SIXBIT\250 % &STARTED.#!\]
		WNAME	CMDNAM]
	PUSHJ	P,GETRSP	;YES, SEE WHAT IT WAS
	  JRST	XFRERR		;AN ERROR, GO COMPLAIN
	EDisix	[CPOPJ1##,,[SIXBIT\250 % &STARTED.#!\]
		WNAME	CMDNAM]

;HERE IF NO RESPONSE IN THE FIRST SECOND
XFRCK1:	PUSHJ	P,GETRSP	;WAIT FOR RESPONSE
	  JRST	XFRERR		;ERROR, GO COMPLAIN
	JRST	CPOPJ1##		;OK, SKIP RETURN

;HERE ON ERROR RESPONSE DURING DATA TRANSFER
XFRERR:
	MOVSI	T3,'507'	;if code is 507 don't change to 454
	CAME	T3,T1
	MOVSI	T1,'454'	;CATCHALL ERROR MESSAGE
	PUSHJ	P,CPYRSP	;COPY ERROR MESSAGE TO USER
	PUSHJ	P,CNCUSR	;FORCE TO COMMAND LEVEL
	WSix	[SIXBIT\IMP CLOSE/SELF#!\] ;CLOSE OPEN CONNECTION(S)
	PJRST	PTYFLS		;FLUSH ANYTHING THAT COMES BACK UP
;ROUTINE TO PERFORM A "FREE" FTP LOGIN
;	PUSHJ	P,FRELGI
;	  ERROR--MESSAGE ALREADY PRINTED
;	OK--LGIFLG HAS BEEN SET

FRELGI:
Ife $MLogin ! $FtpLog,<	;[96bit] if no free logins, complain and return
	EDisix [Cpopj,,[SIXBIT\504 USER &COMMAND REQUIRED BEFORE %.#!\]
		WNAME	CMDNAM]
>	;end ife ftfree
Ifn $MLogin ! $FtpLog,<	;[96bit] want free logins of some kind?
	TXZE	F,USRFLG	;LEFTOVER USER NAME?
	PUSHJ	P,CNCUSR	;YES, FLUSH IT
Ifn $MLogin,<	;[96bit] any special mail stuff?
	TXNN	P4,CM.LGM	;WANT FREE LOGIN FOR MLFL
	JRST	FRELG1		;NO
Ifn MailPPn,<	;[96bit] need to chgppn?
	MovX	T1,MailPPn		;[96bit] change the current ppn
	CHGPPN	T1,
	   JFCL
>	;end ifn MailPPn
	HRRZI	T1,MailLogin	;[96bit] set up the proper ppn
	TXO	F,TLogin	;[96bit] remember to log this out
	JRST	FRELG2
FRELG1:
>	;end ifn $Mlogin
Ife $FtpLog,<	;[96bit] if not allowing normal FTPs without USER,
		;	 then complain and return
	EDisix [Cpopj,,[SIXBIT\504 USER &COMMAND REQUIRED BEFORE %.#!\]
		WNAME	CMDNAM]
>
Ifn $FtpLog,<	;[96bit] logging in for ftp?
Ifn FtpPPn,<	;[96bit] want a chgppn for ftp?
	MovX	T1,FtpPPn	;[96bit] get the PPn to change to
	CHGPPN	T1,		;YES, DO IT
	  JFCL			;DON'T CARE IF FAILS
>
	HRRZI	T1,FtpLogin	;[96bit] get name of free account
>	;end ifn $ftplog
FRELG2:	Disix	[[SIXBIT\LOGIN %#!\] ;ATTEMPT TO LOGIN
		WSIX	(T1)]
	PUSHJ	P,CHKLGI	;SEE HOW IT DID
	  PJRST	[		; totally invalid
		 TXZ F,TLogin	;[96bit] not logged in
		 PJRST LGIERF
		]
	  EDisix [CNCUSR,,[SIXBIT\504 USER &COMMAND REQUIRED BEFORE %.#!\]
		  WNAME	CMDNAM]
	PUSHJ	P,SJBPPN	;WE DID, GET SUBJOB PPN
	MOVEM	T1,PRJPRG	;STORE IT
	TXO	F,LGIFLG	;REMEMBER LOGIN SUCCESS
	LCHF	P1		;RETAIN FIRST CHAR OF RESPONSE
	MOVSI	T1,'050'	;CODE FOR GENERAL FTP INFO
	PUSHJ	P,CPYRSP	;COPY LOGIN MESSAGES TO USER
	FISEL	IMPCBL		;POINT TO INPUT FILE BLOCK AGAIN
	JRST	CPOPJ1##		;TAKE SUCCESS RETURN
>	;end Ifn $MLogin ! $FtpLog


;ROUTINES TO HANDLE LOGIN FAILURE AND PRINT MESSAGE
;	PUSHJ	P,LGIERR OR LGIERF
;	ALWAYS RETURN HERE, MESSAGE PRINTED, PTY OUTPUT FLUSHED
;  LGIERR USES CODE 431, LGIERF USES 504.
;[CFE]	LGIERF now uses 436 since it's just a temporary error condition!

LGIERR:	MOVSI	T1,'431'	;ERROR CODE FOR NORMAL LOGIN ATTEMPT
	TXZA	F,USRFLG	;CLEAR USER-NAME-GIVEN FLAG
;[CFE] LGIERF:	MOVSI	T1,'504'	;ERROR CODE FOR FREE LOGIN ATTEMPT
LGIERF:	MOVSI	T1,'436'	;[CFE] ERROR CODE FOR FREE LOGIN ATTEMPT
	RCHF	P1		;GET FIRST CHAR AFTER QUESTION MARK
	CAIE	P1,"("		;ERROR NUMBER IN PARENTHESES?
	JRST	.+4		;NO
	RCHF	P1		;YES, FLUSH LEFT PAREN
	RCHF	P1		;FLUSH ERROR CODE
	JRST	.+2		;CAUSE RIGHT PAREN TO BE FLUSHED
	LCHF	P1		;BACKUP IF DIDN'T SEE "("
	PUSHJ	P,CPYRSP	;COPY RESPONSE TO USER
	PJRST	CNCUSR		;FORCE SUBJOB TO COMMAND LEVEL.
;ROUTINE TO LOG THE SUBJOB OUT.
;	PUSHJ	P,LGOUSR
;	RETURN HERE AFTER SUBJOB LOGGED OUT

LGOUSR:	PUSHJ	P,CNCUSR	;FORCE TO MONITOR LEVEL
	MOVSI	T1,'050'	;TREAT REPLIES AS COMMENTARY
IfDef KjFunc,<	;[96bit] is there a brain damaged logout?
	KjFunc			;[96bit] yes: use it.
>
IfNDef KjFunc,<	;[96bit] no: use k/b
	WSix	[SIXBIT\KJOB /B#!\] ;PRESERVE ANY FILES POSSIBLE
	PJRST	CPYRSP		;COPY RESPONSE TO USER IF HE'S STILL THERE
>

Repeat 0,<	;[96bit] do this with macros now
	HRRZ	T2,BYEDSP(H)	;GET DISPATCH FOR DESIRED LOGOUT PROTOCOL
	JRST	(T2)		;  FOR THIS HOST

KJOB.F:	WSix	[SIXBIT\KJOB /F#!\];CMU- SAVE ALL FILES
	PUSHJ	P,CPYRSP	;COPY THIS
	TXNN	F,ERRFLG	;ERROR (OVER QUOTA)
	POPJ	P,		;NOPE ALL IS GOODNESS
	PUSHJ	P,CNCUSR	;STOP HIM
	WSix	[SIXBIT/CORE 0#!/];FREE ALL HIS CORE
	PJRST	PTYFLS		;AND GO AWAY

KJOB.B:	WSix	[SIXBIT\KJOB /W/B#!\] ;PRESERVE ANY FILES POSSIBLE
	PJRST	CPYRSP		;COPY RESPONSE TO USER IF HE'S STILL THERE
>	;end of repeat 0


;ROUTINE TO SEND CONTROL-C'S TO THE SUBJOB AND FLUSH ALL RESULTING
;   OUTPUT.
;	PUSHJ	P,CNCUSR
;	ALWAYS RETURN HERE

CNCUSR:	FOSEL	PTYOBL		;SELECT INPUT AND OUTPUT PTY
	FISEL	PTYIBL
	W2CHI	3B28+3		;SEND 2 ↑C'S
	WCHI	LF		;MAKE BUFFER BE FORCED OUT
				;FALL INTO PTYFLS


;ROUTINE TO FLUSH ALL PTY OUTPUT UNTIL IT GOES INTO INPUT WAIT.
;	PUSHJ	P,PTYFLS
;	ALWAYS RETURN HERE

PTYFLS:	FISEL	PTYIBL		;SELECT PTY FOR INPUT
PtyFl1:	RCHF	P1		;GET A CHAR
	JUMPN	P1,PtyFl1	;TRY AGAIN IF GOT ANYTHING
	POPJ	P,		;RETURN WHEN NOTHING MORE


;ROUTINE TO FLUSH PTY OUTPUT UNTIL EITHER A LINE FEED IS ENCOUNTERED
;   OR THE SUBJOB GOES INTO TTY INPUT WAIT.
;	PUSHJ	P,PTYF1L
;	ALWAYS RETURN HERE

PTYF1L:	FISEL	PTYIBL		;SELECT PTY FOR INPUT
PtyF11:	RCHF	P1		;GET A CHAR
	CAIE	P1,LF		;LINE FEED?
	JUMPN	P1,PtyF11	;NO, FLUSH IF NOT END OF OUTPUT
	POPJ	P,
;ROUTINE TO WAIT FOR A RESPONSE FROM THE SUBJOB.
;	PUSHJ	P,GETRSP
;	  ERROR--RESPONSE LINE BEGAN WITH "?"
;	OK RETURN, FIRST CHAR OF RESPONSE IN P1
;   GETRSP FLUSHES BLANK LINES WHILE SEARCHING FOR ITS RESPONSE.

GETRSP:	FISEL	PTYIBL		;SELECT PTY INPUT
GETRS1:	RCHF	P1		;GET A CHAR
	JUMPE	P1,CPOPJ1##	;SKIP RETURN IF GOT NONE
	CAIE	P1,CR		;CARRIAGE RETURN?
	CAIN	P1,LF		;LINE FEED?
	JRST	GETRS1		;YES, FLUSH
	CAIE	P1,"?"		;ERROR RESPONSE?
	JRST	CPOPJ1##		;NO, SKIP RETURN
	;[96bit] check for "?%", which we interpret as
	;	 "user not found" type errors: completely fatal.
	TXNN	F,MAILFG!MLFLFG	;inside mail or mlfl?
	POPJ	P,		;no normal error return
	RCHF	P1		;yes, get next char
	CAIN	P1,"%"		;unknown user type error?
	MOVSI	T1,'507'	;yes, special error code
;[CFE, 16 Apr 81] Make sure a legitimate first character gets through.
	CAIE	P1,"%"		;[CFE] Unless a "%",
	  LCHF	P1		;[CFE]  save it for diagnostic msg.
	POPJ	P,


;ROUTINE TO CHECK WHETHER THE SUBJOB HAS BEEN SUCCESSFULLY LOGGED IN
;AFTER THE LOGIN COMMAND WAS SENT TO IT.
;	Disix	[[SIXBIT\LOGIN %#!\]
;		 PUSHJ	P,WHATEVER]
;	PUSHJ	P,CHKLGI
;	  SOMETHING VERY WRONG, LOGIN GAVE ERROR
;	  NEEDS PASSWORD STILL.
;	SUBJOB LOGGED IN; JOBSTS BITS IN T1

CHKLGI:	PUSHJ	P,GETRSP	;GET RESPONSE FROM LOGIN
	  POPJ	P,		;NOT GOOD, LET CALLER HANDLE
	PUSHJ	P,PTYF1L	;IGNORE THIS LINE (JOB #, TTY#, ETC.)
	jumpn	p1,chklgi	; if there are more chars in the buffer,
				; continue to check for errors.

	; now check to see where we stand
CHKLG1:	MOVEI	T1,PTY		;TAKE A LOOK AT PTY STATUS
	JOBSTS	T1,		;TO CHECK LOGGED IN BIT.
	  PUSHJ	P,Idiocy	;DAMN IT, I JUST HAD ONE!
	txne	t1,jb.uoa	; more output available?
	  jrst	ChkLgi		; yes: go back to error checking
;[CFE]	txne	t1,jb.uli	; well, is it logged in?
;[CFE]	  pjrst	cpopj2		; yes: give an excellent return
;[CFE] Wait for logged-in *and* input wait.
	txnn	t1,Jb.ULI	;[CFE] Logged in?
	  jrst	ChkLg2		;[CFE]  No; skip ahead.
	txnn	t1,Jb.UDI	;[CFE] Awaiting input?
	  jrst	ChkLg3		;[CFE]  no; wait for this bit.
CPopj2:	aos	(p)		; Double-skip (excellent) return.
	jrst	CPopj1##
ChkLg2:
;[CFE]	txne	t1,jb.udi	; input wait?
;[CFE]	  pjrst	cpopj1##	; yes: must want a password
;[CFE]	txne	t1,jb.uml	; at monitor level (and NOT logged in!)
;[CFE]	  pushj	p,idiocy	; this situation should be looked at
;[CFE] No, JB.UDI can happen in monitor mode, also.
	txnn	t1,Jb.UDI	;[CFE] Awaiting input?
	  jrst	ChkLg3		;[CFE]  No, wait for another event.
	txne	t1,Jb.UML	;[CFE] Are we in monitor mode?
	  popj	p,		;[CFE] Yes; something went badly wrong.
	jrst	CPopj1##	;[CFE] No; we must await a password.
ChkLg3:	MOVEI	T1,1		;NONE. WAIT AWHILE
	SLEEP	T1,		; FOR LOGIN TO DO ITS THING
	pushj	p,ImpChk	;[CFE] Check this while we wait
	JRST	CHKLG1		;AND LOOK AGAIN


;ROUTINE TO RETURN THE SUBJOB'S PPN
;	PUSHJ 	P,SJBPPN
;	ALWAYS RETURN HERE WITH PPN IN T1

SJBPPN:	MOVEI	T1,PTY		;PTY CHANNEL
	JOBSTS	T1,		;GET CONTROLLED JOB NUMBER
	  PUSHJ	P,Idiocy
	MOVSI	T1,(T1)		;GET PPN FOR THAT JOB
	HRRI	T1,.GTPPN
	GETTAB	T1,
	  PUSHJ	P,Idiocy
	POPJ	P,
;ROUTINE TO COPY A RESPONSE FROM THE PTY TO THE IMP.
;	MOVE	T1,[4-CHARACTER SIXBIT RESPONSE CODE]
;	PUSHJ	P,CPYRSP
;	ALWAYS RETURN HERE

CPYRSP:	FISEL	PTYIBL		;SELECT PTY INPUT
	FOSEL	IMPOBL		;IMP OUTPUT
	TXZ	F,ERRFLG	;CLEAR ERROR FLAG
CPYRS1:	RCHF	P1		;GET A CHAR
	JUMPE	P1,CpyRs4	;RETURN IF NO MORE
	CAIE	P1,CR		;BLANK LINE?
	CAIN	P1,LF
	JRST	CPYRS1		;YES, FLUSH
;[CFE] Flush double-"." after a MAIL command; ignore leading "."s.
	cain	p1,"."		;[CFE] Is it a monitor dot?
	  jrst	CpyRs1		;[CFE]  yes; ignore it.
	CAIN	P1,"?"		;AN ERROR?
	TXO	F,ERRFLG	;YES, REMEMBER IT
	MOVEI	T2,(P1)		;SAVE THE FIRST CHAR
CpyRsX:	RCHF	P1		;GET NEXT CHAR
	JUMPE	P1,CpyRs4	;QUIT IF NONE (CHAR WAS A PROMPT)
	CAIN	P1,4		;CONTROL-D?
	JRST	CpyRsX		;YES (LOGIN HACK ON SOME ERRORS)
	WSIX	4,T1		;OUTPUT MESSAGE CODE
	WCH	T2		;OUTPUT FIRST CHARACTER
	SKIPA			;KEEP RESPNSE CODE FOR ALL LINES
CPYRS2:	RCHF	P1		;GET A CHAR
	JUMPE	P1,CPYRS3	;JUMP IF ENDED IN MIDDLE OF LINE
	WCH	P1		;OUTPUT CHAR TO IMP
	CAIE	P1,LF		;END OF LINE?
	JRST	CPYRS2		;NO, KEEP COPYING
	JRST	CPYRS1		;YES, START NEW LINE

;HERE IF ENDED IN MIDDLE OF LINE (SHOULDNT)
CPYRS3:	W2CHI	CRLF		;CAUSE LINE TO GO OUT TO IMP ANYWAY
CpyRs4:	FoSel	PtyObl		; return to pty output.
	POPJ	P,


;ROUTINE TO COPY A LINE OF TEXT FROM THE IMP TO THE PTY.
;   THE CRLF AT THE END IS NOT INCLUDED
;	PUSHJ	P,IMPPTY
;	ALWAYS RETURN HERE

IMPPTY:	FISEL	IMPCBL		;SELECT COMMAND BUFFER INPUT
	FOSEL	PTYOBL		;SELECT PTY OUTPUT
IMPPT1:	RCHF	P1		;GET A CHAR
	CAIE	P1,CR		;RETURN OR LINEFEED?
	CAIN	P1,LF
	POPJ	P,		;YES, DONE
	WCH	P1		;NO, SEND TO PTY
	JRST	IMPPT1		;BACK FOR MORE
;ROUTINE TO INPUT A DECIMAL NUMBER FROM THE CURRENT INPUT DEVICE
;   AND RETURN IT IN T1.
;	PUSHJ	P,GETDEC
;	  ERROR--FIRST CHAR NOT A DIGIT
;	OK--NUMBER IN T1

GETDEC:	PUSHJ	P,SPNOR1	;GET FIRST CHAR AND IGNORE SPACES
	TXNN	P2,DIGIT	;IS FIRST CHAR A DIGIT?
	POPJ	P,		;NO--ERROR
	SETZ	T1,		;YES, INITIALIZE NUMBER
GETDE1:	IMULI	T1,↑D10		;ACCUMULATE DIGIT
	ADDI	T1,-"0"(P1)
	RCHF	P1		;GET NEXT
	TRNE	P2,DIGIT	;ALSO A DIGIT?
	JRST	GETDE1		;YES, USE IT
	PUSHJ	P,SPNOR		;NO, IGNORE TRAILING BLANKS
	JRST	CPOPJ1##		;SKIP RETURN


;ROUTINE TO IGNORE BLANKS
;	PUSHJ	P,SPNOR		;USES CURRENT P1
;	PUSHJ	P,SPNOR1	;FETCHES  NEW CHAR BEFORE TESTING

SPNOR1:	RCHF	P1		;FETCH A CHARACTER
SPNOR:	CAIE	P1," "		;BLANK?
	CAIN	P1,CR		;CARRIAGE RETURN (WHICH WE IGNORE)
	JRST	SPNOR1		;YES, FLUSH IT
	POPJ	P,		;NO, RETURN


;ROUTINE TO CHECK FOR PTY OUTPUT
;	PUSHJ	P,PTYCHK
;	  NO OUTPUT AVAILABLE
;	OUTPUT IS AVAILABLE
;   T1 CONTAINS JOBSTS BITS ON EITHER RETURN AND IS THE ONLY AC CLOBBERED

PTYCHK:	MOVE	T1,PTSPNT	;ALSO, SEE IF ANYTHING BUFFERED (NORMALLY WON'T BE)
	CAME	T1,PTRPNT	;MEANING RETRIEVE AND STORE POINTERS ARE DIFFERENT
	JRST	CPOPJ1##		;YES, SKIP RETURN

;ROUTINE TO SEE IF PTY BUFFERS HAVE DATA TO READ IN
PTBCHK:	MOVEI	T1,PTY		;SET PTY CHANNEL
	JOBSTS	T1,		;CHECK STATE OF SUBJOB
	  PUSHJ	P,Idiocy		;HMMM...
	TXNE	T1,JB.UOA	;SUBJOB OUTPUT AVAILABLE?
	AOS	(P)		;THEY ARE...DATA
	POPJ	P,		;NOPE, PTY QUIET
;ROUTINE TO BUFFER PTY OUTPUT SO WE CAN SEND IT SOME DATA

PTYSAV:	PUSH	P,U2		;SAVE CURRENT IO BLOCK
	MOVEI	U2,PTYIBL	;AND POINT TO PTY
PTYS1:	PUSHJ	P,PTYBUF	;GET A CHARACTER FROM PTY
	JUMPE	U1,PTYS2	;0 SAYS END
	SOSLE	PTSCNT		;ROOM TO SAVE THIS ONE?
	IDPB	U1,PTSPNT	;YEP, HE LUCKS OUT
	JRST	PTYS1		;AND TRY FOR ANOTHER, OVERFLOW WILL BE LOST

PTYS2:	POP	P,U2		;RESTORE
	POPJ	P,		;AND RETURN


;ROUTINE TO DO THE RCH OPERATION FOR THE PTY.

PTYRCH:	MOVE	U3,PTRPNT	;PICKUP PTY RETRIEVAL POINTER
	CAMN	U3,PTSPNT	;IS IT THE SAME AS THE STUFF POINTER?
	JRST	PTYBUF		;YES, THEREFORE NO DATA SAVED TO READ, GET FROM BUFFER
	ILDB	U1,U3		;GET NEXT CHAR TO PROCESS
	CAME	U3,PTSPNT	;NOW ARE WE EQUAL?
	JRST	[MOVEM	U3,PTRPNT;NO, SAVE POINTER FOR NEXT TIME
		 POPJ	P,]
	MOVE	U3,[PTYRSH,,PTYRSL];SAME, REINITIALIZE AREA
	BLT	U3,PTYRSE-1	;FOR THE NEXT DATA WE HAVE TO BUFFER
	POPJ	P,		;MEANWHILE, LET THE LAST SAVED CHAR BE PROCESSED

PTYBUF:;ROUTINE TO READ NEXT CHARACTER FROM PTY BUFFERS

	SKIPLE	FILCTR(U2)	;IS THERE ANY BUFFERED DATA?
	JRST	PTYRC1		;YES, GET IT NOW
	MOVE	U1,T1		;NO, SAVE T1
	PUSHJ	P,PTBCHK	;SEE IF PTY HAS ANY MORE OUTPUT DATA
	  JRST	PTYRC2		;IT DOESN'T
	MOVE	T1,U1		;IT DOES.  RESTORE T1 AND PROCESS IT

;HERE WHEN DATA IS AVAILABLE
PTYRC1:	PUSHJ	P,I1BYTE##	;CALL STANDARD BYTE ROUTINE
	JUMPE	U1,PTYBUF	;FLUSH NULLS
	PJRST	RECPUT		;PRINT AND/OR RECORD THE CHAR

;HERE WHEN NO DATA IS AVAILABLE
PTYRC2:	EXCH	U1,T1		;RESTORE T1, PUT JOBSTS BITS IN U1
	TXNE	U1,JB.UDI	;SUBJOB WAITING FOR INPUT?
	TDZA	U1,U1		;YES
	MOVEI	U1,1		;NO, SET SLEEP TIME
	JUMPE	U1,CPOPJ##	;RETURN WITH NULL IF NO MORE OUTPUT
	SLEEP	U1,		;SLEEP ONE SECOND
	PUSHJ	P,IMPCHK	;MAKE SURE TELNET CONNECTION STILL OPEN
	JRST	PTYBUF		;TRY AGAIN
;ROUTINE TO DO WCH OPERATION FOR IMP AND PTY, WHICH WANT TO BREAK
;   ON END-OF-LINE.

IMPWCH:	TXNN	F,OPNFLG	;TELNET CONNECTION OPEN?
	POPJ	P,		;NO, FLUSH IMP OUTPUT
PTYWCH:	PUSHJ	P,O1BYTE##	;CALL STANDARD BYTE OUTPUT ROUTINE
	CAIN	U2,PTYOBL	;PTY OUTPUT?
	PUSHJ	P,RECPUT	;YES, PRINT AND/OR RECORD THE CHAR
	MOVEI	U3,(U1)	;COPY CHARACTER JUST OUTPUT
	ANDI	U3,177		;7 BITS ONLY
	CAIE	U3,LF		;REACHED END OF LINE?
	POPJ	P,		;NO
	CAIE	U2,PTYOBL	;GOING OUT TO PTY?
	JRST	PTYW2		;NO, CAN DO OUTPUT
PTYW1:	MOVEI	U3,PTY		;LET'S SEE IF PTY WANTS DATA
	JOBSTS	U3,
	  JRST	PTYW2		;FAILED? SHOULDN'T HAVE
	TXNE	U3,JB.UOA	;ANY OUTPUT FROM PTY THAT WE MUST STORE FIRST?
	JRST	[PUSHJ P,PTYSAV	;YES, GO BUFFER EVERYTHING IN SIGHT
		 JRST	PTYW1]	;AND SEE IF WE CAN OUTPUT NOW
	TXNE	U3,JB.UDI	;OKAY TO OUTPUT TO?
	JRST	PTYW2		;YES, DO SO
	MOVX	U3,HB.RWJ!HB.RPT!↑D1000;WAIT FOR PTY ACTIVITY
	HIBER	U3,		;DO SO
	  JRST	[MOVEI	U3,1	;FAILED (10/40) SLEEP A SECOND
		 SLEEP	U3,
		 pushj	p,ImpChk ;[CFE] Check IMP connection
		 JRST	PTYW1]	;AND TRY AGAIN
	pushj	p,ImpChk	;[CFE] Ensure connection still there
	JRST	PTYW1		;TRY AGAIN FROM HIBERNATE

PTYW2:	PUSHJ	P,UXCT2##	;YES, CAUSE OUTPUT TO BE SENT
	  OUT
	  POPJ	P,		;OK
	MOVE	U1,FILER2(U2)	;ERROR, TAKE ERROR DISPATCH
	PJRST	UERXIT##


;ROUTINE TO MONITOR AND/OR RECORD CHARACTER IN U1 FOR LATER PLAYBACK.
;	MOVE	U1,[ASCII CHARACTER]
;	PUSHJ	P,RECPUT
;	ALWAYS RETURN HERE, ALL AC'S PRESERVED

RECPUT:	TXNE	F,SLGFLG	;MONITORING?
	OUTCHR	U1		;YES, PRINT THE CHARACTER
	EXCH	U2,RECPTR	;GET CURRENT RECORDING POINTER
	CAME	U2,RECPTZ	;AT END OF BUFFER?
	JRST	.+3		;NO
	TXO	F,WRPFLG	;YES, REMEMBER WE WRAPPED AROUND
	MOVE	U2,RECPT0	;RESET POINTER TO START
	IDPB	U1,U2		;STORE CHAR IN BUFFER
	EXCH	U2,RECPTR	;RESTORE U2 AND STORE NEW POINTER
	POPJ	P,		;RETURN

RECPTZ:	POINT	7,RECBUF+RECSIZ-1,34	;POINTER TO LAST CHAR OF BUFFER
;ROUTINE TO DO THE RCH OPERATION FROM THE IN-CORE IMP BUFFER.

RCHICB:
;[CFE] Provide overflow-safe character processing: obey a count of
;[CFE]  the number of characters saved in the buffer.  Return LFs
;[CFE]  when we're at end of buffer.
	sosge	CmdCnt		;[CFE] Decr and test count
	  jrst	[movei	u1,12	;[CFE] Out of chars!  Return a LF.
		 popj	p,]	;[CFE]
	ILDB	U1,CMDPTR	;GET A CHAR
	CAIL	U1,"A"+40	;LOWER CASE?
	CAILE	U1,"Z"+40
	POPJ	P,		;NO
	TXNN	F,MAILFG	;AND NOT MAIL?
	SUBI	U1,40		;YES, MAKE UPPER
	POPJ	P,


Repeat 0,<	; remove these, and their UUOs (SixImp, SixPty,
		; DSxPty, DSxImp), and replace them with error
		; channel for imp output, normal output for pty output

;VARIOUS SPECIAL UUO HANDLERS

UDSXPT::MOVEI	U2,PTYOBL	;DISIX OPERATION TO PTY
	JRST	.+2

UDSXIM::MOVEI	U2,IMPOBL	;DISIX OPERATION TO IMP
	MOVEM	U2,OFILE##	;STORE CORRECT POINTER TO FILE BLOCK
	PJRST	UDISIX##

USIXPT::MOVEI	U2,PTYOBL	;WSIX OPERATION TO PTY
	JRST	.+2

USIXIM::MOVEI	U2,IMPOBL	;WSIX OPERATION TO IMP
	MOVEM	U2,OFILE##	;STORE CORRECT FILE BLOCK POINTER
	SETZ	U3,		;ONLY INDEFINITE WSIX ALLOWED!
	PJRST	UWSIX##		;DO OPERATION

>;	end of Repeat 0


;ROUTINE TO HANDLE IMPOSSIBLE ERRORS

Idiocy:	SOS	T1,(P)		;GET ERROR ADDRESS
	EDisix	[C.BYE,,[SIXBIT\435 A&N IMPOSSIBLE ERROR HAS OCCURRED AT LOCATION %#!\]
		WOCTI	(T1)]
;ROUTINE TO MAKE SURE THE TELNET CONNECTION IS STILL OPEN.
;	PUSHJ	P,IMPCHK
;	RETURN HERE IF STILL OPEN
;   INITIATES "BYE" COMMAND IF CONNECTION HAS CLOSED
;   NO AC'S CLOBBERED

IMPCHK:	TXNN	F,OPNFLG	;DO WE THINK IT'S OPEN NOW?
	POPJ	P,		;NO, JUST FLUSHING JOB OR SOMETHING
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVEI	P1,CONBLK	;DO STATUS OPERATION
	IMPUUO	P1,
	  JRST	ImpEro		;CONNECTION MUST HAVE GONE AWAY
	LDB	P1,[POINT 6,.IBSTT+CONBLK,35] ;GET STATE
	CAIg	P1,.ISEst	; established or working on it?
	  POPJ	P,		;YES, RETURN
;HERE ON IMP ERROR (PROBABLY CONNECTION CLOSED)
ImpEro:	TXZ	F,OPNFLG	;CLEAR IMP OPEN FLAG
	JRST	C.BYE		;FORCE A BYE COMMAND


;HERE ON ERROR FROM THE PTY. TELL USER WHAT HAPPENED, THEN CLOSE
PTYERR:	pushj	p,ImpChk	;[CFE] Check IMP before write, also.
	EDisix	[C.BYE,,[SIXBIT\435 %#!\]
		 ERROUT	PTYOBL]	;REPORT PTY ERROR AND BREAK CONNECTION


;ROUTINE TO PRINT C(PRJPRG) AS REGULAR PPN OR CMUPPN
;	PUSHJ	P,PPNPRT
;	ALWAYS RETURN HERE

PPNPRT:	WPPN	PRJPRG		;PRINT PPN THE REGULAR WAY
	POPJ	P,


;ROUTINE TO PRINT THE NAME OR NUMBER OF THE FOREIGN HOST
; uses currently selected output, which will be the IMP if called
; from "inside" a EDisix.
;	PUSHJ	P,HSTPRT
;	ALWAYS RETURN HERE

HSTPRT:
;[96bit]SKIPE	SXBHST		;DO WE KNOW WHO HE IS?
;[96bit]DISIX	[CPOPJ##,,[SIXBIT\%-%!\]
;[96bit]	WNAME	SXBHST
;[96bit]	WNAME	SXBHST+1]
;[96bit]WDEC	HSTADR		;NO, JUST PRINT IN DECIMAL
	Skipg	HsName		;[96bit] know the name?
	  Jrst	HstNoo		;[96bit] no: print the number
	WASC	@HsName		;[96bit] print the name
	Popj	p,		;[96bit] and return

HstNoo:	;[96bit] subroutine to print host number in new format
	pushj	p,save3##		;[tcp] get P1-P3
	move	p2,HstAdr		;[tcp] get host address
	lsh	p2,4			;[tcp] left justify it
	movei	p3,4			;[tcp] set counter
HstLoo:	setz	p1,			;[tcp] clear target reg
	lshc	p1,↑d8			;[tcp] shift next 8 bits up
	wdec	p1			;[tcp] and print it
	sojle	p3,cpopj##		;[tcp] count and return if done
	wchi	"."			;[tcp] print separator
	jrst	HstLoo			;[tcp] and loop


;[96bit] subroutine to set a new host address.  checks HstTmp:
;	 if non-zero, moves value into HstAdr, and looks up the
;	 name and puts it in HsName.  if can't find name, HsName
;	 gets -1.
;NOTE: this routine CANNOT be called from withing a LUUO, like
;      in the instruction list for a EDisix, for example.
SetNam:	Push	P,T1		;[96bit] save a reg
	Skipn	T1,HstTmp	;[96bit] new address?
	  Jrst	Tpopj		;[96bit] no: just return
	Movem	T1,HstAdr	;[96bit] save new address
	Clearm	HstTmp		;[96bit] if it's new, forget newness.
	Setom	HsName		;[96bit] assume we're going to fail
	Push	P,T2		;[96bit] save reg from nasty HstNum
	PUSHJ	P,HstNum##	;FIND OUT WHAT IT'S NAME IS
	  Jfcl			; couldn't get tables.
	  Jrst	T2Popj		; couldn't find entry.  flag is set
	hrrzm	T1,HsName	; remember
T2Popj:	Pop	P,T2		;[96bit] restore T2
TPopj:	Pop	P,T1		;[96bit] restore T1
	Popj	P,		;[96bit] return
	SUBTTL	INITIAL FILE BLOCKS

	XALL

;ICP OUTPUT
ICPBLH:	FILE	IMP,O,ICPBLK,<DEV(ICP),STAT(6)>

;IMP INPUT OVER TELNET CONNECTION
IMPIBH:	FILE	IMP,I,IMPIBL,<DEV(TTY),STAT(.IOASC),OPEN(BYEFR2)
		,INPUT(ImpEro),EOF(ImpEro),OTHER(IMPOBL)>

;IMP OUTPUT OVER TELNET CONNECTION
IMPOBH:	FILE	IMP,O,IMPOBL,<DEV(FTPSRV),STAT(.IOASC),OPEN(BYEFR3)
		,OUTPUT(ImpEro),OTHER(IMPIBL),<INST(<PUSHJ P,IMPWCH>)>>
;PTY INPUT (SUBJOB'S OUTPUT)
PTYIBH:	FILE	PTY,I,PTYIBL,<DEV(PTY),STAT(.IOASC),OPEN(PTYTRY)
		,INPUT(PTYERR),EOF(PTYERR),OTHER(PTYOBL)
		,<INST(<PUSHJ P,PTYRCH>)>>

;PTY OUTPUT (SUBJOB'S INPUT)
PTYOBH:	FILE	PTY,O,PTYOBL,<DEV(PTY),STAT(.IOASC),OPEN(PTYTRY)
		,OUTPUT(PTYERR),OTHER(PTYIBL),<INST(<PUSHJ P,PTYWCH>)>>

;INPUT FROM IMP COMMAND BUFFER
IMPCBH:	PFILE	IMPCBL,<PUSHJ P,RCHICB>
	SUBTTL	LOW-SEGMENT INITIALIZATION DATA

FILLH:

; CONBLK (TELNET CONNECTION BLOCK)
	SIXBIT	\FTPSRV\
	0
	EXP	TLNSKT
	0			;[96bit]
	0

;DEFAULT FTP TRANSFER PARAMETERS
	EXP	↑D8		;BYTE SIZE
	"A" ,,	0		;TRANSFER TYPE (ASCII)
	"F" ,,	0		;STRUCTURE (FILE)
	"S" ,,	0		;MODE (STREAM)

;MISCELLANEOUS
RECPT0:	POINT	7,RECBUF	;POINTER TO FIRST CHAR -1 OF PTY DIALOGUE
				;  RECORDING BUFFER
PTYRSH:				;ADDRESS OF DATA TO REINIT PTY SAVE AREA
	POINT	7,PTYHID	;FIRST-1 CHAR OF BUFFER
	POINT	7,PTYHID
	RECSIZ*5		;# OF BYTES WE CAN STORE
	SUBTTL	OTHER TABLES AND STUFF

;SIGNON STRING

DEFINE XX(V,U,E,W) <
IFE W,<
SRVMSG:	SIXBIT	\%% FTP S&ERVER& V'U(E)#!\
>
IFN W,<
SRVMSG:	SIXBIT	\%% FTP S&ERVER& V'U(E)-W#!\
>>
	VERSTR

;DISPATCH TABLES FOR HOST-DEPENDENT HANDLING

MailCm:	MailCommand		;[96bit] monitor command for mailing

repeat 0,<	;[96bit] forget the tables
HSTTAB:				;HOST NUMBER IN LH, FREE ACCOUNT STRING IN RH

FREACT:	↑D9	,, [SIXBIT\62,"#!\]
	↑D14	,, [SIXBIT\N900AR00!\]
	↑D78	,, [SIXBIT\N900AR00!\]
	↑D142	,, [SIXBIT\N900AR00!\]

	NHOSTS==.-HSTTAB	;NUMBER OF HOSTS IN TABLE

PPNCHG:	0			;PPN TO CHANGE TO WHEN DOING FREE LOGIN
	33125	,, 13750	; N900AR00 (CMUPPN)
	33125	,, 13750
	33125	,, 13750

BYEDSP:	0	,, KJOB.B	;RH IS DISPATCH FOR BYE HANDLING
	0	,, KJOB.F
	0	,, KJOB.F
	0	,, KJOB.F
>
	SUBTTL	LOW SEGMENT
	RELOC	0

ZEROL:		;BEGINNING OF AREA TO ZERO DURING INITIALIZATION

PDL:	BLOCK	PDLSIZ		;STACK
PRJPRG:	BLOCK	1		;PPN OF SUBJOB WHILE LOGGED IN
HSTADR:	BLOCK	1		;HOST TO USE IN DATA TRANSFERS
HstTmp:	Block	1		; place to put a potential new host adr.
HsName:	block	1		; pointer to asciz string of host name
RmtSkt:	BLOCK	1		;REMOTE SOCKET FOR data OPERATIONs
LclSkt:	block	1		; our socket number for data connections
SYSNAM:	BLOCK	5		;LOCAL MONITOR NAME GETS PUT HERE
CMDBUF:	BLOCK	CMDLEN/5+1	;INPUT FTP COMMAND BUFFER
CMDPTR:	BLOCK	1		;POINTER INTO CMDBUF
CmdCnt:	block	1		;[CFE] Count of chars in CmdBuf
RNFBUF:	BLOCK	CMDLEN/5+1	;AREA TO SAVE "RNFR" PATHNAME UNTIL "RNTO"
RNFPTR:	BLOCK	1		;POINTER INTO RNFBUF
RnFCnt:	block	1		;[CFE] Count of chars in RnFBuf
CMDNAM:	BLOCK	1		;NAME OF FTP COMMAND BEING EXECUTED
WATCNT:	BLOCK	1		; # SECONDS WAITED FOR USER TO DO SOMETHING
LHOSTP:	BLOCK	.IBSIZ		;LOCAL HOST PARAMETERS
RECBUF:	BLOCK	RECSIZ		;REGION FOR RECORDING PTY DIALOGUE
PTYHID:	BLOCK	RECSIZ		;REGION FOR SAVING PTY OUTPUT

ICPBLK:				;FILE BLOCK FOR DOING ICP
IMPIBL:	BLOCK	FBSIZE		;IMP TELNET INPUT BLOCK
IMPOBL:	BLOCK	FBSIZE		;IMP TELNET OUTPUT BLOCK
PTYIBL:	BLOCK	FBSIZE		;PTY INPUT (SUBJOB OUTPUT) BLOCK
PTYOBL:	BLOCK	FBSIZE		;PTY OUTPUT (SUBJOB INPUT) BLOCK
IMPCBL:	BLOCK	PBSIZE		;FTP COMMAND PSEUDO-FILE BLOCK

ZEREND:		;END OF AREA TO ZERO DURING INITIALIZATION
FILLL:		;BEGINNING OF AREA TO FILL WITH NONZERO DATA

CONBLK:	BLOCK	.IBSIZ		;TELNET CONNECTION BLOCK

BYTSIZ:	BLOCK	1		;DATA CONNECTION BYTE SIZE
XFRTYP:	BLOCK	1		;DATA TRANSFER TYPE
STRTYP:	BLOCK	1		;DATA TRANSFER STRUCTURE
MODTYP:	BLOCK	1		;DATA TRANSFER MODE

RECPTR:	BLOCK	1		;BYTE POINTER FOR RECORDING PTY DIALOGUE
PTYRSL:				;ADDR TO BLT TO TO REINIT PTY SAVE REGION
PTSPNT:	BLOCK	1		;POINTER FOR STUFFING CHARACTERS
PTRPNT:	BLOCK	1		;POINTER FOR PICKING UP CHARACTERS
PTSCNT:	BLOCK	1		;# OF CHARS LEFT TO FILL IN BUFFER
PTYRSE:				;ADDR+1 TO FINISH REINIT

FLLEND:		;END OF AREA TO SETUP DURING INITIALIZATION

	RELOC
	END	FTPSRV