;-*-midas-*-
title sends
;chaosnet qsend server

a=1
b=2
c=3
d=4
e=5
n=7
t=10
tt=11
u=12
h=13
p=17

.insrt system;chsdef

usrch==0
clioch==1
hstich==2
chaich==10
chaoch==11

;hosts2 stuff
nw%chs==7			;standard network number for chaosnet
netptr==12			;word 12 of header pointer to network table
netnum==0			;word 0 of those entries has network number in it
ntlnam==1			;word 1 has name,,address pointer
addadr==0			;word 0 of those entries has host's address
adlsit==1			;word 1 has site,,next addr
stlnam==0			;word 0 of that has the name

;storage
debug:	0			;non-zero => .value on barfage
usrbp:	0			;byte pointer to start of user field
usrcnt:	0			;count of bytes at that point
hstbp:	0
hstcnt:	0
chapkt:	block %cpmxw		;chaosnet packet goes here
npdl==17
pdl:	block npdl

;interrupt handler
tsint:	loc 42
	-tsintl,,tsint
loc tsint
	p
	%piioc ? 0 ? -1 ? -1 ? iocerr	;handle ioc errors
tsintl==.-tsint

iocerr:	jsr die			;cheapo

;error handler
die:	0
	skipe debug
	 .value
passon:	.logout			;natural causes
	.value

sndpkt:	setz ? 'PKTIOT ? movei chaoch ? setzi chapkt
rcvpkt:	setz ? 'PKTIOT ? movei chaich ? setzi chapkt

