Google
 

Trailing-Edge - PDP-10 Archives - BB-H348C-RM_1982 - swskit-v21/vax-mail/vnconn.mac
There is 1 other file named vnconn.mac in the archive. Click here to see a list.
;<LCAMPBELL.DECNET>DNCONN.MAC.59 25-May-81 12:03:58, Edit by LCAMPBELL
; Allow abbreviations for switches, change switch name to /NO20MAIL
;<LCAMPBELL.DECNET>DNCONN.MAC.58 21-May-81 17:02:39, Edit by LCAMPBELL
; Fix random bugs
;<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  by Digital Equipment Corporation
;			Maynard, Massachusetts, USA


	TITLE VNCONN - DECNET Connect Utility

	SUBTTL Larry Campbell

	SEARCH MACSYM,MONSYM,DNCUNV
	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 (see DNCUNV.MAC for format)
;
;Return	+1: failure, AC1 contains either:
;	    TOPS20 error code (600000 + n)
;	    DECNET error code (0 <= n <= 77)
;	    String pointer to text of error message for internal errors
;
;	    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.
;Parameters

STRN==20000			; Number of words for string space
ROUTEN==^D132			; Max chars in routing string
HOSTNN==^D39			; Max chars in a hostname
HSTPAG==500			; Page into which we map DECNET-HOSTS.TXT

;Impure storage

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 1000		; 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
ACSAV:	BLOCK 20		; AC save area

;Switch table

SWTTAB:	SWTTB0,,SWTTB0
	[ASCIZ /Gateway.ARPANET/],,0
	[ASCIZ /No20mail/],,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 /?DNCONN internal error - STRING/]]
		SETZB T3,T4
		SOUT
		HRROI T2,ERRBUF
		SKIPE T1,DN.ERR(AP)	;; If caller supplied sink for msgs,
		SOUT			;;  then fill it
		MOVE T1,[POINT 7,ERRBUF]
		JRST .DNERR]		;; 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 /PFX'STRING because: /]
		SETZB T3,T4		;; Build error string
		SOUT
		HRLOI T2,.FHSLF		;; Last JSYS error
		ERSTR
		 JFCL
		 JFCL
		HRROI T2,ERRBUF		;; Point to string we built
		SETZB T3,T4
		SKIPE T1,DN.ERR(AP)	;; If user supplied message sink,
		SOUT			;;  write the error there
		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>,<
		SKIPE T1,DN.ERR(AP)	;;  if we have an output sink
		CALL DTSTMP
		HRROI T2,[ASCIZ /%/]
		SETZB T3,T4
		SKIPE T1
		SOUT
	      >
	      IFDIF <STRING><CRLF>,<
		HRROI T1,ERRBUF		;; Build string here
		HRROI T2,[ASCIZ /STRING/]
		SETZB T3,T4
		SOUT
		HRROI T2,ERRBUF
		SKIPE T1,DN.WRN(AP)
		SOUT
	      >
		RET]			;; Continue on, this is nonfatal
>


;Type an informational message

