; -*- 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,[,,+1] blt tt,+-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,_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 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,, 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