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