DEFINE INFO(STRING),<
	CALL [IFIDN <STRING><CRLF>,<
		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

.DNLJR:	MOVX T1,.FHSLF		; Get last operating system error
	GETER
	 JFCL
	SKIPA T1,T2		; Load up T1 with code
.DNLER:	MOVE T1,[POINT 7,ERRBUF]
.DNERR:	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,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:	TRVAR <HTABJ,HNPTR,RTPTR,HFPGS,HFCNT,HFPTR>
	CALL INIMEM		; Init memory manager
	MOVEI T1,777		; Empty host table first
	MOVEM T1,HOSTAB		;  ..
	MOVX T1,GJ%SHT!GJ%OLD
	HRROI T2,[ASCIZ /SYSTEM:VAX-HOSTS.TXT/]
	GTJFN
	 ERJMP R		; Just return quietly if no host table
	MOVX T2,<7B5>+OF%RD
	OPENF
	 JERROR (?,<Can't OPENF SYSTEM:DECNET-HOSTS.TXT>)
	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 <Out of string space in .DNINI>
	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 <Out of string space at .DNINI>
	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 (?,<Trouble 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:	STKVAR <<HSTR,20>,TERM>	; Terminating character
	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 (?,<Internal error in switch table>)]
	TXNN T2,TL%EXM!TL%ABR	; Found this switch?
	JRST [	WARN CRLF
		WARN <Unknown switch >
		SKIPN T1,DN.WRN(AP)	; If no sink for warning msgs,
		RET			;   don't even try
		HRROI T2,HSTR
		SETZB T3,T4
		SOUT
		WARN < in SYSTEM:DECNET-HOSTS.TXT>
		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:	STKVAR <NETJFN>
	SETZM CURRUT		; Init state variables
	SETZM PSSHST
	SETZM CURHST
	JRST .DNCO2		; Skip alternate path verbiage first pass
.DNCO1:	INFO CRLF
	INFO < trying alternate path, >
.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 [	CALL ALTRNT		; Do we know another path?
		 JRST .DNCO1		; Yes, go use it
		JRST .DNLER]		; No, report failure to caller
	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
		CALL ALTRNT		; Any alternate route known?
		 JRST .DNCO1		; Yes, go use it
		JRST .DNLER]		; No, report failure to user
	INFO <connect OK, >
	MOVE T1,NETJFN		; Return the network JFN
	MOVE T2,CURRUT		; Return the current routing
	RET			; Win!!


;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:	STKVAR <<TMPST,<<ROUTEN+5>/5>>,NJ>	;temp string space, net JFN
	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 fucking 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
	SKIPN DN.USR(AP)	; If any of these fields are specified,
	SKIPE DN.PWD(AP)	;  (user-ID, password, account string),
	JRST PSSNG4		;  then we must add them inside double quotes
	SKIPN DN.ACN(AP)	;  before terminating colons for last node name
	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
	SKIPE T2,DN.USR(AP)	; If userid present,
	SOUT			;  stick it in the message
	MOVEI T2," "		; Space for delimiter
	IDPB T2,T1		;  ..
	SKIPE T2,DN.PWD(AP)	; If password present,
	SOUT			;  stuff it
	MOVEI T2," "		; Delimit with space
	IDPB T2,T1		;  ..
	SKIPE T2,DN.ACN(AP)	; If account string present,
	SOUT			;  move it
	HRROI T2,[ASCIZ /"::"/]	; More punctuation
PSSNG3:	SOUT			;  ..
	SKIPN T2,DN.ROB(AP)	; Get remote object type
	IERROR <No remote object type specified>
	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: >
		SKIPN T1,DN.WRN(AP)	; Warning message destination
		RET			; Nowhere to complain, quit
		HRLOI T2,.FHSLF
		ERSTR
		 JFCL
		 JFCL
		RET]
	SETZ T4,		;tie off reply
	IDPB T4,T2		; ..
	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		; Pass-through complaining,
		SKIPN T1,DN.WRN(AP)	; Just copy pass-through's message
		RET
		MOVE T2,P3		;  to caller's warning designator
		SETZB T3,T4
		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>
;Get JFN for net link, either to host on local net, or to pass-through task

HSTNAM:	STKVAR<<FNAME,20>,PTR0>	;place to build strings, hstnam pointer
	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>
	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>)
	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
	MOVE T2,P1		; Check for null descriptor
	ILDB T2,T2		; Get first byte
	JUMPE T2,MVATT0		; If null, skip it
	HRROI T2,[ASCIZ /;USERID:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT0:	SKIPN P1,DN.PWD(AP)	; Password
	JRST MVATT1
	MOVE T2,P1
	ILDB T2,T2
	JUMPE T2,MVATT1
	HRROI T2,[ASCIZ /;PASSWORD:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT1:	SKIPN P1,DN.ACN(AP)	; Account
	JRST MVATT2
	MOVE T2,P1
	ILDB T2,T2
	JUMPE T2,MVATT2
	HRROI T2,[ASCIZ /;CHARGE:/]
	SOUT
	MOVE T2,P1
	SOUT
MVATT2:	SKIPN P1,DN.OPT(AP)	; Optional data
	JRST MVATT3
	MOVE T2,P1
	ILDB T2,T2
	JUMPE T2,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,^D10		;how many times to retry MTOPR
	TXNE F,DN%SPL		;if system scan,
	MOVEI W1,^D20		; 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>
	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,^D6000		;wait 6 second
	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			; ..
	 JERROR (?,<Can't close net link>)
	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.ERR(AP)	; If no msg sink, finish up
		RET
		HRROI T2,ERRBUF		; Do have msg sink, fill it
		SETZB T3,T4
		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.ERR(AP)
	RET
	HRROI T2,ERRBUF
	SETZB T3,T4
	SOUT
	RET
SUBTTL Utility routines

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

DTSTMP:	HRROI T2,[ASCIZ /
/]
	SETZB T3,T4
	SOUT
	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:	MOVEI T1,STRSPC		; Beginning of memory space
	MOVEM T1,STRSP0		; Init memory pointer
	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
;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