.lstof title qdomain .decsav .insrt mid:macsym.mid T==:5 TT==:6 A==:7 B==:10 S==:11 F==:16 f%sque==:bit(0) ;In parsct, on if doing question section f%conn==:bit(1) ;On if connected f%chs==:bit(2) ;use CHAOS protocol \ f%tcp==:bit(3) ;use TCP protocol > only one on f%udp==:bit(4) ;use UDP protocol / f%chp==:bit(5) ;Chaosnet is present f%ipp==:bit(6) ;IP/TCP is present f%dbg==:bit(7) ;Show packet before sending .chlab==:"< .chrab==:"> ifndef SNDIN%,SNDIN%==:jsys 754 ifndef RCVIN%,RCVIN%==:jsys 755 ifndef ASNIQ%,ASNIQ%==:jsys 756 ifndef RELIQ%,RELIQ%==:jsys 757 ifndef RIQ%NW,RIQ%NW==:bit(0) ifndef .iqprv,.iqprv==:0 ifndef .iqfhv,.iqfhv==:1 ifndef .iqshv,.iqshv==:2 ifndef .iqptv,.iqptv==:3 ifndef .iqprm,.iqprm==:4 ifndef .iqfhm,.iqfhm==:5 ifndef .iqshm,.iqshm==:6 ifndef .iqptm,.iqptm==:7 ifndef .ipkvr,.ipkvr==:0 ifndef .ipksg,.ipksg==:1 ifndef .ipkpr,.ipkpr==:2 ifndef .ipksh,.ipksh==:3 ifndef .ipkdh,.ipkdh==:4 %ipmxw==:40000 f$word==:044000,,0 lh$word==:242000,,0 rh$word==:042000,,0 ipk$vr==:400400,,.ipkvr ;IP version ipk$do==:340400,,.ipkvr ;Data offset ipk$ts==:241000,,.ipkvr ;Type of service ipk$dl==:rh$word .ipkvr ;IP Datagram length ipk$sg==:f$word .ipksg ;Segmentation stuff ipk$tl==:341000,,.ipkpr ;Time to live ipk$pr==:241000,,.ipkpr ;Protocol number ipk$ch==:rh$word .ipkpr ;IP Header checksum ipk$sh==:f$word .ipksh ;Source host ipk$dh==:f$word .ipkdh ;Destination host iplen==:.ipkdh+1 ;Total word length of IP header udp$lp==:lh$word 0 ;Local port udp$fp==:rh$word 0 ;Foreign port udp$dl==:lh$word 1 ;UDP Datagram length udp$ch==:rh$word 1 ;UDP Header checksum udplen==:2 ;Total word length of IP header .insrt mid:output.mid .scalar pdl(pdllen==:1000) ;;Macros for making tables define Ent &name&,flag,?value [ifnb flag,cm%fw\cm%inv\cm%!flag asciz name],,value termin define endtab tab if2,[ ..xx==. loc tab ..xx-tab-1,,..xx-tab-1 loc ..xx ] termin ;Name tables define maknam minsym,minval minsym==:minval offset minval-. termin define endnam maxsym maxsym==:.-1 offset 0 termin ;Packet header h$id==:242000,,0 ;Identifier word h$qr==:230100,,0 ;Query/response bit h$opc==:170400,,0 ;Opcode opcnam: maknam opcmin,0 ho.sq::[asciz "QUERY"] ;Standard query ho.in::[asciz "IQUERY"] ;Inverse query ho.mc::[asciz "CQUERYM"] ;Multiple completion query ho.uc::[asciz "CQUERYU"] ;Unique completion query endnam opcmax h$flg==:100700,,0 ;Flags h%aa==:100 ;Authoritative Answer h%tc==:040 ;Truncation h%rd==:020 ;Recursion desired h%ra==:010 ;Recursion available h$rco==:040400,,0 ;Response code rconam:maknam rcomin,0 hr.ok::[asciz "No error"] hr.fm::[asciz "Format error"] hr.sf::[asciz "Server failure"] hr.ne::[asciz "Name error"] hr.ni::[asciz "Not implemented"] hr.rf::[asciz "Request refused"] endnam rcomax h$qdc==:242000,,1 ;Question entry count h$anc==:042000,,1 ;Answer entry count h$nsc==:242000,,2 ;Authoritative entry count h$arc==:042000,,2 ;Additional data entry count h$dat==:441000,,3 ;Start of data ;;RR tail section rr.qt==:0 ;Type field rr.qtl==:2 ; two bytes rr.qc==:rr.qt+rr.qtl ;Class field rr.qcl==:2 ; two bytes rr.tl==:rr.qc+rr.qcl ;TTL field rr.tll==:4 ; four bytes rr.dl==:rr.tl+rr.tll ;RDLENGTH field rr.dll==:2 ; two bytes rr.dat==:rr.dl+rr.dll ;Start of data ;;Question tail section qs.qt==:0 qs.qtl==:rr.qtl qs.qc==:qs.qt+qs.qtl qs.qcl==:rr.qcl qs.len==:qs.qc+rr.qcl ;;SOA fields soa.sl==:4 ;Serial number, four bytes soa.rl==:4 ;Refresh time, four bytes soa.tl==:4 ;Retry time, four bytes soa.el==:4 ;Expire time, four bytes soa.ml==:rr.tll ;Minimum TTL time, same as any TTL ;;Types typnam: maknam typmin,1 qt.a:: [asciz "A"] ;Address qt.ns:: [asciz "NS"] ;Authoritative name server qt.md:: [asciz "MD"] ;Mail destination (mail agent) qt.mf:: [asciz "MF"] ;Mail forwarder (mail agent) qt.cn:: [asciz "CNAME"] ;Canonical name qt.soa::[asciz "SOA"] ;Start of authority zone qt.mb:: [asciz "MB"] ;Mailbox domain name (mailbox) qt.mg:: [asciz "MG"] ;Mail group member (mailbox) qt.mr:: [asciz "MR"] ;Mail rename domain name (mailbox) qt.nul::[asciz "NUL"] ;Null qt.wks::[asciz "WKS"] ;Well known service description qt.ptr::[asciz "PTR"] ;Domain name pointer qt.hi:: [asciz "HINFO"] ;Host information qt.mi:: [asciz "MINFO"] ;Mail information endnam typmax ;;QTypes qtnam: maknam qtmin,252. qt.axf::[asciz "AXFR"] ;Authority zone transfer qt.qmb::[asciz "MAILB"] ;Request for mailbox (MB, MG or MR) qt.qma::[asciz "MAILA"] ;Request for mail agent (MD or MF) qt.all::[asciz "*"] ;Request for all records endnam qtmax ;;Classes clanam: maknam clamin,1 qc.in:: [asciz "IN"] ;Internet qc.cs:: [asciz "CS"] ;CSNET endnam clamax ;;QClasses qcnam: maknam qcmin,255. qc.all::[asciz "*"] ;All classes endnam qcmax qtmsk: 1_-1 qcmsk: 1_-1 ttlmsk: 1_-1 opcmsk: <.bm h$opc>_-<.tz <.bm h$id>,> idmsk: <.bm h$id>_-<.tz <.bm h$id>,> define ildb8 len,ac,ptr ildb ac,ptr ifg len-1,[ repeat len-1,[ ildb 0,ptr lsh ac,8 ior ac,0] ] termin define idpb8 len,src,ptr repeat len,[ ldb 0,[.bp 377_<*8>,src] idpb 0,ptr ] termin ;Command parsing strbsz==:100 atmbsz==:100 .vector strbuf(strbsz),atmbuf(atmbsz) cmdblk: 0 ;.CMFLG .priin,,.priou ;.CMIOJ 0 ;.CMRTY 440700,,strbuf ;.CMBFP 440700,,strbuf ;.CMPTR strbsz*5 ;.CMCNT 0 ;.CMINC 440700,,atmbuf ;.CMABP atmbsz*5 ;.CMABC gjblk ;.CMGJB gjblk: gj%old ;.GJGEN .nulio,,.nulio ;.GJSRC 0 ;.GJDEV 0 ;.GJDIR 0 ;.GJNAM 0 ;.GJEXT repeat .gjatr-.gjext,0 define noise &str movei 2,[flddb. .cmnoi,,] call $comnd termin $confm: movei 2,[flddb. .cmcfm] $comnd: push p,2 do. movei 1,cmdblk move 2,(p) COMND% jxn 1,cm%nop,$cmder ldb 4,[.bp cm%fnc,.cmfnp(3)] caie 4,.cmswi exit. hrrz 2,(2) call (2) loop. enddo. adjsp p,-1 movei 3,(3) ret $cmder: emsg "Error in command -- " call .erstr jrst cmdin0 define prserr &str jrst [emsg "Error in command -- " hrroi 1,[asciz str] PSOUT% jrst cmdin0] termin cmdini: movem 1,cmdblk+.cmrty hrrm 2,cmdblk+.cmflg cmdin0: movei 1,cmdblk movei 2,[flddb. .cmini] COMND% hrrz 2,cmdblk+.cmflg jrst (2) cmdtab: 0 Ent "CONNECT",,cconn Ent "DISCONNECT",,cdisc Ent "EXIT",,cexit Ent "QUIT",,cquit Ent "READ",,cread endtab cmdtab reqtab: 0 Ent "CQUERYM",inv,cmcque Ent "CQUERYU",inv,cucque Ent "I",abr,..iqu ..iqu:: Ent "INVERSE-QUERY",,ciquer Ent "IQUERY",inv,ciquer Ent "MULTIPLE-COMPLETION",,cmcque Ent "QUERY",,cquery Ent "UNIQUE-COMPLETION",,cucque endtab reqtab ;"<" prompt: asciz "QDomain> " .scalar pmtbuf(pmtbsz==:10) ;Run-time prompt .scalar netjfn ;Network jfn or queue .scalar chlhst,inlhst ;Chaos and Internet local host numbers .scalar hstbuf(hstbsz==:30) ;Place to temporarily put host name .scalar qident ;Current request ID# define cmdret &str ifnb [str],[$pout str] jrst cmdlup termin levtab: lev1pc' ? lev2pc' ? lev3pc' abtlev==:2 chntab: offset -. abtchn::abtlev,,abtint repeat 32.-.,0 offset 0 .scalar abtpc begin: RESET% move p,[-pdllen,,pdl-1] movei 1,.fhslf RPCAP% txo 3,sc%nwz EPCAP% setzm netjfn setzm qident setzm abtpc setz F, hrroi 1,[asciz "CHA:"] STDEV% ifnje. txo f,f%chp movei 1,.chnph hrroi 2,hstbuf CHANM% .Lose movem 1,chlhst endif. hrroi 1,[asciz "TCP:"] STDEV% ifnje. txo f,f%ipp movei 1,.gthsz GTHST% .Lose movem 4,inlhst endif. ifxe. f,f%ipp\f%chp emsg "No networks available??" jrst die endif. movei 1,.fhslf move 2,[levtab,,chntab] SIR% EIR% movx 2,bit(abtchn) AIC% movx 1,<.ticcg,,abtchn> ;^G interrupt ATI% cmdlup: move p,[-pdllen,,pdl-1] do. hrroi 1,pmtbuf txnn f,f%conn hrroi 1,prompt jsp 2,cmdini move p,[-pdllen,,pdl-1] setzm packet ;Clear packet header move 1,[packet,,packet+1] blt 1,packet+h$dat-1 movei 2,[flddb. .cmkey,,reqtab,"Request type,","QUERY",[ flddb. .cmnum,cm%sdh,10.,"a decimal request opcode",,[ flddb. .cmkey,,cmdtab,"a program command,"]]] txnn f,f%conn movei 2,[flddb. .cmkey,,cmdtab,"Command,"] call $comnd cain 4,.cmnum skipa 3,[copcod] hrrz 3,(2) call (3) loop. enddo. cquit: noise "program temporarily" call $confm movsi T,.prkep jrst cexit0 cexit: noise "program permanently" call $confm call discon movsi T,.prkil cexit0: move 1,[.prast,,.fhslf] movei 2,T movei 3,1 PRARG% ernop HALTF% ret cdisc: call $confm discon: ifxn. f,f%conn move 1,netjfn txne f,f%udp txnn f,f%ipp ifskp. setzb 2,3 RELIQ% .Lose else. CLOSF% jrst [move 1,netjfn txo 1,cz%abt CLOSF% .Lose jrst .+1] endif. endif. setzm netjfn txz f,f%conn\f%chs\f%udp\f%tcp ret protab: 0 ent "CHAOS",,chaicp ent "TCP",,tcpicp ent "UDP",,udpicp endtab protab cconn: noise "to" movei 2,[flddb. .cmfld,cm%sdh,,"host name"] call $comnd move 1,[ascptr atmbuf] move 2,[ascptr hstbuf] movx 3,hstbsz*5 do. ildb 4,1 cain 4,^V ildb 4,1 jumpe 4,endlp. cail 4,"a caile 4,"z abskp subi 4,"a-"A idpb 4,2 sojg 3,top. prserr "Host name too long" enddo. camn 2,[ascptr hstbuf] prserr "Illegal host name" idpb 4,2 noise "using" movei 2,[flddb. .cmkey,,protab,"server protocol,","UDP"] call $comnd hrrz 2,(2) call (2) ret txo f,f%conn txne f,f%udp ;Cons up a custom prompt move 1,[asciz "UDP "] txne f,f%tcp move 1,[asciz "TCP "] txne f,f%chs move 1,[asciz "CHS "] movem 1,pmtbuf move 1,[100700,,pmtbuf] move 2,[ascptr hstbuf] movx 3,pmtbsz*5-7 do. ildb 4,2 caie 4,0 cain 4,". exit. idpb 4,1 sojg 3,top. enddo. movei 3,.chrab idpb 3,1 movei 3,40 idpb 3,1 setz 3, idpb 3,1 ret .scalar srchst,dsthst,lport,maxsct udpicp: jxe f,f%ipp,chudp ;Use gateway if don't have IP movei 1,.gthsn ;Verify host name hrroi 2,hstbuf GTHST% prserr "No such host" push p,3 call $confm call discon pop p,dsthst txo f,f%udp move 1,[atmbuf,,atmbuf+1] setzm atmbuf blt 1,atmbuf+.iqptm movei 1,21 ;UDP protocol dpb 1,[rh$word atmbuf+.iqprv] move 1,dsthst dpb 1,[f$word atmbuf+.iqfhv] move 1,inlhst movem 1,srchst dpb 1,[f$word atmbuf+.iqshv] movei 1,65 ;Domain server port# dpb 1,[rh$word atmbuf+.iqptv] seto 1, ;Exact match on: dpb 1,[rh$word atmbuf+.iqprm] ;protocol dpb 1,[f$word atmbuf+.iqshm] ;source host dpb 1,[f$word atmbuf+.iqptm] ;and local & foreign ports movei 1,377 movem 1,lport do. aos 1,lport dpb 1,[lh$word atmbuf+.iqptv] movei 1,atmbuf setzb 2,3 ASNIQ% abskp exit. cain 1,ASNSX2 loop. call Lose enddo. movem 1,netjfn caile 2,177777 movei 2,177777 movem 2,maxsct movei 1,.gthns ;Convert host name to official name hrroi 2,hstbuf ; for prompt move 3,dsthst GTHST% .Lose txnn 4,hs%up ;Might as well... pout "%~%Warning - host is apparently not up" retskp chudp: ;;Should parse gateway host here call $confm call discon txo f,f%udp hrroi 2,[asciz "CHA:XX.IP_21_"] call chgwy ret move 1,netjfn move 2,[441000,,atmbuf] movx 3,-12. SIN% ldb 2,[f$word atmbuf] movem 2,srchst ;Gateway host number ldb 2,[f$word atmbuf+1] movem 2,dsthst ;Foreign host number ldb 2,[lh$word atmbuf+2] movem 2,lport ;Local port ldb 2,[rh$word atmbuf+2] movem 2,maxsct retskp tcpicp: jxe f,f%ipp,chtcp movei 1,.gthsn ;Verify host name hrroi 2,hstbuf GTHST% prserr "No such host" push p,3 call $confm call discon pop p,dsthst txo f,f%tcp emsg "Direct TCP protocol not implemented yet" ret chtcp: ;;Should parse a gateway host here call $confm call discon txo f,f%tcp hrroi 2,[asciz "CHA:MC.TCP_"] chgwy: hrli 2,(ascptr) move 1,[ascptr atmbuf] ildb 3,2 jumpn 3,[idpb 3,1 ? jrst .-1] call hstnam move 2,[ascptr [asciz "_65"]] do. ildb 3,2 idpb 3,1 jumpn 3,top. enddo. movx 1,gj%sht hrroi 2,atmbuf GTJFN% ifskp. push p,1 movx 2,fld(8,of%bsz)\of%rd\of%wr OPENF% ifskp. pop p,netjfn retskp endif. ;Should try to get CLS message here exch 1,(p) RLJFN% nop pop p,1 endif. move 2,1 emsg "Can't connect to gateway -- " jrst .erstr chaicp: jxe f,f%chp,tcpchs movei 1,.chnsn hrroi 2,hstbuf CHANM% erjmp [prserr "No such host"] push p,1 call $confm call discon pop p,dsthst txo f,f%chs emsg "Direct CHAOS protocol not implemented yet" ret tcpchs: ;;Should parse a gateway host here call $confm call discon txo f,f%chs emsg "Gateway CHAOS protocol not implemented yet" ret ;;Copy host name from hstbuf to 1 as a filename ;;Have to quote in case includes "." hstnam: move 2,[ascptr hstbuf] do. ildb 3,2 jumpe 3,endlp. cail 3,"A ;Note host name has already been upcased caile 3,"Z cain 3,"$ ifskp. cail 3,"0 caile 3,"9 cain 3,"- anskp. movei 3,^V idpb 3,1 ldb 3,2 endif. idpb 3,1 loop. enddo. move 2,1 idpb 3,2 ret cread: txnn f,f%conn prserr "Not connected" noise "a packet" call $confm qread: movei 1,cmdlup ;Set up ^G movem 1,abtpc ifxn. f,f%udp ifxn. f,f%ipp movei 1,%ipmxw+1 movem 1,ipblk hrrz 1,netjfn movei 2,ipblk setz 3, RCVIN% .Lose else. move 1,netjfn move 2,[441000,,iphdr] movx 3,-iplen*4 SIN% ldb 3,[ipk$dl+iphdr] subi 3,iplen*4 movns 3 SIN% endif. ldb A,[udp$dl+udphdr] subi A,udplen*4 else. move 1,netjfn BIN% move A,2 lsh A,8 BIN% ior A,2 move 2,[441000,,packet] movn 3,A SIN% jumpn 3,[emsg "Couldn't read in whole packet" ret] endif. call shopkt setzm abtpc ;No more ^G movei 1,-packet+1(S) imuli 1,4 lsh S,-41 sub 1,S camn 1,A ret emsg "Packet size didn't match amount of data" ret consta shopkt: push p,A ldb 1,[h$opc+packet] hrroi 2,[asciz "OPCODE:%1D"] cail 1,opcmin caile 1,opcmax abskp hrro 2,opcnam-opcmin(1) ldb 3,[h$id+packet] pout "%~%2S #%3D" ldb 1,[h$qr+packet] skipe 1 pout " Response" ldb 1,[h$flg+packet] txze 1,h%aa pout " Authoritative" txze 1,h%tc pout " Truncated" txze 1,h%ra pout " Recursion-Available" txze 1,h%rd pout " Recursion-Desired" skipe 1 pout " Other-Flags:%1O" ldb 1,[h$rco+packet] cain 1,hr.ok ifskp. hrroi 2,[asciz "Error #%1D"] cail 1,rcomin caile 1,rcomax abskp hrro 2,rconam-rcomin(1) pout "%_%2S" endif. move S,[h$dat+packet] setz A, do. ldb 1,[h$qdc+packet] camn 1,A exit. movei 2,1(A) pout "%_Question#%2D: " call shoqs aoja A,top. enddo. setz A, do. ldb 1,[h$anc+packet] camn 1,A exit. movei 2,1(A) pout "%_Answer#%2D: " call shorr aoja A,top. enddo. setz A, do. ldb 1,[h$nsc+packet] camn 1,A exit. movei 2,1(A) pout "%_Authority#%2D: " call shorr aoja A,top. enddo. setz A, do. ldb 1,[h$arc+packet] camn 1,A exit. movei 2,1(A) pout "%_Additional#%2D: " call shorr aoja A,top. enddo. pop p,A ret shoqs: call outdom call shoct movei 1,qs.len adjbp 1,S move S,1 ret shorr: call outdom movei 1,rr.tl adjbp 1,S ildb8 rr.tll,2,1 pout " %2D" call shoct ;Show class and type movei 1,rr.dl adjbp 1,S move S,1 ildb8 rr.dll,2,S jumpe 2,cret ;No data, punt push p,S ;Save data pointer pout " " movx 1,rr.qt-rr.dat ;Get back type adjbp 1,S ildb8 rr.qtl,2,1 cain 2,qt.hi jrst shohi cain 2,qt.mi jrst shomi cain 2,qt.soa jrst shosoa cain 2,qt.a jrst shoadd cain 2,qt.wks jrst showks caie 2,qt.mr cain 2,qt.mg jrst shombx caie 2,qt.cn cain 2,qt.mf jrst shodom caie 2,qt.md cain 2,qt.mb jrst shodom caie 2,qt.ns cain 2,qt.ptr jrst shodom shoany: movx 1,rr.dl-rr.dat adjbp 1,S ildb8 rr.dll,4,1 call outst4 sholen: move 1,S ;Compute length pop p,3 sub 1,3 movei 2,(1) imuli 2,4. ash 1,-41 sub 2,1 movx 1,rr.dl-rr.dat adjbp 1,3 ildb8 rr.dll,3,1 camn 3,2 ret pout "%~%%Warning -- RDLENGTH (%3D) doesn't match actual data length (%2D)" sub 3,2 ifg. 3 pout "%_Extra data: " caig 3,80. ;Show only the first 80 bytes or so skipa 4,3 movei 4,80. sub 3,4 push p,3 call outst4 pop p,3 andg. 3 pout "%_etc." endif. adjbp 3,S move S,3 ret shohi: call outstr pout " " call outstr jrst sholen shomi: call outstr pout "@" call outdom pout " " shombx: call outstr pout "@" shodom: call outdom jrst sholen shosoa: call outdom pout " " call outstr pout "@" call outdom ildb8 soa.sl,1,S ;Serial number pout " %1D" ildb8 soa.rl,1,S ;Various times ildb8 soa.tl,2,S ildb8 soa.el,3,S ildb8 soa.ml,4,S pout " %1D %2D %3D %4D" jrst sholen showks: movx 1,rr.qc-rr.dat adjbp 1,S ildb8 rr.qcl,2,1 caie 2,qc.in jrst shoany ildb 1,S ildb 2,S ildb 3,S ildb 4,S pout "%1D.%2D.%3D.%4D" ildb 1,S ;Protocol number movn 3,iprtab hrri 3,iprtab aobjp 3, do. hrrz 2,(3) came 2,1 aobjn 3,top. enddo. hrroi 2,[asciz "%1D"] skipge 3 hlro 2,(3) pout " %2S" setz T, caie 1,6. cain 1,17. ifnsk. movn T,ipttab hrri T,ipttab aobjp T, endif. movx 1,rr.dl-rr.dat-5 ;Get back length adjbp 1,S ildb8 rr.dll,TT,1 subi TT,5. ;Account for 4 address and 1 protocol byte setz 3, do. ifxe. 3,7 sojl TT,sholen ildb 2,S endif. ifl. 2 hrroi 4,[asciz "%3D"] ifn. T move 4,T do. hrrz 0,(T) came 0,3 aobjn 4,top. enddo. skipl 4 skipa 4,[ascptr [asciz "%3D"]] hlro 4,(4) endif. pout " %4S" endif. lsh 2,1. aoja 3,top. enddo. shoadd: movx 1,rr.qc-rr.dat adjbp 1,S ildb8 rr.qcl,2,1 caie 2,qc.in jrst shoany ildb 1,S ildb 2,S ildb 3,S ildb 4,S pout "%1D.%2D.%3D.%4D" jrst sholen ifn ***,.Fatal can't use SHOCT shoct: movei 2,rr.qt adjbp 2,S ildb8 rr.qtl,1,2 hrroi 2,[asciz "%1D"] cail 1,typmin caile 1,typmax abskp hrro 2,typnam-typmin(1) cail 1,qtmin caile 1,qtmax abskp hrro 2,qtnam-qtmin(1) movei 4,rr.qc adjbp 4,S ildb8 rr.qcl,3,4 hrroi 4,[asciz "%3D"] cail 3,clamin caile 3,clamax abskp hrro 4,clanam-clamin(3) cail 3,qcmin caile 3,qcmax abskp hrro 4,qcnam-qcmin(3) pout " %4S %2S" ret outstr: ildb 4,S outst4: jumple 4,[pout '""' ret] movei 1,.priou setz 3, do. ildb 2,S cail 2,"0 caile 2,"9 tdza 3,3 ifn. 3 ;Need to quote digits if \ddd came before cail 2,"A caile 2,"Z cain 2,"- anskp. cail 2,"a caile 2,"z annsk. movei 2,"\ BOUT% ldb 2,S endif. cail 2,40 cail 2,177 ifskp. ande. 3 BOUT% else. movei 3,10. NOUT% .Lose endif. sojg 4,top. enddo. ret outdom: movei 1,.priou ildb 4,S jumpe 4,[movei 2,". BOUT% ret] do. ifxn. 4,300 txc 4,300 jxn 4,300,[cmdret "Illegal pointer in compressed domain data"] ildb 2,S lsh 4,8 ior 4,2 adjbp 4,[441000,,packet] push p,S move S,4 call outdom pop p,S ret endif. call outst4 movei 2,". BOUT% ildb 4,S jumpn 4,top. enddo. ret ;Keyword mask to allow *. Keybrk: brmsk. keyb0.,keyb1.,keyb2.,keyb3.,[*],[] QTTab: 0 Ent "*",,qt.all Ent "A",abr,..ad Ent "AXFR",,qt.axf Ent "MAILA",,qt.qma Ent "MAILB",,qt.qmb endtab QTTab TypTab: 0 ..ad:: Ent "ADDRESS",,qt.a Ent "CNAME",,qt.cn Ent "HINFO",,qt.hi Ent "MB",,qt.mb Ent "MD",,qt.md Ent "MF",,qt.mf Ent "MG",,qt.mg Ent "MINFO",,qt.mi Ent "MR",,qt.mr Ent "NS",,qt.ns Ent "NULL",,qt.nul Ent "PTR",,qt.ptr Ent "SOA",,qt.soa Ent "WKS",,qt.wks endtab typtab QCTab: 0 Ent "*",,qc.all Ent "CSNET",,qc.cs Ent "INTERNET",,qc.in endtab QCTab ClaTab: 0 Ent "CSNET",,qc.cs Ent "INTERNET",,qc.in endtab ClaTab switab: 0 Ent "IDENTIFIER:",,sident Ent "RECURSION-DESIRED",,srecur endtab switab srecur: ldb 1,[h$flg+packet] txo 1,h%rd dpb 1,[h$flg+packet] ret sident: movei 2,[flddb. .cmnum,cm%sdh,10.,"Decimal ID number"] call $comnd camn 2,[-1] movx 2,idmsk skipl 2 caile 2,idmsk prserr "ID number out of range" dpb 2,[h$id+packet] ret cquery: movei 2,ho.sq call xquery call prsqs call $confm movei 1,1 dpb 1,[h$qdc+packet] jrst qsend ciquer: movei 2,ho.in call xquery call prsrr movei 1,1 dpb 1,[h$anc+packet] jrst qsend cmcque: skipa 2,[ho.mc] cucque: movei 2,ho.uc call xquery call prsqs movx 1,-rr.qcl adjbp 1,S ildb8 rr.qcl,A,1 ;Save class noise "target domain" movei 2,[flddb. .cmcfm,,,,".",domfdb] hllzs domfdx+.cmfnp call $comnd caie 4,.cmcfm ifskp. setzm atmbuf call savdom else. call savdom call $confm endif. movei 1,qt.nul ;Type=NULL idpb8 rr.qtl,1,S idpb8 rr.qcl,A,S ;Class same as QCLASS setz 1, idpb8 rr.tll,1,S ;TTL=0 idpb8 rr.dll,1,S ;RDLEN=0 movei 1,1 dpb 1,[h$qdc+packet] dpb 1,[h$arc+packet] jrst qsend xquery: dpb 2,[h$opc+packet] move 1,qident dpb 1,[h$id+packet] noise "domain" move S,[h$dat+packet] movei 1,[flddb. .cmswi,,switab] hrrm 1,domfdx+.cmfnp movei 2,domfdb call $comnd jrst savdom copcod: skipl 2 camle 2,opcmsk prserr "Opcode out of permissible range" dpb 2,[h$opc+packet] move 1,qident dpb 1,[h$id+packet] movei 2,[flddb. .cmcfm,cm%sdh,,"Confirm to specify arguments",,[ flddb. .cmswi,,switab]] call $comnd move S,[h$dat+packet] quesct: hrroi 1,[asciz "Confirm to go on to next section"] hrroi 2,[asciz "question"] call parque ret ;Aborted dpb A,[h$qdc+packet] anssct: hrroi 1,[asciz "Confirm to go on to next section"] hrroi 2,[asciz "answer"] call parsct jrst quesct dpb A,[h$anc+packet] autsct: hrroi 1,[asciz "Confirm to go on to next section"] hrroi 2,[asciz "authority"] call parsct jrst anssct dpb A,[h$nsc+packet] addsct: hrroi 1,[asciz "Confirm to send the query"] hrroi 2,[asciz "additional"] call parsct jrst autsct dpb A,[h$arc+packet] qsend: movei A,-packet+1(S) ;Find length of whole thing imuli A,4. lsh S,-41 sub A,S txne f,f%dbg call shopkt aos qident jxn f,f%udp,udpsnd move 1,[241000,,packet-1] idpb8 2.,A,1 move 1,netjfn move 2,[241000,,packet-1] movn 3,A subi 3,2. SOUTR% jrst qread udpsnd: addi A,udplen*4 dpb A,[udp$dl udphdr] addi A,iplen*4 dpb A,[ipk$dl iphdr] movei 1,4. dpb 1,[ipk$vr iphdr] movei 1,iplen dpb 1,[ipk$do iphdr] setz 1, dpb 1,[ipk$ts iphdr] dpb 1,[ipk$sg iphdr] dpb 1,[ipk$ch iphdr] movei 1,60. dpb 1,[ipk$tl iphdr] movei 1,21 dpb 1,[ipk$pr iphdr] move 1,srchst dpb 1,[ipk$sh iphdr] move 1,dsthst dpb 1,[ipk$dh iphdr] move 1,lport dpb 1,[udp$lp udphdr] movei 1,65 dpb 1,[udp$fp udphdr] setz 1, dpb 1,[udp$ch udphdr] ifxn. f,f%ipp ldb 1,[ipk$dl iphdr] addi 1,7 lsh 1,-2 movem 1,ipblk move 1,netjfn movei 2,ipblk setz 3, SNDIN% .Lose else. move 1,netjfn move 2,[441000,,iphdr] ldb 3,[ipk$dl iphdr] movns 3 SOUTR% endif. jrst qread lbrtkn==:ascptr . asciz "<" ;> upatkn==:ascptr . asciz "^" dombrk: brmsk. fldb0.,fldb1.,fldb2.,fldb3.,[\*],[] SctFDB: flddb. .cmcfm,cm%sdh,,"",,domfdb domfdb: flddb. .cmqst,cm%sdh,,"domain name",,domfdx domfdx: fldbk. .cmfld,cm%sdh,,"domain name in double quotes",,dombrk,<0> ScuFDB: flddb. .cmtok,cm%sdh,upatkn,"^ to back up one line",,ScqFDB ScqFDB: flddb. .cmtok,cm%sdh,lbrtkn,"< to back out of this section",, ;> .scalar sctppt,sctpdl,sctpmt(10) parque: txoa f,f%sque parsct: txz f,f%sque movem 1,SctFDB+.cmhlp move 1,[ascptr sctpmt] hrli 2,(ascptr) do. ildb 3,2 idpb 3,1 jumpn 3,top. enddo. movei 3,"# dpb 3,1 movem 1,sctppt setz A, do. move 1,sctppt ;Add entry number to prompt movei 2,1(A) movei 3,10. NOUT% .Lose movei 3,.chrab idpb 3,1 idpb 3,1 setz 3, idpb 3,1 movem p,sctpdl hrroi 1,sctpmt jsp 2,cmdini move p,sctpdl movei 1,ScuFDB hrrm 1,domfdx+.cmfnp movei 2,SctFDB call $comnd caie 4,.cmcfm ;Exit ifskp. movn 1,A adjsp p,(1) retskp endif. caie 3,ScuFDB ;Up ifskp. call $confm sojl A,cret pop p,S loop. endif. caie 3,ScqFDB ;Quit ifskp. call $confm sojl A,cret movn 1,A ;Clean up stack adjsp p,(1) pop p,S ;Restore original pointer ret endif. push p,S ;Save pointers for backing up call savdom ifxn. f,f%sque call prsqs call $confm else. call prsrr endif. aoja A,top. enddo. prsqs: noise "Class" movei 2,[fldbk. .cmkey,,QCTab,"Class,","*",keybrk,[ flddb. .cmnum,cm%sdh,10.,"a decimal class number"]] call $comnd caie 4,.cmnum hrrz 2,(2) camn 2,[-1] move 2,qcmsk skipl 2 camle 2,qcmsk prserr "Class number out of range" movx 1,qs.qc adjbp 1,S idpb8 qs.qcl,2,1 noise "type" movei 2,[fldbk. .cmkey,,QTTab,"Query type,","*",keybrk,[ flddb. .cmkey,,TypTab,"an RR type,",,[ flddb. .cmnum,cm%sdh,10.,"a decimal type number"]]] call $comnd caie 4,.cmnum hrrz 2,(2) camn 2,[-1] move 2,qtmsk skipl 2 camle 2,qtmsk prserr "Type number out of range" movx 1,qs.qt adjbp 1,S idpb8 qs.qtl,2,1 movei 1,qs.len adjbp 1,S move S,1 ret prsrr: noise "TTL" movei 2,[flddb. .cmnum,cm%sdh,10.,"Time To Live, in seconds","0"] call $comnd camn 2,[-1] move 2,ttlmsk skipl 2 camle 2,ttlmsk prserr "Time-to-live out of range" movei 1,rr.tl adjbp 1,S idpb8 rr.tll,2,1 noise "class" movei 2,[flddb. .cmkey,,ClaTab,"Class,",,[ flddb. .cmnum,cm%sdh,10.,"a decimal class number"]] call $comnd caie 4,.cmnum hrrz 2,(2) camn 2,[-1] move 2,qcmsk skipl 2 camle 2,qcmsk prserr "Class number out of range" movei 1,rr.qc adjbp 1,S idpb8 rr.qcl,2,1 noise "type" movei 2,[flddb. .cmkey,,TypTab,"Type,",,[ flddb. .cmnum,cm%sdh,10.,"a decimal type number"]] call $comnd caie 4,.cmnum hrrz 2,(2) camn 2,[-1] move 2,qtmsk skipl 2 camle 2,qtmsk prserr "Type number out of range" movei 1,rr.qt adjbp 1,S idpb8 rr.qtl,2,1 movei 1,rr.dl adjbp 1,S push p,1 ;Save pointer to rdlength movei 1,rr.dat ;Point to data adjbp 1,S move S,1 cain 2,qt.hi jrst hidata cain 2,qt.mi jrst midata cain 2,qt.soa jrst soadat cain 2,qt.a jrst addata cain 2,qt.wks jrst wksdat caie 2,qt.mr cain 2,qt.mg jrst mbxdat caie 2,qt.cn cain 2,qt.mf jrst domdat caie 2,qt.md cain 2,qt.mb jrst domdat caie 2,qt.ns cain 2,qt.ptr jrst domdat anydat: noise "data" movei 2,[flddb. .cmtxt] call $comnd call savdat datlen: call $confm datln0: move 1,S sub 1,(p) ;Compute length movei 2,(1) imuli 2,4. ash 1,-41 sub 2,1 subi 2,rr.dll ;Don't count the RDLEN field itself pop p,1 ;Store it idpb8 rr.dll,2,1 ret parmbx: movei 2,[flddb. .cmtok,cm%sdh,,"username@domain"] hrrm 2,domfdx+.cmfnp movei 2,domfdb call $comnd move 2,cmdblk+.cmptr ildb 2,2 caie 2,"@ jrst savdom ildb 2,[ascptr atmbuf] jumpe 2,[prserr "Illegal user name"] call savstr movei 2,[flddb. .cmtok,,] call $comnd pardom: hllzs domfdx+.cmfnp movei 2,domfdb call $comnd jrst savdom mbxdat: noise "mailbox" call parmbx jrst datlen ;Maybe in the future allow foo@domain for mbxdat... domdat: noise "domain" call pardom jrst datlen hidata: noise "CPU type" movei 2,[fldbk. .cmkey,,cputab,"Standard CPU type,",,nambrk,[ fldbk. .cmfld,cm%sdh,,"a non-standard CPU type name",,nambrk]] call $comnd caie 4,.cmkey ;Have to copy the full name, in case used ifskp. ;completion move 1,(2) hrri 1,atmbuf blt 1,atmbuf+20 endif. call savstr noise "OS" movei 2,[fldbk. .cmkey,,ostab,"Standard Operating System,",,nambrk,[ fldbk. .cmfld,cm%sdh,,"a non-standard OS name",,nambrk]] call $comnd caie 4,.cmkey ifskp. move 1,(2) hrri 1,atmbuf blt 1,atmbuf+20 endif. call savstr jrst datlen midata: noise "responsible mailbox" call parmbx noise "error mailbox" call parmbx jrst datlen soadat: noise "source domain" call pardom noise "responsible mailbox" call parmbx noise "serial" movei 2,[flddb. .cmnum,cm%sdh,10.,"Decimal serial number"] call $comnd idpb8 soa.sl,2,S noise "refresh" movei 2,[flddb. .cmnum,cm%sdh,10.,"Refresh time in seconds"] call $comnd idpb8 soa.rl,2,S noise "retry" movei 2,[flddb. .cmnum,cm%sdh,10.,"Retry time in seconds"] call $comnd idpb8 soa.tl,2,S noise "expire" movei 2,[flddb. .cmnum,cm%sdh,10.,"Expiration time in seconds"] call $comnd idpb8 soa.el,2,S noise "minimum" movei 2,[flddb. .cmnum,cm%sdh,10.,"minimum TTL time in seconds"] call $comnd idpb8 soa.ml,2,S jrst datlen wksdat: movx 1,rr.qc-rr.dat ;Check class adjbp 1,S ildb8 rr.qcl,2,1 caie 2,qc.in ;Internet? jrst anydat ;No, dunno what to do call prsadr noise "protocol" movei 2,[flddb. .cmkey,,iprtab,"Internet protocol,",,[ flddb. .cmnum,cm%sdh,10.,"a decimal protocol number"]] call $comnd cain 4,.cmkey hrrz 2,(2) skipl 2 caile 2,377 prserr "Protocol number of out range" idpb 2,S movei T,[flddb. .cmnum,cm%sdh,10.,"a decimal port number"] caie 2,6. ;TCP? cain 2,17. ;or UDP? movei T,[flddb. .cmkey,,ipttab,"UDP/TCP service port,",,[ flddb. .cmnum,cm%sdh,10.,"a decimal port number"]] move 2,S ;Clear the next 256 bits movei 3,32. setz 1, do. idpb 1,2 sojg 3,top. enddo. noise "services" seto TT, do. move 2,T call $comnd cain 4,.cmkey hrrz 2,(2) skipl 2 caile 2,377 prserr "Port number of out range" idivi 2,8 camle 2,TT move TT,2 movei 1,200 movn 3,3 lsh 1,(3) adjbp 2,S ildb 3,2 ior 3,1 dpb 3,2 movei 2,[flddb. .cmcma,,,,",",[flddb. .cmcfm]] call $comnd cain 4,.cmcma loop. enddo. aoj TT, adjbp TT,S move S,TT jrst datln0 addata: movx 1,rr.qc-rr.dat ;Check class adjbp 1,S ildb8 rr.qcl,2,1 caie 2,qc.in ;Internet? jrst anydat ;No, dunno what to do call prsadr jrst datlen prsadr: noise "address" repeat 4,[ movei 2,[flddb. .cmnux,,10.] call $comnd skipl 2 caile 2,377 prserr "Byte out of range" idpb 2,S ifl .rpcnt-3,[ movei 2,[flddb. .cmtok,,,,"."] call $comnd ]] ret savstr: push p,S ibp S call savdat txne 2,#377 prserr "String too long" pop p,3 idpb 2,3 ret savdat: move 1,[ascptr atmbuf] setz 2, do. ildb 3,1 jumpe 3,endlp. cain 3,^V ildb 3,1 caie 3,"\ ifskp. ildb 3,1 jumpe 3,[prserr |Illegal "\" at end of string|] cail 3,"0 caile 3,"9 ifskp. movei 4,-"0(3) do. ildb 3,1 cail 3,"0 caile 3,"9 exit. imuli 4,10. addi 4,-"0(3) loop. enddo. seto 3, adjbp 3,1 move 1,3 txne 4,#377 prserr |Number following "\" won't fit in a byte| idpb 4,S aoja 2,top. endif. cain 3,^V ildb 3,1 endif. idpb 3,S aoja 2,top. enddo. ret savdom: move 1,[ascptr atmbuf] ibp S push p,S setz 2, do. ildb 3,1 caie 3,". cain 3,^@ txnn 2,#77 ifskp. prserr "Domain label too long" endif. caie 3,". ifskp. ifg. 2 dpb 2,(p) setz 2, ibp S movem S,(p) loop. endif. ildb 3,1 jumpn 3,[prserr "Illegal empty label in domain name"] endif. ife. 3 dpb 2,(p) skipe 2 idpb 3,S ;Add an empty label if needed adjsp p,-1 ret endif. cain 3,^V ildb 3,1 caie 3,"\ ifskp. ildb 3,1 jumpe 3,[prserr |Illegal "\" at end of domain name|] cail 3,"0 caile 3,"9 ifskp. movei 4,-"0(3) do. ildb 3,1 cail 3,"0 caile 3,"9 exit. imuli 4,10. addi 4,-"0(3) loop. enddo. seto 3, adjbp 3,1 move 1,3 txne 4,#377 prserr |Number following "\" won't fit in a byte| idpb 4,S aoja 2,top. endif. cain 3,^V ildb 3,1 endif. idpb 3,S aoja 2,top. enddo. nambrk: brmsk. keyb0.,keyb1.,keyb2.,keyb3.,[/],[] cputab: 0 ent "ALTO",,0 ent "C/30",,0 ent "C/70",,0 ent "DEC-1090T",,0 ent "DEC-2060",,0 ent "H-316",,0 ent "H-516",,0 ent "IBM-360/67",,0 ent "IBM-370/145",,0 ent "IBM-PC",,0 ent "IBM-PC/XT",,0 ent "PDP-11/70",,0 ent "PERQ",,0 ent "VAX-11/780",,0 endtab cputab ostab: 0 ent "ASP",,0 ent "AUGUST",,0 ent "BKY",,0 ent "CCP",,0 ent "DOS/360",,0 ent "ELF",,0 ent "EPOS",,0 ent "EXEC-8",,0 ent "GCOS",,0 ent "GPOS",,0 ent "INTERCOM",,0 ent "ITS",,0 ent "KRONOS",,0 ent "MCP",,0 ent "MOS",,0 ent "MPX-RT",,0 ent "MULTICS",,0 ent "MVT",,0 ent "NOS",,0 ent "NOS/BE",,0 ent "OS/MVS",,0 ent "OS/MVT",,0 ent "RIG",,0 ent "RSX11",,0 ent "RSX11M",,0 ent "RT11",,0 ent "SCOPE",,0 ent "SIGNAL",,0 ent "SINTRAN",,0 ent "TENEX",,0 ent "TOPS10",,0 ent "TOPS20",,0 ent "TSS",,0 ent "UNIX",,0 ent "VM/370",,0 ent "VM/CMS",,0 ent "VMS",,0 ent "WAITS",,0 endtab ostab ;;Internet protocols iprtab: 0 ent "BBN-RCC-MON",,10. ent "BR-SAT-MON",,76. ent "CFTP",,62. ent "CHAOS",,16. ent "DCN-MEAS",,19. ent "EGP",,8. ent "GGP",,3. ent "HMP",,20. ent "ICMP",,1. ent "IPCV",,71. ent "IPPC",,67. ent "LEAF-1",,25. ent "LEAF-2",,26. ent "MIT-SUBNET",,65. ent "MUX",,18. ent "NVP",,11. ent "PRM",,21. ent "PUP",,12. ent "RVD",,66. ent "SAT-EXPAK",,64. ent "SAT-MON",,69. ent "ST",,5. ent "TCP",,6. ent "TRUNK-1",,23. ent "TRUNK-2",,24. ent "UCL",,7. ent "UDP",,17. ent "WB-EXPAK",,79. ent "WB-MON",,78. ent "XNET",,15. ent "XNS-IDP",,22. endtab iprtab ;;TCP/UDP Ports ipttab: 0 ent "CHARGEN",,19. ent "CSNET-NS",,105. ent "DAYTIME",,13. ent "DCP",,93. ent "DISCARD",,9. ent "DOMAIN",,53. ent "ECHO",,7. ent "FINGER",,79. ent "FTP",,21. ent "GRAPHICS",,41. ent "HOSTNAME",,101. ent "HOSTS2-NS",,81. ent "ISI-GL",,55. ent "LA-MAINT",,51. ent "LINK",,245. ent "LOGIN",,49. ent "METAGRAM",,99. ent "MIT-DOVER",,91. ent "MIT-MLDEV",,83. ent "MPM",,45. ent "MPM-FLAGS",,44. ent "MSG-AUTH",,31. ent "MSG-ICP",,29. ent "NAMESERVER",,42. ent "NETSTAT",,15. ent "NICNAME",,43. ent "NIFTP",,47. ent "NIMAIL",,61. ent "NSW-FE",,27. ent "PRINTER",,35. ent "QUOTE",,17. ent "RJE",,5. ent "RTELNET",,107. ent "SMTP",,25. ent "SU-MIT-TG",,89. ent "SUPDUP",,95. ent "SUR-MEAS",,243. ent "TELNET",,23. ent "TFTP",,69. ent "TIME",,37. ent "USERS",,11. endtab ipttab abtint: exch 1,abtpc ;^G comes here ifn. 1 ;Enabled? movem 1,@levtab+abtlev-1 ;Yes, new return address $pout "%~%%Aborting...." endif. move 1,abtpc setzm abtpc DEBRK% Lose: movei 1,.fhslf GETER% emsg "Unexpected error (" call .erstr tmsg ") at " movei 1,.priou pop p,2 movei 2,-2(2) movei 3,8 NOUT% nop Diecr: tmsg " " Die: move 1,[.prast,,.fhslf] movei 2,[.prkil,,0] movei 3,1 PRARG% ernop HALTF% jrst Die .Lose=: .erstr: movei 1,.priou hrli 2,.fhslf setz 3, ERSTR% jrst [tmsg "Undefined error #" movei 1,.priou movei 2,(2) movei 3,8 NOUT% nop ret] jrst [tmsg "[Error printing error message]" ret] ret rskp: aos (p) cret: ret retskp=: ipblk: 0 iphdr: block iplen udphdr: block udplen packet: block %ipmxw-udplen-iplen end begin