;XX:GTDOM.MAC.166, 13-Mar-89 13:42:04, Edit by SRA ; Fix fencepost error when we use up entire arg block in $GTDMX. ;XX:GTDOM.MAC.165, 14-Sep-88 19:10:04, Edit by SRA ; Update copyright notice and table of contents. ;XX:GTDOM.MAC.164, 14-Sep-88 18:12:22, Edit by SRA ; Mark Crispin requests that we don't depend on MSEC1 being set to ; zero in non-extended monitor, so change CALLXX to handle that. ;XX:GTDOM.MAC.163, 14-Sep-88 18:02:56, Edit by SRA ; Comment out the REL6 conditionals so that we can stop fixing ; this silliness. Ten extra words of XSWAPCD doesn't matter. ;XX:GTDOM.MAC.162, 4-Sep-88 14:53:03, Edit by SRA ; Add GTDX15 (version mismatch), add GTDX6 and GTDX15 to errors that ; GD%STA translates to .GTDXT, since we hope they are temporary. ; Clean up error handling: we no longer transmute temporary IPCF errors ; into GTDX4, instead we assume that anybody who wants status uses ; GD%STA and there we translate them to .GTDXT status code. ;XX:GTDOM.MAC.161, 3-Sep-88 17:56:03, Edit by SRA ; Add .GTDOS (Get OPSYS string from HINFO RR). This is primarily ; intended for the Stanford user FTP program, which likes to be clever ; about setting defaults for several known operating system types. ;XX:GTDOM.MAC.160, 3-Sep-88 14:09:33, Edit by SRA ; Add UE_ADM (authorization failure), not that we ever expect to see ; it as part of a normal query. Change 5.4/6.1/7.0 compatability ; conditionals slightly so that the worst thing that will happen is ; that GTDOM will end up in SWAPCD instead of XSWAPCD if compiled under ; rel-5 and linked into a later version. ;XX:GTDOM.MAC.159, 2-Sep-88 00:23:53, Edit by SRA ; Replace all uses of CALLX with a new macro, CALLXX, which does random ; arithmetic to force LINK to do the right thing via polish fixup. ;XX:GTDOM.MAC.158, 1-Sep-88 22:32:16, Edit by SRA ; Change CALLX's in GETPAG and GIVPAG back to two-arg syntax, LINK didn't ; resolve these to 30-bit addresses. We may have to change all instances ; of CALLX back and use an expicit switch for rel-7, depending on how ; well the one-arg syntax works under rel-5 and rel-6. ;XX:GTDOM.MAC.157, 7-Aug-88 21:08:13, Edit by SRA ; Change all occurances of CALLX to use the single-argument format so ; that LINK will supply the section numbers. Proximate cause is that ; IPCF moved out of section 0/1 in TOPS-20 7.0. There are still some ; references to external variables via 18-bit addressing in the code ; that interacts with IPIPIP.MAC, fix this if it becomes a problem. ;XX:GTDOM.MAC.156, 15-Jul-88 03:46:29, Edit by SRA ; Fix typos in $GTDSA. ;XX:GTDOM.MAC.155, 5-Jul-88 10:46:29, Edit by SRA ; Put original error code in LSTERR during GD%STA handling. ;XX:GTDOM.MAC.154, 13-Apr-88 04:18:41, Edit by SRA ; Add $GTDLA & $GTDSA. Rework QCxxxx routines a bit. Host goodness ; for chaosnet is currently a no-op, it should be something like ; goodness := (max_cost+1 - cost(subnet(address))), but the current ; Chaosnet code doesn't bother with a routing table on a KL, so we lose. ;XX:GTDOM.MAC.153, 21-Feb-88 18:42:45, Edit by SRA ;SSY:<5-4-MONITOR>GTDOM.MAC.153, 20-Feb-88 18:10:37, Edit by JTW ; Allow externally defined versions of HSTGUD host address prioritizing ; routine. Include a default version in this file which should work ; with standard DEC monitors. Select default version with DHPRSW ; assembly switch (Non-zero to use default version. -1 by default). ;XX:GTDOM.MAC.152, 3-Jan-88 22:54:54, Edit by SRA ; .GTDVN can't trust GTDX2 errors because of "*" name semantic hair. ;XX:GTDOM.MAC.151, 29-Dec-87 15:49:15, Edit by SRA ; Fix PUSH/POP of FKSTA2(FX) not to screw up STKVAR frame in RESOLV. ;XX:GTDOM.MAC.150, 27-Dec-87 23:35:30, Edit by SRA ; Allow non-network machine to specify -1 as IQH and have .GTDWT work. ; Preserve FKSTA2(FX) in RESOLV too. ;XX:GTDOM.MAC.149, 26-Dec-87 17:49:57, Edit by SRA ; Add GTDX1 to GTDSTA list (handle bad syntax like name error). ;XX:GTDOM.MAC.148, 24-Dec-87 13:23:26, Edit by SRA ; Changes to $GTDWT: ; Use CHKIQ (from IPIPIP.MAC) to validate IQH (suggested by VAF). ; Preserve FKSTA2(FX) across dismiss in rel 5 (suggested by JTW). ; Add .GTDVN support. ;XX:GTDOM.MAC.147, 22-Dec-87 18:07:33, Edit by SRA ; Make .GTDMX work in user mode (one MOVE instruction). ;XX:GTDOM.MAC.146, 4-Dec-87 03:40:13, Edit by SRA ; Add .GTDAA support. Fix ATOD so that it returns ILDB pointer to ; terminating source character, rather than LDB pointer, for ; compatability with GTHST%. ;XX:GTDOM.MAC.143, 16-Sep-87 14:01:39, Edit by SRA ; Test for QCLASS & QTYPE was backwards in $GTHNS. ;XX:GTDOM.MAC.142, 13-Sep-87 21:46:55, Edit by SRA ; Add GD%STA support. ;XX:GTDOM.MAC.141, 4-Sep-87 02:26:34, Edit by SRA ; From Mark Crispin: ; Clean up GETPAG/GIVPAG and make them work with 6.1 ; Fix .GTHSZ function to return value in user AC4 ;[MIT-SPEECH]SSY:<5-4-MONITOR>GTDOM.MAC.9, 5-Aug-87 05:44:53, Edit by SRA ;M60 Initial installation in MIT monitor. SUBTTL Table of contents for GTDOM ; -- Section -- -- Page -- ; ; 1. Edit history.................................................. 1 ; 2. Table of contents............................................. 2 ; 3. Header and copyright information.............................. 3 ; 4. Definitions................................................... 4 ; 5. GTDOM% JSYS................................................... 5 ; 6. Invoke resolver............................................... 14 ; 7. Scheduler stuff............................................... 15 ; 8. Address selection functions................................... 16 ; 9. I/O routines.................................................. 18 ; 10. Support routines.............................................. 23 ; 11. IP Address desirability evaluation............................ 27 ; 12. Class dependent stuff......................................... 28 ; ; (End of table of contents) SUBTTL Header and copyright information SEARCH ANAUNV,PROLOG,DOMSYM TTITLE GTDOM,GTDOM,< TOPS-20 resolver interface> ; Copyright (c) 1987,1988 Massachusetts Institute of Technology. ; ; Note that there is absolutely NO WARRANTY on this software. ; See the file COPYRIGHT.NOTICE for details and restrictions. ; ; See GTDOM.DOC for information on installing this module into the ; TOPS-20 monitor. SUBTTL Definitions ; AC usage: ; Copies of user ACs are kept in P1 -> P4 and are put back on exit. ; P5 is used to point at IPCF buffer page. ; P6 is used to hold our PID if we have one. ; Tx, Qx, and F are available for general use. DEFAC(MSG,P5) DEFAC(MYPID,P6) ; Size of bytes in word-aligned string data we get from resolver ; Maybe this should be in USRDEF.D? KCCBSZ==9 ; Easiest for KCC to handle KCCBPW==<<^D36/KCCBSZ>*KCCBSZ> ; Formalize assumptions about QNAME length and page size PAGSIZ==1000 ; Size of a page on Twenex (vs. ITS!) IFL <<*KCCBPW>-MAXDNM>,< PRINTX ? QNAME space too small, may fall off data page > ; 5.4/6.1/7.0 compatability. Use SWAPCD if we haven't heard of XSWAPCD. IFNDEF XSWAPCD,< ;; If we don't know about XSWAPCD, DEFINE XSWAPCD ;; use regular SWAPCD DEFINE XNENT(NAME,G) < ;; and do SWAPCD entry points. SWAPCD NAME: IFNB , > >;IFNDEF XSWAPCD ; CALLXX is like CALLX but hairier because we want to generate .REL ; files that can be linked with any version of the monitor. ; ; NB: CALLXX depends on LINK evaluating the expression <0/0> as zero. DEFINE CALLXX(FOO) < ;; Polish to add section number to local addrs MOVE CX,[FOO!<<1-<>/>>>*>] CALL (CX) ;; Index instead of indirect >;DEFINE CALLXX ; Make this as swappable as we can. Not exactly part of the core ; of the operating system, after all. XSWAPCD ; Use default host address prioritizing routine by default. IFNDEF DHPRSW, ; External things we probably need. EXT ; STG.MAC EXT ; IPCF.MAC EXT ; IPIPIP.MAC IFE DHPRSW,< EXT ; Externally supplied at some sites > ; (IPIPIP.MAC at MIT) ; Code doesn't fully support class CH (Chaosnet) yet, ; so turn off Chaos-specific things even at MIT. CHAOS==0 ; Temporary! ; Default is no Chaosnet code for non-MIT monitors. IFNDEF CHAOS, SUBTTL GTDOM% JSYS ; On entry T1-T4 have user acs 1-4; they are saved in P1-P4. ; Mask for bad flags. This should help spot things like clients ; who think they're talking to the ISI GTDOM% or some such. BADFLG==^- XNENT .GTDOM,G ; 6.1 style JSYS global entry MCENT ; Establish MONITOR context TXNE T1,BADFLG ; Any bad flags turned on? RETERR (ARGX22) ; Yes, give invalid flags error SETZ MYPID, ; We don't yet have a PID DMOVE P1,T1 ; Save user ACs DMOVE P3,T3 HRRES T1 ; Get function code SKIPL T1 ; Check range for legality CAIL T1,GTDMAX RETERR (ARGX02) ; Bad function code XCT GTDDSP(T1) ; Execute function IFSKP. ; Won? SETO T3, ; Yeah, flag that we want skip return TXNE P1,GD%STA ; User wants status code? MOVX P1,.GTDX0 ; Yeah, use code for total win XCTU [DMOVEM P1,1] ; Return ACs to caller XCTU [DMOVEM P3,3] ELSE. ; No, T1 has error code SETZ T3, ; Assume non-skip return ANDXN. P1,GD%STA ; Need error post-processing? XMOVEI T2,GTDSTA ; Yeah, examine list of codes DO. SKIPN T3,(T2) ; Get a table entry EXIT. ; No more, real error HLRZ T4,T3 ; Get this error code CAME T1,T4 ; Match? AOJA T2,TOP. ; No, try next HRRZM T1,LSTERR ; Yes, put error where user can find it XCTU [HRRZM T3,1] ; And put status code in user AC1 ENDDO. ; T3 <> 0 iff want skip return ENDIF. CALL KILPID ; Release our PID if we have one IFN. T3 ; Won (or faking it)? SMRETN ; Yes, return successfully ELSE. RETERR () ; No, pass error code back to caller ENDIF. ; Never get here. ; Dispatch table. This has gotten too long to keep track of manually, ; so do it with a macro that will check the offsets for us. The routines ; we dispatch to have the same name as the function they implement, with ; the leading dot changed to a dollar sign. Unimplemented functions ; should be present and commented out to reserve their codes. DEFINE T(NAME) < IFB , IFNB ,< IFN <.-.'NAME>, CALL $'NAME > > GTDDSP: PHASE 0 ; Enter weird assembly mode T GTHSZ ; (00) Get name table size T ;GTHIX ; (01) Index into name space T GTHNS ; (02) Convert number to string T GTHSN ; (03) Convert string to number T ;GTHHN ; (04) Status by number T ;GTHHI ; (05) Status by index T ;GTHNL ; (06) Get local number on a network T ;GTHNT ; (07) Get status table of a network T ;GTHRT ; (10) Get first hop/route to a host T ;xxxxx ; (11) Return Resource Record (ISI unformated) T GTDWT ; (12) Resolver wait function T ;GTDFN ; (13) Domain file use (ISI code only) T GTDPN ; (14) Primary name and IP address T GTDMX ; (15) Get MX data T GTDAA ; (16) Authenticate an address T ;GTDRR ; (17) Get arbitrary RR (MIT formatted) T GTDVN ; (20) Validate name T GTDLA ; (21) Get appropriate local address T GTDSA ; (22) Sort list of addresses T GTDOS ; (23) Get opsys name GTDMAX:!DEPHASE ; Number of functions in table PURGE T ; Clean up ; Unimplemented functions come here GTDNOP: MOVEI T1,ARGX28 ; Not available on this system RET ; Return lossage ; Table of errors that are converted to success and status code by ; calls with GD%STA turned on. Table is sorted by likelyhood. ; Includes IPCF errors that we consider temporary, ie, indications ; that the resolver is just out to lunch. List terminated with a zero ; word. GTDSTA: XWD GTDX4, .GTDXT ; Timeout XWD GTDX2, .GTDXN ; Bad name XWD GTDX3, .GTDXN ; No matching RRs XWD GTDX1, .GTDXN ; Bad name syntax XWD GTDX10, .GTDXF ; Probable CNAME loop XWD GTDX7, .GTDXF ; Database corruption detected XWD IPCF27, .GTDXT ; Resolver's pid is not defined XWD IPCFX4, .GTDXT ; Receiver's PID invalid XWD IPCFX5, .GTDXT ; Receiver's PID disabled XWD IPCFX6, .GTDXT ; Sender's quota exceeded XWD IPCFX7, .GTDXT ; Receiver's quota exceeded XWD IPCFX8, .GTDXT ; IPCF free space exhausted XWD IPCF12, .GTDXT ; No free PIDs available XWD IPCF13, .GTDXT ; PID quota exceeded XWD IPCF14, .GTDXT ; No PIDs available to this job XWD IPCF15, .GTDXT ; No PIDs available to this proccess XWD GTDX6, .GTDXT ; Internal error in GTDOM% or resolver XWD GTDX15, .GTDXT ; Bad version, special case of internal error 0 ; End of list ; Function .GTHSZ(0), Get our host address ; We smash user's AC2 & AC3 to remain consistant with GTHST%. $GTHSZ: TXNE P1,GD%QCL ; QCLASS specified? SKIPA T1,P2 ; Yes, get it MOVX T1,QC.IN ; No, use Internet CALL QCGLCL ; Get our local address into T2 RETBAD () ; Say WHAT? Unknown host number! MOVE P4,T2 ; Set up to return to user's T4 SETZB P2,P3 ; Length of a nonexistant table is zero RETSKP ; Done. ; Function .GTHNS(2), Convert number to string. $GTHNS: SKIPN .SPRSV+SPIDTB ; Possible? RETBAD (IPCF27) ; No resolver, data not available CALL GETPAG ; Get a JSB page for IPCF RETBAD (IOX7) ; Lost, pass error up the line TXNN P1,GD%QCL ; User specify QCLASS? MOVX P4,QC.IN ; No, so use Internet SKIPLE T2,P3 ; User wants "local host"? IFSKP. ; Yup MOVE T1,P4 ; This is class specific CALL QCGLCL ; Get our local address into T2 RETBAD () ; Unknown host number! MOVE P3,T2 ; Save it for later ENDIF. ; T2 now has desired address MOVX T1, MOVE T3,P4 ; QCLASS CALL QCNTOD ; Convert to a QNAME RETBAD () MOVE T1,P4 ; QCLASS = whatever MOVX T2,QT.PTR ; QTYPE = Pointer MOVX T3,UF.EMO ; Exact match required CALL RESOLV ; Go ask the resolver RETBAD () ; Lost, pass error up the line LOAD T1,COUNT,+U.PHSIZ(MSG) CAIE T1,1 ; Must have exactly one RR as answer RETBAD (GTDX7) ; Multiple primary names?? Inconsistant! LOAD T1,CLASS,+U.PHSIZ+U.DHSIZ(MSG) LOAD T2,TYPE,+U.PHSIZ+U.DHSIZ(MSG) CAMN T1,P4 ; Make sure class and type match CAIE T2,QT.PTR RETBAD (GTDX6) ; Didn't, we are losing big TLC P2,-1 ; Fix HRROI style pointer TLCN P2,-1 HRLI P2,(POINT 7,) MOVE T1,P2 ; Get user's AC2 MOVE T2,U.PHSIZ+U.DHSIZ+U.RHSIZ(MSG) ; Offset to answer string MOVEI T3,PAGSIZ ; Compute min(MAXDNM,) SUB T3,T2 IMULI T3,KCCBPW CAILE T3,MAXDNM MOVEI T3,MAXDNM ; ASSUME user's buffer is at least this big TXO T2, ; Make byte pointer to packet MOVE T4,[XCTBU [IDPB T2,T1]] ; Instruction to store a byte TLNN T1,-1 ; Unless AC1 is a JFN? MOVE T4,[BOUT%] ; It is, handle correctly CALL DTOA ; Convert name string to asciz RETBAD () ; Lost, pass error up MOVE P2,T1 ; Updated pointer for user DMOVE T1,P3 ; Get host address and class CALL GSBITS ; Get host status bits RETSKP ; Done, return win ; Function .GTHSN(3), Convert string to number. ; Function .GTDPN(14), Convert string to primary name and number. $GTDPN: ; Same entry point for now $GTHSN: SKIPN .SPRSV+SPIDTB ; Have PID for resolver? RETBAD (IPCF27) ; Nope, data not available CALL GETPAG ; Get a JSB page for IPCF RETBAD (IOX7) ; Can't, pass failure up TLC P2,-1 ; Fix up HRROI style pointer TLCN P2,-1 HRLI P2,(POINT 7,) MOVE T1,P2 MOVX T2, MOVX T3,<*KCCBPW> MOVE T4,[XCTBU [ILDB T2,T1]] CALL ATOD ; Read in name user specified RETBAD () ; Lost, pass error back up MOVE P2,T1 ; Restore updated pointer TXNN P1,GD%QCL ; QCLASS specified? MOVX P3,QC.IN ; No, use Internet MOVE T1,P3 ; QCLASS = whatever MOVX T2,QT.A ; QTYPE = Address MOVX T3,0 ; Flags SKIPE T4 ; Did name end with a dot? TXO T3,UF.EMO ; Yes, exact match required CALL RESOLV ; Go ask the resolver RETBAD () ; Lost, punt MOVE F,P3 ; Save QCLASS XMOVEI Q1,U.PHSIZ+U.DHSIZ(MSG) ; Point at first RR SETZB Q2,P3 ; No addresses seen yet LOAD Q3,COUNT,+U.PHSIZ(MSG) ; Count of RRs DO. ; Look at all addresses SOJL Q3,ENDLP. ; Exit if no RRs left XMOVEI T1,PAGSIZ(MSG) ; Make sure this RR doesn't fall OPSTR ,LENGTH,(Q1) ; off the message page CAMG T1,Q1 ; If it does, exit loop EXIT. LOAD T1,CLASS,(Q1) ; Get RR class LOAD T2,TYPE,(Q1) ; and type CAMN T1,F ; Must be type A and right class CAIE T2,QT.A IFSKP. ; It is XMOVEI T1,U.RHSIZ(Q1) ; Get address of RDATA MOVE T2,F ; QCLASS CALL QCGADR ; Get address into T1 and goodness RETBAD () ; into T2 CAMG T2,Q2 ; This address better? ANSKP. ; Yeah MOVE Q2,T2 ; Save its goodness MOVE P3,T1 ; And address itself ENDIF. ; Done with this address OPSTR ,LENGTH,(Q1) LOOP. ; Next RR ENDDO. SKIPN T1,P3 ; Did we get an address? RETBAD (GTDX6) ; No, then why did RESOLV skip? Punt. HRRZ T2,P1 ; Get function code CAIE T2,.GTDPN ; Want primary name via AC4? IFSKP. ; Yeah MOVE T1,P4 ; Destination, handle normally TLC T1,-1 ; Fix HRROI style pointer TLCN T1,-1 HRLI T1,(POINT 7,) LOAD T2,RNAME,+U.PHSIZ(MSG) ; Get offset into page MOVEI T3,PAGSIZ ; Compute min(MAXDNM,) SUB T3,T2 IMULI T3,KCCBPW CAILE T3,MAXDNM MOVEI T3,MAXDNM ; ASSUME user's buffer is at least this big TXO T2, ; Make pointer to name MOVE T4,[XCTBU [IDPB T2,T1]] ; Output via T1 TLNN T1,-1 ; Is AC1 a JFN? MOVE T4,[BOUT%] ; It is, handle correctly CALL DTOA ; Dump canonicalized name RETBAD () ; Lost, pass error up MOVE P4,T1 ; Get back pointer for user ELSE. ; Wants status bits in AC4 MOVE T2,F ; QCLASS CALL GSBITS ; Get the status bits ENDIF. RETSKP ; Done, return win ; Function .GTHMX(15), Look up mail agent forwarding info. ; I happen to know that MX.PREF + 1 == MX.AGENT, but that's not good ; code, hence the following macro which takes advantage of this ; assumption iff it is true. The things we do in the name of "good ; taste".... DEFINE MVMX(OP,AC,PTR) < IFE ,< D'OP AC,MX.PREF+U.RHSIZ(PTR) > IFN ,< OP AC,MX.PREF+U.RHSIZ(PTR) OP AC+1,MX.AGENT+U.RHSIZ(PTR) > > $GTDMX: SKIPN .SPRSV+SPIDTB ; Have PID for resolver? RETBAD (IPCF27) ; Nope, data not available CALL GETPAG ; Get a JSB page for IPCF RETBAD (IOX7) ; Can't, pass failure up TLC P2,-1 ; Fix up HRROI style pointer TLCN P2,-1 HRLI P2,(POINT 7,) MOVE T1,P2 MOVX T2, MOVX T3,<*KCCBPW> MOVE T4,[XCTBU [ILDB T2,T1]] CALL ATOD ; Read in name user specified RETBAD () ; Lost, pass error up MOVE P2,T1 ; Restore updated pointer IFXN. P1,GD%QCL ; QCLASS specified? XCTU [HRRZ F,.GTDTC(P4)] ; Yeah, get QCLASS into F ERJMP URMPV ELSE. ; Not specified MOVX F,QC.IN ; Use Internet ENDIF. MOVE T1,F ; QCLASS = whatever MOVX T2,QT.MX ; QTYPE = MX MOVX T3,0 ; Flags SKIPE T4 ; Did name end with a dot? TXO T3,UF.EMO ; Yes, exact match required CALL RESOLV ; Go ask the resolver RETBAD () ; Lost, punt DO. ; Bubble sort the MX RRs LOAD Q1,COUNT,+U.PHSIZ(MSG) ; Count of RRs XMOVEI Q2,U.PHSIZ+U.DHSIZ(MSG); Current RR SETZ Q3, ; NULL sample pointer DO. ; Look at all RRs XMOVEI T3,PAGSIZ(MSG) ; Make sure this RR doesn't fall OPSTR ,LENGTH,(Q2) ; off the message page CAMG T3,Q2 ; If it does, pretend we ran out of RRs SETZ Q1, ; (we sure did if there's no page there!) JUMPLE Q1,ENDLP. ; Exit if no RRs left to scan LOAD T3,CLASS,(Q2) ; Get RR class and type LOAD T4,TYPE,(Q2) CAMN T3,F ; Ignore if not MX of proper class CAIE T4,QT.MX IFSKP. ; Type and class ok IFN. Q3 ; If we have a sample point CAMG T1,U.RHSIZ+MX.PREF(Q2) ANSKP. ; And this RR is better MVMX(MOVE, T3,Q2) ; Swap the PREF and AGENT MVMX(MOVEM,T1,Q2) ; values for these RRs MVMX(MOVEM,T3,Q3) ; (the rest doesn't matter to us) EXIT. ; Exit inner loop, and waltz around again ELSE. MOVE Q3,Q2 ; Otherwise, take new sample here MVMX(MOVE,T1,Q3) ENDIF. ; In order so far ENDIF. ; Done with this RR OPSTR ,LENGTH,(Q2) SOJA Q1,TOP. ; Next RR ENDDO. ; Swapped, no more RRs, or fell off page JUMPG Q1,TOP. ; Start over if swapped ENDDO. ; Done sorting RRs SKIPN Q3 ; Did we see anything useful? RETBAD (GTDX6) ; No, RESOLV shouldn't have skipped. Punt. TLCN P3,-1 ; Check for JFN instead of pointer RETBAD (GTDX5) ; Can't handle that, punt TLCN P3,-1 ; Fix HRROI style pointer HRLI P3,(POINT 7,) CALL CNOINT ; Turn off interrupts but allow RETBAD to work MOVE T4,P4 ; Make this work right in user mode XCTU [MOVE T1,4] ; Make sure user didn't change AC4 while ERJMP URMPV ; we were off doing other things CAME T1,P4 RETBAD (GTDX11) ; Memory changed while we were out fishing IFXN. P1,GD%QCL ; If QCLASS was specified, check it too XCTU [HRRZ T1,.GTDTC(P4)] ERJMP URMPV CAME T1,F RETBAD (GTDX11) ENDIF. XCTU [MOVE Q1,.GTDLN(P4)] ; Get argblock length ERJMP URMPV CAIGE Q1,.GTDML ; Make sure block is big enough RETBAD (ARGX04) ; Isn't, return arg block too small LOAD T2,RNAME,+U.PHSIZ(MSG) ; Get offset into message page XCTU [MOVE T3,.GTDBC(P4)] ; Count of available bytes ERJMP URMPV MOVE T1,P4 ; Point at correct argblock slot ADDI T1,.GTDNM ; for returned canonical name CALL DUMP1N ; Dump canonical name RETBAD () ; Lost, foo SUBI Q1,.GTDRD ; Subtract fixed part of argblock from length IFN <.GTDRD-.GTDNM-1>, ; Paranoia XMOVEI Q2,U.PHSIZ+U.DHSIZ(MSG) ; Pointer to RRs LOAD Q3,COUNT,+U.PHSIZ(MSG) ; Count of RRs DO. ; Look at all addresses SOJL Q3,ENDLP. ; Exit if no RRs left XMOVEI T2,PAGSIZ(MSG) ; Make sure this RR doesn't fall OPSTR ,LENGTH,(Q2) ; off the message page CAMG T2,Q2 ; If it does, exit loop EXIT. LOAD T2,CLASS,(Q2) ; Get RR class LOAD T4,TYPE,(Q2) ; Get RR type CAMN T2,F ; Type and class must match CAIE T4,QT.MX IFSKP. ; It is SOJL Q1,ENDLP. ; Make sure there's room (NOT an error) MOVE T2,U.RHSIZ+MX.AGENT(Q2) CALL DUMP1N ; Dump this name RETBAD () ; Lost, foo ENDIF. ; Advance to next RR. OPSTR ,LENGTH,(Q2) LOOP. ; Next RR ENDDO. ; Done dumping RRs IFG. Q1 ; If we didn't use the whole argblock MOVNS Q1 ; Update user's counts in argblock XCTU [ADDM Q1,.GTDLN(P4)] ERJMP UWMPV ENDIF. ; Update byte count in any case XCTU [MOVEM T2,.GTDBC(P4)] ERJMP UWMPV RETSKP ; Done, return win (and go OKINT) ; Routine to dump one name ; T1/ Pointer (in user space) to arg block slot ; T2/ MSG page offset to domain name format string ; T3/ Buffer byte count (used by DTOA) ; T4/ Trashed by this routine and DTOA ; We assume that if we lose, so does the JSYS, so it's ok ; for us to return a bogus value in T3 if we lose. DUMP1N: STKVAR ; Limits, original and after min() MOVEI T4,PAGSIZ ; Compute limit based on page size SUB T4,T2 ; (ie, don't fall off message page) IMULI T4,KCCBPW MOVEM T3,LIMORG ; Save caller-specified limit CAMLE T3,T4 ; Take minimum limit value MOVE T3,T4 SKIPG T3 ; Are we already losing? RETBAD (GTDX7) ; Yeah, string too long, punt MOVEM T3,LIMMIN ; Save limit we will use XCTU [MOVEM P3,(T1)] ; Store BP to user ERJMP UWMPV ; Lost TXO T2, ; Make source pointer from offset MOVE T4,[XCTBU [IDPB T2,P3]] ; Output via P3 CALL DTOA ; Dump name to user RETBAD () ; Lost, pass error up SUB T3,LIMMIN ; Translate limit back to what the ADD T3,LIMORG ; calling routine wants to see AOJA T1,RSKP ; Update pointer and return win ; Function .GTDAA(16), Authenticate Address for hostname $GTDAA: SKIPN .SPRSV+SPIDTB ; Have PID for resolver? RETBAD (IPCF27) ; Nope, data not available CALL GETPAG ; Get a JSB page for IPCF RETBAD (IOX7) ; Can't, pass failure up MOVE F,P4 ; Get QCLASS TXNN P1,GD%QCL ; QCLASS specified? MOVX F,QC.IN ; No, use Internet IFLE. P3 ; User wants "local host"? MOVE T1,F ; This is class specific CALL QCGLCL ; Get our local address into T2 RETBAD () ; Unknown host number! MOVE P3,T2 ; Save it for later ENDIF. ; T2 now has desired address TLC P2,-1 ; Fix up HRROI style pointer TLCN P2,-1 HRLI P2,(POINT 7,) MOVE T1,P2 ; Read in name user specified MOVX T2, MOVX T3,<*KCCBPW> MOVE T4,[XCTBU [ILDB T2,T1]] CALL ATOD RETBAD () ; Lost, pass error back up MOVE P2,T1 ; Restore updated pointer MOVE T1,F ; QCLASS = whatever MOVX T2,QT.A ; QTYPE = Address MOVX T3,0 ; Flags SKIPE T4 ; Did name end with a dot? TXO T3,UF.EMO ; Yes, exact match required CALL RESOLV ; Go ask the resolver RETBAD () ; Lost, punt XMOVEI Q1,U.PHSIZ+U.DHSIZ(MSG) ; Point at first RR SETZ Q2, ; No good address seen yet LOAD Q3,COUNT,+U.PHSIZ(MSG) ; Count of RRs DO. ; Look at all addresses SOJL Q3,ENDLP. ; Exit if no RRs left XMOVEI T1,PAGSIZ(MSG) ; Make sure this RR doesn't fall OPSTR ,LENGTH,(Q1) ; off the message page CAMG T1,Q1 ; If it does, exit loop EXIT. LOAD T1,CLASS,(Q1) ; Get RR class LOAD T2,TYPE,(Q1) ; and type CAMN T1,F ; Must be type A and right class CAIE T2,QT.A IFSKP. ; It is XMOVEI T1,U.RHSIZ(Q1) ; Get address of RDATA MOVE T2,F ; QCLASS CALL QCGADR ; Get address into T1 and goodness (ignored) RETBAD () ; into T2 CAMN T1,P3 ; Does this address match? AOJA Q2,ENDLP. ; Yes, success, now ENDIF. ; No, done with this address OPSTR ,LENGTH,(Q1) LOOP. ; Next RR ENDDO. SKIPN Q2 ; Did we find the desired address? RETBAD (GTDX3) ; No, give error (seems appropriate message) RETSKP ; Yes, return win ; Function .GTDVN(21), Validate Name for type and class $GTDVN: SKIPN .SPRSV+SPIDTB ; Have PID for resolver? RETBAD (IPCF27) ; Nope, data not available CALL GETPAG ; Get a JSB page for IPCF RETBAD (IOX7) ; Can't, pass failure up STKVAR ,SRCBP> ; (must come after GETPAG) TXNN P1,GD%QCL ; QCLASS specified? HRLI P3,QC.IN ; No, use Internet HRRZ T1,P3 ; Get QTYPE or catagory token CAIL T1,.GTDV0 ; Less than minimum catagory token? IFSKP. ; Yes, it's a QTYPE MOVEM T1,LSTBLK ; Make one entry search list SETOM 1+LSTBLK ; Tie it off XMOVEI T1,LSTBLK ; Point at it ELSE. ; Wasn't a QTYPE, must be catagory MOVSI T2,-LVNTAB ; How many entries in our table DO. ; Look for matching catagory HLRZ T3,VNTAB(T2) ; Get catagory field CAME T1,T3 ; Match? AOBJN T2,TOP. ; No, try next ENDDO. SKIPL T2 ; Did we find it? RETBAD (GTDX14) ; No, bad QTYPE HRRZ T1,VNTAB(T2) ; Get address of list ENDIF. MOVEM T1,LSTPTR ; Save list pointer TLC P2,-1 ; Fix up HRROI style pointer TLCN P2,-1 HRLI P2,(POINT 7,) MOVEM P2,SRCBP ; Save source pointer DO. ; Do some queries MOVE T1,LSTPTR ; Get pointer to QTYPE list SKIPGE T1,(T1) ; Any left to look for? RETBAD (GTDX3) ; No, "data not present at name" HRR P3,T1 ; Yes, it's our current target type MOVE T1,SRCBP ; Get target name MOVX T2, MOVX T3,<*KCCBPW> MOVE T4,[XCTBU [ILDB T2,T1]] CALL ATOD RETBAD () ; Lost, pass error back up MOVE P2,T1 ; Restore updated pointer HLRZ T1,P3 ; QCLASS = whatever HRRZ T2,P3 ; QTYPE = whatever MOVX T3,0 ; No flags SKIPE T4 ; Did name end with a dot? TXO T3,UF.EMO ; Yes, exact match required CALL RESOLV ; Go ask the resolver AOSA LSTPTR ; Lost, increment list pointer EXIT. ; Won, done CAIE T1,GTDX3 ; No data matching that name? CAIN T1,GTDX2 ; No such name (*.foo.bar hair)? LOOP. ; Yup, go try next QTYPE RETBAD () ; Nope, really lost, punt ENDDO. ; Won if we get here MOVE T1,P4 ; Write canonical name for user TLC T1,-1 ; Fix HRROI style pointer TLCN T1,-1 HRLI T1,(POINT 7,) LOAD T2,RNAME,+U.PHSIZ(MSG) ; Get offset into page MOVEI T3,PAGSIZ ; Compute min(MAXDNM,) SUB T3,T2 IMULI T3,KCCBPW CAILE T3,MAXDNM MOVEI T3,MAXDNM ; ASSUME user's buffer is at least this big TXO T2, ; Make pointer to name MOVE T4,[XCTBU [IDPB T2,T1]] ; Output via T1 TLNN T1,-1 ; Is AC1 a JFN? MOVE T4,[BOUT%] ; It is, handle correctly CALL DTOA ; Dump canonicalized name RETBAD () ; Lost, pass error up MOVE P4,T1 ; Get back pointer for user RETSKP ; Return win ENDSV. ; Close scope ; Table of QTYPEs matching known catagories. Add as needed. VNTAB: .GTDVH,,[EXP QT.A,QT.MX,QT.WKS,QT.HINFO,-1] ; Host .GTDVZ,,[EXP QT.SOA,QT.NS, -1] ; Zone LVNTAB==.-VNTAB ; Function .GTDOS(23), Get operating system from HINFO for host (for FTP) $GTDOS: SKIPN .SPRSV+SPIDTB ; Have PID for resolver? RETBAD (IPCF27) ; Nope, data not available CALL GETPAG ; Get a JSB page for IPCF RETBAD (IOX7) ; Can't, pass failure up MOVE F,P4 ; Get QCLASS TXNN P1,GD%QCL ; QCLASS specified? MOVX F,QC.IN ; No, use Internet TLC P2,-1 ; Fix up HRROI style pointer TLCN P2,-1 HRLI P2,(POINT 7,) MOVE T1,P2 ; Read in name user specified MOVX T2, MOVX T3,<*KCCBPW> MOVE T4,[XCTBU [ILDB T2,T1]] CALL ATOD RETBAD () ; Lost, pass error back up MOVE P2,T1 ; Restore updated pointer MOVE T1,F ; QCLASS = whatever MOVX T2,QT.HINFO ; QTYPE = Host INFOrmation MOVX T3,0 ; Flags SKIPE T4 ; Did name end with a dot? TXO T3,UF.EMO ; Yes, exact match required CALL RESOLV ; Go ask the resolver RETBAD () ; Lost, punt XMOVEI Q1,U.PHSIZ+U.DHSIZ(MSG) ; Point at first RR SETZ Q2, ; No good data seen yet LOAD Q3,COUNT,+U.PHSIZ(MSG) ; Count of RRs DO. ; Look at all addresses SOJL Q3,ENDLP. ; Exit if no RRs left XMOVEI T1,PAGSIZ(MSG) ; Make sure this RR doesn't fall OPSTR ,LENGTH,(Q1) ; off the message page CAMG T1,Q1 ; If it does, exit loop EXIT. LOAD T1,CLASS,(Q1) ; Get RR class LOAD T2,TYPE,(Q1) ; and type CAMN T1,F ; Must be type HINFO and right class CAIE T2,QT.HINFO IFSKP. ; It is SKIPE Q2 ; More than one HINFO for this name? RETBAD (GTDX7) ; Yes, "received data inconsistant" XMOVEI Q2,U.RHSIZ(Q1) ENDIF. ; Otherwise remember address of RDATA OPSTR ,LENGTH,(Q1) LOOP. ; Next RR ENDDO. SKIPN Q2 ; Did we find anything? RETBAD (GTDX6) ; No, resolver is losing TLC P3,-1 ; Fix up HRROI style pointer TLCN P3,-1 HRLI P3,(POINT 7,) MOVE T1,P3 ; Write out opsys string MOVX T2, ADD T2,HINF.OS(Q2) MOVX T3, SUB T3,HINF.OS(Q2) MOVE T4,[XCTBU [IDPB T2,T1]] CALL STOA RETBAD () ; Lost, pass error back up MOVE P3,T1 ; Restore updated pointer RETSKP ; Return win SUBTTL Invoke resolver ; Credits: ; This code derived from the RED protocol GTHST% module, ; written by Vince Fuller (Carnegie-Mellon University). ; RESOLV - Send a message to resolver and get a response ; Called with: ; T1/ QCLASS ; T2/ QTYPE ; T3/ UF.EMO, zero, or any flags caller wants to force ; P1/ Flags from user GTDOM% JSYS ; MSG/ Address of JSB page to send containing message ; (With QNAME already in place on page) ; Returns: ; +1/ Something lost, error code in T1 ; +2/ Success, PID created if necessary, resolver's response ; in page pointed to by MSG ; ; We IOR relevant user P1 flags into T3. ; ; Destroys T1->T4. ; How long the resolver has to get back to us with an answer (can be patched) GTDTMO: ^D<60*1000> ; Milliseconds RESOLV: STKVAR <,STAMP,MYTMO,OFKSTA> CALL QCVAL ; Make sure QCLASS is ok RETBAD () ; Pass errors back TXNE P1,GD%LDO ; Local data only? TXO T3,UF.LDO TXNE P1,GD%MBA ; Must be authoritative? TXO T3,UF.MBA TXNE P1,GD%RBK ; Resolve in background? TXO T3,UF.RBK TXNE P1,GD%EMO ; Exact match only? TXO T3,UF.EMO ; NB, overrides caller's setting! ; Add any new flags here. STOR T1,QCLASS,+U.PHSIZ(MSG) ; Put QCLASS into message STOR T2,QTYPE,+U.PHSIZ(MSG) ; And QTYPE STOR T3,FLAGS,+U.PHSIZ(MSG) ; Save flags MOVEI T1,U.PHSIZ+U.DHSIZ ; Where QNAME is STOR T1,QNAME,+U.PHSIZ(MSG) ; Store that too SETZRO RCODE,+U.PHSIZ(MSG) ; No response code yet SETZRO RNAME,+U.PHSIZ(MSG) ; Or canonicalized name SETZRO COUNT,+U.PHSIZ(MSG) ; No RRs in query message MOVX T1,USRVER ; Get user protocol version STOR T1,VERUSR,(MSG) ; send it so resolver can check MOVX T1,RFCVER ; Same for network protocol version STOR T1,VERRFC,(MSG) MOVX T1,US.QRY ; This is a query message STOR T1,STATE,(MSG) ; Tell resolver MOVEI T1,1 ; Set page count fields STOR T1,PAG.COUNT,(MSG) ; page_count STOR T1,PAG.THIS,(MSG) ; page_this MOVE T1,TODCLK ; Get current system uptime STOR T1,STMP1,(MSG) ; and our fork index, use them MOVEM T1,STAMP ; as the two stamp words we check MOVE T1,FORKX ; to be sure that resolver really STOR T1,STMP2,(MSG) ; meant answer for us. MOVX T3,IP%CFV!IP%INT!IP%EPN ; Extended page, internal call SKIPN T4,MYPID ; Have a PID yet? TXO T3, ; Request PID creation on send MOVEM T4,.IPCFS+PDB ; Sending PID MOVEM T3,.IPCFL+PDB ; Set flags SKIPN T1,.SPRSV+SPIDTB ; Get resolver PID RETBAD (IPCF27) ; Error, data not available MOVEM T1,.IPCFR+PDB MOVE T1,MSG ; Get message address LSH T1,-9 ; Make into a page number HRLI T1,1000 ; Size of paged message MOVEM T1,.IPCFP+PDB MOVEI T1,4 ; PDB length MOVEI T2,PDB ; Point at PDB here MSEND% ; Send message to resolver IFNJE. ; Sent ok? TXNN P1,GD%RBK ; Yeah, background query? TDZA T1,T1 ; No, clear T1 to indicate success MOVX T1,GTDX4 ; Yes, tell user we timed out (like ISI code) ENDIF. SKIPE MYPID ; Had PID already? IFSKP. ; No, we just created one (maybe) MOVE T2,.IPCFS+PDB ; Get sender's PID from message we just sent MOVEM T2,MYPID ; Save it for posterity ENDIF. JUMPN T1,R ; Exit now if we got an error MOVE T1,TODCLK ; Current time ADD T1,GTDTMO ; Compute our timeout MOVEM T1,MYTMO ; Save it DO. ; Loop listening for response MOVE T1,MYPID ; Our PID CALLXX PDWTCK ; See if it's ok to hang on it IFSKP. ; It is, we are committed to dismiss MOVE T1,FORKX ; Our fork index ;IFE REL6,< ; Rel 5 workaround MOVE T2,FKSTA2(T1) ; Get current contents MOVEM T2,OFKSTA ; Save it since TOPS-20 doesn't ;>;IFE REL6 MOVE T2,MYTMO ; Our timeout MOVEM T2,FKSTA2(T1) ; Save it for scheduler MOVEI T1,DOMUSR ; Our test routine MDISMS ; Normal dismiss (without hold time) CALLXX PDWTCL ; Clear PIDFW ;IFE REL6,< ; Rel 5 workaround MOVE T1,FORKX ; Our fork index MOVE T2,OFKSTA ; Get stuff TOPS-20 should have saved MOVEM T2,FKSTA2(T1) ; Put it back where TCP code expects it ;>;IFE REL6 ELSE. ; Couldn't hang on our PID, look at reason JUMPN T1,R ; If it's not incoming msg, something's wrong ENDIF. ; We should now have a message to read MOVE T1,MYPID ; Our PID again MOVEM T1,.IPCFR+PDB ; Receiver MOVX T1,IP%CFV!IP%EPN!IP%INT!IP%CFB MOVEM T1,.IPCFL+PDB ; Extended page, internal, don't hang MOVE T1,MSG ; Get message address LSH T1,-9 ; Make into a page number HRLI T1,1000 ; Make a page pointer MOVEM T1,.IPCFP+PDB MOVEI T1,.IPCFC+1 ; Length of PDB MOVEI T2,PDB ; Point at PDB.. SKIPN .SPRSV+SPIDTB ; Check resolver PID again RETBAD (IPCF27) ; in case it got blown away MRECV% ; Receive a message IFJER. ; Error? CAIN T1,IPCFX2 ; Yes, no messages ready? MOVEI T1,GTDX4 ; Yup, must have timed out RETBAD () ; Return error to caller ENDIF. ; MOVE T1,.IPCFC+PDB ; Ignore bogons ; JXE T1,SC%WHL!SC%OPR,TOP. SKIPN T1,.SPRSV+SPIDTB RETBAD (IPCF27) ; Paranoia CAME T1,.IPCFS+PDB ; Ignore message if it wasn't LOOP. ; from the resolver ENDDO. LOAD T1,VERUSR,(MSG) ; Make sure we are talking same version LOAD T2,VERRFC,(MSG) ; of the protocols as the resolver is. CAIN T1,USRVER CAIE T2,RFCVER RETBAD (GTDX15) ; We're not, give up LOAD T1,STATE,(MSG) ; Check what kind of message this is CAME T1,[US.RSP] ; Better be a response RETBAD (GTDX6) LOAD T1,PAG.COUNT,(MSG) ; For now we can only handle single LOAD T2,PAG.THIS,(MSG) ; page responses, so make sure that's CAIN T1,1 ; what this is CAIE T2,1 RETBAD (GTDX6) LOAD T1,STMP1,(MSG) ; Check to see if resolver is suffering LOAD T2,STMP2,(MSG) ; from a nervous breakdown and is sending CAMN T1,STAMP ; us somebody else's responses or is answering CAME T2,FORKX ; an old query of ours RETBAD (GTDX6) ; Lastly, check the error code LOAD T1,RCODE,+U.PHSIZ(MSG) JUMPE T1,RSKP ; Won if no error SKIPL T1 ; In range of known errors? CAILE T1,UE.MAX SETZ T1, ; No, use default error code MOVE T1,UE$TAB(T1) ; Get TOPS-20 error code for it RET ; Losing return ENDSV. ; Close scope of STKVAR ; Resolver "user" protocol errors, see USRDEF.D for error codes. ; Macro to define an error entry DEFINE DEF$UE(JCODE,UCODE) < IFN <.-UCODE>,< PRINTX ? UE$TAB out of order at JCODE, UCODE > JCODE > UE$TAB: PHASE 0 ; Check positions of errors DEF$UE(GTDX6, 0) ; Unknown error code from resolver! DEF$UE(GTDX2, UE.NAM) ; Name does not exist (authoritative answer) DEF$UE(GTDX3, UE.NRR) ; No RRs match name (authoritative answer) DEF$UE(GTDX6, UE.SYS) ; System error. DEF$UE(GTDX6, UE.NIY) ; Not Implemented Yet. DEF$UE(GTDX4, UE.TMO) ; Timeout while resolving query. DEF$UE(GTDX4, UE.RBK) ; Resolving in background. DEF$UE(GTDX10,UE.TMC) ; Too Many CNAMEs. DEF$UE(GTDX6, UE.ACK) ; ACKnowledgement (CTL messages only). DEF$UE(GTDX6, UE.ARG) ; Arguments invalid. DEF$UE(GTDX4, UE.DNA) ; Data Not Available. DEF$UE(GTDX6, UE.NOP) ; "No-op" error (internal resolver use only). DEF$UE(GTDX6, UE.ADM) ; Administrative (authorization) error IFN <.-UE.MAX-1>, DEPHASE ; End of table PURGE DEF$UE ; Clean up SUBTTL Scheduler stuff ; Credits: ; This code derived from the ISI GTDOM% function by the same name, ; which was written by Paul Mockapetris and/or Dave Bilkis (USC-ISI). ; Function .GTDWT, Resolver wait function ; This function is used to let the resolver do a scheduler dismiss to avoid ; busy-waiting. We hang until (1) a new IPCF message comes in, (2) a new ; IP packet comes in, or (3) the caller-specifed time elapses. ; ; Arguments to JSYS: ; AC1/ .GTDWT ; AC2/ hold time for HDISMS ; AC3/ wait time for HDISMS ; AC4/ resolver's IP queue handle $GTDWT: SKIPGE T1,P4 ; Are we doing full IQH dismiss? IFSKP. ; Yes, check IQH for validity NOINT ; CHKIQ wants to run NOINT CALL CHKIQ ; See if it's legal (CHKIQ is in XSWAPCD) OKINT ; Clean up ANDL. T1 ; Did the IQH pass muster? HRRZS T1 ; No, clear LH bits RETBAD () ; and pass error to caller ENDIF. SKIPN T1,.SPRSV+SPIDTB ; Resolver's PID RETBAD (GTDX6) ; None set, punt. CALLXX PDWTCK ; Set up PDFKTB, ok for us to dismiss? IFNSK. ; No, we don't want to dismiss... JUMPE T1,RSKP ; ...because there's already a message for us. RETBAD () ; ...because something's wrong with our PID. ENDIF. MOVE T1,FORKX ; We are now committed to a dismiss ;IFE REL6,< ; Rel 5 workaround PUSH P,FKSTA2(T1) ; Preserve in case we're running at PSI level ;>;IFE REL6 ADD P3,TODCLK ; Compute wakeup time MOVEM P3,FKSTA2(T1) ; Save it for scheduler test IFGE. P4 ; Are we doing full IQH dismiss? MOVEI T1,DOMSVR ; Yes, address of our scheduler test HRL T1,P4 ; Resolver's IQH ELSE. ; No, non-network machine, presumably MOVEI T1,DOMUSR ; User test does the right thing ENDIF. ; In either case MOVE T2,P2 ; Hold time HDISMS ; Dismiss to scheduler CALLXX PDWTCL ; Clear PIDFW ;IFE REL6,< ; Rel 5 workaround MOVE T1,FORKX ; Restore in case we are running at PSI level POP P,FKSTA2(T1) ; with a TCP scheduler dismiss at MP level ;>;IFE REL6 RETSKP ; Return success always ; Scheduler tests. User and server tests are identical except that ; user doesn't have an IQH, so we can reuse the same test code. ; ; Requires: ; T1/ IQH (server test only), set by SCHED from LH of FKSTAT word ; FX/ Fork index ; FKSTA2(FX)/ Wakeup time ; ; Note that in Rel 5 FKSTA2 is not preserved across PSI, and there are ; some routines in TCPJFN which might smash it. At worst this will ; cause a premature wakeup to a user GTDOM%, which will be interpreted ; as a timeout waiting for the resolver and thus will be signaled as a ; soft error and handled correctly by any reasonable program. RESCD ; Scheduler tests must be resident FX==Q3 ; Why the bleep isn't this global? DOMSVR:: ; Server test routine SKIPE INTQSP(T1) ; Any IP packets queued for us? JRST 1(T4) ; Yes, wake up due to incoming net traffic. DOMUSR:: ; User test routine MOVE T2,FKSTA2(FX) ; Get time for wakeup CAMG T2,TODCLK ; Is it later than that? JRST 1(T4) ; Yes, wake up due to alarm clock. MOVE T1,FX ; Our fork number IDIVI T1,^D36 ; Get PDFKTB index and bit position MOVE T1,PDFKTB(T1) ; Get appropriate word LSH T1,(T2) ; Shift interesting bit to sign bit JUMPL T1,1(T4) ; IPCF packet queued, wake up. JRST 0(T4) ; Nothing interesting, snooze some more. XSWAPCD ; Back to swappable code SUBTTL Address selection functions ; Function .GTDLA, Get best local address for a particular foreign address ; ; This function is used to select the best local address to use when ; a user program has to send datagrams (usually UDP) to a foreign host. ; ; Arguments: ; AC1/ flags ,, .GTDLA ; AC2/ Address of foreign machine ; AC3/ (optional) QCLASS ; Returns: ; AC2/ Local address appropriate for this foreign address $GTDLA: MOVE T1,P2 ; Get target foreign address TXNE P1,GD%QCL ; QCLASS specified? SKIPA T2,P3 ; Yes, get it MOVX T2,QC.IN ; No, use Internet CALL QCBLCL ; Get appropriate local address into T1 RETBAD () ; Lost, pass error up MOVE P2,T1 ; Put result where user can find it RETSKP ; Done ; Function .GTDSA, Sort addresses by "goodness" ; ; This function will sort a list of network addresses, best first. ; Addresses that are known to be totally useless will be removed. ; This function is primarily of interest to the domain resolver. ; ; Arguments: ; AC1/ flagss ,, .GTDSA ; AC2/ 30-bit address of block of addresses ; AC3/ Count ; AC4/ (optional) QCLASS ; Returns: ; AC2/ Pointer to updated block of addresses ; AC3/ Updated count ; ; We use a page of JSB space as scratch space for the sort, two words ; per entry: ; 0/ address ; 1/ goodness ; Addresses are assumed to fit into one word. $GTDSA: CALL CNOINT ; Turn off interrupts but allow RETBAD() SKIPG P3 ; Check for silly initial argblock length RETBAD (ARGX04) ; Argblock too small CAILE P3, ; Will we have enough room? RETBAD (ARGX05) ; Nope, argblock too long. CALL GETPAG ; Get a JSB page for scratch space RETBAD (IOX7) ; Can't, pass failure up TXNN P1,GD%QCL ; QCLASS specified? MOVX P4,QC.IN ; No, default to Internet MOVE Q1,P2 ; Point to user's block of addresses MOVE Q2,MSG ; Point to our buffer MOVE Q3,P3 ; Count of addresses DO. ; Loop to snarf and evaluate addresses XCTU [MOVE T1,(Q1)] ; Get an address ERJMP URMPV MOVE T2,P4 ; QCLASS CALL QCGGUD ; Get goodness RETBAD () IFG. T2 ; This address any use at all? DMOVEM T1,(Q2) ; Yeah, save this entry ADDI Q2,2 ; Remember that we did ENDIF. AOJ Q1, ; That was one more user address SOJG Q3,TOP. ; Loop if there are more addresses ENDDO. ; All useful addresses now in our table SUB Q2,MSG ; See how many entries we kept LSH Q2,-1 MOVE P3,Q2 ; That's our new count DO. ; Bubble sort the entries by goodness MOVE Q1,P3 ; Count MOVE Q2,MSG ; Current address SETZ Q3, ; NULL sample pointer DO. ; Look at all addresses JUMPLE Q1,ENDLP. ; Exit if no addresses left to scan IFN. Q3 ; If we have a sample point CAML T2,1(Q2) ; And this address is better ANSKP. DMOVE T3,(Q2) ; Swap this entry with the sampled entry DMOVEM T1,(Q2) DMOVEM T3,(Q3) EXIT. ; Exit inner loop, and waltz around again ELSE. MOVE Q3,Q2 ; Otherwise, take new sample here DMOVE T1,(Q3) ENDIF. ; In order so far ADDI Q2,2 ; Increment pointer by one entry SOJA Q1,TOP. ; Do next entry ENDDO. ; Swapped or no more addresses JUMPG Q1,TOP. ; Start over if swapped ENDDO. ; Done sorting. MOVE Q1,P2 ; Point to user's block of addresses MOVE Q2,MSG ; Point to our buffer MOVE Q3,P3 ; Count of addresses DO. ; Loop to write sorted addresses to user SOJL Q3,RSKP ; Return success when done (and go OKINT) MOVE T1,0(Q2) ; Get an address XCTU [MOVEM T1,(Q1)] ; Write it ERJMP UWMPV ADDI Q2,2 ; Count one table entry AOJA Q1,TOP. ; Update user space pointer and loop ENDDO. ; Never get here. SUBTTL I/O routines ; ITOD -- convert a 32 bit IP address into IN-ADDR domain name format ; ; Accepts: ; T1/ output byte pointer ; T2/ number to convert ; ; Returns: ; +1 on failure ; +2 on success ; T1/ updated byte pointer ; ; Output buffer should be long enough to hold a 29 byte string. ITOD: TLNE T2,740000 ; Make sure this is legal IP address RETBAD (GTDX13) SAVEAC ; Save ACs we use MOVE Q1,T2 MOVEI Q2,3 ; Loop four times DO. ; Get an octet LDB T3,[POINT 8,Q1,11 POINT 8,Q1,19 POINT 8,Q1,27 POINT 8,Q1,35](Q2) MOVEI T2,1 ; Assume one-digit number CAIL T3,^D10 ; Is two digit? AOJ T2, ; Yup CAIL T3,^D100 ; Three digit? AOJ T2, ; Yup IDPB T2,T1 ; Write count byte IDIVI T3,^D100 ; Get high digit IFN. T3 ; If non-zero ADDI T3,"0" ; Make into ascii digit IDPB T3,T1 ; Write it ENDIF. MOVE T3,T4 ; Get remainder IDIVI T3,^D10 ; Make other two digits ADDI T3,"0" ; Convert to ascii CAIL T2,2 ; More than one digit? IDPB T3,T1 ; Yes, write middle digit ADDI T4,"0" ; Last digit gets written IDPB T4,T1 ; in all cases. SOJGE Q2,TOP. ; Loop if more octets ENDDO. ; Done with number MOVE T2,[POINT 7,INADDR] DO. ; Tack on suffix string ILDB T3,T2 IDPB T3,T1 JUMPN T3,TOP. ENDDO. RETSKP ; Return success ; String to append to domain-name-formatted address. INADDR: BYTE(7) 7,"I","N","-","A","D","D","R",4,"A","R","P","A",0 ; Extreme paranoia, formalize assumptions about MAXDNM and length of ; IN-ADDR QNAMEs. ; Max length = number_of_octets * length_of_octet_tag + length_of_suffix. IFL *5>>>,< PRINTX ? IN-ADDR QNAME too long for data page (impossible error) > IFN CHAOS,< ; Chaosnet support only ; CTOD -- convert a 16 bit chaos address into CH-ADDR domain name format ; ; Accepts: ; T1/ output byte pointer ; T2/ number to convert ; ; Returns: ; +1 on failure ; +2 on success ; T1/ updated byte pointer ; ; Output buffer should be long enough to hold a full length domain name. CTOD: SKIPLE T2 ; Make sure it's a legal Chaos address CAILE T2,177777 RETBAD (GTDX13) SAVEAC ; Save ACs we use MOVEI T4,1 ; Start with one digit DO. IDIVI T2,8 ; Divide off a digit PUSH P,T3 ; Save the digit SKIPE T2 ; Exit if that's all the digits AOJA T4,TOP. ; Count another digit ENDDO. IDPB T4,T1 ; Write length byte DO. POP P,T2 ; Get back a digit ADDI T2,"0" ; Convert to an ascii character IDPB T2,T1 ; Write it into string SOJG T4,TOP. ; Next digit ENDDO. MOVE T2,[POINT 7,CHADDR] DO. ; Tack on suffix strings ILDB T3,T2 JUMPE T3,ENDLP. IDPB T3,T1 LOOP. ENDDO. MOVE T2,CHDOMN ; Pointer to our chaosnet domain name DO. ILDB T3,T2 IDPB T3,T1 JUMPN T3,TOP. ENDDO. RETSKP ; Return success ; String to append to domain-name-formatted address. CHADDR: BYTE(7) 7,"C","H","-","A","D","D","R",0 ; There should be a conditional PRINTX here that checks to be ; sure CHADDR and associated stuff aren't too long for buffer. >;IFN CHAOS ; ATOD -- convert asciz string with dots to domain name format. ; ; Accepts: ; T2/ Destination byte pointer ; T3/ Size of destination buffer in bytes ; T4/ Instruction which will fetch a byte into T2 ; ; Returns: ; +1 on error ; T1/ Error code ; +2 on success ; T2/ Updated pointer ; T3/ Updated count ; T4/ Non-zero if string ended with "." ; ; Does not use T1, P, or Q registers, so fetch instruction can ; reference these. Saves T1 across fetch instruction that reads the ; null terminating the string, so T1 is the right place to put a byte ; pointer if you want it returned in ILDB format. ATOD: STKVAR MOVEM T2,OUTBP ; Save arguments MOVEM T3,CNT MOVEM T4,FETCH SETOM DOT ; Pretend last char was a dot to catch DO. ; bogus strings begining with a dot SOSG CNT ; Check for overflow RETBAD (GTDX9) ; Out of room, punt SETZ T3, ; Count of chars for this label IDPB T3,OUTBP ; Zero count byte and advance over it MOVE T4,OUTBP ; Get pointer to count byte MOVEM T4,SAVEBP ; Save till have something to put there DO. MOVEM T1,HOLDT1 ; Save T1 in case it's caller's source BP XCT FETCH ; Get a byte ERJMP URIOX ; Paranoia JUMPE T2,ENDLP. ; Exit loop if null or dot CAIN T2,"." EXIT. SETZM DOT ; Ok, saw a non-dot character CAIE T2,"\" ; Backslash quoting? IFSKP. ; Yup XCT FETCH ; Get next byte ERJMP URIOX CAIL T2,"0" ; Is it a digit? CAILE T2,"9" ANSKP. ; Yeah, sigh, \DDD character representation MOVEI T4,-"0"(T2) ; Three decimal digits, result is assumed IMULI T4,5+5 ; to be text, thank Ghu XCT FETCH ERJMP URIOX ADDI T4,-"0"(T2) IMULI T4,5+5 XCT FETCH ERJMP URIOX SUBI T2,-"0" ADD T2,T4 ENDIF. ; Done with "\" handling SOSG CNT ; Make sure there's room RETBAD (GTDX9) IDPB T2,OUTBP ; Write the byte AOJA T3,TOP. ; Next ENDDO. MOVE T4,SAVEBP ; Get pointer to count byte DPB T3,T4 ; Put in the count byte. JUMPE T2,ENDLP. ; Done if saw null byte CAIG T3,MAXLAB ; Was dot. Label too long? SKIPE DOT ; Or two dots in a row? RETBAD (GTDX1) ; Loser, punt SETOM DOT ; Remember that this is a dot LOOP. ; Next label ENDDO. ; End of string SOSG CNT ; Terminate with null label RETBAD (GTDX9) IDPB T2,OUTBP ; T2 already contained zero MOVE T1,HOLDT1 ; Get return values MOVE T2,OUTBP MOVE T3,CNT MOVE T4,DOT RETSKP ; Return success ENDSV. ; Close scope of STKVAR ; DTOA -- convert domain format name to asciz string. ; ; Accepts: ; T2/ Source byte pointer ; T3/ Size of destination buffer in bytes ; T4/ Instruction which will store a byte from T2 ; P1/ Flags from user GTDOM% call ; ; Returns: ; +1 on error ; T1/ Error code ; +2 on success ; T2/ Updated pointer ; T3/ Updated count ; T4/ Count of labels seen ; ; Does not use T1, P, or Q registers, so store instruction can reference these. ; If opcode of store instruction is not JSYS, will write a null byte after end ; of string, preserving T1 across this write operation, so T1 is the right ; place to put a byte pointer if you want it preserved this way. DTOA: STKVAR MOVEM T2,SRCBP ; Save arguments MOVEM T3,CNT MOVEM T4,STORE SETOM NLABEL ; No labels seen yet DO. ILDB T3,SRCBP ; Get count for this label JUMPE T3,ENDLP. ; Null count, end of domain name SKIPL T3 ; Paranoia CAILE T3,MAXLAB RETBAD (GTDX6) ; Bad label count, our fault, punt AOSG NLABEL ; Do we need to write a dot? IFSKP. ; Yes SOSG CNT ; Check for room RETBAD (GTDX8) ; Too long, return error MOVEI T2,"." ; Character to write XCT STORE ; Do it ERJMP UWIOX ; Paranoia ENDIF. ; Done handling dot DO. ; Output each char of this label ILDB T2,SRCBP ; Get one char IFXN. P1,GD%RAI ; Want uppercase output? CAIL T2,"a" ; Yeah, check for lowercase letter CAILE T2,"z" ANSKP. ; It's lowercase SUBI T2,<"a"-"A"> ; Convert to uppercase ENDIF. CAIE T2,"." ; Is it a dot? CAIN T2,"\" ; Or a backslash? IFNSK. ; Yup, have to quote it with "\" SOSG CNT ; Check for overflow RETBAD (GTDX8) ; Out of room, punt MOVE T4,T2 ; Save char MOVEI T2,"\" ; Quoting character XCT STORE ; Write it ERJMP UWIOX ; Paranoia MOVE T2,T4 ; Get back original character ENDIF. ; Now output original character SOSG CNT ; Check for room RETBAD (GTDX8) ; Overflow, punt XCT STORE ; Write it ERJMP UWIOX SOJG T3,TOP. ; Next char in this label ENDDO. ; End of this label LOOP. ; Next label ENDDO. ; No more labels HLRZ T3,STORE ; Get store instruction opcode CAIN T3,(JSYS) ; Is it a JSYS? IFSKP. ; Nope, have to write null byte SOSG CNT ; Check for room RETBAD (GTDX8) ; Drat and double drat MOVE T4,T1 ; Save T1 across null byte output SETZ T2, ; A null byte XCT STORE ; Write it ERJMP UWIOX ; Gack MOVE T1,T4 ; Put T1 back ENDIF. ; Done with null byte MOVE T2,SRCBP ; Get return values MOVE T3,CNT AOS T4,NLABEL RETSKP ; Return success ENDSV. ; Close scope of STKVAR ; STOA -- convert domain format string to asciz string. ; ; Accepts: ; T2/ Source byte pointer ; T3/ Size of destination buffer in bytes ; T4/ Instruction which will store a byte from T2 ; ; Returns: ; +1 on error ; T1/ Error code ; +2 on success ; T2/ Updated pointer ; T3/ Updated count ; ; Does not use T1, P, or Q registers, so store instruction can reference these. ; If opcode of store instruction is not JSYS, will write a null byte after end ; of string, preserving T1 across this write operation, so T1 is the right ; place to put a byte pointer if you want it preserved this way. STOA: STKVAR MOVEM T2,SRCBP ; Save arguments MOVEM T3,CNT MOVEM T4,STORE ILDB T3,SRCBP ; Get length of string DO. SOJL T3,ENDLP. ; Exit loop if end of source string ILDB T2,SRCBP ; Get one char SOSG CNT ; Check for room RETBAD (GTDX8) ; Overflow, punt XCT STORE ; Write it ERJMP UWIOX LOOP. ENDDO. ; End of string HLRZ T3,STORE ; Get store instruction opcode CAIN T3,(JSYS) ; Is it a JSYS? IFSKP. ; Nope, have to write null byte SOSG CNT ; Check for room RETBAD (GTDX8) ; Drat and double drat MOVE T3,T1 ; Save T1 across null byte output SETZ T2, ; A null byte XCT STORE ; Write it ERJMP UWIOX ; Gack MOVE T1,T3 ; Put T1 back ENDIF. ; Done with null byte MOVE T2,SRCBP ; Get return values MOVE T3,CNT RETSKP ; Return success ENDSV. ; Close scope of STKVAR SUBTTL Support routines ; GETPAG -- co-routine to assign a page from free space ; Takes no arguments. On lossage, just returns +1. ; On win, returns +2 with page address in MSG, and twiddles ; stack so that exit will release page correctly. ; We misuse MSG within this routine for the sake of cleaner ; stack twiddling code. GETPAG: XMOVEI MSG,GIVPAG ; Set up return PC EXCH MSG,(P) ; Put return on the stack PUSH P,MSG ; Then the guy who called us SAVEAC ; Save other registers CALLXX ASGPGS ; Assign page from free space IFNSK. SETZ MSG, ; No message page RET ; Return to caller ENDIF. MOVE MSG,T1 ; Address of block RETSKP ; Coroutine to release monitor IPCF page during return ; Accepts: ; MSG/ Address of page GIVPAG: TRNA ; Normal entry... AOS (P) ; Propagate skip return JUMPE MSG,R ; Return pronto if nothing to do SAVEAC ; Save registers MOVE T1,MSG ; Get page address CALLXX RELPGS ; Release it RET ; Done ; ERJMP handlers: ; URIOX, UWIOX -- User Read/Write I/O XCT error (T4 contains instruction) ; URMPV, UWMPV -- XCTU to/from user memory failed URIOX: CAME T4,[BIN%] ; Already have error code if JSYS URMPV: MOVEI T1,ILLX01 ; Else, bad memory operation RETBAD () ; Return error to caller. UWIOX: CAME T4,[BOUT%] ; Already have error code if JSYS UWMPV: MOVEI T1,ILLX02 ; Else, bad memory operation RETBAD () ; Return error to caller. ; Coroutine to go NOINT but still support RETBAD() CNOINT: NOINT ; Turn off interrupts POP P,CX ; MACSYM scratch AC CALL (CX) ; Coreturn to caller SKIPA ; +1 return AOS (P) ; +2 return OKINT ; Turn on interrupts RET ; Unwind stack some more ; Routine to kill MYPID when we're done with it. Preserves all ACs. KILPID: JUMPE MYPID,R ; Don't bother if no PID SAVEAC ; Save ACs we smash MOVEI T1,2 ; Two words of argument MOVEI T2,T3 ; Arguments are in T3 and T4 MOVEI T3,.MUDES ; Delete a PID MOVE T4,MYPID ; Our PID MUTIL% ; Destroy it ERJMP .+1 ; Oh well, we tried SETZM MYPID ; Don't do this again RET ; Done ; GSBITS -- Get host status bits. ; Accepts T1/ Host number ; MSG/ Message page pointer ; Returns +1 always ; P4/ Status bits GSBITS: SAVEAC ; Save ACs we smash CAIN T2,QC.IN ; Only know about status for Internet CALL HSTHSH ; See if this host has status TDZA P4,P4 ; No host status MOVE P4,HSTSTS(T2) ; Get host status bits LOAD T1,FLAGS,+U.PHSIZ(MSG) TXNE T1,UF.AKA ; If resolver said "alias found", TXO P4,HS%NCK ; light the nickname bit RET ; That's it. SUBTTL IP Address desirability evaluation IFN DHPRSW,< ; WARNING: This code knows too flinking much about the guts of the IP code. ; It may stop working at any time, if in fact it works on your ; machine to begin with. EXT ; Stuff we need from IPIPIP.MAC ; NB: these aren't global on a vanilla system ; Routine to determine a host address "Goodness" ; Accepts: T1/ host number ; returns: T2/ goodness ; ; The value returned in T2 is a positive integer which indicates the ; desirability of this address. Larger numbers indicate more desirable ; addresses. This routine is used to order addresses returned by the ; resolver for presentation to the user. ; This default version of the routine is intended to work with standard ; DEC monitors. Sites may wish to change this routine to consider issues ; such as fast vs slow interfaces or locally implemented subnet schemes. ; ; Priority rankings: ; ; 5 : host is directly connected to the preferred net ; 4 : host is directly connected to an available net ; 3 : a gateway to the host's net is on the preferred net ; 2 : a gateway to the host's net is on an available net. ; 1 : host is at least 2 hops away.. HSTGUD: NETNUM T2,T1 ; Get network number of destination CAME T2,PRFNET ; Check if this address is on the preferred net IFSKP. MOVEI T2,5 ; really good address. RET ENDIF. ; Now check if we have ANY interface direct to the desired net XMOVEI T3,NCTVT ; Point to the NCT table DO. LOAD T3,NTLNK,(T3) ; Get net in the chain JUMPE T3,ENDLP. ; no more Interfaces - failure CAME T2,NTNET(T3) ; same network? LOOP. ; No, loop MOVEI T2,4 ; YES. return goodness level 4. RET ENDDO. ; Now check if we know of any gateways connected directly to the specified net SAVEAC ; save t1 CALL FNDGAT ; find a gateway IFSKP. ; one has been found... MOVE T1,.GWILS(T1) ; get its (local) address NETNUM T1,T1 ; get network number of gateway CAME T1,PRFNET ; is it on our preferred net? TDZA T2,T2 ; no MOVEI T2,1 ; yes - it gets an extra point ADDI T2,2 ; 2 or 3 total points RET ; return this value ENDIF. ; Still losing, address is at least two hops away MOVEI T2,1 ; address is minimally good. RET ; FNDGAT: Find a gateway (in the gateway table) that is directly connected ; to the Network specified (and to a net we are on). ; Entry: T2/ Network number ; Exit: +1 failure. No good gateways were found. ; +2 success. T1/ (extended) pointer to gateway block. ; FNDGAT: ACVAR MOVSI I,-MAXGWA ; Size of tables DO. HRRZ GWT,I ; Get offset ADD GWT,GWTAB ; Point into table SKIPN GWT,(GWT) ; Get entry (if any) RET ; Slot is empty - assume end of table IFQN. GWUP,(GWT) ; Gateway up? MOVE T1,.GWILS(GWT) ; Get accessable address CALL NETCHK ; Is this interface up? ANSKP. ; No, try another gateway LOAD T3,GWICT,(GWT) ; Get the interface count XMOVEI T4,.GWILS(GWT) DO. ; Point to interface names MOVE T1,(T4) ; Get an address NETNUM T1,T1 ; Get the net number CAME T1,T2 ; Same network as we want? IFSKP. MOVE T1,GWT ; Get the address of this GW block RETSKP ; and return ENDIF. AOJ T4, ; Point to the next entry SOJG T3,TOP. ; and loop through this gateway ENDDO. ENDIF. ; Done with this gateway block AOBJN I,TOP. ; Loop through all gateway blocks ENDDO. RET ; Failure. No skip. ENDAV. ;Policy routine to compute best local address for communication with ; a given foreign host. Compute local addr by asking IP for the best ; gateway to that host, then using our interface on that gateway's ; subnet as the local address. ; ;Call: T1/ Foreign address ;Return +1, T1/ Best local address for communication with this host ; BSTLCL: SAVEAC CALL GWYLUK ;See how IP would get there. IFN. T1 ;It wouldn't. Let loser lose later, not now. CALL FNDNCT ;P1/ NCT for interface to this GW ANSKP. ;Should never happen, GWYLUK checks MOVE T1,NTLADR(P1) ;Get local address of this interface. ELSE. MOVE T1,DEFADR ;Bail out. ENDIF. RET >;IFN DHPRSW SUBTTL Class dependent stuff ; These are mostly stub routines. The intent is to localize ; knowledge of class specific parts of the domain protocol ; to this section. Currently there are only two RRs known ; to be class dependent in format: A and WKS. We don't use WKS ; for anything ourselves, so that's not a problem. A we have ; to handle. Also, the suffix name used in CH-ADDR lookups ; is dependent on the domain name of the local chaosnet. ; There is also stuff here for extracting information from ; the network code that is in some mystical way related to ; the way the domain system uses class. This is mostly address ; selection/evaluation stuff. ; If there ever get to be more than two useful classes, ; this stuff should be expanded to table lookups. Right now ; it's faster and cleaner to just code tests directly. ; QCVAL -- See if QCLASS is valid. ; Accepts: ; T1/ QCLASS ; Returns: ; +1: Bad QCLASS, error code in T1 ; +2: QCLASS ok, all ACs preserved QCVAL: CAIN T1,QC.IN ; Internet? RETSKP ; Yes, Win IFN CHAOS,< CAIN T1,QC.CH ; Chaosnet? RETSKP ; Yes, Win >;IFN CHAOS RETBAD (GTDX12) ; Unknown, lose ; QCNTOD -- Convert Number to Domain name (xx-ADDR format) ; Accepts: ; T1/ output byte pointer ; T2/ number to convert ; Returns: ; +1 on failure ; T1/ error code ; +2 on success ; T1/ updated byte pointer QCNTOD: CAIN T3,QC.IN ; Internet? JRST ITOD ; Yes, dispatch IFN CHAOS,< CAIN T3,QC.CH ; Chaosnet? JRST CTOD ; Yes, dispatch >;IFN CHAOS RETBAD (GTDX12) ; QCGLCL -- Get local host address ; Accepts: ; T1/ QCLASS ; Returns: ; +1: error ; +2: success ; T2/ host address QCGLCL: CAIE T1,QC.IN ; Internet? IFSKP. MOVE T2,PRFADR ; Use our prefered IP address RETSKP ENDIF. IFN CHAOS,< CAIE T1,QC.CH ; Chaosnet? IFSKP. MOVE T2,MYCHAD ; Multi-homing? What's that? RETSKP ENDIF. >;IFN CHAOS RETBAD (GTDX12) ; QCBLCL -- Get "best" local host address for specified foreign address ; Accepts: ; T1/ target foreign address ; T2/ QCLASS ; Returns: ; +1: error ; +2: success ; T1/ host address QCBLCL: CAIE T2,QC.IN ; Internet? IFSKP. CALL BSTLCL ; Yeah, what a coincidence, all the args RETSKP ; are where they should be. ENDIF. IFN CHAOS,< CAIE T2,QC.CH ; Chaosnet? IFSKP. MOVE T1,MYCHAD ; This is a bad joke, but what else RETSKP ; can we do without a routing table? ENDIF. >;IFN CHAOS RETBAD (GTDX12) ; QCGADR -- Get host address from IPCF packet and determine "goodness" value ; Accepts: ; T1/ Pointer to RDATA portion of current RR ; T2/ QCLASS ; MSG/ pointer to message page ; Returns: ; +1: error ; +2: success, with ; T1/ address ; T2/ "goodness" QCGADR: CAIE T2,QC.IN ; Internet? IFSKP. MOVE T1,IN.A.ADDR(T1) ; Get address CALLRET QCGGUD ; Onward to get goodness ENDIF. IFN CHAOS,< CAIE T2,QC.CH ; Chaosnet? IFSKP. MOVE T1,CH.A.ADDR(Q1) ; Get address ; Ought to compare against CHDOMN ; to be sure this is right chaosnet. ; If it isn't, return -1 as goodness, ; which will prevent this addr from ; ever being used. CALLRET QCGGUD ; Onward to get goodness ENDIF. >;IFN CHAOS RETBAD (GTDX12) ; QCGGUD -- Determine "goodness" value for a host address ; Accepts: ; T1/ Address ; T2/ QCLASS ; Returns: ; +1: error ; +2: success, with ; T1/ address ; T2/ "goodness" QCGGUD: CAIE T2,QC.IN ; Internet IFSKP. CALL HSTGUD ; Look up goodness RETSKP ; Return win ENDIF. IFN CHAOS,< CAIE T2,QC.CH MOVEI T2,1 ; All addresses look alike without a routing RETSKP ; table, so the all win, I guess ENDIF. >;IFN CHAOS RETBAD (GTDX12) TNXEND END