Google
 

Trailing-Edge - PDP-10 Archives - BB-H138C-BM - 5-sources/ftpser.mac
There are 4 other files named ftpser.mac in the archive. Click here to see a list.
;<5.ARPA-UTILITIES>FTPSER.MAC.6, 26-Jan-82 11:39:14, Edit by PAETZOLD
;Update for 96-bit leaders.....finally
;<4.ARPA-UTILITIES>FTPSER.MAC.9,  4-Jan-80 09:46:18, EDIT BY R.ACE
;UPDATE COPYRIGHT DATES
;<4.ARPA-UTILITIES>FTPSER.MAC.8, 11-Oct-79 11:35:30, Edit by LCAMPBELL
; Update version and edit numbers for release 4
;<4.ARPA-UTILITIES>FTPSER.MAC.7, 10-Oct-79 09:37:16, Edit by LCAMPBELL
; Ctrl-V the lowercase stuff in "somebody at " message
;<4.ARPA-UTILITIES>FTPSER.MAC.6, 28-Sep-79 11:42:11, Edit by LCAMPBELL
; Lowercase "mail will be forwarded" message
;<4.ARPA-UTILITIES>FTPSER.MAC.5, 24-Sep-79 14:45:10, Edit by LCAMPBELL
; Set last writer of MAIL.TXT to "Somebody at <hostname>"
;<4.ARPA-UTILITIES>FTPSER.MAC.4, 13-Jul-79 16:53:45, Edit by LCAMPBELL
; Release 4 fix (clear bit 200 at TELBIN)
;<4.ARPA-UTILITIES>FTPSER.MAC.3, 10-Jul-79 05:29:42, EDIT BY R.ACE
;UPDATE COPYRIGHT NOTICE
;<4.ARPA-UTILITIES>FTPSER.MAC.2, 27-Apr-79 11:45:16, Edit by LCAMPBELL
; New Telnet fix
;<HACKS>FTPSER.MAC.8,  1-Jun-78 23:00:29, EDIT BY JBORCHEK
;TRY TO USE THE DEFAULT ACCOUNT IF YOU CAN
;<HACKS>FTPSER.MAC.3,  1-Jun-78 21:54:41, EDIT BY JBORCHEK
;NEVER ASSUME NUMERIC ACCOUNTS
;<JBORCHEK>FTPSER.MAC.2, 24-Apr-78 13:24:10, EDIT BY JBORCHEK
;CHANGE TTY TYPE TO 9 AND SET TO BINARY NO ECHO MODE
;INT ON QUOTA EXCEEDED. DATA ERRORS NOW CLOSE CONN.
;<3.ARPA-UTILITIES>FTPSER.MAC.5, 14-Nov-77 10:18:49, EDIT BY CROSSLAND
;CORRECT COPYRIGHT NOTICE
;<3.ARPA-UTILITIES>FTPSER.MAC.4, 26-Oct-77 02:36:41, EDIT BY CROSSLAND
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>FTPSER.MAC.3, 30-Sep-77 11:07:44, EDIT BY CROSSLAND
;<3-UTILITIES>FTPSER.MAC.2, 20-Jun-77 22:15:47, EDIT BY CROSSLAND
;CONVERT TO MULTIPLE STRUCTURES
;<101B-SOURCES>FTPSER.MAC.2,  1-Apr-77 15:52:33, EDIT BY CROSSLAND
;ADD JFCL'S AFTER RFBSZ'S FOR TOPS-20
;^V QUOTE UNSENT MAIL
;<A-UTILITIES>FTPSER.MAC.7,  3-Dec-76 15:53:46, EDIT BY CLEMENTS
; CONDITION OUT IPCF REPORT - NO TIME TO FINISH IT.
;<A-UTILITIES>FTPSER.MAC.6, 23-Nov-76 15:05:25, EDIT BY CLEMENTS
;ADD SFCOC TO ALL "2" AT STARTUP - FIXES ^L IN MAIL SCREWUP
;ADD IPCF REPORTING TO FTSCTL
; CHANGE MAIL FILE NAME FROM MESSAGE.TXT TO MAIL.TXT
; REMOVE XLPTF COMMAND
; REMOVE FILTERING OF FORMFEEDS FROM MAIL
;<2MURPHY>FTPSER.MAC.2, 16-Jul-76 17:18:32, EDIT BY MURPHY
;CHANGE STENEX TO MONSYM,MACSYM
;<SOURCES>FTPSER.MAC;56    23-Apr-76 16:06:11    EDIT BY CLEMENTS
; Add XLPTF command. Prevent autologout sometimes. DEBUG ok if wheel.
;<SOURCES>FTPSER.MAC;55    15-OCT-75 13:39:55    EDIT BY CLEMENTS
; Changed timeout logic to not hang up if logged in.
;<SOURCES>FTPSER.MAC;54     8-OCT-75 14:52:32    EDIT BY CLEMENTS
; REMOVE CHECK FOR FILE BEING OPEN AT TELBIN, SINCE IT FAILS FOR
; PRIMARY JFN WHEN IT'S A TTY. WAS CAUSING NULLS TO ABORT MAIL.
;<SOURCES>FTPSER.MAC;53    22-SEP-75 13:06:40    EDIT BY CLEMENTS
;<CLEMENTS>FTPSER.MAC;52    24-JUL-75 18:35:38    EDIT BY CLEMENTS
; STTYP OF 0 AT STARTUP, CLEAR ADVICE AT STARTUP
;<CLEMENTS>FTPSER.MAC;51    16-JUL-75 17:53:20    EDIT BY CLEMENTS
; Repaginated
;<CLEMENTS>FTPSER.MAC;50    16-JUL-75 16:48:28    EDIT BY CLEMENTS
; Make CWD try to do a CNDIR; Make PASS after CWD do CNDIR if needed.
;<CLEMENTS>FTPSER.MAC;49    16-JUL-75 13:46:54    EDIT BY CLEMENTS
; Make ACCT command legal after already logged in. Does CACCT.
;<CLEMENTS>FTPSER.MAC;48    11-JUL-75 14:51:40    EDIT BY CLEMENTS
;<CLEMENTS>FTPSER.MAC;47    10-JUL-75 13:00:04    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;46     9-JUL-75 17:41:04    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;45     9-JUL-75 17:29:28    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;44     9-JUL-75 16:17:06    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;43     9-JUL-75 13:24:59    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;42     5-JUL-75 23:52:38    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;41     5-JUL-75 23:08:20    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;40     5-JUL-75 22:55:46    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;39     5-JUL-75 17:16:26    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;37     3-JUL-75 14:26:21    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;36     3-JUL-75 13:27:09    EDIT BY CLEMENTS
; ADD THE FILE ACTIVITY COMMANDS
;<CLEMENTS>FTPMSV.MAC;35     3-JUL-75 00:01:20    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;34     2-JUL-75 23:27:21    EDIT BY CLEMENTS
;<CLEMENTS>FTPMSV.MAC;31    30-JUN-75 15:11:59    EDIT BY CLEMENTS
; Initial development continuing

;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1976,1977,1978,1979,1980 by Digital Equipment Corporation, Maynard, Mass.


TITLE FTPSER - FTP server. New CRJOB style

;STARTED UP BY FTSCTL.EXE (or NETSER.EXE) SYSTEM JOB

VWHO==0			;last edited by SWE
VMAJOR==5		;MAJOR VERSION #
VMINOR==0		;REVISION #
VEDIT==^D18		;EDIT NUMBER

	LOC	<.JBVER==137>
VERSIO:	<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT ;VERSIONS FOR TYPEOUT
	RELOC


TWOSEG			;THE HIGH SEG CONTAINS CODE USED AFTER LOGIN
RELOC 400000		;CREATE THE HIGH SEG

SEARCH MONSYM,MACSYM

SALL

;AC DEFINITIONS

F=:0		;FLAGS
A=:1		;A-D ARE JSYS ARGS
B=:2
C=:3
D=:4

T1=:5		;TEMPS
T2=:6
P1=:7		;PERMANENT OVER SUBR CALLS
P2=:10
P3=:11

BP=:14		;BYTE POINTER FOR COLLECTING, PARSING STRINGS
X=:15		;MSG POINTER IN MAIL ERRORS

P=:17		;STACK
;PARAMETERS

PDLL==40	;LENGTH OF STACK

TIMCHN==^D24	;CHANNEL POKED BY TIMING FORK EVERY NOW AND THEN
CTCCHN==^D25	;CHANNEL FOR CONTROL C
DETCHN==^D26	;CHANNEL FOR NVT HANGUP

LCMDIB==^D512	;WORDS TO HOLD TELNET LINE. MAKE RIDICULOUSLY HUGE
		;BECAUSE OF NLS USERS' INABILITY TO TYPE CARRIAGE RETURN
LNMAIL==10	;#12 Table size NOMAIL; dir numbers of those who can't
		;#12  receive network mail
LREPLY==^D100	;WORDS TO HOLD REPLY. SHOULDN'T NEED NEARLY THIS MUCH
WATTIM==^D300	;SECONDS TO WAIT FOR USER TO TYPE SOMETHING
MLSKT==^D232		;FOREIGN SOCKET FROM WHICH COMES AUTHENTICATED
			; MAIL IF WE TRUST THE SITE

IFNDEF IPCLOG,<
IPCLOG==0		;RUDIMENTARY LOGGING VIA IPCF,
			; NOT YET IMPLEMENTED
   >

DEFINE CLOSE (FILE)<	MOVEI A,FILE
	PUSHJ P,CLOSER
>
DEFINE CLOSK (FILE)<	MOVEI A,FILE
	PUSHJ P,CLOSEK
>

	LOC 2000		;ORIGIN OF CODE IN LOW SEGMENT
;FLAGS IN AC F

L.SEND==400000		;DISTINGUISH DATA SENDS FROM RECEIVES
L.CMDK==200000		;ERRRPL SETS THIS. CAUSES GETCOM TO HANG UP.
L.LTL==100000		;LINEIN SETS THIS. LINE WAS RIDICULOUSLY LONG.
L.LICV==040000		;SET IN LINEIN WHEN ^V SEEN
L.MLFL==020000		;DISTINGUISH MAIL FROM MLFL
L.ANON==010000		;ANONYMOUS LOGIN
L.NUMA==004000		;FLAG NON-NUMERIC STRING IN ACCOUNT COMMAND
L.MFWD==002000		;MAIL WILL BE FORWARDED
L.LOGI==001000		;I AM LOGGED IN
L.APPE==000400		;APPEND VERSUS STOR
L.LDSK==000200		;LOCAL FILE IS ON DISK
L.STAT==000100		;STAT VERSUS LIST
L.NALO==000020		;DON'T AUTO-LOGOUT THIS JOB.
L.RNIL==000010		;RETRIEVE A MEGABIT FROM NIL:
L.PDIR==000004		;PRINT DIRECTORY NAME, IN LIST AND STAT
L.ACTV==000002		;FILE ACTIVITY GOING ON
L.ABOR==000001		;ABORT REQUEST RECEIVED DURING FILE ACTIVITY

R.RLPT==1		;ON IF RECEIVING FOR SPOOLED LPT
R.TYPX==2		;ON WHEN RETR OR STOR IS PAGED FILE TYPE (XTP)
R.T1==4			;TEMPS USED IN DIRECTORY LISTING ROUTINE
R.T2==10		; ..
R.NLST==20		;DISTINGUISH LIST FROM NLST
R.XRCP==40		;#7 XRCP vs MAIL
;START ADDRESS OF THE TOP LEVEL OF FTP SERVICE

GO:	RESET			;START HERE, CLEAN SLATE
	MOVE A,[112,,11]	;#2 Determine whether TOPS20 or TENEX..
	CALLI A,41		;#2  ..
	 MOVEI A,30000		;#2 
	SETZM TOPS20		;#2 Assume TENEX
	CAIN A,40000		;#2  unless system says TOPS20
	AOS TOPS20		;#2 
	MOVE A,[440700,,REPLYM]	;#8 Init reply mechanism, in case
	MOVEM A,REPLYP		;#8  of "PUSHJ P,BOMB"
	MOVE P,PDP		;SET UP A STACK
	MOVEI F,0		;INITIALIZE ALL FLAGS TO ZERO
	MOVE A,['FTPSER']	;SET NAME TO THIS FOR ACCOUNTING
	SETNM
	MOVEI A,400		;REMOVE ACCESS TO HIGH SEGMENT
	PUSH P,A		; WHERE THE FILE ACTIVITY CODE IS
GOSPLP:	MOVSI A,400000		;PAGE IN THIS FORK
	HRR A,0(P)		;HERE IN THE ADDRESS SPACE
	RPACS			;SEE IF THE PAGE EXISTS
	TLNN B,(1B5)		; ..
	JRST GONXTP		;NO SUCH PAGE. SEE IF ANY MORE.
	MOVSI B,(1B8)		;ACCESS TO NONE, BUT TRAP IF REFERENCED
	SPACS			; ..
GONXTP:	AOS B,0(P)		;ON TO NEXT PAGE
	CAIGE B,700		;UP TO DDT?
	JRST GOSPLP		;NO, DISCARD ANOTHER ONE
	POP P,(P)		;DISCARD PAGE NUMBER
	GJINF			;SEE WHAT MY CONDITION IS
	MOVEM A,GJINF1		;AND SAVE FOR LATER
	MOVEM B,GJINF2
	MOVEM C,GJINF3
	MOVEM D,GJINF4
	SKIPN A			;AM I LOGGED IN ALREADY?
	TLZA F,L.LOGI		;NO
	TLO F,L.LOGI		;YES.

	TLNE F,L.LOGI		;IF LOGGED IN,
	PUSHJ P,GETHI		;MAP THE HIGH SEG BACK IN, UNWRITABLE.
	JUMPGE D,INIT1		;JUMP IF I'M ATTACHED.
	SETO A,0		;NOT. LOG OUT IF NOT LOGGED IN
	SKIPN GJINF1		;LOGGED IN DIRECTORY?
	PUSHJ P,LOGOUT		;NONE. KILL OFF JOB
	  JFCL
	MOVEI A,101		;POINT TO THE CONTROLLING TTY
	DOBE			;THIS WILL HANG UNTIL ATTACHED
	JRST GO			;AND GO TRY AGAIN.