;main program
go:	.close 1,		;this can still be open from loading us
	move p,[-npdl,,pdl-1]
	.suset [.roption,,t]
	tlo t,optint		;new style interrupts
	.suset [.soption,,t]
	.suset [.smask,,[%piioc]]	;catch ioc errors
	.call [setz ? 'CHAOSO ? movei chaich ? movei chaoch ? setzi 5]
	 jsr die
	move t,[.byte 8 ? %colsn ? 0 ? 0 ? 4]
	movem t,chapkt
	move t,[.byte 8 ? "S ? "E ? "N ? "D]
	movem t,chapkt+%cpkdt
	.call sndpkt
	 jsr die
	movei t,30.*60.
	skipe debug
	 hrloi t,177777		;wait forever if debugging
	.call [setz ? 'NETBLK ? movei chaich ? movei %cslsn ? t ? setzm t]
	 jsr die
	caie t,%csrfc		;did we get an rfc for this?
	 jsr die
	.call rcvpkt		;yes, read it in
	 jsr die

	skipe debug		;debugging?
	 jrst getusr
	ldb t,[chapkt+$cpksa]	;get source host address
	move tt,[sixbit /000C00/]	;convert host number to sixbit
	dpb t,[220300,,tt]
	lsh t,-3
	dpb t,[300300,,tt]
	lsh t,-3
	dpb t,[360300,,tt]
	.suset [.ruind,,t]	;incoroporate user index also
	dpb t,[000300,,tt]
	lsh t,-3
	dpb t,[060300,,tt]
	move t,tt		;save copy for xuname
	.call [setz
	       sixbit /LOGIN/
	       tt ? [sixbit /CHAOS/] ? setz t]
	 aoja tt,.-1		;error, perhaps need to try other uname
	.suset [.sjname,,[sixbit /SEND/]]
	.call [setz ? 'DETACH ? movei %jself ? andi 3 ]
	 jsr die

;now see to whom this is a message
getusr:	ldb n,[chapkt+$cpknb]	;get byte count
	move b,[440800,,chapkt+%cpkdt]	;and pointer to data portion of packet
getus1:	sojl n,nouser		;didnt specify a user name, barf at them
	ildb t,b
	caie t," 		;space?
	 jrst getus1		;no, keep looking
	setzb u,h
	movem b,usrbp
	movem n,usrcnt
	move e,[440600,,u]	;get byte pointer to user name we will make
getus2:	sojl n,gotusr		;count down bytes in rfc
	ildb t,b
	cain t," 		;only look at the first token
	 jrst gotusr
	cain t,"@		;specifying a hostname?
	 jrst gethst		;yes
	caige t,140
	 subi t,40
	tlne e,770000
	 idpb t,e
	jrst getus2

gethst:	movem b,hstbp		;save start of hostname in rfc
	movem n,hstcnt
	move e,[440600,,h]	;byte pointer to hostname
	jrst getus2

gotusr:	jumpe h,gothst		;didnt specify a host
	.call [	setz ? 'SSTATU ? movem t ? movem t ? movem t ? movem t ? movem t ? setzm t]
	 jsr die
	camn h,t		;specified local host for some reason?
	 jrst myhost		;yes, optimize
	came h,[sixbit /AI/]	;places i think i can talk to
	 camn h,[sixbit /MC/]
	 jrst gothst
	came h,[sixbit /ML/]
	 camn h,[sixbit /DM/]
	 jrst gothst
	jrst badhst

myhost:	setz h,
gothst:	skipn t,h		;was there a foreign host?
	 skipa t,[sixbit /USR/]	;no, look for local one then
	 ior t,[sixbit /  USR/]	;yes, use the MLUSR device
	.call [	setz
		sixbit /OPEN/
		movsi 10+.uii ? movei usrch
		t ? u
		setz [sixbit /HACTRN/]]
	 jrst nolog		;apparently not logged in
	.close usrch,

;guy is apparently there, accept the rfc
	movei t,%coopn
	dpb t,[chapkt+$cpkop]
	.call sndpkt
	 jsr die

	move t,[440800,,netbuf]
	movei tt,msgsiz
	.call [	setz
		sixbit /SIOT/
		movei chaich
		t ? setz tt]
	 jsr die
	jumpe tt,toobig		;if we filled up the whole buffer, complain
	movei n,msgsiz
	sub n,tt		;get number of bytes we got
	move e,[440700,,msgbuf]	;now convert message's character set
	movei t,177		;start with rubout so can have our own header
	idpb t,e
	movei c,1		;count bytes we make
	movei t,[asciz /TTY message from chaosnet site /]
	pushj p,sout
	ldb a,[chapkt+$cpksa]
	hrli a,nw%chs_9		;chaosnet
	pushj p,hstout
	movei t,[asciz /:
/]
	pushj p,sout
	move b,[440800,,netbuf]
cnvmsg:	sojl n,sndmsg
	ildb t,b
	cain t,215		;eol becomes crlf
	 jrst [idpb t,e
	       movei t,12
	       aoja c,.+1]
	cail t,210		;210-214 become 10-14
	 jrst cnvms1
	trne t,200		;200-207 are flushed
	 jrst cnvmsg
cnvms1:	idpb t,e
	aoja c,cnvmsg

sndmsg:	skipn t,h
	 skipa t,[sixbit /CLI/]
	 ior t,[sixbit /  CLI/]	;using MLCLI device
	.call [	setz
		sixbit /OPEN/
		movsi .uao
		movei clioch
		t ? u
		[sixbit /HACTRN/]]
	 jrst goaway		;guy logged out fast, send a cls of that
	move t,[440700,,msgbuf]
	.call [	setz
		sixbit /SIOT/
		movei clioch
		t ? setz c]
	 jsr die
	.close clioch,

	movei t,[asciz /Message send successfully./]
sndcls:	setz c,
	move e,[440800,,chapkt+%cpkdt]
sndcl0:	pushj p,sout
sndcl2:	dpb c,[chapkt+$cpknb]
	movei t,%cocls
	dpb t,[chapkt+$cpkop]
	.call sndpkt
	 jsr die
	.close chaoch,
	.close chaich,
	jrst passon		;die of natural causes

telusr:	move tt,[chapkt,,netbuf]
	blt tt,netbuf+%cpmxw-1	;save losing rfc
	setz c,
	move e,[440800,,chapkt+%cpkdt]
	hrli t,440700
telus1:	ildb tt,t
	jumpe tt,telus2
	idpb tt,e
	aoja c,telus1

telus2:	addi b,netbuf-chapkt
telus3:	sojl n,cpopj
	ildb tt,b
	idpb tt,e
	aoja c,telus3

;random error conditions
nouser:	movei t,[asciz /You must specify the user in the rfc./]
	jrst sndcls		;didnt say to whome to send

nolog:	movei t,[asciz /User "/]	;guy not around
	move b,usrbp
	move n,usrcnt
	pushj p,telusr
	movei t,[asciz /" not logged in./]
	jrst sndcl0

toobig:	movei t,[asciz /Message too long./]
	jrst sndcls

badhst:	movei t,[asciz /Cannot send messages to "/]
	move b,hstbp
	move n,hstcnt
	pushj p,telusr
	movei t,[asciz /"./]
	jrst sndcl0

goaway:	movei t,[asciz /User no longer logged in, message not sent./]
	jrst sndcls

hstout:	.call [	setz
		sixbit /OPEN/
		movsi .uii
		movei hstich
		[sixbit /DSK/]
		[sixbit /HOSTS2/]
		[sixbit />/]
		setz [sixbit /SYSBIN/]]
	 jrst nout
	.call [	setz
		sixbit /FILLEN/
		movei hstich
		setzm t]
	 jsr die
	addi t,1777
	lsh t,-12		;get page count
	movsi t,-1(t)
	xor t,[-1,,hstpag_-12]	;make aobjn pointer to hstpag
	.call [	setz
		sixbit /CORBLK/
		movei %cbndr
		movei %jself
		t
		setzi hstich]
	 jsr die
	.close hstich,

fndnet:	ldb d,[331000,,a]	;get network number
	move b,hstpag+netptr	;pointer to network table
	move t,hstpag+0(b)	;number of network entries
	move tt,hstpag+1(b)	;size of those entries
	addi b,hstpag+2
fndnt1:	camn d,netnum(b)	;is this our network?
	 jrst fndhst		;yes, go find host then
	add b,tt		;point to next network
	sojg t,fndnt1		;if there are still any to be found
	jrst nout		;didnt find network, give up

fndhst:	hrrz b,ntlnam(b)	;yes, get address table pointer
	move t,hstpag+0(b)	;get number of entries
	move tt,hstpag+1(b)	;and size of each entry
	addi b,hstpag+2
fndhs1:	camn a,addadr(b)	;this the right address?
	 jrst fndnam		;yes, go stick in the asciz name
	add b,tt		;move to next entry
	sojg t,fndhs1		;so long as there are more to come
	jrst nout

fndnam:	hlrz t,adlsit(b)	;get site pointer
	hlrz t,hstpag+stlnam(t)	;and official name from there, fall into sout to type it
	addi t,hstpag

sout:	hrli t,440700		;insert asciz string from t to e increment count in c
sout1:	ildb tt,t
	jumpe tt,cpopj
	idpb tt,e
	aoja c,sout1

nout:	movei t,(a)		;clear network number
nout0:	jumpe t,cpopj		;cheapo number typer
	idivi t,10
	push p,tt
	pushj p,nout0
	pop p,tt
	addi tt,"0
	idpb tt,e
	addi c,1
cpopj:	popj p,

msgsiz==20000
netbuf:	block msgsiz+3/4
msgbuf:	block msgsiz+4/5
hstpag==.\1777+1

end go