TITLE SNDMSG - Routines to send local and network TTY messages
	SUBTTL David Eppstein/DE/KSL/MRC/WHP4

	SEARCH MONSYM,MACSYM,SNDDEF
	EXTERN $WAKE
	EXTERN $GTLCL,$RMREL
	ASUPPRESS
	SALL
IFNDEF OT%822,OT%822==:1

; Definitions and Storage

A=:1				;Temporary AC's for JSYS use etc
B=:2
C=:3
D=:4

ADR=10				;Pointer to current address block
ABLOCK=11			;Pointer to argument block

FP=:15				;TRVAR frame pointer
CX=:16				;Scratch for MACREL
P=:17				;Main stack pointer

	BUFLEN==MAXCHR/5	;Length of command buffers (for long msgs)
	PDLEN==100		;Length of pushdown stack

; Macros for returning error strings and codes

DEFINE RETSTR (ERTEXT,ERCODE,OP<JRST>) <
	OP [	HRROI A,[ASCIZ\ERTEXT\]
		MOVX C,ERCODE
		RET ]
>

; Storage allocation

	.PSECT DATPAG		;Paged storage

BUFFER:	BLOCK 1000		;Random text storage etc (must be whole page)
	BUFPAG==BUFFER/1000	;The associated page number

	.ENDPS

	.PSECT CODE		;Rest of this file is pure code

; $SEND - Send a terminal message to multiple recipients
; Call with A/pointer to ASCIZ message text
;	    B/list of recipients to send to
;	    C/argument block
; Returns +1/Failed, A/error string
;		     B/points to failed recipient
;		     C/error code (TTXxxx defined in SNDDEF)
;	  +2/Success, A, B, and C changed
;
; Format of the recipient list:
;	Each recipient block is in the form of a header word possibly
;	followed by some data words.  The format of the header word is
;	RC%TYP,,RC%NXT where RC%TYP is a code for the type of recipient
;	coded for by this block, and RC%NXT is the next recipient.
;	End the list with a 0 RC%NXT field.  Values for RC%TYP are:
;		RC.TTY - Recipient is a local terminal.
;			 Data is the terminal number (without .TTDES)
;		RC.USR - Recipient is a local user - data is user number.
;		RC.ALL - Send to all local users (no data).
;		RC.NET - Send to a net user.  Data are two word-aligned
;			 ASCIZ strings for the user and host names.
;
;	Example: to send to TTY4, FMF, and CSD.KDO@SCORE one might have:
;		RBLOCK:	RC.TTY,,RBLK0
;			4		;TTY 4 (not 400004)
;		RBLK0:	RC.USR,,RBLK1
;			500000,,137	;FMF's user number (use RCUSR%)
;		RBLK1:	RC.NET,,0
;			ASCIZ/CSD.KDO/	;Net user name (CSD.KDO)
;			ASCIZ/SCORE/	;Net host name (SCORE)
;
;
; Format of the argument block:
;	Word 0 (.SDPID): PID for IPCF messages.  Set to zero to make $SEND
;			 create a new PID - it will be filled in if created.
;	Word 1 (.SDFLG): Flags for the IPCF send server.  Defined flags:
;		1B0 (T%USER) - "User program features" like typing the status
;			       of a send to user with multiple ttys
;		1B1 (T%RAFT) - Obey REFUSE SYS after this message
;		1B2 (T%HDR)  - Don't supply a message header (needs WHEEL)
;		1B3 (T%RSYS) - Obey REFUSE SYS always

