PDP-10.its/src/sysen1/up.35

;;; -*-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   <host-number> or <host-name>
:kill *]
	.value [asciz *:Usage is:
:down <host-number> or <host-name>
: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