mirror of
https://github.com/PDP-10/its.git
synced 2026-02-18 21:47:28 +00:00
SENVER - Chaosnet SEND server.
This commit is contained in:
Lars Brinkhoff
445
src/sysnet/senver.45
Executable file
445
src/sysnet/senver.45
Executable file
@@ -0,0 +1,445 @@
|
||||
; -*- 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 /ÔTY 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
|
||||
Reference in New Issue
Block a user