; -*- Midas -*-

title SENVER - Chaosnet SENd serVER

a=1
b=2
c=3
d=4
e=5
t=6
tt=7
pbp=10
h=11		;BP to the ascii message buffer w/header
hl=12		;Number of bytes in above buffer
n=13		;BP to the chaos-format message text
nl=14		;Number of bytes of above
k=15		;Kount of #bytes in CLS packet
l=16
p=17

call=pushj p,
return=popj p,

hosti==1	;To suck in HOSTS3 with
usri==2		;To test for loginedness of local people
outo==3		;Outputting the message, either CLI or MAIL:
chaosi==4	;The twisted pair.
chaoso==5
erri==6		;For sucking in an error message

pdlen==20
nw%chs==:7	;Chaosnet host#
nw%arp==:12	;Arpanet host#
hostsp==100	;Page to map in HOSTS3 at
length==2000*10	;Number of bytes to allow for a message

.insrt dsk:system;chsdef

define syscall op,args
	.call [setz ? .1stwd sixbit /op/ ? args(400000)]
termin

define type &string
	movei t,<.length string>
	move tt,[440700,,[ascii string]]
	syscall siot,[movei outo ? move tt ? move t]
	 jfcl
termin

subttl Silly Random Crufty Storage

pdlist:	-pdlen,,.
	block pdlen

debug:	0		;Non-0 for debugging
tolate:	0		;Non-0 if it is too late to refuse connection.
error:	0		;Gack!  .CALL error code!
here:	0		;Our hostname

hostn:	0		;Host number you are sending to
host6:	0		;Sixbit abbreviated name of...
l$host:	0		;Length of below name.
phost:	440700,,host
host:	block 20	;Host name you're sending to.

from:	block 20

pfsite:	440700,,fsite
fsite:	block 20	;From site.
msglen:	0		;Length of incoming message.

l$name:	0		;Length of below name...
name6:	0		;Sixbit of name, for ITS messages.
pname:	440700,,name
name:	block 20	;Who you're sending to.

usr:	sixbit /USR/	;Sometimes clobbered to "AIUSR" or similar
cli:	sixbit /CLI/	;Likewise

packet:	block %cpmxw	;One chaotic bundle.

tsint:	loc 42		;Interrupt handler
	-tsintl,,tsint
loc tsint
	p			;need a stack
	%piioc ? 0 ? -1 ? -1 ? iocerr
tsintl==:.-tsint

iocerr:	call choke		;sigh

$$hst3==1
$$arpa==1
$$chaos==1
$$hstmap==1
$$hostnm==1
$$symlook==1
$$mit==1
$$hstsix==1
.insrt dsk:syseng;netwrk


subttl Do It

begin:	.close 1,		;Might still be open from loading us.
	move p,pdlist
	move tt,[-2,,[
		.soption,,[(%opint\%opopc)]	;We use new-style interrupts.
		.smask,,[%piioc]	;Interrupt in IOC errors
		]]
	.suset tt
	syscall chaoso,[movei chaosi ? movei chaoso ? movei 5]
	 call die
	movei t,%colsn
	dpb t,[$cpkop packet]		;LiSteN for...
	movei t,4
	dpb t,[$cpknb packet]		;A name with this many bytes,
	move t,[.byte 8 ? "S ? "E ? "N ? "D]
	movem t,packet+%cpkdt		;Namely that.
	syscall pktiot,[movei chaoso ? movei packet]
	 call die
	movei a,5*30.			;Five seconds,
	skipe debug
	 movei a,60.*60.*30.		;or 1 hour if debugging.
	syscall netblk,[movei chaosi ? movei %cslsn
			move a		;Wait this long
			movem t]	;Will be new socket state.
	 call die
	caie t,%csrfc			;Was there an RFC?
	 call die			;  Then what are we doing here??
	syscall pktiot,[movei chaosi ? movei packet]	;Yes, so suck it in.
	 call die
	syscall sstatu,[repeat 6,[ ? movem here]]
	 jfcl
	movei a,hostsp
	movei b,hosti
	call netwrk"hstmap		;Inhale HOSTS3 binary.
	 call die
	ldb b,[$cpksa packet]
	hrli b,nw%chs_9
	call netwrk"hstsrc		;Find sender's site.
	 caia
	  jrst fsitok
fsituk:	move d,pfsite			;Sender's site is unknown.
	ldb b,[$cpksa packet]		;Make a fake name.
	call octdpb			;Looks like octal Chaos addr.
	move a,[440700,,[asciz "/CHAOS"]]	;Followed by net name.