$SEND::	SAVEAC <D,ADR,ABLOCK,CX> ;Don't mung anything for caller
	TRVAR <MSPTR,QUEJFN>	;Make some pseudo-globals
	SETZM QUEJFN		;So nobody thinks random crud is a JFN
	MKPTR (A)		;Turn into a byte pointer
	MOVEM A,MSPTR		;Get message text pointer
	MOVE ADR,B		;Get address block
	MOVE ABLOCK,C		;Get argument block
	DO.
	  CALL SNDONE		;Send one message
	  IFSKP.
	    MOVE B,.SDFLG(ABLOCK) ;Done, get SNDSRV flags
	    TXZN B,T%RAFT	;Obey REFUSE SYS after that message
	    IFSKP.
	      TXON B,T%RSYS	;Yes, set flag for that
	       MOVEM B,.SDFLG(ABLOCK) ;Save changed flag word
	    ENDIF.
	    LOAD ADR,RC%NXT,(ADR) ;Done, get next
	    JUMPN ADR,TOP.	;And loop back with it
	  ELSE.
	    CALL MQUEUE		;Failed, queue net sends
	    MOVE B,ADR		;Get address block back
	    RET			;And return failure
	  ENDIF.
	ENDDO.
	CALL MQUEUE		;Done, finish queueing net sends
	MOVE A,MSPTR		;Get message text pointer again
	MOVE B,ADR		;Get final value in ADR (should be 0)
	MOVE C,ABLOCK		;Get address block address
	RETSKP			;Return success with them

; Finish queueing net sends

MQUEUE:	SAVEAC <A,B,C>		;Don't mung error code or whatever
	SKIPN QUEJFN		;Are we queueing anything?
	 RET			;No, done already

	;; Finish creating the queued mail file
	HRROI A,BUFFER		;Get buffer back
	FMSG <
Date: >				;Yes, start text
	SETO B,
	MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; RFC 822 standard date/time
	ODTIM%
	FMSG <
From: >
	CALL .DIRST		;Put in my username
	FMSG <@>
	PUSH P,A
	CALL $GTLCL		;Local host name
	IFNSK.
	  POP P,A
	  RETSTR <Couldn't get local host name>,TTXNET
	ENDIF.
	POP P,A
	CALL $RMREL
	MOVE A,QUEJFN
	HRROI B,BUFFER		;Get buffer back
	SETZ C,			;Until null
	SOUT%			;Start making file
	FMSG <

>
	MOVE B,MSPTR		;Get pointer to message text
	SETZ C,			;Ending on null
	SOUT%			;Send it off
	CLOSF%			;Close the file
	 NOP
	CALLRET $WAKE		;Wake up MMailr and return

; SNDONE - Send one message
; returns +1/failure, A and C set up; +2/success

SNDONE:	LOAD A,RC%TYP,(ADR)	;Get send type
	CAIG A,RC.NET		;In range?
	IFSKP.
	  HRROI A,[ASCIZ/Unknown function code/]
	  MOVEI C,TTXUNK	;No, get error string and code
	  RET			;Return failure
	ENDIF.
	CAIN A,RC.NET		;If it's a net send
	 JRST SNDNET		;Then send that way
	JRST SNDLOC		;Else it's a local send

; Here to make error string for JSYS error and return

JSRET:	HRROI A,BUFFER+200	;Use a likely buffer
	HRLOI B,.FHSLF		;With ourself
	MOVEI C,40*5-1		;Number of characters available
	ERSTR%			;Copy error string
	 NOP
	 NOP
	HRROI A,BUFFER+200		;Now point to the string we made
	MOVX C,TTXNET		;Random network error (not called from SNDLOC)
	RET

; Sending a Local Message

SNDLOC:	LOAD A,RC%TYP,(ADR)	;Fetch type of field we parsed
	MOVE A,[ SIXBIT/SNDLIN/
		 SIXBIT/SNDUSR/
		 SIXBIT/SNDALL/ ](A)
	MOVEM A,BUFFER+SN$HDR	;Set up appropriate function code
	MOVE A,1(ADR)		;Retrieve word of data (garbage for SNDALL)
	MOVEM A,BUFFER+SN$DAT	;Set up data
	MOVE A,.SDFLG(ABLOCK)	;Get flags for IPCF
	MOVEM A,BUFFER+SN$FLG	;Set them
	HRROI A,BUFFER+SN$MSG	;Into the appropriate place in the IPCF page
	MOVE B,MSPTR		;From message pointer given to us
	CALL MOVSTR		;Copy the message
	MOVE D,.SDPID(ABLOCK)	;With PID we were given
	CALL DOIPCF		;Go send it off
	IFNSK.
	  MOVEM D,.SDPID(ABLOCK) ;Failed, copy PID back anyway
	  RET			;Give fail return
	ENDIF.
	MOVEM D,.SDPID(ABLOCK)	;Succeeded, copy PID back
	SKIPN BUFFER+SN$HDR	;Header word is -1 on errors
	IFSKP.
	  HRROI A,BUFFER+SN$STR	;Point to error string
	  MOVE C,BUFFER+SN$ERR	;And get error code returned
	  RET			;Return failure
	ENDIF.
	MOVE A,BUFFER+SN$TTY	;Fetch number of terminals sent to
	CAIG A,1		;One or none?
	 RETSKP			;Yes, done (none?? should be error)
	MOVE A,.SDFLG(ABLOCK)	;Get argument flags
	TXNN A,T%USER		;We running a user program?
	 RETSKP			;No, be quiet

	;; Multiple jobs with T%USER set - give status of each
	LOAD A,RC%TYP,(ADR)	;Get address type
	CAIE A,RC.ALL		;Is it to *?
	IFSKP.			;Yes, "* has multiple jobs" is ugly, so:
	  TMSG <Status of system-wide send:
>
	ELSE.
	  MOVX A,.PRIOU		;To the terminal
	  MOVE B,ADR		;With current address
	  CALL $WTRCP		;Write recipient name
	  TMSG < has multiple jobs:
>				;Start message
	ENDIF.
	MOVN D,BUFFER+SN$TTY	;Fetch and negate no. of terminals pawed over
	HRLZS D			;Swap and clear
	DO.
	  TMSG <  >		;Space over for pretty
	  MOVEI A,.PRIOU	;A to the terminal
	  HRRZ B,BUFFER+SN$TTY+1(D)
	  ADDI B,.TTDES		;Make TTY number into a device designator
	  DEVST%		;Write device name, e.g. TTY6
	   ERJMP .+1
	  TMSG <: -- >	;Add a colon and separating dashes
	  HLRZ B,BUFFER+SN$TTY+1(D)	 ;Fetch status flag for that line
	  HRRO A,[ [ASCIZ/refused/]
		   [ASCIZ/ok/]
		   [ASCIZ/timed out/]
		   [ASCIZ/refused/] ]+1(B)
	  PSOUT%		;Print out the status
	  TMSG <
>				;End with a CRLF
	  AOBJN D,TOP.		;Loop over the list
	ENDDO.
	RETSKP

; DOIPCF - send an IPCF page to the send server and await the response
; call with BUFFER/message, D/PID of this process (zero if none)
; returns +1/failure, +2/success, reply page in BUFFER

	PACLEN==7		;Length of MSEND/MRECV packet

