
<<ArpaNameQueryImpl.mesa>>
    <<John Larson, October 31, 1987 10:15:58 pm PST>>

DIRECTORY
Arpa USING [Address, nullAddress],
ArpaNameBuf USING [domainPort, hdrBytes, maxBodyBytes, Buffer, Port], 
ArpaNameQuery, 
ArpaUDP USING [AllocBuffers, Create, Destroy, Error, FreeBuffers, Get, GetRemoteAddress, Handle, Kick, Milliseconds, ReceivedError, 
Put, SetUserBytes],
ArpaUDPBuf USING [Buffer],
Basics USING [BytePair, HighByte, LongNumber, LowByte],
BasicTime USING [GetClockPulses, Pulses, PulsesToMicroseconds],
Rope USING [Concat, Fetch, Find, FromChar, Length, ROPE, Substr];

ArpaNameQueryImpl: CEDAR PROGRAM
IMPORTS ArpaUDP, Basics, BasicTime, Rope
EXPORTS ArpaNameQuery =
BEGIN OPEN ArpaNameQuery;

ROPE: TYPE = Rope.ROPE;


    Error: PUBLIC ERROR [code: ATOM] = CODE;
        <<Codes are those passed up by ArpaUDP.>>


EndOfData: SIGNAL = CODE;
<<Raised when no more udp data>>
<<>>
<<>>
sequenceNumber: CARDINAL _ 0;


Pointer: TYPE = REF PointerRec;
PointerRec: TYPE = RECORD[
ptr: CARDINAL _ 0
];


Query: PUBLIC PROC [
server: Arpa.Address _ Arpa.nullAddress, 
query: Rope.ROPE _ NIL, 
type: QType _ a, 
class: QClass _ in,
recurDesired:  BOOL _ FALSE,
protocol: Protocol _ udpOnly,
port: ArpaNameBuf.Port _ ArpaNameBuf.domainPort, 
timeout: ArpaUDP.Milliseconds _ 20000, 
retry: CARDINAL _ 0,
acceptErrors: BOOL _ FALSE] RETURNS [reply: Reply_NIL] = {

SELECT protocol FROM
udpOnly, retryWithTCP => reply _ UDPQuery[server, query, type, class, recurDesired, port, timeout, retry, acceptErrors];
tcpOnly => reply _ TCPQuery[server, query, type, class, recurDesired, port, timeout, retry, acceptErrors];
ENDCASE;

IF reply = NIL THEN RETURN;

IF reply.hdr.truncated AND protocol = retryWithTCP THEN 
reply _ TCPQuery[server, query, type, class, recurDesired, port, timeout, retry, acceptErrors];

};


TCPQuery: PROC [
server: Arpa.Address _ Arpa.nullAddress, 
query: Rope.ROPE _ NIL, 
type: QType _ a, 
class: QClass _ in,
recurDesired:  BOOL _ FALSE,
port: ArpaNameBuf.Port _ ArpaNameBuf.domainPort, 
timeout: ArpaUDP.Milliseconds _ 20000, 
retry: CARDINAL _ 0,
acceptErrors: BOOL _ FALSE] RETURNS [reply: Reply_NIL] = {};