fsitu1:	ildb t,a
	idpb t,d			; * Note that since NETWRK"HSTLOOK
	skipe t				; * can parse addresses like this.
	 jrst fsitu1			; * (Therefore the SENDER program can
	jrst benice			; *  actually REPLY to these frobs!)

fsitok:	hrli a,440700
	move b,pfsite
weeeee:	ildb t,a
	jumpe t,benice
	idpb t,b
	jrst weeeee

subttl We are Alive - Be Sociable

benice:	skipe debug
	 jrst parse			;No need to be sociable if bizy
	ldb t,[$cpksa packet]		;Source address.
	move a,[sixbit /000C00/]	;The jname template.
	dpb t,[220300,,a]		;Save low byte: 00xS00
	lsh t,-3
	dpb t,[300300,,a]		;Next highest:  0x0S00
	lsh t,-3
	dpb t,[360300,,a]		;And the last:  x00S00
	.suset [.ruind,,t]		;Our user index/job#
	dpb t,[000300,,a]		;Low byte:      000S0x
	lsh t,-3
	dpb t,[060300,,a]		;Finally done:  000Sx0
	move b,a			;B/ xuname, A/ uname
	syscall login,[move a ? [sixbit /CHAOS/] ? move b]
	 aoja a,.-1			;  Loss! Try another uname.
	syscall detach,[movsi 3 ? movei %jself]	;Set ourself free.
	 call die
	.suset [.sjname,,[sixbit /SENVER/]]	;Don't be shy...

subttl See What the Fuck You Want

parse:	setz hl,
	move h,[440700,,buffer]
	ldb l,[$cpknb packet]		;Length.
	move pbp,[440800,,packet+%cpkdt]
	move n,pbp
	setz k,
schaff:	sojl l,hoo
	ildb t,pbp
	caie t,40
	 jrst schaff
	move a,[440700,,name]
	setz b,
usnarf:	sojl l,gotu
	ildb t,pbp
	cain t,40
	 jrst gotu
	cain t,"@
	 jrst gots
	idpb t,a
	aoja b,usnarf

gotu:	jumpe b,hoo			;Be nice about too many blanks.
	movem b,l$name			;Save name length.
gotu1:	move a,[440700,,name]
	move c,[440600,,name6]
	move tt,l$name
	caile tt,6
	 movei tt,6
guloop:	ildb t,a
	caige t,"a
	 subi t,40
	idpb t,c
	sojn tt,guloop
ucheck:	syscall open,[movsi .uii ? movei usri ? move usr
			move name6 ? [sixbit /HACTRN/]]
	 jrst nogots
	.close usri,
	syscall open,[movsi .uio ? movei outo ? move cli
			move name6 ? [sixbit /HACTRN/]]
	 jrst gagged
	.close outo,
	movei a,[asciz /TTY message from chaosnet site /]
	call stuff
	movei a,fsite
	call stuff
	movei a,[asciz /:
/]
	call stuff
	call accept
	movei t,6		; Knock 6 times ("twice on the pipe...")
knock:	syscall open,[movsi .uao ? movei outo ? move cli
			move name6 ? [sixbit /HACTRN/]]
	 caia			; he was there just moment ago...
	  jrst sendit
	sojle t,gone		; I guess he went away
	movei tt,30.		; Knock every 1 second
	.sleep tt,
	jrst knock		; Go knock on his door again

subttl Dolt!  You specified a site!  VERIFICATION!

gots:	jumpe b,hoo
	movem b,l$name
	move a,phost
	setz b,
gsloop:	sojl l,scheck
	ildb t,pbp
	cain t,40
	 jrst scheck
	cail t,"a
	 trz t,40
	idpb t,a
	aoja b,gsloop

scheck:	jumpe b,gotu1			;Not really a site here.
	movem b,l$host
	movei a,host
	call netwrk"hstlook
	 jrst badsite
	movem a,hostn
	hlrz t,1(b)
	add t,netwrk"hstadr
	hlrz tt,1(t)
	add tt,netwrk"hstadr
	move c,(tt)
	camn c,[ascii /ITS/]
	 jrst [	call netwrk"hstsix
		 jfcl
		lsh a,4*6
		camn a,here
		 jrst gotu1
		movem a,host6
		move t,usr
		lsh t,-6*2
		ior t,a
		movem t,usr
		move tt,cli
		lsh tt,-6*2
		ior tt,a
		movem tt,cli
		jrst gotu1 ]
	call accept
	move a,[440700,,from]
	setz b,
