Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - mm/sndmsg-mkl.mac
There are no other files named sndmsg-mkl.mac in the archive.
;[SRI-NIC]SRC:<MM>SNDMSG.MAC.18,  8-Apr-86 14:44:00, Edit by MKL
; hack this to send IPCF's to EXEC's instead of send server
;[SRI-NIC]SRC:<MM>SNDMSG.MAC.17, 13-Aug-85 13:01:00, Edit by IAN
;[NIC001] Add header line to outgoing Internet message bodies

	TITLE SNDMSG - Routines to send local and network TTY messages
	SUBTTL David Eppstein / Stanford University / 22 April 1983

	;; Taken from SEND.MAC, written March 1981 by Kirk Lougheed
	;;
	;; Judy Anderson of HP and Ken Olum of FLAIR wrote the Chaos support.
	;; Frank Fujimoto and David Eppstein, both of Stanford, wrote
	;; the TCP/SMTP support.  David Eppstein wrote the Pup Ethernet code.
	;; Mark Crispin rewrote the TCP/SMTP support to use the JFN interface.

	SEARCH MONSYM,MACSYM
	EXTERN $GTPRO,$GTHNS,$PUPNS,$CHSNS,$RMREL
	ASUPPRESS
	SALL
; Definitions and Storage

A=1				;Temporary AC's for JSYS use etc
B=2
C=3
D=4
; Definitions for SNDMSG subroutine package

	RC%TYP==:.LHALF		;Type of recipient
	RC%NXT==:.RHALF		;Next link in recipient chain

	RC.TTY==0		;Send to terminal (must be 0)
	RC.USR==1		;Send to local user
	RC.ALL==2		;Send to all local logged-in users
	RC.NET==3		;Send to a net user

DEFINE MKPTR (AC) <		;;Turn HRROI pointer into the real thing
	TLC AC,-1
	TLCN AC,-1
	 HRLI AC,(POINT 7,)
>

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==600		;Length of command buffers (for long msgs)
	PDLEN==100		;Length of pushdown stack
; 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 DATA		;Uninitialized unpaged data

	NBFLEN==100
NETBUF:	BLOCK NBFLEN		;Used to build "filename" for ICP etc

NETUSR:	BLOCK 20		;Foreign username
NETADR: BLOCK 20		;Foreign site name
NETJFN:	BLOCK 1			;JFN for net

OURPID:	BLOCK 1			;our pid
PNAME:	BLOCK 10		;name of pid we are sending to
JIBLK:	BLOCK 20		;GETJI% block
ALLP:	BLOCK 1
JC:	BLOCK 1

;error codes
SNXURS=1			;refusing sends
SNXSMT=2			;smtp error (string is smtp error reply)
SNXRND=3			;random SNDMSG failure
SNXNET=4			;random network lossage
SNXNJT=5			;no job on tty
SNXNBT=6			;won't send to batch jobs

;	.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/flags
; Returns +1/Failed,  ac1/error code  ac2/error string
;	  +2/Success
;
; 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)
;
;Flag word:
;		1B4 (T%LF)   - On if send is from a foreign user
;                    if so, message contains asciz /user/host/message/
T%LF=1B4

$SEND::	SAVEAC <D,ADR,ABLOCK,CX> ;Don't mung anything for caller
	TRVAR <MSPTR,MSEPTR>	;Place to save message pointer and end of it
	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
	    RET			;And return failure
	  LOAD ADR,RC%NXT,(ADR) ;Done, get next
	  JUMPN ADR,TOP.	;And loop back with it
	ENDDO.
	RETSKP			;Return success with them
; SNDONE - Send one message
; returns +1/failure, A/B setup,  +2/success

SNDONE:	LOAD A,RC%TYP,(ADR)	;Get send type
	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,NETBUF		;Use a likely buffer
	HRLOI B,.FHSLF		;With ourself
	MOVEI C,40*5-1		;Number of characters available
	ERSTR%			;Copy error string
	 NOP
	 NOP
	MOVEI A,SNXRND		;random failure
	MOVE B,[POINT 7,NETBUF]	;Now point to the string we made
	RET
