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