UDPQuery: PROC [
server: Arpa.Address _ Arpa.nullAddress, 
query: Rope.ROPE _ NIL, 
type: QType _ a, 
class: QClass _ in,
recurDesired:  BOOL _ FALSE,
port: ArpaNameBuf.Port _ ArpaNameBuf.domainPort, 
timeout: ArpaUDP.Milliseconds _ 20000, 
retry: CARDINAL _ 0,
acceptErrors: BOOL _ FALSE]  
RETURNS [reply: Reply_NIL] = 
{
{ENABLE {UNWIND => NULL}; 
packetStart: BasicTime.Pulses;
id: CARDINAL _ (sequenceNumber _ sequenceNumber + 1);
done: BOOL _ FALSE;
sendBuf: ArpaUDPBuf.Buffer;
replyBuf: ArpaUDPBuf.Buffer;
sendNameBuf: ArpaNameBuf.Buffer;
replyNameBuf: ArpaNameBuf.Buffer;
length: CARDINAL _ 0;
handle: ArpaUDP.Handle _ ArpaUDP.Create[remoteAddress: server, remotePort: port, getTimeout: timeout, acceptErrors: acceptErrors];
IF handle = NIL THEN RETURN[]; 

sendBuf _ ArpaUDP.AllocBuffers[handle];
    TRUSTED { sendNameBuf _ LOOPHOLE[sendBuf]; };

sendNameBuf.hdr3.id _ id;
sendNameBuf.hdr3.qr _ query;
sendNameBuf.hdr3.opcode _ query;
sendNameBuf.hdr3.authoritative _ FALSE;
sendNameBuf.hdr3.truncated _ FALSE;
sendNameBuf.hdr3.recurDesired _ recurDesired;
sendNameBuf.hdr3.recurAvail _ FALSE;
sendNameBuf.hdr3.rcode _ ok;
sendNameBuf.hdr3.qdCount _ 0;
sendNameBuf.hdr3.anCount _ 0;
sendNameBuf.hdr3.nsCount _ 0;
sendNameBuf.hdr3.arCount _ 0;

FOR i: CARDINAL IN [0..retry] UNTIL done DO
length _ AppendQuery[sendNameBuf, query, type, class];
ArpaUDP.SetUserBytes[sendBuf, length + ArpaNameBuf.hdrBytes];
packetStart _ BasicTime.GetClockPulses[];
ArpaUDP.Put[sendBuf ! ArpaUDP.Error => IF acceptErrors THEN Error[code] ELSE EXIT; ArpaUDP.ReceivedError => IF acceptErrors THEN 
Error[code] ELSE EXIT];
UNTIL done OR (replyBuf _ ArpaUDP.Get[handle ! ArpaUDP.Error => IF acceptErrors THEN Error[code] ELSE EXIT; ArpaUDP.ReceivedError 
=> IF acceptErrors THEN Error[code] ELSE EXIT]) = NIL DO
packetStop: BasicTime.Pulses _ BasicTime.GetClockPulses[];
milliSeconds: LONG CARDINAL _ (BasicTime.PulsesToMicroseconds[packetStop-packetStart])/1000;
remoteAddress: Arpa.Address _ ArpaUDP.GetRemoteAddress[handle].address;
    TRUSTED { replyNameBuf _ LOOPHOLE[replyBuf]; };
reply  _ NEW[ReplyRecord];
reply.nRetries _ i;
reply.responseTime _ milliSeconds;
reply.source _ remoteAddress;
reply.domainPacketLength _ LOOPHOLE[replyNameBuf.hdr2.length];
reply.hdr _ replyNameBuf.hdr3;
ProcessDomainPacket[replyNameBuf, reply];
done _ TRUE;
ENDLOOP;
ENDLOOP;
IF replyBuf # NIL THEN ArpaUDP.FreeBuffers[replyBuf];  
sendNameBuf _ NIL; replyNameBuf _ NIL; sendBuf _ NIL; replyBuf _ NIL;
ArpaUDP.Kick[handle];
ArpaUDP.Destroy[handle]; 
}};

ProcessDomainPacket: PROC [udp: ArpaNameBuf.Buffer, reply: Reply] =  {
p: Pointer _ NEW[PointerRec];
p.ptr _ 0;
LoadQueries[udp, reply, p];
LoadAnswerRRs[udp, reply, p];
LoadAuthorityRRs[udp, reply, p];
LoadAdditionalRRs[udp, reply, p];
};


