Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetDistr_7-23-85 - decnet-sources/dnconn.mac
There are 10 other files named dnconn.mac in the archive. Click here to see a list.
;DORK20:<SOURCES>DNCONN.MAC.2 17-May-84 14:23:45, Edit by GMAROTTA
; Added value HOSMAX==2000 to be the max size of HOSTAB
; HOSTAB: BLOCK HOSMAX	and	DNINI+1: MOVEI T1,HOSMAX-1
;<DECNET-SOURCES>DNCONN.MAC.2  1-May-84 15:47:25, Edit by BLINN
; Changes to allow more host names in SYSTEM:DECNET-HOSTS.TXT
;  Increased size of STRN from 40000 to 100000.
;  Increased size of HOSTAB from 1000 to 2000.
;  Cosmetics on commas.
;<LCAMPBELL.DECNET>DNCONN.MAC.57 21-May-81 12:49:26, Edit by LCAMPBELL
; Allow nonexistent host table, implement account/userid/pswd for
; non-pass-through hosts, lengthen sleep times, etc. etc.
;<LCAMPBELL.DECNET>DNCONN.MAC.53 20-May-81 14:46:34, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>DNCONN.MAC.52 20-May-81 14:43:02, Edit by LCAMPBELL
; Return addr of host table to caller of .DNINI (for COMND recognition)
;<LCAMPBELL.DECNET>DNCONN.MAC.51 20-May-81 13:57:13, Edit by LCAMPBELL
; Added /NOMAIL20 for MS's use (we ignore it)
;<LCAMPBELL.DECNET>DNCONN.MAC.50 19-May-81 12:52:30, Edit by LCAMPBELL
; Created from code ripped out of DMAILR

;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1981,1982,1985  by Digital Equipment Corporation
;			Maynard, Massachusetts, USA


	TITLE DNCONN - DECNET Connect Utility

	SUBTTL Larry Campbell

	SEARCH MACSYM,MONSYM
	SALL
	.DIRECTIVE FLBLST

T1=1
T2=2
T3=3
T4=4
P1=5
P2=6
P3=7
P4=10
AP=12		; Argument block pointer
F=13		; Flags
W1=14
W2=15
JFN=16
P=17
;User interface to DNCONN - DECNET connect utility, with pass-through
;
;Routines are called by PUSHJ 17,<routine>
;All accumulators except 1 and 2 are preserved
;
;Entry points:
;
;.DNINI	Init routing database and memory manager
;
;	AC1/ address of argument block (see DNCUNV.MAC for format)
;
;Return	+1: failure, AC1 points to error message, and error
;	    message has already been output to appropriate destination
;	+2: success, AC1 contains address of TBLUK table containing
;	    names of all known hosts (the RH of each entry in this table
;	    should be ignored by the calling program)
;
;	Called only once at program startup, or whenever the routing
;	 database might have changed.  The argument block is the
;	 same as that for .DNCON, but the only entries referenced
;	 are DN.ERR, DN.WRN, and DN.INF, and these only if errors occur.
;	 (DMAILR calls .DNINI whenever it wakes up to scan
;	 for work to do)
;
;
;.DNCON	Connect to remote object
;
;	AC1/ address of argument block 
;
;Return	+1: failure, AC1 contains either:
;	    String pointer to text of error message
;
;	    In addition, if DN.ERR, DN.WRN, or DN.INF contain
;	     a destination designator, the appropriate text
;	     will have been written to the destination.
;
;	+2: success, JFN for net link in AC1
;
;The caller is responsible for all subsequent I/O and for closing the net link.
;
;Arguments for .DNCON routine - Connect to remote object
;
;	Name	Offset	Contents
;	----	------	--------
	DN.FLG== 0	; Flag bits
	   DN%DTS==1B0		; Preface msgs with date-time stamp
	   DN%SPL==1B1		; Spooler - be more patient
	DN.HST== 1	; String pointer to remote host name
	DN.ROB== 2	; Remote object type (binary number)
	DN.LOB== 3	; Local object type (binary number)
	DN.BSZ== 4	; Byte size (binary number)
	DN.OPT== 5	; String pointer to ASCIZ optional data string
	DN.PWD== 6	; String pointer to ASCIZ password string
	DN.ACN== 7	; String pointer to ASCIZ account string
	DN.USR==10	; String pointer to ASCIZ user-ID string
	DN.ROP==11	; Destination designator for returned optional data
	DN.RPC==12	; Maximum byte count for DN.ROP
	DN.ERR==13	; Destination designator for error messages
	DN.WRN==14	; Destination designator for warning messages
	DN.INF==15	; Destination designator for informational messages
;Parameters

STRN==100000			; Number of words for string space
ROUTEN==^D64			; Max chars in routing string
HOSTNN==^D10			; Max chars in a hostname
HSTPAG==500			; Page into which we map DECNET-HOSTS.TXT
HOSMAX==2000			; Max size of HOSTAB

;Impure storage

