mirror of
https://github.com/PDP-10/its.git
synced 2026-04-18 17:08:05 +00:00
376 lines
6.1 KiB
Plaintext
Executable File
376 lines
6.1 KiB
Plaintext
Executable File
; -*- Midas -*-
|
||
|
||
title REDRCT - Redirect IP routing
|
||
|
||
a=:1
|
||
b=:2
|
||
c=:3
|
||
d=:4
|
||
e=:5
|
||
t=:6
|
||
tt=:7
|
||
x=:10
|
||
y=:11
|
||
z=:12
|
||
|
||
p=:17
|
||
|
||
ch==:0,,-1
|
||
chttyi==:1
|
||
chttyo==:2
|
||
chutil==:3
|
||
|
||
%fr==:0,,525252
|
||
%fl==:1,,525252
|
||
|
||
call=:pushj p,
|
||
return=:popj p,
|
||
save==:push p,
|
||
rest==:pop p,
|
||
flose=:.lose %lsfil
|
||
slose=:.lose %lssys
|
||
pause=:.break 16,100000
|
||
quit=:.logout 1,
|
||
tyi=:.iot chttyi,
|
||
tyo=:.iot chttyo,
|
||
|
||
define bltdup org,len
|
||
move tt,[<org>,,<org>+1]
|
||
blt tt,<org>+<len>-1
|
||
termin
|
||
|
||
define syscall name,args
|
||
.call [setz ? .1stwd sixbit /name/ ? args(400000)]
|
||
termin
|
||
|
||
popj1: aos (p)
|
||
cpopj: return
|
||
|
||
|
||
|
||
format"$$pcode==:1
|
||
format"$$errs==:0
|
||
.insrt dsk:syseng;format >
|
||
|
||
outstr: syscall siot,[movei chttyo ? a ? b]
|
||
slose
|
||
return
|
||
|
||
define format &string&,args
|
||
call [
|
||
call $format
|
||
.zzz.==-1
|
||
irp arg,,[args]
|
||
save arg
|
||
.zzz.==.irpcnt
|
||
termin
|
||
hrroi a,[ascii string]
|
||
movei b,.length string
|
||
movni c,.zzz.+1
|
||
jrst format"format]
|
||
termin
|
||
|
||
$forma: save a
|
||
save b
|
||
save c
|
||
save [.+2]
|
||
jrst @-4(p)
|
||
rest c
|
||
rest b
|
||
rest a
|
||
rest (p)
|
||
return
|
||
|
||
.vector pdl(lpdl==:100.)
|
||
.vector jcl(ljcl==:100.)
|
||
.scalar jclbp
|
||
.scalar badadr,badid
|
||
.scalar newadr
|
||
.scalar ofset
|
||
|
||
usrvar: sixbit /OPTION/ ? tlo %opint\%opopc
|
||
sixbit /MASK/ ? move [%pipdl]
|
||
sixbit /OPTION/ ? movem a
|
||
lusrvar==:.-usrvar
|
||
|
||
go: move p,[-lpdl,,pdl-1]
|
||
.open chttyi,[.uai,,'tty ? setz ? setz]
|
||
slose
|
||
.open chttyo,[.uao\%tjdis,,'tty ? setz ? setz]
|
||
slose
|
||
move tt,[-lusrvar,,usrvar]
|
||
syscall usrvar,[movei %jself ? tt]
|
||
slose
|
||
tlnn a,%opcmd
|
||
jrst nojcl
|
||
setzm jcl
|
||
bltdup jcl,ljcl-1
|
||
movsi t,(.byte 7 ? ^C ? ^C)
|
||
movem t,jcl+ljcl-1
|
||
.break 12,[..rjcl,,jcl]
|
||
move t,[440700,,jcl]
|
||
movem t,jclbp
|
||
irps sym,,[NIPGW= NIPMGW= IPGWPG: IPGWTN: IPGWTG: IPGWTM:]
|
||
.scalar sym
|
||
move t,[squoze 0,sym]
|
||
.eval t,
|
||
.lose
|
||
movem t,sym
|
||
termin
|
||
ldb t,[121000,,ipgwpg]
|
||
movei a,syspage
|
||
subi a,(t)
|
||
lsh a,12
|
||
movem a,ofset
|
||
move tt,[-nsyspage,,syspage]
|
||
syscall corblk,[movei %cbndr ? movei %jself ? tt ? movei %jsabs ? t]
|
||
slose
|
||
irps sym,,[IPGWPG IPGWTN IPGWTG IPGWTM]
|
||
move t,ofset
|
||
addb t,sym
|
||
cail t,syspage_12
|
||
caile t,<syspage+nsyspage>_12
|
||
.lose
|
||
termin
|
||
movsi a,((c))
|
||
irps sym,,[IPGWTN IPGWTG IPGWTM]
|
||
hllm a,sym
|
||
termin
|
||
movei a,ffpage
|
||
movei b,chutil
|
||
call netwrk"hstmap
|
||
.lose
|
||
|
||
call jclhst
|
||
jrst badjcl
|
||
call hstid
|
||
movem a,badadr
|
||
movem b,badid
|
||
call jcleof
|
||
jrst gotone
|
||
call jclhst
|
||
jrst gotone
|
||
movem a,newadr
|
||
call jcleof
|
||
jrst gottwo
|
||
call jclhst
|
||
jrst gottwo
|
||
jrst badjcl
|
||
|
||
gotone: move c,@ipgwpg
|
||
gotonx: caml c,nipmgw
|
||
setzi c,
|
||
move a,@ipgwtg
|
||
call hstid
|
||
camn b,badid
|
||
aoja c,gotonx
|
||
movem a,newadr
|
||
gottwo: format "~2& Main Gateways:~2&"
|
||
call mgwtab
|
||
format "~2& Replace "
|
||
move a,badadr
|
||
move b,badid
|
||
call prtadr
|
||
format " by "
|
||
move a,newadr
|
||
call hstid
|
||
call prtadr
|
||
call yornp
|
||
jrst done
|
||
format "~2&"
|
||
movn c,nipgw
|
||
hrlzi c,(c)
|
||
loop: move a,@ipgwtg
|
||
call hstid
|
||
came b,badid
|
||
jrst next
|
||
format "~&Set "
|
||
move a,@ipgwtn
|
||
call prtnet
|
||
call yornp
|
||
jrst next
|
||
move a,@ipgwtg
|
||
move b,newadr
|
||
movei t,@ipgwtg
|
||
sub t,ofset
|
||
hrli t,a
|
||
.ifset t,
|
||
format " ...Lost!"
|
||
next: aobjn c,loop
|
||
done: quit
|
||
|
||
badjcl: format "~&Can't parse JCL."
|
||
nojcl: format |~&Usage is:
|
||
|
||
:REDRCT <old gateway> <optional new gateway>
|
||
|
||
Gateways can be given as hostnames, or in decimal octet form (as in
|
||
"10.0.0.77"). If the new gateway is omitted, REDRCT will simply pick a
|
||
likely-looking gateway from ITS's list of main gateways.
|
||
|
||
REDRCT will ask for confirmation once after it interprets its command, to be
|
||
sure it properly understood what you asked it to do. Then for each routing
|
||
table entry it finds that uses the old gateway, it will ask for confirmation
|
||
before clobbering it with the new gateway.|
|
||
quit
|
||
|
||
; CALL YORNP: Ask a question, skip if answer is yes.
|
||
yornp: format " (Y or N)? "
|
||
tyi t
|
||
caie t,"Y
|
||
cain t,"y
|
||
jrst popj1
|
||
caie t,"N
|
||
cain t,"n
|
||
return
|
||
tyo [^G]
|
||
jrst yornp
|
||
|
||
; CALL JCLHST: Read one hostname from JCL
|
||
; skips if host read
|
||
; A (val): IP address
|
||
; C (val): Terminating character
|
||
jclhst: move a,jclbp
|
||
ildb c,jclbp
|
||
call jcleof
|
||
return
|
||
call chtest
|
||
caia
|
||
jrst jclhst
|
||
jclhs1: ildb c,jclbp
|
||
call chtest
|
||
jrst jclhs1
|
||
setzi t,
|
||
dpb t,jclbp
|
||
call hstadr
|
||
jrst badjcl
|
||
aos (p)
|
||
return
|
||
|
||
; CALL JCLEOF: Skip if character in C cannot end JCL line
|
||
jcleof: caie c,^C
|
||
cain c,^M
|
||
return
|
||
caie c,^_
|
||
cain c,^@
|
||
return
|
||
aos (p)
|
||
return
|
||
|
||
; CALL CHTEST: Skip if character in C cannot be part of a host name
|
||
chtest: cail c,"- ; -, ., /, 0, ..., 9
|
||
caile c,"9
|
||
cail c,"A ; A, ..., Z
|
||
caile c,"Z
|
||
cail c,"a ; a, ..., z
|
||
caile c,"z
|
||
aos (p)
|
||
return
|
||
|
||
netwrk"$$hstmap==:1
|
||
netwrk"$$hostnm==:1
|
||
netwrk"$$symlook==:1
|
||
netwrk"$$netsrc==:1
|
||
netwrk"$$tcp==:1
|
||
netwrk"$$hst3==:1
|
||
.insrt dsk:syseng;netwrk >
|
||
|
||
; CALL HSTADR: Return (some) IP address of host.
|
||
; Skips if name parses
|
||
; A (arg): BP to ASCIZ
|
||
; A (val): IP address
|
||
hstadr: save e
|
||
save b
|
||
call netwrk"hstlook
|
||
jrst hstad1
|
||
tlnn a,(-1_32.) ; No "Unternet"
|
||
aos -2(p)
|
||
hstad1: rest b
|
||
rest e
|
||
return
|
||
|
||
; CALL HSTID: Return "unique" host ID.
|
||
; A (arg): IP address
|
||
; B (val): Unique ID
|
||
hstid: save d
|
||
save a ; (P): IP address
|
||
move b,a
|
||
call netwrk"hstsrc
|
||
skipa b,(p) ; Just use IP address
|
||
hrroi b,(d) ; -1,,<sites table entry>
|
||
rest a
|
||
rest d
|
||
return
|
||
|
||
; CALL PRTADR: Print IP address
|
||
; A (a/v): IP address
|
||
; B (a/v): Host ID
|
||
prtadr: jumpge b,prtad1
|
||
hlrz t,netwrk"stlnam(b)
|
||
add t,netwrk"hstadr
|
||
prtnt2: format "~A (",t
|
||
call prtad1
|
||
tyo [")]
|
||
return
|
||
|
||
; CALL PRTNET: Print network
|
||
; A (a/v): Network
|
||
prtnet: save a
|
||
save b
|
||
move b,a
|
||
call netwrk"netsrc
|
||
jrst prtnt1
|
||
move t,a
|
||
rest b
|
||
rest a
|
||
jrst prtnt2
|
||
|
||
prtnt1: rest b
|
||
rest a
|
||
prtad1: ldb t,[301000,,a]
|
||
ldb x,[201000,,a]
|
||
ldb y,[101000,,a]
|
||
ldb z,[001000,,a]
|
||
format "~D.~D.~D.~D",[t,x,y,z]
|
||
return
|
||
|
||
; CALL MGWTAB: Print table of main gateways
|
||
mgwtab: save a
|
||
save c
|
||
movn c,nipmgw
|
||
hrlzi c,(c)
|
||
mgwtb1: format "~&"
|
||
move a,@ipgwtn
|
||
call prtnet
|
||
format " via "
|
||
move a,@ipgwtg
|
||
call hstid
|
||
call prtadr
|
||
aobjn c,mgwtb1
|
||
rest c
|
||
rest a
|
||
return
|
||
|
||
tsint:
|
||
loc 42
|
||
-ltsint,,tsint
|
||
loc tsint
|
||
400000,,p
|
||
ltsint==:.-tsint
|
||
|
||
dismis: setz ? sixbit /DISMIS/ ? movsi 400000 ? setz p
|
||
|
||
cnstnts:
|
||
constants
|
||
variables
|
||
|
||
patch::
|
||
pat: block 100.
|
||
epatch: -1 ; Make memory exist, end of patch area
|
||
|
||
syspage==:<.+1777>_-12
|
||
nsyspage==:2
|
||
ffpage==:syspage+nsyspage
|
||
|
||
end go
|