LoadQueries: PROC [udp: ArpaNameBuf.Buffer, reply: Reply, p: Pointer] =  {
ENABLE {UNWIND => NULL; EndOfData => GOTO Quit}; 
reply.questions _ NEW[QSequenceBody[reply.hdr.qdCount]];
FOR i: INT IN[0..reply.hdr.qdCount) DO
q: QuestionRecord _ NEW[QBody];
q.name _ GetCompressedName[udp, p];
q.type _ VAL[Basics.LowByte[GetTwoBytes[udp, p]]];
q.class _ VAL[Basics.LowByte[GetTwoBytes[udp, p]]];
reply.questions[i] _ q;
reply.qdCount _ reply.qdCount +1;
ENDLOOP;
EXITS 
Quit => RETURN;
};


LoadAnswerRRs: PROC [udp: ArpaNameBuf.Buffer, reply: Reply, p: Pointer] =  {
reply.answers _ NEW[RRSequenceBody[reply.hdr.anCount]];
reply.anCount _ LoadRRs[reply.hdr.anCount, reply.answers, udp, p];
};

LoadAuthorityRRs: PROC [udp: ArpaNameBuf.Buffer, reply: Reply, p: Pointer] =  {
reply.authority _ NEW[RRSequenceBody[reply.hdr.nsCount]];
reply.nsCount _ LoadRRs[reply.hdr.nsCount, reply.authority, udp, p];
};


LoadAdditionalRRs: PROC [udp: ArpaNameBuf.Buffer, reply: Reply, p: Pointer] =  {
reply.additional _ NEW[RRSequenceBody[reply.hdr.arCount]];
reply.arCount _ LoadRRs[reply.hdr.arCount, reply.additional, udp, p];
};


