{$X+}
program query;

include {NOLIST}'domain:jsys.def';
include {NOLIST}'pascal:pascmd.pas';
include {NOLIST}'domain:mdep.def';
include {NOLIST}'domain:master.def';
include {NOLIST}'domain:lparse.def';
include {NOLIST}'domain:udp.def';
include {NOLIST}'domain:udp.hdr';
include {NOLIST}'domain:msub.hdr';
include {NOLIST}'domain:dsconv.hdr';
include {NOLIST}'domain:tface.hdr';
include {NOLIST}'domain:iopkt.hdr';
include {NOLIST}'domain:pp.hdr';
include {NOLIST}'domain:iomsg.hdr';
include {NOLIST}'domain:mdep.hdr';

var	ac1, ac2,i, j, len, ret, qid:integer;
	retran_interval:integer;{ seconds of wait for a response }
	retran_count:integer;	{ number of times to send a request }
	forever, dg_dump:boolean;
	server_atom:atom;
	server_name:big_atom;
	keytbl:table;
	port:field16;
	address:field32;
	req:query_template;
	myfbp:file_blk_ptr;


procedure qry_reset(var query:query_template);

{ Reset header and count of query_template }

var	loopvar:sectcode;

begin
    with query.header do
    begin
	id:=0;
	response:=false;
	opcode:=0;
	aa:=false;
	tc:=false;
	rd:=false;
	ra:=false;
	rcode:=0;
	qdcount:=0;
	ancount:=0;
	nscount:=0;
	arcount:=0;
    end;
    
    for loopvar:=answer to additional do
    with query.sdata[loopvar] do
    begin
	exp_count:=0;
	int_count:=0;
    end;
end; {qry_reset}



procedure find_address(var qry:query_template);
		
{ Format the request and send it to the name server. Check
  for a response every 0.5 seconds and accept the response	  
  having an id which matches the id of the request sent.
  Retransmit the request if a response has not been received
  after every 5 seconds for up to 3 retransmits.  The query
  attempt is aborted if a response is not received after a
  further 5 seconds (20 seconds in all).  Validate and
  output the correct response. }

var	i, j, timeout, diff:integer;
	ok, valid_response:boolean;
	resp:query_template;