; Sending a Local Message
;ret +1 fail, A/B setup; +2 ok

SNDLOC:	LOAD A,RC%TYP,(ADR)	;Fetch type of field we parsed
	CAIN A,RC.ALL
	 JRST SNDALL
	CAIN A,RC.TTY
	 JRST SNDTTY
	CAIN A,RC.USR
	 JRST SNDUSR
	MOVEI A,SNXRND
	MOVE B,[POINT 7,[ASCIZ /Illegal recipient type code./]]
	RET			;ILLEGAL

;a send all.  Scan thru all jobs calling send routine.
SNDALL:	SETOM ALLP
	SKIPA

;send for a user.  find all jobs for that user and call send routine for each.
SNDUSR:	 SETZM ALLP
	SETZM JC
	DO.
	 MOVE A,JC
	 MOVE B,[-12,,JIBLK]
	 MOVEI C,.JIJNO
	 GETJI%
	  ERJMP	[CAIN A,GTJIX3	;END OF JOBS?
		  JRST ENDLP.
		 AOS JC
		 LOOP.]
	 MOVE C,JIBLK+.JIUNO
	 SKIPN ALLP		;DOING EVERYONE?
	 CAMN C,1(ADR)		;RIGHT USER?
	  JRST [CALL SENDIT	;YEP, SEND IT OFF
		 JFCL
		JRST .+1]
	 AOS JC
	 LOOP.	
	ENDDO.	 
	RETSKP			;always works!

;send for a tty.  convert tty to job number and call send routine.
SNDTTY:	MOVE A,1(ADR)		;GET TTY NUMBER
	ADDI A,.TTDES
	MOVE B,[-12,,JIBLK]
	MOVEI C,.JIJNO
	GETJI%			;GET JOB NUMBER
	 ERJMP JSRET
	CALL SENDIT
	 RET
	RETSKP
