From 7b506edcb4a1fa573ea5c080528c12e1b289db15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Mon, 6 Sep 2021 12:24:00 +0200 Subject: [PATCH 01/21] Code from PI --- src/sysnet/dqdefs.16 | 212 +++ src/sysnet/dqdev.182 | 4247 ++++++++++++++++++++++++++++++++++++++++++ src/sysnet/udplib.5 | 352 ++++ 3 files changed, 4811 insertions(+) create mode 100644 src/sysnet/dqdefs.16 create mode 100644 src/sysnet/dqdev.182 create mode 100644 src/sysnet/udplib.5 diff --git a/src/sysnet/dqdefs.16 b/src/sysnet/dqdefs.16 new file mode 100644 index 000000000..6f9d26ee8 --- /dev/null +++ b/src/sysnet/dqdefs.16 @@ -0,0 +1,212 @@ +;;;-*-MIDAS-*-;;; + +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ included in this assembly. +/ + +IFNDEF $$DQDB, $$DQDB==0 + + +SUBTTL Domain Name Protocol Definitions + +DNPORT==53. ;UDP port number for Domain Name server. + +;;; Fields in the Header section + +DP%ID== 777774,, ; 0 16 bit ID number +DP%QR== 2,, ; 0 Query/Response bit +DP%OP== 1,,300000 ; 0 Opcode +DP%AA== 0,,040000 ; 0 Authoritative Answer +DP%TC== 0,,020000 ; 0 TrunCation +DP%RC== 0,,010000 ; 0 Recursion Desired +DP%RA== 0,,004000 ; 0 Recursion Available +DP%RCD== 0,,000160 ; 0 Response Code +DP%QDC==777774,, ; 1 Question Count +DP%ANC== 3,,777760 ; 1 Answer Count +DP%NSC==777774,, ; 2 Authority Record Count +DP%ARC== 3,,777760 ; 2 Additional Record Count + +DP$ID== <.BP DP%ID,0> +DP$QR== <.BP DP%QR,0> +DP$OP== <.BP DP%OP,0> ;Domain system opcodes: + DO$QRY==0 ; Standard QUERY + DO$YRQ==1 ; Inverse IQUERY + DO$QCM==2 ; Multiple completion CQUERYM + DO$QCU==3 ; Single completion CQUERYU +DP$AA== <.BP DP%AA,0> +DP$TC== <.BP DP%TC,0> +DP$RC== <.BP DP%RC,0> +DP$RA== <.BP DP%RA,0> +DP$RCD==<.BP DP%RCD,0> ;Domain system response codes: + DR$OK==0 ; No error condition + DR$FMT==1 ; Format error + DR$LOS==2 ; Server lossage + DR$ERR==3 ; Name error + DR$NI==4 ; Not implemented + DR$RFS==5 ; Refused + +DP$QDC==<.BP DP%QDC,,1> +DP$ANC==<.BP DP%ANC,,1> +DP$NSC==<.BP DP%NSC,,2> +DP$ARC==<.BP DP%ARC,,2> + +DQ$NAM==<441000,,3> ; ILDB ptr to variable length QNAME. + +; Additional opcodes for DQ device only: + DO$WRO==1000 ;NQUERY (ignore cache) + DO$TAB==2000 ;HOSTS3 (use old host file) + + + +;;; TYPEs + +DT$A==1. ;Host address +DT$NS==2. ;Authoritative name server +DT$MD==3. ;Mail destination +DT$MF==4. ;Mail forwarder +DT$CNA==5. ;Canonical name for an alias +DT$SOA==6. ;Start of zone of authority +DT$MB==7. ;Mailbox domain name +DT$MG==8. ;Mail group member +DT$MR==9. ;Mail rename domain name +DT$NUL==10. ;NULL RR +DT$WKS==11. ;Well known service description +DT$PTR==12. ;Domain name pointer +DT$HIN==13. ;Host information +DT$MIN==14. ;Mailbox or list information + +;;; QTYPEs(in addition to above TYPEs) + +DT$XFR==252. ;Request for xfer of entire zone +DT$MLB==253. ;Request for mailbox-related RRs (MB,MG,MR) +DT$MLA==254. ;Request for mail agent RRs (MD,MF) +DT$ANY==255. ;Request for all records + +;;; CLASSes + +DC$IN==1. ;DARPA Internet +DC$CS==2. ;NSF CSnet +DC$CH==3. ;CHAOS network (need a real number from Postel) + +;;; QCLASSes (in addition to above CLASSes) + +DC$ANY==255. ;Any class + + +SUBTTL DQDEV database definitions +IFN $$DQDB,[ + +; To read the database requires a non-exclusive read lock. To write the +; database requires a write lock which excludes all other processes from +; using the database in any way. Attempts to assert the lock will fail +; unless there are no readers. The lock is implemented using the ITS +; LOCKS facility in a particular disk file. + +LCKFN1: SIXBIT / DOMAN/ +LCKFN2: SIXBIT / LOCK/ + +; The database is kept in an NLISTS LSE file. This contains the Domain +; lists, which store all of the Resource Records. When the resolver +; queries a Domain Server, the results may be added to this LSE The +; Domain list is initialized from local host table files. All of the +; other information in the database is keyed into the Domain lists. + +DBDEV: SIXBIT /DSK/ +DBFN1: SIXBIT / DOMAN/ +DBFN2: SIXBIT /DATA/ +DBDIR: SIXBIT /SRA/ + +TMPFN1: SIXBIT /_DQ_/ +TMPFN2: SIXBIT /OUTPUT/ + + + +; The MASTER-DOMAIN-LIST is the LSE database root, and points to +; the DOMAIN-NAME list. +; +; Each DOMAIN-NAME contains a VAL to the domain name string; +; the VAL points to a list of CLASSes for which domain data exists. +; +; Each Class contains a VAL to the Class; the VAL points to a +; list of RESORCE-RECORDS. +; Each RESOURCE-RECORD points to a VAL containing the Type; the +; VAL points to a list of nodes comprising the RR. +; +; The RR list has a RESOURCE-VALUE containing the Data and pointing +; at a list of the other information, including: +; +; o DISTRIBUTION information (which controls the authority +; and propogation of the RR); +; o TIME-TO-DIE (computed upon RR insertion from a TTL stamp) +; +; This means that each Domain takes up 4 CONSes, and in addition +; each Resource Record currently consumes another 5 CONSes. + +;;; ATTRIB ,:,, + +DEFINE ATTRIB COD,SYMC,*NAME*,IRTN +IF1 [IRPS SYM,,[SYMC] + SYM==COD + TERMIN +IFE COD,.ERR Using attribute 0?! +IFGE COD-ATRLIM,.FATAL Attribute code too large! +] +%%S==. +LOC ATTRTB+COD ? ASCNT [NAME] +LOC ATTRIR+COD ? IRTN +LOC %%S +TERMIN + +ATRLIM==40. + +A$==,,-1 ; For bit-typeout mode +ATTRTB: BLOCK ATRLIM ; Table indexed by , holds ASCNT ptr to name. +ATTRIR: BLOCK ATRLIM ; Table to hold routine addr for xct'ing on input. + +;; Low-level LNs. +;; (Note: A$VALs and A$ATTRs do not require each other.) +ATTRIB 1.,A$ATTR:,|ATTRIBUTE| ;S Attrib name for succeeding A$AVAL +ATTRIB 2.,A$VAL:,|ATTRIBVAL| ;* Holds value for preceding A$ATTR + A$PAIR==A$VAL ;* For program clarity, A$PAIR + + +;; High level domain constructs. +ATTRIB 5.,A$DB:,|MASTER-DOMAIN-LIST| ;L LSE root +ATTRIB 6.,A$DOM:,|DOMAIN| ;S Name of a domain +ATTRIB 7.,A$CLAS:,|CLASS| ;L Class tree for the domain +ATTRIB 8.,A$RR:,|RESOURCE-RECORD| ;V Resource records for domain + +;; Low level domain constructs. +ATTRIB 20.,A$DIST:,|DISTRIBUTION| ;V RR Distribution info +ATTRIB 21.,A$TTD:,|TIME-TO-DIE| ;V RR Discard time from TTL +ATTRIB 22.,A$RRVAL:,|RESOURCE-VALUE| ;V RR Resource data +ATTRIB 23.,A$RC:,|REFERENCE-COUNT| ;V RR Reference count + +;; Attributes used for output descriptor lists. +ATTRIB 30.,A$OUTL:,|OUTPUT-LIST| ;L CDR is for MAKOUT +ATTRIB 31.,A$ANS:,|ANSWER-RECS| ;L Answer Section RRs +ATTRIB 32.,A$AUT:,|AUTHORITY-RECS| ;L Authority Section RRs +ATTRIB 33.,A$ADD:,|ADDITIONAL-RECS| ;L Additional Section RRs + +;; Attributes for LNs living in the CAR of A$DB. +ATTRIB 34.,A$SOA:,|START-OF-AUTHORITY| ;L CDR has other junk + ; CAR has string A$VALs + + + +;;; RH bits in the A$DIST word. + +%AUATH==1_0. ;This RR is authoritative. + ;(Do not move this bit!) + ; + ; +%AUAUS==1_1. ;We are the authority for this domain resource. + ; +%AUILL==1_2. ;Illicit RR which may be distributed only to hosts + ;on our trust list. + + +];$$DQDB + diff --git a/src/sysnet/dqdev.182 b/src/sysnet/dqdev.182 new file mode 100644 index 000000000..c57d7a8f6 --- /dev/null +++ b/src/sysnet/dqdev.182 @@ -0,0 +1,4247 @@ +;-*- Mode: MIDAS; Fonts: MEDFNT -*- +.SYMTAB 5001.,7000. + +IF1, TITLE DQDEV - Domain Device + ;CSTACY, summer 1985 +IF2,[ PRINTX / +/ + .TYO6 .FNAM1 + PRINTX / / + .TYO6 .FNAM2 + PRINTX/ +/] + +IFNDEF $$HST3,$$HST3==1 ;Switch for HOSTS3 feature. + +comment  + +The DQ device implements the Resolver component of the Domain system +for ITS. Generally, the DQ device is opened with a pathname which +specifies a query for information about a particular Domain resource. +If the open fails, there was some problem. If the open succeeds, data +can be read in a format determined by the open mode, and the Class and +Type of the query. The usual interface to DQ: is through the routines +in the RESOLV library. + +Note carefully that NAME ERROR means the domain does not exist, and +that RESOURCE NOT FOUND means that the requested resource could not be +found. The former indicates that an authority for the domain says +that the named domain does not exist, while the latter indicates that +we could not find the requested resource. + +If SOPENed in unit-image mode, the pathname is a string +of the form: "DQ:Opcode;Class;Type;Domain-name". + +Opcode strings include: HOSTS3 QUERY, IQUERY, CQUERYU and CQUERYM. + +Example: "DQ:QUERY;IN;A;SRI-NIC.ARPA" asks for the Internet-class +host address records for the domain SRI-NIC.ARPA. + +The NQUERY opcode is like setting %DRWOV. + +If %DRLNG is not set, the data words to read depends on the query being +made, and the user is expected to know how to interpret them. No domain +system information is returned. For example, for "DQ:IN;A;FOO" the +words to be read are Internet host addresses. As user software becomes +more sophisticated, %DRLNG will be made available, and perhaps we will +even reverse the semantics of the bit. + +If %DRLNG is set, the data words to read are: + 1: DQ-Version,,Header-length + 2: RCODE + 3: Bits: (AA,TC) + 4: ANCOUNT + 5: NSCOUNT + 6: ARCOUNT + 7: Number of data words next +Followed by all the Resource Records, in the format: + Domain Name length in chars + ASCII Domain Name + Type + Class + TTL + Length of RDATA + RDATA + +Illicit RRs and %DRANY: + +Our database may contain "illicit" data. These are RRs which we +should not have, but somehow do. Illicit data includes resources from +zones placed in our database by us without any authority or consent. +We use illicit data only in the absence of authoritative information. +We NEVER actually give our user any illicit data, unless permission to +do so was given by setting the %DRANY open bit. + +The database searching function (DBLUKR/RRCONS) will place illicit +data on on the output list and CACHE it. The database update routines +will ignore the illicit RRs and add any authoritative RRs. If the +user sets %DRANY, and both illicit and authoritative data exists, +essentially duplicate RRs may be output. It is up the user to filter +such duplicate data. + + + +.SEE OPNERR ;For a list of OPEN error codes we return. + + +SUBTTL Basic Definitions + +;;; Accumulators + +Z=0 ;Super temp. +A=1 ;A - H general purpose. +B=2 +C=3 +D=4 +E=5 +H=6 +PKT=7 ;Packet pointer. +W==PKT +L=10 ;LSE pointer. +F=11 ;Flags. +OC=12 ;OUT register. +U1=13 ;4 UUO Registers. +U2=14 +U3=15 +U4=16 +T==U1 ;Temps. +TT==U2 +P=17 ;Stack pointer. + +;;; I/O channels. + +UDPC==1 ;ITS IP queue +BOJ==2 ;BOJ +USR==3 ;Client + +DKIC==4 ;Disk input +DKOC==5 ;Disk output +ERRCHN==6 ;ERR device channel +LOCKC==7 ;For locking + +;;; UUO "channels". + +BRR==1 ;BOJ buffer containing digested RRs for client +TMPC==2 ;Temporary chan for short jobs +SAOCH==3 ;Channel for %LTSAO jobs +DBC==BRR ;NLISTS debugging info goes to BRR! + +;;; Device OPEN mode bits (not defined in ITS yet): + +%DR==1,,525252 +%DROUT==1 ;1.1 Output +%DRBLK==2 ;1.2 Block +%DRIMG==4 ;1.3 Image +%DRNRF==:10 ;1.4 Don't update the database +%DRLNG==:20 ;1.5 Access long-form data +%DRSII==:40 ;1.6 Super-image (packet level) +%DRWOV==:100 ;1.7 Force net search and database update +%DRAUT==:200 ;1.8 Authoritative data required +%DRANY==:400 ;1.9 Illicit data allowed +%DRWIZ==:40000 ;2.6 Maintenance +%DROJB==:100000 ;2.7 Magical OJB device protocol +%DRXXX==:200\400\1000\2000\4000\10000\20000 + +;;; Accumulator F holds global control state flags. +;;; In the RH, bits 1.1 through 2.4 are the OPEN mode bits above. + +OPNFLG==<.BP %DRANY\%DRAUT\%DRWOV\%DRSII\%DRLNG\%DRNRF\%DRIMG\%DRBLK\%DROUT,F> + +;;; Other flags in RH of F are: + +%PIBOJ==1_17. ;2.9 0 => new PI level request came in +%FOPEN==1_16. ;2.8 Device is open +%FOJBP==1_15. ;2.7 Doing weirdo OJB protocol +%FJIOT==1_14. ;2.6 Luser last seen in an IOT +%FJSIO==1_13. ;2.5 Luser last seen in a SIOT + +;;; Flags in LH of F are: + +%IOCER==1_17. ;Used by XCTIOC UUO +%BLDRN==1_16. ;An expired record has been used +%UPDAT==1_15. ;Current cache updated + + +;;; Assorted symbols that ITS is missing. + +%NINTS==400000 ;Interrupts push .JPC, .SUUOH, and LSPCL +%ENADR==17 ;Old error code for DIRECTORY NOT AVAILABLE +IOCEOF==2 ;IOC error code for END OF FILE + +.SEE OPNERR ;For a list of device OPEN errors. + +SUBTTL Libraries, Macros + +;;; Pure storage macros +PURPGB==4 ;Lots of impure. +.INSRT KSC;IVORY + +;;; Macros, Output, UUOs, and NLISTS. +UAREAS==1 ;Dynamic storage areas +ULISTS==1 ;Lists +$$OUT==1 ;Super super OUT package +$$OERR==1 ;ERR output type +$$OTIM==1 ;Time output items +.INSRT DSK:KSC;NUUOS + +;;; Time manipulating routines. +$$DSTB==1 ;DST bit in time words +$$ABS==1 ;Absolute days/seconds conversions +$$OUTT==1 ;Tables for pretty output +$$UPTM==1 ;Rtns for system time-in-30'ths conversions +.INSRT DSK:SYSENG;DATIME + +;;; HOSTS3 file lookup rtns +IFN $$HST3,[ +$$ARPA==1 +$$CHAOS==1 +$$HOSTNM==1 +$$SYMLOOK==1 +IFE U2-OC,.ERR NETWRK temp ACs lose +.INSRT SYSENG;NETWRK + ];$$HST3 + +;;; 20x monitor coding support routines (avoid reinvention of wheel) +.INSRT SRA;20XMAC + +CONSTANTS + +;;; Random macros. + +EQUALS PUSHER,PUSHAE +EQUALS POPPER,POPAE + +HALT=<.BREAK 16,100000> + +;;; Macro to zap a buffer of contiguous words. +DEFINE ZAP BUFADR,BUFWDS + SETZM BUFADR + MOVE T,[BUFADR,,BUFADR+1] + BLT T,BUFADR+ +TERMIN + +;;; Macro to uppercase an ASCII character. +DEFINE UPPER CHR + CAIL CHR,141 ;lower "a" + CAILE CHR,172 ;lower "z" + CAIA ;if got here, it's not lower a-z, skip + SUBI CHR,40 ;convert case +TERMIN + +;;; Macro to help debug jobdevs. + +DEFINE FUCKPT + CALL [ SETOM DEBUG + .SUSET [.ROPTION,,Z] + TLNE Z,%OPDDT + RET + SYSCAL DETACH,[%CLIMM,,%JSELF] + NOP + .VALUE [ASCIZ ":BreakpointSL DSK:DEVICE;JOBDEV DQ +"] + RET ] +TERMIN + + +SUBTTL Database definitions + +;;; UDP/IP definitions and routines. +.INSRT CSTACY;UDPLIB + +;;; Domain protocol and DQDEV database definitions. +$$DQDB==1 +.INSRT CSTACY;DQDEFS + +;;; Here we describe each valid Class and Type. +;;; Although there are currently only a few Classes and Types defined, +;;; their numeric codes can be up to 16 bits wide. Also, nobody said +;;; the codes had to be allocated contiguously. So, rather than locate +;;; their descriptors positionally, we find them linearly searching the +;;; CLSTAB and TYPTAB tables. (We leave unused table slots zero, on the +;;; assumption there is no Class or Type whose code is 0.) +;;; The other descriptor tables are indexed correspondingly. + +MAXCLS==256. ;Maximum # class codes. +MAXTYP==256. ;Maximum # type codes. + +MAXKND==100. ;Maximum # class+type combinations allowed. + .SEE ORRK + +CLSTAB: BLOCK MAXCLS ;These tables have the numeric codes +TYPTAB: BLOCK MAXTYP ;of the Class and Type items defined. + +CLSNAM: BLOCK MAXCLS ;These tables have ptrs to ASCIZ names for +TYPNAM: BLOCK MAXTYP ;the items. (Long in LH, short in RH.) + +.%CLSC==-1 +DEFINE DEFCLASS NUM,&SHRT&,&LONG& + .%CLSC==.%CLSC+1 + IFL MAXCLS-.%CLSC, .FATAL Class def wont fit bounds (increase MAXCLS) + TMPLOC CLSTAB+.%CLSC,{NUM} + TMPLOC CLSNAM+.%CLSC,{[ASCIZ LONG],,[ASCIZ SHRT]} +TERMIN + +.%TYPC==-1 +DEFINE DEFTYPE NUM,&SHRT&,&LONG& + .%TYPC==.%TYPC+1 + IFL MAXTYP-.%TYPC, .FATAL Type def wont fit (increase MAXTYP) + TMPLOC TYPTAB+.%TYPC,{NUM} + TMPLOC TYPNAM+.%TYPC,{[ASCIZ LONG],,[ASCIZ SHRT]} +TERMIN + +;;; Class and Type definitions: + +DEFCLASS DC$ANY,"*","Any" +DEFCLASS DC$IN,"IN","DARPA Internet" +DEFCLASS DC$CS,"CS","NSF CSnet" +DEFCLASS DC$CH,"CH","CHAOSnet" + +DEFTYPE DT$A,"A","Host address" +DEFTYPE DT$NS,"NS","Name server" +DEFTYPE DT$MD,"MD","Mail destination" +DEFTYPE DT$MF,"MF","Mail forwarder" +DEFTYPE DT$CNA,"CNAME","Canonical name" +DEFTYPE DT$SOA,"SOA","Start of authority zone" +DEFTYPE DT$MB,"MB","Mailbox" +DEFTYPE DT$MG,"MG","Mailgroup" +DEFTYPE DT$MR,"MR","Mail rename" +DEFTYPE DT$NUL,"NULL","NULL RR" +DEFTYPE DT$WKS,"WKS","Well known service" +DEFTYPE DT$PTR,"PTR","Pointer" +DEFTYPE DT$HIN,"HINFO","Host information" +DEFTYPE DT$MIN,"MINFO","Mail information" +DEFTYPE DT$XFR,"AXFR","Zone transfer request" +DEFTYPE DT$MLB,"MAILB","Mailbox related request" +DEFTYPE DT$MLA,"MAILA","Mail agent request" +DEFTYPE DT$ANY,"*","Any" + + +;;; Here we name the opcodes. + +OPNAMS: [ASCIZ "QUERY"],,DO$QRY + [ASCIZ "IQUERY"],,DO$YRQ + [ASCIZ "CQUERYM"],,DO$QCM + [ASCIZ "CQUERYU"],,DO$QCU + [ASCIZ "NQUERY"],,DO$WRO + [ASCIZ "HOSTS3"],,DO$TAB +OPNAML==.-OPNAMS + + +SUBTTL Errors + +LVAR ERRCOD: 0 ;Error code from failing system call. + +LVAR MAINT: 0 ;Maint mode switch. +LVAR DEBUG: 0 ;Debugging switch. +LVAR LOSER: 0 ;Controls .LOSE when toplevel. + +;;; Various error points (which jump into pure code). + +LVAR SYSLOS: 0 ? JSR AUTPSY ;ITS did something wrong. +LVAR AUTPSY: 0 ? JRST AUTPY0 ;Fatal condition encountered. +LVAR DIE: 0 ? JRST DEATH ;Normal death. + +AUTPY0: SKIPN LOSER + JRST DEATH + SOS Z,AUTPSY + HRLZ Z,Z + HRRI Z,%LSFIL + SYSCAL LOSE,[ Z ? AUTPSY ] + NOP +DEATH: SKIPE DEBUG ;Program termination. + .VALUE [ASCIZ ":PLUGH +"] + .LOGOUT 1, + + + + + + + +SUBTTL Misc. + +;;; Assorted Returns. + +POPJ1: AOS (P) +APOPJ:: +CPOPJ: RET + +POPAJ: POP P,A + RET + +POPBJ: POP P,B + RET + + +;;; Routine to purify code before dumping out installed device. + +PURIFY: MOVE A,[,,PURPGB] ;Pure pages AOBJN. + SYSCAL CORBLK,[%CLIMM,,%CBNDR ? %CLIMM,,%JSELF ? A ? %CLIMM,,%JSELF] + .LOSE %LSFIL + .VALUE [ASCIZ ":Purified. +"] + JRST GO + + + +SUBTTL Interrupts + +BVAR + LIPDL==50. ; Enough for 6 or so nestings of ints. +INTPDP: -LIPDL,,IPDL-1 ; Interrupt PDL pointer. +IPDL: BLOCK LIPDL ; " " stack. +EVAR + +%BADINT==%PIPDL+%PIMPV+%PIWRO+%PIOOB+%PIIOC+%PIILO ;The bad conditions. + +TMPLOC 42,{-LTSINT,,TSINT} ;New style interrupt vector. +TSINT: %NINTS,,INTPDP + %PIPDL+%PIMPV\%PIWRO\%PIOOB ? 0 ? -1 ? -1 ? INTBAD + %PIIOC ? 0 ? -1#<%PIMPV\%PIOOB\%PIPDL\%PIWRO> ? -1 ? INTIOC + %PIILO ? 0 ? %PIILO ? 1_BOJ ? INTILO + %PIRLT ? 0 ? %PIRLT ? 1_BOJ ? INTRLT + 0 ? 1_BOJ ? 0 ? 1_BOJ ? INTBOJ +LTSINT==.-TSINT + +INTIOC: NOP +INTILO: NOP +INTBAD: JSR AUTPSY + + + +SUBTTL Real time clock + +;;; TIMER seconds,lossage-return + +DEFINE TIMER SECS,?LOSRET + MOVE T,[600000,,[SECS*60.]] + .REALT T, + .SUSET [.SIMASK,,[%PIRLT]] + MOVEI T,LOSRET + MOVEM T,RLTRET +TERMIN + + +DEFINE TIMOFF + .SUSET [.SAMASK,,[%PIRLT]] + .SUSET [.SAPIRQC,,[%PIRLT]] + SETZM RLTRET + MOVE Z,[400000,,[0]] + .REALT Z, + NOP +TERMIN + + +LVAR RLTRET: 0 + +INTRLT: MOVE Z,[400000,,[0]] + .REALT Z, + NOP + SKIPE RLTRET + SYSCAL DISMIS,[%CLBIT,,%NINTS ? INTPDP ? RLTRET ] + JSR AUTPSY + + +SUBTTL Main program + +GO: MOVE P,[-PDLLEN,,PDL-1] ;Initialize stack. + SETZ F, ;Clear all flags. + MOVE A,[-18.,,[ .ROPTION ? TLO %OPINT\%OPOPC\%OPLOK\%OPLKF + .RMASK1 ? IOR [%BADINT] ;Bad ints enabled! + .RDF1 ? SETZ + .RMSK2 ? IOR [1_BOJ] ;Enable BOJ interrupt + .RDF2 ? SETZ + .RUNAME ? MOVEM UNAME + .RJNAME ? MOVEM JNAME + .RUIND ? MOVEM INDEX + .ROPTION ? MOVEM B ]] ;B gets new option bits. + SYSCAL USRVAR,[ %CLIMM,,%JSELF ? A ] + JSR AUTPSY + TLNE B,%OPDDT ;If running under DDT + JRST [ SETOM DEBUG ; do OJB hack. + MOVE A,[-2.,,[ .ROPTION ? TLO %OPOJB ]] + SYSCAL USRVAR,[ %CLIMM,,%JSELF ? A ] + JSR AUTPSY + JRST GO10 ] + ;; Now initialize our memory. +GO10: MOVE A,[-,,OPKTPG] ;Create IP packet buffers. + SYSCAL CORBLK,[ %CLIMM,,%CBNDR+%CBNDW + %CLIMM,,%JSELF ? A ? %CLIMM,,%JSNEW ] + JSR AUTPSY + ZAP OPKT,PG$SIZ ;Init network packet buffers. + ZAP IPKT,PG$SIZ + MOVE A,[-,,FREEPG] + UARINIT A ;Initialize area UUOs and PAGSER. + MOVSI A,-NAREAS ;Make sure all ARBLKs declared closed, +GO12: MOVE B,ARPTBL(A) ;by getting ARPT to each + SETZM $AROPN(B) ;and zapping. + AOBJN A,GO12 + MOVEI A,TMPAR ;Initialize temporary area! + CALL LSEOPN + CALL LKINIT ;Ensure database locks available. + MOVEI A,10\.UAO ;Set modes for unidirectional BOJ open. + MOVEM A,MYMODE ;Remember which mode we opened in. +GOBOJ: TRZ F,%PIBOJ ;Say there is work to do. + SYSCAL OPEN,[%CLBTW,,MYMODE ? %CLIMM,,BOJ ? [SIXBIT /BOJ/] ? SETZ ] + JSR AUTPSY + .SUSET [.SIFPIR,,[1_BOJ]] + CAI ;Begin at PI level. + .HANG ;Wait for an OPEN call to be processed. + JSR AUTPSY ;Should dismiss into NOOSE. + +LVAR MYMODE: 0 ;My BOJ: channel open mode bits. + + +SUBTTL BOJ interrupt handler and MP level dispatch + +;;; We use MP level to perform most requests, since we want to be able to +;;; interrupt out of them if the user PCLSRs for one reason or another. +;;; We use PI level to receive operation requests and to set up the args +;;; for the MP level routines. PI level clears the flag %PIBOJ. +;;; When MP toplevel sees %PIBOJ set, it can go to sleep because all +;;; outstanding tasks completed and no new ones have come in yet. +;;; The flags %FJIOT\%FJSIO say the user was last seen asking for an IOT. +;;; MP level routines clobber any ACs, PI level routines clobber only temps. +;;; +;;; All JOBRETs should JSR PCLSRD if they fail. Note that this prohibits +;;; them from having any state. +;;; +;;; Currently this program does not know how to do very many things. +;;; We can assume that if we are done working on opening up the file (Domain +;;; Resolving) and there is something to do, tbc hat it must be outputting the +;;; results (Resource Records) we found. If in the future we support more +;;; operations, we may need to implement a dispatch on the JOBOP opcode we +;;; got from the most recent interrupt. + +;;; BOJFIN [addr] Macro to dismiss a BOJ interrupt. +DEFINE BOJFIN (ADDR) + JRST [ POPPER P,[ERRCOD,TT,T,Z] + .CALL [ SETZ ? 'DISMIS ? %CLBIT,,%NINTS + IFB [ADDR] SETZ INTPDP + .ELSE INTPDP ? SETZ ADDR + ] + ] +TERMIN + +LVAR PCLSRI: 0 ? JRST PCLRTI ;Just like PCLSRD, except from interrupt level. +LVAR PCLSRD: 0 ? JRST PCLRET ;JSR here on losing JOBRET, jump to pure. +LVAR PCLSRP: 0 ;Switch says some JOBRET was PCLSRd. +LVAR PCLSER: 0 ;Place to stuff ERRCOD across BOJFIN (ugh) + +PCLRTI: MOVE T,PCLSRI ;Fixup to reuse PCLRET recovery code + MOVEM T,PCLSRD + MOVE T,ERRCOD ;BOJFIN restores this + MOVEM T,PCLSER + BOJFIN [.+1] ;Leave BOJ PI level + SKIPA T,PCLSER ;Join MP level recovery code + +PCLRET: MOVE T,ERRCOD ;Bad state lossage? + JUMPE T,NOOSE ; Extremely bad state? Fuck it. + CAIE T,%EBOJ + .LOSE + SETOM PCLSRP ;No, call completed but not returned from. + ;Fall into NOOSE! + +NOOSE: TRNE F,%PIBOJ ;Here to hang ourselves. + .HANG ; Work is done at MP level. + TRO F,%PIBOJ ;Fix stupid flag + TRNN F,%FOPEN ;If have pathname, but device not yet open + JRST [ PUSHER P,[A,B,C] ;Cretinism + JRST OPEN50] ; go work on that. + TRNE F,%FJIOT\%FJSIO ;If user last seen in IOT or SIOT + JRST OUTPUT ; work on outputting data. + JRST NOOSE ;Nothing to do right now - we'll just hang out. + +;;; MPFIN - Macro to return to main program level loop. +MPFIN==: + + + +BVAR +ARGS: BLOCK 12. ;JOBCAL arg from client. +ARGLEN==.-ARGS +JOBOP: 0 ;JOBCAL opcode from client. +OPNMOD: 0 ;Mode we were opened in. +OPNARG: 0 ;Addr of filename arg from ARGS. + PATHLN==103. ;Max length in wds of pathname. +PATH: BLOCK PATHLN ;The actual SOPEN pathname string. +OPNLEN==.-OPNMOD +EVAR + +INTBOJ: PUSHER P,[Z,T,TT,ERRCOD] + ZAP ARGS,ARGLEN ;Our client has a system call for us. + MOVE TT,[-ARGLEN,,ARGS] ;Find out what it is. + SYSCAL JOBCAL,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? TT ? %CLOUT,,T] +; JSR AUTPSY ; (Client shouldn't vanish here?) + BOJFIN ; Try this instead + MOVE TT,T + EXCH TT,JOBOP ;Remember opcode for debugging purposes. + TLNE T,%JGCLS ;If user requested CLOSE + JRST CLOSE ; ALWAYS oblige him. + TLNE T,%JGFPD ;Is this is a PCLSRd call restarting? + AOSE PCLSRP ;Yes, did last call complete without JOBRETing? + JRST INTBO1 ;No or no, treat this as a new call. + MOVE T,PCLSRD ;Did complete but didn't JOBRET + XCT -2(T) ;Try doing the JOBRET again + JRST INTBO1 ;Lost, just fake new operation + SETZM PCLSRD ;Paranoia + BOJFIN ;Won, dismiss and wait for new call. + +INTBO1: SETZM PCLSRD ;New operation starting. + TRZ F,%FJIOT\%FJSIO\%PIBOJ + LDB T,[000400,,JOBOP] ;Pick up opcode. + TRNN F,%FOPEN ;Dispatch off opcode to a handler which + JRST @OPNTBL(T) ;depends on whether we are already open. + JRST @CALTBL(T) + +;;; Dispatch table for initial JOBCAL request. + +OPNTBL: OFFSET -. +%JOOPN:: OPEN ;OPEN and SOPEN. +%JOIOT:: OPNDIE ;Nothing else supported yet. +%JOLNK:: OPNWTD +%JORST:: OPNDIE +%JORCH:: OPNDIE +%JOACC:: OPNDIE +%JORNM:: OPNWTD +%JORWO:: OPNDIE +%JOCAL:: OPNDIE ;No non-channel .CALLs supported yet. + OFFSET 0 + +;;; Dispatch table for later JOBCAL requests. + +CALTBL: OFFSET -. +%JOOPN:: OPEN ;.OPEN +%JOIOT:: IOT ;.IOT +%JOLNK:: CALWTD ;MLINK +%JORST:: CALWTD ;.RESET +%JORCH:: CALWTD ;.RCHST +%JOACC:: CALWTD ;.ACCESS +%JORNM:: CALWTD ;.FDELE (DELETE OR RENAME) +%JORWO:: REOPEN ;.FDELE (RENMWO) +%JOCAL:: DOCALL ;.CALL + OFFSET 0 + +;;; Symbolic .CALL processor. +;;; Note: most system calls are handled entirely at interrupt level. + +DOCALL: MOVE T,ARGS+0 ;Get the .CALL name. + CAMN T,[SIXBIT /SREAPB/] + JRST SREAPB + JRST CALWTD ;Unknown symbolic call - "Wrong Type Device". + + +;;; Non-fatal error returns. +;;; CALWTD - Wrong Type Device for client's request. +;;; CALERR - Other errors for client's request. + +CALWTD: MOVSI T,%EBDDV +CALERR: SYSCAL JOBRET,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? T ] + NOP + BOJFIN + +CALDIE: JSR AUTPSY ;Here for fatal JOBCALs. + +;;; BOJIOC - IOC error after opened. + +BOJIOC: SYSCAL SETIOC,[%CLIMM,,BOJ ? T ] + NOP + JSR AUTPSY ;Is this the right way to flush? + + + +SUBTTL OPEN operation (main entry point) + +;;; OPEN - PI handler for (S)OPEN system call. + +OPEN: PUSHER P,[A,B,C] + ZAP OPNMOD,OPNLEN ;Zap pathname. + MOVE A,ARGS+5 ;Else this is the initial OPEN + MOVEM A,OPNMOD ;Which open mode client asking for. + DPB A,[OPNFLG] ;Stuff modes into our own flag bits. + TRNE A,%DRWIZ ;If a wizard is hacking us + SETOM MAINT ; go into maintenance mode. + TRNE A,%DROJB ;If this is the weirdo subjob protocol + TRO F,%FOJBP ; note that fact. + ;; Here check for unimplemented modes... + TRNE A,%DROJB+%DRSII+%DRLNG+%DRNRF+%DRXXX + JRST OPNNSM +OPEN10: MOVE B,ARGS+4 ;Get device we're being opened as. + CAME B,[SIXBIT /DOMAIN/] + CAMN B,[SIXBIT /DQ/] ;If not "DQ:" or "DOMAIN:" + CAIA ; give "mode unavailable" error. + JRST OPNNSM + TRNE F,%DROUT ;If client asking to write + JRST [ MOVSI T,%ENSIO ; on us, give "wrong direction" error. + JRST OPNERR ] + TRZ A,777760 ;Check his basic open mode. + TRC A,1 ;Complement read/write. + TRO A,10 ;Does this bit do anything? + CAME A,MYMODE ;If pipe mismatch + JRST [ MOVEM A,MYMODE ; Set the mode our client wants + POPPER P,[C,B,A] ;and start opening all over for him. + BOJFIN [GOBOJ] ] + SKIPN A,ARGS+7 ;If we were not SOPENed + JRST OPESIX ; do special thing. + +;; Rejoin here on RENMWO +OPEN20: MOVEM A,OPNARG ;Stash away ptr to Bp for safekeeping. + CALL SOPEN ;Read argument string. + JRST [ MOVSI T,%EBDRG ; If can't, error "meaningless args". + JRST OPNERR ] +OPEN50: CALL OPENAR ;Open up RRECS text area. + CALL RESOLV ;Locate the resource records. + JRST OPNERR ; Not found, client's call fails. +OPEN80: MOVEI A,RRECS ;Get RR area. + SKIPN $AROPN(A) ;Make sure it's open. + JRST OPNDIE + TRNN F,%DRIMG ;In ASCII mode + JRST [ MOVE B,$ARWPT(A); Get write pointer (end of used area) + SUB B,$ARLOC(A) ; Make relative to beg + MULI B,5 ; do bp hack + ADD C,UADBP7(B) ; Get # chars. + MOVE B,$ARLOC(A); Now cons up a Bp to start. + HRLI B,440700 + JRST OPEN90 ] + MOVE C,$ARWPT(A) ;Write ptr to end of area. + SUB C,$ARLOC(A) ;Find length from start. + MOVE B,$ARLOC(A) ;Get write ptr + HRLI B,444400 ;Make Bp from it. +OPEN90: MOVEM B,BUF.BP ;Initialize Bp to data we found. + MOVEM C,BUF.CT ;Initialize Character count of data found. + SETZM IOT.CT ;No data given yet. + TRZ F,%FJSIO\%FJIOT ;Not IOTing yet + POPPER P,[C,B,A] + SYSCAL JOBRET,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? %CLIMM,,1 ] + JSR PCLSRI + TRO F,%FOPEN ;Device is now open. + BOJFIN [NOOSE] ;Dismiss to toplevel. + +;;; Here to handle RENMWO. +REOPEN: PUSHER P,[A,B,C] ;Pretend co-routines haven't been invented yet + TRNN F,%FOPEN ;Are we open? + JRST OPNBCH ;No, error "bad channel" + SKIPE A,ARGS+10 ;Get arg if SOPEN format rename + JRST OPEN20 ;Got it, rejoin main open code + MOVSI T,%EBDRG ;Otherwise, error "meaningless args". + JRST OPNERR + + +;;; OPENAR - Opens up the RRECS text area. +;;; Leaves default output channel on it. +;;; Does not skip. +;;; +;;; KLUDGE WARNING: Reuses area if already open, to avoid PAGSER overhead. + +OPENAR: PUSHER P,[A,B] + SKIPE A,$ARLOC+RRECS ; Area already open? + JRST [ TRNN F,%DRIMG ; Yeah. Reinit. Ascii mode? + HRLI A,440700 ; Yup, need byte pointer + MOVEM A,$ARWPT+RRECS ; Reinit write pointer + MOVEM A,$ARRPT+RRECS ; And read pointer +IFN 0,{ ; Seems like a waste of cycles + MOVS B,A ; Cons BLT argument + HRRI B,1(A) ; to zero out the area + MOVE A,$ARTOP+RRECS ; End of area (+1) + BLT B,-1(A) ; Zap! +} ; (Well, put it back in if I'm wrong!) + MOVSI A,%ARTCH ; Assume not ascii + ANDCAM A,$ARTYP+RRECS ; so turn off flag + TRNE F,%DRIMG ; Is it ascii? + JRST OPNAR9 ; Nope, done + IORM A,$ARTYP+RRECS ; Is ascii, turn flag on + MOVE A,$ARLEN+RRECS ; Get area length + IMULI A,5 ; Convert to chars + MOVNM A,$ARCHL+RRECS ; That's how much room is left + JRST OPNAR9 ] ; End of kludge. + DMOVE A,[%ARTZM,,RRECS ? [512.,,PG$SIZ]] + TRNN F,%DRIMG ; Really do have to open area. + TLO A,%ARTCH ; Set char mode bit iff needed + UAROPN A ; 1, 2, 3, thrash. +OPNAR9: MOVE A,$ARLEN+RRECS ; Kludge #2 + TRNE F,%DRIMG ; Image mode? + MOVNM A,$ARCHL+RRECS ; Yeah, bash count for OUT routines (yuk) + OUT(BRR,OPEN(UC$UAR,RRECS)) + OUT(,CH(BRR)) ; Twiddle to init and setup default channel + POPPER P,[B,A] + RET + + +ERRORS: EXPUNGE ERRORS +; List of OPEN error codes we may return to the user: +; +; %ENSFL NAME ERROR (FILE NOT FOUND) +; %ENSJB RESOURCE NOT FOUND (NO SUCH JOB) +; %ENRDV SERVER NOT AVAILABLE (DEVICE NOT READY) +; %ENADV LOCAL DATABASE PROBLEM (DEVICE NOT AVAILABLE) +; %EBDFN FORMAT ERROR (ILLEGAL FILE NAME) +; %ENADR UNKNOWN CLASS (DIR NOT AVAILABLE) +; %ENSDR UNKNOWN TYPE (NON-EXISTENT DIR) +; %ENAPK AUTHORITATIVE DATA UNAVAILABLE (PACK NOT MOUNTED) +; +; %ENNSM MODE NOT AVAILABLE +; %ENSIO WRONG DIRECTION +; %EBDDV WRONG TYPE DEVICE +; +; +; %EROPG undefined (CANT ACCESS PAGE) +; %EBDFL undefined (UNRECOGNIZABLE FILE) +; %EBDLK undefined (LINK TO NONEXT FILE) +; %ETMLK undefined (LINK DEPTH EXCEEDED) +; %EFLDR undefined (DIR FULL) +; %ERODV undefined (DEV WRITE LOCKED) +; %ENAFL undefined (FILE LOCKED) + +;;; Fatal error returns. +OPNBCH: MOVSI T,%EBDCH ? JRST OPNERR ; Bogus RENMWO (channel not open). +OPNBFN: MOVSI T,%EBDFN ? JRST OPNERR ; Bad File name for open. +OPNNSM: MOVSI T,%ENSMD ? JRST OPNERR ; Mode Unavailable for open. +OPNWTD: MOVSI T,%EBDDV ? JRST OPNERR ; Wrong type device for open. + +;;; OPNERR - Other fatal errors for open. +OPNERR: SKIPE MAINT ;If erring in Maint mode + JRST OPEN80 ; just output whatever we got. + TRNN F,%FOPEN ;Already open (RENMWO lossage)? + .SUSET [.SMSK2,,[0]] ;No, ignore any BOJ interrupts while dying. + MOVEI A,12. ;Try to give fatal err up to one dozen times. + TRZ T,-1 ;Flush any RH bits - error code is in LH. +OPNER1: SYSCAL JOBRET,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? T ] + CAIA + JRST OPNDIE + MOVE TT,[-ARGLEN,,ARGS] ;Receive request again for system call. + SYSCAL JOBCAL,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? TT ? %CLOUT,,T] + JRST OPNDIE + TLNE T,%JGCLS ;If user requested CLOSE + JRST CLOSE ; ALWAYS oblige him. + TLNE T,%JGFPD ;If this is a PCLSRd call restarting + SOJG A,OPNER1 ; we can finish trying to give an error. + +OPNDIE: TRNN F,%FOPEN ;RENMWO? + JSR DIE ;No, just die. + POPPER P,[C,B,A] ;Yes, fix cretinism + BOJFIN [NOOSE] ;Dismiss to top level + + +;;; SOPEN - Read SOPEN string. +;;; OPNARG/ ptr to arguments. +;;; Maps in and reads the SOPEN arguments from the client's +;;; address space, and copies the entire filename string into PATH. +;;; Skips if successful. +;;; +;;; Note: I originally implemented this stuff by opening the client +;;; on the USR device and IOTing the string from his address space. +;;; This was slower and required hair to deal with the fact that the +;;; client would be PCLSRd and ask for his SOPEN call a second time. + +SOPEN: PUSHER P,[A,B,C] + HRRZ A,OPNARG ;Address of args. + LSH A,-10. ;Page in client's address space. + MOVEI B,CLNTPG ;Corresponding page in ours. + MOVE T,B ;Find the offset. + SUB T,A ;T has page difference. + IMULI T,PG$SIZ ;Will add in this to get our ptr. + .USET BOJ,[.RUINDEX,,C] ;Find job index of our client. + ADD C,[SETZ] ;Make into job spec. + SYSCAL CORBLK,[ %CLIMM,,%CBNDR ? %CLIMM,,%JSELF + B ? C ? A ] + JRST SOPE99 + AOS A ;Try to get a second page so that + AOS B ;the pathname string can be a page long. + SYSCAL CORBLK,[ %CLIMM,,%CBNDR ? %CLIMM,,%JSELF + B ? C ? A ] + NOP ; OK, I guess it wasn't that long, huh. + MOVE A,[440700,,PATH] ;Now slurp up a copy of the pathname. + HRRZ B,OPNARG ;Get Y of arg in user's core. + ADD B,T ;Adjust to where we mapped it. + HLL B,OPNARG ;B has SOPEN ptr in our address space. + SETCM T,B ;See if our "Bp" is realy an AOBJN ptr. + MOVSI C,-1 ;If it isn't, only one Bp to hack. + TLNE B,-1 ;If LH is 0, treat as Bp. + TLNE T,777700 ;Might be AOBJN to <= 64 Bps. + JRST SOPE15 ; Nope, it's just a vanilla Bp. + MOVE C,B ;Save AOBJN ptr in C. +SOPE10: MOVE B,(C) ;Find next Bp. +SOPE15: TLNN B,-1 ;If Bp has zero LH + HRLI B,440700 ; fix it up to first char in word. +SOPE20: ILDB Z,B ;Increment Bp and load character. + IDPB Z,A ;Stuff it. + JUMPN SOPE20 ;Each string ends with null byte. + AOBJN C,SOPE10 ;Go back for another Bp. +SOPE90: AOS -3(P) +SOPE99: POPPER P,[C,B,A] + RET + + + +SUBTTL OPEN operation for special filenames + +;;; OPESIX - Open device to some sixbit filename. +;;; Only certain magic filenames are available. +;;; +;;; .FILE. (DIR) - Directory listing of DOMAIN .SEE UFDLST +;;; ..NEW. (DAT) - Create and init database .SEE NEWDAT +;;; + +OPESIX: PUSHER P,[A,B,C] + CALL OPENAR ;Open text area as usual. + MOVE A,ARGS+1 + CAMN A,[SIXBIT /..NEW./] + JRST [ MOVE A,ARGS+2 + CAME A,[SIXBIT /(DAT)/] + JRST .+1 + MOVEI A,NEWDAT + JRST OPES50 ] + CAMN A,[SIXBIT /.FILE./] + JRST [ MOVE A,ARGS+2 + CAME A,[SIXBIT /(DIR)/] + JRST .+1 + MOVEI A,UFDLST + JRST OPES50 ] +OPES10: JRST OPNBFN ;"Illegal file name". +OPES50: CALL (A) + NOP +OPES80: MOVEI A,RRECS ;Get RR area. + SKIPN $AROPN(A) ;Make sure it's open. + JRST OPNDIE + MOVE B,$ARWPT(A) ;Get write pointer (end of used area) + SUB B,$ARLOC(A) ;Make relative to beg + MULI B,5 ;do bp hack + ADD C,UADBP7(B) ;Get # chars. + MOVE B,$ARLOC(A) ;Now cons up a BP to start. + HRLI B,440700 + JUMPLE C,OPNBFN + MOVEM B,BUF.BP ;Initialize Bp to data we found. + MOVEM C,BUF.CT ;Initialize Character count of data found. + SETZM IOT.CT ;No data given yet. + TRO F,%FOPEN ;Also, device is now open! + SETOM PATH ;Make pathname appear extant. + POPPER P,[C,B,A] +OPES90: SYSCAL JOBRET,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? %CLIMM,,1] + JSR PCLSRI ;Ok boss, we're open + BOJFIN [NOOSE] ;Dismiss to toplevel. + + +;;; UFDLST - Open up as directory. +;;; For now, this just dumps the database. + +UFDLST: PUSHER P,[A,B,C] + CALL RDLOCK ;Get a read lock. + JRST [ MOVSI T,%ENADV ; Fail if cannot. + JRST OPNERR ] + CALL DBGET + JSR AUTPSY + OUT(,("Database locked and loaded; "),D(USERS),(" readers."),EOL,EOL) + SETOM DEBCHP + MOVE L,$ARLOC+DOMAIN + CALL DEBLSE + NOP + OUT(,CRLF,CRLF) + MOVE L,$ARLOC+DOMADR + CALL DEBLSE + NOP + OUT(,CRLF) + POPPER P,[C,B,A] + RET + +;;; NEWDAT - Create new database. +;;; The sname must be "XYZZY". + +NEWDAT: PUSHER P,[A,B,C] + MOVE A,ARGS+3 ;Get sname. + CAME A,[SIXBIT /XYZZY/] ;Require either magic incantation + SKIPE MAINT ;or maint mode before munging database. + CAIA + JRST OPNBFN + CALL MAKDB ;Try to create database. + JRST [ MOVSI T,%ENADV ; If any problems, report + JRST OPNERR ] ; device not available. + POPPER P,[C,B,A] + RET ;Else print out stats! + + +SUBTTL IOT operation and MP level output + +;;; When the user OPENs us up, a UUO area is created to contain the data +;;; we will be sending down the BOJ pipeline. The Domain Resolver uses +;;; the OUTput UUOs to write data of some sort into the area. +;;; +;;; The data in the area is emptied down the BOJ channel by the +;;; output routines here. We set up at (S)IOT interrupt level +;;; and do real work at MP level. The BOJ channel was opened as +;;; an unbuffered UUO channel, and so we can use OUTput UUOs to +;;; read the data from RRECS and write it on BOJ. + + +;;; IOT - Control comes here at interrupt level. + +BVAR +BUF.BP: 0 ;Bp to unread data buffer. +BUF.CT: 0 ;Length of data there. +IOT.CT: 0 ;How much we already given. +IOTREQ: 0 ;How much user is asking for. +EVAR + +IOT: PUSH P,A + MOVE A,ARGS+0 ;Just pick up request args. + MOVEM A,IOTREQ + MOVE T,JOBOP + TRZ F,%FJIOT\%FJSIO ;Clear both operation flags + TLNN T,%JGSIO ;Note which operation being hacked. + TROA F,%FJIOT + TRO F,%FJSIO + POP P,A + BOJFIN ;Dismiss to MP level. + +;;; OUTPUT - Runs at MP level (may be interrupted). + +OUTPUT: TRNN F,%DRBLK ;If unit mode + JRST [ TRNE F,%FJSIO ; for SIOT + SKIPA C,IOTREQ ; get byte count + MOVEI C,1 ; for IOT, transfer one byte + JRST OUTP10 ] + HLRE C,IOTREQ ;Else for block mode + MOVNS C ;get wd count. + TRNN F,%DRIMG ;If ASCII + IMULI C,5. ; make into chars. +OUTP10: MOVE D,BUF.CT ;D has chars in buffer. + SUB D,IOT.CT ;Find out how many he hasn't seen. + JUMPLE D,OUTEOF ; If he has seen everything, give EOF. + CAML D,C ;Else see if enough for this IOT. + MOVE D,C ;D gets # of bytes we can give the user. + SUB C,D ;C gets number user wants beyond EOF. + TRNN F,%DRBLK ;If unit mode + JRST [ MOVE E,D ; return data via SIOT. + SYSCAL SIOT,[%CLIMM,,BOJ ? BUF.BP ? D] + JSR AUTPSY ; Eh? + SUB E,D ; Compute number of chars given. + SKIPE D ; If he didn't take all we offered, + SETZ C, ; He was PCLSRd, so don't offer any more. + JRST OUTP50 ] + TRNE F,%DRIMG ;Block Image mode is simple: byte=word. + JRST OUTP40 ;Block ASCII mode needs a weird kludge. + IDIVI D,5. ;Convert chars back into words for IOT. + JUMPE D+1,OUTP40 + JUMPG D,OUTP40 +OUTP20: MOVSI D,-1. ;Else do last partial-word. + DPB D+1,[440300,,D] ;Adjust magic top bits in AOBJN ptr. + JRST OUTP42 + +OUTP40: MOVNS D ;Else block mode. + HRLZS D ;Make AOBJN to what we will give. +OUTP42: HRR D,BUF.BP + SKIPE IOT.CT ;Each time we IOT + AOS D ; advance AOBJN ptr. + .IOT BOJ,D ;Return data via IOT. +OUTP45: SKIPGE D ;If creator didn't take all we offered, + SETZ C, ; he was PCLSRd, so don't try to any more. + MOVEI E,-1(D) ;Find # wds given. + SUB E,BUF.BP + ANDI E,-1 + ADDM E,BUF.BP ;Update the Bp. + TRNN F,%DRIMG ;If in ASCII mode + IMULI E,5. ; maintain count in chars, not words. +OUTP50: ADDM E,IOT.CT ;Update count of chars given. + JUMPN C,OUTP10 ;Outstanding bytes this IOT? Try again. + MPFIN ;This IOT satisfied, return. + +.ERR Decide if OUTEOF code should do JOBIOC or not! + +OUTEOF: TRNN F,%FJSIO ;Reading past end of file! + TRNE F,%DRBLK ;For SIOT or in block mode + JRST [ SYSCAL JOBRET,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? %CLIMM,,0] + JSR PCLSRD + MPFIN ] + TRNE F,%DRIMG ;In unit image mode, signal IOC error. + JRST [ SYSCAL JOBIOC,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? %CLIMM,,IOCEOF] + JSR PCLSRD + MPFIN ] + .IOT BOJ,[-1,,^C] ;In unit ASCII mode, give magic value. + MPFIN + + + + +SUBTTL Long filename parser +BVAR +QUOPC: BLOCK 2. ;Opcode token from pathname. +QUCLA: BLOCK 2. ;Class token from pathname. +QUTYP: BLOCK 2. ;Type token from pathname. + +QOP: 0 ;Opcode number. +QNAME: 0,,QNASTR ;SPT to the QNAME parsed from the pathname. +QNASTR: BLOCK PATHLN ;Actual string lives here. +QCLASS: 0 ;QCLASS code. +QCLIDX: 0 ;QCLASS descriptor index. +QTYPE: 0 ;QTYPE code. +QTYIDX: 0 ;QTYPE descriptor index. +EVAR + +;;; PARSE - Parse the ASCIZ pathname from A. +;;; Skips if pathname appears to be properly formed. +;;; If non-skip, OPEN error code returned in T. + +PARSE: PUSHER P,[B,C] + SETZ B, + MOVE C,[-1,,":] + CALL PARNXT ;Skip over device name. + JRST PARLUZ + MOVE B,[440700,,QUOPC] + MOVE C,[-1,,";] + CALL PARNXT ;Find Query Opcode. + JRST PARLUZ + MOVEI T,0 + IDPB T,B + MOVE B,[440700,,QUCLA] + MOVE C,[-1,,";] + CALL PARNXT ;Find Class token. + JRST PARLUZ + MOVEI T,0 + IDPB T,B + MOVE B,[440700,,QUTYP] + CALL PARNXT ;Find Type token. + JRST PARLUZ + MOVEI T,0 + IDPB T,B + SETZ C, + MOVE B,[440700,,QNASTR] + CALL PARNXT ;Find QNAME. + NOP + SETZ T, + IDPB T,B + MOVEI A,QNASTR + CALL ASZLEN ;Make SPT for QNAME. + MOVEM A,QNAME + ;;; Now look up the Query Opcode. +PARS20: MOVE A,[440700,,QUOPC] + MOVSI C,-OPNAML +PARS21: HLRZ B,OPNAMS(C) + HRLI B,440700 + CALL STRCMP + JRST [ AOBJN C,PARS21 + JRST PARLUZ ] + HRRZ A,OPNAMS(C) + MOVEM A,QOP + ;; Now look up the Query Class. + MOVE A,[440700,,QUCLA] ;Bp to class token. + MOVSI C,-MAXCLS +PARS23: HRRZ B,CLSNAM(C) ;Get a class short-name. + HRLI B,440700 ;ASCIZ Bp to it. + CALL STRCMP ;Is this it? + JRST [ AOBJN C,PARS23 ; No, try next name. + MOVSI T,%ENADR ; Lossage: class not found. + JRST PARS99 ] + MOVE A,CLSTAB(C) ;Found it! + MOVEM A,QCLASS ;Save as QCLASS. + MOVEM C,QCLIDX + ;; Now look up the Query Type. +PARS30: MOVE A,[440700,,QUTYP] ;Bp to type token. + MOVSI C,-MAXTYP +PARS31: HRRZ B,TYPNAM(C) ;Get a type short-name. + HRLI B,440700 ;ASCIZ Bp to it. + CALL STRCMP ;Is this it? + JRST [ AOBJN C,PARS31 ; No, try next name. + MOVSI T,%ENSDR ; Lossage: type not found. + JRST PARS99 ] + MOVE A,TYPTAB(C) ;Found it! + MOVEM A,QTYPE ;Save as QTYPE. + MOVEM C,QTYIDX + AOS -2(P) ;Parsed OK, winskip. +PARS99: POPPER P,[C,B] + RET + +PARLUZ: MOVSI T,%EBDFN ;Here if pathname seems to + JRST PARS99 ;be malformed (illegal file name). + +;;; PARNXT gets the next token from A into B. +;;; RH C is break char, LH C is -1 to ignore spaces. + +PARNXT: HLRZ TT,C ;See if should ignore spaces. + HRRZ C,C ;Break char. +PARNX1: ILDB T,A ;Get char. + JUMPE T,CPOPJ ;If null, return. + CAMN T,C ;Else if delimiter + JRST POPJ1 ; Skip. + JUMPE TT,PARNX2 + CAIN T,40 ;Ignore spaces. + JRST PARNX1 +PARNX2: SKIPE B ;If B nonzero Bp + IDPB T,B ; copy chars. + JRST PARNX1 + + +SUBTTL Domain Name Resolver + +;;; RESOLV calls the pathname parser, and examines the open mode +;;; bits which specifies what the device is to resolve. +;;; The CACHE is set up, and then control is handed to the resolving +;;; routine appropriate for the opcode. + +RESOLV: PUSH P,A + MOVE A,[440700,,PATH] + CALL PARSE ;Parse resource pathname. + JRST POPAJ ; Eh? Make OPEN fail. + PUSH P,B +IFN $$HST3,[ + ;; If we are using the HOSTS3 database feature, memory + ;; management is a little different. We don't need much + ;; UUO area space, since we are not going to map in the database. + MOVE T,QOP ;Check query opcode. + CAIE T,DO$TAB ;If not hacking HOSTS3 + JRST RESO50 ; continue to normal initialization. + SKIPE NETWRK"HSTADR ;If HOSTS3 data already set up + JRST RESO60 ; go init CACHE LSE. + OUT(BRR,CLS) ;Okay, need to reset memory. + MOVE A,[-,,FREEPG] + UARINIT A ;Initialize area UUOs and PAGSER. + MOVSI A,-NAREAS ;Make sure all ARBLKs declared closed, +RESO20: MOVE B,ARPTBL(A) ;by getting ARPT to each + SETZM $AROPN(B) ;and zapping. + AOBJN A,RESO20 + MOVEI A,TMPAR ;Initialize temporary area! + CALL LSEOPN + CALL OPENAR ;Initialize output area and default channel. + MOVEI A,HSTPAG ;Map host table into top of memory. + MOVEI B,DKIC ;Use disk input channel. + CALL NETWRK"HSTMAP ;Open wide and say Ahh. + JRST [ MOVSI T,%ENADV ;If can't get access to file + JRST RESO99 ] ; fail - local database problem. + TRNN F,%DRIMG + OUTCAL(,("HOSTS3 database mapped in."),EOL) + JRST RESO60 +];$$HST3 +RESO50: ;; Read in the master Domain List. + CALL RDLOCK ;Get a read lock. + JRST [ MOVSI T,%ENADV ; Fail if cannot. + JRST OPNERR ] + CALL DBGET ;Read in database. + JSR AUTPSY + TRNN F,%DRIMG + OUTCAL(,("Database locked and loaded; "),D(USERS),(" readers."),EOL) +RESO60: TRNN F,%DRIMG ;In ASCII mode + JRST [ MOVE A,QCLIDX ; print out some debugging info. + HLRZ A,CLSNAM(A) + MOVE B,QTYIDX + HLRZ B,TYPNAM(B) + OUT(,("QCLASS: "),TZ(@A),TAB,("QTYPE: "),TZ(@B),EOL) + OUT(,("QNAME: "),TC(QNAME),EOL) + JRST .+1 ] + ;; Now create a cache for the query we are processing. + MOVEI A,CACHE + CALL LSEOPN + MOVE L,$ARLOC+CACHE ;Make this the current LSE! + MAKELN B,[A$OUTL,,NIL ? %LTLST,,[[0]]] ;Set up output & results LN. + MAKELN A,[A$DB,,NIL ? %LTLST,,[B]] ;Set up root node for cache. + MOVEM A,$LLLST(L) + POP P,B + POP P,A + MOVE T,QOP + CAIN T,DO$QRY ;LOOKUP is for simple queries. + CALRET LOOKUP + CAIN T,DO$YRQ ;LOOINV is for inverse queries. + CALRET LOOINV + CAIN T,DO$WRO ;NQUERY query hack forces use of net. + JRST [ TRO F,%DRWOV ? CALRET LOOKUP ] + CAIN T,DO$TAB ;HOSTS3 query just uses the host table. + JRST HSTABL + MOVSI T,%EBDFN ;Other opcodes fail with FORMAT ERROR. +RESO99: RET ;Fail. + + +comment  + +The main resolver routines are LOOKUP and LOOINV. +All of the resolver's routines skip for success. Upon failure they +return an OPEN error code in the LH of T. (The RH of T is available for +use, if someday we need to pass around some other kind of error state.) + +For each class-type combination there is a "resource locator" +subroutine to find the resource record(s) for a given domain name. +Resource locators are made known to LOOKUP with the RL macro. +These subroutines find a resource as in a simple query, and may +call whatever generic or special searching routines they like. +There is a core CACHE area which should usually be searched before +looking in the master Domain database or network servers. When a +resource record for a Domain is found by a search routine, the +(entire) Domain is copied into the CACHE area. + +The CACHE is smaller than the master database and is likely to contain +multiple pieces of information about a domain. As the resource locator +finds the desired data, it constructs an ordered list of CACHE-relative +LPs pointing to the data. The LP to this list (which is consed in +CACHE off of the A$DB LN there) is returned to LOOKUP from the resource +locator in acc A. LOOKUP then calls MAKOUT to construct our device's +output in RRECS. + +Resource locators expect CACHE to be the current LSE, and the root node +and A$OUTL node must be set up. They may look at (but must also +preserve) the QNAME, QCLASS, and QTYPE variables. Resource locators +smash no accs and skip return if they found something. + +The search routines pass their results back to the resource locator as +unordered lists. These lists are built off of the LN pointed at by the +CAR of the A$OUTL hanging off the A$DB in the CACHE. + +Resource locators construct and return (in A) a list beginning with an +A$OUTL node, whose CDR is three nodes: A$ANS, A$AUT, A$ADD (one for each +section). Each of those nodes has an ordered list of A$PAIRs specifying +the RRs which are to appear in that section. Each half of the value-word +of an A$PAIR contains an 18-bit LP. The LH points to the A$DOM node +containing the RR; the RH points to the desired A$RR node. + + + + +;;; Resource locator definitions: + +RLBLK==32. +RLKND: BLOCK RLBLK +RLRTN: BLOCK RLBLK + +.%RL==-1 +DEFINE RL CLASS,TYPE,RTN + .%RL==.%RL+1 + IFL RLBLK-.%RL, .FATAL Too many kinds of RLwers + TMPLOC RLKND+.%RL,{[TYPE,,CLASS]} + TMPLOC RLRTN+.%RL,{RTN} +TERMIN + +RL DC$IN,DT$ANY,X.SIMP +RL DC$IN,DT$A,X.SIMP +RL DC$IN,DT$PTR,X.SIMP +RL DC$IN,DT$CNA,X.SIMP +RL DC$IN,DT$NS,X.SIMP +RL DC$IN,DT$HIN,X.SIMP +RL DC$IN,DT$MB,X.SIMP +RL DC$IN,DT$MR,X.SIMP +RL DC$IN,DT$MD,X.SIMP +RL DC$IN,DT$MF,X.SIMP +RL DC$IN,DT$MG,X.SIMP +RL DC$IN,DT$MIN,X.SIMP +RL DC$IN,DT$NUL,X.SIMP +RL DC$IN,DT$WKS,X.SIMP + + +;;; LOOKUP a domain name +;;; A/ query pathname +;;; Skip returns with results stuffed into RRECS. +;;; Non-skip returns OPEN error code in T. + +LOOKUP: PUSHER P,[A,B,C,D,E] + MOVE A,QNAME ;Begin search with the items + MOVE B,QCLASS ;the user asked for. This will + MOVE C,QTYPE ;fan out until we find what we want. + MOVSI E,-RLBLK ;AOBJN to resource locators. +LOOK20: MOVE D,RLKND(E) ;Get a locator description. + JUMPE D,LOOK25 ;Ignore empty ones. + HLRZ T,(D) ;Type is in LH. + HRRZ TT,(D) ;Class in in RH. + CAME T,C ;Type match? + JRST LOOK25 ; No, wrong locator. + CAMN TT,B ;Class match also? + JRST LOOK40 ; Yes! Go locate a resource. +LOOK25: AOBJN E,LOOK20 ;No match, keep searching for handler. + MOVSI T,%ENAPK ;If no handler, no way to find the data! + JRST LOOK99 +LOOK40: CALL @RLRTN(E) ;Dispatch to resource locator for search. + JRST LOOK99 ; It failed, OPEN errs according to T. + CALL MAKOUT ;Go make output for our user. + TRNN F,%DRIMG + JRST [ OUT(,CRLF,("----------------------------------------"),EOL) + OUT(,("Dump of info cached this time:"),EOL) + SETOM DEBCHP + CALL DEBLSE + JRST LOOK90 ] +LOOK90: AOS -5(P) +LOOK99: POPPER P,[E,D,C,B,A] + RET + + +;;; LOOINV - Lookup Inverse +;;; Inverse queries are handled slightly differently. + +LOOINV: PUSHER P,[A,B,C] + MOVE A,QNAME ;Begin search with the items + MOVE B,QCLASS ;the user asked for. This will + MOVE C,QTYPE ;fan out until we find what we want. + CAIN B,DC$IN ;Support Internet Host Address queries. + CAIE C,DT$A + JRST [ MOVSI T,%EBDFN + JRST LOOI99 ] + MOVSI T,%EBDFN ;Doesn't work yet. +LOOI99: POPPER P,[C,B,A] + RET + + + +;;; HSTABL - Host table lookup +;;; A/ query pathname +;;; Skip returns with results stuffed into RRECS. +;;; Non-skip returns OPEN error code in T. + +HSTABL: PUSHER P,[A,B,C,D,E] + MOVE A,QNAME ;Search only for the items + MOVE B,QCLASS ;the user asked for. + MOVE C,QTYPE + FINDA D,[A$DB,,[$LLLST(L)]] ;Find root node. + JSR AUTPSY + MOVE D,LISTAR(D)+1 ;Get LP to result lists. + LDB T,[$LAFLD,,LISTAR(D)] + CAIN T,A$OUTL ;If LN is not output list + SKIPN D ; or if missing altogether + JSR AUTPSY ; LSE not set up. + SETZ T, + HRRM T,LISTAR(D) ;Zap CDR -- null output list. + SETZM LISTAR(D)+1 ;Zap CAR -- no results yet either. + CALL HSTBLK ;Straightforward search for resource. + JRST HSTA99 ; It failed, OPEN errs according to T. + MAKELN C,[A$ANS,,NIL ? %LTLST,,[A]] + HRRM C,LISTAR(D) ;Results go in ANSWER of output list. + CALL MAKOUT ;Go make output for our user. + TRNN F,%DRIMG + JRST [ OUT(,CRLF,("----------------------------------------"),EOL) + OUT(,("Dump of info cached this time:"),EOL) + SETOM DEBCHP + CALL DEBLSE + JRST HSTA90 ] +HSTA90: AOS -5(P) +HSTA99: POPPER P,[E,D,C,B,A] + RET + + + +SUBTTL Internet Class Resource Locators + +;;; X.SIMP - Simple things +;;; +;;; This can be used to find the data for queries which want +;;; only the named resource, and ignore Additional setion processing. + +X.SIMP: PUSHER P,[L,D] + FINDA D,[A$DB,,[$LLLST(L)]] ;Find root node. + JSR AUTPSY + MOVE D,LISTAR(D)+1 ;Get LP to result lists. + LDB T,[$LAFLD,,LISTAR(D)] + CAIN T,A$OUTL ;If LN is not output list + SKIPN D ; or if missing altogether + JSR AUTPSY ; LSE not set up. + SETZ T, + HRRM T,LISTAR(D) ;Zap CDR -- null output list. + SETZM LISTAR(D)+1 ;Zap CAR -- no results yet either. + CALL SEARCH ;Straightforward search for resource. + JRST X.SIM9 ; Not found, return error code. + ;; Now sort the list in A onto the output list. + ;; For simple queries, this is trivial, since all of the + ;; results go into the Answer section, and we leave the other empty. + MAKELN C,[A$ANS,,NIL ? %LTLST,,[A]] + HRRM C,LISTAR(D) + AOS -2(P) +X.SIM9: POPPER P,[D,L] + RET ;All done, LP for MAKOUT in A. + + +SUBTTL CSnet Class Resource Locators (none yet) + +SUBTTL Chaosnet Class Resource Locators (none yet) + +SUBTTL UUCP Class Resource Locators (none yet) + +SUBTTL BITNET Class Resource Locators (none yet) + + +SUBTTL Generic Search Routine + +;;; SEARCH - Search for information. +;;; A/ ptr to QNAME +;;; B/ QCLASS +;;; C/ QTYPE +;;; +;;; CONSes any data found into current LSE. +;;; Skips if the desired resource was found. +;;; On success, caller may look for results list in CACHE. +;;; Ptr to results is returned in A. +;;; +;;; The cache and the database (searched in that order) are assumed to +;;; have data which is complete for the lifetime of the resource record +;;; found. A network server will not be consulted unless the RR is +;;; missing, expired, or illicit. + +SEARCH: PUSHER P,[B,C,E,L,QNAME] + MOVEM A,QNAME ;Put QNAME in canonical place. + TRNE F,%DRWOV ;If "overwriting", don't check database. + JRST [ MOVE L,$ARLOC+DOMAIN + JRST SEAR70 ] + MOVE L,$ARLOC+CACHE ;First check is in the cruft found so far. + CALL DBLUKR ;Search database cache for resource. + CAIA + JRST SEAR90 + MOVE A,QNAME + CALL DOMLSE ;L gets appropriate database LSE. + CALL DBLUKR ;Search master database for resource. + CAIA + JRST [ MOVE E,$ARLOC+CACHE + EXCH L,E ;Aha! Found it in database. + CALL RRCONS ;Copy results into the cache. + JRST SEAR90 ] + HLRZ TT,T ;Examine error code from database search. + CAIN TT,%ENSFL ;If authoritative Name Error + JRST SEAR99 ; search is definitely over. + ;; Else try searching the network servers. +SEAR70: MOVE A,QNAME + CALL NTLUKR ;Search servers. + CAIA ; Sigh, we lost. Use error in T. +SEAR90: AOS -5(P) ;Skip return with LP to results in A! +SEAR99: POPPER P,[QNAME,L,E,C,B] + RET + + +SUBTTL Database searching + +;;; DOMAR is a macro for assigning certain zones to certain LSEs, +;;; providing data isolation and locality. Zones not mentioned +;;; with DOMAR are assigned to the default LSE, DOMAIN. +;;; +;;; Most domains names are kept in the big DOMAIN LSE, but special +;;; addressing domains, such as "44.0.3.10.IN-ADDR.ARPA" are kept in a +;;; seperate area from the regular domains names. +;;; +;;; NOTE: Remember that if you mention any LSEs here which you expect to +;;; be part of the database, you must also teach the database I/O +;;; routines (include initialization code and DBGET/DBPUT) about them! + +DOMLL==1. +DOMNAM: BLOCK DOMLL +DOMBLK: BLOCK DOMLL + +.%DM==-1 +DEFINE DOMAR LSE,NAM + .%DM==.%DM+1 + IFL DOMLL-.%DM, .FATAL Too many domain areas + TMPLOC DOMNAM+.%DM,ASCNT NAM + TMPLOC DOMBLK+.%DM,{LSE} +TERMIN + +DOMAR DOMADR,[IN-ADDR.ARPA] ;DARPA Internet addresses live here. + ;Maybe someday also: + ; CHAOS-ADDR.MIT.EDU for Chaosnet addresses..... + ; AI.MIT.EDU and/or MIT.EDU for local domains... + + +;;; DOMLSE - Find LSE for a domain name. +;;; A/ ASCNT ptr for a domain name, +;;; +;;; This routine loads L and does not skip! + +DOMLSE: PUSHER P,[B,C,A] + HRLZI C,-DOMLL ;AOBJN ptr to domain/LSE tables. +DOML10: MOVE A,(P) ;Recover ASCNT for domain. + MOVE B,DOMNAM(C) ;Get ASCNT for zone. + CALL USBSEA ;Do they match? + JRST [ AOBJN C,DOML10 ; No, try another. + MOVEI B,DOMAIN ; If none left, assume DOMAIN. + JRST DOML90 ] + MOVE B,DOMBLK(C) ;Aha! Get LSE addr for this domain. +DOML90: MOVE L,$ARLOC(B) ;Load ye olde L-LSE ptr! + POPPER P,[A,C,B] + RET + + + + +;;; DBLUKR - Look up Domain in current LSE. +;;; A/ QName, B/ QClass, C/ QType +;;; +;;; CACHEs the answers it finds, returns A: LP to results +;;; +;;; Skips if found desired resource. +;;; Non-skip means resource not found, or illicit resource found. + +LVAR DBLWCT: 0 ;Keep count of nodes found this pass. +LVAR DBLCKT: -1 ;If nonzero, check RRs for expiration. +LVAR DBLILL: 0 ;If nonzero, some illicit data being returned. + +DBLUKA: SETZM DBLCKT ;Enter here to disregard RR timeouts. +DBLUKR: PUSHER P,[B,C,D,H,E,DBLWCT,DBLCKT,DBLILL] + SETZM DBLWCT ;Zero count of nodes found. + ;; Finda the domain by name in the current database LSE. + SEADOM D,[A,,[$LLLST(L)]] + JRST [ MOVSI T,%ENSFL ; Domain not found. + CALL AUTHP ; NAME ERROR if we're authoritative. + MOVSI T,%ENSJB ; Else just RESOURCE NOT FOUND + SETZ A, + JRST DBLU99 ] ; Lose, lose. + MOVE A,LISTAR(D)+1 ;CDAR points to Class list. + JUMPE A,DBBAD + HRRZ A,LISTAR(A) + SCAAR A,[A$CLAS,,A ? B] + JRST DBBAD + MOVE A,LISTAR(A)+1 ;Get this class sublist. + JUMPE A,DBBAD + MOVE E,A +DBLU50: HRRZ E,LISTAR(E) ;E gets list of A$RRs. + JUMPE E,DBLU90 ;If no more RRs, done. +DBLU60: CAMN C,[DT$ANY] ;If searching for DT$ANY kind of data + JRST [ MOVE B,E ; use any and all RRs. + JRST DBLU85 ] + SCAAR B,[A$RR,,E ? C] ;Else search for one of correct type. + JRST DBLU90 + SKIPN DBLCKT ;If not checking timeouts + JRST DBLU85 ; just go CONS it up. + MOVE H,LISTAR(B)+1 ;Else CDAR to RR values list. + HRRZ H,LISTAR(H) + PUSH P,H ;Check RR to see if this is illicit data. + FINDA H,[A$DIST,,[H]] ;LP to distribution bits. + JRST DBLU65 + MOVE H,LISTAR(B)+1 ;Pick up actual bits. + TRNE H,%AUAUS ;If we claim authority + JRST DBLU65 ; this RR is OK. + TRNE H,%AUILL ;Else if this RR is illicit + SETOM DBLILL ; note that fact. +DBLU65: POP P,H + FINDA H,[A$TTD,,[H]] ;Find RR timeout. + JRST DBLU80 ; If missing, assume it timed out. + MOVE H,LISTAR(H)+1 ;H has TTD. + CAMN H,[-1] ;Check for eternal validity + JRST DBLU85 ; and obey it. + PUSH P,A + CALL DATIME"TIMGET ;Find current time in A. + MOVE U1,A ;Stick it in here. + POP P,A + CAMLE H,U1 ;If have not reached time-to-die + JRST DBLU85 ; assume we have the complete story. +DBLU80: TLO F,%BLDRN ;Else note that expired data encountered. + CAIA ;Do not add this to our answer. +DBLU85: CALL DBLWIN ; OK, add B to list of RRs found. + JRST DBLU50 ;CDR to next RR. + ;; No more RRs, if we found anything, success return. +DBLU90: SKIPN DBLWCT ;If we didn't find anything + JRST [ SETZ A, ; return no results. + JRST DBLU99 ] + SKIPN DBLILL ;Don't skip if returning any illicit data. + AOS -8(P) ; Skip for success! +DBLU99: SETOM DBLCKT + SETZM DBLILL + POPPER P,[DBLILL,DBLCKT,DBLWCT,E,H,D,C,B] + RET + +DBBAD: MOVSI T,%ENADV ;Database structure seems screwed up. + SETZ A, + JRST DBLU99 + + + + +;;; When we locate a resource in the database, we keep track of it. +;;; DBLWIN is called with: +;;; B/ LP to A$RR we found +;;; D/ LP to A$DOM containing B +;;; L/ current LSE, where both A and D (and B) live. +;;; This finds or creates the results list in the CAR of the A$OUTL, +;;; and appends a new node onto it. + +DBLWIN: PUSHER P,[B,C,D,L] + MOVE L,$ARLOC+CACHE ;Switch to cache area. + HRRZ C,B ;RH of pair gets RR. + HRL C,D ;LH of pair gets DOMAIN. + MAKELN B,[A$PAIR,,NIL ? %LTVAL,,[C]] + FINDA C,[A$DB,,[$LLLST(L)]] ;Look for root node. + JSR AUTPSY ; Area not set up for Domains? + MOVE C,LISTAR(C)+1 ;Find results/output list. + JUMPE C,DBLW99 ; Missing? + LDB T,[$LAFLD,,LISTAR(C)] ;Better type check it. + CAIN T,A$OUTL ;If type of LN pointed to is wrong + SKIPN C ; Or if list is missing + JSR AUTPSY ; lose, A$OUTL nonexistant! + SKIPN D,LISTAR(C)+1 ;CAR of A$OUTL has LP to results. + JRST [ MOVEM B,LISTAR(C)+1 ; If results list is NIL + JRST DBLW90 ] ; begin it here in the CAR. + LNAPP [ LISTAR(D) ? B ] ;Else Append new node to CDR. +DBLW90: AOS DBLWCT ;Count a result node added. + MOVE A,LISTAR(C)+1 ;Return LP to results so far. +DBLW99: POPPER P,[L,D,C,B] + RET + + +;;; AUTHP - Authoritatve Predicate +;;; A/ ASCNT Domain name +;;; Skips if we are authoritative for the domain. +;;; Non-skip means someone else is the authority. + +AUTHP: PUSHER P,[A,B,C,L] + MOVE L,$ARLOC+DOMAIN ;SOA recs live in DOMAIN. + FINDA C,[A$DB,,[$LLLST(L)]] + JSR AUTPSY + MOVE C,LISTAR(C)+1 ;CAR here has list of various junk. + FINDA C,[A$SOA,,[C]] ;Find LP to SOA list. + JRST AUTH99 ; Maybe were not an authority. + MOVE C,LISTAR(C)+1 ;Pick up the list of names. +AUTH10: MOVE B,LISTAR(C)+1 ;Get absolute string ASCNT. + ADD B,$LSLOC(L) + HLRZ T,B ;Length of this zone name. + JUMPE T,AUTH80 ;Maybe we are the root authority. + HLRZ T,A ;Else check length of the domain name. + JUMPE T,AUTH99 ;If asking about the root, lose. + CALL AUTHCE ;Ultimate substrings correspond? + JRST AUTH80 ; Yes! + HRRZ C,LISTAR(C) ;Else CDR to next name on list. + JUMPN C,AUTH10 + CAIA +AUTH80: AOS -4(P) ;Here to skip return! +AUTH99: POPPER P,[L,C,B,A] + RET + +;;; AUTHCE - Compares ultimate substrings to see if the +;;; domain in ASCNT A is "underneath" the domain in ASCNT B. +;;; +;;; Skip returns if A is superior to B. +;;; If A is contained in B, does not skip. + +AUTHCE: PUSHER P,[A,B,C,D] + HLRZ C,A ;Get len of Domain1. + HLRZ D,B ;Get len of Domain2. + HRLI A,440700 + PTSKIP C,A ;A is Bp to the end of the Domain1. + HRLI B,440700 + PTSKIP D,B ;B is Bp to the end of the Domain2. +AUTHC1: LDB T,A ;Get Domain1 char. + CAIL T,"a ;Fix case sensitivity, sigh + CAILE T,"z + TRNA + TRZ T,40 + LDB TT,B ;Get Domain2 char. + CAIL TT,"a + CAILE TT,"z + TRNA + TRZ TT,40 + CAME T,TT ;If they don't match + JRST AUTHC8 ; we lost. + SOSG D ;If Domain2 is exhausted + JRST AUTHC9 ; we are done. + SOSE C ;Else if there is more to go + JRST [ DBP7 A ; back up each for another char. + DBP7 B + JRST AUTHC1 ] +AUTHC8: AOS -4(P) ;Lose - Skip return. +AUTHC9: POPPER P,[D,C,B,A] + RET + + + + +SUBTTL Network Server Search + +comment  Notes: + +NTLUKR could be more clever about where to being the search; it could +search the database for authoritative domain servers. It's not clear +is this would be worth it, so for now we just begin our queries with +the toplevel domain server. This will always work. + +The approach used here (NETNS and NTCONS) does not preserve all the +incidental information we find during the search process. +NTASK looks briefly at response packets to see if the search is over. +If we are directed to some other server, NETNS parses the packet to +find a domain server to ask. When we finally get the answers we need, +NTCONS uses RRPAR to extact the data from the answer packet and put it +into the cache. + +I think this is the fastest thing to do, but note that it discards +information about namservers rather than putting that information into +the CACHE (where it might be added to our local database.) Another +way for the system to work would be for NTASK to parse *all* the RRs +into the CACHE as they come in. Then it would search the CACHE for +the answers, and NETNS would search the CACHE for nameserver info. + + + +;;; NTLUKR - Look up Domain in distributed database over network +;;; A/ QName, B/ QClass, C/ QType +;;; +;;; Creates in CACHE a list of results and skip returns. +;;; Returns LP to results in A. +;;; Non-skip means not found, error code in T. + +LVAR SRVLST: 0 ;LP to list of initial servers. + +NTLUKR: PUSHER P,[B,C,D,E,L,PKT,QNAME,QCLASS,QTYPE] + MOVEM A,QNAME ;Query variables into canonical place. + MOVEM B,QCLASS + MOVEM C,QTYPE + SETZM SRVLST + MOVE L,$ARLOC+TMPAR + MOVE A,LITSTR [] ;Root domain's name. + CALL GETNS ;Find authoritative servers for it. + JRST [ MOVSI T,%ENADV ; If none, LOCAL DATABASE PROBLEM. + JRST NTLU99 ] ; Lose. +NTLU10: MOVEM A,SRVLST ;Remember LP to list of servers. + MOVE E,A ;We'll CDR down them until one answers. +NTLU20: MOVE D,LISTAR(E)+1 ;Get network address of a server. + CALL NTASK ;Try querying there. + JUMPN D,NTLU50 +NTLU25: HRRZ E,LISTAR(E) ; try another server. + JUMPN E,NTLU20 ;If no more servers, we lose. + LNDEL SRVLST ; All servers appear to be down. + MOVSI T,%ENRDV ; Say SERVER NOT AVAILABLE + JRST NTLU99 + +NTLU50: ;; Here when we got some kind of answer from a server. + MOVEI PKT,IPKT ;Ptr to response packet. + LNDEL SRVLST ;Don't need these other guys now. + CAMN D,[-1] ;If directed to another authority + JRST [ CALL NETNS ; find the new servers to ask + JRST NTLUZ ; and go ask them. + JRST NTLU10 ] + CAME D,[2] ;Error response? + JRST NTLU70 ; No, go cons data. + LDB T,[IP$IHL (PKT)] ;Else process an error. + ADD PKT,T ;Look in UDP data area. + ADDI PKT,$UDPHL + LDB C,[DP$RCD (PKT)] ;Examine the response code. + CAIE C,1 ;If "Format Error" + CAIN C,4 ; or "Not Implemented" + JRST NTLU25 ; just try another server. + CAIE C,2 ;Likewise for "Server Failure" + CAIN C,5 ; and "Operation Refused" + JRST NTLU25 ; just try another server. + CAIE C,3 ;Must be a "Name Error". + JRST NTLU25 ; If not, the server is fucked up. + LDB C,[DP$AA (PKT)] ;Check the authority bit. + SKIPE C ;If server really knows qname doesn't exist + JRST [ MOVSI T,%ENSFL ; say NAME ERROR. + JRST NTLUZ1 ] + HRRZ E,LISTAR(E) ;Else try another server. + JUMPN E,NTLU20 ;If none are left to try, + LNDEL SRVLST ;say RESOURCE NOT FOUND. + JRST NTLUZ + +NTLU70: ;; We got the data we were looking for. + CALL NTCONS ;Cons RRs from packet into CACHE. + JRST NTLUZ + AOS -9(P) ;Skip return with results in A. +NTLU99: POPPER P,[QTYPE,QCLASS,QNAME,PKT,L,E,D,C,B] + RET + +;;; When we cannot locate a resource give RESOURCE NOT FOUND. + +NTLUZ: MOVSI T,%ENSJB ;RESOURCE NOT FOUND. +NTLUZ1: SETZ A, ;No results. + JRST NTLU99 ;Lossage return. + + +;;; NTASK - Ask one network server about resource in QNAME,QTYPE.QCLASS +;;; D/ Internet address of server +;;; +;;; Returns in D: 0 if server did not respond +;;; -1 if server responded with pointer to domain authority +;;; 1 if server responded with desired domain data +;;; 2 if server responded with an error +;;; +;;; Response from server is in IPKT. +;;; Does not skip. + +UDPTIM==4. ;Seconds allowed for UDP responses. +SRVPRT: DNPORT ;UDP port of Domain server. + +BVAR +SRVHST: 0 ;Server host being used. +QID: 68. ;Query ID. +PKTLEN: 0 ;Packet length in bytes. +EVAR + +NTASK: PUSHER P,[A,B,C,E,PKT] + TRNN F,%DRIMG ;In ASCII mode, mention servers in use. + OUTCAL(,("Asking host "),HND(D),EOL) + MOVEM D,SRVHST ;Remember which host to hack. + SETZM OPKT ;Zap output packet area. + MOVE A,[OPKT,,OPKT+1] + BLT A,OPKT+ + SETZM IPKT ;Zap input packet area. + MOVE A,[OPKT,,IPKT+1] + BLT A,IPKT+ + MOVE B,SRVPRT ;Find Domain server port. + MOVEI A,UDPC ;Channel to use. + CALL UDPOPN ;Set up our UDP queue. + JRST NTALUZ + SETZ C, ;C will count total wds in packet. + MOVEI PKT,OPKT+$UDPD ;Ptr to UDP data. + CALL DOMQRY ;Make up our query. + MOVE A,SRVHST ;Host. + MOVE B,SRVPRT ;Port. + MOVEI PKT,OPKT ;Output area. + CALL MAKPKT ;Ok, packetize... + MOVEM C,PKTLEN ;Send off the query. + MOVEI A,UDPC + MOVEI PKT,OPKT + MOVE B,C +NTAS20: CALL UDPSND ;Send it off. + JRST NTALUZ + MOVEI A,UDPC + MOVEI PKT,IPKT ;Address of packet to receive. + MOVEI B,PG$SIZ ;Max length of packet. + TIMER UDPTIM,NTALUZ ;Don't rexmit, just lose if no response. + SYSCAL IPKIOT,[A ? W ? B ? %CLOUT,,E] + JSR AUTPSY + TIMOFF +NTAS30: MOVEI PKT ;Got it, go peek in UDP data. + LDB T,[IP$IHL (PKT)] + ADD PKT,T + ADDI PKT,$UDPHL + LDB A,[DP$QR (PKT)] ;Query/Response bit. + JUMPE A,NTALUZ ;If not Response, what the fuck! + LDB A,[DP$RCD (PKT)] ;A gets RCODE. + JUMPN A,[ MOVE D,[2] ; Check for error response. + JRST NTAS99 ] + LDB A,[DP$ANC (PKT)] ;No error. Get # Answers. + JUMPN A,[ MOVEI D,1 ; OK, answers are good news. + JRST NTAS99 ] + ;; Hmmm, didn't get an error but didn't get any Answer either. +;MOVE A,QTYPE ;Check to see if this was a Nameserver query. +;CAME A,[DT$NS] ;If it was, don't allow redirection. +; JRST NTAS50 + LDB A,[DP$NSC (PKT)] ;Get # Authority records + JUMPN A,[ MOVE D,[-1] ; Ah, we got something to follow up. + JRST NTAS99 ] +NTAS50: NOP ;Server making no sense ?!? +NTALUZ: SETZ D, ;Complete lossage (connection error.) +NTAS99: POPPER P,[PKT,E,C,B,A] + RET + + + +;;; GETNS - Get NameServer from database +;;; A/ Domain name +;;; +;;; Searches the master database for IN,NS records and returns +;;; in A the LP to a list of Internet host addresses to try. + +GETNS: PUSHER P,[B,C,D,L] ;Save LP context on stack top. + CALL DOMLSE ;L gets appropriate database LSE. + SEADOM B,[A,,[$LLLST(L)]] ;Find Domain. + JRST GETNS9 ; No info for it. + MOVE A,LISTAR(B)+1 ;Get Class list. + JUMPE A,GETNS9 ; Eh? + HRRZ A,LISTAR(A) ;A is list of A$CLASes. + SCAAR A,[A$CLAS,,A ? [DC$IN]] ;Find Internet class data. + JRST GETNS9 ; None? + MOVE C,LISTAR(A)+1 ;Find Resource Records there. + JUMPE C,GETNS9 ; None? + SETZ A, ;A will be LP to data list. +GETNS1: HRRZ C,LISTAR(C) ;CDR to A$RR. + JUMPE C,GETNS8 ;If no more, search is complete. + SCAAR B,[A$RR,,C ? [DT$NS]] ;Search for NameServer type data. + JRST GETNS8 ; No more suitable records. + MOVE B,LISTAR(B)+1 ;Found one - pick up its sublist. + HRRZ B,LISTAR(B) ;CDR down to the actual info LNs. + FINDA D,[A$TTD,,[B]] ;Does data time out? + JRST GETNS3 ; No, just assume it's valid. + MOVE D,LISTAR(D)+1 ;D has TTD. + CAMN D,[-1] ;Check for eternal validity. + JRST GETNS3 + PUSH P,A + CALL DATIME"TIMGET ;Find current time in A. + MOVE U1,A ;Stick it in here. + POP P,A + CAMG D,U1 ;If have reached time-to-die +GETNS3: TLO F,%BLDRN ; this resource record has expired. + FINDA D,[A$RRVAL,,[B]] ;Look for the RDATA. + JRST GETNS1 ; Missing? Ignore this record. + MOVE D,LISTAR(D)+1 ;D has SLP to name of Name Server. + ADD D,$LSLOC(L) ;Make the SLP absolute ASCNT. + SEADOM B,[D,,[$LLLST(L)]] ;Look up *this* domain. + JRST GETNS9 ; No info for it. + MOVE B,LISTAR(B)+1 ;Get Class list. + JUMPE B,GETNS9 ; Eh? + HRRZ B,LISTAR(B) ;A is list of A$CLASes. + SCAAR B,[A$CLAS,,B ? [DC$IN]] ;Find Internet class data. + JRST GETNS9 ; None? + MOVE B,LISTAR(B)+1 ;Find Resource Records there. + JUMPE B,GETNS9 ; None? + PUSH P,C + MOVE C,B +GETNS4: HRRZ C,LISTAR(C) ;CDR to A$RR. + JUMPE C,GETNSL ;If no more, search is complete. + SCAAR B,[A$RR,,C ? [DT$A]] ;Search for Internet Address type data. + JRST GETNSL ; No more suitable records. + MOVE B,LISTAR(B)+1 ;Found one - pick up its sublist. + HRRZ B,LISTAR(B) ;CDR down to the actual info LNs. + FINDA D,[A$TTD,,[B]] ;Does data time out? + JRST GETNS5 ; No, just assume it's valid. + MOVE D,LISTAR(D)+1 ;D has TTD. + CAMN D,[-1] ;Check for eternal validity. + JRST GETNS5 + PUSH P,A + CALL DATIME"TIMGET ;Find current time in A. + MOVE U1,A ;Stick it in here. + POP P,A + CAMG D,U1 ;If have reached time-to-die +GETNS5: TLO F,%BLDRN ; this resource record has expired. + FINDA D,[A$RRVAL,,[B]] ;Look for the RDATA. + JRST GETNS1 ; Missing? Ignore this record. + MOVE D,LISTAR(D)+1 ;D has 36 bit Internet address. + EXCH L,-1(P) ;Get context to CONS data into. + MAKELN B,[A$VAL,,NIL ? %LTVAL,,[D]] + JUMPE A,[ MOVE A,B ; If first time through + JRST GETNS7 ] ; init the list in A. + MOVEM B,LISTAR(A) ;Else append (LP to value into CDR). +GETNS7: EXCH L,-1(P) ;Switch back to database context. + ;; Note that we only use the first host address found for + ;; the Name Server. (Otherwise could have looped GETNS4.) +GETNSL: POP P,C + JRST GETNS1 ;Go try next NS Resource Record. +GETNS8: SKIPE A ;If we accumulated some results + AOS -4(P) ; skip for success. +GETNS9: POPPER P,[L,D,C,B] + RET + + +;;; NETNS - Get NameServer from Authority direction in network response +;;; W/ Ptr to Response packet +;;; +;;; Skip returns A: has LP to a list of Internet host addresses to try. + +NETNS: PUSHER P,[B,C,D,PKT] + SETZ D, ;D holds LP to results. + LDB T,[IP$IHL (PKT)] ;Look in UDP data area. + ADD PKT,T + ADDI PKT,$UDPHL + MOVE A,[DQ$NAM (PKT)] ;Bp to Question section. + LDB B,[DP$QDC (PKT)] ;Skip over the Question section. +NETN10: CALL NAMSKP ;QNAME. + ILDB Z,A ? ILDB Z,A ;QTYPE. + ILDB Z,A ? ILDB Z,A ;QCLASS. + SOJG B,NETN10 + LDB B,[DP$ANC (PKT)] ;Count RRs before Authority section. + LDB C,[DP$NSC (PKT)] ;C has # RRs in the Authority section. + JUMPE C,NETN90 ;If none, lose! + SKIPE B +NETN15: CALL RRSKIP ;Skip over all the Answer RRs. + SOJG B,NETN15 ;When done, A is Bp to first Authority RR. + +NETN20: PUSHER P,[A,C] ;Remember where started and how many. + CALL NAMSKP ;Skip over the name. + LBWIDE B,A ;Check type. + CAME B,[DT$NS] ;Should be Name Server record. + JRST NETN60 + LBWIDE B,A ;Check class. + CAME B,[DC$IN] ;Should be Internet. + JRST NETN60 + ILDB Z,A ? ILDB Z,A ;Skip over the 32-bit TTL (assume valid). + ILDB Z,A ? ILDB Z,A ;Skip over RDATA length + ILDB Z,A ? ILDB Z,A ;Bp in A pts to substring header. + MOVE B,[DT$A] ;Looking for Internet Addresses. + MOVE PKT,-2(P) ;Ptr to packet. + CALL ADSECT ;Find Additional data. + JRST NETN70 ; Oh, shit! Fucking lazy server!!! + MOVE C,A ;C gets list of Bps. + LDB T,[IP$IHL (PKT)] ;Look in UDP data area. + ADD PKT,T + ADDI PKT,$UDPHL +NETN30: MOVE A,LISTAR(C)+1 ;Bp to Resource Record. + CALL NAMSKP ;Skip over the QNAME. + ILDB Z,A ? ILDB Z,A ;Skip over QTYPE + ILDB Z,A ? ILDB Z,A ;Skip over QCLASS. + ILDB Z,A ? ILDB Z,A ;Skip over TTL (assume valid) .SEE NETN70 + ILDB Z,A ? ILDB Z,A + LBWIDE B,A ;Get RDATA length. + CAIE B,4 ;If not 4 bytes + JRST NETN50 ; ignore this malformed IN/A record. + SETZ B, ;Built 36-bit Internet address in B. + ILDB T,A + LSH T,3*8. + IOR B,T ;Network. + ILDB T,A + LSH T,2*8. + IOR B,T ;Host. + ILDB T,A + LSH T,8. + IOR B,T ;Slot. + ILDB T,A + IOR B,T ;IMP. + MAKELN B,[A$VAL,,NIL ? %LTVAL,,[B]] + JUMPE D,[ MOVE D,B ; If first time through + JRST NETN50 ] ; init the list in D. + MOVEM B,LISTAR(D) ;Else append (LP to value into CDR). + ;; Someday maybe add smarts to pick best address for each Server. + ;; Only need one however, so for now, just use the first one. +NETN50: ;; HRRZ C,LISTAR(C) ;CDR to next Additional record. + ;; JUMPN C,NETN20 + LNDEL C ;Flush this list of addrs. +NETN60: POPPER P,[C,A] ;Recover Bp into Authority section. + CALL RRSKIP ;Skip over rest of this RR. + SOJN C,NETN20 ;Loop for all Authority records. +NETN90: SKIPE A,D ;Return LP to results in A. + AOS -4(P) ; Skip if found something. +NETN99: POPPER P,[PKT,D,C,B] + RET + +;;; Here when we have been directed to a different network server, +;;; but have not been given its network address. +;;; +;;; Searches for data in this order: CACHE, DOMAIN, network queries. +;;; If can't find it, we're just shit out of luck, I guess. + +NETN70: JRST NETN60 ;Always just SOL for now. + + +;;; ADSECT - Additional Section processing +;;; W/ ptr to UDP data in packet +;;; A/ Bp to domain name in packet +;;; B/ Type of data desired +;;; +;;; Skip returns A: list of Bps to relavent RRs in packet. +;;; Assumes that all RRs are of the correct CLASS. + +BVAR +ADNAME: 0 +ADTYPE: 0 +EVAR + +ADSECT: PUSHER P,[B,C,D,E,W] ;(Non-reentrant). + MOVEM A,ADNAME + MOVEM B,ADTYPE + LDB T,[IP$IHL (PKT)] ;Look in UDP data area. + ADD PKT,T + ADDI PKT,$UDPHL + SETZ D, ;D will hold LP to results. + MOVE A,[DQ$NAM (PKT)] ;Bp to Question section. + LDB B,[DP$QDC (PKT)] ;Skip over it. +ADSE10: CALL NAMSKP ;QNAME. + ILDB Z,A ? ILDB Z,A ;QTYPE. + ILDB Z,A ? ILDB Z,A ;QCLASS. + SOJG B,ADSE10 + LDB B,[DP$ANC (PKT)] ;Count RRs before Additional section. + LDB T,[DP$NSC (PKT)] + ADD B,T ;B has # RRs to skip over. + SKIPE B +ADSE15: CALL RRSKIP ;Skip over each one. + SOJG B,ADSE15 ;When done, A is Bp to first Additional RR. + LDB C,[DP$ARC (PKT)] ;C has # RRs in the Additional section. + JUMPE C,ADSE70 +ADSE20: MOVE E,A ;Remember where RR we're hacking begins. + MOVE B,ADNAME ;Get the target domain name. + CALL CMPCDN ;See if this RR has the same name. + JRST [ CALL RRSKIP ; No, skip over the rest of it. + JRST ADSE70 ] ; Try next RR. + CALL NAMSKP ;Domain name matches. + LBWIDE B,A ;Now check the QTYPE. + CAME B,ADTYPE ;If this is not the desired type of record + JRST ADSE69 ; skip it. + ;; We found a relavent RR, so CONS up a node with the Bp to it! + MAKELN B,[A$VAL,,NIL ? %LTVAL,,[E]] + JUMPE D,[ MOVE D,B ; If first time through + JRST ADSE69 ] ; init the list in D. + MOVEM B,LISTAR(D) ;Else append (LP to value into CDR). +ADSE69: CALL RRSKI2 +ADSE70: SOJG C,ADSE20 ;Try another Additional RR. + SKIPE A,D ;Return results in A + AOS -5(P) ; Skipping happily if we found anything. +ADSE99: POPPER P,[W,E,D,C,B] + RET + + +;;; RRSKIP - Skip over RR pointed to by Bp in A. + +RRSKIP: CALL NAMSKP ;Skip over the QNAME. +RRSKI1: LBWIDE T,A ;Skip over QTYPE +RRSKI2: LBWIDE T,A ;Skip over QCLASS. + LBWIDE T,A ;Skip over 32 bit TTL. + LBWIDE T,A + LBWIDE T,A ;Get RDATA length. +RRSKI3: ILDB Z,A ;Skip over RDATA. + SOJG T,RRSKI3 + RET + + +;;; CMPCDN - Compare Compressed Domain Names +;;; Compares names in packet W from Bps A and B. +;;; Skips if the names are the same. + +BVAR +CMCMCM: 0 ;Compression source. +CMCML1: 0 ;Length of a current substring. +CMCML2: 0 ;Length of other current substring. +EVAR + +CMPCDN: PUSHER P,[A,B,C,D] + MOVE T,[441000,,(PKT)] ;Compression code uses packet data as string. + MOVEM T,CMCMCM + SETZM CMCML1 ;Init substring lengths. + SETZM CMCML2 +CMPCD1: SKIPLE CMCML1 ;Is substring exhausted? + JRST CMPCD2 ; No, keep hacking it. + ILDB C,A ;Yes - get length of next domain substring. + CAIL C,192. ;If this is a compression pointer + JRST [ ILDB C,A ; Find offset into compression source. + MOVE A,C + ADJBP A,CMCMCM ; Chase ptr to a new name. + JRST CMPCD1 ] ; Continue there (new length coming up). + MOVEM C,CMCML1 ;Nope, remember length. + SKIPE C ;Unless terminator byte +CMPCD2: ILDB C,A ; Get char of domain. + SOS CMCML1 ;Count chair. + +CMPCD3: SKIPLE CMCML2 ;Is substring exhausted? + JRST CMPCD4 ; No, keep hacking it. + ILDB D,B ;Yes - get length of next domain substring. + CAIL D,192. ;If this is a compression pointer + JRST [ ILDB D,B ; Find offset into compression source. + MOVE B,D + ADJBP B,CMCMCM ; Chase ptr to a new name. + JRST CMPCD3 ] ; Continue there (new length coming up). + MOVEM D,CMCML2 ;Nope, remember length. + SKIPE D ;Unless terminator byte +CMPCD4: ILDB D,B ; Get char of domain. + SOS CMCML2 + ;; OK, C and D have real live characters. See if they match. + CAME C,D ;If the chars don't match + JRST CMPCD9 ; failure return. + SKIPE C ;If end of string + CAMN A,B ; or EQ strings + SKIPA ; match! + JRST CMPCD1 ; Else keep trucking. + AOS -4(P) ;Win - skip return. +CMPCD9: POPPER P,[D,C,B,A] + RET + + +SUBTTL Accumulate search results for answer + +;;; RRCONS - Resource Record CONS +;;; L/ LSE to CONS in +;;; A/ LP to list of of Domain,,RR pairs (this LP relative to L!) +;;; E/ LSE where nodes in A live +;;; +;;; This merges the Domains in A (from E) into the LSE in L. +;;; Does not skip. Clobbers no accs. +;;; +;;; !! Note: The list in A is mutated so that the ptr pairs !! +;;; !! are relative to the target LSE (L) !! + +RRCONS: PUSHER P,[A,B,E] + CAMN E,L ;If the from-LSE and the to-LSE are the same + JRST RRCO99 ; nothing to do (maybe caller is confused?) +RRCO10: HLRZ B,LISTAR(A)+1 ;Get LP to Domain. + EXCH L,E ;Okay, switch over to source LSE. + MOVE B,LISTAR(B)+1 ;Also need the Domain's name. + ADD B,$LSLOC(L) ;Make the SLP absolute. + EXCH L,E ;Search the target LSE for the source Domain. + SEADOM B,[B,,[$LLLST(L)]] + CAIA ;If new Domain - go copy entire tree. + CALRET RRCMRG ; Otherwise must do hairy merging. + CALRET RRCADD + ;; Above rtns return here to RRCO90... +RRCO90: HRRZ A,LISTAR(A) ;CDR to next Domain,,RR pair. + JUMPN A,RRCO10 ;If NIL, all done, else CONS another one. +RRCO99: POPPER P,[B,A] + RET + +;;; Here to create a new Domain tree in the L-LSE. +;;; A/ L LP to Domain,,RR ptr-pair (in E-LSE) + +RRCADD: PUSHER P,[B,C,D,H] + HLRZ B,LISTAR(A)+1 ;Get LP to Domain. + LNCOPY D,[E ? B] ;Make copy of entire node in target LSE. + FINDA C,[A$DOM,,[$LLLST(L)]] ;Get Domain list. + JRST [ FINDA C,[A$DB,,[$LLLST(L)]] ; Ours may be the first node. + JSR AUTPSY ; Eh? LSE not set up? + HRRM D,LISTAR(C) + JRST .+1 ] + LNAPP [C ? D] ;Append new Domain onto LSE. + ;; Re-relativize ptr-pairs to LNs in the new LSE. + HRRZ C,LISTAR(A)+1 ;Get LP to RR. + EXCH L,E ;Old ptr-pairs are relative to E-LSE. + SETZ H, ;H counts RR nodes. + MOVE B,LISTAR(B)+1 ;CAR of Domain. + HRRZ B,LISTAR(B) ;CDR to Class. + MOVE B,LISTAR(B)+1 ;CAR of Class. +RRCA10: HRRZ B,LISTAR(B) ;CDR down the RR chain. + CAME A,C ;Is this it? + JRST [ AOS H ; No, keep looking. + JUMPN A,RRCA10 ; If chain exhausted + JSR AUTPSY ] ; RH of our ptr-pair is bogus! + EXCH L,E ;H has relative position of the RR. + HRLM D,LISTAR(A)+1 ;The A$DOM ptr is easy - we just inserted it. + MOVE C,LISTAR(D)+1 ;The A$RR ptr must be searched for, sigh. + HRRZ C,LISTAR(C) ;Cruise down the new domain's sublist. + MOVE C,LISTAR(C)+1 +RRCA20: HRRZ C,LISTAR(C) ;CDR in C gets LP to next A$RR LN. + SOJGE H,RRCA20 ;We know how far along this branch it is. + HRRM C,LISTAR(A)+1 ;Poof! + POPPER P,[H,D,C,B] + JRST RRCO90 + + +;;; Here to merge Domain RRs. +;;; A/ L LP to Domain,,RR ptr-pair (in E-LSE) +;;; B/ extant A$DOM to merge into + +RRCMRG: +IFN 0,[ + PUSHER P,[A,B] + HRRZ A,LISTAR(A)+1 ;Get LP to source RR. + LNCOPY A,[E ? A] ;Copy the RR into our LSE. +;;; *** What are the merge rules when going from DOMAIN->CACHE. +;;; Note that this info will be propogated back to DOMAIN, +;;; replacing the RRs there. +RRCM99: LNDEL A ;Flush the source copy A$RR. + POPPER P,[B,A] + HRLM B,LISTAR(A)+1 ;Poof! Domain is in L. + HRRM H,LISTAR(A)+1 ;So is the RR. +];0 + JRST RRCO90 ;Now go back for another ptr-pair. + + + + + + + +;;; RRPAR creates a block of results: + +RB$NAM==0 ;Bp to name. +RB$LEN==1 ;Length of name. +RB$TYP==2 ;Type. +RB$CLA==3 ;Class. +RB$TTL==4 ;TTL +RB$TIM==5 ;TTD +RB$DAT==6 ;LP to the parsed RDATA. + RBKLEN==7 ; Length of block. + +;;; NTCONS - Cons data from response packet into CACHE. +;;; PKT/ Ptr to response packet +;;; Results checked against QCLASS and QTYPE. +;;; +;;; An A$DOM branch is CONSed for each Answer Section RR in the packet. +;;; Returns A: Results list created in CAR of the A$OUTL. +;;; Skips unless no answers. Error code in T. + +BVAR +ANSBLK: 440700,,ANSNAM + BLOCK RBKLEN-1 +ANSNAM: BLOCK 256. +EVAR + +NTCONS: PUSHER P,[B,L,PKT] + MOVE L,$ARLOC+CACHE ;Will use CACHE area. + LDB T,[IP$IHL (PKT)] ;Look in UDP data area. + ADD PKT,T + ADDI PKT,$UDPHL + MOVE A,[DQ$NAM (PKT)] ;Bp to response. + LDB B,[DP$QDC (PKT)] ;Skip over Question section. +NTCA10: CALL NAMSKP ;QNAME. + ILDB Z,A ? ILDB Z,A ;QTYPE. + ILDB Z,A ? ILDB Z,A ;QCLASS. + SOJG B,NTCA10 + LDB C,[DP$ANC (PKT)] ;Find # RRs in Answer section. + JUMPE C,NTCR99 ;If none, we lost. +NTCA20: PUSH P,C + MOVE PKT,-1(P) ;Ptr to start of packet. + MOVEI B,ANSBLK ;Ptr to results block. + CALL RRPAR ;Parse Answer RR from A. + MOVE B,QCLASS ;Ensure results are of same + CAME B,ANSBLK+RB$CLA ;class and type as query. + JRST NTCA60 + MOVE B,QTYPE + CAMN B,[DT$ANY] + JRST NTCA25 + CAME B,ANSBLK+RB$TYP + JRST NTCA60 +NTCA25: PUSH P,A + MOVEI A,ANSBLK ;Pointer to results block. + CALL RRMAK ;Create complete domain list structure. + ;; Now add the pointers in A to the CACHE's results list. + MAKELN A,[A$PAIR,,NIL ? %LTVAL,,[A]] + FINDA B,[A$DB,,[$LLLST(L)]] ;Find initial database node. + JSR AUTPSY ; Should already be set up. + MOVE B,LISTAR(B)+1 ;CAR should be results/output list. + LDB T,[$LAFLD,,LISTAR(B)] ;Better type check it. + CAIN T,A$OUTL ;If type of LN pointed to is wrong + SKIPN B ; Or if list is missing + JSR AUTPSY ; lose, A$OUTL nonexistant! + SKIPN C,LISTAR(B)+1 ;CAR of A$OUTL has LP to results. + JRST [ MOVEM A,LISTAR(B)+1 ; If results list is NIL + JRST NTCA59 ] ; begin it here in the CAR. + LNAPP [LISTAR(C) ? A ] ;Else Append new node to CDR. +NTCA59: POP P,A +NTCA60: POP P,C + SOJG C,NTCA20 ;Loop for all Answers. + TLO F,%UPDAT + FINDA A,[A$DB,,[$LLLST(L)]] ;When done, return LP to + JSR AUTPSY ;the results we found. + MOVE A,LISTAR(A)+1 ;A gets LP to first result + JUMPE A,NTCR99 + SKIPE A,LISTAR(A)+1 + AOS -3(P) +NTCR99: POPPER P,[PKT,L,B] + RET + + + +;;; RRMAK - Make a Resource Record +;;; A/ Ptr to results block from RRPAR +;;; L/ LSE +;;; PKT/ ptr to response packet +;;; This is used to find the authority info. +;;; Iff LH is -1, RH has the authority bit instead. +;;; +;;; Returns in A: +;;; +;;; This adds an RR to a domain node (creating the domain if needed.) + +RRMAK: PUSHER P,[B,C,D,E] + MOVE B,A ;B gets ptr to results block. + HRRZ C,RB$NAM(B) ;Construct ASCNT to domain name. + HRL C,RB$LEN(B) ;See if domain already exists. + SEADOM A,[C,,[$LLLST(L)]] + JRST [ MAKELN C,[A$VAL,,NIL ? %LTSTR,,[C]] + MAKELN A,[A$DOM,,NIL ? %LTLST,,[C]] + FINDA D,[A$DB,,[$LLLST(L)]] + JSR AUTPSY + LNAPP [ LISTAR(D) ? A ] + JRST RRMA10 ] +RRMA10: HRLZ E,A ;Stash away LP to the domain. + MOVE A,LISTAR(A)+1 ;CDAR points to Class list. + HRRZ T,LISTAR(A) ;D gets LP to A$CLAS. + JUMPE T,RRMA20 ;If no Class list yet, start first one. + SCAAR A,[A$CLAS,,A ? RB$CLA(B)] + CAIA + JRST RRMA30 +RRMA20: MAKELN C,[A$VAL,,NIL ? %LTVAL,,[RB$CLA(B)]] + MAKELN D,[A$CLAS,,NIL ? %LTLST,,[C]] + LNAPP [LISTAR(A) ? D] + MOVE A,D +RRMA30: MOVE A,LISTAR(A)+1 ;Our class branch. + HRRZ D,LISTAR(A) ;D gets list of A$RRs. + SKIPE D ;If there are some RRs here already + MOVE A,D ; we will append onto them. + MAKELN C,[A$VAL,,[RB$DAT(B)] ? %LTVAL,,[RB$TYP(B)]] + MAKELN D,[A$RR,,NIL ? %LTLST,,[C]] + LNAPP [A ? D] ;Attach RR to the list. + HRR E,D ;Stash away LP to it. + HRRZ A,LISTAR(C) ;A gets RDATA LP. + MAKELN C,[A$RC,,NIL ? %LTVAL,,[[0.]]] + PUSHER P,[A,PKT] + HLRZ A,PKT ;Is PKT a ptr? + CAIN A,-1 ; Not if it has -1 in LH. + JRST [ HRRZ A,PKT ; RH has immediate value. + JRST RRMA40 ] ; Go set authority bit. + LDB T,[IP$IHL (PKT)] ;Look in UDP data area. + ADD PKT,T + ADDI PKT,$UDPHL + LDB A,[DP$AA (PKT)] ;See if this is authoritative info. +RRMA40: MAKELN D,[A$DIST,,[C] ? %LTVAL,,[A]] ;%AUATH is bit 1. + POPPER P,[PKT,A] + MAKELN C,[A$TTD,,[D] ? %LTVAL,,[RB$TIM(B)]] + HRRM C,LISTAR(A) ;Tack the other junk onto the RR. +RRMA90: MOVE A,E ;Return . +RRMA99: POPPER P,[E,D,C,B] + RET + +;;; RRPAR - Parse Resource Record into RR variable block +;;; W/ ptr to IP packet +;;; A/ Bp to RR (may be indexed off W relative to UDP data) +;;; B/ ptr to variable block +;;; L/ LSE to create RDATA node in + +RRPAR: PUSHER P,[B,C,PKT] + MOVE Z,[-1] ;Zap results block, starting with RB$LEN. + MOVEM Z,RB$LEN(B) ;Will fill with illegal values. + MOVE T,B + AOS T + MOVE TT,B + HRL T,T + AOS T + ADDI TT,RBKLEN-1 + BLT T,(TT) + LDB T,[IP$IHL (PKT)] ;Look in UDP data area. + ADD PKT,T + ADDI PKT,$UDPHL + PUSH P,B + MOVE B,RB$NAM(B) ;Bp to NAME. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + POP P,B +RRPA10: MOVEM C,RB$LEN(B) ;Stuff length of ASCII domain name. + LBWIDE C,A ;Get TYPE. + MOVEM C,RB$TYP(B) ;Stuff it. + LBWIDE C,A ;Get CLASS. + MOVEM C,RB$CLA(B) ;Stuff it. + SETZ C, ;Compute 32 bit TTL in B. + ILDB T,A + LSH T,<32.-8.> + IOR C,T + ILDB T,A + LSH T,<32.-16.> + IOR C,T + ILDB T,A + LSH T,<32.-24.> + IOR C,T + ILDB T,A + IOR C,T + MOVEM C,RB$TTL(B) ;Stuff TTL into results block. +RRPA30: PUSH P,A ;Don't smash Bp. + PUSH P,B ;Don't smash ptr. + MOVE B,C ;Get TTL. + CALL DATIME"TIMGET ;Find current time in A + CALL DATIME"TIMADD ;Find out when this RR expires. + POP P,B ;Recover ptr to results. + MOVEM A,RB$TIM(B) ;Stuff expiration time into results block. + POP P,A ;Recover Bp. + PUSH P,B ;Don't smash ptr. + MOVE C,RB$TYP(B) ;Get Type we found + MOVE B,RB$CLA(B) ;Get Class we found. + CALL RRPDAT ;CONS in C an RDATA LN of this Class/Type. + POP P,B ;Recover ptr to results. + MOVEM C,RB$DAT(B) ;Stuff LP into results block. +RRPA90: POPPER P,[PKT,C,B] + RET + +;;; RRPAME- Decompress domain name in RR. +;;; A/ Bp to start of name in RR +;;; B/ Bp to ASCII destination string +;;; C/ Bp to compression source string +;;; Updates A and B. Returns length of ASCII NAME in C. + +RRPNAM: PUSHER P,[D,H] + MOVE D,C ;D gets compression Bp. + SETZB C,H ;C couns chars, H preserves source Bp. +RRPN10: ILDB T,A ;Read label length. + JUMPE T,RRPN30 ;If root encountered, all done! + CAIL T,300 ;If this is a compression pointer + JRST [ ILDB T,A ; Find offset into compression source. + SKIPN H ; If this is the first compression ptr + MOVE H,A ; stash the original Bp away now. + MOVE A,T ; Now we can smash A to new Bp. + ADJBP A,D ; Chase ptr to a new name. + JRST RRPN10 ] ; Continue there (new length coming up). + ADD C,T ;Update count of chars in label. +RRPN20: ILDB TT,A ;Get char of domain. + IDPB TT,B ;Stuff as ASCII. + SOJG T,RRPN20 ;Finished with label when count exhausted. + MOVEI T,". ;After each label comes a delimiter. + IDPB T,B ;Stuff it. + AOS C ;Count it. + JRST RRPN10 ;Then loop back for another label. +RRPN30: ;; Root label encountered. + JUMPE C,RRPN35 + MDBP7 B ;Back up over the trailing delimiter. + SOS C ;Corect count. +RRPN35: SETZ T, ;Erase trailing delimiter. + IDPB T,B ;ASCIZ string. + SKIPE H ;If Bp was munged for compression + MOVE A,H ; restore it. + SKIPE C ;If nonzero length domain + AOS -2(P) ; Skip +RRPN99: POPPER P,[H,D] ;Return. + RET + + +;;; NAMSKP - Skip over a domain name. +;;; A/ Bp to domain name. +;;; A is updated, we never skip. + +NAMSKP: ILDB T,A ;Read a length. + CAIL T,192. ;If this is a compression ptr + JRST [ ILDB T,A ; Skip the offset too + RET ] ; and now we're past the name. + JUMPE T,CPOPJ ;If zero, end of domain name. +NAMSK1: ILDB Z,A ;Else gobble characters. + SOJN T,NAMSK1 + JRST NAMSKP ;Loop for all labels in this name. + + +;;; RRPDAT - Create RDATA LN from response packet. +;;; +;;; The routine used to create an RDATA LP depends on the +;;; Class and Type of the data in the packet. +;;; The ANSWER macro is for mapping the kinds of answers +;;; to the routines to handle them. +;;; +;;; Arguments: ANAME, ATYPE, ACLASS, ATTL +;;; A/ Bp to RR data (that is, to the RDATA length word) +;;; PKT/ Ptr to packet UDP data +;;; +;;; A is updated to reflect processing of the RR, but no other ACs are +;;; smashed. The handlers skip unless there was an error. + +;;; Answer handler macrology: + +ANSFOO==32. +ANSKND: BLOCK ANSFOO +ANSRTN: BLOCK ANSFOO + +..ANSR==-1 +DEFINE ANSWER CLASS,TYPE,RTN + ..ANSR==..ANSR+1 + IFL ANSFOO-..ANSR, .FATAL Too many kinds of Answers + TMPLOC ANSKND+..ANSR,{[TYPE,,CLASS]} + TMPLOC ANSRTN+..ANSR,{RTN} +TERMIN + +ANSWER DC$IN,DT$NUL,RNULL +ANSWER DC$IN,DT$A,RINADR +ANSWER DC$IN,DT$CNA,RSTR +ANSWER DC$IN,DT$NS,RSTR +ANSWER DC$IN,DT$PTR,RSTR +ANSWER DC$IN,DT$MR,RSTR +ANSWER DC$IN,DT$MB,RSTR +ANSWER DC$IN,DT$MD,RSTR +ANSWER DC$IN,DT$MF,RSTR +ANSWER DC$IN,DT$MG,RSTR +ANSWER DC$IN,DT$MIN,RMAIL +ANSWER DC$IN,DT$HIN,RHINFO +ANSWER DC$IN,DT$WKS,RWKS +ANSWER DC$IN,DT$SOA,RSOA + +;;; RRPDAT - CONS up one RDATA LN. +;;; A/ Bp to RDATA +;;; B/ Class to interpret as +;;; C/ Type to interpret as +;;; L/ LSE +;;; +;;; Returns an LP in C. + +RRPDAT: PUSHER P,[B,E,H,PKT] + MOVE E,B + MOVE H,C + MOVSI B,-ANSFOO ;AOBJN to answer handlers. +RRPD10: MOVE C,ANSKND(B) ;Get a handler description. + JUMPE C,RRPD60 ;Ignore empty ones. + HLRZ T,(C) ;Type is in LH. + HRRZ TT,(C) ;Class in in RH. + CAME T,H ;Type match? + JRST RRPD60 ; No, wrong handler. + CAMN TT,E ;Class match also? + JRST [ CALL @ANSRTN(B) ; Yes! Hack the rest of this RR. + JRST RRPD90 + JRST RRPD99 ] +RRPD60: AOBJN B,RRPD10 ;No match, keep searching for handler. +RRPD90: SETZ C, ;If unknown kind of RDATA, return NIL. +RRPD99: POPPER P,[PKT,H,E,B] + RET + + +;;; RNULL - Answer Handler for Null data + +RNULL: PUSH P,B + LBWIDE B,A ;Get RDATA length. +RNULL1: ILDB T,A ;Eat all the bytes. + SOJN B,RNULL1 + POP P,B + SETZ C, ;Return NIL. + JRST POPJ1 + + +;;; RINADR - Answer Handler for Internet Address. + +RINADR: PUSH P,B + SETZ C, + LBWIDE B,A ;Get RDATA length. + CAIE B,4 ;If not 4 bytes + JRST RINAD9 ; ignore this malformed IN/A record. + SETZ B, ;Built 36-bit Internet address in B. + ILDB T,A + LSH T,3*8. + IOR B,T ;Network. + ILDB T,A + LSH T,2*8. + IOR B,T ;Host. + ILDB T,A + LSH T,8. + IOR B,T ;Slot. + ILDB T,A + IOR B,T ;IMP. + MAKELN C,[A$RRVAL,,NIL ? %LTVAL,,[B]] + AOS -1(P) +RINAD9: POP P,B + RET + +;;; RSTR - Answer Handler for compressed strings (eg: Nameserver, CNAME) + +RSTR: PUSH P,B + LBWIDE B,A ;Get RDATA length (ignoring it.) + ZAP BUFFER,PG$SIZ ;Clear buffer for string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,[B]] + POP P,B + JRST POPJ1 + +;;; RWKS - Answer Handler for WKS type data. +;;; RRVAL is (List .... ) + +RWKS: PUSHER P,[B,D] + LBWIDE B,A ;B gets RDATA length. + CAIGE B,5 ;If not minumum # of butes here + JRST RWKS99 ; ignore malformed WKS data. + SETZ C, ;Build 36-bit Internet address in C. + ILDB T,A + LSH T,3*8. + IOR C,T ;Network. + ILDB T,A + LSH T,2*8. + IOR C,T ;Host. + ILDB T,A + LSH T,8. + IOR C,T ;Slot. + ILDB T,A + IOR C,T ;IMP. + ILDB D,A ;Next comes the "Protocol" byte. + MAKELN D,[A$VAL,,NIL ? %LTVAL,,[D]] + MAKELN D,[A$VAL,,[D] ? %LTVAL,,[C]] + ;; D now has list whose CDR will contain the port bitmap. + SUBI B,4 + JUMPE B,RWKS80 +RWKS20: SETZ C, ;Pack 32 bits/word into C. + MOVE TT,<32.-8.> ;Do it one octet at a time. +RWKS25: ILDB T,A + LSH T,(TT) + IOR C,T + SOJE B,RWKS80 ;If no more octets, done. + SUBI TT,8. ;Compute shift factor. + JUMPG TT,RWKS25 ;If room left in word, go for another byte. + MAKELN C,[A$VAL,,NIL ? %LTVAL,,[C]] + LNAPP [D ? C] ;Append this word to the bitmap. + JRST RWKS20 ;Prepare for next word. +RWKS80: MAKELN C,[A$RRVAL,,NIL ? %LTLST,,[D]] + AOS -2(P) +RWKS99: POPPER P,[D,B] + RET + +;;; RSOA - Answer Handler for SOA type data. +;;; RRVAL is simply the MNAME for now (since we don't use SOA records). + +RSOA: PUSH P,B + LBWIDE B,A ;Get RDATA length (ignoring it.) + ZAP BUFFER,PG$SIZ ;Clear buffer for MNAME string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,[B]] + ;; Someday we may need to use the rest of this junk in this RR for + ;; something, but for now just skip over it. + CALL NAMSKP ;Skip over RNAME. + LBWIDE B,A ;Skip over 16-bit SERIAL. + LBWIDE B,A ;Skip over 32-bit REFRESH. + LBWIDE B,A + LBWIDE B,A ;Skip over 32-bit RETRY. + LBWIDE B,A + LBWIDE B,A ;Skip over 32-bit EXPIRE. + LBWIDE B,A + LBWIDE B,A ;Skip over 16-bit MINIMUM. +RSOA99: POP P,B ;All done. + JRST POPJ1 + + + +;;; RHINFO - Answer Handler for HINFO type data. +;;; RRVAL is (List ) + +RHINFO: PUSHER P,[B,D] + LBWIDE B,A ;Get RDATA length (ignoring it.) + ZAP BUFFER,PG$SIZ + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + ILDB C,A ;C gets length of CPU string. + CALL STRCOP ;Copy string into buffer. + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MAKELN D,[A$VAL,,NIL ? %LTSTR,,[B]] + ZAP BUFFER,PG$SIZ + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + ILDB C,A ;C gets length of OS string. + CALL STRCOP ;Copy string into buffer. + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MOVE C,D ;C gets LP to CPU. + MAKELN D,[A$VAL,,NIL ? %LTSTR,,[B]] + HRRM D,LISTAR(C) ;Put LP to OS in CDR. + MAKELN C,[A$RRVAL,,NIL ? %LTLST,,[C]] + AOS -2(P) +RHIN99: POPPER P,[D,B] + RET + + + +;;; RMAIL - Answer Handler for MINFO. +;;; RRVAL is (List ) + +RMAIL: PUSHER P,[B,D] + LBWIDE B,A ;Get RDATA length (ignoring it.) + ZAP BUFFER,PG$SIZ ;Clear buffer for RMAILBX string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MAKELN D,[A$VAL,,NIL ? %LTSTR,,[B]] + ZAP BUFFER,PG$SIZ ;Clear buffer for RMAILBX string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MOVE C,D ;C gets LP to RMAILBX. + MAKELN D,[A$VAL,,NIL ? %LTSTR,,[B]] + HRRM D,LISTAR(C) ;Put EMAILBX into CDR. + MAKELN C,[A$RRVAL,,NIL ? %LTLST,,[D]] + AOS -2(P) +RMAI99: POPPER P,[D,B] + RET + + +SUBTTL Host table lookup + +IFN $$HST3,[ + +;;; Before the transition to the distributed database is complete, we can +;;; use a HOSTS3 table containing domain names. This means applications +;;; don't have a host table mapped in consuming their address space, and +;;; we can debug the DQ: interface without having to trust the resolving +;;; mechanism right away. Maybe when resolvers are running we might use +;;; the host table as some kind of a backup, but that's not here yet. + +;;; HSTBLK - Looks up host name and address information in a HOSTS3 file. +;;; A/ ptr to QNAME +;;; B/ QCLASS +;;; C/ QTYPE +;;; +;;; CONSes any data found into current LSE. +;;; Skips if the desired resource was found. +;;; On success, caller may look for results list in CACHE. +;;; Ptr to results is returned in A. + +BVAR +HSTNAM: BLOCK 256. ;QNAME as ASCIZ hostname. + +HOSTS3: 440700,,ANSNAM ;Results block. + BLOCK RBKLEN-1 +HOSNAM: BLOCK 256. +EVAR + +HSTBLK: PUSHER P,[B,C,D,E,QNAME,QCLASS,QTYPE] ;NETWRK rtns clobber E. + MOVEM A,QNAME ;Put args in canonical place. + MOVEM B,QCLASS + MOVEM C,QTYPE + CAIN B,DC$ANY + JRST HSTB07 + CAIE B,DC$IN ;Make sure class is either + CAIN B,DC$CH ;Internet or Chaosnet. + JRST HSTB07 + MOVSI T,%ENAPK ;Else fail for lack of authoritative data. + JRST HSTB99 + +HSTB07: ZAP HSTNAM,256. ;NETWRK likes to see ASCIZ host names, + MOVE B,[440700,,HSTNAM] ;so copy the QNAME into here. + HLRZ C,A + HRLI A,440700 + CALL STRCOP + SETZ Z, ;Tie off ASCIZ. + IDPB Z,B ;Now, see what we're up to. + MOVE C,QTYPE + CAIN C,DT$ANY ;Wildcard? + MOVEI C,DT$A ;Yeah, fake as address lookup + CAIN C,DT$A ;Host name lookup? + JRST HSTB30 ; Yes, go do it. + CAIN C,DT$PTR ;Host address lookup? + JRST HSTB10 ; Yup, go do it. + CAIN C,DT$HIN ;Host information? + JRST HSTB70 ; Yup... + MOVSI T,%ENAPK ;None of above + JRST HSTB99 ;Fail for lack of authoritative data. + +HSTB10: ;; Here for host address => name lookup. + MOVE A,QNAME + MOVE B,LITSTR [IN-ADDR.ARPA] + CALL AUTHCE ;See if IN-ADDR. + JRST [ MOVE A,[440700,,HSTNAM] + CALL HSTBIP ;Convert 10.3.0.44.IN-ADDR to 1200,,600054. + JRST HSTB20 ] + MOVE B,LITSTR [CH-ADDR.MIT.EDU] + CALL AUTHCE ;See if CH-ADDR. + JRST [ MOVE A,[440700,,HSTNAM] + CALL HSTBCH ;Convert 1440.CH-ADDR to 40700,,1440. + JRST HSTB20 ] + CAIA +HSTB20: SKIPN A ;If didn't work + JRST [ MOVSI T,%ENAPK ; must have been wrong domain. + JRST HSTB99 ] + MOVE B,A + CALL NETWRK"HSTSRC ;Look up host by number. + JRST [ MOVSI T,%ENSFL ; Unknown - NAME ERROR. + JRST HSTB99 ] + ;; A now has ASCIZ bp to official host name. + ZAP HOSTS3,RBKLEN ;Will CONS results from this data. + MOVEI B,HOSTS3 ;Ptr to block of results. + MOVE C,QNAME ;RR is for the QNAME given us. + HRRM C,RB$NAM(B) ;Stuff it. + HLRM C,RB$LEN(B) ;Stuff its length too. + MOVE C,QTYPE + MOVEM C,RB$TYP(B) ;Set type from QTYPE. + MOVE C,QCLASS + MOVEM C,RB$CLA(B) ;Set class from QCLASS. + SETZM RB$TTL(B) ;Time to live is zero I guess. + SETZM RB$TIM(B) ;Time to die zero I guess. + CALL ASZLEN ;Convert host name data to ASCNT. + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,[A]] + MOVEM C,RB$DAT(B) ;Stuff LP. + MOVEI A,HOSTS3 + MOVE PKT,[-1,,1] ;Turn on the authority bit. + CALL RRMAK ;Make up the RR. + MAKELN A,[A$PAIR,,NIL ? %LTVAL,,[A]] + FINDA B,[A$DB,,[$LLLST(L)]] ;Find initial database node. + JSR AUTPSY ; Should already be set up. + MOVE B,LISTAR(B)+1 ;CAR should be results/output list. + LDB T,[$LAFLD,,LISTAR(B)] ;Better type check it. + CAIN T,A$OUTL ;If type of LN pointed to is wrong + SKIPN B ; Or if list is missing + JSR AUTPSY ; lose, A$OUTL nonexistant! + SKIPN C,LISTAR(B)+1 ;CAR of A$OUTL has LP to results. + JRST [ MOVEM A,LISTAR(B)+1 ; If results list is NIL + JRST HSTB25 ] ; begin it here in the CAR. + LNAPP [LISTAR(C) ? A ] ;Else Append new node to CDR. +HSTB25: JRST HSTB80 ;That's all there is to it. + + ;; Here for host name => address lookups. +HSTB30: MOVE A,[440700,,HSTNAM] + CALL NETWRK"HSTLOO ;Look up host name. + JRST [ MOVSI T,%ENSFL ; Unknown - NAME ERROR. + JRST HSTB99 ] + MOVE B,A ;Now can look up by host address. + CALL NETWRK"HSTSRC ;Find SITE table entry. + JRST [ MOVSI T,%ENADV ; Table fucked? + JRST HSTB99 ] + HRRZ E,NETWRK"STRADR(D) ;E gets ADDRESS table entry. +HSTB40: MOVE B,HSTTAB+NETWRK"ADDADR(E) ;Get address. + MOVE A,QCLASS + CAIN A,DC$ANY ;If desired class is ANY + JRST HSTB45 ; CONS any addresses. + CAIN A,DC$IN ;If desired class is Internet + JRST [ TLNN B,(NETWRK"NE%UNT) + JRST HSTB45 ; CONS only Internet addresses. + JRST HSTB50 ] ; Ignore others. + CAIE A,DC$CH ;Maybe desired class is CHAOS? + JRST HSTB50 ; No, unknown query class. + NETWRK"GETNET C,B ;Yes - CONS only Chaosnet addresses. + CAME C,[NETWRK"NW%CHS] ;If not Chaosnet + JRST HSTB50 ; unknown data class. +HSTB45: MOVE A,B ;A gets network address value. + ZAP HOSTS3,RBKLEN ;Will CONS results from this data. + MOVEI B,HOSTS3 ;Ptr to block of results. + MOVE C,QNAME ;RR is for the QNAME given us. + HRRM C,RB$NAM(B) ;Stuff it. + HLRM C,RB$LEN(B) ;Stuff its length too. + MOVE C,QTYPE + MOVEM C,RB$TYP(B) ;Set type from QTYPE. + MOVE C,QCLASS + MOVEI C,DC$IN + NETWRK"GETNET T,A + CAMN T,[NETWRK"NW%CHS] + MOVEI C,DC$CH + MOVEM C,RB$CLA(B) ;Set class from network number. + SETZM RB$TTL(B) ;Time to live is zero I guess. + SETZM RB$TIM(B) ;Time to die zero I guess. + MAKELN C,[A$RRVAL,,NIL ? %LTVAL,,[A]] + MOVEM C,RB$DAT(B) ;Stuff LP. + MOVEI A,HOSTS3 + MOVE PKT,[-1,,1] ;Turn on the authority bit. + CALL RRMAK ;Make up the RR. + MAKELN A,[A$PAIR,,NIL ? %LTVAL,,[A]] + FINDA B,[A$DB,,[$LLLST(L)]] ;Find initial database node. + JSR AUTPSY ; Should already be set up. + MOVE B,LISTAR(B)+1 ;CAR should be results/output list. + LDB T,[$LAFLD,,LISTAR(B)] ;Better type check it. + CAIN T,A$OUTL ;If type of LN pointed to is wrong + SKIPN B ; Or if list is missing + JSR AUTPSY ; lose, A$OUTL nonexistant! + SKIPN C,LISTAR(B)+1 ;CAR of A$OUTL has LP to results. + JRST [ MOVEM A,LISTAR(B)+1 ; If results list is NIL + JRST HSTB50 ] ; begin it here in the CAR. + LNAPP [LISTAR(C) ? A ] ;Else Append new node to CDR. + +HSTB50: HRRZ E,HSTTAB+NETWRK"ADRCDR(E) + JUMPN E,HSTB40 ;CDR to next address. + JRST HSTB80 ;No more, onwards + + ;; Here for host name => host info lookups. + ;; This should be class dependent, but since MIT is a rational place + ;; where names are unique, it doesn't matter, so ignore QCLASS.... +HSTB70: MOVE A,[440700,,HSTNAM] + CALL NETWRK"HSTLOO ;Look up host name. + JRST [ MOVSI T,%ENSFL ; Unknown - NAME ERROR. + JRST HSTB99 ] + MOVE B,A ;Now can look up by host address. + CALL NETWRK"HSTSRC ;Find SITE table entry. + JRST [ MOVSI T,%ENADV ; Table fucked? + JRST HSTB99 ] + HRRZ A,NETWRK"STRADR(D) ;Get first network address + MOVE A,HSTTAB+NETWRK"ADDADR(A) + NETWRK"GETNET A ;Get net number + CAME A,[NETWRK"NW%CHS] ;Determine class + SKIPA A,[DC$IN] + MOVEI A, + MOVE B,QCLASS ;Get query class + CAIN B,DC$ANY ;Wild? + MOVEM A,QCLASS ;Yeah, replace it with one we know is valid + MOVE E,NETWRK"STLSYS(D) ;E gets machine and opsys info. + MOVE A,[440700,,HSTTAB] ;Address of table + ADDI A,(E) ;Offset to hardware name + MOVE D,A ;Save byte pointer + CALL ASZLEN ;Count chars + EXCH A,D ;Swap kinds of pointers + ZAP BUFFER,PG$SIZ + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + HLRZ C,D ;Snarf count + CALL STRCOP ;Copy the string + MAKELN D,[A$VAL,,NIL ? %LTSTR,,[D]] + HLRZS E ;Now software name + MOVE A,[440700,,HSTTAB] + ADDB A,E ;Keep copy of byte pointer + CALL ASZLEN ;Count bytes + EXCH A,E ;Swap pointers + ZAP BUFFER,PG$SIZ + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + HLRZ C,E ;C gets length of OS string. + CALL STRCOP ;Copy string into buffer. + MOVE C,D ;C gets LP to CPU. + MAKELN D,[A$VAL,,NIL ? %LTSTR,,[E]] + HRRM D,LISTAR(C) ;Put LP to OS in CDR. + MAKELN E,[A$RRVAL,,NIL ? %LTLST,,[C]] + ZAP HOSTS3,RBKLEN ;Will CONS results from this data. + MOVEI B,HOSTS3 ;Ptr to block of results. + MOVE C,QNAME ;RR is for the QNAME given us. + HRRM C,RB$NAM(B) ;Stuff it. + HLRM C,RB$LEN(B) ;Stuff its length too. + MOVE C,QTYPE + MOVEM C,RB$TYP(B) ;Set type from QTYPE. + MOVE C,QCLASS + MOVEM C,RB$CLA(B) ;Set class from QCLASS. + SETZM RB$TTL(B) ;Time to live is zero I guess. + SETZM RB$TIM(B) ;Time to die zero I guess. + MOVEM E,RB$DAT(B) ;Stuff LP. + MOVEI A,HOSTS3 + MOVE PKT,[-1,,1] ;Turn on the authority bit. + CALL RRMAK ;Make up the RR. + MAKELN A,[A$PAIR,,NIL ? %LTVAL,,[A]] + FINDA B,[A$DB,,[$LLLST(L)]] ;Find initial database node. + JSR AUTPSY ; Should already be set up. + MOVE B,LISTAR(B)+1 ;CAR should be results/output list. + LDB T,[$LAFLD,,LISTAR(B)] ;Better type check it. + CAIN T,A$OUTL ;If type of LN pointed to is wrong + SKIPN B ; Or if list is missing + JSR AUTPSY ; lose, A$OUTL nonexistant! + SKIPN C,LISTAR(B)+1 ;CAR of A$OUTL has LP to results. + JRST [ MOVEM A,LISTAR(B)+1 ; If results list is NIL + JRST HSTB80 ] ; begin it here in the CAR. + LNAPP [LISTAR(C) ? A ] ;Else Append new node to CDR. + +HSTB80: FINDA A,[A$DB,,[$LLLST(L)]] ;Done! + JSR AUTPSY ;Return Lp the results we found. + MOVE A,LISTAR(A)+1 ;A gets LP to first result. + JUMPE A,HSTB99 ;If none, fail. + SKIPE A,LISTAR(A)+1 +HSTB90: AOS -7(P) ;Skip return with LP to results in A! +HSTB99: POPPER P,[QTYPE,QCLASS,QNAME,E,D,C,B] + RET + +;;; HSTBIP, HSTBCH - Convert IN-ADDR or CH-ADDR domain string to number +;;; A/ ASCIZ domain string +;;; Returns with number in A. Returns zero if couldn't parse. + +HSTBCH: PUSHER P,[B,C,D] + SETZ B, + CALL INPNUM ;Read one 16 bit octal number + IOR C,[NETWRK"NW%CHS] ;and then stuff in the constant network #. + MOVE A,C + POPPER P,[D,C,B] + RET + +HSTBIP: PUSHER P,[B,C,D] + SETZ B, ;Read four decimal octets. + CALL INPNUM + DPB D,[001000,,B] + CALL INPNUM + DPB D,[101000,,B] + CALL INPNUM + DPB D,[201000,,B] + CALL INPNUM + DPB D,[301000,,B] + MOVE A,B ;Recover accumulated number. + POPPER P,[D,C,B] ;Return it. + RET + +INPNUM: SETZB C,D ;Accumulate octal number in C, decimal in D. +INPNU1: ILDB T,A ;Get character. + JUMPE T,CPOPJ ;If end of string, punt. + CAIL T,"0 ;If not a digit, punt. + CAILE T,"9 + RET + IMULI C,10 ;Scale octal. + IMULI D,10. ;Scale decmal. + ADDI C,-"0(T) ;Add up octal. + ADDI D,-"0(T) ;Add up decimal. + JRST INPNU1 ;Go back for more. + + +];$$HST3 + +SUBTTL Output some Resource Records + +;;; MAKOUT - Make up resource information for user. +;;; L/ LSE containing A$OUTL +;;; +;;; Puts an ASCII or Image representation of the specified +;;; output records into the RRECS area. Filters the data +;;; according to open mode bits such as %DRAUT. +;;; Does not skip. +;;; +;;; As a side effect, MAKOUT updates the RR reference counts. +;;; +;;; * Note that we can only return information which is the +;;; * same class as the QCLASS. We do not enforce this restriction, +;;; * so the search routines had better have done the right thing! +;;; * (This is in accordance with RFC883, I believe.) + +MAKOUT: PUSHER P,[A,B] + FINDA A,[A$DB,,[$LLLST(L)]] + JSR AUTPSY + MOVE A,LISTAR(A)+1 + SKIPN LISTAR(A) ;If cant find output list + JRST MAKOU9 ; nothing to do. + LDB T,[$LAFLD,,LISTAR(A)] + CAIE T,A$OUTL + JSR AUTPSY + TRNN F,%DRIMG + OUTCAL(,CRLF,TAB,TAB,("ANSWER"),EOL) + FINDA B,[A$ANS,,[LISTAR(A)]] + CAIA + CALL MAKSEC + TRNN F,%DRIMG + OUTCAL(,CRLF,TAB,TAB,("AUTHORITY"),EOL) + FINDA B,[A$AUT,,[LISTAR(A)]] + CAIA + CALL MAKSEC + TRNN F,%DRIMG + OUTCAL(,CRLF,TAB,TAB,("ADDITIONAL"),EOL) + FINDA B,[A$ADD,,[LISTAR(A)]] + CAIA + CALL MAKSEC + TRNN F,%DRIMG + OUTCAL(,CRLF) +MAKOU9: POPPER P,[A,B] + RET + +;;; MAKSEC - Make output section +;;; B/ LP to list of pairs +;;; QCLASS/ Class of data +;;; L/ LSE +;;; This routine is the workhorse for MAKOUT. + +MAKSEC: PUSHER P,[A,B,C,D] + MOVE B,LISTAR(B)+1 ;LP to output-data pair. + TRNE F,%DRSII+%DRLNG ;Hairy modes let our user check the + JRST MAKS10 ; authority of the data instead. + HRRZ D,LISTAR(B)+1 ;Get LP to Resource Record. + MOVE D,LISTAR(D)+1 ;Pick up this RR's sublist. + MOVE A,LISTAR(D)+1 ;This A$VAL has the Type code. + HRRZ D,LISTAR(D) ;CDR to the actual info LNs. + FINDA D,[A$DIST,,[D]] ;Find LP with distribution bits. + JRST [ TRNE F,%DRANY + JRST MAKS10 + JRST MAKS80 ] + MOVE D,LISTAR(D)+1 ;Filter our output on bits in D. + TRNE F,%DRANY ;Illicit data Ok? + JRST [ TRNE F,%DRAUT ; Yes. Check for authority. + TRNE D,%AUAUS+%AUATH + JRST MAKS10 ; OK, output this data. + JRST MAKS80 ] + TRNN F,%DRAUT ;Real authority required? + JRST [ TRNE D,%AUILL ; No, but illicit data not allowed. + JRST MAKS80 + JRST MAKS10 ] + TRNE D,%AUAUS+%AUATH ;If data is authoritative + TRNE D,%AUILL ;and not illicit, output it. + JRST MAKS80 ; Else quality not good enough. +MAKS10: HLRZ D,LISTAR(B)+1 ;LP to Domain. + MOVE D,LISTAR(D)+1 ;Get the Domain. + MOVE D,LISTAR(D)+1 ;Get SLP from VAL hanging off there. + ADD D,$LSLOC(L) ;Make absolute. + TRNN F,%DRIMG + JRST [ OUT(,("Domain: "),TC(D),TAB) + OUT(,LBRC,D(QCLASS),(",")) + JRST MAKS15 ] +MAKS15: HRRZ D,LISTAR(B)+1 ;Get LP to Resource Record. + MOVE D,LISTAR(D)+1 ;Pick up this RR's sublist. + MOVE A,LISTAR(D)+1 ;This A$VAL has the Type code. + TRNN F,%DRIMG + JRST [ OUT(,D(A),RBRC,EOL) + JRST MAKS20 ] +MAKS20: HRRZ D,LISTAR(D) ;CDR to the actual info LNs. + FINDA C,[A$DIST,,[D]] + JRST MAKS30 + TRNN F,%DRIMG + JRST [ OUT(,("Dist: "),H(LISTAR(C)+1),TAB) + JRST MAKS30 ] +MAKS30: FINDA C,[A$RC,,[D]] + JRST MAKS40 + AOS LISTAR(C)+1 ;Update RR reference count. + TRNN F,%DRIMG + JRST [ OUT(,("Refcnt: "),D(LISTAR(C)+1),TAB) + JRST MAKS40 ] +MAKS40: FINDA C,[A$TTD,,[D]] + JRST MAKS50 + TRNN F,%DRIMG + JRST [ OUT(,("Expires: "),TIM(MDYT,LISTAR(C)+1),EOL) + JRST MAKS50 ] +MAKS50: FINDA C,[A$RRVAL,,[D]] + CAIA + JRST MAKS70 + TRNN F,%DRIMG + JRST [ OUT(,("No data found for this Resource Record!"),EOL) + JRST MAKS75 ] +MAKS70: CALL MAKROT ;Output the RR value. +MAKS75: TRNN F,%DRIMG + OUTCAL(,CRLF) +MAKS80: HRRZ B,LISTAR(B) ;CDR to next Resource Record pair. + JUMPN B,MAKS10 +MAKS99: POPPER P,[D,C,B,A] + RET + +;;; MAKROT - Output the value of a Resource Record. +;;; A/ Type +;;; QCLASS/ Class +;;; C/ LP to actual value (an A$RRVAL LN) + +MAKROT: PUSHER P,[A,B,C,D] + MOVE B,A ;B gets Type. + MOVE A,QCLASS ;A gets Class. + MOVSI T,-MAXKND +MAKR40: SKIPN ORRK(T) ;Class/Type codes are nonzero. + JRST MAKR50 ; If no entry here, try next one. + HLRZ D,ORRK(T) ;Class of this entry. + CAMN A,(D) ;Match? + JRST MAKR80 +MAKR50: AOBJN T,MAKR40 + TRNN F,%DRIMG + JRST [ OUT(,("How do I output this kind of record?"),EOL) + JRST MAKR99 ] + JRST MAKR99 +MAKR80: HRRZ D,ORRK(T) ;Class matches. + CAME B,(D) ;Does Type match? + JRST MAKR50 ; Nope. + MOVE D,ORRI(T) ;Yes - get Image mode output instruction. + TRNN F,%DRIMG ;But if in ASCII mode + MOVE D,ORRA(T) ; use different routine. + JUMPE D,MAKR99 ;If no routine, can't output. + XCT D ;Execute output routine! +MAKR99: POPPER P,[D,C,B,A] ;All done. + RET + + +;;; These macros define the Resource Record data output routines. +;;; OUTRRA defines an ASCII output routine for a certain class/type combo. +;;; OUTRRI defines the Image output routine for the most recent OUTRRA. +;;; !!! Call OUTRRA first, then immediately call OUTRRI !!! +;;; +;;; RTN is an instruction to execute to output the RRVAL in LP C. +;;; The instruction may not smash accs and shouldn't skip. +;;; Routines expect class in A and type in B. + +ORRK: BLOCK MAXKND +ORRA: BLOCK MAXKND +ORRI: BLOCK MAXKND + +.%OTRR==-1 +DEFINE OUTRRA CLASS,TYPE,?RTN + .%OTRR==.%OTRR+1 + TMPLOC ORRK+.%OTRR,{[CLASS],,[TYPE]} + TMPLOC ORRA+.%OTRR,RTN +TERMIN + +DEFINE OUTRRI ?RTN + TMPLOC ORRI+.%OTRR,RTN +TERMIN + + +OUTRRA DC$IN,DT$NUL,OUTCAL(,("DARPA Internet NULL RR."),EOL) + +OUTRRA DC$IN,DT$A,OUTCAL(,("DARPA Internet Host Address: "),HND(LISTAR(C)+1),EOL) +OUTRRI OUTCAL(,W(LISTAR(C)+1)) + +OUTRRA DC$IN,DT$NS,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$PTR,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$CNA,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$MR,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$MB,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$MD,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$MG,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$MF,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$IN,DT$HIN,CALL [ PUSHER P,[A,B] + OUT(,("DARPA Internet Host information"),EOL) + MOVE B,LISTAR(C)+1 ;CAR has a string. + MOVE A,LISTAR(B)+1 + ADD A,$LSLOC(L) ;Make absolute. + OUT(,("CPU: "),TC(A),TAB) + HRRZ A,LISTAR(B) ;CDR to next string. + MOVE A,LISTAR(A)+1 + ADD A,$LSLOC(L) + OUT(,("OS: "),TC(A),EOL) + POPPER P,[B,A] + RET ] +OUTRRI CALL RRBAS2 + +OUTRRA DC$IN,DT$SOA,CALL [ PUSHER P,[A] + OUT(,("DARPA Internet Start of authority zone"),EOL) + MOVE A,LISTAR(C)+1 ;CAR has a string. + ADD A,$LSLOC(L) ;Make absolute. + OUT(,("MNAME: "),TC(A),EOL) + POPPER P,[A] + RET ] + +;;; Resources not yet implemented but may occur in database: + +OUTRRA DC$IN,DT$MIN,OUTCAL(,("Ignoring DARPA Internet MINFO record."),EOL) +OUTRRA DC$IN,DT$WKS,OUTCAL(,("Ignoring DARPA Internet WKS record."),EOL) + + +;;; RRASCI - Output a resource record whose value is a string. + +RRASCI: PUSHER P,[A,B] + ;; Find name of this class. + MOVE T,[-MAXCLS,,CLSTAB] +RRASC1: CAME A,(T) + JRST [ AOBJN T,RRASC1 + OUT(,("Class "),D(A)) + SETZ A, + JRST RRASC3 ] + SUBI T,CLSTAB + HLRZ A,CLSNAM(T) + OUT(,TZ(@A)) + ;; Find name of this type. +RRASC3: MOVE T,[-MAXTYP,,TYPTAB] +RRASC2: CAME B,(T) + JRST [ AOBJN T,RRASC2 + OUT(,(" Type "),D(B),(": ")) + SETZ B, + JRST RRASC5 ] + SUBI T,TYPTAB + HLRZ B,TYPNAM(T) + OUT(,(" "),TZ(@B),(": ")) + ;; Now find string value to print. +RRASC5: MOVE A,LISTAR(C)+1 ;Get SLP. + ADD A,$LSLOC(L) ;Make absolute. + OUT(,TC(A),EOL) ;Output it. + POPPER P,[B,A] + RET + + +OUTRRA DC$CH,DT$NUL,OUTCAL(,("CHAOSnet NULL RR."),EOL) + +OUTRRA DC$CH,DT$A,OUTCAL(,("CHAOSnet Host Address: "),RH(LISTAR(C)+1),EOL) +OUTRRI OUTCAL(,W(LISTAR(C)+1)) + +OUTRRA DC$CH,DT$PTR,CALL RRASCI +OUTRRI CALL RRBASC + +OUTRRA DC$CH,DT$HIN,OUTCAL(,("CHAOSnet HINFO RR."),EOL) +OUTRRI CALL RRBAS2 + +;; Output string values for image mode. +;; +;; Format is 36 bit byte count followed by that many bytes of text. +;; Ie, you can .IOT the count then use that to SIOT the rest of the +;; string. ASCIZ strings turn out to be a real pain and not that useful. + +;; Single string. +RRBASC: PUSHER P,[A,B,C] + MOVE A,LISTAR(C)+1 ;Get SLP. + ADD A,$LSLOC(L) ;Make absolute. + OUT(,WLH(A),WBA(A)) ;Count, then string + POPPER P,[C,B,A] + RET + +;; Same thing, but for double valued items (HINFO, MINFO, etc) +RRBAS2: PUSHER P,[A,B,C] + MOVE B,LISTAR(C)+1 ;CAR has a string. + MOVE A,LISTAR(B)+1 + ADD A,$LSLOC(L) ;Make absolute. + HRRZ B,LISTAR(B) ;CDR to next string. + MOVE B,LISTAR(B)+1 + ADD B,$LSLOC(L) + OUT(,WLH(A),WBA(A),WLH(B),WBA(B)) + POPPER P,[C,B,A] + RET + + +SUBTTL CLOSE operation (Database Updating) + +comment  *** Thoughts on caching and updating: + +The current implementation of our resolver mostly captures data which +was explicitly asked for, and not incidental information. This means +(for example) that host addresses and names will be captured, but the +nameserver forwarding information used to find them will not usually +be. It probably should be! Also, there is the problem of incomplete +information. This can be solved by implementing the %DRWOV option. + + + +CLOSE: .SUSET [.SMSK2,,[0]] ;Disable further BOJ interrupts. + .CLOSE BOJ, ;Close the BOJ channel. + TLNE F,%BLDRN\%UPDAT ;If any updating needed + CALL UPDATE ; do it. + CALL UNLOCK ;Unlock any locks we have. + JSR DIE ;I guess this is all we do for now. + +;;; UPDATE - Updates DOMAIN from CACHE. +;;; Merges entire contents of CACHE into DOMAIN. +;;; Writes out new database. +;;; Does not skip. + +UPDATE: SKIPE MAINT ;If in maint mode + JRST UPDA99 ; better not risk munging the database. + CALL WRLOCK ;Ask for the only write-lock. + CAIA ;If got it, proceed with database updates. + JRST UPDA50 + MOVE A,4. ;Else try for up to four minutes. + CALL UNLOCK ;Release our locks and let other guy win. +UPDA20: MOVEI T,30.*60. + .SLEEP T, ;Let's take a stress pill and lie down. + CALL RDLOCK ;Now get a new read lock. + JRST UPDA20 ; Go back to sleep if still being written. + SOJG A,UPDATE ;OK, ask for the write lock again. + JRST UPDA99 ;After a while, just punt. + ;; OK, we now have the write lock on the database. +UPDA50: CALL DBGET ;Read in the latest database. + JSR AUTPSY + TLNE F,%UPDAT ;If goodies are cached + CALL ENCACH ; merge records into the database. + TLNE F,%BLDRN ;If expired RRs were used + CALL REFRES ; Refresh all expired database records. + CALL DBPUT +UPDA99: RET + + + +;;; ENCACH - Merge records in CACHE into DOMAIN. +;;; +;;; Our database never contains duplicate resource records. +;;; We assume that cached data is complete; either none or all of +;;; the resource records for a given {D,C,T} are present in the cache. +;;; +;;; Updating the database deletes any records which are similar to +;;; the records in the cache. However, we only merge authoritative records +;;; into our database. All the authoritative servers had better +;;; always respond completely to our queries! + +ENCACH: MOVE L,$ARLOC+CACHE + FINDA A,[A$DOM,,[$LLLST(L)]] + JRST UPDA99 +ENCA10: MOVE C,LISTAR(A)+1 ;CAR has name VAL. + HRRZ C,LISTAR(C) ;CDR to Class list. + MOVE C,LISTAR(C)+1 ;CAR has class. + HRRZ C,LISTAR(C) ;CDR to RR list. + MOVE C,LISTAR(C)+1 ;CAR has type. + HRRZ C,LISTAR(C) ;LP to values list. + FINDA C,[A$DIST,,[C]] ;Find RR status bits. + JRST ENCA70 ; If missing, assume not authoritative. + MOVE C,LISTAR(C)+1 + TRNN C,%AUATH ;Authoritative resource record? + JRST ENCA70 ; No, don't merge this into our database. + MOVE C,LISTAR(A)+1 ;CAR of domain has its name. + MOVE C,LISTAR(C)+1 ;Get SLP to it. + ADD C,$LSLOC(L) ;Absolutely. + PUSHER P,[A,L] + MOVE A,C + CALL DOMLSE ;L gets appropriate database LSE. + MOVE E,L + POPPER P,[L,A] + EXCH L,E ;Switch to DOMAIN context. + SEADOM B,[C,,[$LLLST(L)]] + CAIA + JRST [ CALL UPDMRG ;Aha! Merge the domains in E(A) and L(B). + JRST ENCA70 ] + ;; No match. Append this entire domain branch to the database. + FINDA B,[A$DOM,,[$LLLST(L)]] + JRST [ FINDA B,[A$DB,,[$LLLST(L)]] + JSR AUTPSY + JRST ENCA50 ] +ENCA50: LNCOPY C,[E ? A] ;Copy domain from CACHE into DOMAIN. + LNAPP [B ? C] ;Append domain to the database. +ENCA70: EXCH L,E ;Switch context back to CACHE. + HRRZ A,LISTAR(A) ;CDR to next domain there. + JUMPN A,ENCA10 +ENCA99: RET + +;;; UPDMRG - Merge domain A in cache with domain B in database. +;;; (Current LSE L is DOMAIN; CACHE is in E.) + +UPDMRG: PUSHER P,[A,B,C,D,E,L] + EXCH L,E ;CACHE context. + MOVE A,LISTAR(A)+1 ;Walk down source domain. + MOVE A,LISTAR(A) ;A gets LP to source Class list. +UPDM10: PUSH P,B ;Stash LP to the target domain. + MOVE D,LISTAR(A)+1 ;Check out this source Class. + MOVE D,LISTAR(D)+1 ;D gets the class #. + EXCH L,E ;DOMAIN context. + MOVE B,LISTAR(B)+1 ;Walk down target domain. + MOVE B,LISTAR(B) ;B gets LP to target Class list. +UPDM20: MOVE C,LISTAR(B)+1 ;Check out this target Class. + CAMN D,LISTAR(C)+1 ;Match? + JRST [ CALL UPDRRG ; Yes - merge the RRs. + JRST UPDM60 ] ; Then go hack another source class. + HRRZ T,LISTAR(B) ;No match, CDR to next target class. + SKIPE T ;If not null + JRST [ MOVE B,T ; loop with it.. + JRST UPDM20 ] + ;; Else this is a new class. Append it to the list in B. + LNCOPY C,[E ? A] ;Copy class from CACHE into DOMAIN. + LNAPP [B ? C] ;Append it to the existing list of classes. +UPDM60: EXCH L,E ;CACHE context. + POP P,B ;Recover LP to target domain. + HRRZ A,LISTAR(A) ;CDR to next source Class node. + JUMPN A,UPDM10 ;Loop for all source data. + POPPER P,[L,E,D,C,B,A] ;Restore context and ACs. + RET + +;;; UPDRRG - Merge resource records in one Class. +;;; A/ LP to source Class list. +;;; C/ LP to matching target Class A$VAL +;;; (Current LSE L is DOMAIN; CACHE is in E.) + +UPDRRG: ;; First, delete from the database any RRs which + ;; are similar to the new RRs in the cache. + CALL UPRDEL + ;; Next, add all types of cached RRs for this {D,C} to the database. + PUSH P,A ;Don't smash ACs. + EXCH L,E ;CACHE context. + MOVE A,LISTAR(A)+1 ;Get LP to all the RRs in this Class. + MOVE A,LISTAR(A) + EXCH L,E ;DOMAIN context. + LNCOPY A,[E ? SETZ A] ;Copy all RRs into DOMAIN. + LNAPP [ LISTAR(C) ? A] ;Append them to the existing RRs. + POP P,A + RET + +UPRDEL: PUSHER P,[A,B,C,D,H] + EXCH L,E ;CACHE context. + MOVE A,LISTAR(A)+1 ;Get source class list. + MOVE A,LISTAR(A) ;A gets A$RR list there. +UPRD10: MOVE H,LISTAR(A)+1 ;H gets source RR type. + MOVE H,LISTAR(H)+1 + EXCH L,E ;DOMAIN context. +UPRD20: HRRZ D,LISTAR(C) ;C has current RR node. + JUMPE D,UPRD30 +UPRD21: MOVE T,LISTAR(D)+1 ;Get LP to type. + CAME H,LISTAR(T)+1 ;Type match? + JRST [ MOVE C,D ; No, try another RR. + JRST UPRD20 ] + MOVE B,D + HRRZ D,LISTAR(D) ;Get new CDR. + HRRM D,LISTAR(C) ;Splice out node. + LNDEL B ;Flush the node. + SKIPE D + JRST UPRD21 +UPRD30: EXCH L,E ;CACHE context. + HRRZ A,LISTAR(A) ;CDR to next A$RR. + JUMPN A,UPRD10 + EXCH L,E ;Don't smash LSE ptrs. + POPPER P,[H,D,C,B,A] + RET + + + +;;; REFRES - Refresh any expired records in DOMAIN. + +REFRES: RET + + +SUBTTL SREAPB operation + +;;; SREAPB - This doesn't do anything, but I figured I'd provide +;;; for one random system call for device debugging purposes. +;;; The channel number is in ARGS+3 and the reap bit in ARGS+4. + +SREAPB: PUSHER P,[A] + MOVE A,ARGS+2 ;Find number of arguments. + CAIE A,2 ;Unless there are two args + JRST [ MOVSI T,%ETFRG ; give "too few args" error. + JRST CALERR ] + SYSCAL JOBRET,[%CLERR,,ERRCOD ? %CLIMM,,BOJ ? %CLIMM,,1 ] + NOP + POPPER P,[A] + BOJFIN + + + +SUBTTL Database Searching UUOs + +; SEADOM AC,[[SPT],,[[list-ptr]]] +; Searches list pointed to by list-ptr for the specified Domain. +; Skips if found with LP to an A$DOM in AC. +; (Non-skip means search failed; AC is NIL.) + +UUODEF SEADOM:,SEAD00 +SEAD00: MOVE U3,@U40 ;Get c(E) = [SPT],,[loc] + HRRZ U1,@(U3) ;U1 gets ptr to first node. +IFSVU2, PUSH P,U2 +SEAD10: SKIPN U1 ;UUO fails if ptr is zero. + JRST [ LDB U2,UACFLD ; Return NIL. + MOVE U1,@NIL + MOVEM U1,(U2) + IFSVU2, POP P,U2 + UUOXRT ] + LDB U2,[$LAFLD,,LISTAR(U1)] ;Get attribute of this LN. + CAIE U2,A$DOM ;Domain node? + JRST SEAD20 ; No, keep looking. + MOVE U2,LISTAR(U1)+1 ;U2 gets LP to CAR. + MOVE U3,LISTAR(U2) + LDB U4,[$LAFLD,,U3] ;Check CAR's attribute. + CAIE U4,A$VAL ;Should be an A$VAL. + JRST SEAD20 + TLNN U3,%LTSTR ;Should hold a string. + JRST SEAD20 +SEAD12: MOVE U4,LISTAR(U2)+1 ;# chars in this string. + HLRZ U4,U4 + MOVE U3,@U40 ;Pick up UUO arg. + HLRZ U3,U3 ;U3 gets target SPT. + HLRZ Z,(U3) ;Get length of target string. + CAMN Z,U4 ;If lengths match + JRST SEAD25 ; go see if contents match too! +SEAD20: HRRZ U1,LISTAR(U1) ;Else get CDR to next Domain and try again. + JRST SEAD10 +SEAD25: MOVE U2,LISTAR(U2)+1 ;SPT to possible match. + ADD U2,$LSLOC(L) ;Make absolute. + MOVE U4,(U3) ;SPT to target string. +SEAD30: JUMPL U4,SEAD70 ;See if any left to test. + TLNN U4,-1 ;If string exhausted + JRST SEAD70 ; we have found the target! + MOVE Z,(U2) ;Get a word to test. + CAME Z,(U4) ;Match against target string. + JRST SEAD20 ; Failure to match, go try another Domain. + ADD U4,[-5,,1] ;Matches so far: decr char cnt, incr index. + AOJA U2,SEAD30 ;Continue with next word in string. +SEAD70: LDB U2,UACFLD ;Found it - get result acc. + MOVEM U1,(U2) ;Store ptr to the A$DOM LN. +IFSVU2, POP P,U2 + AOS UUORPC ;Skip on return + UUOXRT + + + +SUBTTL Network Search Routines + +;;; DOMQRY - Build UDP query about a host name. +;;; QNAME, QCLASS, QTYPE have the query variables +;;; W/ ptr to packet UDP data +;;; Updates the datagram byte count in C. + +DOMQRY: PUSHER P,[A,B,D,PKT] + ;; Build the Header Section. + IDGEN A,QID + PKTDPB DP$ID,A + PKTDPB DP$OP,[DO$QRY] ;Standard QUERY operation. + PKTDPB DP$QR,[0] ;This is a request. + PKTDPB DP$RC,[0] ;No Recursion. + PKTDPB DP$QDC,[1] ;We have one question. +DOMQ19: ADDI C,3*4 ;Count the Header Section. + ;; Now build the Question Section. +DOMQ20: MOVE B,[DQ$NAM (PKT)] ;Bp to QNAME. + HRRZ A,QNAME ;Addr of ASCIZ qname from ASCNT. + HRLI A,440700 ;Make into Bp. +DOMQ22: CALL CMPRES ;Find a domain name token. + JUMPE D,DOMQ27 ; Maybe no more. + IDPB D,B ;Store the count. + AOS C ;Count length in QNAME. +DOMQ24: ILDB T,A ;Get char from name. + IDPB T,B ;Stuff it. + AOS C ;Count char in QNAME. + SOJG D,DOMQ24 + ILDB T,A ;Gobble period seperator. + JRST DOMQ22 ;Get next token. +DOMQ27: IDPB D,B ;Terminate with the zero token +DOMQ29: AOS C ;Count terminator. +DOMQ30: DPWIDE B,QTYPE ;Specify type of data we want. + DPWIDE B,QCLASS ;Specify class of data we want. +DOMQ39: ADDI C,4 ;Count the QTYPE and QCLASS fields. +DOMQ90: POPPER P,[PKT,D,B,A] + RET + + +;;; CMPRES - Compress a domain name. +;;; A/ Bp to ASCIZ string +;;; +;;; What this routine really does is find periods in the +;;; domain name you give it as an argument. We currently +;;; do not bother to send out compressed names. +;;; +;;; Returns in D the number of characters from +;;; the string until and including the period. +;;; A is NOT updated. + +CMPRES: PUSH P,A + SETZ D, +CMPRE1: ILDB T,A + JUMPE T,CMPRE9 + CAIN T,". + JRST CMPRE9 + AOJA D,CMPRE1 +CMPRE9: POP P,A + RET + + + +SUBTTL Database Primitives + +NIL: [0] + +; SCAAR AC,[,,[list-ptr] ? [val]] +; One-deep search of the the list pointed to by list-ptr. +; (Ie., Looks at the CAAR of each node on list-ptr.) +; Skip returns with the LP to the node whose CAAR matched first. +; Else doesn't skip and AC is NIL. + +UUODEF SCAAR,SEAC00 +SEAC00: MOVE U3,@U40 ;Get c(e)= $attr,,[loc]. + HRRZ U1,(U3) ;Get c(Loc) = LP to first node. + HLRZS U3 ;Get attrib type into RH. + MOVE U4,U40 ;Now pick up argument. + MOVE U4,@1(U4) +IFSVU2, PUSH P,U2 + JUMPE U1,SEAC90 +SEAC10: LDB U2,[$LAFLD,,LISTAR(U1)] ;Get attrib of LN pointed to. + CAIN U2,(U3) ;Equal to one we want? + JRST [ MOVE U2,LISTAR(U1)+1 ; Yes. get CAR of node. + CAME U4,LISTAR(U2)+1 ; Values match? + JRST SEAC20 ; No, keep CDRing on down... + ;; Yes! Return LP to LN containing the winning CAAR. + AOS UUORPC ; Make skip. + JRST SEAC99 ] ; Return. +SEAC20: HRRZ U1,LISTAR(U1) ;No, get CDR and continue, + JUMPN U1,SEAC10 ;as long as list still exists. +SEAC90: SETZ U1, ;Return NIL if not found. +SEAC99: LDB U2,UACFLD ;Get result acc + MOVEM U1,(U2) ;Store ptr. +IFSVU2, POP P,U2 + UUOXRT + + +;;; DBPUT - Database Writeout +;;; Writes database LSEs to disk. +;;; Does not skip; goes to AUTPSY if lost. + +DBPUT: PUSHER P,[A,B,C] + MOVEI T,TMPFN1 + SYSCAL OPEN,[%CLBIT,,.BIO ? %CLIMM,,DKOC ? DBDEV ? (T) ? 1(T) ? DBDIR] + JSR AUTPSY + MOVEI A,DOMAIN + SETO B, + CALL LSEOUT ;First goes the DOMAIN regular-names LSE. + MOVEI A,DOMADR + SETO B, + CALL LSEOUT ;Second goes the DOMADR addr-names LSE. + MOVEI T,2*PG$SIZ + MOVE A,[-1,,[0]] ;Then two pages of zeros to guarantee that + .IOT DKOC,A ;readin CORBLKs win even if database is empty. + SOJG T,.-2 + MOVEI T,DBFN1 ;Now install this file as the new database. + SYSCAL RENMWO,[%CLIMM,,DKOC ? (T) ? 1(T) ] + JSR AUTPSY + .CLOSE DKOC, + POPPER P,[C,B,A] + RET + +;;; DBGET - Database Readin. +;;; Skips returns unless error. + +DBGET: PUSHER P,[A,B] + MOVEI T,DBFN1 + SYSCAL OPEN,[[.BII,,DKIC] ? DBDEV ? (T) ? 1(T) ? DBDIR] + JRST DBGET9 + MOVEI A,DOMAIN + SETO B, + CALL LSEIN + JRST DBGET9 + MOVEI A,DOMADR + SETO B, + CALL LSEIN + JRST DBGET9 + .CLOSE DKIC, + AOS -2(P) +DBGET9: POPPER P,[B,A] + RET + + + + + + + +SUBTTL Locks + +TMPLOC 43, LSWLST: 0 ;Ptr to locked switch list. +TMPLOC 44,{-CRITIL,,CRITIC} ;AOBJN ptr to critical code table + +;;; Critical code table pointed to by word 44! + +CRITIC: LKIN32,,LKIN36 ;For crashing in LKINIT + MOVEM A,LSWREQ + LKGRB1,,LKGRB2+1 ;For crashing in LKGRAB + SETOM @A + RDLOC1,,RDLOC2 ;For crashing in RDLOCK + SOS @A + UNLOC2,,UNLOC3 ;For crashing in UNLOCK. + SOS @A +CRITIL==.-CRITIC + +;;; RDLOCK - Obtain a non-exclusive Read database lock. +;;; Skips if successful, tries only once! + +LVAR RDLOKP: 0 ;-1 if we have the read lock. + +RDLOCK: .SUSET [.SPICLR,,[0]] ;Without-interrupts... + PUSHER P,[A,B,C] + SKIPE RDLOKP ;If already locked + JRST RDLOC8 ; don't lock it again. + SKIPN LOCKW ;If database is Write locked + JRST RDLOC9 ; fail. + MOVEI B,LOCKR ;Chain locked-switch list through here. + MOVEI A,USERS ;Database Read lock. +RDLOC1: AOS (A) ;Count ourselves. + MOVEM A,(B) ;1st wd in switch block has lock addr. + HRLZI C,(SOS @) ;2d wd has insn to unlock it. + HRR C,LSWLST ;Find CDR of locked switch list. + MOVEM C,1(B) ;Chain list through here. +RDLOC2: MOVEM B,LSWLST ;Install this switch block on list. + SETOM RDLOKP ;Remember that we acquired a read lock. +RDLOC8: AOS -3(P) +RDLOC9: POPPER P,[C,B,A] + .SUSET [.SPICLR,,[-1]] + RET + +;;; WRLOCK - Obtain the exclusive Read/Write database lock. +;;; Waits for up to five minutes. +;;; Skips if successful. + +LVAR WRLOKP: 0 ;-1 if we have the write lock + +WRLOCK: PUSHER P,[A,B,E] + SKIPE WRLOKP ;If already have write lock + JRST WRLOC8 ; claim success. + SKIPE RDLOKP ;Ensure that we have a read lock too. + JRST WRLOC1 ; Already have it, OK. + CALL RDLOCK ;Else ask for one. + JRST WRLOC9 ; Eh? +WRLOC1: MOVEI A,LOCKW ;Else here's write lock. + CALL LKGRAB ;Let's try to get it. + JRST WRLOC9 ; Fail if cannot. + ;; Now we have Read/Write lock. + ;; However, we must wait for any other readers to finish up. + MOVEI E,5*60.*2 ;Try for up to five minutes. +WRLOC2: MOVE A,USERS ;See how many people have a read lock. + CAIN A,1 ;If only one person has it + JRST WRLOC8 ; must be us! + MOVEI T,15 + .SLEEP T, ;Take 1/2 second nap and try again. + JRST WRLOC2 +WRLOC8: SETOM WRLOKP ;Note that we have write lock. + AOS -3(P) ;We are the only database Read/Writer! +WRLOC9: POPPER P,[E,B,A] + RET + + +;;; LKGRAB - Grab a switch-lock. +;;; A/ addr of switch to swipe at +;;; Skips if successfully grabbed switch for very own. +;;; Doesn't skip if it was locked. Tries only once!!! + +LKGRAB: .SUSET [.SPICLR,,[0]] + AOSE (A) ;Try to get switch. + RET ; Bah, already locked. +LKGRB1: HRRZ T,LSWLST ;Need to remember to unlock it. + HRLI T,(SETOM) ;Insn and CDR. + MOVEM T,1(A) ;Set them up. +LKGRB2: MOVEM A,LSWLST ;Place switch on list. + AOS (P) ;Skip, we got it. + .SUSET [.SPICLR,,[-1]] + RET + + +LVAR HAVLKS: 0 ;-1 => Database locks initialized. + +;;; LKINIT - Lock Initializations +;;; Returns when the database locks are initialized. +;;; Goes to AUTPSY if unable to get at locks. + +LKINIT: PUSHER P,[A,B] + SETZM HAVLKS ;Locks not available yet. +LKIN10: SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,LOCKC ? %CLERR,,A + DBDEV ? LCKFN1 ? LCKFN2 ? DBDIR ] + CAIA + JRST LKIN20 ; OK, we have opened the locking file. + CAIE A,%ENSFL ;Else maybe lock file is missing. + JSR AUTPSY ; No, some *really* random lossage. + SYSCAL OPEN,[%CLBIT,,.BIO ? %CLIMM,,LOCKC ? %CLERR,,A + DBDEV ? LCKFN1 ? LCKFN2 ? DBDIR ] + JSR AUTPSY + MOVEI T,PG$SIZ +LKIN17: MOVE A,[-1,,[0]] ;Output zero wds for initial locks. + .IOT LOCKC,A + SOJG T,LKIN17 + .CLOSE LOCKC, ;Close, creating file. + JRST LKIN10 ;Now try opening it again. +LKIN20: ;; Map in the locks file. + SYSCAL CORBLK,[ %CLIMM,,%CBNDW+%CBPUB ? %CLIMM,,%JSELF + %CLIMM,,LOCKPG ? %CLIMM,,LOCKC ] + JSR AUTPSY + ;; Now try to init. (Critical code is LKIN32 through LKIN36.) +LKIN30: SYSCAL RQDATE,[%CLOUT,,JUNK ? %CLOUT,,A] + JSR SYSLOS + CAMN A,[-1] ;We need the system boot time + JSR AUTPSY ; else we can't init. + MOVE B,A +LKIN31: EXCH A,LSWREQ ;Claim right of initializing. +LKIN32: CAME A,LSWREQ ;If we got the right to lock + JRST LKIN35 ; go initialize it. +LKIN33: CAMN B,LSWDON ;Else didn't get init rights. + JRST LKIN90 ; Either someone else has inited for us. + MOVEI A,30. ;Or initialization is in progress. + .SLEEP A, ;Wait for a moment in case other job dies. + MOVE A,B ;Then go try again. + JRST LKIN31 ;Try to claim again. + ;; (Add new locks here.);; +LKIN35: SETZM LOCKR ;Clear reference count. + SETZM USERS + SETOM LOCKW ;Clear write lock. +LKIN36: MOVEM B,LSWDON ;Indicate lock init done. +LKIN90: SETOM HAVLKS ;Have the page and locks! + .CLOSE LOCKC, + POPPER P,[B,A] + RET + + +;;; UNLOCK - Unlock everything on the locked switch list. +;;; Does not skip. + +UNLOCK: .SUSET [.SPICLR,,[0]] + PUSHER P,[A,B] + MOVE B,LSWLST ;Get list of locks. +UNLOC1: JUMPE B,UNLOC9 ;If NIL, nothing to unlock! + HRRZ A,B ;Get lock addr or switch. + HLLZ T,1(B) ;Get insn to unlock it. + SKIPN T ;If missing + HRLI T,(SETOM) ; assume it was a SETOM. + HLL A,T ;Set up critical instruction. + HRRZ B,1(B) ;Get CDR to next entry. + MOVEM B,LSWLST ;Splice lock out of chain. +UNLOC2: XCT A ;Now unlock it. (Critical insn!) +UNLOC3: SKIPE HAVLKS ;If we had database locks + JRST [ HRRZ A,A ; Update our lock indicators. + CAIN A,LOCKR ? SETZM RDLOKP + CAIN A,LOCKW ? SETZM WRLOKP + JRST .+1 ] + JRST UNLOC1 ;Loop for all locks. +UNLOC9: POPPER P,[B,A] ;Database completely unlocked by us. + .SUSET [.SPICLR,,[-1]] + RET + + + + +SUBTTL Create the initial database + +;;; *** This shouldn't rely on SRI-NIC, but does at the moment. +;;; *** Eventually, we will init from a file or something. + +ROOHST: LITSTR [SRI-NIC.ARPA] +ROOADR: 1200,,63 + +LVAR DOMLST: 0 ;LP to Domain-level list. + +MAKDB: PUSHER P,[A,B,C,D,E] +MAKD10: CALL WRLOCK ;Seize write lock. + JRST MAKD10 ; Keep trying until we get it. + SYSCAL DELETE,[ DBDEV ? DBFN1 ? DBFN2 ? DBDIR ] + NOP + SYSCAL OPEN,[ %CLBIT,,.BIO ? %CLIMM,,DKOC + DBDEV ? DBFN1 ? DBFN2 ? DBDIR ] + JRST CPOPJ + MOVEI A,DOMAIN ;Create new LSE for Domain list. + CALL LSEOPN + MOVE L,$ARLOC+DOMAIN ;Ptr to Domain list in core. + MAKELN E,[A$VAL,,NIL ? %LTVAL,,[[DC$IN]]] + MAKELN D,[A$CLAS,,NIL ? %LTLST,,[E]] + MAKELN C,[A$VAL,,[D] ? %LTSTR,,[LITSTR []]] ;The "Root" Domain name. + MAKELN B,[A$DOM,,NIL ? %LTLST,,[C]] + MOVEM B,DOMLST + MAKELN A,[A$VAL,,NIL ? %LTSTR,,[LITSTR [AI.MIT.EDU]]] + MAKELN B,[A$SOA,,NIL ? %LTLST,,[A]] + MAKELN C,[A$VAL,,[B] ? %LTSTR,,[LITSTR [Main Domain List]]] + MAKELN A,[A$DB,,[DOMLST] ? %LTLST,,[C]] + MOVEM A,$LLLST(L) + ;; Insert Nameserver RR for the root domain. + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,ROOHST] + MAKELN B,[A$VAL,,[C] ? %LTVAL,,[[DT$NS]]] + MAKELN A,[A$RR,,NIL ? %LTLST,,[B]] + HRRM A,LISTAR(E) + MAKELN D,[A$RC,,NIL ? %LTVAL,,[[69.]]] + MAKELN B,[A$DIST,,[D] ? %LTVAL,,[[%AUILL]]] + HRRM B,LISTAR(C) + ;; Add another Domain which is the server for the Domain. + MAKELN E,[A$VAL,,NIL ? %LTVAL,,[[DC$IN]]] + MAKELN D,[A$CLAS,,NIL ? %LTLST,,[E]] + MAKELN C,[A$VAL,,[D] ? %LTSTR,,ROOHST] + MAKELN B,[A$DOM,,NIL ? %LTLST,,[C]] + MOVE A,DOMLST + HRRM B,LISTAR(A) ;Stick onto CDR of Domain list. + MAKELN C,[A$RRVAL,,NIL ? %LTVAL,,[ROOADR]] + MAKELN B,[A$VAL,,[C] ? %LTVAL,,[[DT$A]]] + MAKELN A,[A$RR,,NIL ? %LTLST,,[B]] + HRRM A,LISTAR(E) + MAKELN D,[A$RC,,NIL ? %LTVAL,,[[69.]]] + MAKELN B,[A$DIST,,[D] ? %LTVAL,,[[%AUILL]]] + HRRM B,LISTAR(C) + MOVEI A,DOMADR ;Create new LSE for Domain list. + CALL LSEOPN + MOVE L,$ARLOC+DOMADR ;Ptr to Domain list in core. + MAKELN A,[A$DB,,NIL ? %LTSTR,,[LITSTR [Address Domain List]]] + MOVEM A,$LLLST(L) + CALL DBPUT ;Now write out it out to disk! + OUT(,("Database initialized at "),TIM(HMS),(" for "),6F(UNAME),EOL,EOL) +MAKDBG: SETOM DEBCHP ;Print debugging into into RRECS. + MOVE L,$ARLOC+DOMAIN + CALL DEBLSE + NOP + OUT(,CRLF,CRLF) + MOVE L,$ARLOC+DOMADR + CALL DEBLSE + NOP + POPPER P,[E,D,C,B,A] + JRST POPJ1 ;All done. + + +SUBTTL Miscellaneous Subroutines and UUOs + +; USEA AC,[ASCNT [string]] ASCNT String Equal +; +; Compare from ASCNT ptr in E to ASCNT ptr in AC. +; Ignore case and skip if strings are equal. + +UUODEF USEA:,USEA00 +USEA00: SETOM UQSTRF ;Uppercase compare. + LDB U1,UACFLD ;Find AC. + MOVE U1,(U1) ;U1 gets an ASCNT. +IFSVU2, PUSH P,U2 + MOVE U4,@U40 ;U4 gets an ASCNT. + JRST UQSTR4 ;Might as well re-use some code... + +;;; USBSEA Uppercase string backwards compare. +;;; A/ string ASCNT +;;; B/ substring ASCNT +;;; +;;; This case-insensitively compares the two ASCNT strings backwards. +;;; If B is a substring from the very end of A, skip return. +;;; Otherwise do not skip. Does not mung A or B. +;;; +;;; +;;; Example: MOVE A,LITSTR [FOO.BAR.BAZ] +;;; MOVE B,LITSTR [BAR.BAZ] +;;; CALL USBSEA +;;; Would skip return! + +USBSEA: PUSHER P,[A,B,C,D] + HLRZ C,A ;Get len of string. + HLRZ D,B ;Get len of substr. + CAMLE D,C ;If substring is larger than string + JRST USBS99 ; it can't be contained in there. + HRLI A,440700 + PTSKIP C,A ;A is Bp to the end of the string. + HRLI B,440700 + PTSKIP D,B ;B is Bp to the end of the substr. +USBS10: LDB T,A ;Get string char. + LDB TT,B ;Get substr char. + CAME T,TT ;If they don't match + JRST USBS99 ; we lost. + SOSE D ;If substring not exhausted + JRST [ DBP7 A ; Back up one char each. + DBP7 B ; String is at least as long as substring. + JRST USBS10 ] +USBS90: AOS -4(P) ;Else we are done! +USBS99: POPPER P,[D,C,B,A] + RET + + +;;; STRCMP - Slow case-insensitive compare of aligned ASCIZ strings. +;;; A/ Bp to string +;;; B/ Bp to string +;;; Skips if the strings are equal. Does not mung Bps. + +STRCMP: PUSHER P,[A,B] +STRCM1: ILDB T,A ;Gobble. + UPPER T + ILDB TT,B ;Gobble. + UPPER TT + CAME T,TT ;Gobble? + JRST STRCM9 ; No, gobble. + JUMPN T,STRCM1 ;Gobble... + AOS -2(P) ;Gobble! +STRCM9: POPPER P,[B,A] + RET + + +;;; ASZLEN - Return ASCNT for ASCIZ string in A. +;;; Returns in A the . + +ASZLEN: SETZ TT, + MOVE T,A ;Copy Bp. + HRLI T,440700 ;ASCIZ string. +ASZLE1: ILDB Z,T ;Get a char. + SKIPE Z ;If not null + AOJN TT,ASZLE1 ; count it. + HRRZ A,A ;Put addr in RH + HRL A,TT ;Put cnt in LH. + RET ;All done. + +;;; STRCOP - Copy (uncompressed) string +;;; A/ Bp to source string +;;; B/ Bp to dest string +;;; C/ Length of source string +;;; Updates A and B. + +STRCOP: PUSH P,C +STRCO1: ILDB T,A + IDPB T,B + SOJG C,STRCO1 + POP P,C + RET + +;;; XCTIOC - Expected IOC error UUO. +;;; NLISTS apparently requires this. + +LVAR XIOCP: 0 ;Saved PDL ptr. + +UUODFE XCTIOC,UXCTIO ;Skip unless IOCER occurs +UXCTIO: TRO F,%IOCER +IFE $$UCAL,PUSH P,UUORPC ;Ensure ret addr on stack since may xct UUO. + PUSH P,U40 ;Must also save due to int lossage (40 zapped) + MOVEM P,XIOCP ;Save PDL pointer... + XCT @(P) ;Execute instruction... + CAIA + AOS -1(P) + AOS -1(P) +IOCRET: TRZ F,%IOCER + SUB P,[1,,1] ;Flush saved loc 40 + RET ;Return from UUO. + + + +;;; OWNHST - Return own Internet host address in A. +;;; Non-skip means we are not on the ARPAnet. + +OWNHST: SYSCAL NETHST,[ %CLIMM,,-1 ? %CLOUT,,Z ? %CLOUT,,A] + RET + LSHC A,-6 ;Put 10 bits spacing between host/imp #s. + LSH B,-<2+8.> + LSHC A,<2+8.+6> + TLO A,(12_24.) ;and add ARPA network number. + JRST POPJ1 + + +SUBTTL Storage + +PRGNAM: .FNAM1 ;FN1, FN2 of source file assembled from. +VERSHN: .FNAM2 + +BVAR +JUNK: 0 ;The kitchen sink. + PDLLEN==512. +PDL: BLOCK PDLLEN ;The stack. + +PATLEN==64. +PAT: +PATCH: BLOCK PATLEN ;Patch area. + +INDEX: -1 ;Our job index. +UNAME: 0 ;Our job names +JNAME: 0 + +BUFFER: BLOCK PG$SIZ ;A random buffer. + +;;; UUO Areas. + +RRECS: BLOCK $ARSIZ ;Area for text of RRs (BOJ output buffer!) +DOMAIN: BLOCK $ARSIZ ;Domain names database area. +DOMADR: BLOCK $ARSIZ ;Domain addresses database area. +CACHE: BLOCK $ARSIZ ;Domain names cache for current job. +TMPAR: BLOCK $ARSIZ ;Temporary area for various things. + +;;; Table of ARPT's to all standard ARBLK's to be flushed when coring down. +ARPTBL: RRECS + DOMAIN + DOMADR + CACHE + TMPAR +NAREAS==.-ARPTBL + +EVAR +LITTER: CONSTANTS ;Now dump out all literals/constants here + VARCHK ;Now dump out all variables, and find + ;How big impure and pure really are. + +;;; Memory management definitions (now that we know how big pgm is!) + +LASTPG==1+<.+PG$SIZ-1>/PG$SIZ ;First dedicated page. + +LOCKPG==LASTPG+0 ;Actual locks mapped to this page. +OPKTPG==LOCKPG+1 ;For IP output packet. +IPKTPG==OPKTPG+2 ;For IP input packet. +CLNTPG==IPKTPG+2 ;For mapping in client. +FREEPG==CLNTPG+4 ;First free page for PAGSER. + +IFN $$HST3, HSTPAG==377-200 ;Reserve top 128K for HOSTS3 file. +IFN $$HST3, HSTTAB=HSTPAG*PG$SIZ + +;;; Buffers pages. +OPKT=OPKTPG*PG$SIZ +IPKT=IPKTPG*PG$SIZ + +;;; Locks .SEE LKIN35 +LSWLOC=:LOCKPG*2000 ;Switch page starts here. +LSWREQ=:LSWLOC+0 ;Init Request flag. +LSWDON=:LSWREQ+1 ;Init Done flag. +LOCKW=: LSWDON+1 ;Database write-lock switch +LOCKR=: LOCKW+2 ;Database read-lock +USERS=: LOCKR+2 ;Count of readers. + +END GO + + +;;; Local Modes: +;;; Mode:MIDAS +;;; Comment column:32 +;;; End: diff --git a/src/sysnet/udplib.5 b/src/sysnet/udplib.5 new file mode 100644 index 000000000..ec9b9a8aa --- /dev/null +++ b/src/sysnet/udplib.5 @@ -0,0 +1,352 @@ +;;;-*-MIDAS-*-;;; + +.TYO6 .IFNM1 +.TYO 40 +.TYO6 .IFNM2 +PRINTX/ included in this assembly. +/ + + +IFNDEF CALL,CALL==: ; More efficient than macro. +IFNDEF RET,RET==: +IFNDEF NOP,NOP=: ; What the hell. +IFNDEF JCRY0,JCRY0=: ;Jump on Carry from bit 0 (and clear flag) + +IFNDEF SYSCAL,{ +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +} + +IFNDEF PUSHER,{ +DEFINE PUSHER AC,LIST +IRP LOC,,[LIST] +PUSH AC,LOC +TERMIN +TERMIN +} + +IFNDEF POPPER,{ +DEFINE POPER AC,LIST +IRP LOC,,[LIST] +POP AC,LOC +TERMIN +TERMIN +} + + +;;; IDGEN - Generate a "unique" ID number. +;;; T/ address of counter +;;; Returns value in A. + +DEFINE IDGEN AC,CNTR + SKIPN MYUIND ;Find my job index. + .SUSET [.RUIND,,MYUIND] + AOS CNTR ;Make up an ID for this query. + MOVE T,CNTR + .PDTIME TT, + DPB T,[.BP 000777,AC] + DPB TT,[.BP 777000,AC] +TERMIN + + + +SUBTTL IP/UDP Defs. + +IP%VER==740000,, ; 0 IP Version # (= 4) +IP%IHL==036000,, ; 0 IP Header Length in 32-bit wds - at least 5 +IP%TOS==001774,, ; 0 Type Of Service +IP%TOL==000003,,777760 ; 0 Total Length in octets (including header) +IP%ID== 777774,, ; 1 Identification +IP%FLG== 3,,400000 ; 1 Flags + IP%FDF== 1,,0 ; Don't-Fragment flag + IP%FMF== 400000 ; More-Fragments flag +IP%FRG== 0,,377760 ; 1 Fragment Offset +IP%TTL==776000,, ; 2 Time To Live +IP%PTC== 1774,, ; 2 Protocol +IP%CKS== 3,,777760 ; 2 Header Checksum +IP%SRC==777777,,777760 ; 3 Source Address +IP%DST==777777,,777760 ; 4 Destination Address + ; 5 Start of options +IP$VER==<.BP IP%VER,0> +IP$IHL==<.BP IP%IHL,0> +IP$TOS==<.BP IP%TOS,0> +IP$TOL==<.BP IP%TOL,0> +IP$ID== <.BP IP%ID, 1> +IP$FLG==<.BP IP%FLG,1> +IP$FRG==<.BP IP%FRG,1> +IP$TTL==<.BP IP%TTL,2> +IP$PTC==<.BP IP%PTC,2> + %PTCIC==:1 ; Protocol ICMP + %PTCTC==:6. ; Protocol TCP + %PTCUD==:17. ; Protocol UDP +IP$CKS==<.BP IP%CKS,2> +IP$SRC==<.BP IP%SRC,3> +IP$DST==<.BP IP%DST,4> + +;;; USER DATAGRAM PROTOCOL + +$UDPHL==2 ;Length of a UDP header. + +$UDPH==5 ;Minimum buffer offset to UDP header. +$UDPD==$UDPH+$UDPHL ;Buffer offset to UDP data. + + ; UDP fields +UD$SRC==<242000,,0> ; 0 wd 1 Source port +UD$DST==<042000,,0> ; 0 wd 2 Dest port +UD$LEN==<242000,,1> ; 1 wd 1 # octets in data +UD$CKS==<042000,,1> ; 1 wd 2 UDP checksum +UD$DAT==<441000,,2> ; 2 Data - actually an ILDB pointer! + +;;; IPQ dev OPEN control/mode bits + +%IQSYS==100 ; Set up System Queue (0 or 1) +%IQSOU==200 ; System Queue 1 if set, otherwise 0 +%IQUDP==400 ; Set up random queue for UDP (port # in FN1) + +; .CALL IPKIOT - Internet Protocol Packet Transfer. +; Arg 1 is channel (must be open on IPQ:, specifies queue #) +; Arg 2 is address of buffer +; Arg 3 is count of words +; Val 1 is count of words read into user space (if any) +; Control bits specify function. If none, "read" is assumed. +; Get datagram from: + %IPIUS==100 ; 1 = Get datagram from user space, not from a queue + %IPNOC==200 ; Global input no-check flag, suppresses normal check. + ; For User Space, "check" means verify, set cksum. + ; For Input Queue, "check" means verify IP header. + ; For SysIn Queue, "check" means verify IP hdr. + ; For SysOut Queue, means nothing. + %IPNOH==400 ; Don't Hang waiting for datagram (Queues only) + %IPIQK==1000 ; Keep on queue, don't remove (only for %IPOUS) +; Put datagram to: + %IPOUS==0 ; User space + %IPOUT==1 ; Output to network (bypasses SysOut queue) + %IPOFL==2 ; Flush it + %IPORV==3 ; Re-vector to input queues past this one + + +;;; PKTDPB macro for plunking down into a field (index packet off W). + +DEFINE PKTDPB PTR,-VAL + MOVE T,VAL + MOVE TT,[PTR (W)] + DPB T,TT +TERMIN + + +;;; DPWIDE macro deposits 16 bit quantity down 8-bit Bp. + +DEFINE DPWIDE PTR,-VAL + MOVE T,VAL + SETZ TT, + LSHC T,-8. + LSH TT,-<36.-8.> + IDPB T,PTR + IDPB TT,PTR +TERMIN + + +;;; LBWIDE macro reads 16 bit quantity from an 8-bit Bp. + +DEFINE LBWIDE AC,-PTR + SETZ AC, + ILDB T,PTR + LSH T,8. + ILDB TT,PTR + ADD T,TT + MOVE AC,T +TERMIN + + + +SUBTTL IP/UDP Routines + + +;;; These routines require ACs: W, A-E, smashable T,TT, and P. +;;; Args passed in ACs, code is pure, etc. etc. etc. + +.SCALAR MYUIND ;Our ITS job number. +.SCALAR PKTID ;Packet number we've sent. +.SCALAR LOCPRT ;Local port number where we listen. +.SCALAR UDLENG ;Length of data user put in datagram. + +;;; UDPOPN - Open a UDP queue. +;;; A/ channel number + +UDPOPN: PUSH P,C + .GENSYM C, + ANDI C,177777 + MOVEM C,LOCPRT ;Remember local port, and open IPQ on it. + SYSCAL OPEN,[%CLBIT,,%IQUDP ? A ? [SIXBIT /IPQ/] ? C ] + CAIA + AOS -1(P) + POP P,C + RET + + +;;; Someday it will be useful to have a routine which +;;; sends a packet and waits for a response, re-sending +;;; the packet if no response comes in reasonable time. + +;;; UDPSND and UDPRCV - Trivial UDP I/O functions. +;;; W/ packet addr +;;; A/ UDP channel number +;;; B/ bytes in the packet +;;; +;;; UDPRCV returns words received in E. + +UDPSND: PUSHER P,[B,C] + IDIVI B,4. + SKIPE B+1 + AOS B + SYSCAL IPKIOT,[%CLBIT,,%IPIUS+%IPOUT ? A ? W ? B ] + CAIA + AOS -2(P) + POPPER P,[C,B] + RET + + +UDPRCV: SYSCAL IPKIOT,[A ? W ? B ? %CLOUT,,E] + CAIA + AOS (P) + RET + + +;;; MAKPKT - Make a packet (put IP and UDP headers on it). +;;; W/ packet addr +;;; A/ foreign host +;;; B/ foreign port +;;; C/ length of data stuffed into it +;;; Returns with C updated to total packet length. + +MAKPKT: PUSHER P,[A,D,W] + MOVEM C,UDLENG +IPHDR: PKTDPB IP$VER,[4] ;Version 4 IP header (RFC791). + PKTDPB IP$IHL,[5] ;Usual length of IP packet header. + PKTDPB IP$TOS,[0] ;Default type of unreliable service. + PKTDPB IP$PTC,[%PTCUD] ;Protocol is UDP. + IDGEN D,PKTID ;Gensym a packet ID number. + PKTDPB IP$ID,D ;Stuff it in. +IFN 0, PKTDPB IP$FLG,[3] ;No fragmentation allowed. + PKTDPB IP$TTL,[30.] ;Half-minute lifetime. + PUSHER P,[A,B] + SYSCAL NETHST,[%CLIMM,,-1 ? %CLOUT,,T ? %CLOUT,,A] + .LOSE %LSFIL + LSHC A,-6 ;Standardize our ARPAnet host number. + LSH B,-<2+8.> ;Put 10 bits spacing between host/imp #s. + LSHC A,<2+8.+6> + TLO A,(12_24.) ;Add ARPA network number. + MOVE T,A + POPPER P,[B,A] + LSH T,<36.-32.> ;Get our own host address. + MOVEM T,IP$SRC(W) ;Stuff it in. + MOVE T,A ;Get destination host address. + LSH T,<36.-32.> ;Stuff it in. + MOVEM T,IP$DST(W) + ADDI C,20. ;Update count to include 5 word IP header. + ADDI C,8. ;Update our count to include 2 word UDP header. + PKTDPB IP$TOL,C ;Stuff it in. + CALL IPCKSM ;Compute the header checksum. + PKTDPB IP$CKS,A ;Stuff it in. +UDPHDR: ADDI W,$UDPH ;Make ptr to UDP header. + PKTDPB UD$SRC,LOCPRT ;Stuff in the source port. + PKTDPB UD$DST,B ;Stuff in the destination port. + MOVE D,UDLENG + ADDI D,8. + PKTDPB UD$LEN,D ;Stuff in the user datagram length. + SUBI W,$UDPH ;Pointer to entire packet. + CALL UDCKSM ;Compute UDP checksum from there. + ADDI W,$UDPH ;Now point back into UDP datagram. + PKTDPB UD$CKS,A ;Stuff it in. + POPPER P,[W,D,A] + RET + + + +;;; IPCKSM - Compute IP packet checksum (stolen from ITS INET module). +;;; W/ addr of IP packet +;;; Returns checksum in A. +;;; Does not handle headers with options + +IPCKSM: PUSH P,B + SETZ A, ;Compute header checksum in A. + MOVE B,IP$CKS(W) ;Get 3rd word + ANDCM B,[IP%CKS] ;Mask out the checksum field + JFCL 17,.+1 ;Clear flags + ADD B,IP$VER(W) ;Add 1st wd + JCRY0 [AOJA A,.+1] + ADD B,IP$ID(W) ;Add 2nd + JCRY0 [AOJA A,.+1] + ADD B,IP$SRC(W) ;Add 4th + JCRY0 [AOJA A,.+1] + ADD B,IP$DST(W) ;Add 5th + JCRY0 [AOJA A,.+1] +IPCKS2: LSHC A,16. ;Get high 2 bytes (plus carries) in A + LSH B,-<16.+4> ;Get low 2 bytes in B +IPCKS3: ADDI A,(B) ;Get total sum + CAILE A,177777 ;Fits? + JRST [ LDB B,[202400,,A] ;No, must get overflow bits + ANDI A,177777 ;then clear them + JRST IPCKS3] ;and add in at low end. + ANDCAI A,177777 ;Return ones complement + POP P,B + RET + + +;;; UDCKSM - UDP checksum (stolen from SYSNET;IPLIST) +;;; W/ addr of IP packet +;;; Returns checksum in A. + +CARMSK==<-1,,600000> + +UDCKSM: PUSHER P,[B,C,D,E] + MOVEI D,(W) + LDB A,[IP$SRC (D)] ;Source addr + LDB B,[IP$DST (D)] ;Dest addr + ADD A,B + LDB B,[IP$PTC (D)] ;Protocol + ADDI A,(B) + LDB B,[IP$TOL (D)] ;Get total length in octets + LDB C,[IP$IHL (D)] ;Find IP header length in 32-bit wds + ADDI D,(C) ;Change pointer to UDP seg + LSH C,2 ;mult by 4 to get # octets + SUBI B,(C) ;Find # octets of IP data (TCP segment) + CAIL B, ;If negative, skip this one. + ADDI A,(B) + ;; Done with pseudo header (not folded yet, though). + ;; B has # octets in the UDP segment. + ;; D now points to the UDP segment. + LDB C,[UD$SRC (D)] + ADDI A,(C) + LDB C,[UD$DST (D)] + ADDI A,(C) + LDB C,[UD$LEN (D)] + ADDI A,(C) + MOVEI C,-<2*4>(B) ;Get # bytes of remaining data in C + LSHC A,-16. + LSH B,-<16.+4> + ADDI A,(B) ;Now have it folded up. + JUMPLE C,UDPCK7 + MOVEI E,2(D) + HRLI E,442000 ;Set up 16-bit byte ptr + LSHC C,-1 + JUMPLE C,UDPCK6 +UDPCK5: ILDB B,E + ADDI A,(B) + SOJG C,UDPCK5 +UDPCK6: JUMPL D,[ ;Jump if odd byte left. + ILDB B,E ;get it + ANDCMI B,377 ;mask off low (unused) byte. + ADDI A,(B) + JRST .+1] +UDPCK7: TDNE A,[CARMSK] ;If any carries, add them in. + JRST [ LDB B,[.BP CARMSK,A] + TDZ A,[CARMSK] + ADD A,B + JRST UDPCK7] + ANDCAI A,177777 ;Complement sum and mask off. +UDCKS9: POPPER P,[E,D,C,B] + RET + + From 05717eb5be040525deabd7c3664ffc5a275879f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Mon, 6 Sep 2021 14:15:06 +0200 Subject: [PATCH 02/21] Fixes from 2005 with some minor touchups. --- src/sysen2/name.558 | 92 +++++++++++++- src/sysnet/dqdefs.16 | 5 +- src/sysnet/dqdev.182 | 293 +++++++++++++++++++++++++++++++++++++++---- src/sysnet/resolv.35 | 224 +++++++++++++++++++++++++++++++-- src/sysnet/udplib.5 | 9 +- 5 files changed, 580 insertions(+), 43 deletions(-) diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 index 7e811f94d..0d2cfbc36 100755 --- a/src/sysen2/name.558 +++ b/src/sysen2/name.558 @@ -264,6 +264,15 @@ $$ANALYZ==1 .INSRT SYSTEM;CHSDEF .INSRT SYSENG;NETWRK +DODQ==:1 +ifn DODQ,[ +RESOLV"$$DQCH==:1 +.INSRT SYSNET;RESOLV +] + +;; Whether reagan.ai.mit.edu is used or not +ifndef $$dorgn, $$dorgn==0 + putchr: .iot tyoc,t popj p, @@ -804,10 +813,20 @@ fjcl55: movem a,hstcur ;store # as current host. typi "[ push p,b move b,a +ifn DODQ,[ + move a,[440700,,hanlst] + pushj p,resolv"hstsrc + jrst [ move a,hstcur + pushj p,typehn + jrst fjcl56 ] + movei a,hanlst +] +.else,[ pushj p,netwrk"hstsrc jrst [ move a,hstcur pushj p,typehn jrst fjcl56 ] +] typz (a) ;type official name of site. fjcl56: pop p,b typi "] @@ -1090,7 +1109,13 @@ hstlook: movei a,(p) ;B may contain host name in asciz, tlnn b,-1 ;or if lh is 0, it is address of asciz string. move a,b +ifn DODQ,[ + hrli a,440700 + pushj p,resolv"hstadr +] +.else,[ pushj p,netwrk"hstlook ;convert to host number. +] setz a, move b,a ;return that in B. sub p,[1,,1] @@ -1293,6 +1318,7 @@ ncvt63: sojge c,ncvt62 ;Look through the host table to find all the Lisp machines, ;or all Lisp machines associated with the machine we are on. ;Contact them eight at a time using all 16 I/O channels. +;#### More efficiently, use a Chaosnet broadcast (BRD) and collect answers? lmfing: pushae p,[a,b,c,d,e,t,tt] .iopush ntsi, .iopush tyoc, @@ -1304,7 +1330,7 @@ lmfing: pushae p,[a,b,c,d,e,t,tt] movem c,lmintb .suset [.smsk2,,c] setz c, ;C has index into LMADRS. -ife 1,[ ;now we have reagan this works differently... +ifn $$dorgn,[ ;now we have reagan this works differently... trne f,%alllm jrst [ movei b,hslm ;Find the table of all lisp machines, or jrst lmfin2] @@ -2521,6 +2547,25 @@ prthsc: push p,b jrst [ ;6typ hstsix ;Print out its sixbit name. pop p,b jrst prths1 ] +ifn DODQ,[ +;;; If TELSER only has numeric address (1.2.3.4), try resolving the FHOST + push p,a + move a,[440700,,hstnam] +prtc00: ildb b,a + skipn b + jrst prtc01 ;only numbers found + cain b,". + jrst prtc00 + cail b,"0 + caig b,"9 + jrst prtc00 ;non-number found + jrst prtc09 +prtc01: move a,[440700,,hstnam] + skipe b,fhost + pushj p,resolv"hstsrc + trn +prtc09: pop p,a +] prthc0: move a,[440700,,hstnam] ;Scan name supplied by TELNET server. irpc ch,,[MIT-] ildb b,a @@ -2566,6 +2611,25 @@ prthc3: ildb c,b prthst: push p,b push p,c push p,d +ifn DODQ,[ +;;; If TELSER only has numeric address (1.2.3.4), try resolving the FHOST + push p,a + move a,[440700,,hstnam] +prth00: ildb b,a + skipn b + jrst prth01 ;only numbers found + cain b,". + jrst prth00 + cail b,"0 + caig b,"9 + jrst prth00 ;non-number found + jrst prth09 +prth01: move a,[440700,,hstnam] + skipe b,fhost + pushj p,resolv"hstsrc + trn +prth09: pop p,a +] ;; Strip .ARPA, .EDU, etc from host name domstp: move b,[440700,,hstnam] push p,b ;save it too @@ -2583,6 +2647,7 @@ domlo1: jumpe c,domeos ;null? Oh well. jrst domlcs cain c,"M ;.MIT.EDU? jrst dommit + ;; #### check for configured local domain here, and perhaps CHAOSNET.NET as well jrst domlo1 domaxx: ildb c,b ;Check for "i.mit.edu" or "rpa" @@ -3542,6 +3607,21 @@ HANLY0: ILDB T,B SOJG D,HANLY0 HANLY1: IDPB D,C MOVEI A,HANLST +ifn DODQ,[ + hrli a,440700 + pushj p,resolv"hstadr + JRST [ SKIPN ITBARF + JRST HANLY9 + TYPZ CRLF + TYPI "[ + movei a,hanlst + TYPZ (A) + TYPZ [ASCIZ " is an unknown host]"] + TYPZ CRLF + TYPZ CRLF + JRST HANLY9 ] +] +.else,[ PUSHJ P,NETWRK"HSTLOOK JRST [ SKIPN ITBARF JRST HANLY9 @@ -3552,6 +3632,7 @@ HANLY1: IDPB D,C TYPZ CRLF TYPZ CRLF JRST HANLY9 ] +] AOS -6(P) HANLY9: POPAE P,[TT,T,E,D,C,B] POPJ P, @@ -3636,6 +3717,7 @@ EVAR ;Match name of ITS system to list of names of lisp machines ;that should be considered automatically with that ITS system. hs10lm: sixbit /mc/+hslmmc + sixbit /up/+hslmup 0 ;Lisp machines associated with MC. @@ -3644,6 +3726,12 @@ hslmmc: irps x,,sinatra bing avatar merlin lm20 lm19 mit-pi lm9 lm16 lm12 starli termin 0 +;; Lisp machines associated with UP. +hslmup: irps x,,cdr greek + [asciz/x/] + termin + 0 + ; List of all Lisp machines. ; Now reagan has the all-lispm finger server, *lispm = Reagan hslm: [asciz /reagan/] @@ -3682,11 +3770,11 @@ hsvms: irps x,,pig corwin oberon vulcan golem 0 ;MIT Twenex sites +;;#### should work like lispms - based on the ITS name, find its friends hstnx: irps x,,xx oz speech ee [asciz /x/] termin 0 - ;List of Apiary machines. hsapes: irps x,,ap1 ap2 ap3 ap4 ap5 ap6 ap7 ap8 ap9 ap10 [asciz /x/] diff --git a/src/sysnet/dqdefs.16 b/src/sysnet/dqdefs.16 index 6f9d26ee8..b766de83e 100644 --- a/src/sysnet/dqdefs.16 +++ b/src/sysnet/dqdefs.16 @@ -76,6 +76,8 @@ DT$WKS==11. ;Well known service description DT$PTR==12. ;Domain name pointer DT$HIN==13. ;Host information DT$MIN==14. ;Mailbox or list information +DT$MX==15. ;Mail exchange +DT$TXT==16. ;Text string ;;; QTYPEs(in addition to above TYPEs) @@ -88,7 +90,8 @@ DT$ANY==255. ;Request for all records DC$IN==1. ;DARPA Internet DC$CS==2. ;NSF CSnet -DC$CH==3. ;CHAOS network (need a real number from Postel) +DC$CH==3. ;CHAOS network +DC$HS==4. ;Hesiod ;;; QCLASSes (in addition to above CLASSes) diff --git a/src/sysnet/dqdev.182 b/src/sysnet/dqdev.182 index c57d7a8f6..368d1a4d5 100644 --- a/src/sysnet/dqdev.182 +++ b/src/sysnet/dqdev.182 @@ -3,6 +3,23 @@ IF1, TITLE DQDEV - Domain Device ;CSTACY, summer 1985 + +;;Hacked by VICTOR, 2005 +;; - the cache is buggy and disabled (see esp. UPRD21++) +;; - don't care about authoritative data - use external functionality to +;; send all requests to a recursive server. +;; - implemented Chaos class handling, and MX/TXT also for IN. +;; - should return minimum preference MX (assume first is minimum) +;;TODO: +;; - put configuration in database file, update by accessing, e.g. +;; DOMAIN:CONFIG;CH-ADDR - read ch-addr domain (e.g. RESOLV) +;; DOMAIN:XYZZY;CONFIG;CH-ADDR;CH-ADDR.MIT.EDU - set ch-addr domain +;; DOMAIN:CONFIG;SEARCHLIST - read domain search list +;; DOMAIN:CONFIG;SEARCHLIST;FOO.COM;BAR.ORG - set domain search list +;; Then implement +;; - ch-addr handling (RCHADR, and HSTSRC in RESOLV) +;; - searchlist handling + IF2,[ PRINTX / / .TYO6 .FNAM1 @@ -13,6 +30,11 @@ IF2,[ PRINTX / IFNDEF $$HST3,$$HST3==1 ;Switch for HOSTS3 feature. +;;[BV] additional switches +ifndef $$CACH,$$CACH==0 ;(Don't) cache +ifndef $$NOAUT,$$NOAUT==1 ;Don't care about authoritative data or not +ifndef $$DBUG,$$DBUG==0 ;Debug + comment  The DQ device implements the Resolver component of the Domain system @@ -172,6 +194,11 @@ IOCEOF==2 ;IOC error code for END OF FILE SUBTTL Libraries, Macros +;; for KSC;PAGSER - do an autopsy rather than just a .VALUE +define psrerr code + jsr autpsy +termin + ;;; Pure storage macros PURPGB==4 ;Lots of impure. .INSRT KSC;IVORY @@ -201,9 +228,6 @@ IFE U2-OC,.ERR NETWRK temp ACs lose .INSRT SYSENG;NETWRK ];$$HST3 -;;; 20x monitor coding support routines (avoid reinvention of wheel) -.INSRT SRA;20XMAC - CONSTANTS ;;; Random macros. @@ -246,11 +270,11 @@ TERMIN SUBTTL Database definitions ;;; UDP/IP definitions and routines. -.INSRT CSTACY;UDPLIB +.INSRT SYSNET;UDPLIB ;;; Domain protocol and DQDEV database definitions. $$DQDB==1 -.INSRT CSTACY;DQDEFS +.INSRT SYSNET;DQDEFS ;;; Here we describe each valid Class and Type. ;;; Although there are currently only a few Classes and Types defined, @@ -295,6 +319,7 @@ DEFCLASS DC$ANY,"*","Any" DEFCLASS DC$IN,"IN","DARPA Internet" DEFCLASS DC$CS,"CS","NSF CSnet" DEFCLASS DC$CH,"CH","CHAOSnet" +DEFCLASS DC$HS,"HS","Hesiod" DEFTYPE DT$A,"A","Host address" DEFTYPE DT$NS,"NS","Name server" @@ -310,6 +335,8 @@ DEFTYPE DT$WKS,"WKS","Well known service" DEFTYPE DT$PTR,"PTR","Pointer" DEFTYPE DT$HIN,"HINFO","Host information" DEFTYPE DT$MIN,"MINFO","Mail information" +DEFTYPE DT$MX,"MX","Mail exchange" +DEFTYPE DT$TXT,"TXT","Text string" DEFTYPE DT$XFR,"AXFR","Zone transfer request" DEFTYPE DT$MLB,"MAILB","Mailbox related request" DEFTYPE DT$MLA,"MAILA","Mail agent request" @@ -341,8 +368,12 @@ LVAR SYSLOS: 0 ? JSR AUTPSY ;ITS did something wrong. LVAR AUTPSY: 0 ? JRST AUTPY0 ;Fatal condition encountered. LVAR DIE: 0 ? JRST DEATH ;Normal death. -AUTPY0: SKIPN LOSER +AUTPY0: +IFN $$DBUG, SETOM DEBUG +.ELSE [ + SKIPN LOSER JRST DEATH +] SOS Z,AUTPSY HRLZ Z,Z HRRI Z,%LSFIL @@ -397,7 +428,8 @@ EVAR TMPLOC 42,{-LTSINT,,TSINT} ;New style interrupt vector. TSINT: %NINTS,,INTPDP - %PIPDL+%PIMPV\%PIWRO\%PIOOB ? 0 ? -1 ? -1 ? INTBAD +IFE $$DBUG, %PIPDL+%PIMPV\%PIWRO\%PIOOB ? 0 ? -1 ? -1 ? INTBAD +.ELSE %PIWRO\%PIOOB ? 0 ? -1 ? -1 ? INTBAD %PIIOC ? 0 ? -1#<%PIMPV\%PIOOB\%PIPDL\%PIWRO> ? -1 ? INTIOC %PIILO ? 0 ? %PIILO ? 1_BOJ ? INTILO %PIRLT ? 0 ? %PIRLT ? 1_BOJ ? INTRLT @@ -865,6 +897,11 @@ SOPE10: MOVE B,(C) ;Find next Bp. SOPE15: TLNN B,-1 ;If Bp has zero LH HRLI B,440700 ; fix it up to first char in word. SOPE20: ILDB Z,B ;Increment Bp and load character. + ;; upcase + cail z,"a + caile z,"z + skipa + trz z,40 IDPB Z,A ;Stuff it. JUMPN SOPE20 ;Each string ends with null byte. AOBJN C,SOPE10 ;Go back for another Bp. @@ -1320,6 +1357,25 @@ RL DC$IN,DT$MG,X.SIMP RL DC$IN,DT$MIN,X.SIMP RL DC$IN,DT$NUL,X.SIMP RL DC$IN,DT$WKS,X.SIMP +RL DC$IN,DT$MX,X.SIMP +RL DC$IN,DT$TXT,X.SIMP + +RL DC$CH,DT$ANY,X.SIMP +RL DC$CH,DT$A,X.SIMP +RL DC$CH,DT$PTR,X.SIMP +RL DC$CH,DT$CNA,X.SIMP +RL DC$CH,DT$NS,X.SIMP +RL DC$CH,DT$HIN,X.SIMP +RL DC$CH,DT$MB,X.SIMP +RL DC$CH,DT$MR,X.SIMP +RL DC$CH,DT$MD,X.SIMP +RL DC$CH,DT$MF,X.SIMP +RL DC$CH,DT$MG,X.SIMP +RL DC$CH,DT$MIN,X.SIMP +RL DC$CH,DT$NUL,X.SIMP +RL DC$CH,DT$WKS,X.SIMP +RL DC$CH,DT$MX,X.SIMP +RL DC$CH,DT$TXT,X.SIMP ;;; LOOKUP a domain name @@ -1468,6 +1524,7 @@ SUBTTL Generic Search Routine SEARCH: PUSHER P,[B,C,E,L,QNAME] MOVEM A,QNAME ;Put QNAME in canonical place. +ife $$CACH, skipa TRNE F,%DRWOV ;If "overwriting", don't check database. JRST [ MOVE L,$ARLOC+DOMAIN JRST SEAR70 ] @@ -1793,6 +1850,10 @@ NTLU50: ;; Here when we got some kind of answer from a server. JRST NTLU10 ] CAME D,[2] ;Error response? JRST NTLU70 ; No, go cons data. +;; #### [BV] BEWARE: trying another server crashes the machine! #### + movsi t,%ensfl + jrst ntluz1 ;so don't! (say NAME ERROR) +;; #### LDB T,[IP$IHL (PKT)] ;Else process an error. ADD PKT,T ;Look in UDP data area. ADDI PKT,$UDPHL @@ -1806,6 +1867,7 @@ NTLU50: ;; Here when we got some kind of answer from a server. CAIE C,3 ;Must be a "Name Error". JRST NTLU25 ; If not, the server is fucked up. LDB C,[DP$AA (PKT)] ;Check the authority bit. +ifn $$NOAUT,skipa ;Don't care about authority SKIPE C ;If server really knows qname doesn't exist JRST [ MOVSI T,%ENSFL ; say NAME ERROR. JRST NTLUZ1 ] @@ -2232,7 +2294,7 @@ RRCO10: HLRZ B,LISTAR(A)+1 ;Get LP to Domain. ;; Above rtns return here to RRCO90... RRCO90: HRRZ A,LISTAR(A) ;CDR to next Domain,,RR pair. JUMPN A,RRCO10 ;If NIL, all done, else CONS another one. -RRCO99: POPPER P,[B,A] +RRCO99: POPPER P,[E,B,A] RET ;;; Here to create a new Domain tree in the L-LSE. @@ -2255,9 +2317,9 @@ RRCADD: PUSHER P,[B,C,D,H] HRRZ B,LISTAR(B) ;CDR to Class. MOVE B,LISTAR(B)+1 ;CAR of Class. RRCA10: HRRZ B,LISTAR(B) ;CDR down the RR chain. - CAME A,C ;Is this it? + CAME B,C ;Is this it? JRST [ AOS H ; No, keep looking. - JUMPN A,RRCA10 ; If chain exhausted + JUMPN B,RRCA10 ; If chain exhausted JSR AUTPSY ] ; RH of our ptr-pair is bogus! EXCH L,E ;H has relative position of the RR. HRLM D,LISTAR(A)+1 ;The A$DOM ptr is easy - we just inserted it. @@ -2266,7 +2328,7 @@ RRCA10: HRRZ B,LISTAR(B) ;CDR down the RR chain. MOVE C,LISTAR(C)+1 RRCA20: HRRZ C,LISTAR(C) ;CDR in C gets LP to next A$RR LN. SOJGE H,RRCA20 ;We know how far along this branch it is. - HRRM C,LISTAR(A)+1 ;Poof! + HRRM C,LISTAR(B)+1 ;Poof! POPPER P,[H,D,C,B] JRST RRCO90 @@ -2517,6 +2579,11 @@ RRPN10: ILDB T,A ;Read label length. JRST RRPN10 ] ; Continue there (new length coming up). ADD C,T ;Update count of chars in label. RRPN20: ILDB TT,A ;Get char of domain. + ;; upcase + cail tt,"a + caile tt,"z + skipa + trz tt,40 IDPB TT,B ;Stuff as ASCII. SOJG T,RRPN20 ;Finished with label when count exhausted. MOVEI T,". ;After each label comes a delimiter. @@ -2579,6 +2646,7 @@ DEFINE ANSWER CLASS,TYPE,RTN TMPLOC ANSRTN+..ANSR,{RTN} TERMIN +;; Internet class ANSWER DC$IN,DT$NUL,RNULL ANSWER DC$IN,DT$A,RINADR ANSWER DC$IN,DT$CNA,RSTR @@ -2593,6 +2661,18 @@ ANSWER DC$IN,DT$MIN,RMAIL ANSWER DC$IN,DT$HIN,RHINFO ANSWER DC$IN,DT$WKS,RWKS ANSWER DC$IN,DT$SOA,RSOA +ANSWER DC$IN,DT$MX,RMX +ANSWER DC$IN,DT$TXT,RTXT + +;; Chaos class +ANSWER DC$CH,DT$A,RCHADR +ANSWER DC$CH,DT$CNA,RSTR +ANSWER DC$CH,DT$NS,RSTR +ANSWER DC$CH,DT$PTR,RSTR +ANSWER DC$CH,DT$HIN,RHINFO +ANSWER DC$CH,DT$SOA,RSOA +ANSWER DC$CH,DT$MX,RMX +ANSWER DC$CH,DT$TXT,RTXT ;;; RRPDAT - CONS up one RDATA LN. ;;; A/ Bp to RDATA @@ -2657,6 +2737,31 @@ RINADR: PUSH P,B RINAD9: POP P,B RET +;;; RCHADR - Answer handler for Chaosnet address. + +rchadr: push p,b + LBWIDE B,A ;Get RDATA length (ignoring it.) + ZAP BUFFER,PG$SIZ ;Clear buffer for netdom string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + push p,a + move a,b +;;#### make this a parameter (see RESOLV too) + move b,LITSTR [CH-ADDR.NET] + call usbsea + jrst rchad1 ;No match + pop p,a + LBWIDE B,A ;Get CHAOS address + MAKELN C,[A$RRVAL,,NIL ? %LTVAL,,[B]] + aosa -1(p) +rchad1: pop p,a +rchad9: pop p,b + ret + ;;; RSTR - Answer Handler for compressed strings (eg: Nameserver, CNAME) RSTR: PUSH P,B @@ -2672,6 +2777,51 @@ RSTR: PUSH P,B POP P,B JRST POPJ1 +;;; RTXT - Answer handler for TXT records +;;; TXT records are one or more , i.e. +;;; . We store them as NUL +RTXT: PUSHER P,[B,D,H] + LBWIDE D,A ;get RDATA length + PUSH P,D ;save it for later + ZAP BUFFER,PG$SIZ ;Clear buffer + MOVE B,[440700,,BUFFER] ;Store text here +$$MUTXT==0 +ife $$MUTXT,[ + ILDB C,A ;Get length + AOS C ;compensate for length byte + CAME C,D + JSR AUTPSY ;strange length + SOS (P) ;compensate total length +RTXT1:: SOJLE D,RTXT9 ;(already read one byte) + ILDB C,A + IDPB C,B + JRST RTXT1 ;Go back for more +RTXT9:: SETZ C, + IDPB C,B +] +ifn $$MUTXT,[ +RTXT1:: JUMPLE D,RTXT9 ;Eat char-strings + ILDB H,A ;read length of one + PUSH P,H +RTXT2:: SOJL H,RTXT8 ;eat one + ILDB C,A + IDPB C,B + JRST RTXT2 +RTXT8:: + SETZ C, ;End string + IDPB C,B + POP P,H ;get length of what was consumed + SUB D,H + JRST RTXT1 ;Go back for more +RTXT9:: +] + POP P,D + HRLZ B,D ;make ASCNT ptr in B + HRRI B,BUFFER ;(note length bytes are replaced by nulls) + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,[B]] + POPPER P,[H,D,B] + JRST POPJ1 + ;;; RWKS - Answer Handler for WKS type data. ;;; RRVAL is (List .... ) @@ -2740,7 +2890,58 @@ RSOA: PUSH P,B RSOA99: POP P,B ;All done. JRST POPJ1 - +;;; RMX - Answer handler for MX type data +ifn 0,[ ;; Punt this - assume server gives the min pref first +RMX: pusher p,[b,c,d,e,h] ;E: min pref, D: final bp, H: len of buffer + movei e,-1 ;large min + setz h, ;zero buf len + LBWIDE d,A ;Get RDATA length + subi d,2 ;compensate for length + adjbp d,a ;make final bp in D +;; loop until end of rdata +rmx0: exch c,a ;bp compare (cf HAKMEM item 20) + rotc c,6 + camg d,c + jrst rmx9 ;end of rdata +rmx01: rotc c,-6 + exch c,a + lbwide b,a ;get preference + camge e,b ;Larger than we have? + jrst rmx1 ;no, fetch MX + call namskp ;yes, skip this one + jrst rmx0 ;and loop +rmx1: move e,b ;save new min + ZAP BUFFER,PG$SIZ ;Clear buffer for MX string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + movem c,h ;save length + jrst rmx0 ;loop +rmx9: ;end of loop, construct result + rotc c,-6 + exch c,a + HRLZ B,h ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,[B]] + popper p,[h,e,d,c,b] + jrst popj1 +] +.else,[ ;; Just return the first MX. +RMX: push p,b + LBWIDE B,A ;Get RDATA length (ignoring it.) + lbwide b,a ;skip preference + ZAP BUFFER,PG$SIZ ;Clear buffer for MNAME string. + MOVE B,[440700,,BUFFER] ;Bp to name we'll accumulate. + MOVE C,[441000,,(PKT)] ;Compression code uses packet data as string. + CALL RRPNAM ;Decompress the domain name. + NOP + HRLZ B,C ;Make an ASCNT ptr in B. + HRRI B,BUFFER + MAKELN C,[A$RRVAL,,NIL ? %LTSTR,,[B]] + pop p,b + jrst popj1 +] ;;; RHINFO - Answer Handler for HINFO type data. ;;; RRVAL is (List ) @@ -2866,7 +3067,8 @@ HSTB10: ;; Here for host address => name lookup. JRST [ MOVE A,[440700,,HSTNAM] CALL HSTBIP ;Convert 10.3.0.44.IN-ADDR to 1200,,600054. JRST HSTB20 ] - MOVE B,LITSTR [CH-ADDR.MIT.EDU] +;;#### make this a parameter (see RESOLV too) + MOVE B,LITSTR [CH-ADDR.NET] CALL AUTHCE ;See if CH-ADDR. JRST [ MOVE A,[440700,,HSTNAM] CALL HSTBCH ;Convert 1440.CH-ADDR to 40700,,1440. @@ -3168,7 +3370,10 @@ MAKSEC: PUSHER P,[A,B,C,D] JRST [ TRNE D,%AUILL ; No, but illicit data not allowed. JRST MAKS80 JRST MAKS10 ] +; non-auth is OK +ife $$NOAUT,[ TRNE D,%AUAUS+%AUATH ;If data is authoritative +] TRNE D,%AUILL ;and not illicit, output it. JRST MAKS80 ; Else quality not good enough. MAKS10: HLRZ D,LISTAR(B)+1 ;LP to Domain. @@ -3323,6 +3528,13 @@ OUTRRA DC$IN,DT$SOA,CALL [ PUSHER P,[A] POPPER P,[A] RET ] +OUTRRA DC$IN,DT$MX,CALL RRASCI +OUTRRI CALL RRBASC + +;; Should be handled special: TXT records are +OUTRRA DC$IN,DT$TXT,CALL RRASCI +OUTRRI CALL RRBASC + ;;; Resources not yet implemented but may occur in database: OUTRRA DC$IN,DT$MIN,OUTCAL(,("Ignoring DARPA Internet MINFO record."),EOL) @@ -3362,15 +3574,34 @@ RRASC5: MOVE A,LISTAR(C)+1 ;Get SLP. OUTRRA DC$CH,DT$NUL,OUTCAL(,("CHAOSnet NULL RR."),EOL) -OUTRRA DC$CH,DT$A,OUTCAL(,("CHAOSnet Host Address: "),RH(LISTAR(C)+1),EOL) +OUTRRA DC$CH,DT$A,OUTCAL(,("CHAOSnet Host Address: "),RHV(LISTAR(C)+1),EOL) OUTRRI OUTCAL(,W(LISTAR(C)+1)) OUTRRA DC$CH,DT$PTR,CALL RRASCI OUTRRI CALL RRBASC -OUTRRA DC$CH,DT$HIN,OUTCAL(,("CHAOSnet HINFO RR."),EOL) +OUTRRA DC$CH,DT$HIN,CALL [ PUSHER P,[A,B] + OUT(,("CHAOSnet Host information"),EOL) + MOVE B,LISTAR(C)+1 ;CAR has a string. + MOVE A,LISTAR(B)+1 + ADD A,$LSLOC(L) ;Make absolute. + OUT(,("CPU: "),TC(A),TAB) + HRRZ A,LISTAR(B) ;CDR to next string. + MOVE A,LISTAR(A)+1 + ADD A,$LSLOC(L) + OUT(,("OS: "),TC(A),EOL) + POPPER P,[B,A] + RET ] OUTRRI CALL RRBAS2 + +OUTRRA DC$CH,DT$MX,CALL RRASCI +OUTRRI CALL RRBASC + +;; Should be handled special: TXT records are +OUTRRA DC$CH,DT$TXT,CALL RRASCI +OUTRRI CALL RRBASC + ;; Output string values for image mode. ;; ;; Format is 36 bit byte count followed by that many bytes of text. @@ -3459,7 +3690,9 @@ UPDA99: RET ;;; into our database. All the authoritative servers had better ;;; always respond completely to our queries! -ENCACH: MOVE L,$ARLOC+CACHE +ENCACH: +ife $$CACH, ret ;Just don't do it + MOVE L,$ARLOC+CACHE FINDA A,[A$DOM,,[$LLLST(L)]] JRST UPDA99 ENCA10: MOVE C,LISTAR(A)+1 ;CAR has name VAL. @@ -3471,8 +3704,11 @@ ENCA10: MOVE C,LISTAR(A)+1 ;CAR has name VAL. FINDA C,[A$DIST,,[C]] ;Find RR status bits. JRST ENCA70 ; If missing, assume not authoritative. MOVE C,LISTAR(C)+1 +; don't care about authoritative or not +ife $$NOAUT,[ TRNN C,%AUATH ;Authoritative resource record? JRST ENCA70 ; No, don't merge this into our database. +] MOVE C,LISTAR(A)+1 ;CAR of domain has its name. MOVE C,LISTAR(C)+1 ;Get SLP to it. ADD C,$LSLOC(L) ;Absolutely. @@ -3555,11 +3791,16 @@ UPRDEL: PUSHER P,[A,B,C,D,H] UPRD10: MOVE H,LISTAR(A)+1 ;H gets source RR type. MOVE H,LISTAR(H)+1 EXCH L,E ;DOMAIN context. -UPRD20: HRRZ D,LISTAR(C) ;C has current RR node. +UPRD20: jumpe c,uprd30 ; don't follow null links + HRRZ D,LISTAR(C) ;C has current RR node. JUMPE D,UPRD30 UPRD21: MOVE T,LISTAR(D)+1 ;Get LP to type. + jumpe t,uprd30 ; don't follow null links CAME H,LISTAR(T)+1 ;Type match? - JRST [ MOVE C,D ; No, try another RR. + JRST [ + camn c,d ;#### bugs out here + jsr autpsy + MOVE C,D ; No, try another RR. JRST UPRD20 ] MOVE B,D HRRZ D,LISTAR(D) ;Get new CDR. @@ -3667,7 +3908,7 @@ DOMQRY: PUSHER P,[A,B,D,PKT] PKTDPB DP$ID,A PKTDPB DP$OP,[DO$QRY] ;Standard QUERY operation. PKTDPB DP$QR,[0] ;This is a request. - PKTDPB DP$RC,[0] ;No Recursion. + PKTDPB DP$RC,[1] ;Recursion, please! PKTDPB DP$QDC,[1] ;We have one question. DOMQ19: ADDI C,3*4 ;Count the Header Section. ;; Now build the Question Section. @@ -3862,11 +4103,14 @@ WRLOC1: MOVEI A,LOCKW ;Else here's write lock. JRST WRLOC9 ; Fail if cannot. ;; Now we have Read/Write lock. ;; However, we must wait for any other readers to finish up. - MOVEI E,5*60.*2 ;Try for up to five minutes. + MOVEI E,30.*2 ;Try for up to 30 seconds WRLOC2: MOVE A,USERS ;See how many people have a read lock. CAIN A,1 ;If only one person has it JRST WRLOC8 ; must be us! - MOVEI T,15 + skipg e ;use limit counter + jrst wrloc9 ; but there's something (more) wrong + subi e,15. ; with lock handling. + MOVEI T,15. .SLEEP T, ;Take 1/2 second nap and try again. JRST WRLOC2 WRLOC8: SETOM WRLOKP ;Note that we have write lock. @@ -3978,8 +4222,9 @@ SUBTTL Create the initial database ;;; *** This shouldn't rely on SRI-NIC, but does at the moment. ;;; *** Eventually, we will init from a file or something. -ROOHST: LITSTR [SRI-NIC.ARPA] -ROOADR: 1200,,63 +;;; #### this should be configurable +ROOHST: LITSTR [ONE.ONE.ONE.ONE] +ROOADR: 100,,200401 LVAR DOMLST: 0 ;LP to Domain-level list. @@ -3999,7 +4244,7 @@ MAKD10: CALL WRLOCK ;Seize write lock. MAKELN C,[A$VAL,,[D] ? %LTSTR,,[LITSTR []]] ;The "Root" Domain name. MAKELN B,[A$DOM,,NIL ? %LTLST,,[C]] MOVEM B,DOMLST - MAKELN A,[A$VAL,,NIL ? %LTSTR,,[LITSTR [AI.MIT.EDU]]] + MAKELN A,[A$VAL,,NIL ? %LTSTR,,[LITSTR [CHAOSNET.NET]]] MAKELN B,[A$SOA,,NIL ? %LTLST,,[A]] MAKELN C,[A$VAL,,[B] ? %LTSTR,,[LITSTR [Main Domain List]]] MAKELN A,[A$DB,,[DOMLST] ? %LTLST,,[C]] diff --git a/src/sysnet/resolv.35 b/src/sysnet/resolv.35 index fe59416cc..01dbdc683 100644 --- a/src/sysnet/resolv.35 +++ b/src/sysnet/resolv.35 @@ -3,6 +3,20 @@ SUBTTL RESOLV - Interface to DOMAIN: device +;;; Hacked 2005 by Bjorn Victor. +;;; TODO: +;;; - make the Chaos address domain (for DNS) a config parameter (cf DQDEV) +;;; - search *both* HOSTS3 and QUERY +;;; -- HOSTS3 is faster (since the DNS cache still isn't working) +;;; -- until BIND supports the Chaos class officially, using DNS for Chaos +;;; is awkward (and in many situations after that point too). +;;; - handle configurable default domain for HSTADR (if no . in name) +;;; (DQDEV should handle this) +;;; NOTE: +;;; - unfortunately this isn't fully compatible with NETWRK, so plugging +;;; it into NAME, SUPDUP, TELNET etc may not be so straight-forward. +;;; For NAME, it has been done. + ;;; Initially, this will be very simple and provide minimal ;;; capabilities; as the device and the user software become ;;; more sophisticted, this will change. Eventually this @@ -104,6 +118,7 @@ SUBTTL Routines from NETWRK ;;; GETNET macro to find host address. +ife 0,[ ;; this is what it really should be, but... DEFINE GETNET AC,(ADDR) IFNB [ADDR] MOVE AC,ADDR TLNN AC,(17_32.) ; Check for non-Internet type addrs @@ -113,7 +128,14 @@ IFNB [ADDR] MOVE AC,ADDR TRZA AC,177777 ; Class B network, zap low 2 octets TRZ AC,377 ; Class C net, only zap 1 low octet TERMIN - +] +.else [ +; Be compatible with the kludge in HOSTS3 that reduces the size of the network table. +DEFINE GETNET AC,(ADDR) +IFNB [ADDR] MOVE AC,ADDR + TDZ AC,[<1_24.>-1] +TERMIN +] ;;; OWNHST - Return own Internet host address in A. ;;; A/ network number @@ -146,6 +168,9 @@ CVH3NA: PUSH P,B CAIL B,1000 ; If any of high 3 bits were set, JRST CVH3N3 ; it must be a HOSTS3 strange-fmt addr. JUMPN B,CVH3N2 ; If not zero, then must assume HOSTS2 fmt. +;; Noone uses Arpanet anymore - but some use Chaosnet. +;; Code kept for history. +ifn 0,[ ;; Old-format 8-bit Arpanet host number, or HOSTS2 with zero net. CAILE A,377 JRST CVH3N6 ; If greater than 8 bits, assume HOSTS2, zero net. @@ -153,6 +178,10 @@ CVH3NA: PUSH P,B LSH B,-<2+8.> LSHC A,<2+8.+6> TLO A,(12_24.) ; and add ARPA network number. +] +.else [ + ior a,[nw%chs] +] JRST CVH3N3 ;; HOSTS2 format number CVH3N2: TRZE B,7 ; Zap low 3 bits to ensure correct comparison @@ -200,11 +229,23 @@ SUBTTL HSTADR - Host name to netaddress ;;; Maybe should be expanded to return all possible addresses? ADDRS:: -IFN $$DQCH, CH.A: 440700,,[ASCIZ "DQ:HOSTS3;CH;A;"] -IFN $$DQIN, IN.A: 440700,,[ASCIZ "DQ:HOSTS3;IN;A;"] +;;IFN $$DQCH, CH.A: 440700,,[ASCIZ "DOMAIN:HOSTS3;CH;A;"] +IFN $$DQCH, CH.A: 440700,,[ASCIZ "DOMAIN:QUERY;CH;A;"] +;;IFN $$DQIN, IN.A: 440700,,[ASCIZ "DOMAIN:HOSTS3;IN;PTR;"] +IFN $$DQIN, IN.A: 440700,,[asciz "DOMAIN:QUERY;IN;A;"] NADDRS==.-ADDRS -HSTADN: PUSHER P,[A,B,C,D] ;Must match HSTADR!! +ifndef $$DQSRC,$$DQSRC==1 + +ifn $$DQSRC,[ ;; Domains to search + 440700,,[0] +doms: ;; Add yours here - make it configurable + 440700,,[asciz ".update.uu.se"] + 440700,,[asciz ".chaosnet.net"] +ndoms==.-doms +] + +HSTADN: PUSHER P,[A,B,C,D,E] ;Must match HSTADR!! IFE $$DQRN,{ ;Preserve channel unless hairy version SYSCAL IOPUSH,[%CLIMM,,DQCH] NOP @@ -215,11 +256,21 @@ IFN $$DQCH, CAMN B,[NW%CHS] ? HRROI D, JUMPE D,HSTA99 ;Punt if bad net type JRST HSTAD1 ;Join HSTADR code. -HSTADR: PUSHER P,[A,B,C,D] +HSTADR: PUSHER P,[A,B,C,D,E] IFE $$DQRN,{ ;Preserve channel unless hairy version SYSCAL IOPUSH,[%CLIMM,,DQCH] NOP } +ifn $$DQSRC,[ ;; Domain search + move b,-3(p) ;Check QNAME for dots +hstad0: ildb a,b + cain a,". + jrst [ hrroi e,doms-1 + jrst hsta00 ] ;. found + jumpn a,hstad0 + movsi e,-ndoms +hsta00: +] MOVSI D,-NADDRS ;AOBJN ptr to query commands. HSTAD1: ZAP NAMBUF,NAMBLN ;Clear pathname buffer. MOVE A,[440700,,NAMBUF] ;Cons filename @@ -227,15 +278,111 @@ HSTAD1: ZAP NAMBUF,NAMBLN ;Clear pathname buffer. PUSHJ P,STRCPY ;Stuff it. MOVE B,-3(P) ;Recover QNAME. PUSHJ P,STRCPY ;Stuff it. +ifn $$DQSRC,[ + move b,doms(e) ;pick up domain + pushj p,strcpy +] MOVE A,[440700,,NAMBUF] ;Bp to pathname. PUSHJ P,DOOPEN ;Invoke the resolver JRST [ AOBJN D,HSTAD1 ;Lost, try next class +ifn $$DQSRC, aobjn e,hsta00 ;Try next domain SETOM -3(P) ? JRST HSTA99 ] ;Did all classes, punt SETOM -3(P) ;Paranoia (DQDEV IOT lossage) .IOT DQCH,-3(P) ;Get the address +IFE $$DQCH [ SKIPL -3(P) ;Did we really get anything??? AOS -4(P) ;Won, skip return +] +.else [ + skipge -3(p) + jrst hsta99 + aos -5(p) + trne d,-1 ;Won on first ADDRS entry (Chaos)? + jrst hsta99 + move a,-3(p) + tlo a,(nw%chs) ;Set NW%CHS + movem a,-3(p) +] HSTA99: +IFE $$DQRN,{ + .CLOSE DQCH, ;Tidy up + SYSCAL IOPOP,[%CLIMM,,DQCH] + NOP +} + POPPER P,[E,D,C,B,A] ;Fix acs + POPJ P, + + +SUBTTL HSTMX - Host name to mail exchange + +;;; HSTMX - Resolve host name into address of mail exchange +;;; A/ Bp to (asciz) host name. +;;; +;;; HSTMXN - Resolve host name into mail exchange address on specific network. +;;; A/ Bp to (asciz) host name. +;;; B/ Network number (as returned by GETNET). +;;; +;;; Both return: +;;; +1: Error, +;;; A/ -1 +;;; +2: Success, +;;; A/ HOSTS3 format address. +;;; +;;; Maybe should be expanded to return all possible addresses? + +MADDRS:: +IFN $$DQCH, CH.MX: 440700,,[ASCIZ "DOMAIN:QUERY;CH;MX;"] +IFN $$DQIN, IN.MX: 440700,,[asciz "DOMAIN:QUERY;IN;MX;"] +NMADDRS==.-MADDRS + +.vector mxbuf(mxbln==50.) ;Buffer for MX name + +HSTMXN: PUSHER P,[A,B,C,D] ;Must match HSTMX!! +IFE $$DQRN,{ ;Preserve channel unless hairy version + SYSCAL IOPUSH,[%CLIMM,,DQCH] + NOP +} + SETZ D, ;Cons up appropriate AOBJN pointer +IFN $$DQIN, TLNN B,(NE%UNT) ? HRROI D, +IFN $$DQCH, CAMN B,[NW%CHS] ? HRROI D, + JUMPE D,HSTM99 ;Punt if bad net type + JRST HSTMX1 ;Join HSTMX code. + +HSTMX: PUSHER P,[A,B,C,D] +IFE $$DQRN,{ ;Preserve channel unless hairy version + SYSCAL IOPUSH,[%CLIMM,,DQCH] + NOP +} + MOVSI D,-NMADDRS ;AOBJN ptr to query commands. +HSTMX1: ZAP NAMBUF,NAMBLN ;Clear pathname buffer. + MOVE A,[440700,,NAMBUF] ;Cons filename + MOVE B,MADDRS(D) ;Pick up a command. + PUSHJ P,STRCPY ;Stuff it. + MOVE B,-3(P) ;Recover QNAME. + PUSHJ P,STRCPY ;Stuff it. + MOVE A,[440700,,NAMBUF] ;Bp to pathname. + PUSHJ P,DOOPEN ;Invoke the resolver + JRST [ AOBJN D,HSTMX1 ;Lost, try next class + move a,-3(p) ;Did all classes, try address + pushj p,hstadr + trn + movem a,-3(p) ;save result + JRST HSTM98 ] + MOVE A,[440700,,mxbuf] ;dest Bp. + SETZM mxbuf ;Paranoia, clear string + .IOT DQCH,B ;Get byte count or IOC error + SYSCAL SIOT,[%CLIMM,,DQCH ? A ? B ? %CLERR,,T] ;Snarf string + JRST HSTM99 ;Punt + SETZ B, ;Ascizify result + IDPB B,A + SETOM -3(P) ;Paranoia + move a,[440700,,mxbuf] + pushj p,hstadr ;Resolve name of MX + trn + movem a,-3(p) ;store result +hstm98: SKIPL -3(P) ;Did we really get anything??? + AOS -4(P) ;Won, skip return +HSTM99: IFE $$DQRN,{ .CLOSE DQCH, ;Tidy up SYSCAL IOPOP,[%CLIMM,,DQCH] @@ -255,6 +402,9 @@ SUBTTL HSTSRC - Netaddress into host name. ;;; Non-skip means unknown netaddress. HSTSRC: PUSHER P,[A,B,C,D] ;Save acs (don't change this) + exch a,b ;standardize + PUSHJ P,STDHST ;net + exch a,b ;address IFE $$DQRN,{ SYSCAL IOPUSH,[%CLIMM,,DQCH] NOP @@ -266,13 +416,14 @@ IFE $$DQRN,{ IFN $$DQIN, TLNN C,(NE%UNT) ? MOVEI D,0 ;IP = 0 IFN $$DQCH, CAMN C,[NW%CHS] ? MOVEI D,1 ;CH = 1 JUMPL D,HSTS99 ;Lose if unknown - MOVE B,[440700,,[ASCIZ "DQ:HOSTS3;IN;PTR;"] - 440700,,[ASCIZ "DQ:HOSTS3;CH;PTR;"]](D) + MOVE B,[440700,,[ASCIZ "DOMAIN:QUERY;IN;PTR;"] + 440700,,[ASCIZ "DOMAIN:QUERY;CH;PTR;"]](D) PUSHJ P,STRCPY ;Appropriate initial string MOVE B,-2(P) ;Recover host address PUSHJ P,@[ INAPRT ? CHAPRT ](D) ;Write it as appropriate MOVE B,[440700,,[ASCIZ ".IN-ADDR.ARPA"] - 440700,,[ASCIZ ".CH-ADDR.MIT.EDU"]](D) +;; #### make this a config parameter + 440700,,[ASCIZ ".CH-ADDR.NET"]](D) ;.CH-ADDR.MIT.EDU PUSHJ P,STRCPY ;Appropriate trailing string MOVE A,[440700,,NAMBUF] ;Bp to pathname. PUSHJ P,DOOPEN ;SOPEN or RENMWO as needed @@ -343,8 +494,8 @@ SUBTTL HSTINF - Get machine and opsys type, based on host name ;;; Non-skip means lost for some reason. HINFS:: ;Possible HINFO queries to do -CH.INF: 440700,,[ASCIZ "DQ:HOSTS3;CH;HINFO;"] -IN.INF: 440700,,[ASCIZ "DQ:HOSTS3;IN;HINFO;"] +ifn $$DQCH,CH.INF: 440700,,[ASCIZ "DOMAIN:QUERY;CH;HINFO;"] +ifn $$DQIN,IN.INF: 440700,,[ASCIZ "DOMAIN:QUERY;IN;HINFO;"] NHINFS==.-HINFS ;(Try for Chaos first) HSTINF: PUSHER P,[A,B,C,D] ;(Order is important) @@ -385,6 +536,51 @@ IFE $$DQRN,{ POPJ P, +SUBTTL HSTCAN - Alias into canonical host name. + +;;; HSTCAN - Resolve host alias into canonical name. +;;; A/ Bp for tentative alias +;;; B/ Bp to receive canonical host name +;;; +;;; Skip returns if the host was found, depositing the name down A. +;;; Non-skip means (B) was not an alias + +HSTCAN: PUSHER P,[A,B,C,D] ;Save acs (don't change this) +IFE $$DQRN,{ + SYSCAL IOPUSH,[%CLIMM,,DQCH] + NOP +} + ZAP NAMBUF,NAMBLN ;Clear pathname buffer. + MOVE A,[440700,,NAMBUF] ;Cons up query string + MOVE B,[440700,,[ASCIZ "DOMAIN:QUERY;IN;CNAME;"]] + PUSHJ P,STRCPY ;Appropriate initial string + MOVE B,-3(P) ;Recover host alias name + pushj p,strcpy + MOVE A,[440700,,NAMBUF] ;Bp to pathname. + PUSHJ P,DOOPEN ;SOPEN or RENMWO as needed + JRST HSTL99 ; Host not found - lose! + MOVE A,-2(P) ;Recover dest Bp. + SETZ B, ;Paranoia, clear string + IDPB B,A + MOVE A,-2(P) ;BP again + .IOT DQCH,B ;Get byte count or IOC error + SYSCAL SIOT,[%CLIMM,,DQCH ? A ? B ? %CLERR,,T] ;Snarf string + JRST HSTL99 ;Punt + SETZ B, ;Ascizify result + IDPB B,A + MOVE A,-3(P) ;Once more into the breach... + ILDB B,A ;Get first byte of result + SKIPE B ;Empty? + AOS -4(P) ;Won, skip return +HSTL99: +IFE $$DQRN,{ + .CLOSE DQCH, ;Tidy up + SYSCAL IOPOP,[%CLIMM,,DQCH] + NOP +} + POPPER P,[D,C,B,A] ;Restore acs + POPJ P, + SUBTTL DOOPEN - Do the actual invokation of DQ: device ;;; Opening a DQ: device is expensive. So for them as got lots @@ -409,10 +605,14 @@ SUBTTL DOOPEN - Do the actual invokation of DQ: device DOOPEN: PUSH P,C ;Don't smash needlessly .STATUS DQCH,C ;Check channel state TRNN C,-1 ;Ignore useless bits - .OPEN DQCH,[ (+.UII) ? SETZ ? SETZ] +comment | ;; #### Hmm. + .OPEN DQCH,[ (+.UII) ? SETZ ? SETZ] JFCL ;Open new server if needed - SYSCAL RENMWO,[%CLIMM,,DQCH ? A ? %CLERR,,T] + SYSCAL RENMWO,[%CLIMM+%drimg,,DQCH ? A ? %CLERR,,T] SKIPA ;Look up the data, +| + SYSCAL SOPEN,[ [%DRIMG,,DQCH] ? A ? %CLERR,,T ] + SKIPA IFN $$DQRN,{ ;Winning multi query version? AOS -1(P) ;Yeah, skip return iff won diff --git a/src/sysnet/udplib.5 b/src/sysnet/udplib.5 index ec9b9a8aa..66c0029f3 100644 --- a/src/sysnet/udplib.5 +++ b/src/sysnet/udplib.5 @@ -233,10 +233,11 @@ IFN 0, PKTDPB IP$FLG,[3] ;No fragmentation allowed. PUSHER P,[A,B] SYSCAL NETHST,[%CLIMM,,-1 ? %CLOUT,,T ? %CLOUT,,A] .LOSE %LSFIL - LSHC A,-6 ;Standardize our ARPAnet host number. - LSH B,-<2+8.> ;Put 10 bits spacing between host/imp #s. - LSHC A,<2+8.+6> - TLO A,(12_24.) ;Add ARPA network number. +;[BV] we get the real IP address these days +; LSHC A,-6 ;Standardize our ARPAnet host number. +; LSH B,-<2+8.> ;Put 10 bits spacing between host/imp #s. +; LSHC A,<2+8.+6> +; TLO A,(12_24.) ;Add ARPA network number. MOVE T,A POPPER P,[B,A] LSH T,<36.-32.> ;Get our own host address. From 9d9f129c9ed60769729d24aed233b92e7f2b3f5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Tue, 7 Sep 2021 19:09:06 +0200 Subject: [PATCH 03/21] And make it work --- src/sysnet/resolv.35 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/sysnet/resolv.35 b/src/sysnet/resolv.35 index 01dbdc683..db60091aa 100644 --- a/src/sysnet/resolv.35 +++ b/src/sysnet/resolv.35 @@ -245,7 +245,7 @@ doms: ;; Add yours here - make it configurable ndoms==.-doms ] -HSTADN: PUSHER P,[A,B,C,D,E] ;Must match HSTADR!! +HSTADN: PUSHER P,[E,A,B,C,D] ;Must match HSTADR!! IFE $$DQRN,{ ;Preserve channel unless hairy version SYSCAL IOPUSH,[%CLIMM,,DQCH] NOP @@ -256,7 +256,7 @@ IFN $$DQCH, CAMN B,[NW%CHS] ? HRROI D, JUMPE D,HSTA99 ;Punt if bad net type JRST HSTAD1 ;Join HSTADR code. -HSTADR: PUSHER P,[A,B,C,D,E] +HSTADR: PUSHER P,[E,A,B,C,D] IFE $$DQRN,{ ;Preserve channel unless hairy version SYSCAL IOPUSH,[%CLIMM,,DQCH] NOP @@ -265,7 +265,7 @@ ifn $$DQSRC,[ ;; Domain search move b,-3(p) ;Check QNAME for dots hstad0: ildb a,b cain a,". - jrst [ hrroi e,doms-1 + jrst [ seto e, ;point to doms-1 jrst hsta00 ] ;. found jumpn a,hstad0 movsi e,-ndoms @@ -309,7 +309,7 @@ IFE $$DQRN,{ SYSCAL IOPOP,[%CLIMM,,DQCH] NOP } - POPPER P,[E,D,C,B,A] ;Fix acs + POPPER P,[D,C,B,A,E] ;Fix acs POPJ P, From 39e8858737de938321669e3ddd4e0bcc17022b7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Tue, 7 Sep 2021 19:56:06 +0200 Subject: [PATCH 04/21] Fix for SUPDUP but HSTSIX implementation should go in RESOLV --- src/sysnet/supdup.325 | 45 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/src/sysnet/supdup.325 b/src/sysnet/supdup.325 index d934e5d27..b8fb50fd8 100755 --- a/src/sysnet/supdup.325 +++ b/src/sysnet/supdup.325 @@ -51,6 +51,12 @@ BUFSIZ==200 ;SIZE OF BUFFER CHAOSP: 0 ;NON-ZERO IF CONNECTED THROUGH CHAOS NET USENCP: 0 ;NON-ZERO IF SHOULD USE NCP USETCP: -1 ;NON-ZERO IF SHOULD USE TCP + +DODQ==:1 +ifn DODQ,[ +RESOLV"$$DQCH==:1 +.INSRT SYSNET;RESOLV +] SUBTTL UTILITY PROCEDURES @@ -272,11 +278,23 @@ SUPDU1: MOVEI A,HSTPAG PUSHJ P,NETWRK"HSTMAP ;LOAD IN THE HOSTS3 DATA BASE. .VALUE MOVEI A,JCLBUF +ifn DODQ,[ + hrli a,440700 + pushj p,resolv"hstadr +] +.ELSE [ PUSHJ P,NETWRK"HSTLOOK ;GET HOST NUMBER INTO A, NETWORK NUMBER INTO TT +] JRST [ MOVEI TT,[ASCIZ /Unrecognized host name./] PUSHJ P,OUTSTR JRST DIEDIE] ;LOST MOVEM A,FRNHST ;STASH HOST NUMBER +ifn DODQ,[ + ;; Check if we got a Chaos address + move tt,a ;whatever + tlne a,(resolv"nw%chs) + movsi tt,(netwrk"nw%chs) +] MOVEM TT,NETNUM ;STASH NET NUMBER. .SUSET [.RUNAME,,D] HLLO D,D @@ -318,9 +336,36 @@ USEARP: SKIPE USENCP JRST SUPDU4 ] .VALUE [ASCIZ /:Neither TCP or NCP specified for ARPANET./] SUPDU4: MOVE A,FRNHST +ife DODQ,[ PUSHJ P,NETWRK"HSTSIX ;Get short name of host .VALUE MOVEM A,HSTSIX' ;Save for command prompt +] +.else,[ + ;; should move this to a hstsix in RESOLV + move b,frnhst + move a,[440700,,buffer] ;abuse this temporarily + pushj p,resolv"hstsrc + .value + move a,[440700,,buffer] + move b,[440600,,hstsix'] + setzm hstsix + movei d,6 ;max 6 chars +hs6lp: ildb c,a + cain c,". ;stop at period + setz c, + skipn c + jrst hs6dn + ;; first upcase it + cail c,"a + caile c,"z + skipa + trz c,40 + subi c,40 ;convert to sixbit + idpb c,b + sojg d,hs6lp +hs6dn: setzm buffer ;clean up +] PUSHJ P,NETWRK"HSTUNM ;We don't need HOSTS3 any more .LOSE %LSSYS ; Eh? PUSHJ P,WHOLIN ;PUT NAME OF HOST, NETWORK ON WHOLINE From a47377078cf380790e68b898b06348a5ff6f6f36 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Tue, 7 Sep 2021 20:01:28 +0200 Subject: [PATCH 05/21] Remove comments since that was already implemented. --- src/sysnet/dqdev.182 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/sysnet/dqdev.182 b/src/sysnet/dqdev.182 index 368d1a4d5..7276528d1 100644 --- a/src/sysnet/dqdev.182 +++ b/src/sysnet/dqdev.182 @@ -16,9 +16,6 @@ IF1, TITLE DQDEV - Domain Device ;; DOMAIN:XYZZY;CONFIG;CH-ADDR;CH-ADDR.MIT.EDU - set ch-addr domain ;; DOMAIN:CONFIG;SEARCHLIST - read domain search list ;; DOMAIN:CONFIG;SEARCHLIST;FOO.COM;BAR.ORG - set domain search list -;; Then implement -;; - ch-addr handling (RCHADR, and HSTSRC in RESOLV) -;; - searchlist handling IF2,[ PRINTX / / From 1105b33f622a269d9cf4bcc78f59d200df8ada46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 10:22:12 +0200 Subject: [PATCH 06/21] Implement HSTSIX in RESOLV and use it in SUPDUP --- src/sysnet/resolv.35 | 72 +++++++++++++++++++++++++++++++++++++++++-- src/sysnet/supdup.325 | 31 +++---------------- 2 files changed, 74 insertions(+), 29 deletions(-) diff --git a/src/sysnet/resolv.35 b/src/sysnet/resolv.35 index db60091aa..7684945fa 100644 --- a/src/sysnet/resolv.35 +++ b/src/sysnet/resolv.35 @@ -3,13 +3,12 @@ SUBTTL RESOLV - Interface to DOMAIN: device -;;; Hacked 2005 by Bjorn Victor. +;;; Originally by CStacy. Hacked 2005 by Bjorn Victor, and further improved in 2021. ;;; TODO: ;;; - make the Chaos address domain (for DNS) a config parameter (cf DQDEV) ;;; - search *both* HOSTS3 and QUERY ;;; -- HOSTS3 is faster (since the DNS cache still isn't working) -;;; -- until BIND supports the Chaos class officially, using DNS for Chaos -;;; is awkward (and in many situations after that point too). +;;; -- using DNS for Chaos is a bit awkward, I admit ;;; - handle configurable default domain for HSTADR (if no . in name) ;;; (DQDEV should handle this) ;;; NOTE: @@ -313,6 +312,73 @@ IFE $$DQRN,{ POPJ P, +SUBTTL HSTSIX - Host address to sixbit + +;Given a host number in A, returns a sixbit abbreviation of +;the name of the host, also in A. Clobbers only T and TT. +;Always skip returns. +;Might return 0 in A if it is an unknown IP address. +;If an unknown Chaos address, return 'Cxxxxx' for xxxxx the address. + +;We can't find the shortest alias for the host (since CNAMEs point the +;other way around), so convert the first six ascii bytes of the host name +;(or up to first period). +;Should possibly care about non-representable bytes. + +.vector sixbuf(sxbln==50.) ;Buffer + +hstsix: setz t, + pusher p,[b,c,d] + pushj p,stdhst ;standardize net address + move d,a ;save it + move b,a + move a,[440700,,sixbuf] + pushj p,hstsrc + jrst [ pushj p,nosix ;not found, make it up + move t,b + jrst hs6dn ] + move a,[440700,,sixbuf] + move b,[440600,,t] + movei tt,6 ;max 6 chars +hs6lp: ildb c,a + caie c,". ;stop at period + skipn c ;or end of string + jrst hs6dn + ;; first upcase it + cail c,"a + caile c,"z + skipa + trz c,40 + subi c,40 ;convert to sixbit + idpb c,b + sojg tt,hs6lp +hs6dn: popper p,[d,c,b] + move a,t + aos (p) + popj p, + +;; no name found, make one up (see NETWRK"HSTSX9) in B +;; Make it 'Cxxxxx' where xxxxx is the octal Chaos address +;; Might clobber C, for large addresses. +nosix: getnet tt,d + setz b, + came tt,[nw%chs] + jrst hs6dn ;Can't possibly fit IP in sixbit + movei tt,'C + move a,[440600,,b] + idpb tt,a + move t,d + andi t,177777 ;Mask out gubbish bits +nosix1: setz tt, + idivi t,8. + push p,tt + skipe t + pushj p,nosix1 + pop p,tt + addi tt,'0 ;make it sixbit + idpb tt,a + popj p, + SUBTTL HSTMX - Host name to mail exchange ;;; HSTMX - Resolve host name into address of mail exchange diff --git a/src/sysnet/supdup.325 b/src/sysnet/supdup.325 index b8fb50fd8..0ca14d6d5 100755 --- a/src/sysnet/supdup.325 +++ b/src/sysnet/supdup.325 @@ -52,7 +52,8 @@ CHAOSP: 0 ;NON-ZERO IF CONNECTED THROUGH CHAOS NET USENCP: 0 ;NON-ZERO IF SHOULD USE NCP USETCP: -1 ;NON-ZERO IF SHOULD USE TCP -DODQ==:1 +;; default off. Compile with /T to input DODQ==:1 +ifndef DODQ,DODQ==:0 ifn DODQ,[ RESOLV"$$DQCH==:1 .INSRT SYSNET;RESOLV @@ -338,34 +339,12 @@ USEARP: SKIPE USENCP SUPDU4: MOVE A,FRNHST ife DODQ,[ PUSHJ P,NETWRK"HSTSIX ;Get short name of host - .VALUE - MOVEM A,HSTSIX' ;Save for command prompt ] .else,[ - ;; should move this to a hstsix in RESOLV - move b,frnhst - move a,[440700,,buffer] ;abuse this temporarily - pushj p,resolv"hstsrc - .value - move a,[440700,,buffer] - move b,[440600,,hstsix'] - setzm hstsix - movei d,6 ;max 6 chars -hs6lp: ildb c,a - cain c,". ;stop at period - setz c, - skipn c - jrst hs6dn - ;; first upcase it - cail c,"a - caile c,"z - skipa - trz c,40 - subi c,40 ;convert to sixbit - idpb c,b - sojg d,hs6lp -hs6dn: setzm buffer ;clean up + pushj p,resolv"hstsix ] + .VALUE + MOVEM A,HSTSIX' ;Save for command prompt PUSHJ P,NETWRK"HSTUNM ;We don't need HOSTS3 any more .LOSE %LSSYS ; Eh? PUSHJ P,WHOLIN ;PUT NAME OF HOST, NETWORK ON WHOLINE From 96f35243be7ecb12c4d05fdf944ce15722c34695 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 10:22:41 +0200 Subject: [PATCH 07/21] Default DODQ==0 for simplicity etc --- src/sysen2/name.558 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 index 0d2cfbc36..20c8451e6 100755 --- a/src/sysen2/name.558 +++ b/src/sysen2/name.558 @@ -264,7 +264,8 @@ $$ANALYZ==1 .INSRT SYSTEM;CHSDEF .INSRT SYSENG;NETWRK -DODQ==:1 +;; default off. Compile with /T to input DODQ==:1 +ifndef DODQ,DODQ==:0 ifn DODQ,[ RESOLV"$$DQCH==:1 .INSRT SYSNET;RESOLV From 50800b20de089b7b8f4085bb1da63f97e018fe9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 10:23:15 +0200 Subject: [PATCH 08/21] Modernize Chaos address domain --- src/sysnet/dqxdev.42 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/sysnet/dqxdev.42 b/src/sysnet/dqxdev.42 index b5709b8df..60b247ffc 100644 --- a/src/sysnet/dqxdev.42 +++ b/src/sysnet/dqxdev.42 @@ -386,7 +386,7 @@ qt.ptr: move a,qclass ; which type of foo-ADDR are we lookinf for? call strlen move a,t ; save that move b,[440700,,[asciz ".IN-ADDR.ARPA"] ; trailer string - 440700,,[asciz ".CH-ADDR.MIT.EDU"]](x) + 440700,,[asciz ".CH-ADDR.NET"]](x) move t,b ; get its length call strlen sub a,t ; get difference From 11e86cad1ebfae8c40eda066dd0627466d70ab5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 10:23:52 +0200 Subject: [PATCH 09/21] Test program for DQDEV --- src/sysnet/dig.1 | 145 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 src/sysnet/dig.1 diff --git a/src/sysnet/dig.1 b/src/sysnet/dig.1 new file mode 100644 index 000000000..19832e431 --- /dev/null +++ b/src/sysnet/dig.1 @@ -0,0 +1,145 @@ +; -*- Mode: Midas -*- + +title DIG in the DNS for info + +X=0 ;Super temporary register. +A=1 ;General +B=2 ; purpose +C=3 ; utility +D=4 +E=5 +F=6 ;Flag register. +T=7 ;Temporary. +TT=10 ;Temporary, T+1. +oc=:12 +u1=:13 +u2=:14 +u3=:15 +u4=:16 + +P=17 ;Stack pointer. + +tyoc==1 +out"$$OERR==1 ;OUT: include error code +errchn=2 ;define error channel +DQCH==14 ;for resolv + +ascbp==440700 + +.insrt ksc;macros > +$$DQCH==1 +$$DQRN==1 +.insrt sysnet;resolv > +.insrt syseng;t20mac > +.insrt klh;out + +DEFINE ZAP LOC,LEN +SETZM LOC +MOVE T,[LOC,,LOC+1] +BLT T,LOC+LEN-1 +TERMIN + +typebk: setz + sixbit /SIOT/ + c ? t ? setz tt + +PDLSIZ==120 ; Stack size +PDL: BLOCK PDLSIZ ; Push down stack +jcl: block 100 +name: block 100 + +;; required by OUT +autpsy: 0 + sos t,autpsy + hrlz t,t + hrri t,%lsfil + syscal lose,[t ? autpsy] + trn + .value + .logout 1, + +;; Get JCL +getjcl: zap jcl,100 + zap name,100 + pushae p,[t,tt,a] + move tt,[ascbp,,jcl] + move t,[ascbp,,[asciz "DOMAIN:NQUERY;"]] + do. + ildb a,t + skipn a + exit. + idpb a,tt + loop. + enddo. + .break 12,[..rjcl,,name] + skipn name + jrst gotjcl + move t,[ascbp,,name] + do. + ildb a,t + cain a,^M + setz a, ;zap CR + idpb a,tt + skipe a + loop. + enddo. + aos -3(p) +gotjcl:: + popae p,[a,tt,t] + ret + +go: MOVE P,[-pdlsiz,,pdl] + .open tyoc,[.uao,,'TTY] + .lose %lsfil + out(tyoc,open(UC$IOT)) + out(,ch(tyoc)) + call getjcl + jrst usage + out(,("Looking for "),tz(name),eol) + move a,[ascbp,,jcl] + syscal sopen,[[.uai,,dqch] ? a ? %clerr,,e] ;open domain + ifnsk. +;; .lose %lsfil + ;; Interpret error codes specially + setz tt, + cain e,%ensfl + movei tt,[asciz "Name error"] + cain e,%ensjb + movei tt,[asciz "Resource not found"] + cain e,%enrdv + movei tt,[asciz "Server not available"] + cain e,%enadv + movei tt,[asciz "Local database problem"] + cain e,%ebdfn + movei tt,[asciz "Format error"] + cain e,17 ;%ENADR + movei tt,[asciz "Unknown class"] + cain e,%ensdr + movei tt,[asciz "Unknown type"] + cain e,%enapk + movei tt,[asciz "Authoritative data unavailable"] + skipe tt + ifnsk. + hrli tt,ascbp + out(,("Error from DNS: "),tpz(tt),eol) + caie e,%ebdfn + ifskp. +usage:: out(,("Usage: :DIG class;type;name"),eol,(" e.g. :DIG in;a;ftp.its.os.org"),eol) + endif. + .logout 1, + else. + out(,("Error: "),err,eol) + .value + endif. + endif. +rdrr:: syscall iot,[%climm,,dqch ? b ] ;read a char + .lose %lsfil + skipge b ;EOF: -1,,^C + .logout 1, + .iot tyoc,b ;echo + jrst rdrr + + +;; to create a fresh database, :print domain:xyzzy;..new. (dat) + +end go \ No newline at end of file From 3c3d3ec71869114eacbc4135db660359f8d86d0d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 10:55:40 +0200 Subject: [PATCH 10/21] Try HOSTS3 first, then DNS --- src/sysen2/name.558 | 89 +++++++++++++++++++++++---------------------- 1 file changed, 46 insertions(+), 43 deletions(-) diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 index 20c8451e6..f04e846f9 100755 --- a/src/sysen2/name.558 +++ b/src/sysen2/name.558 @@ -814,20 +814,8 @@ fjcl55: movem a,hstcur ;store # as current host. typi "[ push p,b move b,a -ifn DODQ,[ - move a,[440700,,hanlst] - pushj p,resolv"hstsrc - jrst [ move a,hstcur - pushj p,typehn - jrst fjcl56 ] - movei a,hanlst -] -.else,[ pushj p,netwrk"hstsrc - jrst [ move a,hstcur - pushj p,typehn - jrst fjcl56 ] -] + pushj p,fjcl57 typz (a) ;type official name of site. fjcl56: pop p,b typi "] @@ -923,6 +911,20 @@ fjcl70: pushj p,hicp ;try to perform ICP. fjcl72: pushj p,netin ;go copy net input to TTY jrst fjcl ;when done, go back for more sites. +fjcl57: +ifn DODQ,[ + move a,[440700,,hanlst] + pushj p,resolv"hstsrc + jrst fjcl58 + movei a,hanlst + popj p, +fjcl58: +] + move a,hstcur + pushj p,typehn + pop p, + jrst fjcl56 + ;initialize for a pass through JCL jclbeg: push p,a move a,ownhst ; initial "sticky site" is local. @@ -1110,14 +1112,20 @@ hstlook: movei a,(p) ;B may contain host name in asciz, tlnn b,-1 ;or if lh is 0, it is address of asciz string. move a,b + pushj p,netwrk"hstlook ;convert to host number. ifn DODQ,[ - hrli a,440700 - pushj p,resolv"hstadr + jrst [ move b,(p) ;netwrk"hstlook might have clobbered + movei a,(p) + tlnn b,-1 + move a,b + hrli a,440700 + pushj p,resolv"hstadr + setz a, + jrst .+1 ] ] .else,[ - pushj p,netwrk"hstlook ;convert to host number. -] setz a, +] move b,a ;return that in B. sub p,[1,,1] pop p,e @@ -3608,36 +3616,31 @@ HANLY0: ILDB T,B SOJG D,HANLY0 HANLY1: IDPB D,C MOVEI A,HANLST -ifn DODQ,[ - hrli a,440700 - pushj p,resolv"hstadr - JRST [ SKIPN ITBARF - JRST HANLY9 - TYPZ CRLF - TYPI "[ - movei a,hanlst - TYPZ (A) - TYPZ [ASCIZ " is an unknown host]"] - TYPZ CRLF - TYPZ CRLF - JRST HANLY9 ] -] -.else,[ PUSHJ P,NETWRK"HSTLOOK - JRST [ SKIPN ITBARF - JRST HANLY9 - TYPZ CRLF - TYPI "[ - TYPZ (A) - TYPZ [ASCIZ " is an unknown host]"] - TYPZ CRLF - TYPZ CRLF - JRST HANLY9 ] -] - AOS -6(P) + jrst hanlDQ +HANLY2: AOS -6(P) HANLY9: POPAE P,[TT,T,E,D,C,B] POPJ P, +hanlDQ: +ifn DODQ,[ + move a,[440700,,hanlst] ;might be clobbered + pushj p,resolv"hstadr + skipa + jrst HANLY2 +] + SKIPN ITBARF + JRST HANLY9 + TYPZ CRLF + TYPI "[ + movei a,hanlst ;might be clobbered + TYPZ (A) + TYPZ [ASCIZ " is an unknown host]"] + TYPZ CRLF + TYPZ CRLF + JRST HANLY9 + + ;;; tcp support routines tcplsn: syscal tcpopn,[movei 1(a) ? movei 2(a) From 2087a62d67e4bc91d8b04e68dccf9abae0d3f9c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 11:24:01 +0200 Subject: [PATCH 11/21] Try HOSTS3 first, then DNS But for now, use only the HSTSIX of NETWRK (HOSTS3) since it's faster and hard to tell if it failed. --- src/sysnet/supdup.325 | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/sysnet/supdup.325 b/src/sysnet/supdup.325 index 0ca14d6d5..788bbf1f6 100755 --- a/src/sysnet/supdup.325 +++ b/src/sysnet/supdup.325 @@ -279,23 +279,26 @@ SUPDU1: MOVEI A,HSTPAG PUSHJ P,NETWRK"HSTMAP ;LOAD IN THE HOSTS3 DATA BASE. .VALUE MOVEI A,JCLBUF -ifn DODQ,[ - hrli a,440700 - pushj p,resolv"hstadr -] -.ELSE [ PUSHJ P,NETWRK"HSTLOOK ;GET HOST NUMBER INTO A, NETWORK NUMBER INTO TT +ifn DODQ,[ + ;; NETWRK failed, try DNS + jrst [ move a,[440700,,jclbuf] + pushj p,resolv"hstadr + jrst [ MOVEI TT,[ASCIZ /Unrecognized host name./] + PUSHJ P,OUTSTR + JRST DIEDIE] ;LOST + ;; Check if we got a Chaos address, for NETNUM + move tt,a ;whatever + tlne a,(resolv"nw%chs) + movsi tt,(netwrk"nw%chs) + jrst .+1 ] ] +.ELSE,[ JRST [ MOVEI TT,[ASCIZ /Unrecognized host name./] PUSHJ P,OUTSTR JRST DIEDIE] ;LOST - MOVEM A,FRNHST ;STASH HOST NUMBER -ifn DODQ,[ - ;; Check if we got a Chaos address - move tt,a ;whatever - tlne a,(resolv"nw%chs) - movsi tt,(netwrk"nw%chs) ] + MOVEM A,FRNHST ;STASH HOST NUMBER MOVEM TT,NETNUM ;STASH NET NUMBER. .SUSET [.RUNAME,,D] HLLO D,D @@ -337,10 +340,11 @@ USEARP: SKIPE USENCP JRST SUPDU4 ] .VALUE [ASCIZ /:Neither TCP or NCP specified for ARPANET./] SUPDU4: MOVE A,FRNHST -ife DODQ,[ PUSHJ P,NETWRK"HSTSIX ;Get short name of host -] -.else,[ +ifn 0,[ + ;; This is slower than HSTSIX, but that always skip returns + ;; so it's hard to see if it failed to find a real name. + ;; Punt and use NETWRK"HSTSIX for now. pushj p,resolv"hstsix ] .VALUE From be2f0f2865153175f2f06bdc374bd533c7c7a8b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 12:55:48 +0200 Subject: [PATCH 12/21] Let RESOLV be configurable using $$DQDQ which decides whether to use DQ: (DQXDEV) or DOMAIN: (DQDEV). Default DQ:. Support that in NAME, SUPDUP and COMSAT. --- src/sysen2/name.558 | 3 ++- src/sysnet/comsat.584 | 1 + src/sysnet/resolv.35 | 59 ++++++++++++++++++++++++++++++++----------- src/sysnet/supdup.325 | 3 ++- 4 files changed, 49 insertions(+), 17 deletions(-) diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 index f04e846f9..fa1864a7a 100755 --- a/src/sysen2/name.558 +++ b/src/sysen2/name.558 @@ -267,7 +267,8 @@ $$ANALYZ==1 ;; default off. Compile with /T to input DODQ==:1 ifndef DODQ,DODQ==:0 ifn DODQ,[ -RESOLV"$$DQCH==:1 +RESOLV"$$DQDQ==:0 ;use DOMAIN: +RESOLV"$$DQCH==:1 ;handle Chaosnet .INSRT SYSNET;RESOLV ] diff --git a/src/sysnet/comsat.584 b/src/sysnet/comsat.584 index a8b62d7ee..cff93ff62 100644 --- a/src/sysnet/comsat.584 +++ b/src/sysnet/comsat.584 @@ -159,6 +159,7 @@ $$DQ==1 ; Domain interface code in use (mostly for NETRTS) $$DQRN==1 ; Use RENMWO hack to cut down on resolver overhead ;; These are IFNDEFs for now so that I can play with them without ;; editing the sources every time. +IFNDEF $$DQDQ,$$DQDQ==1 ; RESOLV uses "fake" DQ device instead of DOMAIN device IFNDEF $$DQCH,$$DQCH==1 ; RESOLV is allowed to find Chaosnet addresses IFNDEF $$DQIN,$$DQIN==1 ; RESOLV is allowed to find Internet addresses ;; $$DQIN should be turned off as soon as the NAMES > files etc can be diff --git a/src/sysnet/resolv.35 b/src/sysnet/resolv.35 index 7684945fa..4f616a88e 100644 --- a/src/sysnet/resolv.35 +++ b/src/sysnet/resolv.35 @@ -1,20 +1,25 @@ ;;; -*- Mode:MIDAS -*- .AUXIL -SUBTTL RESOLV - Interface to DOMAIN: device +SUBTTL RESOLV - Interface to DQ/DOMAIN: device -;;; Originally by CStacy. Hacked 2005 by Bjorn Victor, and further improved in 2021. +;;; Original by CStacy. Hacked 2005 by Bjorn Victor, and further improved in 2021. +;;; +;;; To use the DOMAIN device which uses DNS, define $$DQDQ==0. +;;; Otherwise, and by default, the "fake" DQ device is used +;;; (see SYSNET;DQXDEV), which is an interface to the HOSTS3 tables. +;;; ;;; TODO: ;;; - make the Chaos address domain (for DNS) a config parameter (cf DQDEV) -;;; - search *both* HOSTS3 and QUERY +;;; - search *both* HOSTS3 and QUERY (this is done by NAME and SUPDUP, now) ;;; -- HOSTS3 is faster (since the DNS cache still isn't working) ;;; -- using DNS for Chaos is a bit awkward, I admit ;;; - handle configurable default domain for HSTADR (if no . in name) ;;; (DQDEV should handle this) ;;; NOTE: ;;; - unfortunately this isn't fully compatible with NETWRK, so plugging -;;; it into NAME, SUPDUP, TELNET etc may not be so straight-forward. -;;; For NAME, it has been done. +;;; it into old programs may not be so straight-forward. +;;; For NAME, SUPDUP, and COMSAT it has been done. ;;; Initially, this will be very simple and provide minimal ;;; capabilities; as the device and the user software become @@ -47,6 +52,9 @@ PRINTX / included in this assembly. %DROJB==:100000 ;2.7 Magical OJB device protocol %DRXXX==:200\400\1000\2000\4000\10000\20000 +;;; Default to use old fake DQ device (DQXDEV) instead of new DOMAIN device (DQDEV) +ifndef $$DQDQ, $$DQDQ==1 + ;;; Default to not using RENMWO hack on DQ: device. IFNDEF $$DQRN, $$DQRN==0 @@ -228,19 +236,24 @@ SUBTTL HSTADR - Host name to netaddress ;;; Maybe should be expanded to return all possible addresses? ADDRS:: -;;IFN $$DQCH, CH.A: 440700,,[ASCIZ "DOMAIN:HOSTS3;CH;A;"] +ifn $$DQDQ,[ +IFN $$DQCH, CH.A: 440700,,[ASCIZ "DQ:HOSTS3;CH;A;"] +IFN $$DQIN, IN.A: 440700,,[ASCIZ "DQ:HOSTS3;IN;A;"] +] +.else,[ IFN $$DQCH, CH.A: 440700,,[ASCIZ "DOMAIN:QUERY;CH;A;"] -;;IFN $$DQIN, IN.A: 440700,,[ASCIZ "DOMAIN:HOSTS3;IN;PTR;"] IFN $$DQIN, IN.A: 440700,,[asciz "DOMAIN:QUERY;IN;A;"] +] NADDRS==.-ADDRS +;; Implement domain search list - this should be in DQDEV instead. ifndef $$DQSRC,$$DQSRC==1 ifn $$DQSRC,[ ;; Domains to search 440700,,[0] doms: ;; Add yours here - make it configurable - 440700,,[asciz ".update.uu.se"] - 440700,,[asciz ".chaosnet.net"] + 440700,,[asciz ".UPDATE.UU.SE"] + 440700,,[asciz ".CHAOSNET.NET"] ndoms==.-doms ] @@ -379,6 +392,7 @@ nosix1: setz tt, idpb tt,a popj p, +ife $DQDQ,[ ;; only if real DOMAIN device, i.e using DNS SUBTTL HSTMX - Host name to mail exchange ;;; HSTMX - Resolve host name into address of mail exchange @@ -456,7 +470,7 @@ IFE $$DQRN,{ } POPPER P,[D,C,B,A] ;Fix acs POPJ P, - +]; $DQDQ SUBTTL HSTSRC - Netaddress into host name. @@ -482,8 +496,14 @@ IFE $$DQRN,{ IFN $$DQIN, TLNN C,(NE%UNT) ? MOVEI D,0 ;IP = 0 IFN $$DQCH, CAMN C,[NW%CHS] ? MOVEI D,1 ;CH = 1 JUMPL D,HSTS99 ;Lose if unknown +ifn $DQDQ,[ + MOVE B,[440700,,[ASCIZ "DQ:HOSTS3;IN;PTR;"] + 440700,,[ASCIZ "DQ:HOSTS3;CH;PTR;"]](D) +] +.else,[ MOVE B,[440700,,[ASCIZ "DOMAIN:QUERY;IN;PTR;"] 440700,,[ASCIZ "DOMAIN:QUERY;CH;PTR;"]](D) +] PUSHJ P,STRCPY ;Appropriate initial string MOVE B,-2(P) ;Recover host address PUSHJ P,@[ INAPRT ? CHAPRT ](D) ;Write it as appropriate @@ -560,8 +580,14 @@ SUBTTL HSTINF - Get machine and opsys type, based on host name ;;; Non-skip means lost for some reason. HINFS:: ;Possible HINFO queries to do +ifn $$DQDQ,[ +CH.INF: 440700,,[ASCIZ "DQ:HOSTS3;CH;HINFO;"] +IN.INF: 440700,,[ASCIZ "DQ:HOSTS3;IN;HINFO;"] +] +.else,[ ifn $$DQCH,CH.INF: 440700,,[ASCIZ "DOMAIN:QUERY;CH;HINFO;"] ifn $$DQIN,IN.INF: 440700,,[ASCIZ "DOMAIN:QUERY;IN;HINFO;"] +] NHINFS==.-HINFS ;(Try for Chaos first) HSTINF: PUSHER P,[A,B,C,D] ;(Order is important) @@ -602,6 +628,7 @@ IFE $$DQRN,{ POPJ P, +ife $$DQDQ,[ ;; only for DOMAIN device, not DQ - but this should be doable there too SUBTTL HSTCAN - Alias into canonical host name. ;;; HSTCAN - Resolve host alias into canonical name. @@ -646,6 +673,7 @@ IFE $$DQRN,{ } POPPER P,[D,C,B,A] ;Restore acs POPJ P, +]; $$DQDQ SUBTTL DOOPEN - Do the actual invokation of DQ: device @@ -671,15 +699,16 @@ SUBTTL DOOPEN - Do the actual invokation of DQ: device DOOPEN: PUSH P,C ;Don't smash needlessly .STATUS DQCH,C ;Check channel state TRNN C,-1 ;Ignore useless bits -comment | ;; #### Hmm. - .OPEN DQCH,[ (+.UII) ? SETZ ? SETZ] +ifn $$DQDQ,[ + .OPEN DQCH,[ (+.UII) ? SETZ ? SETZ] JFCL ;Open new server if needed - SYSCAL RENMWO,[%CLIMM+%drimg,,DQCH ? A ? %CLERR,,T] + SYSCAL RENMWO,[%CLIMM,,DQCH ? A ? %CLERR,,T] SKIPA ;Look up the data, -| +] +.else,[ SYSCAL SOPEN,[ [%DRIMG,,DQCH] ? A ? %CLERR,,T ] SKIPA - +] IFN $$DQRN,{ ;Winning multi query version? AOS -1(P) ;Yeah, skip return iff won } .ELSE { ;Losing cretinous version? diff --git a/src/sysnet/supdup.325 b/src/sysnet/supdup.325 index 788bbf1f6..70c26e8d2 100755 --- a/src/sysnet/supdup.325 +++ b/src/sysnet/supdup.325 @@ -55,7 +55,8 @@ USETCP: -1 ;NON-ZERO IF SHOULD USE TCP ;; default off. Compile with /T to input DODQ==:1 ifndef DODQ,DODQ==:0 ifn DODQ,[ -RESOLV"$$DQCH==:1 +RESOLV"$$DQDQ==:0 ;use DOMAIN: +RESOLV"$$DQCH==:1 ;handle Chaosnet .INSRT SYSNET;RESOLV ] From f00488b855b58f051afb61240478ed2bf6e1f352 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 13:18:59 +0200 Subject: [PATCH 13/21] Some documentation and rename DODQ to DODNS for a little less confusion. --- doc/networking.md | 39 ++++++++++++++++++++++++++++++++++++++- src/sysen2/name.558 | 16 ++++++++-------- src/sysnet/supdup.325 | 8 ++++---- 3 files changed, 50 insertions(+), 13 deletions(-) diff --git a/doc/networking.md b/doc/networking.md index db037df26..01ccd295a 100644 --- a/doc/networking.md +++ b/doc/networking.md @@ -52,7 +52,44 @@ If you use Chaosnet, you may be interested in joining the Global Chaosnet: read more about it at https://chaosnet.net. ## DNS -Check out this [external guide](https://its.victor.se/wiki/dqdev) +To make ITS use DNS like a modern netizen, you need to do the following: + +1. Compile the handler for the DOMAIN: device, which interfaces to DNS. + ``` + :midas device;jobdev domain,sysnet;dqdev + ``` +2. Compile NAME and SUPDUP with a switch to use RESOLV library routines (with DNS support) if the NETWRK library routines (which uses HOSTS3 tables) fail. (`^C` below is Control-C.) + ``` + :midas sysbin;name_sysen2;/t + DODNS==1 + ^C + :midas sysbin;supdup_sysnet;/t + DODNS==1 + ^C + ``` +3. Purify NAME. (`$` below is Escape.) + ``` + name$j + $l sysbin;name + debug[ 0 + $g + ``` +4. Compile COMSAT (the mail daemon) with a switch to use DOMAIN instead of DQ. (The "Limit to KA-10 instructions" question should be responded with "y" if you are using a KA-10, of course.) + ``` + :midas .mail.;comsat_sysnet;/t + $$DQDQ==0 + ^C + Limit to KA-10 instructions: n + ``` +5. Make sure your ITS system can reach a DNS resolver which allows recursive queries. + If you don't use Chaosnet, the default resolver in DQDEV, 1.1.1.1, should work fine as long as packets from ITS reach it. + You might find the `iptables` incantation below useful: + ``` + iptables -I PREROUTING -t nat -s $YOUR_KLH10_ITS_IP -p udp --dport 53 -j DNAT --to-destination $YOUR_DNS_RESOLVER + ``` + + If you use Chaosnet, you need a DNS resolver which knows how to find Chaosnet data, e.g. from the server at DNS.Chaosnet.NET (which does NOT allow recursion). + Get in touch and I'll help you! ## Mail Check out this [external guide](https://its.victor.se/wiki/mail-setup) diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 index fa1864a7a..aefde7653 100755 --- a/src/sysen2/name.558 +++ b/src/sysen2/name.558 @@ -264,9 +264,9 @@ $$ANALYZ==1 .INSRT SYSTEM;CHSDEF .INSRT SYSENG;NETWRK -;; default off. Compile with /T to input DODQ==:1 -ifndef DODQ,DODQ==:0 -ifn DODQ,[ +;; default off. Compile with /T to input DODNS==:1 +ifndef DODNS,DODNS==:0 +ifn DODNS,[ RESOLV"$$DQDQ==:0 ;use DOMAIN: RESOLV"$$DQCH==:1 ;handle Chaosnet .INSRT SYSNET;RESOLV @@ -913,7 +913,7 @@ fjcl72: pushj p,netin ;go copy net input to TTY jrst fjcl ;when done, go back for more sites. fjcl57: -ifn DODQ,[ +ifn DODNS,[ move a,[440700,,hanlst] pushj p,resolv"hstsrc jrst fjcl58 @@ -1114,7 +1114,7 @@ hstlook: tlnn b,-1 ;or if lh is 0, it is address of asciz string. move a,b pushj p,netwrk"hstlook ;convert to host number. -ifn DODQ,[ +ifn DODNS,[ jrst [ move b,(p) ;netwrk"hstlook might have clobbered movei a,(p) tlnn b,-1 @@ -2557,7 +2557,7 @@ prthsc: push p,b jrst [ ;6typ hstsix ;Print out its sixbit name. pop p,b jrst prths1 ] -ifn DODQ,[ +ifn DODNS,[ ;;; If TELSER only has numeric address (1.2.3.4), try resolving the FHOST push p,a move a,[440700,,hstnam] @@ -2621,7 +2621,7 @@ prthc3: ildb c,b prthst: push p,b push p,c push p,d -ifn DODQ,[ +ifn DODNS,[ ;;; If TELSER only has numeric address (1.2.3.4), try resolving the FHOST push p,a move a,[440700,,hstnam] @@ -3624,7 +3624,7 @@ HANLY9: POPAE P,[TT,T,E,D,C,B] POPJ P, hanlDQ: -ifn DODQ,[ +ifn DODNS,[ move a,[440700,,hanlst] ;might be clobbered pushj p,resolv"hstadr skipa diff --git a/src/sysnet/supdup.325 b/src/sysnet/supdup.325 index 70c26e8d2..28c6a01b8 100755 --- a/src/sysnet/supdup.325 +++ b/src/sysnet/supdup.325 @@ -52,9 +52,9 @@ CHAOSP: 0 ;NON-ZERO IF CONNECTED THROUGH CHAOS NET USENCP: 0 ;NON-ZERO IF SHOULD USE NCP USETCP: -1 ;NON-ZERO IF SHOULD USE TCP -;; default off. Compile with /T to input DODQ==:1 -ifndef DODQ,DODQ==:0 -ifn DODQ,[ +;; default off. Compile with /T to input DODNS==:1 +ifndef DODNS,DODNS==:0 +ifn DODNS,[ RESOLV"$$DQDQ==:0 ;use DOMAIN: RESOLV"$$DQCH==:1 ;handle Chaosnet .INSRT SYSNET;RESOLV @@ -281,7 +281,7 @@ SUPDU1: MOVEI A,HSTPAG .VALUE MOVEI A,JCLBUF PUSHJ P,NETWRK"HSTLOOK ;GET HOST NUMBER INTO A, NETWORK NUMBER INTO TT -ifn DODQ,[ +ifn DODNS,[ ;; NETWRK failed, try DNS jrst [ move a,[440700,,jclbuf] pushj p,resolv"hstadr From 08965d7d13b102c1ed715e4f87122a8bb9eaf494 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Wed, 8 Sep 2021 13:21:13 +0200 Subject: [PATCH 14/21] Update networking.md --- doc/networking.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/networking.md b/doc/networking.md index 01ccd295a..5115b070f 100644 --- a/doc/networking.md +++ b/doc/networking.md @@ -89,7 +89,7 @@ To make ITS use DNS like a modern netizen, you need to do the following: ``` If you use Chaosnet, you need a DNS resolver which knows how to find Chaosnet data, e.g. from the server at DNS.Chaosnet.NET (which does NOT allow recursion). - Get in touch and I'll help you! + Get in touch and I'll help you (@bictorv)! ## Mail Check out this [external guide](https://its.victor.se/wiki/mail-setup) From 8aa11a732505131cbd04a14eb9d64c7c2fceb447 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Thu, 9 Sep 2021 09:05:29 +0200 Subject: [PATCH 15/21] Minor fixes. --- doc/networking.md | 22 ++++++++++++++++++---- src/sysen2/name.558 | 16 ++++++++-------- src/sysnet/dig.1 | 1 + src/sysnet/dqdev.182 | 2 +- src/sysnet/supdup.325 | 8 ++++---- 5 files changed, 32 insertions(+), 17 deletions(-) diff --git a/doc/networking.md b/doc/networking.md index 5115b070f..55b61bc31 100644 --- a/doc/networking.md +++ b/doc/networking.md @@ -52,19 +52,23 @@ If you use Chaosnet, you may be interested in joining the Global Chaosnet: read more about it at https://chaosnet.net. ## DNS -To make ITS use DNS like a modern netizen, you need to do the following: +To make ITS use DNS like a modern netizen, you need to do the following. The result will be that the `H3TEXT` table mentioned above will be consulted first, but if it doesn't contain the info you need, DNS will be used. 1. Compile the handler for the DOMAIN: device, which interfaces to DNS. ``` :midas device;jobdev domain,sysnet;dqdev ``` +2. Initialize the database for DOMAIN: + ``` + :print domain:xyzzy;..new. (dat) + ``` 2. Compile NAME and SUPDUP with a switch to use RESOLV library routines (with DNS support) if the NETWRK library routines (which uses HOSTS3 tables) fail. (`^C` below is Control-C.) ``` :midas sysbin;name_sysen2;/t - DODNS==1 + DNSP==1 ^C :midas sysbin;supdup_sysnet;/t - DODNS==1 + DNSP==1 ^C ``` 3. Purify NAME. (`$` below is Escape.) @@ -74,7 +78,7 @@ To make ITS use DNS like a modern netizen, you need to do the following: debug[ 0 $g ``` -4. Compile COMSAT (the mail daemon) with a switch to use DOMAIN instead of DQ. (The "Limit to KA-10 instructions" question should be responded with "y" if you are using a KA-10, of course.) +4. Compile COMSAT (the mail daemon) with a switch to use DOMAIN instead of DQ. In this case, *only* DNS will be used, not the HOSTS3 tables. (The "Limit to KA-10 instructions" question should be responded with "y" if you are using a KA-10, of course.) ``` :midas .mail.;comsat_sysnet;/t $$DQDQ==0 @@ -90,6 +94,16 @@ To make ITS use DNS like a modern netizen, you need to do the following: If you use Chaosnet, you need a DNS resolver which knows how to find Chaosnet data, e.g. from the server at DNS.Chaosnet.NET (which does NOT allow recursion). Get in touch and I'll help you (@bictorv)! +6. You may want to compile DIG, a test program: + ``` + :midas sysbin;dig_sysnet; + :link sys;ts dig,sysbin;dig bin + :dig in;a;hactrn.org + :dig ch;hinfo;up.update.uu.se + ``` + +So far, you can configure some parameters by editing the code: +- The DNS server is hardcoded at `ROOHST`/`ROOADR` in `SYSNET;DQDEV`, but you can also use the `iptables` ## Mail Check out this [external guide](https://its.victor.se/wiki/mail-setup) diff --git a/src/sysen2/name.558 b/src/sysen2/name.558 index aefde7653..9b74d89db 100755 --- a/src/sysen2/name.558 +++ b/src/sysen2/name.558 @@ -264,9 +264,9 @@ $$ANALYZ==1 .INSRT SYSTEM;CHSDEF .INSRT SYSENG;NETWRK -;; default off. Compile with /T to input DODNS==:1 -ifndef DODNS,DODNS==:0 -ifn DODNS,[ +;; default off. Compile with /T to input DNSP==:1 +ifndef DNSP,DNSP==:0 +ifn DNSP,[ RESOLV"$$DQDQ==:0 ;use DOMAIN: RESOLV"$$DQCH==:1 ;handle Chaosnet .INSRT SYSNET;RESOLV @@ -913,7 +913,7 @@ fjcl72: pushj p,netin ;go copy net input to TTY jrst fjcl ;when done, go back for more sites. fjcl57: -ifn DODNS,[ +ifn DNSP,[ move a,[440700,,hanlst] pushj p,resolv"hstsrc jrst fjcl58 @@ -1114,7 +1114,7 @@ hstlook: tlnn b,-1 ;or if lh is 0, it is address of asciz string. move a,b pushj p,netwrk"hstlook ;convert to host number. -ifn DODNS,[ +ifn DNSP,[ jrst [ move b,(p) ;netwrk"hstlook might have clobbered movei a,(p) tlnn b,-1 @@ -2557,7 +2557,7 @@ prthsc: push p,b jrst [ ;6typ hstsix ;Print out its sixbit name. pop p,b jrst prths1 ] -ifn DODNS,[ +ifn DNSP,[ ;;; If TELSER only has numeric address (1.2.3.4), try resolving the FHOST push p,a move a,[440700,,hstnam] @@ -2621,7 +2621,7 @@ prthc3: ildb c,b prthst: push p,b push p,c push p,d -ifn DODNS,[ +ifn DNSP,[ ;;; If TELSER only has numeric address (1.2.3.4), try resolving the FHOST push p,a move a,[440700,,hstnam] @@ -3624,7 +3624,7 @@ HANLY9: POPAE P,[TT,T,E,D,C,B] POPJ P, hanlDQ: -ifn DODNS,[ +ifn DNSP,[ move a,[440700,,hanlst] ;might be clobbered pushj p,resolv"hstadr skipa diff --git a/src/sysnet/dig.1 b/src/sysnet/dig.1 index 19832e431..e0b7ef479 100644 --- a/src/sysnet/dig.1 +++ b/src/sysnet/dig.1 @@ -29,6 +29,7 @@ ascbp==440700 .insrt ksc;macros > $$DQCH==1 $$DQRN==1 +$$DQDQ==0 ;don't use DQ:, use DOMAIN: .insrt sysnet;resolv > .insrt syseng;t20mac > .insrt klh;out diff --git a/src/sysnet/dqdev.182 b/src/sysnet/dqdev.182 index 7276528d1..380b44ca8 100644 --- a/src/sysnet/dqdev.182 +++ b/src/sysnet/dqdev.182 @@ -9,8 +9,8 @@ IF1, TITLE DQDEV - Domain Device ;; - don't care about authoritative data - use external functionality to ;; send all requests to a recursive server. ;; - implemented Chaos class handling, and MX/TXT also for IN. -;; - should return minimum preference MX (assume first is minimum) ;;TODO: +;; - should return minimum preference MX (now assumes first is minimum) ;; - put configuration in database file, update by accessing, e.g. ;; DOMAIN:CONFIG;CH-ADDR - read ch-addr domain (e.g. RESOLV) ;; DOMAIN:XYZZY;CONFIG;CH-ADDR;CH-ADDR.MIT.EDU - set ch-addr domain diff --git a/src/sysnet/supdup.325 b/src/sysnet/supdup.325 index 28c6a01b8..bdf15dff1 100755 --- a/src/sysnet/supdup.325 +++ b/src/sysnet/supdup.325 @@ -52,9 +52,9 @@ CHAOSP: 0 ;NON-ZERO IF CONNECTED THROUGH CHAOS NET USENCP: 0 ;NON-ZERO IF SHOULD USE NCP USETCP: -1 ;NON-ZERO IF SHOULD USE TCP -;; default off. Compile with /T to input DODNS==:1 -ifndef DODNS,DODNS==:0 -ifn DODNS,[ +;; default off. Compile with /T to input DNSP==:1 +ifndef DNSP,DNSP==:0 +ifn DNSP,[ RESOLV"$$DQDQ==:0 ;use DOMAIN: RESOLV"$$DQCH==:1 ;handle Chaosnet .INSRT SYSNET;RESOLV @@ -281,7 +281,7 @@ SUPDU1: MOVEI A,HSTPAG .VALUE MOVEI A,JCLBUF PUSHJ P,NETWRK"HSTLOOK ;GET HOST NUMBER INTO A, NETWORK NUMBER INTO TT -ifn DODNS,[ +ifn DNSP,[ ;; NETWRK failed, try DNS jrst [ move a,[440700,,jclbuf] pushj p,resolv"hstadr From 0c405622865f7d191f76646c3d67c98919626a9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Thu, 9 Sep 2021 09:15:52 +0200 Subject: [PATCH 16/21] Finish parameters section --- doc/networking.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/networking.md b/doc/networking.md index 55b61bc31..18cac4687 100644 --- a/doc/networking.md +++ b/doc/networking.md @@ -103,7 +103,10 @@ To make ITS use DNS like a modern netizen, you need to do the following. The res ``` So far, you can configure some parameters by editing the code: -- The DNS server is hardcoded at `ROOHST`/`ROOADR` in `SYSNET;DQDEV`, but you can also use the `iptables` +- The DNS server is hardcoded at `ROOHST`/`ROOADR` in `SYSNET;DQDEV`, but it might be more convenient to use the `iptables` trick above to redirect all DNS packets elsewhere. +- The domain search list is hardcoded at `DOMS` in `SYSNET;RESOLV`. When you change it, remember to recompile `NAME`, `SUPDUP`, `COMSAT` and perhaps `DIG` (see above). +- The Chaosnet address-to-name translation domain is hardcoded to `CH-ADDR.NET` in `SYSNET;DQDEV` and in `SYSNET;RESOLV`, but chances are that you want to keep it that way if you join the [Global Chaosnet)](https://chaosnet.net). + ## Mail Check out this [external guide](https://its.victor.se/wiki/mail-setup) From 0c653ef77a9d5066268c4aec03b7183e7c6663b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Thu, 9 Sep 2021 09:17:07 +0200 Subject: [PATCH 17/21] Update networking.md --- doc/networking.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/networking.md b/doc/networking.md index 18cac4687..316ff9ee2 100644 --- a/doc/networking.md +++ b/doc/networking.md @@ -105,7 +105,7 @@ To make ITS use DNS like a modern netizen, you need to do the following. The res So far, you can configure some parameters by editing the code: - The DNS server is hardcoded at `ROOHST`/`ROOADR` in `SYSNET;DQDEV`, but it might be more convenient to use the `iptables` trick above to redirect all DNS packets elsewhere. - The domain search list is hardcoded at `DOMS` in `SYSNET;RESOLV`. When you change it, remember to recompile `NAME`, `SUPDUP`, `COMSAT` and perhaps `DIG` (see above). -- The Chaosnet address-to-name translation domain is hardcoded to `CH-ADDR.NET` in `SYSNET;DQDEV` and in `SYSNET;RESOLV`, but chances are that you want to keep it that way if you join the [Global Chaosnet)](https://chaosnet.net). +- The Chaosnet address-to-name translation domain is hardcoded to `CH-ADDR.NET` in `SYSNET;DQDEV` and in `SYSNET;RESOLV`, but chances are that you want to keep it that way if you join the [Global Chaosnet](https://chaosnet.net). ## Mail From c585527c1dd12a94bf3e7d9f4ef423cdaf9fe866 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Thu, 9 Sep 2021 14:09:06 +0200 Subject: [PATCH 18/21] JCL compatibility in strcpy also spelling error fix --- src/sysnet/resolv.35 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/sysnet/resolv.35 b/src/sysnet/resolv.35 index 4f616a88e..e8e9f899b 100644 --- a/src/sysnet/resolv.35 +++ b/src/sysnet/resolv.35 @@ -392,7 +392,7 @@ nosix1: setz tt, idpb tt,a popj p, -ife $DQDQ,[ ;; only if real DOMAIN device, i.e using DNS +ife $$DQDQ,[ ;; only if real DOMAIN device, i.e using DNS SUBTTL HSTMX - Host name to mail exchange ;;; HSTMX - Resolve host name into address of mail exchange @@ -470,7 +470,7 @@ IFE $$DQRN,{ } POPPER P,[D,C,B,A] ;Fix acs POPJ P, -]; $DQDQ +]; $$DQDQ SUBTTL HSTSRC - Netaddress into host name. @@ -496,7 +496,7 @@ IFE $$DQRN,{ IFN $$DQIN, TLNN C,(NE%UNT) ? MOVEI D,0 ;IP = 0 IFN $$DQCH, CAMN C,[NW%CHS] ? MOVEI D,1 ;CH = 1 JUMPL D,HSTS99 ;Lose if unknown -ifn $DQDQ,[ +ifn $$DQDQ,[ MOVE B,[440700,,[ASCIZ "DQ:HOSTS3;IN;PTR;"] 440700,,[ASCIZ "DQ:HOSTS3;CH;PTR;"]](D) ] @@ -724,10 +724,15 @@ SUBTTL Misc. ;;; Copy B down A, smashing both. Null handled like Twenex SOUT%. STRCPY: ILDB TT,B + ;; JCL compatibility + caie tt,3 ;stop at ^C + cain tt,15 ;stop at ^M + jrst strcp1 JUMPE TT,STRCP1 IDPB TT,A JRST STRCPY STRCP1: MOVE B,A ;Ascizify but leave pointer + setz tt, ;in case ^C or ^M IDPB TT,B ;set up for overwriting POPJ P, From 0e8331978b31c5e9aee05ed3c9436f7bf44b982f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Thu, 9 Sep 2021 14:10:06 +0200 Subject: [PATCH 19/21] Partial DNS support Need to develop HOSTNM replacement in resolv or telnet. --- src/sysnet/telnet.753 | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/src/sysnet/telnet.753 b/src/sysnet/telnet.753 index 92b10b63c..5e351ced3 100755 --- a/src/sysnet/telnet.753 +++ b/src/sysnet/telnet.753 @@ -196,6 +196,12 @@ $$hstmap==1 ; HSTMAP routine $$analyz==1 ; Analysis reoutines netwrk"E==x .insrt syseng;netwrk +ifndef DNSP,DNSP==0 +ifn DNSP,[ +$$DQDQ==0 ;use DOMAIN:, not DQ: +resolv"E==x +.insrt sysnet;resolv +] subttl TELNET commands for the new protocol @@ -431,7 +437,18 @@ goicp: move x,ttysts ; get TTY status move b,hostad call netwrk"hstsrc ; Look up name +ife DNSP,[ caia ; lost +] +.else,[ + jrst [ move a,[440700,,hstnam] + move b,hostad + call resolv"hstsrc + jrst .+2 ;fail, make it "RANDOM-PLACE" + move x,[440700,,hstnam] + move y,[440600,,hstsnm] + jrst getwvr ] +] jrst gotwhn store sixbit/RANDOM/,hstsnm ; host name not in table store sixbit/-PLACE/,hstsnm+1 ; so invent a name @@ -1932,6 +1949,15 @@ open: skipl hostad ; are we connected? movei a,[asciz /Open connection to /] movem a,prompt' store %zeros,icpskt ; initialize initial socket +ifn DNSP,[ + ;; Only handle JCL for now, since hostnm does all kinds of hairy interactive stuff + jrst [ skipn jclbuf + jrst .+1 ;do the interactive hair + move a,[440700,,jclbuf] + pushj p,resolv"hstadr + jrst cmdfls ;fail + jrst .+3 ] ;success +] pushj p,netwrk"hostnm ; Do hostname lookup interactively jrst cmdfls ; Fail or something? movem a,hostad ; Store host address. From 93c7af9c3386d6f38c29adefcf52bd1f4af49e58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Sun, 12 Sep 2021 14:58:10 +0200 Subject: [PATCH 20/21] Use NETHST in OWNHST Needed after PR #2061, where the address is read from the IMP rather than hardcoded. --- src/sysnet/resolv.35 | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/sysnet/resolv.35 b/src/sysnet/resolv.35 index e8e9f899b..0eb8306e1 100644 --- a/src/sysnet/resolv.35 +++ b/src/sysnet/resolv.35 @@ -10,12 +10,13 @@ SUBTTL RESOLV - Interface to DQ/DOMAIN: device ;;; (see SYSNET;DQXDEV), which is an interface to the HOSTS3 tables. ;;; ;;; TODO: -;;; - make the Chaos address domain (for DNS) a config parameter (cf DQDEV) +;;; - make the Chaos address domain (for DNS) a more easily configurable parameter ;;; - search *both* HOSTS3 and QUERY (this is done by NAME and SUPDUP, now) ;;; -- HOSTS3 is faster (since the DNS cache still isn't working) ;;; -- using DNS for Chaos is a bit awkward, I admit +;;; -- solution: first try DOMAIN:HOSTS3; and then DOMAIN:QUERY. ;;; - handle configurable default domain for HSTADR (if no . in name) -;;; (DQDEV should handle this) +;;; ;;; NOTE: ;;; - unfortunately this isn't fully compatible with NETWRK, so plugging ;;; it into old programs may not be so straight-forward. @@ -150,10 +151,18 @@ TERMIN OWNHST: SETZ B, IFN $$DQIN,[ - IFN $$KA10, TLNN A,(NE%UNT) ? MOVEI A, 0 ? MOVE B, [SQUOZE 0,IMPUS3] - IFE $$KA10, TLNN A,(NE%UNT) ? DMOVE A,[0 ? SQUOZE 0,IMPUS3] + ;; Since the IP address is read from the IMP, we can't just read IMPUS3, + ;; but must check the actual address. + tlne a,(ne%unt) + jrst ownhsc ;might be Chaos + ;; Ask ITS about it + syscal nethst,[movei -1 ? movem a ? movem a] + popj p, + push p,stdhst + aos (p) + popj p, +ownhsc: ] - IFN $$DQCH, CAMN A,[NW%CHS] ? MOVE B,[SQUOZE 0,MYCHAD] SKIPE B .EVAL B, From 3a719b91a1fd053e82eb86e1f3baa8da0b377098 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Victor?= Date: Fri, 17 Sep 2021 17:24:36 +0200 Subject: [PATCH 21/21] Handle RENMWO better (plus typo fix) --- src/sysnet/dqdev.182 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/sysnet/dqdev.182 b/src/sysnet/dqdev.182 index 380b44ca8..63d29a4e6 100644 --- a/src/sysnet/dqdev.182 +++ b/src/sysnet/dqdev.182 @@ -11,11 +11,6 @@ IF1, TITLE DQDEV - Domain Device ;; - implemented Chaos class handling, and MX/TXT also for IN. ;;TODO: ;; - should return minimum preference MX (now assumes first is minimum) -;; - put configuration in database file, update by accessing, e.g. -;; DOMAIN:CONFIG;CH-ADDR - read ch-addr domain (e.g. RESOLV) -;; DOMAIN:XYZZY;CONFIG;CH-ADDR;CH-ADDR.MIT.EDU - set ch-addr domain -;; DOMAIN:CONFIG;SEARCHLIST - read domain search list -;; DOMAIN:CONFIG;SEARCHLIST;FOO.COM;BAR.ORG - set domain search list IF2,[ PRINTX / / @@ -1116,6 +1111,9 @@ EVAR ;;; If non-skip, OPEN error code returned in T. PARSE: PUSHER P,[B,C] + SETZM QNASTR ;Zap old QNAME, in case of RENMWO + MOVE B,[QNASTR,,QNASTR+1] + BLT B,QNASTR+ SETZ B, MOVE C,[-1,,":] CALL PARNXT ;Skip over device name. @@ -1915,7 +1913,7 @@ NTASK: PUSHER P,[A,B,C,E,PKT] MOVE A,[OPKT,,OPKT+1] BLT A,OPKT+ SETZM IPKT ;Zap input packet area. - MOVE A,[OPKT,,IPKT+1] + MOVE A,[IPKT,,IPKT+1] BLT A,IPKT+ MOVE B,SRVPRT ;Find Domain server port. MOVEI A,UDPC ;Channel to use.