begin  {find_address}
    valid_response:=false;
    qry.rawmsg.xmit_using:=dgm;
    timeout:=retran_interval*2*retran_count;

    ok:=format_pkt(qry,qry.rawmsg);
    if not ok
    then  {couldn't correctly format pkt}
	writeln('Query completion aborted')
    else begin
	     udp_send(qry.rawmsg);  {send the query}

	     { If response with correct name not received after
               5 seconds retransmit; after 20 elapsed seconds,
	       return control to user. }
	     repeat
		 jsys(disms, -2, ret; 500);     { wait 500 ms. }
		 if udp_receive(resp.rawmsg, false)
		 then begin  {accept datagram} 
			  if dg_dump  {print received pkt if desired}
			  then dump_pkt(resp.rawmsg);

			  {make superficial checks on pkt header}
			  with resp.rawmsg.raw_pkt.header do
			  begin    
			      if band(id, "fff0)<>band(qry.header.id, "fff0)
			      then begin  {old pkt}
				       writeln('Stale pkt:', id:4:h,
					       ' expecting:',qry.header.id);
				       dump_pkt(resp.rawmsg);
				   end
			      else begin
				       if id<>qry.header.id
				       then writeln('Previous pkt:',id:4:h)
				       else writeln( 'Matching pkt:', id:4:h);
				       if response
						and (opcode=qry.header.opcode)
				       then valid_response:=true
				       else valid_response:=false;
				   end;
			  end;
		      end {accept datagram}
		 else begin
			  timeout:=timeout-1;
			  {retransmit request every 5 seconds if no resonse }
			  if ((timeout mod (retran_interval*2))=0) and (timeout<>0)
			      then begin {retransmit request}
				       {bump id to reflect rexmit}
				       qry.rawmsg.raw_pkt.header.id:=
				       qry.rawmsg.raw_pkt.header.id+1;
				       udp_send(qry.rawmsg);
				       writeln('Request retransmitted');
				   end;  {retransmit request}
		      end
		 until valid_response or (timeout=0);
	     
	     if timeout=0
	     then begin {failure message}
		      writeln('Valid response not received.');
		      writeln('Query completion aborted.');
		  end   {failure message}
	     else begin
		  if resp.rawmsg.raw_pkt.header.rcode<>no_error
		  then with resp.rawmsg.raw_pkt.header
		       do begin
			      {report header information}
			      if aa or tc
			      then begin
				       write('Response:  ');
				       if aa
				       then write('Authoritative  ');
				       if tc
				       then write('Truncated');
				       writeln;
				   end;
			      pr_error(rcode)
			  end;
		  if (parse_pkt(resp.rawmsg, resp))
		  then pr_response(resp)
		  else writeln('Faulty packet received')
		  end;
	 end;
end; {find_address}

procedure lset_server(addr:field32;
		      port:field16);

var     myatom:atom;

begin
ppina(addr,myatom);
writeln('Using address ',myatom,' and port ',port:5,'(decimal)');
set_server(addr,port)
end; {lset_server}
{----------------------------------------

-----------------------------------------}

begin  {query}

    {**Initialization*}
    pp_init;
    initmaster;

    reset(input,'tty:', '/i');  {interactive file}
    rewrite(output,'tty:');

    forever:=true;
    dg_dump:=false;   {don't print datagrams}
    qid:=0;  {query id for domain header}	
    init_query(false);  {"false" means not the server}

    retran_interval:=10;
    retran_count:=3;

    writeln('Domain-style Query Program--');
    writeln;
    writeln('Use QUIT or EXIT to terminate.');
    writeln('    DUMP/NODUMP to enable/disable UDP data');
    writeln('                printing (octal) upon receipt.');
    writeln('    SERVER to change target nameserver locations.');
    writeln('	        Initial nameserver-- A.ISI.EDU port 53.');
    writeln('    QUERY OPERATIONS: std, inv, cm, cu');
    writeln;

    { set up keyword command table }
    keytbl:=tbmak(9);	   {make a table for keywords}
    tbadd(keytbl, 0, 'Exit', 0);
    tbadd(keytbl, 1, 'Quit', 0);
    tbadd(keytbl, 2, 'Dump', 0);
    tbadd(keytbl, 3, 'Nodump', 0);
    tbadd(keytbl, 4, 'Server', 0);
    tbadd(keytbl, 5, 'std', 0);
    tbadd(keytbl, 6, 'inv', 0);
    tbadd(keytbl, 7, 'cm', 0);
    tbadd(keytbl, 8, 'cu', 0);

    while forever do
	begin  {get user request}
	    with req.rawmsg
	    do	 begin
		     to_address:=0;
		     from_address:=0
		     end;
	writeln;
	cminir('QUERY OPERATION:  ');  {prompt to user}
	j:=cmkey(keytbl);		 {keyword expected}
	case j of
	    0,1: begin   {'exit or quit'--release queue}
		     quit_query(dgm);
		     forever:=false;
		 end;  {'exit or quit'}
	    
	    2: dg_dump:=true;  {enable datagram printing}
	    
	    3: dg_dump:=false; {disable datagram printing}

	    4: begin {'server'--assign name server}
		     write('host(string or address)  port(optional):  ');
		     readln;  {clear eoln}
		     read(server_name:len:[' ']);
		     if not eoln
		     then read(port)
		     else port:=53;
		     jsys(gthst_, -2, ret; gthsn_, 
			   server_name; ac1, ac2, address);
		     if ret=3 
		     then begin {jsys error}
			      {try to convert as if dotted decimal notation}
			      for i:=1 to max_atom_chars
		              do if i<=len
			         then server_atom[i]:=server_name[i]
				 else server_atom[i]:=' ';
			      if (len<=max_atom_chars) and not (cvina(server_atom, address))
			      then begin
				       {use server file open to init
					myfbp in order to conform to
					jsys_err calling requirements}
				       myfbp:=ofile(err);
				       writeln(myfbp^.fident,
					       'jsys GTHST failed' );
				       {print error messag}
				       jsys_err(noabort, -1, myfbp);
				       writeln(myfbp^.fident,
					       'Try another name server.');
				       writeln(myfbp^.fident);
				   end
			      else lset_server(address, port);
			  end  {jsys error}
		     else lset_server(address, port);
	       end;  {'server'--assign name server}
	    
	    5,6,7,8: begin  {query operation}
			 with req.header do
			 begin
			     {reset req internals}
			     qry_reset(req);

			     {consider id 12 bits request +
			      4 bits rexmit}
			     qid:=qid+"10;
			     if qid>"10000
			     then qid:=0;	 
			     id:=qid;
			     opcode:=j-5;

			     {prompt for query input}
			     case opcode of
				 std_query: begin
						qdcount:=1;
						writeln('question section');
						get_qsctn(req.q_section, 
							 qdcount);
					    end;
				 inv_query: begin
						ancount:=1;
						req.sdata[answer].exp_count:=
							       ancount;
						writeln('answer section');
						get_exp_sctn(
						     req.sdata[answer], 
						     opcode);
					    end;
				 cm_query,
				 cu_query: begin
					       qdcount:=1;
					       arcount:=1;
					       req.sdata[additional].
						   exp_count:=arcount;
					       writeln('question section');
					       get_qsctn(req.q_section, 
							 qdcount);
					       writeln('additional section');
					       get_exp_sctn(
						    req.sdata[additional],
						    opcode);
					   end;
			     end; {case}
			     find_address(req);
			 end; {with}
		     end; {query operation}
	     end; { case j }
     end; {while loop}
end. {query}