DATBEG:
PMRHAK:	BLOCK 1
ATTEMP: BLOCK 1
HTABJ: BLOCK 1
HNPTR: BLOCK 1
RTPTR: BLOCK 1
HFPGS: BLOCK 1
HFCNT: BLOCK 1
HFPTR:	BLOCK 1
HSTR: BLOCK 20
TERM: BLOCK 1
NETJFN: BLOCK 1
TMPST: BLOCK <ROUTEN+5>/5
NJ: BLOCK 1
FNAME: BLOCK 20
PTR0: BLOCK 1
ERRBUF:	BLOCK 50		; Error message buffer
PSSHST:	BLOCK 10		; Name of 1st host in multihop connection
CURRUT:	BLOCK 1			; Address of current route string block
CURHST:	BLOCK 10		; Current (1st) destination host
HOSTAB:	BLOCK HOSMAX		; Host name and route table (TBLUK-style)
FBITS:	BLOCK 1			; Flag bits for current host
STRSPC:	BLOCK STRN		; String space
STRSP0:	BLOCK 1			; Pointer to next free word in string space
DATEND:
ACSAV:	BLOCK 20		; AC save area

;Switch table

SWTTAB:	SWTTB0,,SWTTB0
	[ASCIZ /ANF10/],,0
	[ASCIZ /Gateway.ARPANET/],,0
	[ASCIZ /KAWELL/],,0
	[ASCIZ /NoMail20/],,0	; Can't receive TOPS20-style mail
SWTTB0==.-SWTTAB-1


;MACRO definitions

DEFINE IERROR (STRING),<	;; Internal, fatal error
	JRST [	HRROI T1,ERRBUF		;; Where to build error message
		CALL DTSTMP		;; Date-time stamp maybe
		MOVE T2,[POINT 7,[ASCIZ /STRING/]]
		SETZB T3,T4
		SOUT
		SKIPN T1,DN.ERR(AP)
		JRST .DNLER
		HRROI T2,[ASCIZ /
?/]
		SOUT
		HRROI T2,ERRBUF
		SOUT			;;  then fill it
		HRROI T2,[ASCIZ /
/]
		SOUT
		JRST .DNLER]		;; Return pointing to string
>


DEFINE JERR (PFX,STRING),<		;; JSYS error
	CALL [	HRROI T1,ERRBUF		;; Where to build error string
		CALL DTSTMP		;; CRLF and maybe timestamp
		HRROI T2,[ASCIZ /STRING because: /]
		SETZB T3,T4		;; Build error string
		SOUT
		HRLOI T2,.FHSLF		;; Last JSYS error
		ERSTR
		 JFCL
		 JFCL
		SETZB T3,T4
		HRROI T2,[ASCIZ /
PFX/]
		SKIPE T1,DN.ERR(AP)
		SOUT
		HRROI T2,ERRBUF		;; Point to string we built
		SKIPE T1,DN.ERR(AP)	;; If user supplied message sink,
		SOUT			;;  write the error there
		HRROI T2,[ASCIZ /
/]
		SKIPE T1,DN.ERR(AP)
		MOVE T1,[POINT 7,ERRBUF]
		RET]
>

DEFINE JERROR (PFX,STRING),<
	JRST [	JERR (PFX,STRING)
		JRST .DNLER]		;; Go return failure to caller
>

DEFINE WARN (STRING),<		;; Do warning message
	CALL [IFIDN <STRING><CRLF>,<
		HRROI T1,ERRBUF
		CALL DTSTMP
	      >
	      IFDIF <STRING><CRLF>,<
		HRROI T2,[ASCIZ /STRING/]
		SETZB T3,T4
		SOUT
	      >
		RET]			;; Continue on, this is nonfatal
>


;Type an informational message

DEFINE INFO(STRING),<
	CALL [IFIDN <STRING><CRLF>,<
		HRROI T2,[ASCIZ/
/]
		SETZB T3,T4
		SKIPE T1,DN.INF(AP)
		SOUT
		SKIPE T1,DN.INF(AP)
		CALL DTSTMP		;; CRLF and maybe timestamp
	      >
	      IFDIF <STRING><CRLF>,<
		HRROI T2,[ASCIZ /STRING/]
		SETZB T3,T4
		SKIPE T1,DN.INF(AP)	;;  if one exists
		SOUT
	      >
		RET]
>
;Route-string block definitions

RB.LNK==0		; Link to next route-string block
RB.FLG==1		; Flag bits
RB.RST==2		; Routing string begins here
;Jacket routines -- provide AC-saving and restoring and set up arg ptrs

;Entry point for init routine

.DNINI::EXCH 0,ACSAV		; First save ACs
	MOVE 0,[1,,ACSAV+1]
	BLT 0,ACSAV+17
	MOVE AP,T1		; Get arg block pointer
	MOVE F,DN.FLG(AP)	; Load up flags AC
	CALL DNINI		; Do the work
.DNRSK:	DMOVEM T1,ACSAV+1	; Return these two to caller
	MOVE 0,[ACSAV+1,,1]	; Restore the ACs
	BLT 0,17
	MOVE 0,ACSAV
	RETSKP

;Here for failure return to caller

.DNLER:	MOVE T1,[POINT 7,ERRBUF]
	DMOVEM T1,ACSAV+1	; Restore ACs
	MOVE 0,[ACSAV+1,,1]
	BLT 0,17
	MOVE 0,ACSAV
	RET


;Entry point for connect utility

