Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11l-bm_tops20_v7_0_tsu03_2_of_3 - t20src/smtlis.mac
There are 21 other files named smtlis.mac in the archive. Click here to see a list.
;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1989.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	TITLE	LISTEN	- SMTP Listener
	TWOSEG
	RELOC	400000
;Cloned by MX. Does not return or get killed.

	SEARCH	MACSYM

	EXTERN	DB%VD8,MX%UNQ,MX$VAL,NODNAM,TBL%LO,UF%CLO,UN%ACC
	EXTERN	UF%OPE,UF%WRI,UM%GET,UM%REL,UN%CLO,UN%REA,UN%WRI,SCAN%P
	EXTERN	UN%OPEN,MX$TIM,RELASC,UT%TEX,MXERRS,NMLDIE,LOG

	INTERN	SMTPLI,STRLEN,STRLN

	IP$JAC==400000000000		;Like SC%WHL for TOPS10
	SC%WHL==400000

	FTLOG==0			;NO LOGGING NOW (20 ONLY)

;Offsets into various MX data structures
	.DESTN==3
	.FILSP==1
	.POST==1
	.DONE=2
	.SENDR==2
	.DECNT==1

	.RECNM==0
	.RECTY==1
	.RECLE==2
	.RECTX==3

	.PKTYP==0
	.PKID==1
	.PKSEQ==2
	.PKSTS==3
	.PKRCT==4

;Ac definitions
	F==0
	T1==1
	T2==2
	T3==3
	T4==4
	T5==5
	T6==6
	RCPTPT==7		;LINKED LIST OF RECEIPIENTS
	CONBLK==10		;ADDR OF CONNECT BLOCK
	REQLEN==11		;LENGTH OF REQUEST BLOCK
	REQ==12			;ADDRESS OF REQUEST BLOCK
	 ;DON'T USE 13, RESERVED FOR BLISS
	DECNET==14		;DECNET CHANNEL NUMBER
	 ;15 IS RESERVED FOR BLISS
	VR==16			;POINTER TO VARIABLE SPACE
	P==17

;Object type
	OBJTYP==^D0		;Using name not number

;OFFSETS INTO BLOCK OF INFORMATION AT VR (Local data)
	TXTPTR==0		;POINTER TO LAST LINE READ BUFFER
	TXTLEN==1		;LENGTH OF LAST READ IN TEXT
	FRMPTR==2		;POINTER TO "FROM" BUFFER
	RSPPTR==3		;POINTER TO SPACE FOR RESPONSES
	SCRWRD==4		;SCRATCH FOR ROUTINE RETURNS
	CMDWRD==5		;FIRST 5 CHARS OF INCOMING COMMAND
	TMPPTR==6		;POINTER TO CHAIN OF RECEIPIENTS
	ATPNTR==7		;POINTER TO THE @ IN A "TO" STRING
	ENPNTR==10		;POINTER TO END OF NODENAME
	USPNTR==11		;POINTER TO BEGINNING OF USERNAME
	NXTPTR==12		;POINTER TO NEXT SUBBLOCK TO CREATE
	TXTBLK==13		;TEXT ARG BLOCK FOR UT%TEX
	FILE==14		;FILE NUMBER
	OUTBFR==15		;pointer to output buffer begin
	OUTPNT==16		;pointer into output buffer
	OUTCNT==17		;number of chars left in buffer
	SENDFL==20		;faking SEND, not doing MAIL
	STARTP==21		;Stack pointer at startup
	SAVACL==22		;ac save block
	N%VAR=SAVACL+4+1		;NUMBER OF VARIABLES NEEDED

	NXT==0			;NEXT POINTER FOR RCPT LINKED LIST
			;LH IS LENGTH OF BLOCK, RH IS NEXT BLOCK ADDR (OR 0)


;Constants of merit
	CONLEN==^D64		;SIZE OF DECNET CONNECT BLOCK
	OUTLEN==1000		;NUMBER OF WORDS FOR FILE OUTPUT BUFFER
	MAXREC==1000*^D8*5	;MAX NUMBER OF CHARACTERS WE CAN RECEIVE
	MAXSND==^D1000		;MAX WE WILL SEND, OR EXPECT FOR NON-MESSAGES
	TXBLEN==10		;FOR UT%TXT

;These allow us to format up SMTP responses
	DEFINE	$RSPC(val),<
	 MOVEI	T1,^D val
	 DMOVEM	T1,@TXTBLK(VR)
	 MOVE	T1,[POINT 7,STDSTR]
	 MOVEI	T2,2 >

	DEFINE	$RSPA(ind),<
	 EXTERN	ind
	 MOVE	T2,MXERRS+ind >

	DEFINE	$RSE(val,ind),<
	 $RSPA	(ind)
	 $RSPC	(val) >

	DEFINE	$RSP(val,text),<
	 MOVE	T2,[POINT 7,[ASCIZ `text`]]
	  $RSPC(val) >

	define logger(txt),<
 IFN FTLOG,<
	CALL	[PUSH	P,[ -1,,[ASCIZ/
**********	txt
/]]
		call	logers
		adjsp	p,-1
		RET]
> >
	define logget(addr),<
 IFN FTLOG,<
	CALL	[PUSH	P,addr
		 call	logers
		 adjsp	p,-1
		RET]
> >	



 IFN FTLOG,<
logers:	PUSH	P,T1
	PUSH	P,T2
	MOVX	T1,GJ%SHT+GJ%OLD
	HRROI	T2,[ASCIZ/MX:SMTLIS.LOG/]
	GTJFN%
	 ERJMP	NOLOGR
	MOVX	T2,OF%APP+7B5
	OPENF%
	 ERJMPS	NOLOGX
	PUSH	P,T3
	SETZ	T3,
	move	t2,-4(p)
	sout%
	 erjmps	.+1
	pop	p,T3
nologx:	closf%
	 erjmps	.+1
nologr:	pop	p,t2
	pop	p,t1
	ret
>

	DEFINE GETMEM(size),<
	 %$$==<size>
	 PUSH	P,[%$$]
	 CALL	SVACLI
	 CALL	UM%GET
	 CALL	RSACLI
	 ADJSP	P,-1
	 JUMPE	T1,NOMEME
>
	DEFINE SETADR(whrpnt,size),<
	 MOVEM	T1,whrpnt
	 ADDI	T1,<size>
	  %$$==%$$-<size>
	  IFLE %$$,<PRINTX Not enough memory asked for in SMTLIS>