gfrom:	sojl l,qsend
	ildb t,pbp
	idpb t,a
	aoja b,gfrom

qsend:	jumpe b,nofrom
	syscall open,[movsi .uao ? movei outo ? [sixbit /DSK/] ? moves error
			[sixbit /MAIL/] ? [sixbit />/] ? [sixbit /.MAIL./]]
	 call losage
	type "FROM-PROGRAM:SENVER
FROM:"
	move a,[440700,,from]
	syscall siot,[movei outo ? move a ? move b ? moves error]
	 call losage
	type "
RCPT:("
	move t,pname
	move tt,l$name
	syscall siot,[movei outo ? move t ? move tt ? moves error]
	 call losage
	.iot outo,["@]
	move t,phost
	move tt,l$host
	syscall siot,[movei outo ? move t ? move tt ? moves error]
	 call losage
	type " (R-MODE-SEND 0))
TEXT;-1
"

subttl Send the Silly Thing and then Quit

sendit:	move t,[440700,,buffer]
	move tt,hl
	syscall siot,[movei outo ? move t ? move tt ? moves error]
	 call losage
done:	.close outo,
close:	.close chaoso,
	.close chaosi,
	call die

loss:	call gargle
loss1:	dpb k,[$cpknb packet]		;Length
	movei t,%cocls
	dpb t,[$cpkop packet]		;Opcode
	syscall pktiot,[movei chaoso ? movei packet]
	 call choke
	call choke

choke:	skipn tolate
die:	 skipe debug
	  .value
	.logout 1,

subttl Random and Sundry Subroutines

;;; OCTDPB - Deposit octal number in B down ASCII Bp in D.
;;; Smashes B,C; Updates D.

octdpb:	idivi b,8.
	movm b,b
	movm c,c
octdp1:	addi c,"0
	caile c,"9
	 addi c,<"a-10.-"0>
	jumpe b,octdp2
	hrlm c,(p)
	idivi b,8.
	call octdp1
	hlrz c,(p)
octdp2:	idpb c,d
	return

accept:	movei t,%coopn
	dpb t,[$cpkop packet]
	syscall pktiot,[movei chaoso ? movei packet]
	 call die
	setom tolate
	move t,[440800,,netbuf]
	movei tt,length
	syscall siot,[movei chaosi ? move t ? move tt ? moves error]
	 call losage
	jumpe tt,toobig
	movei nl,length
	sub nl,tt
transl:	move a,[440800,,netbuf]
send2:	sojl nl,cpopj
	ildb t,a
	cain t,200\^m
	 jrst [	idpb t,h
		movei t,^j
		aoja hl,send3 ]
	trnn t,200
	 skipa
	  caile t,207
send3:	   idpb t,h
	aoja hl,send2

stuff:	hrli a,440700
sloop:	ildb t,a
	jumpe t,cpopj
	idpb t,h
	aoja hl,sloop

gargle:	hrli a,440700
garg1:	ildb t,a
	jumpe t,cpopj
	idpb t,n
	aoja k,garg1

hoo:	movei a,[asciz /You must specify a name in the RFC./]
	jrst loss

toobig:	movei a,[asciz /Message is too big - Can't cope./]
	jrst loss

nogots:	movei a,[asciz /User "/]
	call gargle
	movei a,name
	call gargle
	movei a,[asciz /" is not logged in./]
	jrst loss

gagged:	movei a,[asciz "User is not accepting messages."]
	jrst loss

gone:	movei a,[asciz /User is no longer logged in or accepting messages./]
	jrst loss

badsit:	movei a,[asciz /Invalid site specified: "/]
	call gargle
	movei a,host
	call gargle
	movei a,[asciz /"./]
	jrst loss

nofrom:	movei a,[asciz /Senders name not specified in C->A forwarding RFC./]
	jrst loss

losage:	movei a,[asciz /?ITS LOSSAGE - /]
	call gargle
	syscall open,[movsi .uai ? movei erri ? [sixbit /ERR/]
			movei 4 ? move error]
	 jrst [	movei a,[asciz /?!Can't get error message/]
		jrst loss ]
eloop:	.iot erri,t
	caige t,40
	 jrst loss1
	idpb t,n
	aoja k,eloop
	
popj1:	aos (p)
cpopj:	return

netbuf:	block <length+3>/4

buffer:	block <length+4>/5

	end begin