.DNCON::EXCH 0,ACSAV		; Save ACs
	MOVE 0,[1,,ACSAV+1]
	BLT 0,ACSAV+17
	MOVE AP,T2
	MOVEM AP,PMRHAK
	MOVE AP,T1		; Set up arg ptr
	MOVE F,DN.FLG(AP)
	CALL .DNCN0		; Do the work
	CALLRET .DNRSK		; Go do winning return
;DNINI - Init memory manager and routing database
; Local flag: P2 nonzero indicates that we've found the routing string

DNINI:	CALL INIMEM		; Init memory manager
	MOVEI T1,HOSMAX-1	; Empty host table first
	MOVEM T1,HOSTAB		;  ..
	MOVX T1,GJ%SHT!GJ%OLD
	HRROI T2,[ASCIZ /SYSTEM:DECNET-HOSTS.TXT/]
	GTJFN
	 ERJMP R		; Just return quietly if no host table
	MOVX T2,<7B5>+OF%RD
	OPENF
	 ERJMP R
	MOVEM T1,HTABJ
	SIZEF			; Get file size
	 JFCL			; Unlikely
	MOVEM T3,HFPGS		; Save page count
	MOVE T1,[POINT 7,HSTPAG*1000]
	MOVEM T1,HFPTR		; save
	HRLZ T1,HTABJ		; Map from file page zero
	MOVE T2,[.FHSLF,,HSTPAG]	;  to fork page HSTPAG
	TXO T3,PM%RD!PM%PLD!PM%CNT
	PMAP
	MOVE T1,HTABJ		; Get JFN back
	MOVE T2,[1,,.FBSIZ]	; Get byte count for file
	MOVEI T3,T3		; Into T3
	GTFDB
	 ERJMP [JERROR (?,<GTFDB failure for SYSTEM:DECNET-HOSTS.TXT>)]
	MOVEM T3,HFCNT		; Save
	SETZ P2,		;Flag that no routing string has been found yet
DNINI0:	MOVEI T1,<<HOSTNN+5>/5>	;Room for one host name plus null
	CALL ALLSTR		;Allocate string space
	 IERROR <Host table from SYSTEM:DECNET-HOSTS.TXT too big for internal buffer>
	HRLI T1,(POINT 7,)	;Form byte pointer to this place
	MOVEM T1,HNPTR
	MOVEI T1,<<ROUTEN+5>/5>	;room for routing string plus null
	CALL ALLSTR
	 IERROR <Host table from SYSTEM:DECNET-HOSTS.TXT too big for internal buffer>
	HRLI T1,(POINT 7,)	; Form byte pointer
	MOVEM T1,RTPTR
	MOVE P3,HNPTR		;First we're parsing hostnames
	MOVEI P4,HOSTNN		;max bytes in a hostname
DNINI1:	CALL TBIN		;Get next byte
	 JRST DNINIX
	CAIN T1,"/"		; Switch?
	CALL HSTIDK		; Yes, parse it
	CAIN T1,12		;EOL?
	JRST DNINI4		;Yes, let's see what we've got
	CAIN T1,"="		;MS handles synonyms, we ignore them
	JRST DNINI2
	CAIN T1,","		;Start of routing string?
	JRST DNINI3		;Yes, go handle
	IDPB T1,P3		;No, deposit next char of hostname or route
	SOJG P4,DNINI1		;Watch out for too-long strings

DNINI2:	CALL TBIN		;Synonym - ignore entire line
	 JRST DNINIX
	CAIE T1,12
	JRST DNINI2
	JRST DNINI4		;OK, go see if we have something

DNINI3:	SETZ T1,		; Comma - tie off hostname string and
	IDPB T1,P3		;  begin parsing routing string
	MOVEI P4,ROUTEN		; Max chars in routing string
	MOVE P3,RTPTR		; Where to store routing string
	ADDI P3,RB.RST		; Skip to route string part of block
	SETO P2,		; Flag that routing string was found
	JRST DNINI1		; Go eat more of the file

;Here after EOL found.  P2 will be nonzero if a routing string was found.

DNINI4:	SETZ T1,		;Insure ASCIZ
	MOVE T2,P3
	IDPB T1,T2		; ..
	MOVEI T1,HOSTAB		;TBLUK table for hosts
	HRRO T2,HNPTR		; See if entry already in table
	TBLUK
	TXNN T2,TL%EXM		; Already there?
	JRST DNINI6		; No, add to table then

;If node already in table and this entry has no route string, ignore it

	JUMPE P2,[MOVEI P4,<<HOSTNN+5>/5> ;No routing found - reuse string blks
		MOVE P3,HNPTR		;Back to scanning hostname
		SETZ P2,		;Flag no routing string found yet
		JRST DNINI1]		;Try next line in file
DNINI5:	MOVE T2,T1		; Save addr of current block
	HRRZ T1,(T1)		; Move to next block in chain
	JUMPN T1,DNINI5		; Look for end of chain
	HRRZ T1,RTPTR		; Get address of routing string
	MOVEM T1,(T2)		; Link to list
	JRST DNINI7		; Done
DNINI6:	MOVEI T1,HOSTAB
	HRL T2,HNPTR		; Address of hostname
	HRR T2,RTPTR		; Address of routing string
	TBADD			; Add to the table
	 ERJMP [JERROR (?,<TBADD error adding hosts to routing table>)]