>

	ALLMEM=< N%VAR+CONLEN+TXBLEN+OUTLEN+<MAXREC/5+1>+3*<MAXSND/5+1> >+1
;Start here
SMTPLI:	GETMEM	(ALLMEM)
	 SETADR	VR,N%VAR		;N%VAR WORDS POINTED TO BY VR
	 SETADR	CONBLK,CONLEN		;CONLEN WORDS POINTED TO BY CONBLK
	 SETADR	TXTBLK(VR), TXBLEN	;TXBLEN WORDS POINTED TO BY TXTBLK(VR)
	HRLI	T1,(POINT 7)		;EVERYTHING BELOW IS A BP
	 SETADR OUTBFR(VR), OUTLEN	;OUTPUT BUFFER
	 SETADR	TXTPTR(VR), MAXREC/5+1	;INPUT FROM DECNET
	 SETADR	FRMPTR(VR), MAXSND/5+1	;FOR PROCESSING FROM, ETC.
	 SETADR RSPPTR(VR), MAXSND/5+1	;FPR BUILDING RESPONSES
	 SETADR TMPPTR(VR), MAXSND/5+1	;STRING HACK SPACE

	SETZB	RCPTPT,FILE(VR)		;NO FILE YET, NO RECPIENTS
	MOVEM	P,STARTP(VR)		;SAVE STARTING STACK POINTER
;Come back here to set up the next connection
GOAGAI:	MOVE	P,STARTP(VR)		;START WITH RIGHT STACK
	SETZM	0(CONBLK)
	MOVSI	T1,(CONBLK)		;SET UP TO CLEAR THE CONNECT BLOCK
	HRRI	T1,1(CONBLK)
	BLT	T1,CONLEN-1(CONBLK)
;	MOVX	T1,OBJTYP		;STORE OBJECT TYPE
;	MOVEM	T1,2(CONBLK)		;..DON'T, IS A 0
;
;SET UP A SOURCE TASK NAME IN CB_TASK
;
	MOVE	T1,[POINT 7,[ASCII /MX-SENDER/]] ;Who we want to hear from
	MOVEM	T1,3(CONBLK)
	MOVEI	T1,^D9			;LENGTH OF ABOVE TASK NAME
	MOVEM	T1,4(CONBLK)
;
;SET UP DESTINATION TASK NAME IN CB_DESCRIPTOR FIELD
;
	MOVE	T1,[POINT 7,[ASCIZ /MX-LISTENER/]] ;Who we are
	MOVEM	T1,15(CONBLK)
	MOVEI	T1,^D11			;LENGTH OF ABOVE TASK NAME
	MOVEM	T1,16(CONBLK)

	PUSH	P,[1]			;CONNECT TYPE 1, DESTINATION
	PUSH	P,CONBLK
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,[0]
	 logger	<Attempting to open a SMTP Receive connection>
	CALL	SVACLI
	CALL	UN%OPEN			;Open the recieving link
	CALL	RSACLI
	ADJSP	P,-5
	SKIPG	DECNET,T1		;OK? STORE RESULTING LINK-ID
	JRST	DIENOW			;FAILED
	 logger	<Opened, sending accept>
	PUSH	P,DECNET		;SET UP TO ACCEPT LINK
	PUSH	P,[0]
	PUSH	P,[0]
	CALL	SVACLI
	CALL	UN%ACCEPT
	CALL	RSACLI
	ADJSP	P,-3
;SAY HELLO
	SETZ	T4,			;BUILD ONLINE MESSAGE
	MOVE	T2,RSPPTR(VR)
	HRROI	T1,[ASCIZ/220 /]	;SMTP PROTOCOL VALUE FOR ONLINE MESSAGE
	CALL	CSTRB
	MOVE	T1,[POINT 7,NODNAM]	;ADD OUR NODENAME
	CALL	CSTRB
	HRROI	T1,[ASCIZ/ Ready
/]					;+<SP>message
	CALL	CSTRB
	CALL	DNTOUT			;WRITE MESSAGE OUT
;Get greeting
GETGRT:	logger	<Waiting for hello message>
	CALL	DCTREA			;WAIT FOR HELLO MESSAGE
	MOVEI	T1,TABLE1		;LOOK ON STATE TABLE 1 FOR REACTION
	CALL	CMDFND			;..
	 JRST	NOHELO			;COMMAND NOT KNOWN
	JRST	(T1)			;KNOWN, DISPATCH

TABLE1:	TLEN1,,TLEN1
	[ASCIZ/HELO/],,GOTHLO		;HELO, ALL SET, ENTER STATE 2
	[ASCIZ/NOOP/],,OKGGRT		;NOOP, FINE, IGNORE
	[ASCIZ/QUIT/],,QUIT		;QUIT, GO START HANGING UP
	[ASCIZ/RSET/],,OKGGRT		;RSET, FINE, IGNORE
	 TLEN1=.-TABLE1-1

;Here to set up for next state 2 command
GOTHLO:	CALL	READY			;CLEAR OUT EVERYTHING
OKCMD:	$RSP	(250,OK)		;SAY LAST COMMAND WAS OK
	 logger	<Sending OK>
RSPCMD:	CALL	SNDRSP			;SEND MESSAGE IN T1
NXTCMD:	CALL	DCTREA			;GET A COMMAND
;TO LOSE TIMING CHECK, COMMENT OUT NEXT 5 LINES
	CALL	SVACLI
	CALL	MX$TIM			;GET # OF SECS TILL SYSTEM GOES DOWN
	CALL	RSACLI
	CAIGE	T1,^D60			;GOT 60 MORE SECONDS?
	JRST	SYSDWN			;NO - CLOSE UP
;END TIMING CHECK
	MOVEI	T1,TABLE2		;LOOK ON TABLE FOR STATE 2 COMMANDS
	CALL	CMDFND
	 JRST	NOCMD			;NOT KNOWN
	JRST	(T1)			;DISPATCH