INIT1:	MOVEI A,400000		;GET CAPABILITIES
	RPCAP			;SO CAN ENABLE CONTROL C,
	IOR C,B			;AND DELIVER MAIL
	EPCAP			; ..
	PUSHJ P,TIMEOK		;SET UP INITIAL TIME BEFORE PSI IS ON
	SETOM TFORKX		;NO TIMING FORK YET
	MOVEI A,100		;SET NVT TYPE TO 9
	MOVEI B,9
	SKIPN TOPS20		;#2 
	MOVEI B,7		;#2 TENEX NVT type is 7
	STTYP
	MOVE B,[7B3+10B23+3B33]	;TAB,FF,LC,WAKE ON CR,LINE HALF DUPLEX
	SFMOD
	STPAR
	MOVE B,[BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
	MOVE C,B
	SFCOC			;MAKE SURE NO GRAPHICS ECHOED ON CTRLS
	HRLOI A,(1B4+0B5+1B0+1B1)
	MOVEI B,-1		;REFUSE AND BREAK LINKS
	TLINK			; ..
	  PUSHJ P,BOMB
	MOVE A,GJINF4		;TERMINAL NUMBER
	TRO A,400000		;DESIGNATOR
	HRLI A,(1B0)		;CLEAR ADVICE
	SKIPN TOPS20		;#2 TOPS20 ADVIZ is in TLINK
	JSYS 315		;#2 ADVIZ (TENEX way)
	 ERJMP .+1		;#2 convenient no-op
	SETZM $TYPE		;INITIALIZE ALL PARAMS TO DEFAULT
	SETZM $MODE		;FOR FILE CONNECTION AND SO ON
	MOVEI A,10		;DEFAULT BYTE SIZE
	MOVEM A,$BYTE		; ..
	SETZM $STRU		; ..
	SETOM $PATH1		;JFN'S SET TO -1
	SETOM $PATH2		; ..
	SETOM $SOCK
	SETOM $HOST
	SETOM DATJFN		;NO DATA CONNECTION OPEN YET
	SETZM USRFCT		;NO BAD USER NAMES YET
	SETZM PASFCT		;NO PASSWORD FAILURES YET.
	SETZM USERNM		;USER NUMBER HAS NOT BEEN DECLARED YET
	SETZM $CWD		;NO CWD ARGUMENT YET
	SETOM $ACCES+2		;ALWAYS CONNETING THIS JOB
	SETZM PRVKWD		;NO PREVIOUS KEYWORD YET,
	SETZM KEYWRD		; AND NO CURRENT ONE EITHER.
	SETOM LGOCNT		;INIT LOGOUT FORCER COUNTER
	SETOM LCLJFN		;CLEAR JFN'S USED LATER
	SETOM DATJFN		; ..
	SETOM LOGJFN		; ..
	SETZM MYPID		;I HAVE NO PID YET

	MOVX A,RC%EMO		;EXACT MATCH ONLY
	HRROI B,[ASCIZ /ANONYMOUS/]
	PUSHJ P,.RCUSR		;#2 See if ANONYMOUS is a user on this system
	MOVEM C,ANODNO		;#2 Save possible user number (zero if none)


	MOVE A,['JOBRT ']	;#2 Get size and table number for
	SYSGT			;#2  "job runtime"
	SKIPN B			;#2 
	 PUSHJ P,BOMB		;#2  (fail cause we need size info)
	MOVEM B,JOBRT		;#2 
	MOVE A,['JOBDIR']	;#2 
	SYSGT			;#2  "job directory"
	SKIPN B			;#2 
	 MOVEI B,377777		;#2  (illegal info, caught later)
	MOVEM B,JOBDIR		;#2 
	MOVE A,['JOBTTY']	;#2 
	SYSGT			;#2  "job controlling terminal"
	SKIPN B			;#2 
	 MOVEI B,377777		;#2  (illegal info, caught later)
	MOVEM B,JOBTTY		;#2 
;	..
;	..
	MOVEI A,.GTHNS		;#1 Get local host name and number..
	HRROI B,LHSTNM		;#1 
	SETO C,			;#1 
	GTHST			;#1 
	 PUSHJ P,BOMB		;#1 (shouldn't fail if we're on the net!)
	MOVEM C,LHOSTN		;#1 save number

WHTNVT:	MOVEI A,.GTNNI		;#1 Get info about our NVT terminal..
	MOVE B,GJINF4		;#1  (the input side)
	MOVEI C,NCPBLK		;#1 
	MOVSI D,-20		;#1  enuf room for things we need
	GTNCP			;#1 
	 JRST [	MOVE A,LHOSTN		;#1 must not be an NVT??
		MOVEM A,FHSTN		;#1 assume local host,
		SETOM FORNS		;#1  and hope we don't need
		SETOM NETLSK		;#1  socket numbers!
		JRST .+1]		;#1 

PSIINI:	MOVSI A,^D3		;ASSIGN ^C INTERRUPT
	SKIPE DBUGSW		;OR ^E IF DEBUGGING
	MOVSI A,^D5
	HRRI A,CTCCHN		;TO THIS CHANNEL
	ATI
	MOVSI A,^D30		;NVT DETACHING PSI CODE
	HRRI A,DETCHN		;TO THIS CHANNEL
	ATI
	MOVEI A,400000		;SET UP PSI SYSTEM
	MOVE B,[LEVTAB,,CHNTAB]	; ..
	SIR
	MOVE B,ONCHNS		;TURN ON THESE CHANNELS
	AIC
	MOVEI A,400000		;NOW TURN THE SYSTEM ON
	EIR

MAKTFK:	MOVSI A,(1B0!1B1)	;CREATE A FORK FOR TIMING
	CFORK			; ..
	  JRST FULL		;IF TOO FULL, QUIT.
	HRRZM A,TFORKX		;SAVE THE FORK INDEX
	RPCAP			;MAKE SURE IT CAN POKE ME
	TLO B,(1B9)		; ..
	TLO C,(1B9)		; ..
	EPCAP
	MOVEI B,TFRKSA		;WHERE IT STARTS
	SFORK			;START IT. IT WILL GIVE ME TIME CHECKS
;	..
;	..
GETPID:
   IFN IPCLOG,<
	SKIPN TOPS20		;#2 TENEX doesn't support IPCF
	 JRST SIGON		;#2 
	MOVX A,IP%CPD		;GET A PID FOR SELF
	MOVEM A,PIDARG
GPIDL:	SETZM PIDARG+1		;NO PID OF SENDER YET
GPID2:	SETZM PIDARG+2		;RECEIVER IS 0, IE INFO
	MOVE A,[ENDMSG-INFMSG,,INFMSG]
	MOVEM A,PIDARG+3	;THE DATA OF THE MESSAGE TO INFO
	MOVEI A,4		;COUNT
	MOVEI B,PIDARG		;DESCRIPTOR
	MSEND			;GET PID OF FTSCTL
	 JRST [MOVEI A,^D1000
		DISMS
		JRST GPIDL]
	MOVX B,IP%CPD		;DON'T CREATE ANOTHER
	ANDCAM B,PIDARG
	MOVE A,PIDARG+1		;STASH MY NEW PID
	MOVEM A,MYPID
GETAGN:	SETZM PIDARG		;NO FLAGS
	SETZM PIDARG+1		;NO PARTICULAR SENDER
	MOVE A,MYPID		;I AM RECEIVER
	MOVEM A,PIDARG+2
	MOVE A,[10,,IPCDAT]	;RECEIVE THIS MUCH DATA
	MOVEM A,PIDARG+3
	MOVEI A,4		;LENGTH OF DESCRIPTOR
	MOVEI B,PIDARG		;ADDR OF DESCRIPTOR
	MRECV
	 JFCL
	MOVE A,PIDARG		;GET FLAGS
	ANDI A,7B32
	CAIE A,1B32		;SENT BY MONITOR?
	CAIN A,2B32		;SENT BY INFO?
	SKIPA			;YES.
	JRST GETAGN		;NO, NOT INTERESTED.
	MOVE A,PIDARG
	TRNE A,7		;WAS THE PACKET UNDELIVERABLE?
	JRST GPID2		;YES.
	TRNE A,77B29		;TROUBLE?
	JRST GETAGN		;YES.
	MOVE A,IPCDAT+1		;GET FTSCTL'S PID
	MOVEM A,CTLPID		;SAVE IT.
   >
;	..
;	..
SIGNON:	MOVE A,[POINT 7,REPLYM]	;#8 
	HRROI B,[ASCIZ /300 /]	;#8 REQUIRED HELLO MESSAGE
	PUSHJ P,.SOUT		;#8 
	HRROI B,LHSTNM		;#8 SITE NAME
	PUSHJ P,.SOUT		;#8 
	HRROI B,[ASCIZ / FTP Service /] ;#8 
	PUSHJ P,.SOUT		;#8 
	LDB B,[POINT 9,VERSIO,11] ;GET MAJOR VERSION
	MOVEI C,10		;OCTAL NUMBERS
	SKIPE B			;PRINT IF NON-ZERO
	NOUT
	  JFCL
	LDB B,[POINT 6,VERSIO,17] ;GET MINOR VERSION
	JUMPE B,VERSI1		;SKIP IF 0
	SUBI B,1
	IDIVI B,^D26		;MAKE 2 LETTERS
	JUMPE B,VERSI0		;ANY FIRST LETTER?
	HRRZI B,"A"-1(B)	;YES, PRINT
	IDPB B,A		;#8 
VERSI0:	HRRZI B,"A"(C)		;PRINT SECOND LETTER
	IDPB B,A		;#8 
VERSI1:	HRRZ B,VERSIO		;GET EDIT NUMBER
	MOVEI C,10		;OCTAL NUMBERS
	JUMPE B,VERSI2		;SKIP IF EDIT IS 0
	MOVEI B,"("		;PRINT OPEN PAREN
	IDPB B,A		;#8 
	HRRZ B,VERSIO		;GET EDIT NUMBER AGAIN
	NOUT			;PRINT IT
	  JFCL
	MOVEI B,")"		;PRINT CLOSE PAREN
	IDPB B,A		;#8 
VERSI2:	LDB B,[POINT 3,VERSIO,2] ;GET GROUP CODE
	JUMPE B,VERSI3		;SKIP IF ZERO
	MOVEI C,"-"		;#8 print -
	IDPB C,A		;#8 
	ADDI B,"0"		;#8 print group code
	IDPB B,A		;#8 
VERSI3:   repeat 0,<			;need directive to get this
	HRROI B,[ASCIZ / %/]
	MOVEI C,0
	SOUT
	MOVEI B,SRCVNO
	MOVEI C,12
	NOUT
	  JFCL
   >
	HRROI B,[ASCIZ / at /]	;#8 
	PUSHJ P,.SOUT		;#8 
	SETO B,0		;CURRENT TIME STAMP
	MOVSI C,200221		;FORMAT OF TIME
	ODTIM
	MOVEM A,REPLYP		;#8 End of greeting (reply)
	JRST CRLFRP		;#8 Show greeting, get first command
NOLINE:	GJINF			;SEE IF I GOT DETACHED
	JUMPL D,HANGUP		;IF SO, HANG UP AND LOG OUT
	HRROI B,MSG500		;NO, MUST BE SUPER LONG LINE
	JRST RPCRLP		;GIVE FAILURE MSG AND READ AGAIN
MSG500:	ASCIZ /500 Last line was not comprehensible./

SYNERR:	JSP B,RPCRLP		;SYNTACTICAL ERROR IN COMMAND
	ASCIZ /501 Syntax error at start of last command line./
SYNER2:	JSP B,RPCRLP
	ASCIZ /501 Syntax error - Character after command verb is bad./
ARGSYN:	PUSHJ P,ADDREP		;HERE TO COMPLAIN OF ARGUMENT SYNTAX
	ASCIZ /502 Syntax error in argument of /
	MOVE C,KEYWRD		;NAME OF COMMAND
ARGSYL:	MOVEI B,0		;PRINT COMMAND
	LSHC B,6		;GET A SIXBIT CHARACTER
	ADDI B,40		;CONVERT TO ASCII FROM SIXBIT
	IDPB B,A		;PUT IN REPLY BUFFER
	JUMPN C,ARGSYL		;OUTPUT WHOLE WORD
	MOVEM A,REPLYP		;CURRENT POINTER FOR REPLY
	JSP B,RPCRLP		;CLOSE OFF MSG
	ASCIZ / command./

FULL:	HRROI B,[ASCIZ /401 Service full, please try later. Goodbye./]
	JRST ERRRPL		;CAUSE HANGUP AFTER SENDING THIS

ABORPC:	MOVE P,PDP		;RESTORE STACK LEVEL
	HRROI X,[ASCIZ /? Unknown error interrupt
/]				;#14 
	SKIPE CTCFLG		;WAS IT A ^C?
	HRROI X,[ASCIZ /Interrupt by user
/]				;#14 
	SKIPE IOXFLG		;I/O ERROR?
	HRROI X,[ASCIZ +System I/O Error
+]				;#14 
	HRROI A,[ASCIZ /456 /]
	PSOUT

RETXX:				;#14 
STOXX:	SETO A,			;#14 UNMAP THE WINDOW PAGES
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
	ADDI B,1
	PMAP
	HRRI B,<WINDW2/1000>
	PMAP
	ADDI B,1
	PMAP
	CLOSE DATJFN
	CLOSE LCLJFN
	HRROI B,0(X)
	JRST RPCRLP		;REPLY

BOMB:	MOVE A,REPLYP
	HRROI B,[ASCIZ /435 Fatal system error at /]
	PUSHJ P,.SOUT		;#8 
	HRRZ B,0(P)
	MOVEI C,10
	NOUT
	  JFCL
	MOVEM A,REPLYP
	JSP B,ERRRPL
	ASCIZ /. Please report it. Logging out./
;HERE TO GET A COMMAND LINE. FIRST SEE IF SYSTEM STILL UP

GETCOM:	MOVE A,[440700,,REPLYM]	;INITIALIZE POINTER TO REPLY
	MOVEM A,REPLYP		;FOR OTHER ROUTINES TO APPEND TO
	MOVE P,PDP		;RESTORE STACK LEVEL, JUST IN CASE.
	PUSHJ P,TIMEOK		;MARK THAT TIMEOUT HASN'T HAPPENED
	TLNE F,L.CMDK		;ASKED TO KILL JOB BEFORE CMD READING?
	JRST HANGUP		;YES, DO SO.
	MOVE A,['ENTFLG']	;SEE IF SYSTEM STILL OPEN
	SYSGT
	JUMPE B,GETCM1		;IF NO SUCH TABLE,
	JUMPN A,GETCM1		;OR ENTFLG IS NON-ZERO, GO TO IT
SHUTDN:	HRROI B,[ASCIZ /436 Service shutting down; goodbye./]
	JRST ERRRPL		;HANG UP ON HIM
GETCM1:	PUSHJ P,LINEIN		;COLLECT A COMMAND LINE FROM TTY
	  JRST NOLINE		;EOF OR SUPER-LONG LINE
	MOVE A,['ENTFLG']	;FLAG WENT OF DURING TYPEIN WAIT, MAYBE
	SYSGT
	JUMPE B,GETCM2		;CONTINUE IF NO FLAG AVAIL
	JUMPN A,GETCM2		;OR FLAG STILL OK
	JRST SHUTDN		;NO GOOD. HANG UP.
GETCM2:	SKIPN CMDIB		;BLANK LINE?
	JRST BLANK		;YES.
	MOVE BP,[440700,,CMDIB]	;INITIALIZE SAVED BYTE POINTER
GETCM3:	MOVEM BP,SBP		; ..
	ILDB C,BP		;SKIP LEADING SPACES AND TABS
	CAIE C,40		;SST ROUTINE FAILS AT START OF LINE
	CAIN C,11		;SO DO IT THIS WAY
	JRST GETCM3		;THAT WAS A SPACE. SKIP IT.
	CAIN C,";"		;LET'S ALLOW COMMENTS
	JRST CMNTOK		; ..
	PUSHJ P,SIN6BT		;COLLECT A SIXBIT WORD
	  JRST SYNERR		;DIDN'T START WITH A GOOD CHARACTER
	LDB C,SBP		;GET THE BREAK CHARACTER
	PUSHJ P,SST		;AND THEN STEP PAST ANY SPACES OR TABS
	JUMPE A,SYNERR		;BAD IF FIRST CHAR ON LINE NOT ALPHANUM.
	CAIE C,40		;SPACING CHARACTER AFTER VERB?
	CAIN C,11		; ..
	JRST PARS02		;YES
	JUMPN C,SYNER2		;JUMP UNLESS END OF LINE
;FALL THRU
;FALLS THRU FROM ABOVE
PARS02:	SKIPE C,KEYWRD		;ANY PREVIOUS KEYWORD?
	MOVEM C,PRVKWD		;YES, SAVE IT.
	MOVEM A,KEYWRD		;SAVE THE SIXBIT KEYWORD
	MOVSI C,-NKEYS		;SEE IF WE CAN FIND THE KEYWORD
	CAMN A,KEYS6B(C)	;THIS ONE?
	JRST KEYFND		;YES
	AOBJN C,.-2		;NO, LOOK THRU LIST
NOTKEY:	MOVE A,REPLYP		;NOT THERE. COMPLAIN
	HRROI B,[ASCIZ /500 I never heard of the /]
	PUSHJ P,.SOUT		;#8 
	MOVE C,KEYWRD
NOTKY1:	MOVEI B,0
	LSHC B,6		;CONVERT NAME FROM SIXBIT
	ADDI B,40		; ..
	IDPB B,A		;STORE IN REPLY
	JUMPN C,NOTKY1		;LOOP FOR ALL CHARACTERS
	MOVEM A,REPLYP		;STORE POINTER SO FAR
	HRROI B,[ASCIZ / command. Try HELP./]
	JRST RPCRLP		;FINISH THE LINE

KEYFND:	HRRZ B,KEYADR(C)	;DISPATCH TO ROUTINE
	SKIPGE KEYADR(C)	;NEED TO BE LOGGED IN?
	TLNE F,L.LOGI		;YES. AM I?
	SKIPA			;LOGGED IN, OR DON'T NEED TO BE
	JRST LGNPLS		;NO GOOD. COMPLAIN.
	PUSHJ P,0(B)		;CALL IT
	  JRST RPCRLP
	JRST RPCRLP

ERRRPL:	TLO F,L.CMDK		;FLAG THIS WAS A FATAL ERROR
RPCRLP:	MOVE A,REPLYP		;APPEND MSG IN B TO REPLY
	HRLI B,440700		;STRING POINTER (ALLOWS JSP B,RPCRLP)
	PUSHJ P,.SOUT		;#8 
	HRROI B,CRLFM		;APPEND CRLF
	PUSHJ P,.SOUT		;#8 
	HRROI A,REPLYM		;NOW SEND IT DOWN TELNET LINE
	PSOUT
	JRST GETCOM		;AND GET ANOTHER COMMAND

ADDREP:	MOVE A,REPLYP		;ADD TEXT AFTER PUSHJ TO REPLY BUFFER
	HRRO B,0(P)		;STRING PTR TO TEXT
	PUSHJ P,.SOUT		;#8 
	MOVEM A,REPLYP		;UPDATE REPLY POINTER
	HRRM B,0(P)		;POINTER TO WORD WITH NULL
	AOS 0(P)		;ONE MORE IS WHERE TO RETURN TO
	POPJ P,0		;RETURN THERE.

CRLFRP:	JSP B,RPCRLP		;JUST EOL, NO MORE TEXT
	0			;NO TEXT.
;.SOUT - copy ASCIZ string in core
; 1/ destination byte pointer
; 2/ source byte pointer (also -1,,string.loc)
;	PUSHJ P,.SOUT
;Ret +1; always,
; 1,2/ updated byte pointers
; 3/ zero

.SOUT:	TLC B,-1		;#8 Insure (compose) byte pointer
	TLCN B,-1		;#8  to source string
	HRLI B,440700		;#8 
	ILDB C,B		;#8 Get character,
	IDPB C,A		;#8 put character,
	JUMPN C,.-2		;#8  until nul found.
	ADD A,[7B5]		;#8 Backup dest ptr (to overwrite nul)
	POPJ P,			;#8 


;.SOUTC - copy ASCIZ (or maximum char count) string in core
; 1/ destination byte pointer
; 2/ source byte pointer
; 4/ positive char limit
;	PUSHJ P,.SOUT
;Ret +1; always,
; 1,2/ updated byte pointers
; 3/ zero

.SOUTC:	TLC B,-1		;#8 Insure (compose) byte pointer
	TLCN B,-1		;#8  to source string
	HRLI B,440700		;#8 
SOUTC1:	SOSGE C,D		;#8 Stop at limit
	TDZA C,C		;#8 
	ILDB C,B		;#8 Get character,
	IDPB C,A		;#8 put character,
	JUMPN C,SOUTC1		;#8  until nul found.
	ADD A,[7B5]		;#8 Backup dest ptr (to overwrite nul)
	POPJ P,			;#8 


;.CVHST - translate host number into name

.CVHST:	MOVEI C,10		;#2 
	CVHST			;#2 Translate number into name
	 NOUT			;#2  error, show (octal) number instead
	  JFCL			;#2 
	POPJ P,			;#2 
;.RCDIR - lookup directory name (add/remove necessary punctuation)
;.RCUSR - lookup user name (a PS: directory which is not files-only)
; Ret +1; always,
;  A/ flags (error if RC%AMB or RC%NOM)
;  C/ directory number (zero if error)

.RCUSR:	SKIPN TOPS20		;#2 Translate user name string..
	 JRST [	PUSHJ P,STDIR5		;#2 TENEX way..
		JUMPL A,RCERR		;#2 Must not be files-only!
		POPJ P,]		;#2 
	RCUSR			;#2 TOPS20 has this JSYS
	 ERJMP RCERR		;#2  error
	POPJ P,			;#2 


.RCDIR:	PUSH P,A		;#2 Translate directory name string..
	TLC B,-1		;#2 Make sure "pointer" to string
	TLCN B,-1		;#2  is a legitimate byte pointer
	HRLI B,440700		;#2 
	MOVE A,B		;#2 Scan string for TOPS20 format "str:<dir>"..
	ILDB C,A		;#2 look until
	CAIE C,"<"		;#2  directory punctuation
	JUMPN C,.-2		;#2  or end of string seen
	SKIPN TOPS20		;#2 
	 JRST STDIR1		;#2 
	JUMPN C,RCDIR4		;#2 Required format?
	MOVE A,[440700,,XSTDIR]	;#2 No, just directory name,
	MOVEI C,"<"		;#2  so add punctuation..
	IDPB C,A		;#2 
	ILDB C,B		;#2 
	JUMPN C,.-2		;#2 
	MOVEI B,">"		;#2 
	IDPB B,A		;#2 
	IDPB C,A		;#2 
	MOVE B,[440700,,XSTDIR]	;#2 Ptr to proper format str
RCDIR4:	POP P,A			;#2 Recover initial flags
	RCDIR			;#2 
	 ERJMP RCERR		;#2 
	POPJ P,			;#2 

RCERR:	TXO A,RC%NOM		;#2 Error of some sort,
	SETZ C,			;#2  just call it "no match"
	POPJ P,			;#2  and return zero number


STDIR1:	JUMPE C,STDIR4		;#2 Not TOPS20 format, easy handle
	SKIPA B,[440700,,XSTDIR] ;#2 Strip away punctuation into here..
	IDPB C,B		;#2 
	ILDB C,A		;#2 copy until
	CAIE C,">"		;#2  directory punctuation
	JUMPN C,.-3		;#2  (or end of string?)
	SETZ C,			;#2 make str ASCIZ
	IDPB C,B		;#2 
	MOVE B,[440700,,XSTDIR]	;#2 String from here
STDIR4:	POP P,A			;#2 Recover initial flags
STDIR5:	TXNE A,RC%EMO		;#2 Exact match requested?
	TDZA A,A		;#2  yes, no recognition
	MOVSI A,(1B0)		;#2  no, allow recognition
	JSYS 40			;#2 STDIR
	 TXOA A,RC%NOM		;#2  +1; no match
	 TXO A,RC%AMB		;#2  +2; ambiguous
	MOVEI C,(A)		;#2 TENEX directory number (18-bits)
	POPJ P,			;#2 
;.ACCES - connection to directory

.ACCES:	SKIPN TOPS20		;#2 Separate TOPS20/TENEX
	 JRST ACCES4		;#2 
	MOVE A,[AC%CON+3]	;#2 flags,,count
	MOVEI B,$ACCES		;#2 argument block
	ACCES			;#2 (TOPS20 way)
	 ERJMP .GETER		;#2 Ret +1; error
	JRST CPOPJ1		;#2 Ret +2; okay

ACCES4:	HRRZ A,$ACCES		;#2 flags,,dir#
	MOVE B,$ACCES+1		;#2 pointer to pswd
	JSYS 44			;#2 CNDIR (TENEX way)
	 JRST CPOPJ		;#2 Ret +1; error
	JRST CPOPJ1		;#2 Ret +2; okay


;.GTJFN - special GTJFN, strip off structure if TENEX

.GTJFN:	SKIPE TOPS20		;#2 Separate TOPS20/TENEX
	 JRST GTJFN8		;#2 
	TLC B,-1		;#2 Make sure "pointer" to string
	TLCN B,-1		;#2  is a legitimate byte pointer
	HRLI B,440700		;#2 
	PUSH P,B		;#2 Save ptr for later
	PUSH P,C		;#2 
	ILDB C,B		;#2 Look over string
	CAIE C,":"		;#2  until structure (device) punctuation
	JUMPN C,.-2		;#2  or end of string
	SKIPN C			;#2 If structure not found
	MOVE B,-1(P)		;#2  use entire string
	POP P,C			;#2 
	POP P,0(P)		;#2 
GTJFN8:	GTJFN			;#2 
	 JRST CPOPJ		;#2 Ret +1; error
	JRST CPOPJ1		;#2 Ret +2; okay


;.VACCT - verify account for given user

.VACCT:	SKIPN TOPS20		;#2 Separate TOPS20/TENEX
	 JRST VACCT4		;#2 
	JSYS 566		;#2 VACCT (TOPS20 way)
	 ERJMP CPOPJ		;#2 Ret +1; error
	JRST CPOPJ1		;#2 Ret +2; okay

VACCT4:	JSYS 330		;#2 VACCT (TENEX way)
	 JRST CPOPJ		;#2 Ret +1; error
	JRST CPOPJ1		;#2 Ret +2; okay


.GETER:	PUSH P,B		;#2 For now, just TOPS20
	MOVEI A,.FHSLF		;#2 
	GETER			;#2 
	MOVEI A,(B)		;#2 
	POP P,B			;#2 
	POPJ P,			;#2 
;COMMAND MACROS
C.LGN==1B18	;NEED TO LOG IN TO USE THIS COMMAND

DEFINE KEYMAC <		;KEYWORDS
M1 (USER,0)
M1 (PASS,0)
M1 (ACCT,0)
M1 (HELP,0)
M1 (MAIL,0)
M1 (MLFL,0)
M1 (XRCP,0)			;#7 
M1 (XRSQ,0)			;#7 
M1 (XSEN,0)			;#6 
M1 (XSEM,0)			;#6 
M1 (BYE,0)
M1 (ABOR,0)
M1 (NOOP,0)
M1 (NOP,0)
M1 (DEBUG,C.LGN)
M1 (CRASH,0)
M1 (BOMB,0)
M1 (BYTE,0)
M1 (SOCK,C.LGN)
M1 (TYPE,0)
M1 (STRU,0)
M1 (MODE,0)
M1 (RETR,C.LGN)
M1 (STOR,C.LGN)
M1 (APPE,C.LGN)
M1 (RNFR,C.LGN)
M1 (RNTO,C.LGN)
M1 (DELE,C.LGN)
M1 (LIST,C.LGN)
M1 (NLST,C.LGN)
M1 (ALLO,C.LGN)
M1 (REST,C.LGN)
M1 (STAT,C.LGN)
M1 (CWD,C.LGN)
M1 (XCWD,C.LGN)
>

DEFINE M1(A,B)<	SIXBIT +A+>

KEYS6B:	KEYMAC
NKEYS==.-KEYS6B	;LENGTH OF TABLE

DEFINE M1(A,B)<	XWD B,Z'A>

;THE DISPATCH TABLE
KEYADR:	KEYMAC
;COMMAND EXECUTION ROUTINES

ZUSER:	GJINF			;SEE IF LOGGED IN ALREADY
	JUMPN A,USER07		;IF SO, COMPLAIN
	TLZ F,L.ANON		;MAKE SURE NOT ANONYMOUS
	SETZM $ACCT		;CLEAR ANY ACCOUNT JUNK
	PUSHJ P,SST		;SKIP LEADING SPACES
	MOVE A,[440700,,$USER]	;USER NAME STRING STORAGE
	MOVEI C,^D39		;MAXIMUM LENGTH
USER01:	ILDB B,SBP		;GET A CHARACTER
	IDPB B,A		;STORE IN STRING
	JUMPE B,USER02		;QUIT ON NULL
	SOJG C,USER01		;LOOP FOR WHOLE NAME
USERNG:	SETZM USERNM		;TOO LONG. NO USER NUMBER.
	AOS A,USRFCT		;COUNT BAD USER NAMES
	CAIL A,5		;ALLOW HIM A FEW, THEN FORCE HIM OUT
	JRST USER03		;TOO MANY
	PUSHJ P,ADDREP		;TELL HIM USER DOESN'T EXIST
	ASCIZ /431 No such user as /
	HRROI B,$USER
	PUSHJ P,.SOUT		;#8 
	MOVEM A,REPLYP
	JSP B,RPCRLP		;RETURN ERROR MSG
	ASCIZ /./
USER03:	JSP B,ERRRPL		;HANG UP WITH FOLLOWING MSG
	ASCIZ /430 Too many login failures. Go away./

USER02:	MOVX A,RC%EMO		;EXACT MATCH ONLY
	MOVE B,[440700,,$USER]	;NAME STRING
	PUSHJ P,.RCUSR		;#2 See if user exists
	TXNE A,<RC%NOM!RC%AMB>	;DOES IT EXIST
	JRST USERNG		;NO SUCH USER
	MOVEM C,USERNM		;OK. STORE THE NUMBER
	CAMN C,ANODNO		;ANONYMOUS?
	JRST USERAN		;YES. GO GET PASSWORD
USER04:	MOVE A,[440700,,$ACCT+1] ; BACK HERE FROM ANONYMOUS
	MOVE B,USERNM		;SEE IF USER HAS A DEFAULT ACCOUNT
	SKIPN TOPS20		;#2 TOPS20 does not yet support this
	JSYS 331		;#2 GDACC (TENEX way)
	  JRST USER06		;NO.
	MOVEM A,$ACCT		;YES. STORE IT FOR LOGIN JSYS
USER06:	HRROI B,[ASCIZ /330 Anonymous user ok, send real ident as password./]
	TLNE F,L.ANON		;ANONYMOUS OR REAL USER?
	JRST RPCRLP		;ANONYMOUS. ASK FOR NAME (SPCL MSG)
	JSP B,RPCRLP		;REAL. ASK FOR PASSWORD
	ASCIZ /330 User name ok. Password, please./
USER07:	JSP B,RPCRLP		;ALREADY LOGGED IN ERROR
	ASCIZ /504 You are already logged in./


USERAN:	TLO F,L.ANON		;ANONYMOUS IS THE USER NAME
	SETZM ANOPSW		;COLLECT ANONYMOUS PASSWORD
	MOVSI A,100001		;FROM SYSTEM FILE
	HRROI B,[ASCIZ /SYSTEM:ANONYMOUS.USERFILE/] ;#2 
	SKIPN TOPS20		;#2 
	HRROI B,[ASCIZ /<SYSTEM>ANONYMOUS.USERFILE/] ;#2 
	GTJFN
	  JRST USERAN1		;FILE NOT THERE
	MOVEM A,LOGJFN		;STASH JFN HERE
	MOVE B,[070000,,200000]	;READ ASCII FROM FIRST LINE
	OPENF			;OPEN FILE
	  JRST USRAN2		;CAN'T?
	MOVE D,[440700,,ANOPSW]	;STORE TEXT HERE
	MOVEI C,^D39		;MAX LENGTH IN CASE FILE BAD
USRAN4:	BIN			;GET A CHARACTER OF PASSWORD
	CAIGE B,40		;STILL GOOD?
	JRST USRAN3		;END
	IDPB B,D		;STORE IN STRING
	SOJG C,USRAN4		;COUNT AND LOOP
USRAN3:	MOVEI B,0		;TERMINATE WITH NULL
	IDPB B,D
USRAN2:	CLOSE LOGJFN		;FINISHED WITH FILE
USRAN1:	JRST USER04		;GO BACK AND CHECK DEFAULT ACCT
ZPASS:	SETZM $PASS		;MAKE SURE NO JUNK LEFT AROUND
	SKIPN USERNM		;HAS A USER BEEN SEEN?
	JRST PASS06		;NO.
	PUSHJ P,SST		;SKIP LEADING (UNQUOTED) SPACES
	MOVE A,[440700,,$PASS]	;PASSWORD STRING STORAGE
	MOVEI C,^D39		;MAXIMUM LENGTH
PASS01:	ILDB B,SBP		;GET A CHARACTER
	CAIN B,"V"&37		;QUOTE CHARACTER?
	JRST PASS02		;YES.
	CAIL B,"A"+40		;NOT QUOTED, MAKE LC BE UC
	CAILE B,"Z"+40		; ..
	SKIPA			;NOT LOWER CASE
	TRZ B,40		;MAKE LOWER BE UPPER
PASS03:	IDPB B,A		;STORE THE CHARACTER
	JUMPE B,PASS04		;JUMP AT END.
	SOJG C,PASS01		;SPACE COUNTER
PASSNG:	SETZM $PASS		;CLEAR. FLAGS THAT NO GOOD PSWD YET.
	AOS A,PASFCT		;COUNT BAD PASSWORDS
	CAIL A,5		;ALLOW A FEW, THEN FORCE OFF
	JRST PASS05		;TOO MANY.
	JSP B,RPCRLP		;BAD, BUT NOT TOO MANY TIMES YET
	ASCIZ /431 Password incorrect./
PASS05:	JSP B,ERRRPL		;HANG UP ON HIM
	ASCIZ /430 Password wrong again. Go away./
PASS02:	ILDB B,SBP		;QUOTED CHARACTER. COPY IT.
	JRST PASS03		;WITHOUT CRUNCHING LOWER CASE TO UPPER
PASS04:	TLNE F,L.LOGI		;AM I ALREADY LOGGED IN?
	JRST PASCWD		;YES. IF CWD, DO ACCES.
	SKIPN $PASS		;IF TRYING ANONYMOUS, PHONY PASSWORD
				; STILL MUST BE NON-NULL.
	 JRST PASSNG		;FAIL. COUNT IT, REPLY, MAYBE HANGUP.
	JRST PASS10		;GO DO THE LOGIN.
PASSAC:	JSP B,RPCRLP		;NO. ASK FOR THE ACCOUNT.
	ASCIZ /331 Password OK, Account please./
PASS06:	JSP B,RPCRLP		;PASS W/O USER
	ASCIZ /431 User name before password, please./
;HERE WHEN READY TO TRY LOGGING IN
;BACK HERE FROM ACCT COMMAND, TOO, IF NOT YET LOGGED IN.

PASS10:	SKIPN TOPS20		;#2 
	 JRST PASS11		;#2 
	MOVEI A,.SFNVT		;ARE LOGINS ON NVT'S ALLOWED?
	TMON			; ..
	JUMPE B,NVTNLI		;IF NOT, DON'T ALLOW FTP SERVICE EITHER
PASS11:	MOVE A,USERNM		;#2 USER NUMBER
   repeat 0,<			;not yet supported by tops20
	HRLI A,(1B16)		;BIT TO SUPPRESS LOGIN DATE UPDATE
   >
	MOVE B,[440700,,$PASS]	;PASSWORD
	MOVE C,$ACCT		;AND ACCOUNT
	TLNE F,L.ANON		;ANONYMOUS?
	HRRI B,ANOPSW		;YES. HERE'S ITS PASSWORD.
	LOGIN
	  JRST LGNFAL		;FAILED? STRANGE. GO REPORT IT.
	TLO F,L.LOGI		;FLAG THAT I AM LOGGED IN.
	PUSHJ P,CLRPSW		;CLEAR SECRET INFO
	GJINF			;UPDATE JOB INFO
	MOVEM A,GJINF1
	MOVEM B,GJINF2
	MOVEM C,GJINF3
	MOVEM D,GJINF4		; ..
	MOVE A,REPLYP		;COMPOSE A PRETTY LOGIN MESSAGE
	HRROI B,[ASCIZ /230 User /]
	PUSHJ P,.SOUT		;#8 
	MOVE B,USERNM		;NAME STRING
	DIRST
	 JFCL			;#2  can't fail
	HRROI B,[ASCIZ / logged in at /]
	PUSHJ P,.SOUT		;#8 
	SETO B,0
	MOVSI C,200221		;FORMAT OF DATE/TIME
	ODTIM
	HRROI B,[ASCIZ /, job /]
	PUSHJ P,.SOUT		;#8 
	HRRZ B,GJINF3		;JOB NUMBER
	MOVEI C,12
	NOUT
	  0
	MOVEM A,REPLYP		;MESSAGE POINTER SO FAR.
	HRROI B,CRLFM		;END OF LINE
	PUSHJ P,.SOUT		;#8 
	HRROI A,REPLYM		;TYPE THE HERALD
	PSOUT			; ..
	MOVE A,[POINT 7,IPCDAT]	;#8 AND TELL CONTROLLER
	HRROI B,[ASCIZ /FTP SERVER: /]
	PUSHJ P,.SOUT		;#8 
	MOVE B,[100700,,REPLYM]	;AFTER THE 230
	PUSHJ P,.SOUT		;#8 
	PUSHJ P,SNDCTL
	JRST DOLOGIN		;GO GET THE FILE HANDLING PART OF CODE
LGNFAL:	SKIPE $ACCT		;SEE IF DEFAULTING
	 JRST LGNFL1
	CAIN A,LGINX1		;DEFAULTING FAILED?
	 JRST PASSAC
	CAIN A,VACCX0
	 JRST PASSAC
	CAIN A,VACCX1
	 JRST PASSAC
	CAIN A,VACCX2
	 JRST PASSAC
LGNFL1:	PUSHJ P,CLRPSW		;CLEAR SECRET INFO
	PUSH P,A
	PUSHJ P,ADDREP		;BUILD A REPLY
	ASCIZ /431 Login failed unexpectedly, /
	POP P,B
	HRLI B,400000		;ERROR IN THIS FORK
	ERSTR			;STRING FOR THE ERROR
	  JFCL
	  SKIPA
	MOVEM A,REPLYP		;END OF STRING
	JRST CRLFRP		;CARRIAGE RETURN AND REPLY

NVTNLI:	JSP B,ERRRPL		;DON'T ALLOW THE LOGIN - DUE TO TMON
	ASCIZ /453 Network logins not allowed at this time. Please try later./
.ORG ;HIGH SEGMENT
;HERE ON PASS COMMAND WHEN ALREADY LOGGED IN. SEE IF IT GOES WITH A CWD.

PASCWD:	MOVE A,PRVKWD		;SEE WHAT PREVIOUS COMMAND KEYWORD WAS
	CAME A,['CWD   ']	;EITHER FORM OF CWD?
	CAMN A,['XCWD  ']	; ..
	JRST PASCW1		;YES
	JSP B,RPCRLP		;NO. WHAT'S WITH THIS SILLY PASS?
	ASCIZ /504 You are already logged in. I don't know what this password is for./
PASCW1:	GJINF			;IT FOLLOWS CWD. SEE IF ALREADY
	CAME B,$CWD		;CONNECTED TO THE DESIRED DIRECTORY.
	JRST PASCW2		;NO, GO DO IT.
	JSP B,RPCRLP		;YES, IGNORE PASSWORD.
	ASCIZ /200 Password not needed for this CWD./
PASCW2:	MOVE A,$CWD		;DESIRED DIRECTORY
	MOVEM A,$ACCES		;PUT IN ARGUMENT BLOCK
	MOVE B,[440700,,$PASS]	;PASSWORD
	MOVEM B,$ACCES+1	;PUT IN ARGUMENT BLOCK
	PUSHJ P,.ACCES		;#2 Attempt the requested access
	 JRST CWDER		;#13  failed
CWDOK:	PUSHJ P,ADDREP
	ASCIZ /200 Connected to /
	MOVE B,$CWD		;PLUG NAME INTO MESSAGE
	DIRST
	 MOVE A,REPLYP		;CAN'T FAIL HERE, I HOPE.
	MOVEM A,REPLYP		;UPDATE POINTER
	JSP B,RPCRLP		;OK
	ASCIZ /./

CWDER:	HRROI B,[ASCIZ /330 Default name accepted, send password to connect to it./] ;#13 
	CAIE A,ACESX3		;#13 If the error indicates the need for
	CAIN A,CNDIX1		;#13  or a correct password,
	 JRST RPCRLP		;#13  use this msg.
	PUSH P,A		;#13 Otherwise compose a msg with
	PUSHJ P,ADDREP		;#13  the system error string..
	ASCIZ \431 CWD/PASS failed unexpectedly, \ ;#13 
	POP P,B			;#13 
	HRLI B,.FHSLF		;#13 
	ERSTR			;#13 
	 JFCL			;#13 
	 SKIPA			;#13 
	MOVEM A,REPLYP		;#13 
	JRST CRLFRP		;#13 
.ORG ; BACK TO LOW SEGMENT
;ACCOUNT COMMAND

ZACCT:	SKIPN USERNM		;#2 Insure proper sequence of user/pass/acct
	 JRST ACCT06		;#2  isn't
	PUSHJ P,SST
	MOVE A,SBP		;PICK UP ACCOUNT CHARACTERS HERE
	MOVE B,[440700,,$ACCT+1];STORE STRING HERE
	MOVEI D,^D39		;MAX LENGTH OF STRING
	SETZM $ACCT+1		;CLEAR SO CAN TELL IF NULL ARGUMENT
ACCT01:	ILDB C,A		;GET A CHARACTER OF THE ACCOUNT
	JUMPE C,ACCT02		;END OF ARGUMENT
	CAIL C,"A"+40		;LOWER CASE?
	CAILE A,"Z"+40		; ..
	SKIPA			;NO
	TRO C,40		;YES, MAKE UPPER.
	IDPB C,B		;ADD TO TEXT STRING
	SOJG D,ACCT01		;LOOP IF STILL SPACE.
ACCTNG:	JSP B,RPCRLP		;STRING TOO LONG OR OTHERWISE BAD
	ASCIZ /431 Account not valid./

ACCT02:	SKIPN $ACCT+1		;WAS STRING NON-NULL?
	JRST ACCTNG		;NO. EMPTY STRING IS NG
	MOVE T1,[440700,,$ACCT+1]	;HERE FOR STRING ACCOUNT
	MOVEM T1,$ACCT		;THIS IS THE DESIGNATOR
	MOVE B,T1		;CHECK IT IN MONITOR
	MOVE A,USERNM		;FOR THIS USER NUMBER
	PUSHJ P,.VACCT		;#2 Is it ok?
	 JRST ACCTNG		;#2  no
	TLNN F,L.LOGI		;AM I LOGGED IN ALREADY?
	JRST PASS10		;NO, GO DO LOGIN.
	MOVE A,$ACCT		;YES, CHANGE TO THIS ACCOUNT
	MOVEI B,0		;NO FLAGS
	CACCT			;DO THE CHANGE
	  JRST ACCTNG		;THIS SHOULD NOT FAIL
	JSP B,RPCRLP		;OK, ACCOUNT HAS BEEN CHANGED.
	ASCIZ /200 Account OK./

ACCT06:	JSP B,RPCRLP		;#2 
	ASCIZ /431 User name and password first, please./ ;#2 
;MORE COMMAND EXECUTION ROUTINES

ZTYPE:	MOVEI P1,TYPTAB		;TABLE OF KNOWN TYPES
	HRLI P1,-NTYPES		;NUMBER OF THEM
	PUSHJ P,GETARG		;LOOK FOR ARG IN TABLE
	  JRST ARGSYN		;HAS TO BE ONE
	  JRST ARGUNK		;ARG WAS THERE BUT NOT KNOWN
	HRRZ C,TYPTAB(B)	;DISPATCH FOR THIS ARG TO TYPE
	JRST 0(C)		;GO TO IT
TYPEOK:	MOVEM B,$TYPE		;SAVE THE INDEX INTO TABLE
	PUSHJ P,ADDREP		;START BUILDING OK REPLY
	ASCIZ /200 Type /	; ..
LCMRET:	MOVE C,ARGWRD		;ADD THE ARG VALUE TO MSG
	PUSHJ P,ADD6BC		;ADD SIXBIT IN AC C
	JSP B,RPCRLP		;FINISH MSG AND RETURN
	ASCIZ / ok./

;MACRO FOR DEFINING TABLES FOR ARGS TO TYPE, MODE, STRU COMMANDS
;FIRST TEXT ARG MUST BE THE DEFAULT. ITS VALUE IS 0

DEFINE KM(A,B)<
ZZ==0
IRP B,<
	XWD <SIXBIT /B/>B53,A'$'B
A'.'B==ZZ
ZZ==ZZ+1
>;END IRP
>;END DEFINE


TY$A==<TY$I==<TY$L==<TY$XTP==TYPEOK>>>
TY$E==<TY$P==ARGNIM>
TYPTAB:	KM (TY,<A,E,I,L,P,XTP>)
NTYPES==.-TYPTAB
ARGUNK:	PUSHJ P,ADDREP		;AN ARGUMENT THAT ISN'T EVEN IN TABLE
	ASCIZ /501 I never heard of /
	MOVE C,KEYWRD
	PUSHJ P,ADD6BC		;PUT COMMAND NAME IN
	PUSHJ P,ADDREP
	ASCIZ / with argument /
	JRST ARGUN1

ARGNIM:	PUSHJ P,ADDREP		;AN ARG IN THE TABLE BUT UNIMPLEMENTED
	ASCIZ /506 /
	MOVE C,KEYWRD		;COMMAND NAME
	PUSHJ P,ADD6BC
	PUSHJ P,ADDREP
	ASCIZ / is not implemented for argument /
ARGUN1:	MOVE C,ARGWRD
	PUSHJ P,ADD6BC
	JSP B,RPCRLP
	ASCIZ /./

ADD6BC:	MOVE A,REPLYP		;ADD SIXBIT WORD IN C TO REPLY
ADD6BL:	MOVEI B,0
	LSHC B,6		;SHIFT IN A CHARACTER
	ADDI B,40		;SIXBIT TO ASCII
	IDPB B,A		;INTO MSG
	JUMPN C,ADD6BL		;LOOP IF MORE LETTERS
	MOVEM A,REPLYP		;END OF REPLY SO FAR
	IDPB C,A		;C IS NOW CLEAR. APPEND NULL.
	POPJ P,0		;RETURN FROM ADD6BC

GETARG:	PUSHJ P,SIN6BT		;GET A WORD
	  POPJ P,0		;SYNTAX ERROR
	AOS 0(P)		;OK, SKIP AT LEAST ONE
	MOVEM A,ARGWRD		;SAVE FOR ERROR MSGS, REPLIES
	MOVEI B,0		;INDEX INTO TABLE
GETAR2:	HLLZ C,0(P1)		;GET UP TO 3 CHARACTERS
	CAMN A,C		;SAME AS SUPPLIED ARG?
	JRST GETAR1		;YES.
	ADDI B,1		;NO, NEXT INDEX
	AOBJN P1,GETAR2		;LOOP LOOKING FOR IT
	POPJ P,0		;NOT IN TABLE

GETAR1:	JRST CPOPJ1		;SUCCESS. FOUND THE WORD.
ZMODE:	MOVEI P1,MODTAB		;TABLE OF KNOWN MODES
	HRLI P1,-NMODES		;NUMBER OF THEM
	PUSHJ P,GETARG		;LOOK FOR ARG IN TABLE
	  JRST ARGSYN		;SYNTAX ERROR
	  JRST ARGUNK		;ARGUMENT NOT IN TABLE
	HRRZ C,MODTAB(B)	;DISPATCH FOR THIS ARG
	JRST 0(C)		;GO TO IT
MODEOK:	MOVEM B,$MODE		;SAVE THE INDEX INTO TABLE
	PUSHJ P,ADDREP		;START BUILDING OK REPLY
	ASCIZ /200 Mode /
	JRST LCMRET		;COMMON RETURN FOR GOOD LETTER COMMANDS

MODTAB:	KM (MD,<S,B,T,H>)
NMODES==.-MODTAB

MD$S==MODEOK
MD$B==<MD$T==<MD$H==ARGNIM>>

ZBYTE:	PUSHJ P,SST		;GET BYTE SIZE ARGUMENT
	MOVE BP,SBP
	PUSHJ P,DECIN1		;COLLECT A NUMBER
	  JRST ARGSYN		;NOT A NUMBER
	CAIE A,10		;EIGHT BITS?
	CAIN A,44		;36 BITS?
	JRST BYTEOK		;YES
	CAIE A,40		;32 BITS?
	JRST BYTEX1		;NO
BYTEOK:	LDB B,BP		;GET TERMINATOR
	JUMPN B,BYTEX1		;SHOULD BE EOL
	MOVEM A,$BYTE		;STORE THE VALUE
	JSP B,RPCRLP		;OK
	ASCIZ /200 Byte size accepted./
BYTEX1:	JSP B,RPCRLP
	ASCIZ /506 Byte size must be 8, 32, or 36./

ZSTRU:	MOVEI P1,STRTAB		;ARGS TO STRUCTURE
	HRLI P1,-NSTRUS		;NUMBER OF THEM
	PUSHJ P,GETARG		;LOOK FOR ARG 	N TABLE
	  JRST ARGSYN		;SYNTAX ERROR
	  JRST ARGUNK		;NOT IN TABLE
	HRRZ C,STRTAB(B)	;DISPATCH ADDRESS FOR THIS ARG
	JRST 0(C)		;GO TO IT.
STRUOK:	MOVEM B,$STRU		;STORE THE ARG
	PUSHJ P,ADDREP		;BUILD A SUCCESS REPLY
	ASCIZ /200 Structure /
	JRST LCMRET		;FINISH IT UP

STRTAB:	KM (ST,<F,R>)
NSTRUS==.-STRTAB
ST$F==STRUOK
ST$R==ARGNIM
;MORE COMMAND EXECUTION ROUTINES

LGNPLS:	JSP B,RPCRLP
	ASCIZ /451 Please log in first, with USER, PASS and ACCT./
ZNOP:
ZNOOP:	JSP B,RPCRLP
	ASCIZ /200 No-operation OK./
ZBYE:	JSP B,ERRRPL		;SEND THIS MESSAGE, THEN HANG UP.
	ASCIZ /231 BYE command received. Goodbye./
ZHELP:	JSP B,RPCRLP
	ASCIZ /100 The following commands are allowed before logging in:
100 USER, PASS, ACCT, NOP, NOOP, HELP, MAIL, MLFL, BYE,
100 BYTE (8 only), TYPE (A only), MODE (S only), and STRU (F only).
100 After logging in, the following are also allowed:
100 BYTE (8, 32 and 36 only), SOCK, TYPE (A,I,L,XTP only),
100 RETR, STOR, APPE, RNFR, RNTO, DELE, LIST, NLST,
100 STAT (for directory listing), CWD and XCWD.
200 End of help text./

BLANK:	JSP B,RPCRLP		;BLANK LINE
	ASCIZ /200 Blank line ignored./

CMNTOK:	JSP B,RPCRLP		;LINE STARTED WITH SEMICOLON
	ASCIZ /200 Comment OK./

ZCRASH:	JRST 4,.		;TEST COMMAND FOR FATAL ERRORS
NOTIMP:	PUSHJ P,ADDREP
	ASCIZ /506 The /
	MOVE C,KEYWRD		;PUT VERB INTO MESSAGE
NOTIM1:	MOVEI B,0
	LSHC B,6
	ADDI B,40
	IDPB B,A
	JUMPN C,NOTIM1
	MOVEM A,REPLYP
	HRROI B,[ASCIZ / command is not yet implemented./]
	POPJ P,0

ZBOMB:	PUSHJ P,BOMB		;ANOTHER ONE
.ORG				;SWITCH TO HIGH SEGMENT

ZDEBUG:	MOVEI A,400000		;SEE IF I AM A WHEEL
	RPCAP
	TRNN B,600000		; ..
	JRST NOTIMP		;NO. PRETEND NOT IMPLEMENTED
DEBUG1:	SKIPE 770000		;YES. IS DDT THERE?
	JRST DEBUG0		;YES, GO TO IT.
	MOVSI A,100001		;#9 NO, GET IT
	HRROI B,[ASCIZ /SYS:UDDT.EXE/]
	SKIPN TOPS20		;#2 
	HRROI B,[ASCIZ /<SUBSYS>UDDT.SAV/] ;#2 
	GTJFN
	  JRST NOTIMP
	HRLI A,400000		;INTO THIS FORK
	GET
	MOVE A,116		;JOBSYM
	MOVEM A,@770001		;TO $I-1
DEBUG0:	MOVSI A,400000		;NOW PUT ON COPY/WRITE BIT IN ACCESS
	HRRI A,400		;SO DDT CAN DO BREAKPOINTS
DEBUGL:	RPACS			;SEE IF PAGE THERE
	TLNN B,(1B5)		; ..
	JRST DEBUGN		;NO
	TLNE B,(1B10)		;IF SHARED, PUT ON CW
	SKIPA B,[1B2!1B3!1B4]	;NO, PRIVATE. R,W,E
	MOVSI B,(1B2!1B4!1B9)	;YES, MAKE IT R,E,CW
	SPACS			; ..
DEBUGN:	ADDI A,1		;NEXT PAGE
	HRRI B,(A)
	CAIGE B,700		;CONTINUE UP TO DDT
	JRST DEBUGL		; ..
	PUSHJ P,770000		;CALL DDT
	JSP B,RPCRLP
	ASCIZ /200 End of debug./

ZREST:	JSP B,RPCRLP		;RESTART COMMAND NOT IMPLEMENTED
	ASCIZ /200 Restart command received but ignored./
.ORG				;SWITCH BACK TO LOW SEGMENT
HANGUP:	GJINF			;#10 Get job info
	JUMPL D,NOCLSD		;#10 If detached, simply logout
	movei a,101		;wait for end of output
	dobe			; ..
	DTACH			;GET OFF THE TTY
HANGU1:	JUMPL D,NOclsD		;#10 NOT IF DETACHED
	move a,[point 7,gtjstr]	;#8 this sequence closes the nvt
	hrroi b,[asciz /tty/]
	pushj p,.sout		;#8 build a string for the tty name
	movei b,(d)
	movei c,10		;octal tty number
	nout
	 jfcl
	movei b,":"		;#8 terminating colon
	idpb b,a		;#8 
	setz b,			;#8 
	idpb b,a		;#8 
	movsi a,1		;now get a jfn for the tty
	hrroi b,gtjstr
	gtjfn
	 jrst noclsd		;shouldn't fail
	push p,a		;save the jfn
	movei a,.fhslf		;adjust my capabilities
	rpcap
	push p,c
	push p,b
	trz c,-1
	epcap
	move a,-2(p)		;now open the tty
	move b,[070000,,100000]
	openf
	 jfcl			;shouldn't fail
	pop p,b			;restore capabilities
	pop p,c			; ..
	movei a,.fhslf
	epcap
	pop p,a			;get tty jfn again
	closf			;this will close the net conn
	 jfcl			;shouldn't fail
NOclsD:	SETO A,0		;NOW LOG OUT
	PUSHJ P,LOGOUT		;LOGOUT OR HALTF IF DEBUGGING
	WAIT			;SHOULDN'T GET HERE...
	JRST GO

LOGOUT:	SETO A,0		;LOGOUT ME
	SKIPN DBUGSW
	LGOUT
	  JFCL
	SKIPE DBUGSW
	HALTF
	POPJ P,0

FORCLO:	HRROI A,[ASCIZ /434 Autologout; Time exceeded without login.
/]
	PSOUT
	JRST HANGUP

TFRKSA:	MOVEI A,^D60000
	DISMS
	MOVEI A,-1		;MY SUPERIOR
	MOVEI B,1B<TIMCHN>	;CHANNEL TO POKE HIM ON
	IIC			;DO SO
	JRST TFRKSA		;AND RETURN

SDUMPA:	MOVEI A,101
	MOVEI C,0
	SOUT
	POPJ P,0

CRLFM:	BYTE (7)15,12,0
;HERE TO GET IN THE FILE ACTIVITY PORTION NOW THAT PROGRAM IS 
;SAFELY LOGGED IN. NOTE THAT THIS GREATLY REDUCES SECURITY ERRORS.

DOLOGI:	GJINF			;FIND OUT FROM SYSTEM WHETHER I AM 
	SKIPN A			;  REALLY LOGGED IN.
	PUSHJ P,BOMB		;NOT LOGGED IN! QUIT AND HANG UP.
	PUSHJ P,GETHI		;MAP THE HIGH SEGMENT BACK TO LIFE
	JRST GETCOM		;NOW ON TO NEXT COMMAND.

GETHI:	MOVEI A,400		;FIRST PAGE OF CRITICAL CODE
	PUSH P,A		;CURRENT PAGE NUMBER TO STACK
GETLP:	MOVSI A,400000		;IN THIS FORK,
	HRR A,0(P)		;AT THIS PAGE,
	RPACS			;SEE IF PAGE IS THERE
	TLNN B,(1B5)		; ..
	JRST GETLPN		;NO, SO CAN'T MAKE IT ACCESSIBLE
	MOVSI B,(1B2!1B4)	;SET ACCESS TO READ EXECUTE (NO WRITE)
	SPACS			; ..
GETLPN:	AOS A,0(P)		;LOOK AT NEXT PAGE
	CAIGE A,700		;UNLESS UP TO DDT AREA
	JRST GETLP
	POP P,A			;DISCARD PAGE NUMBER
	POPJ P,0		;END OF GETHI
;MISC SUBRS

CLOSER:	SKIPGE 0(A)		;ANYTHING THERE?
	POPJ P,0		;NO SUCH JFN. RETURN.
	PUSH P,A		;YES. SAVE A COUPLE AC'S
	PUSH P,B
	HRRZ A,0(A)		;GET JFN ITSELF
	GTSTS
	JUMPGE B,[RLJFN		;NOT OPEN. JUST RELEASE IT
		    CLOSF	; ..
		  JRST CLOSR1]
	CLOSF
	  JFCL
CLOSR1:	POP P,B			;RESTORE AC'S
	POP P,A
	SETOM 0(A)		;AND FLAG JFN GONE
	POPJ P,0

CLOSEK:	SKIPGE 0(A)		;CLOSE, KEEPING JFN. FILE THERE?
	POPJ P,0		;NO.
	PUSH P,A		;YES, SAVE ADDR WHERE JFN IS
	MOVE A,(A)		;GET THE JFN
	HRLI A,(1B0)		;FLAG TO KEEP THE JFN
	CLOSF			;CLOSE IT
	  JFCL
	POP P,A			;RESTORE POINTER
	POPJ P,0		;RETURN

ORDERX:	JSP B,RPCRLP
	ASCIZ /504 Mail only accepted if you do NOT log in first./

CLRPSW:	PUSH P,A		;BE TRANSPARENT
	SETZM $PASS		;CLEAR SECRET INFO
	MOVE A,[$PASS,,$PASS+1]	;IN ALL PASSWORD AREAS
	BLT A,$PASS+7
	SETZM ANOPSW
	MOVE A,[ANOPSW,,ANOPSW+1]
	BLT A,ANOPSW+7
	SETZM CMDIB
	MOVE A,[CMDIB,,CMDIB+1]
	BLT A,CMDIB+20
	JRST APOPJ
;THE LINE COLLECTOR. PERFORMS CHARACTER AND WORD AND LINE EDITTING.
;READS A LINE INTO CMDIN BUFFER, TERMINATED BY NULL, CRLF STRIPPED OFF.

LINEIN:	PUSH P,P1
	PUSH P,P2
	PUSH P,P3
LINICU:				;REENTER HERE ON LINE DELETE
	TLZ F,L.LTL!L.LICV	;CLEAR THIS ROUTINE'S FLAGS
	MOVEI P1,<5*LCMDIB>-3	;MAXIMUM LINE LENGTH TO READ
	MOVE P2,LINEIP		;INITIAL BYTE POINTER TO BUFFER
	SETZM CMDIB		;CLEAR THE BUFFER, TO BE NEAT
	MOVE A,[CMDIB,,CMDIB+1]	; ..
	BLT A,CMDIB+LCMDIB-1	; ..
LININL:	PUSHJ P,TELBIN		;BIN FROM NVT
	  JRST P3POPJ		;NON-SKIP IF TTY GETS EOF
	TLZE F,L.LICV		;CONTROL V SEEN?
	JRST LININ2		;YES. STORE CHARACTER EXACTLY
	CAIN B,12		;IS IT A LINEFEED?
	JRST LINEOL		;YES. QUIT.
	CAIE B,0		;NULL OR CARRET?
	CAIN B,15		; ..
	JRST LININL		;YES, IGNORE COMPLETELY
	CAIE B,"H"&37		;EDITTING. BACKSPACE?
	CAIN B,177		;OR RUBOUT?
	JRST LINICH		;YES
	CAIN B,"W"&37		;CONTROL W?
	JRST LINICW		;YES
	CAIN B,"U"&37		;CONTROL U?
	JRST LINICU		;YES.
	CAIN B,"V"&37		;SUPER-QUOTE?
	TLO F,L.LICV		;FLAG CONTROL V SEEN, THEN STORE IT
LININ2:	IDPB B,P2		;STORE THIS CHARACTER
	SOJG P1,LININL		;ACCUMULATE LINE
	TLO F,L.LTL		;LINE TOO LONG
P3POPJ:	POP P,P3		;NON-SKIP RETURN
	POP P,P2
	POP P,P1
	POPJ P,0

LINEOL:	MOVEI B,0		;NORMAL END OF LINE. TERMINATE WITH EOL
	IDPB B,P2		;TERMINATE THE STRING
	AOS -3(P)		;SKIP RETURN
	JRST P3POPJ		; ..

LINEIP:	010700,,CMDIB-1		;INITIAL POINTER TO BUFFER
;EDITTING ROUTINES FOR LINEIN

LINICH:	CAMN P2,LINEIP		;ALREADY AT START OF LINE?
	JRST LININL		;YES, IGNORE THIS ^A
	MOVEI B,0		;CLOBBER THE CURRENT CHARACTER
	DPB B,P2		; ..
	ADD P2,[070000,,0]	;BACK UP THE POINTER
	SKIPGE P2		;IF OFF END OF WORD,
	SUB P2,[430000,,1]	;PREVIOUS WORD.
	AOJA P1,LININL		;UN-COUNT THE DELETED CHARACTER

LINICW:	LDB B,P2		;GET CURRENT CHARACTER
	PUSHJ P,ALNUMQ		;SKIP IF ALPHANUMERIC
	 JRST LINCW1		;NO, A BREAK CHAR.
LINCW2:	MOVEI B,0		;THIS IS ALPHANUMERIC. CLOBBER IT.
	DPB B,P2		; ..
	ADDI P1,1		;UN-COUNT IT.
	ADD P2,[070000,,0]	;BACK UP POINTER
	SKIPGE P2
	SUB P2,[430000,,1]	; ..
	CAMN P2,LINEIP		;BACK TO START OF BUFFER?
	JRST LININL		;YES. DONE DELETING
	LDB B,P2		;NO, SEE IF THIS IS STILL IN THE WORD.
	PUSHJ P,ALNUMQ		;SKIP IF ALPHANUMERIC
	 JRST LININL		;BREAK. DONE.
	JRST LINCW2		;STILL IN WORD. GO DELETE IT.

LINCW1:	MOVEI B,0		;CURRENT CHAR IS A BREAK. GET BACK TO
	DPB B,P2		;WORD BEFORE BREAK(S), THEN DELETE IT.
	ADDI P1,1		;DELETE BREAK CHARACTER
	ADD P2,[070000,,0]
	SKIPGE P2
	SUB P2,[430000,,1]
	CAMN P2,LINEIP		;BACK TO START OF BUFFER?
	JRST LININL		;YES. QUIT.
	LDB B,P2		;SEE IF MULTI-BREAKS AFTER LAST WORD
	PUSHJ P,ALNUMQ		;ALPHANUMERIC?
	 JRST LINCW1		;NO, MORE BREAKS. DELETE THIS ONE TOO
	JRST LINCW2		;INTO THE WORD. DELETE THE WORD.
ALNUMQ:	CAIL B,"A"+40		;LOWER CASE?
	CAILE B,"Z"+40		; ..
	SKIPA			;NO.
	JRST CPOPJ1		;YES. SKIP RETURN.
	CAIL B,"A"		;UPPER CASE?
	CAILE B,"Z"		; ..
	SKIPA			;NO
	JRST CPOPJ1		;YES. SKIP RETURN
	CAIL B,"0"		;DIGIT?
	CAILE B,"9"		; ..
	SKIPA			;NO
	JRST CPOPJ1		;YES. SKIP RETURN.
	CAIN B,"-"		;HYPHEN?
	JRST CPOPJ1		;YES. SKIP RETURN
	POPJ P,0		;SOMETHING ELSE. NON-SKIP.

SIN6BT:	PUSH P,B		;ANSWER TO A, PRESERVE B AND C
	PUSH P,C		; ..
	MOVE BP,SBP		;CURRENT BYTE POINTER
	MOVEI A,0		;CLEAR THE ANSWER
	MOVE C,[440600,,A]	;START POINTER TO ANSWER
SIN6BL:	ILDB B,BP		;GET A CHARACTER
	PUSHJ P,ALNUMQ		;A-Z, 0-9, OR HYPHEN?
	  JRST SIN6B1		;NO, BREAK CHARACTER
	CAIL B,100		;YES. LETTER?
	TRZ B,40		;YES, MAKE SURE UPPER CASE.
	SUBI B,40		;YES. CONVERT TO SIXBIT
	TLNE C,770000		;ROOM FOR ANOTHER CHARACTER?
	IDPB B,C		;YES, STORE IN KEYWORD
	JRST SIN6BL		;ON TO THE BREAK
SIN6B1:	MOVEM BP,SBP		;UPDATE STORED BYTE POINTER
	POP P,C			;RESTORE AC'S
	POP P,B			; ..
	SKIPE A			;SKIP RETURN UNLESS NO WORD
	AOS 0(P)
	POPJ P,0
TELBIN:	MOVEI A,100		;BIN FROM PRIMARY INPUT
	BIN			;CHARACTER TO AC B
	TRZ B,200		; clear junk bit
	JUMPE B,TELBI0		;NULL? DISCARD IF SO.
	CAIN B,37		;TTY EOL?
	MOVEI B,12		;YES, MAKE LINEFEED
	CAIN B,15		; also make CR into LF
	MOVEI B,12
CPOPJ1:	AOS 0(P)		;NO, OK. SKIP RETURN.
CPOPJ:	POPJ P,0

TELBI0:	MOVEI A,100		;SEE IF EOF
	GTSTS
	TLNN B,1000
	JRST TELBIN		;NO, DISCARD THE NULL.
	POPJ P,0		;YES. GIVE NON-SKIP RETURN. BUT
				;PROBABLY DETACH WILL CAUSE PSI ANYHOW

TIMEOK:	PUSH P,A		;UPDATE TIME TILL HANGUP FORCED
	PUSH P,B		;SAVE AC'S
	TIME			;GET SYSTEM UPTIME
	IMULI B,WATTIM		;THIS MANY SECONDS TO WAIT
	ADD A,B			;WAIT UNTIL TIME EQUALS THIS
	MOVEM A,KTIMET		;THEN FORCE A LOGOUT.
BAPOPJ:	POP P,B
APOPJ:	POP P,A
	POPJ P,0

SST:	PUSH P,A		;SKIP SPACES AND/OR TABS AT CURRENT SBP
	TLZ F,L.LICV		;FLAG FIRST CHARACTER
SSTL:	LDB A,SBP		;GET THE CURRENT CHARACTER
	CAIE A,40		;IS IT A SPACE OR TAB?
	CAIN A,11		; ..
	TLOA F,L.LICV		;YES. FLAG MOVING UP AT LEAST ONE CHAR.
	JRST SST01		;NO. QUIT HERE
	IBP SBP			;IT'S A SPACE/TAB. MOVE PAST IT
	JRST SSTL		;AND GO CHECK THE NEXT ONE.
SST01:	MOVSI A,070000		;BACK UP SO ILDB GETS THE NON-SPACE
	TLZN F,L.LICV		;UNLESS DIDN'T MOVE FORWARD AT ALL.
	JRST SST3		;IN WHICH CASE LEAVE IT HERE.
	ADD A,SBP		; ..
	SKIPGE A
	SUB A,[430000,,1]
	MOVEM A,SBP
SST3:	JRST APOPJ
;PSI HANDLERS

TIMINT:	MOVEM 17,PI2AC+17	;STASH THE AC'S
	MOVEI 17,PI2AC		; ..
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;AND SET UP A STACK
	TIME
	CAMG A,KTIMET		;TIME TO QUIT?
	JRST L2DBRK		;NO.
	TLNN F,L.ANON		;YES. ANONYMOUS USER?
	TLNN F,L.LOGI!L.NALO	;OR NOT LOGGED IN AT ALL?
	SKIPA			;YES. AUTOLOGOUT HIM.
	JRST L2DBRK		;REAL LOGGED IN USER. LET IT SIT IDLE.
	AOS A,LGOCNT		;COUNT THE FORCE-LEVEL COUNTER
	CAIL A,2		;PANIC?
	JRST HANGUP		;YES. GET OUT
	CAIL A,1		;STILL NOT SEEN AT PROCESS LEVEL. FIRST?
	JRST TIMIN1		;NO, GO CAUSE DEBRK TO FORCE OFF
L2DBRK:	MOVSI 17,PI2AC		;RESTORE AC'S
	BLT 17,17		; ..
	DEBRK			;AND RETURN FROM LEV 2 PSI

TIMIN1:	MOVEI A,FORCLO		;FORCED LOGOUT
	HRLI A,(1B5)		;USER MODE
	MOVEM A,RETPC2		;BREAKING OUT OF PRESENT WORK
	JRST L2DBRK

L1DBRK:	MOVSI 17,PI1AC		;RESTORE LEV 1 AC'S
	BLT 17,17		; ..
	DEBRK			;AND RETURN FROM LEV 1 PSI

DETINT:	MOVEM 17,PI1AC+17	;#10 STASH AC'S
	MOVEI 17,PI1AC		;#10 JUST FOR SYMMETRY
	BLT 17,PI1AC+16		;#10 
	MOVE P,L1PDP		;#10 SET UP STACK
	GJINF			;#10 Get current info about job
	DTACH			;#10 Detach now! (wait for nothing)
	RESET			;KILL EVERYTHING. (SHOULD DELETE FILE?)
	JRST HANGU1		;#10 AND GO HANG UP NVT

CTCINT:	MOVEM 17,PI2AC+17	;STASH THE AC'S
	MOVEI 17,PI2AC		; ..
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;AND SET UP A STACK
	SETOM CTCFLG
ABODBK:	MOVEI A,ABORPC
	HRLI A,(1B5)		;FORCE IT TO BREAK OUT AT THIS PC
	MOVEM A,RETPC2
	JRST L2DBRK

IOXINT:	MOVEM 17,PI2AC+17	;STASH THE AC'S
	MOVEI 17,PI2AC		; ..
	BLT 17,PI2AC+16
	MOVE P,L2PDP		;AND SET UP A STACK
	SETOM IOXFLG		;FLAG THE I/O ERROR
	JRST ABODBK		;ABORT TO ABORPC ON DEBREAK
	JRST L2DBRK

QTAINT:	HRROI X,[ASCIZ/456 Exceeded working quota/]
	MOVE P,PDP		;RESET STACK FOR COMMAND LEVEL
	MOVEI A,RETXX		;DEBREAK OU TO CLOSE CONN ETC
	MOVEM A,RETPC2
	DEBRK
;THE FATAL (LEV 1) ONES

INSINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Illegal Instruction trap/

MEMINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Illegal memory reference trap/

PDLINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Pushdown stack overflow trap/

FULINT:	MOVEM 17,PI1AC+17	;STASH THE AC'S
	MOVEI 17,PI1AC
	BLT 17,PI1AC+16
	MOVE P,L1PDP		;SET UP A STACK
	JSP B,L1INTS
	ASCIZ /Disk or Drum overflow/
L1INTS:	HRROI A,[ASCIZ /456 /]
	PSOUT
	HRROI A,(B)
	PSOUT			;SPECIFIC FAILURE MESSAGE
	HRROI A,[ASCIZ / at /]
	PSOUT
	MOVEI A,101		;TYPE THE PC
	HRRZ B,RETPC1
	MOVEI C,10
	NOUT
	  JFCL
	HRROI A,[ASCIZ /. Goodbye.
/]
	PSOUT
	JRST HANGUP
;#7 Following code is for handling XRSQ/XRCP mail transfers..
;#7 Supports only "XRCP T" mode

;#7 XRSQ command - query and select XRCP mode

ZXRSQ:	SETZM XRCPTX		;#7 Always reset text storage
	CLOSE LCLJFN		;#7  ..
	ILDB B,SBP		;#7 Get single char argument
	JUMPE B,XRSQN		;#7 No arg is okay
	CAIN B,"?"		;#7 Wants our preference?
	 JRST XRSQQ		;#7 
	TRZ B,40		;#7 insure uppercase
	CAIN B,"R"		;#7 Wants RCPT first?
	 JRST XRSQR		;#7  (lose)
	CAIN B,"T"		;#7 Wants TEXT first?
	 JRST XRSQT		;#7  (win)
	JSP B,RPCRLP		;#7 Unknown arg
	ASCIZ /502 No such mode./ ;#7 

XRSQQ:	JSP B,RPCRLP		;#7 
	ASCIZ /215 T Text-first, please./ ;#7 

XRSQN:	SETZM XRCPSC		;#7 Clear setting to default scheme
	JSP B,RPCRLP		;#7 
	ASCIZ /200 Resetting to no XRCP mode selected./ ;#7 

XRSQR:	JSP B,RPCRLP		;#7 
	ASCIZ /501 Text-first is the only mode supported./ ;#7 

XRSQT:	SETOM XRCPSC		;#7 Set -1 for "T" scheme
	JSP B,RPCRLP		;#7 
	ASCIZ /200 Text first mode selected./ ;#7 


;#7 XRCP command - specify addressee for mail already stored via MAIL/MLFL
;#7	with no argument; otherwise like MAIL in response/behavior

ZXRCP:	SKIPL XRCPSC		;#7 Specified XRCP scheme?
	 JRST XRCPL1		;#7  no, error
	SKIPLE XRCPTX		;#7 Assume T scheme; do we have msg text?
	SKIPG LCLJFN		;#7 Claim to, have real JFN?
	 JRST XRCPL2		;#7  negative, lose
	TRO F,R.XRCP		;#7 Flag XRCP command (not MAIL)
	JRST MAIL0X		;#7 Enter normal mail code

XRCPL1:	JSP B,RPCRLP		;#7 
	ASCIZ /507 No scheme specified yet. Use XRSQ./ ;#7 

XRCPL2:	JSP B,RPCRLP		;#7 
	ASCIZ /430 No mail text sent yet./ ;#7 
;MAIL COMMAND - APPENDS MAIL TO MAIL.TXT.1 FOR LOCAL USER
;AND MLFL COMMAND, SAME BUT DATA ON DATA CONN INSTEAD OF TELNET.

ZMAIL:	TLZA F,L.MLFL		;FLAG MAIL, NOT MLFL
ZMLFL:	TLO F,L.MLFL		;FLAG MLFL, NOT MAIL
	TLNE F,L.LOGI		;DON'T ACCEPT MAIL IF LOGGED IN.
	JRST ORDERX		; ..
	CLOSE LCLJFN		;IN CASE ABORTED OUT OF MAIL
	SETZM XRCPTX		;#7 Always reset text storage
	TRZ F,R.XRCP		;#7 Flag MAIL command (not XRCP)
MAIL0X:	TLZ F,L.MFWD		;#7 ASSUME NOT FORWARDING
	SKIPLE NOMAIL		;#12 Is mail delievery allowed?
	 JRST MAILX7		;#12  no, call everyone busy!
	PUSHJ P,SST		;SKIP OVER TO NAME
	SETZM IBITCT		;NO BITS READ YET
	SETZB A,MLUSR		;SEE IF ARG WINS. CLEAR DEST NAME
	SETZM MLUNST		;PUT THE NAME IT WAS ADDRESSED TO HERE.
	MOVE B,SBP
	MOVE A,[POINT 7,MLUNST]	;#8 
	MOVEI D,^D39		;#8 
	PUSHJ P,.SOUTC		;#8 
	SKIPN MLUNST		;THERE WAS A NAME, WASNT THERE?
	 JRST [	TRNN F,R.XRCP		;#7 No, Lose if XRCP command
		SKIPN XRCPSC		;#7  or if no XRCP scheme specified
		 JRST MAILX4		;#7 
		SETOM XRCPTX		;#7 Okay, flag storing text
		JRST MAIL0A]		;#7  go make temp file for it.

;#3 We use RCDIR in place of RCUSR because we want to be able
;#3	to send mail to files-only directories!

	MOVE A,[POINT 7,MLFWST]	;#2 Compose filename here
	HRROI B,[ASCIZ /PS:</]	;STICK IN USER NAME
	PUSHJ P,.SOUT		;#8 
	HRROI B,MLUNST		;NAME FROM COMMAND
	PUSHJ P,.SOUT		;#8 
	HRROI B,[ASCIZ />/]	;#3 
	PUSHJ P,.SOUT		;#8 
	MOVE D,A		;#3 save pointer for filename
	MOVX A,RC%EMO		;EXACT MATCH ONLY
	HRROI B,MLFWST		;#2 OK, GET DIRECTORY NUMBER
	PUSHJ P,.RCDIR		;#3 ;#2 See if user exists
	TXNE A,<RC%NOM!RC%AMB>	;DOES IT EXIST
	  JRST MLFWQ		;#3  no
	MOVEM C,MLUSR		;SAVE THE DIRECTORY NUMBER
	SKIPGE B,NOMAIL		;#12 See if this dir exempted from mail delivery..
	CAME C,0(B)		;#12 
	AOBJN B,.-1		;#12 
	JUMPL B,MAILX4		;#12 If number found in table, yes
	MOVE A,D		;#3 
	HRROI B,MAILFN		;#2 
	PUSHJ P,.SOUT		;#8 
	MOVSI A,101001		;SEE IF MAILBOX EXISTS
	HRROI B,MLFWST		;#2 
	PUSHJ P,.GTJFN		;#2 
	  JRST MLFWQ		;IT DOESN'T. SEE IF FORWARDING EXISTS.
	MOVE B,[XWD 1,1]	;MAKE SURE ALLEGED MAILBOX IS
	MOVEI C,C		; PERMANENT. IF NOT, PRETEND
	GTFDB			; IT DOESN'T EXIST
	RLJFN			;RELEASE MAILBOX JFN
	  JFCL
	TLNN C,(1B1)
	 JRST MLFWQ		;#3 
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
MAIL0A:	TRNE F,R.XRCP		;#7 If XRCP command,
	 JRST MAIL2A		;#7  then already have temp file, copy it.
	MOVE A,[POINT 7,GTJSTR]	;#8 Build a name for temp file for mail
	HRROI B,[ASCIZ /PS:<SYSTEM>--MAIL--./]
	PUSHJ P,.SOUT		;#8 
	HRRZ B,GJINF3		;JOB NUMBER
	MOVEI C,12		;DECIMAL
	NOUT			;INTO FILENAME
	  JRST MLX10		;IMPOSSIBLE FAILURE
	HRROI B,[ASCIZ /;P770000;T/]	;AND MAKE JOB DEPENDENT.
	PUSHJ P,.SOUT		;#8 
MAIL01:	MOVSI A,411001		;GTJFN SHORT, STRING, OUT, TEMP, IG DEL.
	HRROI B,GTJSTR		; ..
	PUSHJ P,.GTJFN		;#2 
	 JSP A,MAILX9		;CAN'T?
	MOVEM A,LCLJFN		;STORE JFN
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	MOVE B,[070000,,100000]	;OPEN TO WRITE.
	OPENF
	 JSP A,MAILX9		;CAN'T?
	HRROI B,[ASCIZ /Mail-from: ARPANET host /] ;#4
	MOVEI C,0
	SOUT
	MOVE B,FHSTN		;#1 NOW PUT A TIME-STAMP ON. FIRST, HOST.
	PUSHJ P,.CVHST		;#2 Get host name string
	HRROI B,[ASCIZ / rcvd at /]
	MOVEI C,0
	SOUT
	MOVSI C,(1B10+1B12+1B13+1B17)
	SETO B,
	ODTIM
	HRROI B,CRLFM		;AND END LINE
	MOVEI C,0
	SOUT
	TLNE F,L.MLFL		;MAIL FILE?
	JRST MLFL01		;YES. DIFFERENT DATA CAPTURE MECHANISM
	HRROI B,[ASCIZ /350 Type mail, ended by a line with only a "."
/]
	PUSHJ P,SDUMPA		;SEND MSG AND DUMP BUFFER

MAILL1:	PUSHJ P,LINEIN		;NOW READ TELNET LINES.
	  JRST [TLNE F,L.LTL
		JRST MAILX6
		JRST MAILX8 ]	;EOF ON TELNET. ABORT.
MAIL1A:	MOVE A,CMDIB		;SEE IF LINE WAS JUST A DOT
	CAMN A,[ASCII /./]	; ..
	JRST MAIL02		;YES. DEFINES END.
	MOVE A,LCLJFN
	HRROI B,CMDIB		;PUT THE LINE IN THE TEMP FILE
	MOVEI C,0
	SOUT
	HRROI B,CRLFM		;AND A CR LF WHICH WAS STRIPPED
	SOUT
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	JRST MAILL1		;LOOP TILL DOT OR EOF

MAIL02:	MOVE A,LCLJFN		;NOW MOVE THE LOCAL FILE TO THE
	HRLI A,(1B0)		;MAIL FILE. CLOSE THE WRITE.
	CLOSF			;BUT KEEP THE JFN
	  JFCL
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	HRRZ A,LCLJFN		;RE-OPEN FOR READING
	MOVE B,[070000,,200000]	; ..
	OPENF
	 JSP A,MAILX9		;CAN'T
	RFPTR			;CHECK SIZE OF THE MAIL
	 JSP A,MAILX9		;CAN'T FAIL
	ASH B,3			;EIGHT BITS PER
	ADDM B,TRBITS
	ASH B,-3
	CAIL B,10000		;DON'T ALLOW SUPER-HUGE FILES.
	JRST MAILX5		;BAD..
	SKIPE XRCPTX		;#7 If storing text for use by XRCP,
	 JRST MAIL3X		;#7  then just return positive ack to user.
;	..
;	..

MAIL2A:	MOVEI X,5		;TIMES TO TRY IF BUSY
MAIL2B:	HRROI B,MLFWST		;#2 NOW GET A JFN FOR MAILBOX
	MOVSI A,101001
	TLNE F,L.MFWD		;FORWARDING?
	TLZ A,101000		;YES. ALLOW NEW FILE
	PUSHJ P,.GTJFN		;#2 
	  JRST MAILX4		;NO SUCH FILE
	PUSH P,A		;KEEP ON STACK
	HRLI A,1		;MAKE SURE IT'S UNDELETED
	MOVSI B,040000
	MOVSI C,0		;NOT DELETED BIT
	CHFDB
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	HRRZ A,0(P)		;RESTORE JFN
	MOVE B,[070000,,020000]	;APPEND TO IT.
	OPENF
	  JRST [MOVEM A,B	;SAVE ERROR CODE
		POP P,A		;CAN'T
		RLJFN
		  JFCL
		SOJLE X,MLX15
		MOVEI A,^D2000
		DISMS
		JRST MAIL2B]

	MOVE A,LCLJFN		;GET # OF CHARS IN TEMP FILE
	SIZEF
	  JRST [POP P,A
		CLOSF
		  JFCL
		JSP A,MAILX9]
	MOVEM B,T1		;SAVE # CHARS IN T1
	TLNE F,L.MFWD		;FORWARDING?
	JRST MAILL2		;YES. DON'T PUT HEADER ON.
	MOVE A,0(P)		;MESSAGE FILE
	SETO B,0		;PUT STANDARD MSG FILE FORMAT ON.
	MOVSI C,(1B13)		;FIRST, DATE AND TIME WITH TIME ZONE.
	ODTIM
	MOVEI B,","		;THEN COMMA
	BOUT
	MOVE B,T1		;SIZE OF TEXT
	MOVEI C,12		;DECIMAL RADIX
	NOUT
	  MOVE A,0(P)
	MOVEI B,";"		;NOW BIT FLAG FIELD
	BOUT
	SETZ B,			;IS NORMALLY 0.
	MOVE C,FORNS		;IF FOREIGN ICP SOCKET
	CAIL C,MLSKT		; IS AUTHENTICATED MAIL SOCKET
	CAILE C,MLSKT+5		; IN THIS GROUP OF 6
	SKIPA			;NO GOOD.
	TLO B,(1B7)		; OK, FLAG VERIFIED IN B7
	MOVE C,[1B2+1B3+^D12B17+^D8] ;12 OCTAL DIGITS, LEADING 0'S.
	NOUT
	  MOVE A,0(P)
	HRROI B,CRLFM
	MOVEI C,0
	SOUT			;AND CR, LF ON END OF LINE
;	..
;	..

MAILL2:	MOVE A,LCLJFN		;NOW PUT POINTER BACK AT START
	MOVEI B,0		; ..
	SFPTR
	  JFCL
	MOVE B,T1		;COUNT 8-BIT CHARS, THOUGH INCLUDES
	IMULI B,10		; SMALL ERROR OF LOCAL HEADER
	ADDM B,IBITCT
	ADDM B,TRBITS
MLLUP1:	PUSHJ P,TIMEOK		;LOOP TO COPY FROM TEMP TO MSG FILE
	SKIPG C,T1		;# OF CHARS LEFT TO COPY
	JRST MAIL03		;NO MORE
	CAILE C,5000		;IF > 1 PAGE, JUST DO PAGE
	MOVEI C,5000
	SUB T1,C		;ADJUST # REMAINING CHARS
	MOVE A,LCLJFN		;SET UP TO READ FROM TEMP FILE
	HRROI B,WINDOW		; INTO WINDOW
	PUSH P,C		;SAVE # CHARS TO READ
	MOVNS C			;MAKE COUNT NEGATIVE
MLLUP2:	SIN			;READ
	POP P,C			;# OF CHARS READ
	MOVNS C			;WRITE THEM TO MSG FILE
	HRROI B,WINDOW
	MOVE A,0(P)
	SOUT
	JRST MLLUP1		;LOOP FOR MORE

MAIL03:	MOVE A,[POINT 7,GTJSTR]	;#8 Where to build amusing string
	HRROI B,[ASCIZ /[/]
	PUSHJ P,.SOUT		;#8 
	MOVE B,FHSTN		;#1 Foreign host number
	PUSHJ P,.CVHST		;#2 Get host name string
	HRROI B,[ASCIZ /]/]
	PUSHJ P,.SOUT		;#8 
	POP P,A
	HRLI A,.SFLWR		; Set last writer of MAIL.TXT
	HRROI B,GTJSTR		; To string we just built
	SKIPE TOPS20		;#2 TENEX doesn't have this (ERJMP is noop)
	SFUST			; Do it
	 ERJMP .+1
	MOVE A,1(P)		; Get JFN all over again
	CLOSF
	  JFCL
;	PUSHJ P,MLSTAT		;RECORD MAIL STATISTICS
	TLO F,L.NALO		;NO AUTOLOGOUT, NOW. MAY BE MAILER.
	HRROI X,MAILM2		;MAIL DONE.
	TLNE F,L.MLFL		;OR WAS IT MLFL
	HRROI X,MAILM3		;YES.
	JRST MAIL05
MAILM3:	ASCIZ /252 Mail completed successfully./
MAILM2:	ASCIZ /256 Mail completed successfully./

MAIL3X:	MOVEI A,1		;#7 Set flag to 1,
	MOVEM A,XRCPTX		;#7  meaning text exists and is ready
	HRROI B,[ASCIZ /256 Mail stored successfully./] ;#7 
	TLNE F,L.MLFL		;#7 
	HRROI B,[ASCIZ /252 Mail stored successfully./] ;#7 
	JRST RPCRLP		;#7 
;RECORD MAIL STATISTICS IF APPROPRIATE

MLSTAT:	SKIPE DBUGSW		;RETURN IF DEBUGGING
	  POPJ P,0
	MOVEI A,0		;SEE IF MAIL2 DIRECTORY EXISTS
	HRROI B,[ASCIZ /PS:<MAIL2>/]
	PUSHJ P,.RCDIR		;#2 
	TXNE A,<RC%NOM!RC%AMB>	;DOES IT EXIST
	JRST [TDZ C,C		;NO IT DOES NOT EXIST
		JRST .+2]
	SETO C,0		;IT DOES
	PUSH P,C		;REMEMBER IT
	SETO B,			;CALCULATE VERSION NUMBER FOR
	MOVSI D,(1B0+1B2+0B17)	; STATISTICS FILE BASED ON GMT DATE
	ODCNV
	MOVE A,C		;SAVE DAY OF WEEK IN RH, AND
	HRL A,D			;GMT SECONDS SINCE MIDNIGHT IN LH
	MOVEM A,MLTIMT		; IN A TIME TEMP CELL
	HRRZ A,B		;MONTH
	AOS A
	IMULI A,^D100
	HLRZ B,B		;YEAR
	IDIVI B,^D100
	ADD A,C			;VERSION=MMYY
	TLO A,(1B17)		;SHORT FORM GTJFN
	HRROI B,[ASCIZ /PS:<SYSTEM>MAIL.BLOG/]
	SKIPGE 0(P)		;DOES MAIL2 EXIST?
	HRROI B,[ASCIZ /PS:<MAIL2>MAIL.BLOG/]	;YES. USE IT
	POP P,(P)		;DISCARD THAT FLAG
	PUSHJ P,.GTJFN		;#2 
	  POPJ P,0		;CAN'T, GIVE UP
	MOVEM A,LOGJFN		;SAVE JFN
	MOVE B,[1B19+1B20+1B25]	;READ,WRITE,THAWED
	OPENF
	  JRST MLSTA2		;CAN'T, GIVE UP
	HRL A,LOGJFN		;MAP PAGE 1 OF STATISTICS FILE
	HRRI A,1
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,140000		;READ/WRITE
	PMAP
	MOVE A,FHSTN		;INCREMENT # OF MSGS RECEIVED
	AOS WINDOW(A)		;FROM THIS HOST
	SETO A,			;UNMAP PAGE
	MOVEI C,0		;NO COUNT
	PMAP
	HRL A,LOGJFN		;MAP PAGE 3 OF FILE
	HRRI A,3
	PMAP
	MOVE A,LCLJFN		;GET # OF CHARS IN MESSAGE
	SIZEF			;=LENGTH OF LOCAL FILE
	  SETZ B,		;SHOULDN'T FAIL
	PUSH P,B		;SAVE THE SIZE
	MOVE A,FHSTN		;ADD TO # OF CHARS RECEIVED
	ADDM B,WINDOW(A)	;FROM THIS HOST
	SETO A,			;UNMAP PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
	HRL A,LOGJFN		;MAP PAGE 4 OF FILE
	HRRI A,4
	MOVSI C,140000		;READ/WRITE
	PMAP
	HRRZ C,MLUSR		;NUMBER OF USER RECEIVING MAIL
	IDIVI C,^D36		;CALCULATE WORD AND BIT
	MOVSI A,400000		; CORRESPONDING TO USER #
	MOVNS D
	ROT A,(D)
	IORM A,WINDOW+200(C)	;TURN ON BIT FOR THAT USER
	SETO A,			;UNMAP PAGE
	MOVEI C,0		;NO COUNT
	PMAP
	MOVS A,LOGJFN		;NOW THE TIME-HISTOGRAM PAGES
	HRRI A,10		;PAGE 10 IS CHARS BY TIME OF DAY
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,140000		;READ AND WRITE ACCESS
	PMAP
	HLRZ A,MLTIMT		;GET THE TIME WITHIN DAY
	IDIVI A,^D<60*30>	;THE HALF-HOUR WITHIN THE DAY
	HRRZ D,MLTIMT		;THE DAY IN THE WEEK (MONDAY = 0)
	IMULI D,^D48		;SKIP N DAYS OF HALF-HOURS
	ADD D,A			;AND ADD IN TODAY'S HALF-HOURS
	POP P,A			;GET BACK LENGTH OF MSG
	ADDM A,WINDOW(D)	;RECORD IT
	MOVS A,LOGJFN		;NOW COUNT MSGS BY TIME OF DAY
	HRRI A,7		;IN THIS PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,140000		;READ AND WRITE ACCESS
	PMAP
	AOS WINDOW(D)		;COUNT A MSG
	MOVEI A,400000		;NOW GET RUN TIME OF THIS FORK
	RUNTM
	SUB A,IFRKTM		;SINCE STARTED
	SUB A,MALCPU		;LESS ANY POSSIBLE PREVIOUS MSG
	ADDM A,MALCPU		;UPDATE FOR THIS MSG
	ADDM A,WINDOW+777	;COUNT IT IN TOTAL, LAST WD THIS PG
	SETO A,			;UNMAP PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
MLSTA2:	CLOSE LOGJFN		;CLOSE STATISTICS FILE
	POPJ P,0
MLFWQ:	MOVSI A,100001		;GET JFN OF FORWARDER
	HRROI B,[ASCIZ /SYS:MAILBOX.EXE/]
	SKIPN TOPS20		;#2 
	HRROI B,[ASCIZ /<SUBSYS>MAILBOX.SAV/] ;#2 
	GTJFN
	  JRST MFWDX1		;NOT THERE.
	PUSH P,A		;SAVE JFN
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	MOVSI A,(1B1)		;CREATE AN INFERIOR FORK
	CFORK
	  JRST MFWDX2		;CAN'T
MLFWQ5:	PUSH P,A		;SAVE FORK HANDLE
	HRL A,0(P)		;GET PROG INTO FORK
	HRR A,-1(P)		;JFN
	GET
	HRLZ A,0(P)		;PAGE 0 OF INFERIOR
	MOVSI B,400000		;MAPPED FROM THIS FORK
	HRRI B,BLTPAG		;TEMP PAGE
	MOVSI C,140000		;RD, WRT ACCESS
	PMAP
	MOVSI T1,-10		;COPY NAME
	MOVE A,MLUNST(T1)	;COMMANDED ADDRESSEE
	MOVEM A,BLTADR+140(T1)	;TO INFERIOR
	AOBJN T1,.-2
	MOVE A,0(P)		;FORK HANDLE AGAIN
	MOVEI B,[1]-1		;SET AC1 TO 1 FOR LOCAL SITE
	SFACS
	MOVEI B,2
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	SFRKV			;START UP INFERIOR
	WFORK
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	RFSTS			;SEE IF IT FINISHED OK
	HLRZ A,A		; ..
	CAIE A,2		;HALTF?
	JRST MFWDX3		;NO
	MOVE A,0(P)		;HANDLE AGAIN
	MOVEI B,ACTACS		;ACCOUNT FORK AC BLK IS FREE HERE
	RFACS			;GET ANSWER
	SKIPG T1,ACTACS+1	;SUCCESS ANSWER?
	JRST MFWDX3		;NO
	MOVE A,[440700,,LHSTNM]	;PREVENT LOOPS.
	MOVE B,[440700,,BLTADR+150]	; BY CHECKING FOR LOCAL HOST
	MOVEI C,50
MLFWQ2:	ILDB T1,A
	ILDB T2,B
	CAME T1,T2
	JRST MLFWQ3
	JUMPE T1,MLFWQ1		;IF MATCHED THRU END, CHECK NAME
	SOJG C,MLFWQ2		;LOOK TIL END OR MISMATCH
	JRST MFWDX3		;WIERD FAILURE.
MLFWQ1:	MOVE A,[440700,,MLUNST]	;SEE IF USER NAME MATCHES TOO
	MOVE B,[440700,,BLTADR+140]
	MOVEI C,50
MLFWQ4:	ILDB T1,A
	ILDB T2,B
	CAME T1,T2
	JRST MLFWQ3
	JUMPE T1,MFWDX3
	SOJG C,MLFWQ4
	JRST MFWDX3
MLFWQ3:	MOVE A,[POINT 7,MLFWST]	;#2 Copy over for a new file
	HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
	PUSHJ P,.SOUT		;#8 MAILER standard name
	HRROI B,BLTADR+140
	PUSHJ P,QVSTR		;#5 
	MOVEI B,"V"&37
	IDPB B,A		;#8 Quote the at-sign
	MOVEI B,"@"
	IDPB B,A		;#8 
	HRROI B,BLTADR+150
	PUSHJ P,QVSTR		;#5 
	HRROI B,[ASCIZ /;P770000/]
	PUSHJ P,.SOUT		;#8 
	HRROI B,[ASCIZ /951 mail will be forwarded to /]
	PUSHJ P,SDUMPA		;TELL USER
	HRROI B,BLTADR+140
	PUSHJ P,SDUMPA		;GIVE HIM ADDRESSEE
	HRROI B,[ASCIZ / at /]
	PUSHJ P,SDUMPA
	HRROI B,BLTADR+150
	PUSHJ P,SDUMPA
	HRROI B,CRLFM		;END OF LINE
	PUSHJ P,SDUMPA
	TLO F,L.MFWD		;FLAG FOR LATER PROCESSING
	POP P,A			;FORK HANDLE
	KFORK
;;#11 	MOVE A,0(P)		;AND MAILBOX.EXE JFN
;;#11 	HRLI A,(1B0)
;;#11 	CLOSF
;;#11 	  JFCL
	POP P,A
;;#11 	RLJFN
;;#11 	  JFCL
	PUSHJ P,TIMEOK		;UPDATE KILL TIME
	JRST MAIL0A		;NOW GET THE MAIL


QVSTR:	TLC B,-1		;#5 Insure (compose) byte pointer
	TLCN B,-1		;#5  to source string
	HRLI B,440700		;#5 
	MOVEI D,"V"&37		;#5 Ctrl-V is the quote char
QVSTR1:	ILDB C,B		;#5 Get character,
	JUMPE C,QVSTR2		;#5 
	CAIL C,"A"		;#5  uppercase letters,
	CAILE C,"Z"		;#5 
	CAIN C,"$"		;#5  the dollar sign,
	 JRST QVSTR2		;#5 
	CAIL C,"0"		;#5  all digits,
	CAILE C,"9"		;#5 
	CAIN C,"-"		;#5  and the minus sign
	 JRST QVSTR2		;#5  don't need to be quoted in
	IDPB D,A		;#5 all other chars need preceeding ^V
QVSTR2:	IDPB C,A		;#5 put character,
	JUMPN C,QVSTR1		;#5  continue until nul
	ADD A,[7B5]		;#5 Backup dest ptr (overwrite nul)
	POPJ P,			;#5 
MFWDX3:	POP P,A			;FORK
	KFORK
	MOVE A,0(P)
	HRLI A,(1B0)
	CLOSF
	  JFCL
	POP P,A			;JFN FOR MAILBOX.EXE
	RLJFN
	  JFCL
MFWDX1:	JRST MAILX4

MFWDX2:	MOVEI A,^D2000		;Failed get fork, wait 2 sec & try again
	DISMS
	MOVSI A,(1B1)
	CFORK
	  SKIPA			;Failed again
	JRST MLFWQ5		;Got fork, go on.
	POP P,A			;No fork. Release MAILBOX.EXE JFN
	RLJFN
	  JFCL
	JRST MAILX3
MLBUSY:	TLNE F,L.MFWD		;ONLY POSSIBLE IF TO REAL MAILBOX
	JRST MAILX7
	MOVE A,FHSTN		;DON'T QUEUE IF FROM SAME HOST
	CAMN A,LHOSTN		; TO AVOID CIRCULAR SENDING
	JRST MAILX7
	MOVE A,[POINT 7,MLFWST]	;#2 Ok to queue, make filename
	HRROI B,[ASCIZ /[--UNSENT-MAIL--]./]
	PUSHJ P,.SOUT		;#8 
	HRROI B,MLUNST
	PUSHJ P,.SOUT		;#8 
	HRROI B,[ASCIZ /@;P770000/] ;#8 
	PUSHJ P,.SOUT		;#8 
	TLO F,L.MFWD
	JRST MAIL2A

MAILX3:	JSP	X,MAIL05
	ASCIZ /453 No forks available; please try later./
MAILX4:	JSP	X,MAIL05
MAILM4:	ASCIZ /450 No such mailbox at this site./
MAILX5:	JSP	X,MAIL05
MAILM5:	ASCIZ /451 Message too long./
MAILX6:	JSP	X,MAIL05
MAILM6:	ASCIZ /451 Line too long./
MAILX7:	JSP	X,MAIL05
MAILM7:	ASCIZ /453 Mailbox busy./
MAILX8:	JSP	X,MAIL05
MAILM8:	ASCIZ /453 Net connection closed./
MAILX9:	movei b,(a)
	movei a,101
	movei c,10
	nout
	 jfcl
	JSP	X,MAIL05
MAILM9:	ASCIZ /453 Scratch file failure./
MLX10:	JSP	X,MAIL05
MLM10:	ASCIZ /453 Impossible error./
MLX11:	JSP	X,MAIL05
MLM11:	ASCIZ /453 Disk full./
MLX12:	JSP	X,MAIL05
MLM12:	ASCIZ /453 Mailbox damaged./
MLX13:	JSP	X,MAIL05
MLM13:	ASCIZ /453 Unexpected failure to open mailbox./
MLX14:	JSP	X,MAIL05
MLM14:	ASCIZ /450 Append access to mailbox not allowed./
MLX15:	CAIE	B,OPNX1		;diagnose OPENF failure on mailbox
	CAIN	B,OPNX9
	 JRST	MLBUSY
	CAIN	B,OPNX6
	 JRST	MLX14
	CAIN	B,OPNX10
	 JRST	MLX11
	CAIN	B,OPNX16
	 JRST	MLX12
	JRST	MLX13

MAIL05:	TRNE F,R.XRCP		;#7 If in XRCP command,
	 JRST MAIL5Z		;#7  don't zap stored text file!
	SETZM XRCPTX		;#7 MAIL/MLFL always reset stored text!
	SKIPGE A,LCLJFN
	JRST MAIL5Z
	MOVE A,LCLJFN		;CLOSE OUT THE TEMP FILE.
	HRLI A,400000
	CLOSF
	  JFCL
	HRRZ A,LCLJFN
	DELF
	  JFCL
	CLOSE LCLJFN		;#7 moved here so XRCP can avoid it
	CLOSE DATJFN		;#7  ..
MAIL5Z:	HRROI B,(X)		;#7 Reply to correct AC
	JRST RPCRLP		;#7 
;Subr used by MLFL (and FORMERLY XLPTF) to open ascii data connection.

OPN8NC:	SKIPG $STRU		;ARGUMENTS FOR SIMPLE ASCII XFER?
	SKIPLE $MODE		; ..
	RET			;PARAMS BAD
	SKIPN A,$BYTE		;BYTE SIZE 8?
	MOVEI A,10		;OR UNSPECIFIED?
	SKIPG $TYPE		;AND ASCII TYPE?
	CAIE A,10		; ..
	RET			;NO.
	AOS 0(P)		;AT LEAST ONE SKIP AFTER HERE
	MOVE A,[POINT 7,GTJSTR]	;#8 Build name for data connection
	HRROI B,[ASCIZ /NET:2./]
	PUSHJ P,.SOUT		;#8 
	MOVE B,FHSTN		;#1 FOREIGN HOST NUMBER
	MOVEI C,10		;OCTAL
	NOUT
	  0
	MOVEI B,"-"
	IDPB B,A		;#8 
	MOVE B,FORNS		;FOREIGN SOCKET OF TELNET CONN
	TRO B,1			;HIS SOCKET IS A SENDER
	ADDI B,2		;AND TWO ABOVE THE TELNET
	NOUT
	  0
	HRROI B,[ASCIZ /;T/]	;MINE IS JOB RELATIVE
	PUSHJ P,.SOUT		;#8 
	MOVSI A,1		;NOW GET A JFN
	HRROI B,GTJSTR		;FOR THIS CONNECTION
	GTJFN
	  RET			;CAN'T?
	MOVEM A,DATJFN		;OK
	HRROI A,[ASCIZ /255 SOCK /]	;SOCKET REPLY
	PSOUT
	MOVEI A,101
	MOVE B,GJINF3		;MY JOB NUMBER
	ADDI B,^D100000		;CONSTRUCT SOCKET NUMBER
	LSH B,^D15		; ..
	ADDI B,2		; ..
	MOVEI C,12		;TELL HIM IN NET VIRTUAL RADIX (10.)
	NOUT
	  0
	HRROI A,CRLFM		;END LINE
	PSOUT
	MOVE A,DATJFN		;NOW TRY TO OPEN THE CONNECTION
	MOVE B,[102400,,200000]	;TYPE OF CONNECTION TO OPEN
	OPENF
	  RET			;CAN'T?
	JRST CPOPJ1		;OK.
MLFL01:	CALL OPN8NC		;GET A DATA CONNECTION
	  JRST MLFLXP
	  JRST MFPDX1
	HRROI B,[ASCIZ /250 Begin mail file transfer.
/]
	PUSHJ P,SDUMPA		;SEND MSG AND DUMP BUFFER
MLFLL1:	MOVE A,DATJFN		;GET THE MAIL
	BIN
	JUMPN B,MLFLN		;EOF OR NULL?
	GTSTS			;YES. SEE WHICH.
	TLNE B,1000		; ..
	JRST MLFLEF
	JRST MLFLL1		;NULL. THROW IT AWAY.
MLFLN:	CAILE B,177		;AND THROW AWAY TELNET CONTROLS
	JRST MLFLL1		; ..
	MOVE A,LCLJFN		;OK, A REAL CHAR. PUT IN FILE
	BOUT
	PUSHJ P,TIMEOK		;UPDATE TIMEOUT
	JRST MLFLL1		;ONWARD.
MLFLEF:	CLOSE DATJFN
	JRST MAIL02		;NOW COPY TO REAL MAILBOX.

MFPDX1:
MFPDX2:	CLOSE DATJFN
	CLOSE LCLJFN
	JSP B,RPCRLP
	ASCIZ /454 Unable to establish data connection./

MLFLXP:	JSP B,RPCRLP		;FAIL BECAUSE PARAMETERS NO GOOD
ASCIZ /454 Mail file must be 8-bit, Ascii type, Stream mode, File structure./
;#6 BEGIN addtion of several pages, XSEN implementation

;  XSEN Command handling

ZXSEM:	; For time being, XSEM = XSEN.
ZXSEN: 	TLNE F,L.LOGI		; Can't do XSEN if logged in - wheelness lost.
	 JRST ORDERX

	; Get argument (name to send to) and check it.
	PUSHJ P,SST		; Push SBP to start of name.
	MOVSI A,(RC%EMO)	; Using exact match,
	MOVE B,SBP		; look at argument
	PUSHJ P,.RCUSR		;#2 See if user exists
	TLNE A,(RC%AMB!RC%NOM)	;#2  Was it any good?
	 JRST MAILX4		; Foo, no such luser
	MOVEM C,MLUSR		; Aha, save dir number!

	; See if online now
	PUSHJ P,ONLINE		; Scan tables etc.
	JUMPE A,XSENX7		; If not online, jump...
	PUSHJ P,TTYACP		; Online, see if accepting links.
	 JRST XSENX8

	; Online, collect message text into buffer
	HRROI B,[ASCIZ /350 User online, send message ended by a line with only a "."
/]
	PUSHJ P,SDUMPA		; Invite data over
	PUSHJ P,MSGBEG		; Set up buffer for reception
	PUSHJ P,MSGCOL		; Yum yum
	
	; Text collection done, first try to stuff into SENDS.TXT file
	; safely out of way, but don't barf if can't.
	SETZM MLERRC		; Clear error indicator
	MOVE A,SBP		; Get BP to name, which coincidentally is
	PUSHJ P,WRTSND		; name of dir to write msg into!
	 MOVEM A,MLERRC		; If hit error, save code.

	; OK, now again check for online TTY numbers just before sending.
	PUSHJ P,ONLINE		; Return list of TTY's in A.
	JUMPE A,XSENX7		; Fooey, must have gotten wise to us.
	MOVE D,A

	; Send message to TTYs if possible.
	SETZ T1,		; clear cnt of wins
XSEN4:	MOVEI A,.TTDES
	ADD A,(D)		; Get terminal designator
	RFMOD			; Get mode word for terminal
	TRNN B,TT%ALK		; Allowing links?
	 JRST XSEN5		; Nope, assume refusing.
	PUSHJ P,TIMEOK
	DOBE			; Wait until can get at him.
	 ERJMP XSEN5		; Hmm, something wrong? ignore it.
	HRROI B,MSGBUF		; Can send, get pointer to message
	MOVEI C,$MBFLN
	SUB C,MSGCNT		; and cnt of chars in it
	SOUT			; and send it!
	AOS T1			; Bump count of times sent.
XSEN5:	AOBJN D,XSEN4
	JUMPLE T1,XSENX9	; Jump if didn't send to any.

	; Successfully sent message, one last check...
	SKIPE A,MLERRC		; was there an error in writing SENDS.TXT?
	 CAIE A,OPNX9		; and was it "invalid simult access"?
	  JRST XSEN9		; If not or no error, return straightaway.

	; Hmm, try a little harder to get SENDS.TXT written.
	MOVEI X,5	; # times to try
XSEN7:	MOVE A,SBP	; Luser name.
	PUSHJ P,WRTSND	; Try again.
	 JRST [	CAIE A,OPNX9
		 JRST .+1	; Leave loop if strange error,
		SOJLE X,.+1	; or if tried enough times.
		MOVEI A,^D2000	; Wait 2 sec each time
		DISMS
		JRST XSEN7]

	; Return reply indicating success.
XSEN9:	JSP B,RPCRLP
	ASCIZ /256 Message sent successfully./

XSENX7:	JSP B,RPCRLP
	ASCIZ /453 User not online now./
XSENX8:	JSP B,RPCRLP
	ASCIZ /453 User is refusing./
XSENX9:	JSP B,RPCRLP
	ASCIZ /453 Message not sent - user now gone or refusing./
; Auxiliaries for XSEN - online checks etc.

	; ONLINE - takes dir # in MLUSR, returns in A an AOBJN
	; pointer to list of TTY's logged in under that directory.
ONLINE:	MOVEI B,ONLNTB		; Init aobjn ptr to TTY table
	MOVEM B,ONLNPT
	HLLZ D,JOBRT		;#2 Init aobjn ptr for job scan
ONLIN4:	SKIPN TOPS20		;#2 
	 JRST ONLIN1		;#2 
	MOVEI A,(D)		; Job number
	MOVE B,[-2,,T1]		; Where to stick goodies
	MOVEI C,.JITNO		; Start with terminal number
	GETJI			; T1 _ TTY; T2 _ User
	 JRST ONLIN8		; No job there
ONLIN5:	XOR T2,MLUSR		;#2 See if this is who we want
	TRNE T2,-1		;#2  (ignore structure info)
	 JRST ONLIN8		; Nope
	JUMPL T1,ONLIN8		; Jump if job detached.
	SKIPL B,ONLNPT		; Get aobjn ptr to TTY table
	 JRST ONLIN6
	CAME T1,(B)
	 AOBJN B,.-1
	JUMPL B,ONLIN8		; Jump if TTY already in table.
ONLIN6:	MOVEM T1,(B)		; Not found in table, store in 1st free slot
	MOVSI A,-1
	ADDM A,ONLNPT		; Add one to AOBJN count.
	CAIL B,ONLNTB+$OLNTL	; If stuck this one into last slot,
	 JRST ONLIN9		; time to return.

ONLIN8:	AOBJN D,ONLIN4		; search all of jobdir table.

ONLIN9:	SKIPL A,ONLNPT		; Return AOBJN pointer
	 SETZ A,		; Or zero.
	POPJ P,

ONLIN1:	MOVE A,JOBRT		;#2 TENEX job scan..
	HRLI A,(D)		;#2 First see if job exists,
	GETAB			;#2  it does if runtime is positive
	 PUSHJ P,BOMB		;#2 
	JUMPL A,ONLIN8		;#2 
	MOVE A,JOBTTY		;#2 Okay, now get the controlling terminal
	HRLI A,(D)		;#2 
	GETAB			;#2 
	 PUSHJ P,BOMB		;#2 
	HLRE T1,A		;#2 
	MOVE A,JOBDIR		;#2 and user number (login directory)
	HRLI A,(D)		;#2 
	GETAB			;#2 
	 PUSHJ P,BOMB		;#2 
	HRRZ T2,A		;#2  (ignore connected directory)
	JRST ONLIN5		;#2 

	; TTYACP - Takes AOBJN ptr to TTY list (as returned by ONLINE) in A,
	;	skips if at least one is accepting links.  Fails if none
	;	are accepting links.  Doesn't clobber A.
TTYACP:	PUSH P,A
	MOVE D,A
TTYAC4:	MOVEI A,.TTDES
	ADD A,(D)	; Get JFN for terminal descriptor
	RFMOD		; Get mode word for terminal
	TRNE B,TT%ALK	; Allowing links?
	 AOSA -1(P)	; Yes, skip out and do a skip return.
	AOBJN D,TTYAC4	; Hmm, if not check all TTY's on list.
	POP P,A
	POPJ P,

	; MSGBEG - Set up initial string in message buffer.

MSGBEG:	MOVE A,[440700,,MSGBUF]
	HRROI B,[ASCIZ /TTY message from ARPAnet host /]
	PUSHJ P,.SOUT		;#8 
	MOVE B,FHSTN		;#1 NOW PUT A TIME-STAMP ON. FIRST, HOST.
	PUSHJ P,.CVHST		;#2 Get host name string
	HRROI B,[ASCIZ /:
/]
	PUSHJ P,.SOUT		;#8 
	MOVEM A,MSGBPT		; Store updated BP into buffer.
	HRROI B,MSGBUF
	PUSHJ P,PTRDIF		; Get BP pointer difference into C
	SUBI C,$MBFLN		; Get -# chars left in buffer
	MOVMM C,MSGCNT		; Store # chars left as count.
	MOVEI A,1
	MOVEM A,MSGLNS		; Start count of # lines.
	POPJ P,


	; MSGCOL - Collect message text over command connections.
	; Gobbles into core until usual "." line seen.

MSGCOL:	PUSHJ P,LINEIN		; Get a line of input
	 JRST [	TLNE F,L.LTL
		 JRST MAILX6
		JRST MAILX8]
	MOVE A,CMDIB		; If line was only a period
	CAMN A,[ASCII /./]
	 POPJ P,		;  then we are thru
	MOVE A,MSGBPT		; Copy the line into our buffer..
	HRROI B,CMDIB
	MOVE D,MSGCNT
	PUSHJ P,.SOUTC		;#8 
	JUMPE D,MAILX5		; Complain if we run out of buffer
	HRROI B,CRLFM		; Tack on end-of-line which was stripped off
	PUSHJ P,.SOUTC		;#8 
	JUMPE D,MAILX5
	MOVEM A,MSGBPT		; Save current pointer into msg
	MOVEM D,MSGCNT		;  and how much space is left
	AOS MSGLNS		; Increment line cnt
	PUSHJ P,TIMEOK		; Bletcherous crock
	JRST MSGCOL		; continue


	; PTRDIF - Takes BPs in A and B, leaves difference (# chars)
	; in C.  Think of it as A-B => C
	; Won't work for indexed/indirected bp's.
PTRDIF:	PUSH P,A
	PUSH P,B
	TLNE A,7077	; Assume LH -1 if any of these bits set.
	 HRLI A,440700
	TLNE B,7077	; Ditto.
	 HRLI B,440700
	MULI B,5	; Get stuffs
	ADD C,PTRD7P(B)	; and work magic to get canonical pointer
	MULI A,5
	ADD B,PTRD7P(A)	; Ditto for other bp.
	SUBM B,C	; Put A-B in C.
	POP P,B
	POP P,A
	POPJ P,

	133500,,0	; to handle -5 produced by 440700
	BLOCK 4		; never ref'd
PTRD7P:	-54300,,5	; Magic numbers...
	-104300,,4
	-134300,,3
	-164300,,2
	-214300,,1


	; WRTSND - write out message buffer.  A holds BP to directory name.
	;	Skips if successful.  Error return gives err code in A.
	;	maybe later make more general.

WRTSND:	MOVE D,A
	MOVE A,[POINT 7,GTJSTR]	;#8 Compose filename here
	HRROI B,[ASCIZ /PS:</]
	PUSHJ P,.SOUT		;#8 
	MOVE B,D
	PUSHJ P,.SOUT		;#8 
	HRROI B,[ASCIZ />SENDS.TXT.0;T/]
	PUSHJ P,.SOUT		;#8 

	; Have filename to hunt for (or create), get JFN etc.
	MOVSI A,(GJ%SHT)	; Short form is all.
	HRROI B,GTJSTR
	PUSHJ P,.GTJFN		;#2 
	 POPJ P,		; Failed?? non-skip return, err code in A.
	MOVE D,A		; Save JFN
	MOVE B,[7B5+OF%APP]	; Open for appending
	OPENF
	 JRST [	EXCH A,D	; Failed... perhaps simultaneous access.
		RLJFN		; for now, just return.
		 JFCL
		MOVE A,D	; return err code.
		POPJ P,]

	; Hurray, have it open - kick message out.
	MOVEI A,(D)
	HRROI B,MSGBUF		; Get pointer to message
	MOVEI C,$MBFLN
	SUB C,MSGCNT		; and cnt of chars in it
	SOUT			; and send it!
	CLOSF			; Close file (LH = 0)
	 JFCL
	AOS (P)		; Win return.
	POPJ P,

;#6 END addition of several pages, XSEN implementation
;NUMERIC INPUT ROUTINE. DECIMAL UNLESS PRECEDED BY "O" OR "X".

DECIN1:	ILDB C,BP		;SKIP SEPARATOR FIRST
DECIN:	MOVEI A,0		;COLLECT NUMBER HERE
	PUSH P,BP		;SAVE ORIGINAL BYTE POINTER
DECINL:	CAIL C,"0"		;DECIMAL DIGIT?
	CAILE C,"9"		; ..
	JRST DECINX		;NO.
	IMULI A,12		;YES, ACCUMULATE NUMBER
	ADDI A,-"0"(C)		; ..
	ILDB C,BP		;ON TO NEXT CHARACTER
	JRST DECINL		;SEE IF BREAK OR DIGIT
DECINX:	CAMN BP,0(P)		;HAS ANY DIGIT BEEN SEEN?
	JRST RADIXQ		;NO, MAYBE IT'S A LEADING X OR O
	AOS -1(P)		;SAW A DIGIT. SKIP RETURN
	POP P,0(P)		;DISCARD ORIGINAL POINTER
	POPJ P,0		;AND SKIP RETURN

RADIXQ:	CAIE C,"O"		;OCTAL PREFIX?
	CAIN C,"O"+40		;OR LOWER CASE "O"
	JRST OCTIN		;YES. GO READ IT
	CAIE C,"X"		;HEX INPUT?
	CAIN C,"X"+40		; ..
	JRST HEXIN		;YES. GO COLLECT HEX NUMBER
	POP P,(P)		;NO GOOD. DISCARD POINTER ON STACK
	POPJ P,0		;AND GIVE NON-SKIP RETURN

OCTIN:	ILDB C,0(P)		;UPDATE START OF NUMBER, SKIP THE "O"
	MOVE BP,0(P)		; ..
OCTINL:	CAIL C,"0"		;OCTAL DIGIT?
	CAILE C,"7"		; ..
	JRST RADIXX		;NO. QUIT.
	LSH A,3			;YES. ACCUMULATE NUMBER
	ADDI A,-"0"(C)		; ..
	ILDB C,BP		;GET NEXT CHARACTER
	JRST OCTINL		;SEE IF END OF NUMBER

SNDCTL:
   IFN IPCLOG,<			;DON'T USE THIS FEATURE YET
	SKIPN TOPS20		;#2 TENEX doesn't support IPCF
	 POPJ P,		;#2 
	PUSH P,A
	PUSH P,B
	PUSH P,C
	SETZM PIDARG		;SEND DATA TO FTSCTL
	MOVEI C,3		;TRY THREE TIMES
SNDCT1:	MOVE A,MYPID
	MOVEM A,PIDARG+1
	MOVE A,CTLPID
	MOVEM A,PIDARG+2
	MOVE A,[20,,IPCDAT]	;SHOULD PUT CORRECT LENGTH ON
	MOVEM A,PIDARG+3
	MOVEI A,4		;LENGTH OF DESCRIPTOR
	mOVEi B,PIDARG		;ADDR OF DESCRIPTOR
	MSEND
	 JRST [	MOVEI A,^D1000
		DISMS
		SOJGE C,SNDCT1
		JRST .+1]
	POP P,C
	POP P,B
	POP P,A
   >
	POPJ P,0
HEXIN:	ILDB C,0(P)		;SKIP THE "X". UPDATE START OF NUMBER
	MOVE BP,0(P)		; ..
HEXINL:	CAIL C,"A"+40		;LOWER CASE LETTER?
	CAILE C,"Z"+40		; ..
	SKIPA			;NO
	TRZ C,40		;YES. MAKE UPPER CASE
	CAIL C,"A"		;NOW, IS IT A HEX DIGIT-LETTER?
	CAILE C,"F"		; ..
	SKIPA			;NO
	SUBI C,"A"-"9"-1	;YES. SQUUNCH DOWN TO DIGITS
	CAIL C,"0"		;DIGIT (INCLUDING A-F)?
	CAILE C,"0"+17		; ..
	JRST RADIXX		;NO
	LSH A,4			;YES. ACCUMULATE NUMBER
	ADDI A,-"0"(C)		; ..
	ILDB C,BP		;ON TO NEXT CHARACTER
	JRST HEXINL		;CONTINUE TILL BREAK CHARACTER

RADIXX:	CAME BP,0(P)		;ANY DIGITS SEEN AT ALL?
	AOS -1(P)		;YES. SKIP RETURN
	POP P,(P)		;DISCARD STARTING BYTE POINTER
	POPJ P,0		; ..
.ORG ; TO HIGH SEGMENT

ZCWD:				;CHANGE WORKING DIRECTORY
ZXCWD:	PUSHJ P,SST		;DOWN TO THE ARGUMENT
	MOVX A,RC%EMO		;EXACT MATCH ONLY
	MOVE B,SBP		;POINTER TO ARGUMENT
	PUSHJ P,.RCDIR		;#2 See if it exists
	TXNE A,<RC%NOM!RC%AMB>	;DOES IT EXIST
	JRST XCWD1		;NO
	MOVE B,C		;IT DOES. JUST DIRECTORY NUMBER
	MOVEM B,$CWD		; SAVE IT IN CASE PASSWORD FOLLOWS
	MOVEI A,400000		;GET CURRENT CAPS
	RPCAP
	PUSH P,B		;SAVE THEM
	PUSH P,C		; ..
	SETO C,			;ENABLE FOR THE ACCES
	EPCAP			; ..
	MOVE A,$CWD		;SEE IF CAN DO A ACCES TO IT
	MOVEM A,$ACCES		;PUT IN ARGUMENT BLOCK
	MOVEI B,0		;WITHOUT A PASSWORD
	MOVEM B,$ACCES+1	;PUT IN ARGUMENT BLOCK
	PUSHJ P,.ACCES		;#2 Attempt the requested access
	 JRST XCWD2		;#2  failed
	POP P,C			;YES, RESTORE CAPS
	POP P,B
	MOVEI A,400000
	EPCAP			; ..
	JRST CWDOK		;SEND SUCCESS MESSAGE

XCWD2:	POP P,C			;ACCES FAILED.
	POP P,B			; ..
	PUSH P,A		;#13 Save the error code
	MOVEI A,400000		;RESTORE CAPS
	EPCAP
	POP P,A			;#13 
	JRST CWDER		;#13 Let user know of failure

XCWD1:	JSP B,RPCRLP
	ASCIZ /431 No such directory - CWD./
;SOCK COMMAND

ZSOCK:	SETOM $HOST		;DEFAULT HOST
	PUSHJ P,DECIN1		;DECIMAL NUMBER ARGUMENT
	  JRST SOCKX1		;SYNTAX ERROR
	CAIE C,","		;HOST NUMBER?
	JRST SOCK01		;NO.
	TLNE A,740000		;#1 Legal host number?
	JRST SOCKX2		;NO.
	MOVEM A,$HOST		;YES. SAVE IT.
	PUSHJ P,DECIN1		;AND GET SOCKET NUMBER
	  JRST SOCKX1		;HAS TO BE ONE. DEFAULT NOT ALLOWED.
SOCK01:	CAIE C,0		;END OF LINE NOW?
	JRST SOCKX1		;NO. ERROR.
	TLNE A,740000		;LEGAL NUMBER?
	JRST SOCKX3		;NO.
	MOVEM A,$SOCK		;YES. SAVE IT.
	HRROI B,SOCKM1		;SUCCESS MESSAGE
	JRST RPCRLP		;AND RETURN TO COMMAND LOOP

SOCKX1:	HRROI B,SOCKM2		;HERE IF EOL NOT AT RIGHT PLACE
	JRST SOCKXX
SOCKX2:	HRROI B,SOCKM3		;HERE ON BAD HOST NUMBER
	JRST SOCKXX
SOCKX3:	HRROI B,SOCKM4		;HERE ON BAD SOCKET NUMBER (OVER 2**32)
SOCKXX:	SETOM $SOCK		;CLEAR TO DEFAULTS
	SETOM $HOST		; ..
	JRST RPCRLP		;REPLY

SOCKM1:	ASCIZ /200 Socket command accepted./
SOCKM2:	ASCIZ /501 Syntax error in SOCK command./
SOCKM3:	ASCIZ /503 Host number out of range./ ;#1 
SOCKM4:	ASCIZ /503 Socket number out of range./
;COMMANDS NOT YET FULLY IMPLEMENTED.

;ABOR

ZABOR:	TLNE F,L.ACTV		;FILE ACTIVITY?
	JRST DOABOR		;YES. ABORT IT
	HRROI B,ABORM1
	JRST RPCRLP
DOABOR:	TLO F,L.ABOR		;CAUSE ABORT TO HAPPEN
	HRROI B,ABORM2		;AND SAY IT WILL
	JRST RPCRLP		;BACK TO TOP.
ABORM1:	ASCIZ /202 ABOR request ignored./
ABORM2:	ASCIZ /200 Abort request noted./
;RETRIEVE COMMAND. FILE FROM SERVER TO USER

ZRETR:	TRZ F,R.TYPX		;ASSUME NOT PAGED MODE
	TLO F,L.SEND		;THIS IS A SEND CONNECTION OF DATA
	SKIPG B,$BYTE		;ANY DECLARED BYTE SIZE?
	MOVEI B,10		;NO. SET IT TO DEFAULT EIGHT-BIT
	MOVEM B,$BYTE		; ..
	SKIPLE $MODE		;SEE IF DEFAULT STREAM MODE.
	JRST RETX0		;NO.
	MOVE C,$TYPE		;SEE IF PAGED TYPE
	CAIE C,TY.XTP		;IS IT PAGED?
	JRST RETR01		;NO, WILL FILTER LATER
	CAIE B,44		;36 BITS AND PAGED?
	JRST RETX0		;NO.
	TRO F,R.TYPX		;IT IS PAGED MODE. REMEMBER IN FLAG.
RETR01:	SKIPLE $STRU		;STRUCTURE MUST BE DEFAULT NON-RECORD
	JRST RETX0
	PUSHJ P,TIMEOK		;UPDATE TIMEOUT
	SETZM TYXSCT		;CLEAR NET SEQUENCE COUNT FOR PAGE MODE
	PUSHJ P,JBKINI		;INITILIZE GTJFN BLOCK
	MOVSI A,100000		;EXISTING FILE FOR READING
	MOVEM A,JBLOCK		;NO DEFAULT VERSION
	MOVEI A,JBLOCK		;ARGUMENT TO LONG GTJFN
	MOVE B,SBP		;POINT TO FILENAME ARG
	GTJFN			;OPEN THE LOCAL FILE
	  JRST RETX1
	MOVEM A,LCLJFN		;SAVE IT
	LDB C,B			;WAS TERMINATOR THE END OF LINE?
	JUMPN C,RETX2		;IF NOT, COMPLAIN
	PUSHJ P,JFNTXT		;STASH FILE NAME IN TXT STORAGE
	TLZ F,L.LDSK!L.RNIL	;CLEAR A COUPLE FLAGS
	MOVE A,LCLJFN		;OK. SEE WHAT TYPE DEVICE IT IS ON
	DVCHR
	HLRZS B			;TYPE FIELD
	ANDI B,777
	CAIN B,15		;IS IT THE NIL:?
	JRST RETNIL		;SPECIAL HANDLING FOR NIL
	CAIN B,0		;DISK?
	TLO F,L.LDSK		;LOCAL DISK FILE.
	SKIPLE P1,$TYPE		;DEFAULT ASCII TYPE?
	JRST RET03		;NO.
	MOVE B,[070000,,200000]	;YES. READ IN 7-BIT BYTES.
	JRST RETOPN		;OPEN THE FILE
RET03:	CAIE P1,TY.L		;LOCAL BYTE?
	JRST RET04		;NO.
	MOVE B,$BYTE		;GET THE CONNECTION BYTE SIZE
	ROT B,-6		;TO BYTE FIELD FOR OPEN
	HRRI B,200000		;AND OPEN FOR READ
	JRST RETOPN		;OPEN IT.

RETNIL:	TLO F,L.RNIL		;FLAG TO PHONY UP A NIL
	JRST RET02		;BYPASS OPENING IT.
RET04:	CAIN P1,TY.XTP		;PAGED TYPE?
	JRST RETOP0		;YES. CHECKING DONE.
	CAIE P1,TY.I		;IMAGE TYPE?
	JRST RETX4		;NO. UNKNOWN TYPE. (IMPOSSIBLE)
	MOVE D,$BYTE		;GET THE BYTE SIZE
	CAIE D,44		;ONLY SUPPORT IMAGE 36 BITS NOW.
	TLNE F,L.LDSK		;EXCEPT OK ON DISK
	SKIPA
	JRST RETX4		;SAY NOT SUPPORTED, IF NOT 36-BITS.
	HRROI B,SLOWM1		;BUT GIVE THE GUY A COMMENT
	CAIE D,44		;THAT IT WILL BE SLOW IF 8 OR 32
	PUSHJ P,SDUMPA		;DUMP ON TELNET SEND
RETOP0:	MOVE B,[440000,,200000]	;OK FOR OPEN.
	JRST RETOPN
RETOPN:	MOVE A,LCLJFN		;GET LOCAL JFN BACK
	PUSH P,B		;SAVE OPEN FLAGS.
	OPENF
	  JRST [POP P,B
		TRON B,1B25	;TRY IT THAWED
		JRST RETOPN
		JRST RETX2]	;ALREADY DID. FAIL.
	POP P,B			;CLEAR STACK
	PUSHJ P,GETFDB		;SET UP THE FDB COPY OF LOCAL FILE
RET02:	PUSHJ P,PREDAT		;SET UP THE DATA CONNECTION
	  JRST RPCRLP		;CAN'T. RETURN REASON.
	TRNN F,R.TYPX		;PAGED MODE?
	JRST RET02B		;NO.
	MOVE A,$BYTE		;YES. MUST BE DISK OR NIL AND 36 BITS
	CAIE A,44		; ..
	JRST RETX0		;NOT 36 BITS
	TLNN F,L.RNIL!L.LDSK	;DISK OR NIL?
	JRST RETXPX		;NO.
RET02B:	MOVE A,REPLYP		;SEND STARTED MSG
	HRROI B,[ASCIZ /250 Retrieve of /]
	SKIPL D,$TYPE		;OR MORE SPECIFIC MESSAGE.
	CAIN D,TY.A		;ASCII TYPE?
	HRROI B,[ASCIZ /250 ASCII retrieve of /]
	CAIN D,TY.I
	HRROI B,[ASCIZ /250 IMAGE retrieve of /]
	PUSHJ P,.SOUT		;#8 
	HRRZ B,LCLJFN		;FILE NAME
	MOVE C,[211110,,040001]	;FORMAT BITS
	JFNS
	HRROI B,[ASCIZ / started.
/]
	PUSHJ P,.SOUT		;#8 
	HRROI A,REPLYM		;SEND IT
	PSOUT
	MOVE A,[440700,,REPLYM]	;AND PREPARE FOR NEXT ONE
	MOVEM A,REPLYP
	SETZM REPLYM		; ..
;FALL THRU
;FALLS THRU FROM ABOVE
RET2A:	TLNE F,L.LDSK		;LOCAL FILE A DISK?
	JRST RETDSK		;YES.
	TLNE F,L.RNIL		;NIL FILE?
	JRST RETNL1		;YES.
RETL:	MOVE A,LCLJFN		;GET SOME INPUT
	BIN
	JUMPN B,RETNN
	GTSTS
	TLNE B,1000
	  JRST RETEOF
	MOVEI B,0
RETNN:	MOVE A,DATJFN
	BOUT
	PUSHJ P,TIMEOK		;WASTEFUL, EVERY BYTE, BUT...
	MOVE A,$BYTE		;CURRENT BYTE SIZE
	ADDM A,TSBITS		;ADD TO TOTAL SENT BITS
	JRST RETL

RETNL1:	SETO A,			;FREE UP THE WINDOW PAGE
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
	MOVE A,$BYTE		;GET THE BYTE SIZE
	CAILE A,10		;10 OR DEFAULT?
	JRST RETNL2		;NO, 32 OR 36.
	MOVE A,[BYTE (8)377,0,377,0]
	MOVEM A,WINDOW		;ALTERNATING BYTES
	MOVE A,[WINDOW,,WINDOW+1]
	BLT A,WINDOW+777	;WHOLE PAGE OF THEM
	JRST RETNL3
RETNL2:	MOVSI D,-1000		;SET UP A PAGE OF -1 AND 0
	SETZ A,
	SETCAB A,WINDOW(D)	; ..
	AOBJN D,.-1		;WHOLE PAGE
RETNL3:	MOVE P1,$BYTE		;BYTE SIZE
	CAIG P1,10		;HANDLE DEFAULT
	MOVEI P1,10
	MOVEI P2,1000		;NUMBER OF BYTES IN A PAGE
	CAIN P1,10		;UNLESS 4 PER WORD,
	MOVEI P2,4000		;THIS NUMBER PER PAGE
	MOVE T1,[^D1000000]	;A MILLION BITS
	IDIVI T1,(P1)		;IS THIS MANY BYTES
	SKIPE T2		;PARTIAL WORD?
	ADDI T1,1		;YES. (36 BITS)
	MOVE BP,P1		;NOW BUILD BYTE POINTER
	ROT BP,-14
	HRRI BP,WINDOW-1	; ..
	MOVEI P1,(T1)		;NUMBER OF BYTES
	MOVEM P1,FDBBLK+12	;SAVE LENGTH FOR EOF
RETNLL:	MOVE A,DATJFN		;SEND CONNECTION
	MOVE B,BP		;STARTING POINTER
	MOVNI C,(P1)		;NUMBER OF BYTES LEFT IN MEGABIT
	CAILE P1,(P2)		;THIS MAKE A MILLION?
	MOVNI C,(P2)		;NO, SEND A WHOLE PAGE
	MOVN T2,C		;PLUS THIS BUNCH OF WORDS
	IMUL T2,$BYTE		;THIS MANY BITS
	ADDM T2,TSBITS		;ADD TO TOTAL SENT BITS
	ADD P1,C		;UPDATE HOW MANY TO GO
	SOUT			;SEND THIS BUNCH
	JUMPG P1,RETNLL		;IF MORE TO GO, SEND MORE.
				;NO MORE IF FALL THRU. CLOSE FILE.
	TRNN F,R.TYPX		;PAGED TYPE?
	JRST RETEOF		;NO, JUST CLOSE.
	MOVE A,[400100,,31]	;MAKE UP A PHONY FDB FOR THE NIL FILE
	MOVEM A,FDBBLK		; ..
	MOVSI A,(1B0)		;CALL IT A TEMP FILE
	MOVEM A,FDBBLK+1
	SETZM FDBBLK+2
	MOVE A,[FDBBLK+2,,FDBBLK+3]
	MOVE B,FDBBLK+12	;PRESERVE LENGTH
	BLT A,FDBBLK+30		;CLEAR REST
	MOVEM B,FDBBLK+12	;RESTORE LENGTH
	MOVSI A,(5B2)		;MAKE A PROTECTION
	HRRI A,770000		; ..
	MOVEM A,FDBBLK+4	; ..
	MOVE A,$BYTE
	LSH A,30		;BYTE SIZE IN B6-B11
	MOVEM A,FDBBLK+11	; ..
	PUSHJ P,RETPEF
	JRST RETEOF		;END OF THE NIL FILE
RETEOF:	MOVEI B,21		;SEND PARTIAL BUFFER
	SKIPL A,DATJFN
	MTOPR			; ..
	JSP X,RETXX		;TYPE FOLLOWING MSG, CLOSE JFN'S.
MESS99:	ASCIZ /252 Transfer completed./

RETXPX:	JSP X,RETXX
	ASCIZ /457 Paged transfer requested, but not on DSK or NIL./
RETX0:	HRROI X,RET506
	JRST RETXX		;CLOSE UP AND RETURN
STO506:
RET506:	ASCIZ /457 Parameter combination illegal or unimplemented./

RETX4:	MOVEI X,RET506
	JRST RETXX		;ERROR AND CLOSE.
RETX1:
RETX2:	MOVEI X,RETLUZ		;ERROR MESSAGE
	JRST RETXX
RETX3:	MOVEI X,ACCESM		;ACCESS DENIED MESSAGE
	JRST RETXX		;#14 

RETLUZ:	ASCIZ /450 File not found./
ACCESM:	ASCIZ /451 You do not have access for that file operation./
;DISK RETRIEVE ROUTINE.

RETDSK:	TRNE F,R.TYPX		;PAGED TRANSFER MODE?
	JRST RETDPG		;YES.
	LDB D,[POINT 6,FDBBLK+11,11]	;FILE BYTE SIZE
	MOVEI C,44		;FIND BYTES PER WORD
	SKIPE D			;IN CASE OF JUNK
	IDIVI C,(D)		; ..
	MOVE A,FDBBLK+12	;BYTES PER THIS FILE
	IDIV A,C		;WORDS PER THIS FILE
	SKIPE B			;PARTIAL WORD?
	ADDI A,1		;YES. COUNT IT.
	MOVEM A,LWORDS		;WORDS IN THE LOCAL FILE, IF ALL SEQ
	SETOM WINDPN		;SCAN TO SEE IF ANY HOLES
RETDL2:	AOS A,WINDPN		;A PAGE TO CHECK
	HRL A,LCLJFN		;IN THIS FILE
	RPACS			;SEE IF ITS THERE
	TLNE B,(1B5)		;EXIST?
	JRST RETDL2		;YES. LOOK ONWARD.
	FFUFP			;SEE IF ANY PAGES ARE USED BEYOND HERE.
	  JRST RETD00		;NO. SIMPLE SEQUENTIAL FILE.
	MOVSI D,(1B1)		;YES. MAKE LENGTH BE INFINITE, USE
	MOVEM D,LWORDS		; OTHER TEST FOR END.
RETD00:	SETZM WINDPN		;PAGE NUMBER FOR FILE WINDOW
RETDL:	MOVS A,LCLJFN		;LOCAL FILE
	HRR A,WINDPN		;PAGE IN IT
	MOVE B,LWORDS		;LOCAL WORDS IN FILE
	LSH B,-11		;PAGES IN FILE
	CAMGE B,WINDPN		;PAST LAST PAGE?
	JRST RETEOF		;YES, END OF FILE.
	RPACS			;PAGE ACCESS BITS
	TLNE B,(1B5)		;PAGE EXIST?
	JRST RETD01		;YES. SEND IT.
	FFUFP			;SEE IF ANY MORE PAGES BEYOND.
	  JRST RETEOF		;NO. END OF FILE.
	SETO A,			;YES. PRETEND THIS HOLE WAS A PAGE OF 0.
RETD01:	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,(1B2)		;MAP IN THE PAGE
	PMAP
RETD02:	MOVE D,LWORDS		;LOCAL WORDS IN FILE
	LSH D,-11		;PAGES
	MOVE C,LWORDS		;WHOLE WORDS AGAIN
	ANDI C,777		;PARTIAL PAGE
	CAMLE D,WINDPN		;TO LAST PAGE YET?
	MOVEI C,1000		;NO. USE WHOLE PAGE
	MOVNS C			;- NUMBER OF WORDS
	MOVE A,LCLJFN		;FIND BYTE SIZE
	RFBSZ			;DECIDED ON EARLIER
	 JFCL			;ERROR RETURN
	CAIN B,7		;FIVE PER WORD?
	IMULI C,5
	CAIN B,10		;FOUR PER WORD?
	IMULI C,4
	ROT B,-14		;BYTE SIZE FOR SOUT BYTE PTR
	IOR B,[440000,,WINDOW]	;POINTER FOR SOUT
	MOVE T1,$TYPE		;SEE IF IT IS IMAGE MODE
	CAIN T1,TY.I		; ..
	JRST RETIMG		; YES.
RETD03:	MOVE A,DATJFN		;SINK FOR SOUT
	MOVE T2,$BYTE		;BYTE SIZE
	IMUL T2,C		;MINUS NUMBER OF BITS BEING SENT
	MOVNS T2		;PLUS THAT MANY
	ADDM T2,TSBITS		;ADD TO TOTAL SENT BIT COUNT
	SOUT
	AOS WINDPN		;COUNT TO NEXT PAGE
	PUSHJ P,TIMEOK		;UPDATE TIMER
	JRST RETDL		;NEXT PAGE, IF ANY.
RETIMG:	MOVE T2,$BYTE		;IS IT 36 BIT IMAGE?
	CAIN T2,44
	JRST RETD03		;YES. TREAT SIMPLY.
	PUSH P,C		;NO. HAVE TO SHUFFLE DATA AROUND
	MOVSI A,-1000		;COUNT THRU A PAGE OF DATA
	MOVSI B,-10		;EIGHT STATE COUNTER
	MOVE C,[-2000,,WINDW2-1] ;DESTINATION
RETIM1:	MOVE T1,WINDOW(A)	;GET 36 BITS
	AOBJN C,.+1		;DESTINATION UP BY 1
	TRNN B,-1		;EVERY 8 PASSES, COUNT ANOTHER OUTPUT WD
	  AOBJN C,.+1
	LSHC T1,@IMISHT(B)	;SHIFT RIGHT INTO T2
	DPB T1,IMIPT1(B)	;STORE THE LEFT PART
	MOVEM T2,0(C)		;AND THE RIGHT PART INTO NEXT WORD
	AOBJN B,.+2		;STEP THE COUNT-TO-8 COUNTER
	  MOVSI B,-10		;RESTART IT
	AOBJN A,RETIM1		;PROCESS WHOLE PAGE THIS WAY
	POP P,C			;GET BACK NUMBER OF BYTES TO SEND
	IMULI C,11		;NINE EIGHTHS
	ASH C,-3		; ..
	MOVE B,$BYTE		;GET THE BYTE SIZE
	CAIG B,10		;WORDS OR BYTES?
	ASH C,2			;BYTES. FOUR TIMES THAT.
	LSH B,30		;TO PLACE IT GOES IN BYTE PTR
	IOR B,[440000,,WINDW2]	;POINTER TO TRANSLATED DATA
	JRST RETD03		;GO SEND IT FROM SECOND WINDOW

IMISHT:	REPEAT 10,<	XWD 0,-4*<.-IMISHT+1>>
IMIPT1:	REPEAT 10,<	POINT ^D<32-<4*<.-IMIPT1>>>,-1(C),31>
RETDPG:	SETOM WINDPN		;START AT PAGE 0
RETDP1:	AOS A,WINDPN		;PAGE TO CONSIDER
RETDP3:	HRRZM A,PAGNO		;STORE FILE PAGE NUMBER FOR NET
	HRL A,LCLJFN		;SEE IF PAGE IS THERE
	RPACS			; ..
	MOVEM B,ACCESS		;SAVE BITS FOR NET
	TLNN B,(1B5)		;PAGE EXIST?
	JRST RETDP2		;NO
	MOVE B,[400000,,<WINDOW/1000>]
	MOVSI C,(1B2)		;YES. MAP IT IN FOR READING
	PMAP			; ..
	SETZM RECTYP		;DATA RECORD
	MOVEI A,1000		;LENGTH IS ONE PAGE
	SKIPN WINDOW-1(A)	;OR LESS
	SOJG A,.-1		; ..
	CAIGE A,2		;MAKE SURE AT LEAST SOME DATA
	MOVEI A,2		;SO LOOPS WORK
	MOVEM A,TYXNDW		;STORE IN HEADER, NUMBER DATA WDS
	PUSHJ P,RETPP1		;OUTPUT IT
	PUSHJ P,TIMEOK		;UPDATE TIMEOUT TIMER
	JRST RETDP1		;ON TO NEXT PAGE

RETDP2:	FFUFP			;THIS PAGE NONEX. ANY MORE?
	  JRST RETDP4		;NO.
	HRRZM A,WINDPN		;YES, HERE IT IS.
	JRST RETDP3		;GO SEND IT.
RETDP4:	PUSHJ P,RETPEF		;OUTPUT THE FILE TRAILER
	JRST RETEOF		;AND GO CLOSE OUT.

RETPEF:	SETZM ACCESS		;END OF FILE. CLEAR THESE OUT.
	SETZM PAGNO		; ..
	MOVNI A,3		;HEADER FOR EOF
	MOVEM A,RECTYP		; ..
	SETO A,			;RELEASE WINDOW
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
	MOVSI A,FDBBLK		;PUT THE FDB IN IT
	HRRI A,WINDOW
	BLT A,WINDOW+24		; ..
	MOVEI A,25		;NUMBER OF DATA WORDS IN FDB
	MOVEM A,TYXNDW		;TO HEADER FOR NET
 ; FALL THRU TO RETPP1
; FALL THRU FROM ABOVE, ALSO CALL HERE.

RETPP1:	AOS A,TYXSCT		;COUNT THE NET SEQ NUMBER
	MOVEM A,SEQNO		;PUT IT IN NET HEADER AREA
	SETZM CHKSUM		;INITIALIZE CHECKSUM
	PUSHJ P,PGCKSM		;CHECKSUM HEADER AND PAGE
	SETCAM A,CHKSUM		;STORE FOR SENDING
	MOVE A,DATJFN		;SEND IT
	MOVEI B,TYXHDN		;SEND LENGTH OF HEADER
	BOUT
	MOVNI C,TYXHDN		;SEND THE HEADER
	MOVE B,[444400,,TYXHED]
	SOUT
	MOVN C,TYXNDW		;AND THE DATA AREA, THIS LONG.
	MOVE B,[444400,,WINDOW]
	SOUT
	POPJ P,0

GETFDB:	SETZM FDBBLK		;CLEAR IT IN CASE NOT DSK
	MOVE A,[FDBBLK,,FDBBLK+1]
	BLT A,FDBBKE		; ..
	MOVE A,LCLJFN		;LOCAL FILE
	MOVSI B,31		;ALL OF FDB
	SKIPN TOPS20		;#2 
	MOVSI B,25		;#2 
	MOVEI C,FDBBLK		;STORE IT HERE
	TLNE F,L.LDSK		;IF DISK,
	GTFDB			;GET THE INFO
	POPJ P,0
PGCKSS:	MOVN B,MLFWST		;LENGTH OF RECEIVED HEADER STASHED HERE.
	HRLZ B,B		;MAKE AOBJN POINTER
	HRRI B,MLFWST+1		;TO REST OF HEADER
	JRST PGCKS1		;COUNT THAT AND ITS DATA

PGCKSM:	MOVSI B,-TYXHDN		;LENGTH OF HEADER ON RETR
	HRRI B,TYXHED		;LOCATION OF HEADER ON RETR
PGCKS1:	MOVEI A,0
	JCRY0 .+1
PGCKL1:	ADD A,0(B)		;CHECKSUM THE HEADER
	JCRY0 [AOJA A,.+1]
	AOBJN B,PGCKL1
	MOVN B,TYXNDW		;NUMBER OF DATA WORDS
	HRLZS B			;AOBJN COUNTER
	JCRY0 .+1
PGCKL2:	ADD A,WINDOW(B)
	JCRY0 [AOJA A,.+1]
	AOBJN B,PGCKL2
	AOJE A,CPOPJ
	SOJA A,CPOPJ
;STORE AND APPEND COMMANDS. FILE FROM REMOTE TO SERVER.

ZSTOR:	TLZA F,L.APPE		;NOT APPEND
ZAPPE:	TLO F,L.APPE		;APPEND. MUCH LIKE STOR.
	TLZ F,L.SEND		;NET CONN IS RECEIVER
	TRZ F,R.TYPX		;ASSUME NOT PAGED MODE
	SETZM TYXSCT		;BUT IF IT IS, START AT SEQ ZERO
	SETZM RECTYP		;IN CASE EOF COMES IN IMMEDIATELY.
	PUSHJ P,PREDAT		;SET UP COMMON PARAMS,
	  JRST RPCRLP		;NO GOOD. MSG IN B.
	SETZM IBITCT		;IMAGE BIT COUNT IS 0
	SKIPG A,$BYTE		;BYTE STILL AT DEFAULT?
	MOVEI A,10		;YES. SET TO REAL SIZE
	MOVEM A,$BYTE		; ..
	SKIPLE B,$MODE		;STREAM MODE?
	JRST STOX0		;NO. UNSUPPORTED.
	MOVE B,$TYPE		;SEE IF PAGED TYPE
	CAIE B,TY.XTP		; ..
	JRST STO00		;  NO
	CAIE A,44		;AND 36 BIT BYTES?
	JRST STOX0		;NO. BAD.
	TLNE F,L.APPE		;YES. STOR, I HOPE.
	JRST STOX0		;NO. CANT APPEND IN PAGE MODE
	TRO F,R.TYPX		;OK. FLAG PAGE MODE IN AC F
STO00:	SKIPLE $STRU		;ONLY FILE STRUCTURED SO FAR.
	JRST STOX0
	PUSHJ P,TIMEOK		;UPDATE TIMEOUT.
	PUSHJ P,JBKINI		;SET UP THE DEFAULT STRINGS IN GTJFN BLK
	MOVSI A,(1B0+1B13)	;OUTPUT USE BIT AND REQUEST BITS BIT
	TLNE F,L.APPE		;UNLESS APPEND, WHENCE
	MOVSI A,(1B13)		;USE CURRENT VERSION IF ANY.
	TLNE F,L.ANON		;IF ANONYMOUS, NO NEW FILES AT ALL.
	MOVSI A,(1B2+1B13)	;SO DON'T DEFAULT TO NEW VERSION
	MOVEM A,JBLOCK		; ..
	MOVEI A,JBLOCK		;ARG TO LONG GTJFN
	MOVE B,SBP		;HIS TEXT STRING
	GTJFN			;GET IT.
	  JRST STOX1		;CAN'T
	HRRZM A,LCLJFN		;STORE THE JFN
	SKIPE JBLOCK+7		;WAS THERE AN ACCOUNT?
	JRST STO01		;YES. MAIN STRING POINTER NOT NEEDED.
STO01:	LDB C,B			;GET THE TERMINATOR
	JUMPN C,STOX2		;JUMP IF NOT EOL
	MOVE A,LCLJFN		;OK. NAME WAS GOOD.
	PUSHJ P,JFNTXT		;STORE THE TEXT STRING FOR FILE NAME
STO01A:	MOVE A,LCLJFN
	DVCHR			;SEE WHAT DEVICE IT'S ON.
	TLNN B,777		;DISK?
	TLOA F,L.LDSK		;YES.
	TLZ F,L.LDSK		;NO
	HLRZ B,B		;CHECK FOR NIL TOO
	ANDI B,777
	CAIN B,15		;NIL DEVICE?
	TLOA F,L.RNIL		;YES
	TLZ F,L.RNIL		;NO
	TRZ F,R.RLPT		;ASSUME NOT TO SPOOLED LPT
	CAIN B,7		;LPT?
	JRST STOLPT		;YES. GO SEE IF SPOOLED
	SKIPLE P1,$TYPE		;TYPE PARAMETER.
	JRST STO03		;NOT ASCII
STOLP1:	MOVSI B,(7B5)		;WRITE 7-BIT BYTES
	JRST STOOPN		;OPEN THE FILE

STOLPT:	TLNE F,L.ANON		;ANONYMOUS LOGIN?
	JRST STOX8		;YES. LET'S NOT HAVE ANONYMOUS LISTINGS
	MOVE B,$BYTE		;FOR NOW, ONLY ALLOW ASCII 8-BIT.
				; THIS SHOULD BE FIXED, THOUGH.
	CAIN B,10		;EIGHT BIT CONN?
	SKIPLE P1,$TYPE		;AND ASCII?
	JRST .+2		;NO.
	JRST STOLP1		;YES. SIMPLE LOOP DOES IT.
STLPX1:	JSP X,STOXX		;ERROR.
ASCIZ /503 TRANSFERS TO LPT MUST BE ASCII, 8-BIT CONNECTIONS./
STO03:	CAIE P1,TY.L		;LOCAL BYTE MODE?
	JRST STO04		;NO.
	MOVE B,$BYTE		;GET THE BYTE SIZE
	ROT B,-6		;TO RIGHT PLACE FOR OPENF
	JRST STOOPN		;OPEN THE FILE

STO04:	CAIN P1,TY.XTP		;PAGED MODE?
	JRST STOOP0		;YES. ALL CHECKED OUT
	CAIE P1,TY.I		;IMAGE TYPE?
	JRST STOX4		;NO. UNIMPLEMENTED.
	MOVE D,$BYTE		;BYTE SIZE
	CAIE D,44		;ONLY 36 BIT IMAGES EXIST FOR NOW.
	TLNE F,L.LDSK!L.RNIL	;EXCEPT ALLOW IT ON DSK AND NIL
	SKIPA
	JRST STOX4
	HRROI B,SLOWM1		;BUT COMPLAIN ABOUT IT.
	CAIE D,44		;IF NOT 36 BIT MODE
	PUSHJ P,SDUMPA		;SEND DOWN TELNET CONN
STOOP0:	MOVSI B,(44B5)		;OK. OPEN TO WRITE IT THAT WAY
	JRST STOOPN		; ..
STOOPN:	HRRI B,100000		;BIT FOR WRITING
	TLNE F,L.APPE		; OR
	HRRI B,020000		;BIT FOR APPENDING
	PUSH P,B		;HOLD THE OPEN BITS
STO02:	POP P,B			;RESTORE OPENF SIZE AND DIRECTION
	MOVE A,LCLJFN		;RESTORE THE JFN
	OPENF			;OPEN ACCORDING TO STUFF IN B
	  JRST STOX2		;CAN'T.
	MOVE A,REPLYP		;OK. TELL USER WE ARE READY TO GO.
	HRROI B,[ASCIZ /250 Store of /]
	TLNE F,L.APPE		;OR APPEND MSG
	HRROI B,[ASCIZ /250 Append to /]
	PUSHJ P,.SOUT		;#8 
	HRRZ B,LCLJFN		;DISK FILE OR WHATEVER
	MOVE C,[211111,,140001]	;BITS FOR FORMAT
	JFNS
	HRROI B,[ASCIZ / started.
/]
	SKIPL D,$TYPE		;OR MORE SPECIFIC MESSAGE
	CAIN D,TY.A		;ASCII?
	HRROI B,[ASCIZ /, ASCII type, started.
/]
	CAIN D,TY.I		;IMAGE?
	HRROI B,[ASCIZ /, Image type, started.
/]
	PUSHJ P,.SOUT		;#8 
	HRROI A,REPLYM		;SEND IT
	PSOUT			;ON TTY
	MOVE A,[440700,,REPLYM]	;PREPARE FOR NEXT REPLY AT COMPLETION
	MOVEM A,REPLYP		; ..
	SETZM REPLYM		; ..
;FALL THRU
;FALLS THRU FROM ABOVE
STO02A:
STOL:	TRNE F,R.TYPX		;PAGED MODE?
	JRST STOTYX		;YES.
	MOVE A,DATJFN		;GET BYTE FROM NET DATA CONNECTION
	MOVE B,$BYTE		;GET BYTE SIZE
	MOVNI C,1000		;ASSUME 36 BIT BYTE
	CAIG B,10		;OR 32 BIT. 8-BIT IS 4 PER WORD
	MOVNI C,4400		; ..
	CAIN B,40		;IF 32 BIT, GET MORE THAN A PAGE, SO
	MOVNI C,1100		;AN EVEN NUMBER OF 36 BIT WDS
	LSH B,30		;MAKE THE SIN POINTER
	HRRI B,WINDOW-1		; ..
	PUSH P,B		;SAVE FOR LATER CONTEMPLATION
	PUSH P,C		;AND THE CHAR COUNT TOO
	SIN			;READ FROM THE NET DATA CONN
STONN:	MOVE A,LCLJFN		;GET LOCAL FILE HANDLE
	RFBSZ			;GET WRITING FILE SIZE
	 JFCL			;ERROR RETURN
	CAME B,$BYTE		;SAME AS NET?
	JUMPN B,STONSS		;NOT SAME SIZE (EXCEPT NIL, SIZE =0)
STON1:	POP P,D			;ORIGINAL COUNT
	POP P,B			;ORIGINAL POINTER
	SUB C,D			;C GETS POS NUMBER WORDS TRANSFERRED
	IMULI C,44		;BITS
	ADDM C,IBITCT		;COUNT THEM
	ADDM C,TRBITS		;ADD TO TOTAL FOR THIS LOGIN
	IDIVI C,44
	MOVNS C			;NOW NEGATIVE
	TLNN F,L.RNIL		;IF NOT NIL,
	SOUT			;SEND THEM.
STOEFQ:	MOVE A,DATJFN		;CHECK FOR END OF FILE
	GTSTS			; ..
	TLNE B,600000		;ERRORS OR CLOSED?
	TLNE B,400		; ..
	JRST STOERR		;ERRORS.
	TLNE B,1000		;EOF?
	JRST STOEOF		; YES.
	PUSHJ P,TIMEOK		;UPDATE TIME.
	JRST STOL		;LOOP TILL CONNECTION CLOSES
;HERE TO READ PAGED MODE FROM NET

STOTYX:	SETO A,			;RELEASE ANY PREVIOUS WINDOW
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
	SKIP WINDOW		;TOUCH IT TO CREATE PRIVATE PAGE.
	MOVE A,DATJFN		;GET FIRST BYTE, SHOULD BE HDR LENGTH
	BIN
	JUMPE B,STXEFQ		;SEE IF EOF, IF ZERO
	MOVEM B,MLFWST		;SAVE IT IN THIS BORROWED SCRATCH AREA
	CAIL B,6		;ALLOW A RANGE FOR GROWTH
	CAILE B,12		;SIX TO TEN SOUNDS FAIR
	JRST STXFER		;FORMAT ERROR
	MOVNI C,0(B)		;READ THAT MUCH HEADER
	MOVE B,[444400,,MLFWST+1] ;IN THIS SAME SCRATCH AREA
	SIN
	JUMPN C,STXFER		;IF DIDN'T GET IT ALL, FORMAT ERR.
	MOVE C,[MLFWST+1,,TYXHED] ;COPY IT TO REAL HEADER
	BLT C,TYXHED+TYXHDN-1	; ..
	MOVE C,TYXNDW		;SEE HOW LONG THE DATA AREA IS
	CAIL C,0
	CAILE C,1000		;UP TO A PAGE
	JRST STXFER		;NO GOOD. FORMAT ERROR
	MOVE B,[444400,,WINDOW]	;READ THE DATA INTO WINDOW
	MOVNI C,(C)
	SKIPE C			;IN CASE DATA AREA EMPTY
	SIN
	JUMPN C,STXFER		;MUST GET IT ALL, ELSE FORMAT ERR
	AOS C,TYXSCT		;CHECK SEQUENCE COUNTER
	CAME C,SEQNO		; ..
	JRST STXSQE		;NO GOOD.
	PUSHJ P,PGCKSS		;CHECKSUM TO A
	JUMPN A,STXCKE		;CHECKSUM ERROR IF NON-ZERO
	TLNE F,L.LDSK		;NOW, IS THIS TO A DISK?
	JRST STXDSK		;YES. GO PAGE IT OUT
	SKIPE RECTYP		;DATA RECORD?
	JRST STOEFQ		;NO. IGNORE IT.
	MOVN C,TYXNDW		;FOR NON-DISK, RETURN TO OLD CODE
	PUSH P,[444400,,WINDOW]	;SET STACK WITH SIN POINTERS
	PUSH P,C
	MOVEI C,0		;AS IF SIN READ WHOLE BLOCK
	JRST STONN		;AND GO PROCESS THE WINDOW.
STXDSK:	MOVN A,RECTYP		;SEE WHAT TYPE IT IS
	JUMPE A,STXDDT		;IF ORDINARY DATA, GO MAP OUT.
	CAIE A,3		;EOF?
	JRST STOEFQ		;NO, IGNORE (FOR EXPANSION)
STXEOF:	MOVE A,TYXNDW		;SEE IF THIS LOOKS LIKE AN FDB
	CAIL A,25
	CAILE A,30
	JRST STXFER		;NO, I DON'T THINK SO.
	MOVSI D,-NFDBMX		;YES. PROCESS STUFF IN FDB
STXEFL:	MOVE A,LCLJFN		;MAKE FDB POINTER
	HRL A,FDMXT1(D)		;OFFSET INTO FDB
	MOVE B,FDMXT2(D)	;MASK FOR IT
	XCT FDMXT3(D)		;HOW TO GET DATUM FOR IT
	CHFDB			;CHANGE THE DATUM
	AOBJN D,STXEFL		;LOOP THRU TABLES
	JRST STOEFQ		;AND GO WRAP IT UP.

FDMXT1:	EXP 1,11,12,24		;WORDS OF FDB TO SET
NFDBMX==.-FDMXT1
FDMXT2:	400001,,0		;TMP AND EPH BITS
	77B11			;BYTE SIZE
	-1			;EOF POINTER
	-1			;USER SETTABLE WORD
FDMXT3:	MOVE C,WINDOW+1
	MOVE C,WINDOW+11
	MOVE C,WINDOW+12
	MOVE C,WINDOW+24

STXDDT:	MOVE A,[400000,,<WINDOW/1000>]	;FROM FORK SPACE (PRIVATE)
	MOVE B,PAGNO		;TO FILE PAGE
	HRL B,LCLJFN		; ..
	MOVSI C,040000		;WRITE ACCESS
	PMAP
	MOVE A,B		;FILE HANDLE
	MOVE B,ACCESS		;SET PAGE ACCESS
	SPACS
	SETO A,0		;FREE THE WINDOW ADDRESS
	MOVE B,[400000,,<WINDOW/1000>]
	MOVEI C,0		;NO COUNT
	PMAP
	JRST STOEFQ		;AND MOVE ON TO NEXT PAGE OR EOF FDB

STXEFQ:	MOVE A,DATJFN		;GOT A ZERO AS FIRST BIN
	GTSTS			;EOF, ERRORS OR CLOSED?
	TLNE B,600000
	TLNE B,400
	JRST STOERR		;ERRORS.
	TLNN B,1000		;EOF?
	JRST STXFER		;NO. FORMAT ERROR.
	MOVN C,RECTYP		;YES. WAS LAST RECORD THE FDB?
	CAIE C,3		; ..
	JRST STXFER		;NO. FORMAT ERROR.
	JRST STOEF1		;YES. CLOSE UP SHOP.
STONSS:	TRNE F,R.RLPT		;TO SPOOLER?
	JRST STSLPT		;YES. STORE SPOOLED LINE PRINTER
	SKIPLE B,$TYPE		;NOT SAME SIZE. ASCII?
	CAIE B,TY.I		;OR LOCAL BYTE
	JRST STON1		;YES. JUST SHIP IT OUT
	PUSH P,C		;NO. IMAGE. HAVE TO SHUFFLE BITS.
	SETZM WINDW2		;CLEAR THE WINDOW
	MOVE A,[WINDW2,,WINDW2+1]
	BLT A,WINDW2+777	; ..
	MOVSI A,-1100		;THIS MANY INPUT BYTES FROM NET
	MOVSI B,-10		;EIGHT STATE COUNTER
	MOVE C,[-1000,,WINDW2]	;DESTINATION IS ONE PAGE HERE
STONSB:	AOBJP A,.+2		;COUNT THRU SOURCE
	MOVE T2,WINDOW(A)	;GET TWO WORDS MAKING UP RESULT
	MOVE T1,WINDOW-1(A)	; ..
	LSH T1,-4		;BUTT THEM TOGETHER
	LSHC T1,@IMOSHT(B)	;MOVE THEM LEFT TO GET 36 GOOD BITS
	MOVEM T1,0(C)		;AND STORE THE GOOD BITS
	AOBJN C,.+1		;COUNT OUTPUT WORDS
	AOBJN B,STONSA		;END OF GROUP OF EIGHT?
	AOBJN A,.+1		;YES. HAVE TO DIDDLE POINTER
	MOVSI B,-10		;AND RESTART STATE COUNTER.
STONSA:	JUMPL A,STONSB		;IF MORE TO GO, LOOP.
	POP P,C			;COUNT LEFT AFTER READ FROM NET
	POP P,D			;COUNT DESIRED FROM NET
	POP P,B			;WHERE STORED FROM NET
	SUB C,D			;COUNT GOTTEN FROM NET
	TLNE B,4000		;4 OR 1 PER WORD?
	LSH C,2			;ONE. MOVE OVER TO BYTES COUNT AT 4/WD
	LSH C,3			;BITS AT 32 PER WORD
	ADDM C,IBITCT		;COUNT BITS
	ADDM C,TRBITS		;ADD TO TOTAL FOR THIS LOGIN
	IDIVI C,44		;WORDS AT 36 BITS PER
	SKIPE D
	ADDI C,1		;PARTIAL WORD
	MOVNS C			; -WORDS TO WRITE ON DISK
	MOVE B,[444400,,WINDW2]	;WHERE THEY ARE IN CORE
STSLP1:	HRRZ A,LCLJFN		;FILE TO WRITE ON
	SOUT			;DO IT
	JRST STOEFQ		;SEE IF DONE

IMOSHT:REPEAT 10,<	EXP <.-IMOSHT+1>*4>
STSLPT:	MOVE B,$BYTE
	CAIN B,10		;EIGHT BIT RECEIVE?
	JRST STON1		;YES. JUST COPY.
	POP P,D			;ORIGINAL COUNT BEFORE SIN
	POP P,B			;ORIGINAL SIN POINTER (UGH!! PUN!!)
	SUB C,D			;POSITIVE WORDS READ
	IMULI C,44		;BITS FOR STATISTICS
	ADDM C,IBITCT
	ADDM C,TRBITS
	IDIVI C,44		;BACK TO WORDS
	IMULI C,5		;NOW CHARACTERS
	MOVNS C			;MINUS FOR SOUT
	MOVE B,[440700,,WINDOW]	;POINTER TO DATA
	JRST STSLP1		;GO SEND IT

STOEOF:	MOVE A,$TYPE		;SEE IF NEED TO SET BIT COUNT
	MOVE B,$BYTE
	CAIE B,44		;WORD SIZED?
	CAIE A,TY.I		;OR NON-IMAGE?
	JRST STOEF1		;YES. OK AS IT IS
	TLNN F,L.LDSK		;ON A DISK FILE?
	JRST STOEF1		;NO
	CLOSK LCLJFN		;HAVE TO DIDDLE UP THE BIT COUNT
	MOVSI B,7700		;THIS FIELD
	MOVSI C,100		;ONE BIT BYTES
	HRRZ A,LCLJFN
	HRLI A,11		;WORD IN FDB
	CHFDB
	MOVE C,IBITCT		;THIS MANY BITS
	SETO B,			;FULL WORD QTY
	HRLI A,12		;THIS WORD
	CHFDB
STOEF1:	HRROI X,MESS99		;DONE MESSAGE
	JRST STOXX		;#14 SEND IT TO USER
STOERR:	HRROI X,STOERM		;ERROR FRM NET
	JRST STOXX		;#14 
STOERM:	ASCIZ /452 Data connection error. File not completed./

STOX0:	HRROI X,STO506		;CANT DO IT
	JRST STOXX
STOX5:	MOVEI X,STACTM		;NO ACCOUNT SPECIFIED
	JRST STOXX
STOX4:	MOVEI X,STO506
	JRST STOXX
STOX8:	MOVEI X,STOANX		;ERROR FOR LPT BY ANONYMOUS
	JRST STOXX
STOX1:
STOX2:	MOVEI X,STOLUZ
	JRST STOXX
STOX3:	MOVEI X,ACCESM
	JRST STOXX		;#14 

STOLUZ:	ASCIZ /450 Can't write such a file./
STACTM:	ASCIZ /433 Account must be supplied to store files. Send ACCT./
SLOWM1:	ASCIZ /050 Image mode is inefficient except in 36 bit bytes.
050 Use TYPE L instead if possible. Proceeding...
/
STXFER:	JSP X,STOXX
ASCIZ /455 Format error in paged data during store./
STXCKE:	JSP X,STOXX
ASCIZ /455 Checksum error in data block from network./
STXSQE:	JSP X,STOXX
ASCIZ /455 Sequence error in data from network./
STOANX:	ASCIZ /450 Anonymous users may not write on LPT./
ZDELE:	SETZM JFNTXS		;NO NAME STRING YET
	PUSHJ P,JBKINI		;SET UP FOR DELETE FILE REQUEST
	MOVSI A,100000		;OLD FILE REQUIRED
	HRRI A,-2		;OLDEST VERSION DEFAULT
	MOVEM A,JBLOCK
	MOVE B,SBP		;USER'S NAME STRING
	MOVEI A,JBLOCK		;POINT TO DATA
	GTJFN
	  JRST DELX1		;NO SUCH FILE
	MOVEM A,LCLJFN
	PUSHJ P,JFNTXT		;STORE TEXT STRING FOR THIS FILENAME
	LDB C,B			;MAKE SURE GOT TO EOL
	JUMPN C,DELX2		;NO. BAD SYNTAX.
	DVCHR			;SEE WHAT THE DEVICE IS
	TLNE B,777		;DISK?
	JRST DELX3		;NO. ERROR.
	HRRZ A,LCLJFN		;JFN
	DELF			;DO THE DELETE
	  JRST DELX4		;CAN'T. ASSUME ACCESS RIGHTS BAD
	SETOM LCLJFN		;JFN RELEASED BY DELF JSYS
DELEOK:	JSP B,DELXX
	ASCIZ /254 Delete completed OK/
DELX1:	JSP B,DELXX
	ASCIZ /450 No such file - DELEte request/
DELX2:	JSP B,DELXX
	ASCIZ /550 Bad name syntax - DELEte request/
DELX3:	JSP B,DELXX
	ASCIZ /506 DELEte only implemented for DISK files/
DELX4:	JSP B,DELXX
	ASCIZ /451 You do not have access rights to delete /
DELXX:	CLOSE LCLJFN
	MOVE A,REPLYP
	TLO B,-1
	PUSHJ P,.SOUT		;#8 
	SKIPN JFNTXS		;A FILE NAME?
	JRST DELXX1		;NO
	HRROI B,[ASCIZ / - file /]
	PUSHJ P,.SOUT		;#8 
	HRROI B,JFNTXS
	PUSHJ P,.SOUT		;#8 
DELXX1:	MOVEM A,REPLYP
	HRROI B,[ASCIZ /./]
	JRST RPCRLP		;RETURN A MESSAGE
ZRNFR:	MOVE B,SBP		;RENAME FROM. JUST COLLECT STRING
	MOVE A,[440700,,$PTHS1]	;WHERE TO STASH IT
	MOVEI D,<5*40>-1	;#8 
	PUSHJ P,.SOUTC		;#8 
	HRROI B,[ASCIZ /200 Rename-from name stored./]
	JRST RPCRLP		;SEND THIS BACK

ZRNTO:	SETOM $PATH1		;NO JFN'S HERE YET
	SETOM $PATH2		; ..
	PUSHJ P,JBKINI
	MOVSI A,600000		;OUTPUT NEW FILE ONLY
	MOVEM A,JBLOCK
	MOVEI A,JBLOCK
	MOVE B,SBP		;POINTER TO USER'S STRING
	GTJFN			;SEE IF THE FILE IS THERE
	  JRST RNMX1		;CANT GET "TO" JFN
	MOVEM A,$PATH2
	PUSHJ P,JBKINI		;OK. TRY THE FROM JFN
	MOVSI A,100000		;OLD FILE ONLY
	MOVEM A,JBLOCK		; ..
	MOVEI A,JBLOCK		;POINT TO PARAMS
	HRROI B,$PTHS1		;STORED FROM RNFR COMMAND
	GTJFN
	  JRST RNMX3		;NOT THERE
	MOVEM A,$PATH1		;STORE JFN
	MOVE B,$PATH2		;OK, GET NEW NAME
	RNAMF			;DO THE RENAME
	  JRST RNAMX5		;CAN'T
	SETOM $PATH1		;GOOD. THIS JFN NOW GONE.
	MOVE A,$PATH2
	PUSHJ P,JFNTXT
	JSP B,RNMXX
	ASCIZ /253 Rename completed OK./
RNMX1:	CAIE A,GJFX20		;ERRORS FOR FILE EXISTS ALREADY
	CAIN A,GJFX27		; ..
	JRST RNMX1A
	JSP B,RNMXX
	ASCIZ /455 Can't get JFN for New file name./
RNMX1A:	JSP B,RNMXX
	ASCIZ /456 "New Name" already exists. Delete it first./
RNMX2:	JSP B,RNMXX
	ASCIZ /451 No access rights to create new file./
RNMX3:	JSP B,RNMXX
	ASCIZ /450 Old named file not found./
RNMX4:	JSP B,RNMXX
	ASCIZ /451 No access rights to delete old filename./
RNMX5:	JSP B,RNMXX
	ASCIZ /455 Rename request unexpectedly failed./
RNMXX:	PUSH P,B
	CLOSE $PATH1
	CLOSE $PATH2
	POP P,B
	TLO B,-1
	JRST RPCRLP
;LIST, NLST AND STAT COMMANDS
;OUTER LEVEL SETS UP FOR DATA OR TELNET CONNECTION, THEN CALLS DOLIST

ZLIST:	TRZA F,R.NLST		;LIST, NOT NLST
ZNLST:	TRO F,R.NLST		;NLST, NOT LIST.
	SKIPG $MODE		;BETTER BE AN ASCII CONNECTION
	SKIPLE $STRU		; ..
	JRST LISTX0		;NOT.
	TLZ F,L.STAT		;TELL DOLIST IT'S A LIST, NOT STAT.
	SETOM $BYTE		;FORCE 8-BIT
	SETOM $TYPE		;ASCII
	TLO F,L.SEND		;SET UP A SEND CONNECTION
	PUSHJ P,PREDAT		;  ..
	  JRST RPCRLP		;NO GOOD.
	HRROI B,[ASCIZ /250 List started.
/]
	PUSHJ P,SDUMPA		;SEND MSG AND DUMP BUFFER TO SJFN
	MOVE A,DATJFN		;WHERE DOLIST SHOULD SEND ANSWERS
	PUSHJ P,DOLIST
LIST02:	MOVE A,DATJFN
	CLOSF			;DONE WITH THE DATA CONNECTION
	  JFCL
	SETOM DATJFN
	HRROI B,MESS99		;252 DONE MESSAGE
	JRST RPCRLP

LISTX0:	HRROI B,[ASCIZ /506 Parameter error in LIST command./]
	JRST RPCRLP

ZSTAT:	TLO F,L.STAT		;TELL DOLIST IT'S A STAT, NOT LIST.
	TRZ F,R.NLST		;OR NLST
	MOVEI A,101		;DATA GOES TO PRIMARY OUTPUT
	PUSHJ P,DOLIST		;DO THE WORK
	JRST GETCOM		;DONE.
;DOLIST IS THE GUTS OF BOTH LIST AND STAT.

DOLIST:	MOVEM A,LSTJFN		;SAVE THE DESTINATION.

REPEAT 0,<
	SKIPE ARGCH		;BLANK ARGUMENT?
	JRST DOLI01		;NO.
	HRROI B,[ASCIZ /100 /]	;PREFIX IF ON TELNET CONNECTION
	MOVEI C,0
	TLNE F,L.STAT		;LIST OR STAT?
	SOUT			;STAT.
	HRROI B,LHSTNM		;TYPE SERVER HOST NAME
	SOUT
	HRROI B,[ASCIZ / FTP Server /]
	SOUT
	HRROI B,VERSTR
	SOUT
	TRO F,R.T1		;PRETEND NEED A CRLF
	JRST DOLIZ1		;OUTPUT CRLF AND 200 REPLY
>
DOLI01:	TLZ F,L.PDIR		;CLEAR FLAGS USED BELOW
	TRZ F,R.T1!R.T2		; ..
	PUSHJ P,JBKINI		;SEE IF HIS STRING MAKES SENSE
	HRROI T1,[ASCIZ /*/]	;SET UP FOR DEFAULTS
	MOVEM T1,JBLOCK+4
	MOVEM T1,JBLOCK+5	;NAME AND EXT
	MOVSI T1,100100		;FLAGS TO ALLOW WILD, OLD FILES
	TRNN F,R.NLST		;UNLESS NLST COMMAND,
	HRRI T1,-3		;"STAR" FOR VERSION DEFAULT
	MOVEM T1,JBLOCK		; ..
	MOVEI A,JBLOCK		;ARG TO GTJFN
	MOVE B,SBP		;POINTER TO USER'S REQUEST
	GTJFN
	  JRST DOLIX1		;NO GOOD
	MOVEM A,LCLJFN		;SAVE IT
	TLNN A,(77B5)		;ANY WILD CARDS?
	JRST DOLINS		;NO STARS
	TLNE A,(70B5)		;WILD DEV OR DIR?
	JRST DOLIX3		;YES. DONT ALLOW WHOLE DUMPS.
	TRNN F,R.NLST		;UNLESS NLST COMMAND,
	TLO F,L.PDIR		;PRINT DIRECTORY NAME FIRST TIME
;FALL THRU
DOLIL1:	PUSHJ P,TIMEOK		;UPDATE TIME KILL.
DOLI04:	MOVE A,LSTJFN		;LIST THE FILE NAME
	HRROI B,[ASCIZ /151 /]	;HEADER.
	MOVEI C,0
	TRON F,R.T1		;NEED A CR. ALREADY STARTED LINE?
	TLNN F,L.STAT		;NO. NEED THE HEADER?
	SKIPA
	SOUT			;NEW LINE AND NEED HEADER
	MOVEI B,","		;SEPARATING VERSIONS ONLY?
	TRNE F,R.T2		; ..
	BOUT			;YES.
	HRRZ B,LCLJFN		;THE FILE NAME TO BE LISTED
	TLZN F,L.PDIR		;WANT DIRECTORY NAME?
	JRST DOLI03		;NOT NOW
	MOVE C,[110000,,1]	;ONLY DIR NAME, PUNCTUATED
	JFNS			;OUTPUT IT
	HRROI B,CRLFM		;FORCE AN END OF LINE HERE.
	MOVEI C,0
	SOUT
	TRZ F,R.T1		;AND SAY NOT STARTED THIS LINE
	JRST DOLI04		;BACK TO PRINT FILE NAME

DOLI03:	MOVE C,[201110,,040001]	;FORMAT
	TRZE F,R.T2		;JUST A NEW VERSION?
	MOVSI C,(1B14)		;YES. JUST PRINT THAT.
	TRNE F,R.NLST		;BUT IF NLST, SEND DIFFERENT FORMAT.
	MOVE C,[211111,,140001]
	JFNS			;PRINT SOMETHING.
DOLIN1:	MOVE A,LCLJFN		;STEP THE HANDLE
	GNJFN			; ..
	  JRST DOLIZ1		;NO MORE.
	TRNE F,R.NLST		;NLIST COMMAND?
	JRST DOLIN2		;YES. ALWAYS SEPARATE LINES.
	TLNN A,16		;JUST VERSION CHANGE?
	JRST DOLI02		;YES.
	TLNE A,(GN%STR!GN%DIR)	;NEW DIRECTORY OR STRUCTURE?
	TLO F,L.PDIR		;YES. WANT TO MENTION IT.
DOLIN2:	HRROI B,CRLFM		;NO. END LINE.
	MOVE A,LSTJFN
	MOVEI C,0
	TRZE F,R.T1		;IF ONE STARTED.
	SOUT
	JRST DOLIL1		;LOOP TO NEXT FILE.

DOLI02:	TRNE F,R.T1		;STARTED A LINE?
	TRO F,R.T2		;YES. THEN EXT IS ALL THAT CHANGES
	JRST DOLIL1		;LOOP
DOLINS:	HRRZ A,LSTJFN		;JUST ONE FILE. NO STARS.
	HRROI B,[ASCIZ /150 /]
	MOVEI C,0
	TLNE F,L.STAT		;CUE NEEDED?
	SOUT			; YES
	HRRZ B,LCLJFN		;GET THE FILE JFN
	MOVE C,[211111,,176011]	;QFD FORMAT
	TRNE F,R.NLST		;BUT IF NLST, SEND DIFFERENT FORMAT.
	MOVE C,[211111,,140001]
	JFNS
	TROA F,R.T1		;SAY NEED CRLF
DOLIZ1:	SETOM LCLJFN		;GNJFN COUNTING OUT RELEASED IT
	MOVE A,LSTJFN
	HRROI B,CRLFM		;OUTPUT EOL IF NEEDED
	MOVEI C,0
	TRZE F,R.T1		; ..
	SOUT
	HRROI B,[ASCIZ /200 End of status.
/]
	TLNE F,L.STAT		;ON TELNET CONN?
	SOUT			;YES. FLAG END.
	POPJ P,0		;RETURN FROM DOLIST

DOLIX1:
DOLIX2:	CLOSE LCLJFN
	HRROI B,[ASCIZ /450 /]	;FILE STATUS
	MOVE A,LSTJFN		;OUTPUT JFN
	MOVEI C,0		; ..
	TLNE F,L.STAT		;NEED CUE?
	SOUT			;YES.
	HRROI B,[ASCIZ /? Not found.
/]
	SOUT
	POPJ P,0

DOLIX3:	HRRZ A,LCLJFN		;CLOSE JFN WHICH HAS TOO MANY STARS
	CLOSF
	  JFCL
	SETOM LCLJFN
	HRROI B,[ASCIZ /451 /]
	MOVE A,LSTJFN
	MOVEI C,0
	TLNE F,L.STAT		;HEADER NEEDED ON TTY CONN?
	SOUT			;YES.
	HRROI B,[ASCIZ /* not allowed for device or directory./]
	SOUT
	POPJ P,0
JBKINI:	SETZM JBLOCK		;SET UP FOR LONG FOR GTJFN
	MOVE A,[JBLOCK,,JBLOCK+1]
	BLT A,EJBLOK		;CLEAR IT FIRST
	MOVSI A,377777		;NO TTY I/O
	HRRI A,377777		; ..
	MOVEM A,JBLOCK+1	; ..
	POPJ P,0		;RETURN

JFNTXT:	PUSH P,A		;PRESERVE AC'S
	PUSH P,B
	PUSH P,C
	SETZM JFNTXS		;CLEAR TEXT STORAGE
	MOVE A,[JFNTXS,,JFNTXS+1]
	BLT A,EJFNTX		; ..
	HRRZ B,-2(P)		;THE JFN
	HRROI A,JFNTXS		;STORE STRING HERE
	MOVE C,[211110,,1]	;FORMAT
	JFNS
	POP P,C
	POP P,B
	POP P,A
	POPJ P,0
;SUBROUTINE CALLED BY COMMANDS WHICH NEED THE DATA CONNECTION.
; PREPARES THE DATA SOCKET, SENDS THE 255 SOCKET REPLY, AND
;THEN OPENS THE CONNECTION.
;SKIP RETURN IF OK, ELSE NON-SKIP WITH ERROR MSG IN B.
;ARGUMENTS ARE L.SEND (FOR DIRECTION) AND THE SOCKET/HOST/BYTE PARAMS

PREDAT:
PRED1:	SKIPGE A,DATJFN		;CONNECTION ALREADY THERE?
	JRST PRED2A		;NO.
	GTSTS			;YES. IS IT THE RIGHT KIND?
	TLNN B,(1B0)		;OPEN?
	JRST PRED2		;NO. FLUSH.
	TLNE F,L.SEND		;YES. RIGHT DIRECTION?
	TLNN B,(1B2)		;SENDING AND OPEN FOR WRITE?
	JRST PRED1A		;NO
	PUSHJ P,PRE255		;YES. SEND SOCKET REPLY,
	JRST PRED3		; AND USE IT AGAIN
PRED1A:	TLNN F,L.SEND		;RECEIVING?
	TLNN B,(1B1)		;AND OPEN FOR READ?
	JRST PRED2		;NO
	PUSHJ P,PRE255		;SEND SOCKET REPLY
	JRST PRED3		;AND USE IT

PRED2:	CLOSF			;GET RID OF OLD CONNECTION
	  JFCL			;IF CAN'T, JUST GET ANOTHER JFN
PRED2A:	SETOM DATJFN		;NO USEFUL OLD CONNECTION
	MOVE A,[440700,,GTJSTR]	;POINTER TO BUILD A NEW SOCKET NAME
	HRROI B,[ASCIZ /NET:2./] ;#8 local socket 2 for read connection
	TLNE F,L.SEND		;#8 
	HRROI B,[ASCIZ /NET:3./] ;#8 local socket 3 for write connection
	PUSHJ P,.SOUT		;#8  (job relative sockets)
;FALL THRU
;FALLS IN FROM ABOVE
PRED2B:	SKIPGE B,$HOST		;FOREIGN HOST SPECIFIED?
	MOVE B,FHSTN		;NO, DEFAULT IS WHERE TELNET IS FROM
	MOVEI C,10
	NOUT
	  PUSHJ P,BOMB
	MOVEI B,"-"		;FLAG FOR SOCKET
	IDPB B,A
	SKIPGE B,$SOCK		;FOREIGN SOCKET SPECIFIED?
	  JRST [MOVE B,FORNS	;NO, GET TELNET CONN SOCKET
		ADDI B,2	;PLUS 2 TO RECEIVE
		TLNN F,L.SEND	;OR IS HE SENDING?
		TROA B,1	;#1 yes, insure odd number
		TRZ B,1		;#1 no, insure even number
		JRST .+1]
	MOVEI C,10		;SOCKET IN OCTAL
	NOUT
	  PUSHJ P,BOMB
	HRROI B,[ASCIZ /;T/]	;JOB-LOCAL SOCKET
	PUSHJ P,.SOUT		;#8 
	PUSHJ P,TIMEOK		;UPDATE TIMER CLOCK
PRED2C:	MOVSI A,1		;NOW TRY TO GET THE SOCKET
	HRROI B,GTJSTR		; ..
	GTJFN
	  JRST PREDX1		;CAN'T?
	MOVEM A,DATJFN		;OK, SAVE THE JFN
	CVSKT			;NOW GET THE SOCKET NUMBER (ABSOLUTE)
	  JRST PREDX2		;CAN'T?
	TLNN F,L.SEND		;MAKE SURE SEX BIT IS RIGHT
	TRZA B,1		; ..
	TRO B,1			;SENDING
	MOVEM B,MYDATS		;SAVE IT
	PUSHJ P,PRE255		;NOW SEND THE 255 REPLY
;FALL THRU AGAIN. THIS IS A BIG STRAIGHT LINE ROUTINE
;FALLS IN FROM ABOVE
PRED2D:	PUSHJ P,TIMEOK		;UPDATE TIMER
	SKIPG B,$BYTE		;GET BYTE SIZE
	MOVEI B,10		;DEFAULT IS 8-BIT
	LSH B,36		;TO OPENF FLAG WORD
	TLNE F,L.SEND		;SEE WHICH WAY TO POINT IT
	TDOA B,[002400,,100000]	;WRITE, BUFFERED SEND
	TRO B,1B19		;READ.
	MOVE A,DATJFN		;NOW DO THE CONNECT
	OPENF			; ..
	  JRST PREDX2		;CAN'T
PRED3:	JRST CPOPJ1		;SUCCESS RETURN FROM PREDAT

PREDX2:	MOVE A,DATJFN		;COULDN'T OPEN OR CVSKT
	RLJFN			;FREE THE JFN
	  JFCL
PREDX1:	SETOM DATJFN		;FLAG NOT THERE
	HRROI A,STRTMP		;BUILD ERROR MSG HERE
	HRROI B,[ASCIZ /454 Data connection failed: /]
	MOVEI C,0
	SOUT
	HRLOI B,400000
	MOVEI C,0
	ERSTR
	  JFCL
	  JFCL
	HRROI B,STRTMP		;POINT TO MSG
	POPJ P,0		;FAIL RETURN

PRE255:	HRROI A,[ASCIZ /255 SOCK /]
	PSOUT			;SEND SERVER SOCKET REPLY IN SPECIFIED
	MOVEI A,101		; FORMAT, OVER TELNET SOCKET
	MOVE B,MYDATS		; ..
	MOVEI C,12		;NETWORK VIRTUAL RADIX
	NOUT
	  PUSHJ P,BOMB
	HRROI A,CRLFM
	PSOUT
	POPJ P,0

.ORG ;BACK TO LOW SEGMENT
;CONSTANTS

DEFINE M1 (A,B) <
IFNDEF Z'A, <Z'A==NOTIMP>
>
KEYMAC

PDP:	IOWD PDLL,PDL		;STACK POINTER
L1PDP:	IOWD PDLL,L1PDL		;LEV 1 PSI STACK
L2PDP:	IOWD PDLL,L2PDL		;LEV 2 PSI STACK
DBUGSW:	0			;NONZERO FOR DEBUGGING
ONCHNS:	770547,,507777		;CHANNELS ON IN PSI SYSTEM
LEVTAB:	RETPC1			;RETURN PC'S
	RETPC2
	RETPC3
CHNTAB:	REPEAT ^D9,<0>		;FIRST TERM PSI GROUP, OV'S
	1,,PDLINT		;PDLOV
	0			;EOF
	2,,IOXINT		;IO DATA ERROR
	2,,QTAINT		;12 QUOTA EXCEEDED
	0			;13 UNDEF FILE INT'S
	0			;14 TIME OF DAY
	1,,INSINT		;15 ILLEG INSTRUCTION INT
	REPEAT 3,<1,,MEMINT>	;16-18 MEMORY ILLEGAL REF'S
	0			;FORK TERM
	1,,FULINT		;20 MACHINE SIZE EXCEEDED
	REPEAT 3,<0>		;TRAP TO USER, NEW PAGE, NOT USED
	2,,TIMINT		;24 TIMING FORK INT
	2,,CTCINT		;25 CONTROL C (OR E IN DEBUG)
	1,,DETINT		;26 DETACH INTERRUPT		;#10 
	REPEAT ^D9,<0>		;UNUSED
IFN <.-44-CHNTAB>,<PRINTX ;CHNTAB NOT 36 LONG>
INFMSG:	1,,1			;MESSAGE TO INFO
	0			;NO COPY
	ASCIZ /[SYSTEM]FTSCTL/	;GET A PID FOR THIS NAME
ENDMSG==.

PRMTBL:	['MAILFN'],,[XWD 10,MAILFN]	;#2 expect ASCIZ /MAIL.TXT.1/, or
					;#2        ASCIZ /MESSAGE.TXT;1/
	['NOMAIL'],,[XWD LCMDIB,CMDIB]	;#2 expect ASCIZ /list/, where 'list'
					;#2  is dir name(s) separated by comma
	0				;#2 

PATCHX=VERSIO			;UPDATE VERSION NUMBER IF PATCHED

PAT:
PATCH:	BLOCK 200		;FOR PATCHING THE BINARY


;END OF ALL CODE. NOW THE LITERALS.

XLIST ;LIT STATEMENT
LIT
LIST

CODTOP:	;THIS IS THE END OF THIS MODULE EXCEPT FOR PRIVATE PAGES

LOC <<.+777>&777000>	;PAGE BOUNDARY FOR PRIVATE AREAS
VARADR==.			;FOR PMAPPING SPACE AWAY

;VARIABLES

TOPS20:	BLOCK 1			;#2 Flag: 1=TOPS20, 0=TENEX
JOBRT:	BLOCK 1			;#2 SYSGT(JOBRT) table info
JOBDIR:	BLOCK 1			;#2 SYSGT(JOBDIR) table info
JOBTTY:	BLOCK 1			;#2 SYSGT(JOBTTY) table info

RETPC1:	BLOCK 1			;RETURN PC'S FOR PSI SYSTEM
RETPC2:	BLOCK 1
RETPC3:	BLOCK 1			; ..
GJINF1:	BLOCK 1			;RESULTS OF GJINF AT START AND LOGIN
GJINF2:	BLOCK 1
GJINF3:	BLOCK 1
GJINF4:	BLOCK 1
KEYWRD:	BLOCK 1			;THE SIXBIT COMMAND VERB
ARGWRD:	BLOCK 1			;THE SIXBIT ARG FOR SOME COMMANDS
PRVKWD:	BLOCK 1			;PREVIOUS KEYWRD, FOR SEQUENCE-
				; DEPENDANT COMMANDS RNTO, PASS
PI1AC:	BLOCK 20		;STORAGE FOR LEV 1 AC'S
PI2AC:	BLOCK 20		;STORAGE FOR LEV 2 AC'S
PDL:	BLOCK PDLL		;SPACE FOR STACK
L1PDL:	BLOCK PDLL		;ANOTHER ON LEV 1 PSI
L2PDL:	BLOCK PDLL		;AND ANOTHER ON LEV 2
LHOSTN:	BLOCK 1			;LOCAL HOST NUMBER IN OCTAL
LHSTNM:	BLOCK 20		;LOCAL HOST NAME IN ASCIZ
$ACCES:	BLOCK 3			;ARGUMENT BLOCK FOR ACCESS JSYS
$USER:	BLOCK 11		;USER NAME TEXT STRING
$PASS:	BLOCK 11		;PASSWORD TEXT STRING
$ACCT:	BLOCK 12		;ACCOUNT WORD OR STRING
$CWD:	BLOCK 1			;DIR NUM OF CWD COMMAND
$BYTE:	BLOCK 1			;BYTE SIZE OF DATA CONNECTION
$SOCK:	BLOCK 1			;SOCKET NUMBER IF SENT BY USER
$HOST:	BLOCK 1			;HOST NUMBER FOR DATA IF SENT BY USER
$TYPE:	BLOCK 1			;TYPE ARGUMENT FROM USER
$MODE:	BLOCK 1			;MODE ARGUMENT FROM USER
$STRU:	BLOCK 1			;STRUCTURE ARGUMENT FROM USER
$PATH1:	BLOCK 1			;JFN FOR RENAME FROM
$PATH2:	BLOCK 1			;JFN FOR RENAME TO
$PTHS1:	BLOCK 40		;STRING SPACE FOR NAME IN RNFR

XRCPSC:	BLOCK 1			;#7 XRCP scheme: 0=none, -1=T, +1=R
XRCPTX:	BLOCK 1			;#7 XRCP saved-text flag: 0=none,
				;#7  -1=collecting, +1=save (LCLJFN=temp file)
ANOPSW:	BLOCK 10		;WHERE TO STORE ANONYMOUS'S PASSWORD 
				; FROM SYSTEM TEXT FILE
USERNM:	BLOCK 1			;USER NUMBER (RCUSR($USER))
PRGJFN:	BLOCK 1			;JFN FROM RMAP OF THIS PROGRAM
USRFCT:	BLOCK 1			;BAD USER NAMES COUNTER
PASFCT:	BLOCK 1			;PASSWORD FAILURE COUNTER
TFORKX:	BLOCK 1			;FORK HANDLE OF TIMING FORK
KTIMET:	BLOCK 1			;TIME WHEN JOB WILL BE KILLED BY
				; TIME OF DAY INTERRUPT
IOXFLG:	BLOCK 1			;FLAG SET BY IO ERR PSI
CTCFLG:	BLOCK 1			;FLAG SET BY ^C PSI
LGOCNT:	BLOCK 1			;COUNTER TO FORCE LOGOUT ON TIME.
CMDIB:	BLOCK LCMDIB		;THE TELNET LINE COLLECTED FROM NET
SBP:	BLOCK 1			;BYTE POINTER AS COMMAND IS SCANNED
REPLYM:	BLOCK LREPLY		;AND ANSWER BEING BUILT FOR REPLY
REPLYP:	BLOCK 1			;POINTER TO REPLY BEING BUILT
NOMAIL:	ASCIZ/PS:<SYSTEM>/	;#12 "No mail" directive:
				;#12  =0 everyone may receive mail
				;#12  >0 nobody may receive mail
				;#12  <0 AOBJN ptr to table who can't
ANODNO:	BLOCK 1			;USER NUMBER OF ANONYMOUS
LCLJFN:	BLOCK 1			;JFN OF LOCAL MAIL FILE, TEMP FILES
IBITCT:	BLOCK 1			;BIT COUNT FOR LOGGING
TSBITS:	BLOCK 1			;BITS SENT IN A RETR

NCPBLK:	BLOCK 20		;#1 GTNCP info block
;      =NCPBLK+.NCIDX		;#1  NCP connection index
 FHSTN= NCPBLK+.NCFHS		;#1  foreign host
 NETLSK=NCPBLK+.NCLSK		;#1  local socket
 FORNS= NCPBLK+.NCFSK		;#1  foreign socket
;      =NCPBLK+.NCFSM		;#1  state of connection
;      =NCPBLK+.NCLNK		;#1  link
;      =NCPBLK+.NCNVT		;#1  NVT, or -1 if none
;      =NCPBLK+.NCSIZ		;#1  byte size of connection
;      =NCPBLK+.NCMSG		;#1  msg allocation
;      =NCPBLK+.NCBAL		;#1  bit allocation
;      =NCPBLK+.NCDAL		;#1  desired allocation
;      =NCPBLK+.NCBTC		;#1  bits transferred
;      =NCPBLK+.NCBPB		;#1  bytes per buffer
;      =NCPBLK+.NCCLK		;#1  time-out countdown
;      =NCPBLK+.NCSTS		;#1  connection status
ONLNPT:	BLOCK 1		;#6 AOBJN ptr into ONLNTB table of TTYs
$OLNTL==10		;#6 Max # of TTYs that XSEN can send to (arbitrary)
ONLNTB:	BLOCK $OLNTL	;#6 Table of TTYs specific user is logged in on.
MSGBPT:	BLOCK 1		;#6 Byte pointer into MSGBUF
MSGLNS:	BLOCK 1		;#6 # lines of text in MSGBUF
MSGCNT:	BLOCK 1		;#6 # chars left in MSGBUF
MLERRC:	BLOCK 1		;#6 Error code returned by WRTSND, else zero.
CHKBLK:	BLOCK 5		;#6 For checking access to maybe login as anonymous

MLUNST:	BLOCK 21		;NAME OF UNKNOWN MAIL ADDRESSEE
ACTACS:	BLOCK 20		;AC STORAGE FOR FORWARDER FORK
STRTMP:	BLOCK 60		;ANOTHER STRING STORAGE SPACE
DATJFN:	BLOCK 1			;DATA CONN JFN IF MLFL
MYDATS:	BLOCK 1			;CVSKT OF MY DATA CONNECTION
GTJSTR:	BLOCK 60		;SPACE TO BUILD A FILENAME STRING
IPCDAT:	BLOCK 100		;DATA AREA FOR MSGS TO/FROM IPCF
PIDARG:	BLOCK 10		;ARG BLOCK FOR IPCF CALLS
CTLPID:	BLOCK 1			;PID OF FTSCTL
MYPID:	BLOCK 1			;PID OF ME
IFRKTM:	BLOCK 1			;TIME METER FOR LOGGING
LOGJFN:	BLOCK 1			;JFN OF LOG FILE FOR PMAPPING MAIL STAT
LSTJFN:	BLOCK 1			;JFN WHERE LIST OR STAT GOES.
MALCPU:	BLOCK 1			;MORE METERING
MAILFN:	ASCIZ/MAIL.TXT.1/	;#2 Mailbox name (i.e. MAIL.TXT.1)
MLFWST:	BLOCK 50		;#5 NAME FOR FORWARDING
LPTSTR:	BLOCK 30		;ARG OF XLPTF COMMAND
MLTIMT:	BLOCK 1			;TEMP FOR GMT TIME COMPUTATION
MLUSR:	BLOCK 1			;DIRECTORY NUMBER OF MAIL RECIPIENT
TRBITS:	BLOCK 1			;BITS RECEIVED IN MAIL
LWORDS:	BLOCK 1			;FILE LENGTH IN WORDS
FDBBLK:	BLOCK 31		;AREA TO HOLD AN FDB
FDBBKE=.-1			;END FOR BLT TO CLEAR
JBLOCK:	BLOCK 11		;ARG BLOCK FOR LONG GJTFN
EJBLOK==.-1
JFNTXS:	BLOCK 60		;TEXT STRING FROM JFNS
EJFNTX==.-1

XSTDIR:	BLOCK 11		;#2 Extra space for .RCDIR/.RCUSR

TYXSCT:	BLOCK 1			;SEQUENCE COUNTER FOR TYPE XTP
;DO NOT SEPARATE THE NEXT FEW. THEY ARE THE "TYPE XTP" HEADER
TYXHED:	BLOCK 0			;TAG THE HEADER AREA
CHKSUM:	BLOCK 1			;CHECKSUM OF THE DATA CHUNK
SEQNO:	BLOCK 1			;SEQUENCE NUMBER OF THE CHUNK
TYXNDW:	BLOCK 1			;NUMBER OF DATA WORDS GOES HERE
PAGNO:	BLOCK 1			;PAGE NUMBER IN DISK FILE
ACCESS:	BLOCK 1			;RPACS ARG FOR DISK FILE
RECTYP:	BLOCK 1			;TYPE OF NET CHUNK
TYXHDN==6			;LENGTH OF THIS HEADER
;END OF UNSEPARABLE STUFF
;NOW THE VARIABLE STORAGE:
VAR

;END OF EVERYTHING

VARTOP:

LOC <<.+777>&777000>

WINDOW:	BLOCK 1000
WINDW2:	BLOCK 1000		;TWO PAGES FOR MAPPING FILES
BLTADR:	BLOCK 1000		;PAGE FOR MAPPING MAILBOX FORWARDER
WINDPN==WINDOW/1000
WND2PN==WINDW2/1000
BLTPAG==BLTADR/1000
MSGBUF:	BLOCK 2000		;#6 Room for collecting message text.
$MBFLN==2000*5			;#6 Max # chars of room in MSGBUF.

IFN .&777,<PRINTX STORAGE NOT ON PAGE BOUNDARIES!!!>

	END GO