DNINI7:	SETZ P2,		;reset route-string-found flag
	JRST DNINI0		;OK, try for next guy

DNINIX:	SETO T1,		; Unmap file pages now
	MOVE T2,[.FHSLF,,HSTPAG]
	MOVE T3,HFPGS
	TXO T3,PM%CNT
	PMAP
	MOVE T1,HTABJ		;Close JFN and return
	CLOSF
	 JERROR (?,Error closing SYSTEM:DECNET-HOSTS.TXT>)
	MOVEI T1,HOSTAB		; Return address of host table to caller
	RET


;Utility routine to read bytes, ignoring null, LWSP, and CR
; Also eats up comments so higher level need not worry about them
;Return	+1: EOF
;	+2: OK, next byte in T1

TBIN:	SOSGE HFCNT		; Any bytes left?
	RET			; No, nonskip return
	ILDB T1,HFPTR		; Yes, fetch next
	JUMPE T1,TBIN		; Ignore nulls
	CAIN T1,";"		; Comment?
	JRST [	CALL TBIN		; Yes, eat chars until EOL
		 RET			; Pass EOF up to caller
		CAIE T1,12		;  ..
		JRST .			;  ..
		RETSKP]			; OK, return the LF to caller
	CAIN T1,"!"		; Other flavor of comment?
	JRST [	CALL TBIN		; Yes, chew it up
		 RET			; Pass EOF up to caller
		CAIN T1,"!"		; Chew chars until closing bang
		CALLRET TBIN		;  but return next char, not bang
		CAIE T1,12		;  or EOL
		JRST .			; Neither case, keep munching
		RETSKP]			; EOL, return it
	CAIE T1," "		; Ignore spaces
	CAIN T1,15		;  and CR
	JRST TBIN
	CAIN T1,11		; Ignore tabs
	JRST TBIN
	RETSKP
;Parse switch
;Return	+1: always, T1/ terminating character, T2 trashed

HSTIDK:	MOVEI T2,HSTR		; Point to place to stuff switch
	HRLI T2,(POINT 7,)
HSTDK0:	CALL TBIN		; Get a byte
	 JRST HSTDK1		; Let someone else bite it on this one
	CAIG T1,172
	CAIGE T1,101		; If not alphabetic,
	JRST HSTDK1		; Finish up and quit
	TRZ T1,40		; Uppercase
	IDPB T1,T2		; Stuff into switch
	JRST HSTDK0		; Loop thru all chars
HSTDK1:	MOVEM T1,TERM		; Save terminator
	SETZ T1,			; Insure ASCIZ
	IDPB T1,T2
	MOVEI T2,HSTR		; Point to switch name
	MOVEI T1,SWTTAB		; Switch table
	TBLUK
	ERJMP [	JERROR (?,<TBLUK error while parsing switches from SYSTEM:DECNET-HOSTS.TXT>)]
	TXNN T2,TL%EXM+TL%ABR		; Found this switch?
	JRST [	WARN CRLF
		WARN <Unknown switch >
		HRROI T2,HSTR
		SETZB T3,T4
		SOUT
		WARN < in SYSTEM:DECNET-HOSTS.TXT>
		SKIPN T1,DN.WRN(AP)
		RET
		HRROI T2,[ASCIZ/
%/]
		SOUT
		HRROI T2,ERRBUF
		SOUT
		HRROI T2,[ASCIZ/
/]
		SOUT
		RET]
	HRRZ T1,(T1)		; Get bits associated with switch
	IORM T1,FBITS		; Save for posterity
	MOVE T1,TERM		; Return terminator
	RET			; Return
;.DNCON - Connect to remote object

.DNCN0:	SETZM CURRUT		; Init state variables
	SETZM PSSHST
	SETZM CURHST
	SETZM ATTEMP
	AOS ATTEMP
	JRST .DNCO2		; Skip alternate path verbiage first pass
.DNCO1:	INFO < trying alternate path, >
	AOS ATTEMP
.DNCO2:	CALL HSTNAM		; Get JFN for server or pass-through
	MOVEM T1,NETJFN
	SKIPE PSSHST		; Doing any routing?
	JRST [	INFO <routing = >	; Yes, be chatty
		HRROI T2,PSSHST
		SETZB T3,T4
		SKIPE T1,DN.INF(AP)	; If we have a place to put msgs,
		SOUT			;  output it
		INFO <::>
		JRST .+1]
	MOVE T1,NETJFN		; pass net JFN to OPNLNK
	CALL OPNLNK
	 JRST TRYAGN
	CALL PSSNEG		; Negotiate with pass-through task if necessary
	 JRST [	MOVE T1,NETJFN		; OK, dump the JFN, it didn't work
		TXO T1,CZ%ABT
		CLOSF
		 JFCL
		JRST TRYAGN]
;	INFO <connect OK, >
	INFO CRLF
	MOVE T1,NETJFN
	RET			; Win!!