;What we expect to get once the premilinaries are out of the way
TABLE2:	TLEN2,,TLEN2
	[ASCIZ/DATA/],,DODATA		;DATA, RECEIVE TEXT
	[ASCIZ/HELO/],,GOTHLO		;HELO, TREAT LIKE RSET
	[ASCIZ/MAIL/],,DOFROM		;MAIL, START OF A MAIL TRANSCATION
	[ASCIZ/NOOP/],,OKCMD		;NOOP, OUR FAVORITE
	[ASCIZ/QUIT/],,QUIT		;QUIT, GO END CONVERSATION
	[ASCIZ/RCPT/],,DOTO		;RCPT, ACCEPT (ANOTHER) RECEIPIENT
	[ASCIZ/RSET/],,GOTHLO		;RSET, CLEAR OUT ALL BUFFERS
	[ASCIZ/SEZZ/],,DOSEND		;SEND, DO A SPECIALIZED SEND
	[ASCIZ/SOML/],,DOFROM		;SOML, TREAT LIKE MAIL
	[ASCIZ/VRFY/],,VERIFY		;VRFY, VERIFY A USER
	 TLEN2=.-TABLE2-1

NOCMD:	CALL	WHAT			;Here if we get something we didn't
	JRST	NXTCMD			;Expect. Send back the right 50n.

DOSEND:	SETOM	SENDFL(VR)
	 logger	<Got SEZZ command>
	JRST	DOXXXX
;FROM command
DOFROM:	SETZM	SENDFL(VR)
	 logger	<Got FROM command>
DOXXXX:	MOVE	T1,TXTPTR(VR)
	ADDI	T1,1			;SKIP FIRST 5 CHARS
FNDFRS:	ILDB	T3,T1			;SCAN FOR ":"
	JUMPE	T3,BADCMD		;NEVER SAW IT, BAD
	CAIE	T3,":"
	JRST	FNDFRS			;SCAN SMORE
	MOVE	T2,FRMPTR(VR)		;GOT IT, COPY REST TO FRMPTR(VR)
FROMCP:	ILDB	T3,T1			;COPY REV. PATH WITHOUT <CRLF>
	CAIE	T3,.CHCRT		;STOP ON CR..
	CAIN	T3,.CHLFD		;OR LF
	SETZ	T3,
	IDPB	T3,T2
	JUMPN	T3,FROMCP		;KEEP GOING UNTIL ALL READ
	$RSP	(250,OK for mail)	;RESPOND OK
	JRST	RSPCMD

;Here if we get trash
BADCMD:	$RSE	(501,MG$ARG)
	JRST	RSPCMD

;These routines attempt to verify a username. They measure the provided
; string and pass it to MX$VAL. The return value is MX$VAL's.
VERIUS:	MOVE	T1,TXTPTR(VR)
	ADDI	T1,1
VERIST:	MOVE	T5,T1
	SETZ	T4,
VERCHP:	ILDB	T3,T1
	JUMPE	T3,NOCRVY
	CAIE	T3,.CHCRT
	AOJA	T4,VERCHP
NOCRVY:	JUMPE	T4,BADCMD
	PUSH	P,T4
	PUSH	P,T5
	HRRZ	T1,TMPPTR(VR)
	PUSH	P,T1
	CALL	SVACLI
	CALL	MX$VAL
	CALL	RSACLI
	ADJSP	P,-3
	RET

;The VRFY command comes here. Verify and say "250 <name>" or "Not here"
VERIFY:	CALL	VERIUS
	TRNE	T1,1
	JRST	VEROKR		;USER IS OK
	$RSP	(550,User not known here)
	JRST	RSPCMD
VEROKR:	MOVE	T2,TXTPTR(VR)	;MOVE NAME INTO <NAME@USNODE>
	MOVE	T1,T2		;MAY AS WELL USE SAME STRING SPACE
	ADDI	T1,1		;USERNAME STARTS ONE WORD DOWN
	MOVEI	T3,"<"		;MOVE WEDGY IN
	IDPB	T3,T2
VEROK2:	ILDB	T3,T1		;COPY USERNAME UNTIL <CR> OR NULL
	JUMPE	T3,VEROK3
	CAIN	T3,.CHCRT
	JRST	VEROK3		;OK, ADD @NODENAME
	IDPB	T3,T2
	JRST	VEROK2
VEROK3:	MOVEI	T3,"@"
	IDPB	T3,T2		;@
	MOVE	T1,[POINT 7,NODNAM]
VEROK4:	ILDB	T3,T1		;COPY NODENAME
	JUMPE	T3,VEROK5
	IDPB	T3,T2
	JRST	VEROK4
VEROK5:	MOVEI	T3,">"
	IDPB	T3,T2
	SETZ	T3,
	IDPB	T3,T2		;NULL TERMINATE
	MOVE	T2,TXTPTR(VR)
	$RSPC	(250)		;SAY OK, AND GIVE NAME BACK
	JRST	RSPCMD

;MAIL command
;This is messy
;SMTP allows strings in the form <user@node> or <@node,@node,@node..:user@node>
; user@node is easy, just verify node, and if it is us, verify user
; @node...:user@node is messy.  Toss the first node (it should be us), verify
;  the second one in the list, and pass the rest verbatim.
DOTO:	 logger	<Got MAIL command>
	MOVE	T1,TXTPTR(VR)
	ADDI	T1,1		;SKIP FIRST 5 CHARS ("MAIL ")
	MOVE	T4,TXTLEN(VR)
	SUBI	T4,5		;ACCOUNT FOR 5 CHARS SKIPPED
FNDTOS:	ILDB	T3,T1		;FETCH
	JUMPE	T3,BADCMD	;NULL? BAD COMMAND
	CAIE	T3,"<"		;FIND THE OPEN ANGLE BRACKET
	SOJA	T4,FNDTOS	;NOPE, ANOTHER CHAR GONE
	MOVE	T6,T1		;GOT IT, SAVE POINTER
	IDIVI	T4,5		;HOW MUCH SPACE TO HOLD THIS STRING?
	MOVEI	T4,2(T4)	;LEAVE SOME EXTRA
	PUSH	P,T4		;FETCH THE MEMORY
	CALL	SVACLI
	CALL	UM%GET		;GET ENOUGH MEMORY TO HOLD RCPT STRING & HEADER
	CALL	RSACLI
	ADJSP	P,-1
	JUMPE	T1,STORFL	;NO ROOM? ABORT!
	 logger	<MAIL command has enough memory>
	HRL	RCPTPT,T4	;MAKE LEN,,POINTER TO NEXT BLOCK
	MOVEM	RCPTPT,NXT(T1)	;STORE IN NEW BLOCK
	MOVE	RCPTPT,T1	;LINK IN
	ADD	T1,[POINT 7,1]	;POINT TO STRING DESTINATION
	SETZM	ATPNTR(VR)	;NO "@" YET
	SETZM	USPNTR(VR)	;NO USER NAME YET
	SETZB	T4,ENPNTR(VR)	;NO NODENAME YET, NO FLAGS