DOIPCF:	STKVAR <SRVPID,<SNDARG,4>,<PACKET,PACLEN>>
	MOVX A,IP%CPD		;Get create pid flag into place
	SKIPE D			;Do we already have a pid?
	 SETZ A,		;Yes, no special flags needed
	MOVEM A,.IPCFL+PACKET	;Set up flag word
	MOVEM D,.IPCFS+PACKET	;We are the sender
	SETZM .IPCFR+PACKET	;INFO is the receiver
	MOVEI A,SNDARG
	HRLI A,4
	MOVEM A,.IPCFP+PACKET	;Set up pointer to argument block
	MOVX A,.IPCIW
	MOVEM A,.IPCI0+SNDARG	;Get pid for this name
	SETZM .IPCI1+SNDARG	;No duplicate
	DMOVE A,[ASCIZ/SNDSRV/]	;Point to string for SNDSRV's PID name
	DMOVEM A,.IPCI2+SNDARG	;Stash the id
	MOVEI A,PACLEN
	MOVEI B,PACKET
	MSEND%			;Ask info for server PID, maybe create our PID
	 RETSTR <Error while sending to INFO>,TTXIPC
	MOVE D,.IPCFS+PACKET	;Fetch our PID in case it was created
	MOVEM D,.IPCFR+PACKET	;We are receiver this time
	SETZM .IPCFL+PACKET	;Sender is INFO
	MOVEI A,PACLEN
	MOVEI B,PACKET
	MRECV%			;Receive reply from INFO
	 RETSTR <Error receiving from INFO>,TTXIPC
	LDB A,[POINT 6,.IPCFL+PACKET,29] ;Get INFO error code field
	IFN. A
	  CAIN A,76		;Couldn't find it?
	   RETSTR <Server not running>,TTXIPC
	  RETSTR <INFO error other than server not running>,TTXIPC
	ENDIF.
	MOVE A,.IPCI1+SNDARG
	MOVEM A,SRVPID		;Store server's PID
	MOVX A,IP%CFV
	MOVEM A,.IPCFL+PACKET	;Sending a page of data
	MOVEM D,.IPCFS+PACKET	;We are the sender
	MOVE A,SRVPID
	MOVEM A,.IPCFR+PACKET	;The server is the receiver
	MOVEI A,BUFPAG		;From the data page
	HRLI A,1000		;A whole page full
	MOVEM A,.IPCFP+PACKET
	MOVEI A,PACLEN
	MOVEI B,PACKET
	MSEND%			;Send off the request
	 RETSTR <Error sending to server>,TTXIPC
	MOVX A,IP%CFV
	MOVEM A,.IPCFL+PACKET	;Receiving a page of data
	MOVE A,SRVPID
	MOVEM A,.IPCFS+PACKET	;From the server
	MOVEM D,.IPCFR+PACKET	;To our own PID
	MOVEI A,BUFPAG		;Back to the same data page
	HRLI A,1000
	MOVEM A,.IPCFP+PACKET
	MOVEI A,PACLEN
	MOVEI B,PACKET
	MRECV%			;Receive a reply
	 RETSTR <Error receiving from server>,TTXIPC
	RETSKP

; SNDNET - Send a Network Message
; returns +1/failure, A and C set for return; +2/success

SNDNET:	SKIPE A,QUEJFN		;Do we have a queued mail file yet?
	 JRST NETRCP		;Yes, just add recipient
	HRROI A,BUFFER		;Into a free place
	HRROI B,[ASCIZ/MAILQ:[--QUEUED-MAIL--].NEW-/]
	SETZ C,
	SOUT%			;Start making name
	PUSH P,A		;Create frame to save string pointer
	GTAD%			;Now output date/time
	MOVE B,A
	MOVE A,(P)
	MOVEI C,^D8		;Output in octal
	NOUT%
	 RETSTR <Couldn't make name for queued mail file>,TTXNET
	FMSG <-SNDMSG-J>
	MOVEM A,(P)		;Update saved string pointer
	GJINF%			;Get my job number
	POP P,A			;Get string pointer back
	MOVE B,C		;Get job number in B
	MOVEI C,^D10		;Output in octal
	NOUT%
	 RETSTR <Couldn't make name for queued mail file>,TTXNET
	FMSG <.-1;P770000>	;Next generation, set protection
	MOVX A,GJ%SHT!GJ%FOU	;File for output
	HRROI B,BUFFER		;With nice file name
	GTJFN%			;Get handle on queue file
	 RETSTR <Couldn't get handle on queued mail file>,TTXNET
	MOVX B,FLD(7,OF%BSZ)!OF%WR ;Writing
	OPENF%			;Open it up
	 RETSTR <Couldn't open queued mail file>,TTXNET
	MOVEM A,QUEJFN		;Save for later
	HRROI A,BUFFER		;Into buffer space
	FMSG <=DELIVERY-OPTIONS:SEND
_>				;This is a send, from someone
	CALL $GTLCL		;Get local host name
	 RETSTR <Couldn't get local host name>,TTXNET
	FMSG <
>				;CRLF (still in buffer)
	CALL .DIRST		;And our user name
	FMSG <
>				;Another CRLF
	MOVE A,QUEJFN		;Get file again
	HRROI B,BUFFER		;Get buffer back
	SETZ C,			;Until null
	SOUT%			;Start making file

; Here with A/QUEJFN, add one recipient to the list in the file
NETRCP:	MOVEI B,"L"-100		;Control L
	BOUT%			;To start another host/recip pair
	HRROI A,BUFFER		;Get a place to buffer user name
	HRROI B,1(ADR)		;With pointer from address block
	CALL MOVSTR		;Copy string
	MOVE A,QUEJFN		;Get JFN back again
	HRROI B,1(B)		;With next string in block
	SOUT%			;Send host name first
	FMSG <