;Here to try for another path
TRYAGN:	CALL ALTRNT
	 JRST .DNCO1		; Yes, go use it
	HRROI T1,ERRBUF
	HRROI T2,[ASCIZ /Connection failed after /]
	SETZB T3,T4
	SOUT
	MOVE T2,ATTEMP
	MOVEI T3,^D10
	NOUT
	 JFCL
	HRROI T2,[ASCIZ / routing attempt/]
	SETZB T3,T4
	SOUT
	MOVEI T2,"s"
	MOVE T3,ATTEMP
	CAIE T3,1
	BOUT
	SETZ T2,
	BOUT
	SETZB T3,T4
	SKIPN T1,DN.ERR(AP)
	JRST .DNLER
	HRROI T2,[ASCIZ /
?/]
	SOUT
	HRROI T2,ERRBUF
	SOUT
	HRROI T2,[ASCIZ /
/]
	SOUT
	JRST .DNLER		; No, report failure to caller
;Utility routine to test for alternate path to a host
;Return	+1: Alternate path exists
;	+2: nope

ALTRNT:	SKIPN T1,CURRUT		; Point to current routing string block
	RETSKP			; No alternate path if no routing
	HRRZ T1,(T1)		; Get possible address of alternate
	JUMPN T1,R		; If nonzero, there's a path
	RETSKP
;PSSNEG - Negotiate hairy routing with pass-through task
;Call with:
;	T1/ JFN of net link to first pass-through task
;Return	+1: failure, error message(s) already logged
;	+2: success, JFN now speaks to mail listener at other end

PSSNEG:	SKIPN PSSHST		; are we routing at all?
	RETSKP			; no, just pretend we did good stuff
	MOVEM T1,NJ		; Save net JFN
	MOVE T2,CURRUT		; Point to current routing string block
	ADDI T2,RB.RST		; Skip to string part
	HRLI T2,(POINT 7,)	; ..
