;;; -*-MIDAS-*- TITLE UP versio==.fnam2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This is the UP and DOWN programs. Which we are depends on our ; XJNAME. If it is DOWN we are down, else UP. Our SNAME is set to the ; sixbit name of the host. We use whichever network netwrk"hstlook ; gives us, which seems to be chaos. For arpa sites we TCPOPN to 25 ; (SMTP) since not everyone provides anything else like finger. For ; chaos we toss a packet at STATUS. Any answer at all is taken as ; evidence of up'ness, including a CLS. When the appropriate state ; change is seen, a cli message is sent to our originator. We do not ; hack TIP's. This might be possible given the existence of tip links. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;This Version by Bill York (archy);;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;and Benson I. Margulies (bim);;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;November 1980;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; A=1 B=2 C=3 D=4 E=11 T=5 TT=6 T1=7 T2=10 P=17 CLICH==1 ;For sending messages. USRCH==2 ;HACTRN of user who created us. ICPCH==3 ;ICPCH+1 is net output channel. WRKCH==4 ;For NETWRK to use lcmd==<80.+4>/5 ;80. characters of JCL tcprot==25 ;SMTP loc 40 0 0 -ltsint,,tsint loc 100 .insrt syseng;$call macro pat: block 100 lpdl==100 pdl: block lpdl .scalar downfl go: move p,[-lpdl,,pdl-1] .suset [.roption,,a] tlo a,%opint+%opopc move tt,[-4,,[ .soption,,a .smsk2,,[1_usrch] .runame,,c ;This guy's HACTRN .rxjname,,b ;xjname controls function ]] .suset tt .call [setz ? sixbit /open/ move [.uii,,usrch] move [sixbit /usr/] move c setz [sixbit /hactrn/]] .lose %lsfil setzm downfl camn b,[sixbit /down/] setom downfl tlnn a,%opcmd jrst usage move a,[cmd,,cmd+1] ; zero out command buffer setzm cmd blt a,cmd+lcmd-1 setom cmd+lcmd .break 12,[5,,cmd] .vector hostname(lcmd) .scalar hstlen move c,[440700,,cmd] move d,[440700,,hostname] hsloop: ildb t,c caile t,40 idpb t,d ; if not space, tentatively copy out jumpn t,hsloop idpb t,d camn t,[350700,,hostname] ; did we get anything at all? jrst usage movei a,tablespace ;page number movei b,wrkch pushj p,netwrk"hstmap ;get the host table for hstlook jrst deadnet movei a,hostname ;point to JCL pushj p,netwrk"hstlook ;look for a host jumpa NoSuchHost jumpa gotnum usage: skipn downfl .value [asciz *:Usage is: :up or :kill *] .value [asciz *:Usage is: :down or :kill *] .break 16,144000 NoSuchHost: .value [asciz *:Diplomatic Relations do not exist with the specified host. :kill *] .break 16,144000 deadnet: .value [asciz *:The Host Table appears to be unavailable. Sure it isnt April Fools' day? :kill *] .break 16,144000 .scalar host gotnum: movem a,host ;got a host number, wasn't that easy? move b,host pushj p,netwrk"hstsrc jrst deadnet jumpl a,[.value [asciz /:That host is a TIP, try another. :kill /] .break 16,144000] hrli a,440700 ; a byte pointer to host name move c,[440700,,hostname] ; name place seto d, namel: ildb t,a idpb t,c aos d ; count length jumpg t,namel movem d,hstlen move a,host pushj p,netwrk"hstsix skipa .suset [.ssname,,a] pushj p,netwrk"hstunmap ;done with this jfcl fly: .value [asciz "4 "] ;;; At this point we have a host number, and we can check to ;;; see if it is up. This is the main loop. isitup: ; is it up? ldb tt,[netwrk"nw$byt,,host] caie tt,.ldb netwrk"nw$byt,netwrk"nw%chs ;arpa or chaos ? jrst arpa ;; try a chaos connection movei a,icpch ;any old channel move b,host movei c,[asciz/STATUS/] move d,[-lcmd,,cmd] ; point d to a response pushj p,netwrk"chasmp ; Ring Ring jrst down ; no answer jrst up ; we got a CLS, assume UP jrst up ; we got an ANS, assume UP arpa: movei a,icpch move b,host movei c,tcprot ; move d,[40+.uai,,40+.uao] ; modes 8bit, from supdup pushj p,netwrk"tcpcon jrst down jrst up down: .close icpch, skipn downfl jrst sleep move c,[440700,,hostname] ; point to name move b,hstlen dloop: ildb t,c ; bump c sojg b,dloop movei b,.length / is down./ move d,[440700,,[asciz/ is down./]] dloop1: ildb t,d idpb t,c sojg b,dloop1 move t1,[440700,,hostname] move t2,hstlen addi t2,.length / is down./ .uset usrch,[.runame,,a] $call open,[[.uao,,clich],[sixbit /cli/],a,[sixbit /hactrn/]] jrst die .call [setz ? sixbit /siot/ movei clich move t1 setz t2] jfcl .close clich, jrst die up: .close icpch, skipe downfl jrst sleep move c,[440700,,hostname] ; point to name move b,hstlen uloop: ildb t,c ; bump c sojg b,uloop movei b,.length / is up./ move d,[440700,,[asciz/ is up./]] uloop1: ildb t,d idpb t,c sojg b,uloop1 move t1,[440700,,hostname] move t2,hstlen addi t2,.length / is up./ .uset usrch,[.runame,,a] $call open,[[.uao,,clich],[sixbit /cli/],a,[sixbit /hactrn/]] jrst die .call [setz ? sixbit /siot/ movei clich move t1 setz t2] jfcl .close clich, die: .logout 2, ; if we are toplevel die here .value ; if not stick around for debugging sleep: movei a,30.*30. .sleep a, jrst isitup tsint: p 0 ? 1_usrch ? 0 ? 1_usrch ? die ltsint==:.-tsint cmd: block lcmd -1 ; Set flags to get the things we want from the network utils $$hst3==1 $$tcp==1 $$arpa==1 $$chaos==1 $$connect==1 $$hostnm==1 $$symlook==1 $$hstmap==1 $$hstsix==1 $$simple==1 $$errhan==0 ;usencp: 0 ;what are these for? ;usetcp: 0 debug: 0 ;NETWRK at least looks at this... .insrt syseng;netwrk consta ; dump the literals to avoid bashing them variab ; same for .vector & friends tablespace==<.+1777>/2000 ;place for hostab END GO