>				;Then a CRLF
	HRROI B,BUFFER		;Then point to user name
	SETZ C,			;To null
	SOUT%			;Add user name
	FMSG <
>				;Another CRLF to tie it off
	RETSKP			;Done for now with the net send

; $SSTAT - Send a request for statistics to the send server
; call with D/PID, returns +1/always, D/updated PID

$SSTAT::SAVEAC <A,B,C,CX>	;Don't mung caller's registers
	MOVE A,['SNDSTA']	;SIXBIT function code
	MOVEM A,BUFFER+SN$HDR	;Set it in IPCF page
	SETZM BUFFER+SN$FLG	;No format flags
	CALL DOIPCF		;Send it off
	 NOP			;Ignore failure
	RET

; $WTRCP - Make string for recipient block
; Call with A/Destination pointer (string or JFN)
;	    B/Recipient block (as for $SEND)
; Returns +1/Always

$WTRCP::SAVEAC <B,C,ADR>	;Don't mung caller's registers
	MKPTR (A)		;Make sure we have a real byte pointer
	MOVE ADR,B		;Copy address block pointer
	LOAD B,RC%TYP,(ADR)	;Find out what kind of send this is
	JRST @[	WRTTTY		;RC.TTY - to line number
		WRTUSR		;RC.USR - to user number
		WRTALL		;RC.ALL - to all
		WRTNET ](B)	;RC.NET - network send

WRTTTY:	MOVE B,1(ADR)		;Get send data
	MOVEI B,.TTDES(B)	;Turn into device designator
	DEVST%			;Type it
	 IFNJE. <RET>
	FMSG <Unknown terminal>
	RET

WRTUSR:	MOVE B,1(ADR)		;Get send data
	DIRST%			;Type user name
	 IFNJE. <RET>
	FMSG <Unknown user>
	RET

WRTALL:	FMSG <*>		;To everyone, just type a star
	RET

WRTNET:	HRROI B,1(ADR)		;Point to user
	SETZ C,			;No limit
	SOUT%			;Add it
	HRROI C,1(B)		;Save it
	MOVEI B,"@"		;Atsign
	BOUT%			;Add that too
	MOVE B,C		;Get pointer back
	SETZ C,			;Ending on null
	SOUT%			;Copy host name
	RET

; Random string copying utilities

;MOVSTR - move ASCIZ string from source in B to dest in A, including the null
MOVSTR:	MKPTR (A)
	MKPTR (B)
	DO.
	  ILDB C,B
	  IDPB C,A
	  JUMPN C,TOP.
	ENDDO.
	RET

; CPYSTR - copy an asciz string from source to destination without the null
CPYSTR:	MKPTR (A)
	MKPTR (B)
	DO.
	  ILDB C,B
	  JUMPE C,R
	  IDPB C,A
	  LOOP.
	ENDDO.

; .DIRST - Copy our user name or string describing n-l-i into pointer in A
.DIRST:	SAVEAC <B,C,D>		;Don't mung other registers
	PUSH P,A		;Save pointer
	GJINF%			;Get our user number
	HLRZ B,A		;Get left half only
	CAIE B,500000		;Look like a user number?
	IFSKP.
	  MOVE B,A		;Save user number
	  POP P,A		;Get pointer back
	  DIRST%		;Type it out
	   IFSKP. <RET>		;If succeeded, we're all done
	  HRROI B,[ASCIZ/Unknown user, /] ;Else start making string
	ELSE.
	  POP P,A		;Get dest back
	  HRROI B,[ASCIZ/Not logged in, /]
	ENDIF.
	CALL CPYSTR		;Start string
	IFL. D			;If detached (how'd a n-l-i det run send???)
	  HRROI B,[ASCIZ/detached/]
	  JRST CPYSTR		;Say so
	ENDIF.
	MOVEI B,.TTDES(D)	;Else get as terminal designator
	DEVST%			;Write "TTYn"
	 ERJMP .+1		;Ignore errors
	RET			;All done

	END