LoadRRs: PROC [inCount: CARDINAL, rrs: RRSequence, udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS[outCount: CARDINAL_0] =  {
ENABLE {UNWIND => NULL; EndOfData => GOTO Quit}; 
FOR i: INT IN[0..inCount) DO
name: ROPE _ GetCompressedName[udp, p];
type: RRType _ VAL[Basics.LowByte[GetTwoBytes[udp, p]]];
thisRR: ResourceRecord _ NewRR[type];
thisRR.type _ type;
thisRR.name _ name;
thisRR.class _ VAL[Basics.LowByte[GetTwoBytes[udp, p]]];
thisRR.ttl _ GetTtl[udp, p];
thisRR.dataLength _ GetTwoBytes[udp, p];

WITH thisRR SELECT FROM
rr: ARR =>  rr.address _ GetIPAddress[udp, p];
rr: NsRR => rr.serverRope _ GetCompressedName[udp, p];
rr: CNameRR => rr.cNameRope _ GetCompressedName[udp, p];
rr: PtrRR => rr.ptrRope _ GetCompressedName[udp, p];
rr: MbRR => rr.mbRope _ GetCompressedName[udp, p];
rr: MgRR => rr.mgRope _ GetCompressedName[udp, p];
rr: MrRR => rr.mrRope _ GetCompressedName[udp, p];
rr: MdRR => rr.mdRope _ GetCompressedName[udp, p];
rr: MfRR => rr.mfRope _ GetCompressedName[udp, p];
rr: NullRR => rr.nullRope _ GetCompressedName[udp, p];
rr: SoaRR => {
rr.soaRec.primaryServer _ GetCompressedName[udp, p];
rr.soaRec.domainContact _ GetCompressedName[udp, p];
rr.soaRec.serial _ GetCard[udp, p];
rr.soaRec.refresh _ GetCard[udp, p];
rr.soaRec.retry _ GetCard[udp, p];
rr.soaRec.expire _ GetCard[udp, p];
rr.soaRec.minTtl _ GetCard[udp, p]};
rr: WksRR => {
tempPortArray: ARRAY[0..100) OF CARDINAL;
nPorts: CARDINAL _ 0;
port: INT _ 0;
rr.wksRec.address _ GetIPAddress[udp, p];
rr.wksRec.protocol _ GetOneByte[udp, p];
FOR j: INT IN [5..rr.dataLength) DO   -- parse port bit array
byte: INT [0..255] _ GetOneByte[udp, p];
FOR k: INT IN [0..8) DO
IF byte >= 80H THEN {
byte _ byte - 80H;
tempPortArray[nPorts] _ port;
nPorts _ nPorts +1};
byte _ byte * 2;
port _ port + 1;
ENDLOOP;
ENDLOOP;
rr.wksRec.nPorts _ nPorts;
rr.wksRec.ports _ NEW[PortSequenceBody[nPorts]];
FOR j: INT IN [0..nPorts) DO
rr.wksRec.ports[j] _ tempPortArray[j];
ENDLOOP;
};
rr: HinfoRR => {
rr.hinfoRec.cpu _ GetRope[udp, p]; 
rr.hinfoRec.os _ GetRope[udp, p]};
rr: MinfoRR => {
rr.minfoRec.rmailbx _ GetCompressedName[udp, p]; 
rr.minfoRec.emailbx _ GetCompressedName[udp, p]};
rr: MxRR => {
rr.mxRec.preference _ GetCardinal[udp, p];
rr.mxRec.host _ GetCompressedName[udp, p]};
ENDCASE =>  p.ptr _ p.ptr + thisRR.dataLength;  -- unknown type
rrs[i] _ thisRR;
outCount _ outCount +1;
ENDLOOP;
EXITS 
Quit => RETURN;
};


NewRR: PROC [type: RRType] RETURNS[ResourceRecord] = {
RETURN[
SELECT type FROM
a => NEW[a RRBody],
ns => NEW[ns RRBody],
cName => NEW[cName RRBody],
ptr => NEW[ptr RRBody],
mb => NEW[mb RRBody],
mg => NEW[mg RRBody],
mr => NEW[mr RRBody],
md => NEW[md RRBody],
mf => NEW[mf RRBody],
null => NEW[null RRBody],
soa => NEW[soa RRBody],
wks => NEW[wks RRBody],
hinfo => NEW[hinfo RRBody],
minfo => NEW[minfo RRBody],
mx => NEW[mx RRBody],
ENDCASE => NIL 
];

};


<<Yuk... Much of this code is from the old Arpanet mail gateway and is rather crufty, but it seems to work and I don't have time to 
clean it up right now....>>


AppendQuery: PROC [
udp: ArpaNameBuf.Buffer, query: ROPE, type: QType, class: QClass] RETURNS[length: CARDINAL_0] =  {
p: Pointer _ NEW[PointerRec];
p.ptr _ 0;
AppendName[udp, query, p];
AppendTwoBytes[udp, LOOPHOLE[type], p];
AppendTwoBytes[udp, LOOPHOLE[class], p];
udp.hdr3.qdCount _ udp.hdr3.qdCount + 1; 
length _ p.ptr;
};

AppendName: PROC [
udp: ArpaNameBuf.Buffer, name: ROPE, p: Pointer] =  {
DO
dot: INT _ Rope.Find[name, "."];
IF dot = -1 THEN EXIT;
IF dot = 0 THEN EXIT; -- Bounds fault
AppendFragment[udp, Rope.Substr[name, 0, dot], p];
name _ Rope.Substr[name, dot+1]
ENDLOOP;
IF Rope.Length[name] # 0 THEN AppendFragment[udp, name, p];
AppendFragment[udp, NIL, p]; };

AppendFragment: PROC [
udp: ArpaNameBuf.Buffer, rope: ROPE, p: Pointer] =  {
ptr: CARDINAL _ p.ptr;
chars: CARDINAL _ Rope.Length[rope];
udp.body.bytes[ptr] _ chars;
FOR i: CARDINAL IN [0..chars) DO
udp.body.bytes[ptr+i+1] _ LOOPHOLE[Rope.Fetch[rope, i]];
ENDLOOP;
p.ptr _ p.ptr + chars + 1; };

AppendTwoBytes: PROC [
udp: ArpaNameBuf.Buffer, data: UNSPECIFIED, p: Pointer] =  {
ptr: CARDINAL _ p.ptr;
udp.body.bytes[ptr] _ Basics.HighByte[data];
udp.body.bytes[ptr+1] _ Basics.LowByte[data];
p.ptr _ p.ptr + 2; };

AppendIPAddress: PROC [
udp: ArpaNameBuf.Buffer, address: Arpa.Address, p: Pointer] =  {
ptr: CARDINAL _ p.ptr;
udp.body.bytes[ptr+0] _ address.a;
udp.body.bytes[ptr+1] _ address.b;
udp.body.bytes[ptr+2] _ address.c;
udp.body.bytes[ptr+3] _ address.d;
p.ptr _ p.ptr + 4; };

GetCompressedName: PROC [udp: ArpaNameBuf.Buffer, p: Pointer] 
RETURNS [rope: ROPE] =  {
ptr: CARDINAL _ p.ptr;
indirect: CARDINAL _ 300B;
rope _ NIL;
DO
bytes: CARDINAL;
IF ptr >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
bytes _ udp.body.bytes[ptr];
ptr _ ptr + 1;
IF bytes = 0 THEN EXIT;
IF bytes >= indirect THEN { -- Indirect link, keep length we have
temp: CARDINAL;
IF ptr >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
temp _ (bytes-indirect)*256 + udp.body.bytes[ptr];
temp _ temp - ArpaNameBuf.hdrBytes;
ptr _ ptr + 1;
p.ptr _ temp;
rope _ Rope.Concat[rope, GetCompressedName[udp, p]];
EXIT; };
FOR i: CARDINAL IN [0..bytes) DO
IF ptr >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
rope _ Rope.Concat[rope, Rope.FromChar[LOOPHOLE[udp.body.bytes[ptr]]]];
ptr _ ptr + 1;
ENDLOOP;
IF ptr >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
IF udp.body.bytes[ptr] # 0 THEN rope _ Rope.Concat[rope, "."];
ENDLOOP;
p.ptr _ ptr; };


GetTtl: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [Seconds] = {
RETURN[GetCard[udp, p]]; };

GetCard: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [CARD32] = {
ln: Basics.LongNumber;
ln.hi _ GetCardinal[udp, p];
ln.lo _ GetCardinal[udp, p];
RETURN[ln.lc]; };

GetCardinal: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [CARDINAL] = {
RETURN[GetTwoBytes[udp, p]]; };

GetTwoBytes: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [UNSPECIFIED] =  {
ptr: CARDINAL _ p.ptr;
temp: Basics.BytePair;
IF ptr +1 >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
temp.high _ udp.body.bytes[ptr];
temp.low _ udp.body.bytes[ptr+1];
p.ptr _ p.ptr + 2;
RETURN[LOOPHOLE[temp]]; };

GetIPAddress: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [a: Arpa.Address] =  {
ptr: CARDINAL _ p.ptr;
IF ptr + 3 >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
a.a _ udp.body.bytes[ptr+0];
a.b _ udp.body.bytes[ptr+1];
a.c _ udp.body.bytes[ptr+2];
a.d _ udp.body.bytes[ptr+3];
p.ptr _ p.ptr + 4; };

GetOneByte: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [UNSPECIFIED] =  {
ptr: CARDINAL _ p.ptr;
temp: Basics.BytePair;
IF ptr  >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
temp.high _ 0;
temp.low _ udp.body.bytes[ptr];
p.ptr _ p.ptr + 1;
RETURN[LOOPHOLE[temp]]; };

GetChar: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [c: CHAR] =  {
ptr: CARDINAL _ p.ptr;
IF ptr  >= ArpaNameBuf.maxBodyBytes THEN SIGNAL EndOfData;
c _ LOOPHOLE[udp.body.bytes[ptr]];
p.ptr _  p.ptr + 1;
RETURN[c]; };

 
GetRope: PROC [
udp: ArpaNameBuf.Buffer, p: Pointer] RETURNS [rope: Rope.ROPE_NIL] =  {
chars:  CARDINAL _ GetOneByte[udp, p];
rope _ NIL;
FOR  i: INT IN [0..chars) DO
rope _ Rope.Concat[rope, Rope.FromChar[GetChar[udp, p]]];
ENDLOOP;
RETURN[rope]; };


END.