Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mm/sndmsg.mac
There are 11 other files named sndmsg.mac in the archive. Click here to see a list.
;[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,SNDDEF
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
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
; 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 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
.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/updated pointer, B/0, C/unchanged
;
; 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,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
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.
MOVE B,ADR ;Failed, get address block back
RET ;And return failure
ENDIF.
ENDDO.
SETO A, ;Get -1
ADJBP A,MSEPTR ;So we can point to null at end of message
MOVE B,ADR ;Get final value in ADR (should be 0)
MOVE C,ABLOCK ;Get address block address
RETSKP ;Return success with them
; 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,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
HRROI A,NETBUF ;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.
MOVEI 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: 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
RETSTR <Unrecognized host name>,TTXNET
HRRZ C,(C) ;Get dispatch routine for protocol
CALL (C) ;Go jump to it
TRNA ;Non-skip
AOS (P) ;Skip
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.
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
; 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
RETSTR <Couldn't copy host address>,TTXNET
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
RETSTR <Couldn't get network connection>,TTXNET
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.
RETSTR <Couldn't open network connection>,TTXNET
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
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,A ;Get error string back
MOVEI C,TTXNET ;Get failure code in case we failed
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
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
RET
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
RETSTR <Couldn't get local Internet host name>,TTXNET
CALL INTGO ;Send off our hello to the other site
RET
CALL GETRSP ;Pick up reply (most likely 250)
RET
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
RETSTR <Couldn't get local Internet host name>,TTXNET
MOVEI B,">" ;Close with a close broket
IDPB B,A ;Drop it in
CALL INTGO ;Send the SEND command
RET
CALL GETRSP ;Get server's response
RET
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
RET
CALL GETRSP ;Pick up reply (250 or 251)
RET
HRROI B,[ASCIZ\DATA
\] ;Point to start of DATA command
CALL INTSTR ;Go send it
RET
CALL GETRSP ;Pick up reply (most likely 354)
RET
;;
;; [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
RETSTR <Couldn't get local Internet host name>,TTXNET
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
RET
;;
;; 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
RETSTR <Couldn't send char to net>,TTXNET
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
RET
CALL GETRSP ;Pick up reply (most likely 250)
RET
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%
RETSTR <Couldn't send string to network>,TTXNET,ERJMP
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
RETSTR <Couldn't read SMTP server response>,TTXNET,ERJMP
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
RETSTR <SMTP input number was not positive>,TTXNET
EXCH C,RETNUM ;Exchange with value to return
IFG. C
CAME C,RETNUM ;If had a number already but is not the same
RETSTR <SMTP multi-line input had different codes>,TTXNET
ENDIF.
CAIE B,"-" ;If we got a dash
IFSKP.
CALL GETLFD ;Then read in some more
RET ;Propagate fail return
LOOP.
ENDIF.
ENDDO.
CAIE B," " ;If not a space
RETSTR <SMTP code terminator is neither a dash nor a space>,TTXNET
; 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%
RETSTR <Couldn't copy host number>,TTXNET
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%
RETSTR <Can't get Chaosnet connection>,TTXNET
MOVEM A,NETJFN ;Save JFN for later
MOVX B,FLD(8,OF%BSZ)!OF%WR ; write mode, 8 bits
OPENF%
RETSTR <Can't open Chaosnet connection>,TTXNET
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%
RETSTR <Can't send Chaosnet message>,TTXNET,ERJMP
MOVE A,NETJFN
MOVEI B,.MOEOF ;Send an EOF to Chaosnet
MTOPR%
RETSTR <Can't send Chaosnet EOF>,TTXNET,ERJMP
MOVEI B,.MONOP ;Wait for everything to die down
MTOPR%
RETSTR <Can't send Chaosnet NOP>,TTXNET,ERJMP
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%
RETSTR <Chaosnet connection failed>,TTXNET,ERJMP
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
RETSTR <Couldn't get local Chaos host name>,TTXNET
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
RETSTR <Couldn't copy net number>,TTXNET
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)
RETSTR <Couldn't copy host number>,TTXNET
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
RETSTR <Couldn't get network connection>,TTXNET
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
RETSTR <Couldn't open network connection>,TTXNET
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.
RETSTR <Failed to receive remote reply>,TTXNET
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
; $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