CPTOST:	ILDB	T3,T6		;SCAN STRING, PARSING OUT NODENAME, ETC.
	CAIN	T3,">"		;TREAT CLOSE ANGLE AS TERMINATOR
	SETZ	T3,		;..
	JUMPE	T3,CHKTOS	;END OF STRING
	CAIN	T3,"\"		;QUOTING CHAR?
	JRST	LITTOA		;YES, GO HANDLE
	CAIE	T3,"@"		;NODENAME STARTS HERE?
	JRST	LITTOS		;NO, DOING USERNAME
	TRNN	T4,2		;YES, GOT A USERNAME YET?
	TROE	T4,1		;NO, IS THIS FIRST NODENAME?
	JRST	CPFRND		;NOT A FORWARDING REQUEST.
;HERE WE SEE @US,@OTHERSTUFF.  REMOVE "@US,"
TOSSLF:	ILDB	T3,T6		;GOBBLE FIRST NODENAME (IT'S US)
	JUMPE	T3,NOUSER	;ERROR - NO USER OR NODENAME
	CAIE	T3,":"		;LOOK FOR NODENAME TERMINATOR
	CAIN	T3,","		;..
	JRST	CPTOST		;SKIPPED OUR NODENAME, BACK TO SCANNING
	JRST	TOSSLF		;KEEP SCANNING
;HERE IF WE HAVE "USER@NODENAME" REMEMBER WHERE THE "@" IS
CPFRND:	IDPB	T3,T1		;PUT "@" IN
	MOVEM	T1,ATPNTR(VR)	;AND STORE POINTER TO IT
;HERE TO COPY OUT A NODENAME
CPTOND:	ILDB	T3,T6
	CAIN	T3,">"
	SETZ	T3,0
	IDPB	T3,T1		;COPY CHARACTER
	JUMPE	T3,ENDNDS	;END, GO SEE WHAT WE GOT
	CAIE	T3,":"
	CAIN	T3,","		;NODENAME END?
	JRST	ENDNDS		;YES, GO SEE WHAT WE GOT
	JRST	CPTOND		;KEEP COPYING NODENAME
ENDNDS:	MOVEM	T1,ENPNTR(VR)	;STORE POINTER TO END OF NODE
	JUMPE	T3,CHKTOS	;WAS LAST CHAR NULL?
CPBLIN:	ILDB	T3,T6		;NO, COPY REST OF STRING VERBATIM
	IDPB	T3,T1
	JUMPN	T3,CPBLIN
	JRST	CHKTOS		;AND GO DEAL WITH WHAT'S REVELANT TO US
LITTOA:	ILDB	T3,T6		;HERE FOR QUOTED CHAR, FETCH IT
LITTOS:	TRON	T4,2		;HAVE WE STARTED USERNAME ALREADY?
	MOVEM	T1,USPNTR(VR)	;NO, STORE POINTER TO IT
	IDPB	T3,T1		;WRITE USERNAME CHARACTER
	JRST	CPTOST		;GO AGAIN
;DONE PARSING, SEE WHAT WE GOT
CHKTOS:	SKIPN	T1,ATPNTR(VR)	;WAS A NODENAME SEEN?
	JRST	LCLMAL		;NO, JUST A LOCAL USERNAME
	LDB	T3,ENPNTR(VR)	;FETCH CHARACTER THAT ENDS STRING AND SAVE IT
	SETZ	T2,		;PREPARE TO NULL IT
	DPB	T2,ENPNTR(VR)	;..
	PUSH	P,T1		;VALIDE THE NODENAME
	PUSH	P,[1]		;PUSH LOCAL DOMAIN
	PUSH	P,[-1]		;PUSH UNKNOWN DOMAIN
	CALL	SVACLI
	CALL	DB%VD8		;VALID8 NODE
	CALL	RSACLI
	ADJSP	P,-3		;FIX STACK
	DPB	T3,ENPNTR(VR)	;REPAIR STRING
	JUMPL	T1,BADNOD	;UNKNOWN NODE, WE CAN'T DO THIS
	JUMPN	T3,USRNTL	; "," OR ":" FORCE FORWARDING (USER NOT LOCAL)
	JUMPG	T1,USRNTL	;.GT. 0 IF NOT LOCAL, HANDLE AS SUCH
;THE NODE IS LOCAL, LET'S DO THE USERNAME
LCLMAL:	SKIPN	T1,USPNTR(VR)	;POINTER TO USERNAME TO CHECK
	JRST	NOUSER		;NONE GIVEN, COMPLAIN
	SETZ	T2,		;MAKE USERNAME NULL TERMINATED
	DPB	T2,ATPNTR(VR)	;NULL OUT "@"
	CALL	VERIST		;VERIFY USER
	MOVEI	T2,"@"
	DPB	T2,ATPNTR(VR)	;REPAIR STRING
	TRNN	T1,1		;REAL USERNAME?
	JRST	NOUSER		;NO, COMPLAIN
USRNTL:	 logger	<username acceptable>
	JRST	OKCMD		;OK STRING IF NOT LOCAL OR GOOD LOCAL USERNAME

NOUSER:	 logger	<username unacceptable (not local)>
	MOVE	T1,USPNTR(VR)	;NEVER HEARD OF THE BLIGHTER
	$RSPA	(SL$NSU)
	JRST	ERR550
BADNOD:	 logger	<nodename not known>
	MOVE	T1,ATPNTR(VR)	;NEVER HEARD OF THIS NODE
	$RSPA	(SL$NNK)
ERR550:	MOVE	T3,TXTBLK(VR)	;ERROR 550, BAD RECIPIENT
	MOVEM	T1,2(T3)
	MOVEI	T1,^D550
	DMOVEM	T1,(T3)
	MOVEI	T2,3
	HRROI	T1,STDSTI
	PUSH	P,T1
	PUSH	P,T2
	HLRZ	T4,NXT(RCPTPT)	;DELETE THIS RECIPIENT
	PUSH	P,RCPTPT
	PUSH	P,T4
	HRRZ	RCPTPT,NXT(RCPTPT)
	CALL	SVACLI
	CALL	UM%REL
	CALL	RSACLI
	ADJSP	P,-2
	POP	P,T2
	POP	P,T1
	JRST	RSPCMD

;HERE TO CLEAR OUT OLD COMMAND STATES. TOSS OLD RCPT LINKED LIST
; ZERO APPROPRATE VARIABLES, DROP OPEN FILES, ETC.
READY:	 logger	<At READY (clearing out old data)>
	JUMPE	REQ,NOREQK
	PUSH	P,REQ
	PUSH	P,REQLEN
	CALL	UM%REL
	ADJSP	P,-2
	SETZ	REQ,		;NO REQUEST BLOCK
NOREQK:	SKIPN	T1,FILE(VR)	;ANY FILE OPEN?
	JRST	NOFILE
	PUSH	P,T1		;YES, ABORT IT
	PUSH	P,[1]		;ABORT FLAG
	PUSH	P,[0]		;DON'T WANT ERROR STRING
	CALL	SVACLI
	CALL	UF%CLO
	CALL	RSACLI
	ADJSP	P,-3
	SETZM	FILE(VR)	;GONE
NOFILE:	JUMPE	RCPTPT,ENDTOL	;ANY RECPIENTS LEFT?
NXTTOK:	HLRZ	T4,NXT(RCPTPT)	;YES, FETCH LENGTH OF THIS BLOCK
	PUSH	P,RCPTPT	;ARG: ADDRESS
	PUSH	P,T4		;ARG: LENGTH
	HRRZ	RCPTPT,NXT(RCPTPT) ;ADVANCE FOR NEXT BLOCK (OR 0)
	CALL	SVACLI
	CALL	UM%REL		;DELETE BLOCK
	CALL	RSACLI
	ADJSP	P,-2
	JUMPN	RCPTPT,NXTTOK	;DO NEXT IF NOT DONE
ENDTOL:	HRRZ	T1,FRMPTR(VR)	;CLEAR OUT FROM BUFFER
	SETZM	(T1)		;..
	RET			;READY TO START AFRESH

;DATA COMMAND
DODATA:	JUMPN	RCPTPT,DATAST	;ANY RECIPIENTS ON THE LIST?
	$RSP	(554,No legal receivers given)
	JRST	DATANO		;NO, NO GOOD RECIPIENT RECIEVED
DATAST:	MOVE	T1,FRMPTR(VR)	;POINT TO FROM STRING
	 logger	<Got DATA with good previous receivers>
	SKIPE	(T1)		;ANY "FROM"?
	JRST	DATAS1		;OK, GOOD
	$RSP	(554,No MAIL command given)
	JRST	DATANO
	SKIPE	SENDFL(VR)
	JRST	[$RSP (357,Go wild)
		 CALL	SNDRSP	;SEND REQUEST, THIS IS SPECIAL
		 JRST	SENDI2]
;Here to start creating a buffer of information to hand to MX
DATAS1:	CALL	STRLN		;COUNT CHARS REF'D BY T1, TO T4
	IDIVI	T4,5		;HOW MANY WORDS?
	MOVEI	REQLEN,4(T4)	;ANSWER INTO REQLEN, PLUS HEADER
	MOVE	T2,RCPTPT	;NOW ADD SPACE FOR EACH RECPIENT STRING
CNTUP:	HLRZ	T1,NXT(T2)	;GET LENGTH..
	ADDI	REQLEN,4(T1)	;ADDED IN, PLUS HEADER
	HRRZ	T2,NXT(T2)	;GET NEXT BLOCK
	JUMPN	T2,CNTUP	;IF THERE IS ONE
	ADDI	REQLEN,^D20	;ADD SPACE FOR FILE NAME AND HEADERS AND EXTRA
	PUSH	P,REQLEN	;REQUEST THAT MUCH
	CALL	SVACLI
	CALL	UM%GET		;..
	CALL	RSACLI
	ADJSP	P,-1		;..
	SKIPN	REQ,T1		;STORE ADDRESS OF BLOCK IN REQ
	JRST	STORFL		;NO MEMORY
;SET UP 5 WORD BLOCK HEADER
	HRRI	T1,.POST	;First block
	HRLI	T1,.DECNT	;We're a decnet listener
	MOVEM	T1,.PKTYP(REQ)	;NEW COMMAND BUFFER
	SETZM	.PKID(REQ)	;NO ID NUMBER
	SETZM	.PKRCT(REQ)	;NO RECORDS SO FAR
	MOVEI	T1,1
	MOVEM	T1,.PKSEQ(REQ)	;FIRST IN GROUP (OF 1)
	MOVEM	T1,.PKSTS(REQ)	;..
;SET UP FIRST RECORD, FILENAME
	MOVEI	T5,.PKRCT+1(REQ) ;POINT TO FIRST BLOCK
	AOS	T1,.PKRCT(REQ)	;HAVE A NEW RECORD IN THE BLOCK
	MOVEM	T1,.RECNM(T5)	;ADD RECORD NUMBER IN
	MOVEI	T1,.FILSP	;TYPE IS FILESPEC
	MOVEM	T1,.RECTY(T5)	;..

	CALL	SVACLI
	CALL	MX%UNQ		;GENERATE A FILENAME THAT'S UNIQUE
	CALL	RSACLI
	HRLI	T1,(POINT 7)	;RETURNS ADDRESS OF STRING
	MOVEI	T2,(T5)		;POINT TO SUBBLOCK START
	ADD	T2,[POINT 7,.RECTX] ;BUILD BYTE POINTER TO FILENAME SECTION
	PUSH	P,T2		;NOTE! FOR CALL TO UF%OPE BELOW!
	PUSH	P,T1		;SAVE FOR RELASC
	SETZ	T4,		;NEED LENGTH OF THIS STRING
	CALL	CSTRB
	HRRZS	(P)		;REDUCE BP TO ADDRESS
	CALL	SVACLI
	CALL	RELASC		;AND RELEASE STRING CREATED BY MX%UNQ
	CALL	RSACLI
	ADJSP	P,-1		;TOSS SOURCE ADDR OFF STACK
	MOVE	T1,T4		;GET STRING LENGTH INTO T1
	IDIVI	T1,5		;GET STRING LENGTH IN WORDS
	ADDI	T1,3+1		;CORRECT LENGTH, AND ADD IN HEADER LENGTH
	MOVEM	T1,.RECLE(T5)	;AND STORE
	ADDI	T5,(T1)		;UPDATE T5 TO POINT TO NEXT BLOCK TO CREATE
	MOVEM	T5,NXTPTR(VR)	;AND STORE
	PUSH	P,[2]		;WRITE ACCESS (ADDRESS OF NAME ALREADY STACKED)
	PUSH	P,[0]		;NO ERROR BUFFER
	CALL	SVACLI
	CALL	UF%OPE		;OPEN FILE FOR WRITE
	CALL	RSACLI
	ADJSP	P,-3		;REBALANCE STACK
	JUMPLE	T1,STORFA	;CHECK IF OK, COMPLAIN IF NOT
FILEOP:	MOVEM	T1,FILE(VR)	;RECORD FILE NUMBER
	$RSP	(354,Go)
	CALL	SNDRSP		;SAY "OK FOR TEXT"
	 logger	<GO given for DATA>
;BUILD DATA STRUCTURE WHILE WAITING FOR INCOMING MAIL
	MOVE	T5,NXTPTR(VR)
	AOS	T1,.PKRCT(REQ)
	MOVEM	T1,.RECNM(T5)
	MOVEI	T1,.SENDR
	MOVEM	T1,.RECTY(T5)
	MOVE	T1,FRMPTR(VR)		;COPY REVERSE PATH IN
	MOVE	T2,T5			;BUILD POINTER INTO REQ BLOCK
	ADD	T2,[POINT 7,.RECTX]	;..
	SETZ	T4,
	CALL	CSTR			;COPY STRING AND GET LENGTH
	IDIVI	T4,5
	ADDI	T4,3+1			;SIZE OF BLOCK PLUS HEADER
	MOVE	T5,NXTPTR(VR)
	MOVEM	T4,.RECLE(T5)
	ADDI	T5,(T4)			;GET ADDR NEXT BLOCK IN T5
RECPCP:	AOS	T1,.PKRCT(REQ)
	MOVEM	T1,.RECNM(T5)
	MOVEI	T1,.DESTN
	MOVEM	T1,.RECTY(T5)
	MOVE	T2,T5			;BUILD POINTER TO RECEIPIENT NAME
	ADD	T2,[POINT 7,.RECTX]	;..
	MOVE	T1,RCPTPT		;GEN POINTER TO WHERE IT IS NOW
	ADD	T1,[POINT 7,1]		;SKIP HEADER..
	SETZ	T4,
	CALL	CSTR			;COPY IT
	MOVE	T1,T4
	IDIVI	T1,5			;HOW LONG?
	ADDI	T1,3+1			;PLUS HEADER PLUS NULL
	MOVEM	T1,.RECLE(T5)
	ADDI	T5,(T1)			;POINT TO NEXT BLOCK
	PUSH	P,RCPTPT		;TOSS USED RECIPIENT BUFFER
	HLRZ	T1,NXT(RCPTPT)		;..
	PUSH	P,T1			;..
	HRRZ	RCPTPT,NXT(RCPTPT)	;ADVANCE POINTER FOR NEXT TIME
	CALL	SVACLI
	CALL	UM%REL			;ZAP
	CALL	RSACLI
	ADJSP	P,-2
	JUMPN	RCPTPT,RECPCP		;IS THERE MORE?
;SET UP TO READ/PARSE THE MESSAGE AND WRITE IT TO A FILE
;TERMINATE ON A LINE BEGINNING WITH ".<CR><LF>"
;IN HERE, T6 IS -1 IF WE JUST READ A <LF> (OR ARE JUST STARTING),
; AND IS 1 IF WE JUST READ A <LF> FOLLOWED BY "." (NEXT WILL BE "." OR <LF>)
; ANY OTHER TIME WE KEEP IT 0
;TXTLEN(VR) IN THE NUMBER OF CHARACTERS LEFT IN THE READ BUFFER (SET BY DCTREA)
;OUTCNT(VR) IS THE NUMBER OF CHARACTERS WRITTEN INTO OUTBFR
SENDI2:	SETO	T6,			;FLAG: DOT IS MEANINGFUL
	SETZM	TXTLEN(VR)		;EMPTY BUFFER
	 logger	<Initing up for DATA receives>
	JRST	SETOUT			;GO INITIALIZE
;Here, read a line, check for leading ".", and store text or finish
INLOOP:	CALL	DCTREA			;READ A CHUNK OF MESSAGE
	MOVE	T3,TXTPTR(VR)		;FETCH POINTER TO IT
SCAND:	SOSGE	TXTLEN(VR)		;GET A CHARACTER HERE
	JRST	INLOOP			;NONE LEFT, GO REFIL BUFFER
	ILDB	T1,T3			;PICK UP NEXT CHARACTER
	CAIN	T1,.CHLFD		;LF MEANS END OF LINE..
	JRST	FLAGLF			;SO GO FLAG IT AND GO ON
	JUMPGE	T6,DOTIRR		;ARE WE RIGHT AFTER A <LF>?
	CAIE	T1,"."			;YES, IS THIS A DOT?
	JRST	GOWRIT			;NO. CLEAR FLAG AND GO ON
	MOVEI	T6,1			;YES, FLAG "<LF>." AND TOSS LEADING .
	JRST	SCAND			;AND GET NEXT CHARACTER
DOTIRR:	JUMPE	T6,GOWRIN		;NOT AFTER BARE <LF>. AFTER "<LF>."?
	CAIE	T1,.CHCRT		;ALLOW <LF>.<CR> TO TERMINATE
	CAIN	T1,.CHLFD		;ALSO ALLOW <LF>.<LF>, JIC
	JRST	WRISTR			;DONE! GO WRITE THIS LAST BUFFER
GOWRIT:	TDZA	T6,T6			;HERE FOR A MUNDANE CHARACTER WRITE
FLAGLF:	SETO	T6,			;HERE TO FLAG A <LF>
GOWRIN:	IDPB	T1,OUTPNT(VR)		;PUT THE CHARACTER IN THE BUFFER
	AOS	T1,OUTCNT(VR)		;DID WE FILL IT?
	CAIGE	T1,OUTLEN*5-1		;..
	JRST	SCAND			;NO, GET NEXT CHARACTER
;Here if we are dumping our last buffer (T6 .GT. 0) or have a full buffer to
;dump (T6 anything else).
WRISTR:	SKIPE	SENDFL(VR)
	JRST	SENDBR
	PUSH	P,FILE(VR)	;FILE
	PUSH	P,OUTBFR(VR)	;POINTER
	PUSH	P,OUTCNT(VR)	;LENGTH
	PUSH	P,[0]		;NO BUFFER FOR ERROR
	CALL	SVACLI
	CALL	UF%WRI
	CALL	RSACLI
	ADJSP	P,-4
	TRNN	T1,1
	JRST	STORFA		;WRITE ERROR, GO ABORT ALL THIS
SETOUT:	SETZM	OUTCNT(VR)	;BUFFER WRITTEN, RESET IT
	MOVE	T1,OUTBFR(VR)
	MOVEM	T1,OUTPNT(VR)
	JUMPLE	T6,SCAND	;"DONE" FLAG? GO DO MORE IF NOT LIT (.GT. 0)
EOFGOP:	SKIPE	SENDFL(VR)
	JRST	GOTHLO		;FINE, SAY OK
	PUSH	P,FILE(VR)	;CLOSE UP FILE
	PUSH	P,[0]		;CLOSE, NOT ABORT
	PUSH	P,[0]		;DONT WANT AN ERROR STRING
	CALL	SVACLI
	CALL	UF%CLO		;CLOSE IT
	CALL	RSACLI
	ADJSP	P,-3
	SETZM	FILE(VR)	;FILE NOT NOW OPEN
	TRNN	T1,1		;CLOSE OK?
	JRST	STORFA		;NO, SAY FAILURE
;POST DATA AT REQ (LENGTH REQLEN)

	 logger	<All DATA received, calling SCAN%P...>
	PUSH	P,REQ
	PUSH	P,[0]
	PUSH	P,[-1,,[ASCIZ/MX SMTP Listener/]]
	PUSH	P,[SC%WHL!IP$JAC]
	CALL	SVACLI
	CALL	SCAN%P		;CHECK THE PACKET
	CALL	RSACLI
	ADJSP	P,-4

	 logger	<Return from SCAN%P>

	JUMPE	T1,STORFX	;SNH! WE BUILT IT RIGHT!
	MOVE	T1,.PKSTS(REQ)	;POST OK?
	CAIN	T1,.POST	;..
	JRST	GOTHLO		;RETURN OK
	;BAD POST, ASSUME NO MEMORY TO HOLD IT
STORFX:	PUSH	P,SCNP%E
	JRST	STORFQ
SCNP%E:	ASCIZ/	SMTLIS:	Unexpected fail return from SCAN%P/
DSKW%E:	ASCIZ/	SMTLIS:	Can't write incoming mail to disk/
MEME%E:	ASCIZ/	SMTLIS:	Can't get memory to handle incoming mail/
STORFA:	PUSH	P,DSKW%E
	JRST	STORFQ
STORFL:	PUSH	P,MEME%E
;Here if a reasonable request can't be satisfied because of space
; Send a 452, Serious room problem.
;Come with address of complaint string on stack
STORFQ:	PUSH	P,[0]           ;[318]Push a 0 for the "id"
	CALL	LOG
	ADJSP	P,-2            ;[318]Adjust the stack accordingly
	 logger	<STORFL, unable to find memory or disk space, returning 452>
	$RSE	(452,SP$UIE)
DATANO:	CALL	SNDRSP
DATAN1:	CALL	READY
	JRST	NXTCMD

SENDBR:	SETZ	T1,
	IDPB	T1,OUTPNT(VR)	;NULL TERMINATE
	MOVE	T1,RCPTPT
	MOVEI	T1,1(T1)	;POINT AT USERNAME TEXT
	PUSH	P,T1
	PUSH	P,OUTBFR(VR)	;POINTER TO MESSAGE
	CALL	SVACLI
	CALL	BROAD		;SEND IT TO THE TERMINALS
	CALL	RSACLI
	ADJSP	P,-2
	JRST	SETOUT

BROAD:	RET	;FOR NOW

;Here if we get an unexpected command. See if it is in the spec at all,
; or legal but not in this context, or legal in this context but not handled by
; us, and give the right error accordingly. MX's SMTP sender should never allow
; this to get called.
WHAT:	MOVEI	T1,ALLTBL
	CALL	CMDFND		;Is it legal at all?
	 TRNA
	JRST	ERR503		;NOPE
	MOVEI	T1,UNSTBL	;YES, DO WE JUST NOT SUPPORT IT?
	CALL	CMDFND
	 JRST	ERR500
ERR502:	$RSE	(502,MG$UIC)
	JRST	SNDRSP
ERR503:	$RSE	(503,MG$UEC)
	JRST	SNDRSP
ERR500:	$RSE	(500,MG$UNC)
	JRST	SNDRSP


ALLTBL:	ALEN,,ALEN
	[ASCIZ/DATA/],,0
	[ASCIZ/HELO/],,0
	[ASCIZ/MAIL/],,0
	[ASCIZ/NOOP/],,0
	[ASCIZ/QUIT/],,0
	[ASCIZ/RCPT/],,0
	[ASCIZ/RSET/],,0
	[ASCIZ/SOML/],,0
	[ASCIZ/VRFY/],,0
	 ALEN=.-ALLTBL-1

;Unimplemented command
UNSTBL:	ULEN,,ULEN
	[ASCIZ/EXPN/],,0		;WE AREN'T THIS BRIGHT
	[ASCIZ/HELP/],,0		;HELPLESS
	[ASCIZ/SAML/],,0		;WE NEVER DO SEND AND MAIL
	[ASCIZ/SEND/],,0		;WE NEVER DO SEND (THIS WAY)
	[ASCIZ/TURN/],,0		;WE AREN'T THIS BRIGHT
	 ULEN=.-UNSTBL-1

;Here if we know this node is going down real soon. Politely request we hang up.
SYSDWN:	$RSP	(221,This node is going down - please QUIT)
	CALL	SNDRSP
	CALL	DCTREA
	MOVEI	T1,TABLE4		;SEVERELY LIMIT CORRECT RESPONSES
	CALL	CMDFND
	 JRST	SYSDWN			;WRONG, COMPLAIN AGAIN
	JRST	(T1)

;LEGAL RESPONSE TO A '221 SORRY GOING DOWN NOW' MESSAGE
TABLE4:	TLEN4,,TLEN4
	[ASCIZ/QUIT/],,QUIT
	 TLEN4=.-TABLE4-1

;Take the first 4 characters at txtptr and see what command they are.
CMDFND:	MOVE	T2,@TXTPTR(VR)
	LDB	T3,[POINT 7,T2,34]
	CAIE	T3," "		;5TH CHAR MUST BE <SP> OR <CR>
	CAIN	T3,.CHCRT
ACCTAB:	TRZA	T2,377		;OK. MAKE IT <NULL>
	RET			;BAD CHARACTER, NO SKIP RETURN
	MOVEM	T2,CMDWRD(VR)	;STORE 4 SYMBOLS OF COMMAND AND <NULL>
	PUSH	P,T1		;PUSH TABLE ADDRESS
	MOVE	T3,T1		;KEEP TABLE ADDRESS AROUND
	MOVE	T1,[POINT 7,CMDWRD]
	ADD	T1,VR
	PUSH	P,T1		;PUSH BP TO STRING
	MOVEI	T1,SCRWRD(VR)	;PUSH ADDRESS TO RETURN INDEX IN
	PUSH	P,T1		;..
	CALL	SVACLI
	CALL	TBL%LO		;CALL TABLE LOOKUP ROUTINE
	CALL	RSACLI
	ADJSP	P,-3		;TOSS STACKED ARGS
	TRNN	T1,1		;OK MATCH?
	RET			;NO MATCH
	MOVE	T1,SCRWRD(VR)	;INDEX WENT HERE
	ADD	T1,T3
	HRRZ	T1,(T1)		;GET RH OF TARGET WORD
CPOPJ1:	AOS	(P)		;SKIP HOME
	RET

;HERE FROM STATE 1, WAITING FOR THE HELO COMMAND
OKGGRT:	$RSP	(250,Please HELO)
	CALL	SNDRSP
	JRST	GETGRT

;WE EXPECT A HELO AND WERE DISSAPOINTED
NOHELO:	CALL	WHAT
	JRST	GETGRT

;Return a null terminated string starting at TXTPTR(VR)
;On a channel death, dispatch to DIENOW (does not return)
DCTREA:	PUSH	P,DECNET
	PUSH	P,[MAXREC]
	PUSH	P,TXTPTR(VR)
	CALL	SVACLI
	CALL	UN%READ
	CALL	RSACLI
	ADJSP	P,-3
	JUMPE	T1,DCTREA		;NO ONE WANTS A NULL STRING
	JUMPL	T1,DCTERR		;-1 OR -2 IS ERROR
	MOVEM	T1,TXTLEN(VR)
	ADJBP	T1,TXTPTR(VR)		;FORCE NULL TERMINATION
	SETZ	T2,
	IDPB	T2,T1

	 logget	TXTPTR(VR)

	MOVE	T1,TXTLEN(VR)		;RETURN LENGTH
CPOPJ:	RET

DCTERR:	AOJE	T1,TIMOUT		;-1 MEANS TIMED OUT
;ERROR OTHER THAN TIMOUT. ASSUME MESSAGE TOO LONG FOR OUR BUFFER. IF,
; INSTEAD, IT IS AN ABORTED LINK, SNDRSP WILL GO TO TIMOUT
CHOKE:	$RSE	(500,MG$LTL)
	CALL	SNDRSP
	ADJSP	P,-1			;UNDO CALL TO DCTREA
	JRST	DIENOW			;QUIT WHILE WE CAN

;Here with T1/ BP to directive string, T2/ number of args in TXTBLK
; formats and sends string
SNDRSP:	PUSH	P,RSPPTR(VR)
	MOVEI	T3,(P)
	PUSH	P,T3
	PUSH	P,[MAXREC-5]
	TLC	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	PUSH	P,T1
	PUSH	P,T2
	PUSH	P,TXTBLK(VR)
	CALL	SVACLI
	CALL	UT%TEX
	CALL	RSACLI
	ADJSP	P,-6
	SOSG	T4,T1
	JRST	STORFL
	;JRST	DNTOUT
;Needs T4 containing number of bytes to write, and RSPPTR(VR) pointing at
; text to write.  On an error, does not return (goes to DIENOW)
DNTOUT:		logget	RSPPTR(VR)
	PUSH	P,DECNET
	PUSH	P,[1]		;COMPLETE MESSAGE
	PUSH	P,T4
	PUSH	P,RSPPTR(VR)
	CALL	SVACLI
	CALL	UN%WRI
	CALL	RSACLI
	ADJSP	P,-4
	TRNN	T1,1
	JRST	TIMOUT
	RET

;Here when we see a QUIT
QUIT:	$RSP	(221,Closing channel)
	CALL	SNDRSP
	 logger	<Received a QUIT, closing channel real soon>
	JRST	DIENOW
TIMOUT:	 logger	<SINR failed (at TIMOUT)>
DIENOW:	logger	<At DIENOW>
	CALL	READY
;CLOSE DECNET
	JUMPLE	DECNET,NCLOND		;CLOSE IF OPEN
	PUSH	P,DECNET
	PUSH	P,[0]
	PUSH	P,[0]
	CALL	SVACLI
	CALL	UN%CLO
	CALL	RSACLI
	ADJSP	P,-3
NCLOND:
	JRST	GOAGAI			;GO AGAIN, WAIT FOR NEXT CONNECT

;COPY STRING AND END WITH NULL
CSTR:	CALL	CSTRB
	IDPB	T3,T2
	RET

;MEASURE STRING, RETURN COUNT IN T4
STRLEN:	TLCE	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
STRLN:	SETZ	T4,
STRLE1:	ILDB	T3,T1
	CAIE	T3,0
	AOJA	T4,STRLE1
	RET

;COPY STRING, LEAVE POINTER SET FOR APPENDING
CSTRB:	TLCE	T1,-1
	TLCN	T1,-1
	HRLI	T1,(POINT 7)
	TLC	T2,-1
	TLCN	T2,-1
	HRLI	T2,(POINT 7)
CSTRC:	ILDB	T3,T1
	JUMPE	T3,CPOPJ
	IDPB	T3,T2
	AOJA	T4,CSTRC

;SAVE AND RESTORE AC'S FOR BLISS
RSACLI:	DMOVE	T2,SAVACL(VR)
	DMOVE	T4,SAVACL+2(VR)
	RET
SVACLI:	DMOVEM	T2,SAVACL(VR)
	DMOVEM	T4,SAVACL+2(VR)
	RET

NOMEME:	PUSH	P,[POINT 7,[ASCIZ/Out of memory at SMTLIS startup/]]
	CALL	NMLDIE
;NO RETURN

STDSTR:	ASCIZ	!%D %A%/!
STDSTI:	ASCIZ	!%D %I%/!

	END