PSSNG0:	ILDB T1,T2		; Skip first hostname, we're already there
	JUMPE T1,PSSNFG		; Better not find any nulls here, foax
	CAIE T1,":"
	JRST PSSNG0
	ILDB T1,T2		; Better be two colons
	CAIE T1,":"		;  ..
	JRST PSSNFG		;No !@#$ing good
	MOVEI T1,TMPST		;Where to build crud for msg to psthhru
	HRLI T1,(POINT 7,)
	MOVEI T3,1		;I don't understand what this 1 is for,
	IDPB T3,T1		; but it don't work without it...
	SETZB T3,T4		;Move remainder of routing string there
	SOUT
	SKIPE T3,DN.USR(AP)		;IS USERID FIELD PRESENT
	CALL [HRLI T3,(POINT 7,0)
		ILDB T4,T3
		SKIPE T4
		TRO F,1		;USERID IS PRESENT
		RET]
	SKIPE T3,DN.PWD(AP)		;IS PASSWORD FIELD PRESENT
	CALL [HRLI T3,(POINT 7,0)
		ILDB T4,T3
		SKIPE T4
		TRO F,2
		RET]
	SKIPE T3,DN.ACN(AP)
	CALL [HRLI T3,(POINT 7,0)
		ILDB T4,T3
		SKIPE T4
		TRO F,4
		RET]
	SETZB T3,T4
	TRNE F,7		;ANY ACCOUNTING FIELDS PRESENT?
	JRST PSSNG4		;YES
	JRST [	HRROI T2,[ASCIZ /"/]	; All of them are blank,
		JRST PSSNG3]		;  skip this stuff entirely
PSSNG4:	MOVNI T2,2		; Back up over terminating double colon
	ADJBP T2,T1		;  ..
	MOVE T1,T2		;  ..
	MOVEI T2,42		; Delimit user-id/password/account strings
	IDPB T2,T1		;  with doublequote
	TRNN F,1		;USERID THERE?
	JRST PSS.A		;NO
	MOVE T2,DN.USR(AP)
	HRLI T2,(POINT 7,0)
	CALL UQSOUT
	MOVE T4,F		;GET FLAGS
	ANDI T4,7		;GET THE BITS
	MOVEI T2," "		;GET A SPACE
	CAIE T4,7
	CAIN T4,3
	IDPB T2,T1		;YES, OUTPUT A SPACE
	SETZ T4,
PSS.A:	TRNN F,2
	JRST PSS.B
	MOVE T2,DN.PWD(AP)
	HRLI T2,(POINT 7,0)
	CALL UQSOUT
	MOVEI T2," "
	MOVE T4,F
	ANDI T4,7
	CAIN T4,7
	IDPB T2,T1		;OUTPUT A SPACE
	SETZ T4,
PSS.B:	TRNN F,4		;ACCOUNT STRING THERE?
	JRST PSS.C		;NO
	MOVE T2,DN.ACN(AP)
	HRLI T2,(POINT 7,0)
	CALL UQSOUT
PSS.C:	HRROI T2,[ASCIZ /"::"/]	; More punctuation
PSSNG3:	SOUT			;  ..
	SKIPN T2,DN.ROB(AP)	; Get remote object type
	IERROR <No remote object type specified when .DNCON was called>
	MOVX T3,^D10		; Decimal number
	NOUT
	 JERROR (?,<NOUT failure at PSSNEG>)
	MOVEI T2,"="		; Punctuate!
	IDPB T2,T1		;  ..
	MOVEI T2,42		; Close quote
	IDPB T2,T1		;  ..
	SETZ T2,		; Insure ASCIZ
	IDPB T2,T1
	MOVE T1,NJ		;JFN of net link
	HRROI T2,TMPST		;Message to send
	SETZB T3,T4
	SOUTR			;Force the message out
	 ERJMP [JERR (%,<Couldn't send path to pass-through task>)
		RET]
PSSNG1:	MOVE T1,NJ		;Now read the response
	HRROI T2,TMPST
	SETZB T3,T4
	SINR
	 ERJMP [WARN CRLF
		WARN <Couldn't read reply from pass-through task because: >
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		SKIPN T1,DN.WRN(AP)
		RET
		HRROI T2,[ASCIZ /
%/]
		SOUT
		HRROI T2,ERRBUF
		SOUT
		HRROI T2,[ASCIZ /
/]
		SOUT
		RET]
	SETZ T4,		;tie off reply
	IDPB T4,T2		; ..
	HRROI T1,ERRBUF
	HRROI T2,TMPST
	SETZB T3,T4
	SOUT			;MOVE THE ANSWER
	MOVE T2,[POINT 7,ERRBUF]
	MOVE T1,[POINT 7,TMPST]
FIXUP:	ILDB T3,T2		;GET A BYTE
	JUMPE T3,ENDF.2		;ALL DONE
	CAIN T3,""""		;DOUBLE QUOTE?
	JRST FIXIT		;YES
	IDPB T3,T1		;SAVE IT
	JRST FIXUP
FIXIT:	IDPB T3,T1		;SAVE IT
	ILDB T3,T2		;GET A BYTE OF THE USER ID
	JUMPE T3,ENDF.2
	CAIN T3,""""
	JRST ENDF.1
	CAIE T3," "
	JRST FIXIT
	IDPB T3,T1		;THE BLANK
	PUSH P,T2
	HRROI T2,[ASCIZ/password/]
	setzb t3,t4
	SOUT
	POP P,T2
EATUP:	ILDB T3,T2		;EAT UP THE PASSWORD
	JUMPE T3,ENDF.2
	CAIN T3,""""
	JRST ENDF.1
	CAIE T3," "
	JRST EATUP
ENDF.1:	IDPB T3,T1
	SETZB T3,T4
	SOUT
	JRST ENDF.3
ENDF.2:	IDPB T3,T1
ENDF.3:	MOVEI P3,TMPST		;Point to reply we just read
	HRLI P3,(POINT 7,)
	ILDB P4,P3		;Get the answer
	CAILE P4,1		;I think 1 means success...
	JRST [	WARN CRLF
		MOVE T2,P3		;  to caller's warning designator
		SETZB T3,T4
		SOUT
		SKIPN T1,DN.WRN(AP)
		RET
		HRROI T2,[ASCIZ/
%/]
		SOUT
		HRROI T2,ERRBUF
		SOUT
		HRROI T2,[ASCIZ /
/]
		SOUT
		RET]
	SKIPN T1,DN.INF(AP)	; Success, write pass-through's verbiage
	JRST PSSNG2
	MOVE T2,P3		;  to info destination
	SETZB T3,T4
	SOUT			;Be informative
PSSNG2:	JUMPE P4,PSSNG1		;read msgs until a 1-prefixed msg arrives
	INFO <, >
	RETSKP

PSSNFG:	IERROR <bad format for internal host table>

; DO A SOUT, DELETING ALL ^V'S ON THE WAY
UQSOUT:	ILDB T3,T2
	CAIN T3,26
	JRST UQSOUT
	JUMPE T3,UQEND
	IDPB T3,T1
	JRST UQSOUT
UQEND:	PUSH P,T1
	IDPB T3,T1
	POP P,T1
	RET
;Get JFN for net link, either to host on local net, or to pass-through task

HSTNAM:	HRROI T1,FNAME		;build prefix of net JFN string
	HRROI T2,[ASCIZ /DCN:/]
	SETZB T3,T4
	SOUT
	MOVEM T1,PTR0		; Save filespec pointer for a bit
	HRROI T1,CURHST		; Stuff destination hostname in here
	SKIPN T2,DN.HST(AP)	; Get host name pointer
	IERROR <No host name supplied when .DNCON was called>
	SOUT
	SKIPE T1,CURRUT		; See if trying 2nd thru nth route
	JRST [	HRRZ T1,(T1)		; Yes, fetch next route
		JRST HSTNA2]
	MOVEI T1,HOSTAB		;see if this host is nonadjacent
	HRROI T2,CURHST		; ..
	TBLUK
	 ERJMP [JERROR (?,<TBLUK failure at HSTNAM>)]
	TXNE T2,TL%EXM		;Is it in the nonadjacent table?
	JRST [	HRRZ T1,(T1)		; Yes, point to route string block
		JRST HSTNA2]		; Go do the routing
HSTNA0:	HRROI T2,CURHST		; No, just connect straight on thru then
	MOVE P1,DN.ROB(AP)	; Get remote object type
	SETZM PSSHST		; Flag that no routing is being done
HSTNA1:	MOVE T1,PTR0		; Restore ptr to partial filespec
	SETZB T3,T4
	SOUT			; Tack on hostname
	MOVEI T2,"-"		; Punctuation for network filespec
	IDPB T2,T1		;  ..
	MOVE T2,P1		; Object type (final dest, or pass-through)
	MOVX T3,^D10		; Move it in decimal
	NOUT
	 JERROR (?,<NOUT failure at HSTNA1>)
	SETZB T3,T4
	HRROI T2,[ASCIZ /;BDATA:144011/]
	SKIPE PMRHAK		; SEND OPTIONAL DATA?
	SOUT			;YES
	SKIPN PSSHST		; Is this a direct connection?
	CALL MVATTR		; Yes, move file attributes then
	MOVX T1,GJ%SHT		; Get a JFN on the net file
	HRROI T2,FNAME
	GTJFN
	 ERJMP [JERROR (?,<Can't GTJFN for net link>)]
	RET			; Return with JFN in T1


;Here if routing node -- set up for connect to pass-thru task in adjacent node

HSTNA2:	MOVEM T1,CURRUT		; Save current routing block address
	ADDI T1,RB.RST		; Skip to routing string word
	SKIPN (T1)		; If this route string is null (i.e., adjacent
	JRST HSTNA0		;  node with alternate, nonadjacent routing)
				;  just ignore and try direct connect
	HRLI T1,(POINT 7,)	; Form string pointer
	MOVE T3,[POINT 7,PSSHST]; Where to put name of adjacent node
HSTNA3:	ILDB T2,T1		; Move chars from routing string
	JUMPE T2,[IERROR <Bad routing string at HSTNA3>]
	CAIN T2,":"		;stop at first colon
	JRST HSTNA4
	IDPB T2,T3		;store chars of 1st node in route
	JRST HSTNA3
HSTNA4:	SETZ T2,		; Insure ASCIZ
	IDPB T2,T3		;  ..
	HRROI T2,PSSHST		; This will be host to connect to
	MOVEI P1,^D123		; Object type for pass-through task
	JRST HSTNA1
;Move file attributes into filespec string pointed to by T1

MVATTR:	PUSH P,P1		; Get a reg
	SETZB T3,T4		; Set up for all those SOUTs
	SKIPN P1,DN.USR(AP)	; UserID specified?
	JRST MVATT0		; No, skip this
	HRLI P1,(POINT 7,0)
	ILDB T2,P1
	JUMPE T2,MVATT0
	MOVE P1,DN.USR(AP)
	HRROI T2,[ASCIZ /;USERID:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT0:	SKIPN P1,DN.PWD(AP)	; Password
	JRST MVATT1
	HRLI P1,(POINT 7,0)
	ILDB T2,P1
	JUMPE T2,MVATT1
	MOVE P1,DN.PWD(AP)
	HRROI T2,[ASCIZ /;PASSWORD:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT1:	SKIPN P1,DN.ACN(AP)	; Account
	JRST MVATT2
	HRLI P1,(POINT 7,0)
	ILDB T2,P1
	JUMPE T2,MVATT2
	MOVE P1,DN.ACN(AP)
	HRROI T2,[ASCIZ /;CHARGE:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT2:	SKIPN P1,DN.OPT(AP)	; Optional data
	JRST MVATT3
	HRROI T2,[ASCIZ /;DATA:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT3:	POP P,P1
	RET
;Open link to foreign host, JFN in T1

OPNLNK:	MOVEI W2,^D2		;how many times to retry OPENF
	TXNE F,DN%SPL		;if system scan,
	MOVEI W2,^D3		; be more patient
	MOVE JFN,T1		;save JFN

OPNLK1:	MOVEI W1,^D40		;how many times to retry MTOPR
	TXNE F,DN%SPL		;if system scan,
	MOVEI W1,^D80		; be much more patient
	MOVX T2,OF%RD!OF%WR
	SKIPN T3,DN.BSZ(AP)	; Get byte size user specified
	IERROR <Nonzero byte size must be specified when .DNCON is called>
	DPB T3,[POINT 6,T2,5]	; Stuff into OPENF arg
	OPENF
	 ERJMP [MOVE T1,JFN		;restore JFN
		RLJFN			;dump the JFN
		 JFCL
		JERR (%,<Can't OPENF net link>)
		RET]
OPNLK2:	MOVX T2,.MORLS		;read link status
	MTOPR			; ..
	TXNE T3,MO%CON
	RETSKP
	TXNE T3,MO%ABT!MO%SYN	; Has other end already dumped us?
	JRST [	SETZB W1,W2		; Yes, zero wait counts
		JRST OPNLK3]		; Dump the JFN and report the failure
	MOVEI T1,^D500		;wait 1/2 second
	HRRZ T2,T3		; get reason code
	CAIN T2,4		; destination process does not exist?
	MOVEI T1,^D1000		; yes, wait longer (other end may be busy)
	DISMS
OPNLK3:	MOVE T1,JFN		;restore JFN
	SOJG W1,OPNLK2		;check again
	TXO T1,CZ%ABT!CO%NRJ	;dump the link but keep JFN
	CLOSF			; ..
	 JFCL
	TXZ T1,CZ%ABT!CO%NRJ	;dump useless bits
	SOJG W2,OPNLK1		;try the OPENF again
	RLJFN			;no good, dump the JFN
	 JFCL
	; ..
	; ..

	TRNE T3,-1		;disconnection reason?
	JRST [	HRRZS T3		;yes, discard useless bits
		PUSH P,T3		;save reason code
		HRROI T1,ERRBUF		; Build error message in error buffer
		CALL DTSTMP
		HRROI T2,[ASCIZ /Connect failed because: /]
		SETZB T3,T4
		SOUT
		POP P,T3		;get reason code back
		HRRO T2,REASON(T3)
		SKIPL T3
		CAILE T3,NREASN		;range check reason code
		HRROI T2,FUNNY		;out of range, get catch-all msg
		SETZB T3,T4
		SOUT
		SKIPN T1,DN.WRN(AP)	; If no msg sink, finish up
		RET
		SETZB T3,T4
		HRROI T2,[ASCIZ /
%/]
		SOUT
		HRROI T2,ERRBUF		; Do have msg sink, fill it
		SOUT
		HRROI T2,[ASCIZ /
/]
		SOUT
		RET]
	HRROI T1,ERRBUF
	CALL DTSTMP		; time stamp the log file
	HRROI T2,[ASCIZ /Timed out waiting for connect confirm from server process/]
	SOUT
	SKIPN T1,DN.WRN(AP)
	RET
	SETZB T3,T4
	HRROI T2,[ASCIZ /
%/]
	SOUT
	HRROI T2,ERRBUF
	SOUT
	HRROI T2,[ASCIZ /
/]
	SOUT
	RET
SUBTTL Utility routines

;Place CRLF and date/time stamp in log file, dest designator in T1

DTSTMP:	SETZB T3,T4
	TXNN F,DN%DTS		;only if user asked for timestamps
	RET
	SETO T2,		;current date/time
	SETZ T3,		; everything
	ODTIM
	 JFCL
	MOVEI T2," "		; Prettyprint it
	BOUT
	RET


SUBTTL Memory manager (such as it is)

;Init memory manager

INIMEM:	SETZM	HSTPAG*1000	;MAKE THIS PAGE EXIST FOR GLXLIB
	SETZM	DATBEG		;ZERO IMPURE STORAGE FOR GLXLIB
	MOVE T1,[DATBEG,,DATBEG+1] ;IF WE DIDN'T DO THIS GLXLIB
	BLT T1,DATEND-1		;WOULD MEMORY MANAGE OUR MEMORY
	MOVEI T1,STRSPC
	MOVEM T1,STRSP0
	RET


;Allocate c(T1) words of storage
; Returns +1: failure
;	  +2: OK, address in T1

ALLSTR:	MOVE T2,STRSP0		;current free space
	ADDI T2,(T1)		; plus amount requested
	CAIL T2,STRSPC+STRN	;overflow?
	RET			;yes, fail
	MOVE T2,STRSP0		;no, get address of this string
	PUSH P,T2		;save for a bit
	SETZM (T2)		;zero it
	HRLZI T3,(T2)		;build BLT pointer
	HRRI T3,1(T2)		; ..
	ADDI T2,-1(T1)		;last word to zero
	BLT T3,(T2)
	ADDM T1,STRSP0		; ..
	POP P,T1		;return address of chunk
	RETSKP

RSKP:	AOS 0(P)
R:	RET
;Table of reasons for disconnection from net link

REASON:	[ASCIZ /No special error/]			;0
	[ASCIZ /Resource allocation failure/]		;1
	[ASCIZ /Destination node does not exist/]	;2
	[ASCIZ /Node shutting down/]			;3
	[ASCIZ /Destination process does not exist/]	;4
	[ASCIZ /Invalid name field/]			;5
	[ASCIZ /Destination process queue overflow/]	;6
	[ASCIZ /Unspecified error/]			;7
	[ASCIZ /Third party aborted the logical link/]	;8
	[ASCIZ /User abort/]				;9
	FUNNY						;10
	[ASCIZ /Undefined error code/]			;11
	FUNNY						;12
	FUNNY						;13
	FUNNY						;14
	FUNNY						;15
	FUNNY						;16
	FUNNY						;17
	FUNNY						;18
	FUNNY						;19
	FUNNY						;20
	[ASCIZ /Connect initiate with illegal destination address/] ;21
	FUNNY						;22
	FUNNY						;23
	[ASCIZ /Flow control violation/]		;24
	FUNNY						;25
	FUNNY						;26
	FUNNY						;27
	FUNNY						;28
	FUNNY						;29
	FUNNY						;30
	FUNNY						;31
	[ASCIZ /Too many connections to node/]		;32
	[ASCIZ /Too many connections to destination process/] ;33
	[ASCIZ /Access not permitted/]			;34
	[ASCIZ /Logical link services mismatch/]	;35
	[ASCIZ /Invalid account/]			;36
	[ASCIZ /Segment size too small/]		;37
	[ASCIZ /Process aborted/]			;38
	[ASCIZ /No path to destination node/]		;39
	[ASCIZ /Link aborted due to data loss/]		;40
	[ASCIZ /Destination logical link address does not exist/] ;41
	[ASCIZ /Confirmation of disconnect initiate/]	;42
	[ASCIZ /Image data field too long/]		;43
NREASN==.-REASON

FUNNY:	ASCIZ /Unknown DECnet disconnect reason code/


	END