;Send routine.  Called with job info in JIBLK.  MSPTR TO MESSAGE.
;ret +1 on error, A/B setup; +2 on success
SENDIT:	
	SKIPGE JIBLK+.JIJNO
	 JRST [MOVEI A,SNXNJT
	       MOVE B,[POINT 7,[ASCIZ /No job on that TTY./]]
	       RET]
	SKIPGE JIBLK+.JIBAT
	 JRST [MOVEI A,SNXNBT
	       MOVE B,[POINT 7,[ASCIZ /Won't send to batch jobs./]]
	       RET]

;Set up name of PID to send to
	HRROI A,PNAME
	SKIPN B,JIBLK+.JIUNO
	 JRST [HRROI B,[ASCIZ /N-L-I/]
	       SETZ C,
	       SOUT%
	       JRST NLINAM]
	DIRST%
	 ERJMP JSRET
NLINAM:	MOVEI B,"."
	IDPB B,A
	MOVE B,JIBLK+.JIJNO
	MOVEI C,^D10
	NOUT%
	 ERJMP JSRET

;Set up IPCF message
	HRLZI A,123456		;MAGIC NUMBER
	MOVE B,ABLOCK		;get flags
	TXNE B,T%LF		;Foreign?
	 TXO A,1B18		;yes, set flag
	MOVEM A,BUFFER+0	;MAGIC,,FLAGS
	GJINF%
	MOVEM C,BUFFER+1	;OUR JOB NUMBER
	HRROI A,BUFFER+2	;Into the appropriate place in the IPCF page
	MOVE B,MSPTR		;From message pointer given to us
	CALL MOVSTR		;Copy the message (or user if foreign)

	MOVE C,ABLOCK		;get flags
	TXNN C,T%LF		;Foreign?
	IFSKP.
	 CALL MOVSTR		;copy host
	 CALL MOVSTR		;ccopy message
	ENDIF.

 	CALL DOIPCF		;Go send it off
	  RET			;Give fail return
	RETSKP
; DOIPCF - Ask INFO for PID of user we want to send to,
; then send an IPCF page to the person.
; call with BUFFER/message, PNAME/name of pid to send to
; returns +1/failure (A/B setup), +2/success, reply page in BUFFER

	PACLEN==7		;Length of MSEND/MRECV packet

DOIPCF:	STKVAR <SRVPID,<SNDARG,14>,<PACKET,PACLEN>>
	MOVX A,IP%CPD		;Get create pid flag into place
	SKIPE D,OURPID		;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,14
	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
	HRROI A,.IPCI2+SNDARG
	HRROI B,PNAME		;Name we are looking for
	CALL MOVSTR
	MOVEI A,PACLEN
	MOVEI B,PACKET
	MSEND%			;Ask info for server PID, maybe create our PID
	 ERJMP JSRET
	MOVE D,.IPCFS+PACKET	;Fetch our PID in case it was created
	MOVEM D,OURPID		;Save for future use
	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
	 ERJMP JSRET
	LDB A,[POINT 6,.IPCFL+PACKET,29] ;Get INFO error code field
	IFN. A
	  CAIN A,76		;Couldn't find it?
	   JRST [MOVEI A,SNXURS
		 MOVE B,[POINT 7,[ASCIZ /Refused./]]
		 RET]
	  MOVEI A,SNXRND
	  MOVE B,[POINT 7,[ASCIZ /Unexpected reply from INFO/]]
	  RET
	ENDIF.
	MOVE A,.IPCI1+SNDARG
	MOVEM A,SRVPID		;Store user's EXEC'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
	 ERJMP JSRET
	RETSKP
; SNDNET - Send a Network Message
; returns +1/failure, A/B set for return; +2/success

SNDNET:	HRROI A,NETUSR		;Into net user string
	HRROI B,1(ADR)		;With pointer from address block
	CALL MOVSTR		;Copy string
	HRROI A,NETADR		;Now into host name
	HRROI B,1(B)		;With next string in block
	CALL MOVSTR		;Copy string
	HRROI A,NETADR		;Point to network site name
	MOVEI C,NETLST		;Get list of protocols supported
	CALL $GTPRO		;Look it up
	 JRST NETRET
	HRRZ C,(C)		;Get dispatch routine for protocol
	CALL (C)		;Go jump to it
	 TRNA			;Non-skip
	  AOS (P)		;Skip
	PUSH P,A
	SKIPN A,NETJFN		;If server made a JFN, be sure to clean it up
	IFSKP.
	  TXO A,CO%NRJ		;Yes, close it
	  CLOSF%
	   NOP
	  HRRZ A,NETJFN		;Now flush it
	  RLJFN%
	   NOP
	  SETZM NETJFN		;No more JFN
	ENDIF.
	POP P,A
	RET

; List of networks we know about.  For each network we have a pointer
; to a string for the name of the net and the address of a handler routine.
; The called routine gets a host number in B, should return +2 for success.

NETLST:	[ASCIZ/TCP/],,DOINT	;TCP/IP Internet (SMTP)
	[ASCIZ/Chaos/],,DOCHA	;MIT Chaosnet
	[ASCIZ/Pup/],,DOETH	;Pup Ethernet (MiscService packet protocol)
	0

NETRET:	MOVEI A,SNXNET
	MOVE B,[POINT 7,[ASCIZ /Random network error/]]
	RET

SMTRET:	MOVEI A,SNXSMT
	MOVE B,[POINT 7,BUFFER]
	RET
; DOINT - Send a message over the Internet

DOINT:	PUSH P,B		;Save address
	HRROI A,NETBUF		;a := ptr to net file name str
	HRROI B,[ASCIZ/TCP:./]	;Build device and default local spec
	CALL CPYSTR		;Copy string
	POP P,B			;Destination host number
	MOVX C,^D8		;TCP: hosts are in octal
	NOUT%			;Output to file string
	 ERJMP NETRET
	HRROI B,[ASCIZ/-25;CONNECTION:ACTIVE;PERSIST:30/] ;Port 25, quit
	CALL CPYSTR		; after 30 seconds
	MOVX A,GJ%SHT		;Short form, restricted
	HRROI B,NETBUF		;Pointer to file string we made
	GTJFN%			;Make a JFN on it
	 ERJMP NETRET
	MOVEM A,NETJFN		;Save the JFN
	MOVX B,<<FLD ^D8,OF%BSZ>!<FLD .TCMWH,OF%MOD>!OF%RD!OF%WR>
	OPENF%			;Open 8 read/write buffered, wait for conn.
	 ERJMP NETRET
	CALL INTMSG		;Get initial hello, send the message
	 IFSKP. <AOS (P)>	;On success, set up +2 return
	PUSH P,A		;Save error string in case of error
	PUSH P,B
	MOVE A,NETJFN		;Get the JFN for our connection
	HRROI B,[ASCIZ \QUIT
\]				;Say we want to go bye-bye
	SETZ C,			;Stop on null
	SOUTR%
	 ERJMP .+1
	DO.
	  BIN%			;Read any following crud
	   ERJMP ENDLP.
	  LOOP.			;Continue until error
	ENDDO.
	POP P,B
	POP P,A			;Get error string back
	RET			;Return success or failure
; GETRSP - listen for responses from the foreign MAISER
; returns +2, with MAISER code in A, text in BUFFER
; if MAISER sends a code .GE. 400, returns +1

GETRSP:	MOVE A,NETJFN		;A/foreign socket
	HRROI B,BUFFER		;Into scratch buffer
	MOVX C,1000*5-1		;With this many characters
	CALL SMTNIN		;Read MAISER's response
	IFSKP.
	  CAIGE B,400		;Look at number returned
	   RETSKP		;Below 400, return success
	  MOVE A,[POINT 7,BUFFER]
	  DO.
	   ILDB B,A
	   JUMPE B,ENDLP.
	   CAIE B,.CHCRT
	    LOOP.
	   SETZ B,
	   DPB B,A		;only 1 line please!
	  ENDDO.
	  HRROI A,BUFFER	;Else get error string
	ENDIF.
	RET			;Return failure
; INTMSG - build the actual message and send it

; If this could possibly go into a user's mailbox we would have to follow
; RFC822 and build message headers.  But we use SEND instead of SOML so
; this is merely a terminal message and needs no headers.

INTMSG:	CALL GETRSP		;Pick up 220 site ident
	 JRST NETRET
	HRROI A,BUFFER		;Get a pointer to our output buffer
	HRROI B,[ASCIZ/HELO /]	;String for hello command
	CALL CPYSTR		;Start our message
	SETO B,			;Local host number
	CALL $GTHNS		;Get host name
	 JRST NETRET
	CALL INTGO		;Send off our hello to the other site
	 JRST NETRET
	CALL GETRSP		;Pick up reply (most likely 250)
	 JRST SMTRET
	HRROI A,BUFFER		;Put everything in our buffer
	HRROI B,[ASCIZ/SEND FROM:</]
	CALL CPYSTR		;Initiate message
	CALL .DIRST		;Add our user name
	MOVEI B,"@"		;Append at-sign for return address
	IDPB B,A		;Drop it into buffer
	SETO B,			;Local host number
	CALL $GTHNS		;Add our site name
	 JRST NETRET
	MOVEI B,">"		;Close with a close broket
	IDPB B,A		;Drop it in
	CALL INTGO		;Send the SEND command
	 JRST NETRET
	CALL GETRSP		;Get server's response
	 JRST SMTRET
	HRROI A,BUFFER		;Where to build message to send
	HRROI B,[ASCIZ/RCPT TO:</] ;Set up recipient command
	CALL CPYSTR		;Throw start of command into buffer
	HRROI B,NETUSR		;Get recipient user name
	CALL CPYSTR		;Add it in
	MOVEI B,"@"		;Get an at-sign
	IDPB B,A		;Add that too
	HRROI B,NETADR		;Get site name of recipient address
	CALL CPYSTR		;Add it in
	MOVEI B,">"		;And an angle bracket
	IDPB B,A		;Closes off the recipient name
	CALL INTGO		;Send off the buffer
	 JRST NETRET
	CALL GETRSP		;Pick up reply (250 or 251)
	 JRST SMTRET
	HRROI B,[ASCIZ\DATA
\]				;Point to start of DATA command
	CALL INTSTR		;Go send it
	 JRST NETRET
	CALL GETRSP		;Pick up reply (most likely 354)
	 JRST SMTRET
;;
;;	[NIC001] First line of data should be header line for REPLY
;;	programs to use...
;;
	HRROI A,BUFFER
	CALL .DIRST		;Add our user name
	MOVEI B,"@"		;Append at-sign for return address
	IDPB B,A		;Drop it into buffer
	SETO B,			;Local host number
	CALL $GTHNS		;Add our site name
	 JRST NETRET
	MOVEI B," "
	IDPB B,A
	IDPB B,A
	SETO B,			;B/want present time
	MOVX C,OT%NSC!OT%12H!OT%TMZ!OT%SCL ;C/format
	ODTIM%			;Write the time
	CALL INTGO		;Add CRLF and send it off
	 JRST NETRET
;;
;;	End [NIC001]
;;
	SETZ D,			;Clear line position
	MOVE C,MSPTR		;Point to message
	ILDB B,C		;Get the first character
	DO.
	  CALL INTCHR		;Send char out, maybe processing prefix period
	   JRST NETRET
	  ILDB B,C		;Get another
	  JUMPN B,TOP.		;Go back for the next char
	ENDDO.
	MOVEM C,MSEPTR		;Save pointer to end of message
	SKIPE D			;If not at start of line, need extra crlf
	 SKIPA B,[POINT 7,[ASCIZ \
.
\]]
	  MOVE B,[POINT 7,[ASCIZ \.
\]]				;Will eventually end with a CRLF . CRLF
	CALL INTSTR		;Append the trailer
	 JRST NETRET
	CALL GETRSP		;Pick up reply (most likely 250)
	 JRST SMTRET
	RETSKP			;Success, return +2
; Copy in one data character, being careful with CRLFs and dots

INTCHR:	MOVE A,NETJFN		;Get jfn for output
	CAIE B,"."		;If we have a period
	IFSKP.
	  IFE. D		;If at the start of a line
	    BOUT%		;Send an extra dot
	     ERJMP R
	  ENDIF.
	  SETO D,		;In the middle of a line
	  BOUT%			;Now send our first dot
	   ERJMP R
	  RETSKP
	ENDIF.
	CAIE B,.CHCRT		;Carriage return?
	IFSKP.
	  MOVEM B,D		;Yes, set line position positive to remember
	  BOUT%			;And go send it
	   ERJMP R
	  RETSKP
	ENDIF.
	CAIN B,.CHLFD		;Line feed?
	 SKIPG D		;And previous carriage return?
	  CAIA			;No, go on
	   TDZA D,D		;Yes, we are now at the start of a line
	    SETO D,		;Else we are in the middle of a line
	BOUT%			;In any case go send the char
	 ERJMP R
	RETSKP
; INTGO - add CRLF to string in buffer and send it off
; INTSTR - send string pointed to in B
; both return +2 normally, or +1 on error

INTGO:	MOVEI B,.CHCRT		;A carriage return
	IDPB B,A		;Append it to our buffer
	MOVEI B,.CHLFD		;A linefeed
	IDPB B,A		;Add it, too
	MOVEI B,.CHNUL		;A null
	IDPB B,A		;Tie off string with it
	HRROI B,BUFFER		;What to send
INTSTR:	MOVE A,NETJFN		;Where to send
	SETZ C,			;End on null
	SOUTR%
	 ERJMP NETRET
	RETSKP
; SMTNIN - input a number (like NIN%), break on non-digit
; call with A/SMTP connection JFN, B/pointer to line buffer, C/char count
; returns +1/failure, +2/success, number in B, C and D smashed

SMTNIN:	TRVAR <ATMPTR,RETNUM,BUFCTR,<LINPTR,2>>
	DMOVEM B,LINPTR		;Save where to start
	SETZM ATMPTR		;No continuation lines yet
	SETZM RETNUM		;Nothing to return yet
	DO.
	  SETZ C,		;Nothing this time through
	  DO.
	    BIN%		;Get the next character from our stream
	     ERJMP NETRET
	    CAIL B,"0"		;Is it in range
	     CAILE B,"7"	;to be a digit?
	      IFSKP.
		IMULI C,10	;Yes, shift result by octal radix
		ADD C,B		;Add in digit
		SUBI C,"0"	;Minus offset for ASCII characters
		LOOP.		;Go back for the next one
	      ENDIF.
	  ENDDO.
	  SKIPG C		;If somehow out of range
	   JRST NETRET
	  EXCH C,RETNUM		;Exchange with value to return
	  IFG. C
	    CAME C,RETNUM	;If had a number already but is not the same
	     JRST NETRET
	  ENDIF.
	  CAIE B,"-"		;If we got a dash
	  IFSKP.
	    CALL GETLFD		;Then read in some more
	     JRST NETRET	;Propagate fail return
	    LOOP.
	  ENDIF.
	ENDDO.
	CAIE B," "		;If not a space
	 JRST NETRET
;	JRST GETLFD

; GETLFD - Read in rest of server response line

GETLFD:	SKIPE B,ATMPTR		;Get pointer
	IFSKP.
	  DMOVE B,LINPTR	;If none, point to start of buffer
	  MKPTR (B)		;Make sure it is a byte pointer
	ELSE.
	  MOVEI C,.CHCRT	;Else get a CR
	  DPB C,B		;Drop it in over the null we left
	  MOVEI C,.CHLFD	;And a linefeed
	  IDPB C,B
	  MOVEI C," "		;And finally a space
	  IDPB C,B		;Drop it in to make pretty
	  SOS C,BUFCTR		;Count off, get old buffer counter
	  SOS C,BUFCTR		;And again
	ENDIF.
	MOVEI D,.CHCRT		;Read to a carriage return
	SIN%			;Do the read
	 ERJMP R		;Propagate fail return
	MOVEM B,ATMPTR		;Save new atom buffer pointer
	MOVEM C,BUFCTR		;And new buffer space counter
	SETZ C,			;Get a null
	DPB C,B			;Drop it in over carriage return
	BIN%			;Now read in the linefeed
	 ERJMP R
	MOVE B,RETNUM		;Get the number to return
	RETSKP
; DOCHA - Send a message via the CHAOSnet

; Chaosnet symbols abstracted from CHASYM
	.CSRFS==3		;RFC sent
	.CSOPN==4		;Connection is open
	.MOPKR==27		;Read packet
	CHPKDT==4		;???
	$CPKNB==041400,,0	;???

DOCHA:	PUSH P,B		;Save foreign host
	HRROI A,NETBUF		;Set up pointer for building filename string
	HRROI B,[ASCIZ/CHA:/]
	CALL CPYSTR		;Start with correct device name
	POP P,B			;Get host number back
	MOVEI C,^D8		;Octal
	NOUT%
	 ERJMP JSRET
	HRROI B,[ASCIZ/.SEND_/]
	CALL CPYSTR		;Put contact name into buffer too
	HRROI B,NETUSR		;And net username
	CALL CPYSTR
	MOVX A,GJ%SHT!GJ%OLD	;Short form, old file
	HRROI B,NETBUF		;Filename
	GTJFN%
	 ERJMP NETRET
	MOVEM A,NETJFN		;Save JFN for later
	MOVX B,FLD(8,OF%BSZ)!OF%WR ; write mode, 8 bits
	OPENF%
	 ERJMP NETRET
	CALL CHAMSG		;Build the message to be sent
	 RET
	MOVE A,NETJFN		;A/network jfn
	MOVE B,[POINT 8,BUFFER]	;B/buffer where CHAMSG left the message
	SETZB C,D		;Normal SOUT, flush randomness in C & D
	SOUT%
	 ERJMP JSRET
	MOVE A,NETJFN
	MOVEI B,.MOEOF		;Send an EOF to Chaosnet
	MTOPR%
	 ERJMP JSRET
	MOVEI B,.MONOP		;Wait for everything to die down
	MTOPR%
	 ERJMP JSRET
	CLOSF%			;Close the Chaosnet connection
	IFNJE.
	  SETZM NETJFN		;Flush the JFN
	  RETSKP
	ENDIF.
	MOVE A,NETJFN		;A/network jfn
	MOVEI B,.MOPKR		;Get Los/CLS packet
	HRROI C,NETBUF		;Drop it into NETBUF
	MTOPR%
	 ERJMP JSRET
	MOVE A,[POINT 8,NETBUF+CHPKDT]
	LDB B,[$CPKNB+NETBUF]	;Get length
	ADJBP B,A		;To point to end of string
	SETZ C,			;Get a null
	DPB C,B			;And tie off message with it
;	MOVX C,TTXNET		;Have pointer to string, now set err code
	RET
; CHAMSG - build a message to be sent over the CHAOSnet into BUFFER

CHAMSG:	MOVE A,[POINT 8,BUFFER]	;Get a pointer to our output buffer
	CALL .DIRST		;Add our user name
	MOVEI B,"@"		;Get an atsign
	IDPB B,A		;Drop it in
	SETO B,			;With local host name
	MOVEM A,D		;Saving string pointer
	CALL $CHSNS		;Copy local host name to our buffer
	 RET
	MOVE A,D		;Get pointer to host name back
	CALL $RMREL		;Flush ugly relative domain
	MOVE A,D		;Get pointer once more
	DO.
	  ILDB B,A		;Skip over
	  JUMPN B,TOP.		;Until we get a null
	ENDDO.

	;; Added sender, now add time
	MOVEI B,.CHSPC		;A space
	DPB B,A			;Add it to the buffer
	SETO B,			;B/want present time
	MOVX C,OT%NSC!OT%12H!OT%TMZ!OT%SCL ;C/format
	ODTIM%			;Write the time
	MOVEI B,215		;CHAOSnet EOL
	IDPB B,A		;Drop that in

	;; Finished header, now add text of message (converting EOLs)
	MOVE B,MSPTR		;Get pointer to message text
	DO.
	  ILDB C,B		;Get a byte from the user
	  CAIN C,15		;Carriage return?
	   MOVEI C,215		;Replace with chaos EOL character
	  CAIE C,12		;If linefeed, ignore it.
	   IDPB C,A		;Put character in the buffer
	  JUMPN C,TOP.		;And continue until we have transferred a null
	ENDDO.
	MOVEM B,MSEPTR		;Save pointer to end of message
	MOVEI C,215		;Put another carriage return for pretty
	DPB C,A			;Clobber the null we left there
	SETZ C,
	IDPB C,A		;And terminate string with a null
	RETSKP
; DOETH - Send a message via the Pup Ethernet

; Definitions for Pup-based Ethernet (stolen from PUPPAR)

IFNDEF PUPI%,<
	OPDEF PUPI% [JSYS 441]	;JSYS to send a packet over the Ether
	OPDEF PUPO% [JSYS 442]	;JSYS to pick up a packet

	PU%CHK==1B1		;Compute/check checksum
	PU%MEI==1B3		;Header is in 16-bit hardware mode
	PU%TIM==1B4		;(PUPI%) input timeout in ms in ac3

	.PUORW==16		;Raw I/O mode for OPENF%
>;IFNDEF PUPI%

	PBCONT==5		;Start of data in buffer

	MNPLEN==^D22		;Minimum Pup length (bytes) incl header
	MXPLEN==^D554		;Maximum Pup length
	MXPBLN==<MXPLEN+3>/4	;Maximum packet buffer size (words)

	DEFSTR PUPLEN,BUFFER,17,16	;Pup length
	DEFSTR PUPTYP,BUFFER,35,8	;Pup type

DOETH:	PUSH P,B		;Save net number
	HRROI A,NETBUF		;Get pointer to name string area
	HRROI B,[ASCIZ/PUP:!J./]
	CALL CPYSTR		;Copy string
	HLRZ B,(P)		;Get net num back
	MOVEI C,^D8		;Octal
	NOUT%			;Add the number
	 ERJMP JSRET
	CALL NUMSGN		;Add a number sign
	POP P,B			;Get host number back
	HRRZS B			;Just the host number
	NOUT%			;Add the number (8 still in C)
	 ERJMP JSRET
	CALL NUMSGN		;Another number sign
	MOVEI B,"4"		;Well-known socket for misc-services
	IDPB B,A		;Drop it in
	SETZ B,			;Get a null
	IDPB B,A		;Drop that in too
	MOVX A,GJ%SHT!GJ%OLD	;Short-style gtjfn, old file
	HRROI B,NETBUF		;From name we just built
	GTJFN%			;Get the jfn
	 ERJMP NETRET
	MOVEM A,NETJFN		;Save JFN
	MOVX B,FLD(^D8,OF%BSZ)!FLD(.PUORW,OF%MOD)!OF%RD!OF%WR
	OPENF%			;Open in raw packet mode
	 ERJMP NETRET
	CALL BLDETH		;Build packet into buffer
	HRRZ A,NETJFN		;Get JFN back
	TXO A,PU%CHK!PU%MEI	;Compute checksum, MEIS headers
	MOVE B,[MXPBLN,,BUFFER] ;Max length, from buffer
	PUPO%			;Send it out
	 ERJMP JSRET		;Random lossage
	HRRZ A,NETJFN		;Get JFN again
	TXO A,PU%CHK!PU%MEI!PU%TIM ;Checksum, MEIS headers, timeout
	MOVE B,[MXPBLN,,BUFFER] ;Max length, into buffer
	MOVX C,^D<30*1000>	;Wait for up to 30 seconds
	PUPI%			;Read it back in
	IFNJE.			;Got one?
	  LOAD A,PUPTYP		;Get type
	  CAIN A,301		;Success?
	   RETSKP
	  LOAD B,PUPLEN		;Get length of pup
	  SUBI B,MNPLEN		;Minus minimum number is length of error string
	  IFE. B		;If we have nothing
	    HRROI A,[ASCIZ/Unknown network error/] ;Make up a string
	  ELSE.
	    MOVE A,[POINT 8,PBCONT+BUFFER] ;Get pointer to error
	    ADJBP B,A		;Point to end of error message
	    SETZ C,		;Get a null
	    IDPB C,B		;Drop it in at end of string
	  ENDIF.
;	  MOVX C,TTXNET		;And error code
	  RET			;Return with it
	ENDIF.
	RET

NUMSGN:	MOVEI B,""		;Quote with control-V
	IDPB B,A		;Drop it in
	MOVEI B,"#"		;Number sign
	IDPB B,A		;Drop it in
	RET
; Build packet into buffer for PUPO%
; returns +1/always, mungs registers A-D

BLDETH:	SETZM BUFFER		;Clear start of buffer
	MOVE A,[BUFFER,,BUFFER+1]
	BLT A,BUFFER+MXPBLN-1	;Clear it out for the length of a packet
	MOVEI A,300		;Get packet type for ether send
	STOR A,PUPTYP		;Save it
	MOVE A,[POINT 8,PBCONT+BUFFER] ;Get dest ptr
	CALL .DIRST		;Copy user name or string describing us
	MOVEI B,":"		;Colon
	IDPB B,A		;Drop it in
	HRROI B,NETUSR		;Get net user name
	CALL CPYSTR		;Add it in
	MOVEI B,":"		;Another colon
	IDPB B,A		;Drop it in
	MOVE B,MSPTR		;Point to message
	CALL CPYSTR		;Copy it in
	MOVEM B,MSEPTR		;Save pointer
	MOVEI D,@A		;Compute address of last word
	SUBI D,BUFFER-1		;Compute # 36-bit words used
	LSH D,2			;Convert to bytes
	LSH A,-^D33		;Get bytes not used in last word
	SUBI D,(A)		;Compute pup length
	ADDI D,2		;Include checksum
	STOR D,PUPLEN		;Save length
	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