{$M-,X+}
program rrup;

{ This file contains obsolete routines that still use the exp_ data
  types, use naddrr for new programs }

include {NOLIST} 'domain:mdep.def';
include {NOLIST} 'domain:master.def';
include {NOLIST} 'domain:hash.hdr';
include {NOLIST} 'domain:msub.hdr';
include {NOLIST} 'domain:alloc.hdr';
include {NOLIST} 'domain:iomsg.hdr';
include {NOLIST} 'domain:eutil.hdr';

procedure walklabel(var myzone:zone_entry;
			procedure callee);

{	WALKULABEL walks the label table of a zone and
	calls its target procedure with an argument of
	a ulabel_pointer
}

var	i,j:integer;
	pscan:^secondary_label_table;
	sscan:ulabel_pointer;

begin
with myzone.ltable
do	begin
	if direct<>NIL	{ do the root entry }
	then	callee(direct);
	for i:=0 to 255
	do	begin
		pscan:=stable[i];	{ scan all of the secondary tables }
		if pscan<>NIL
		then	begin
			if pscan^.direct<>NIL
			then	callee(pscan^.direct);
			for j:=0 to 255
			do	begin
				sscan:=pscan^.lchain[j];
				while sscan<>NIL
				do	begin
					callee(sscan);
					sscan:=sscan^.next
					end
				end
			end
		end
	end
end; { walklabel }
procedure makeulabel(	var myzone:zone_entry;
			var mylabel:exp_label;
			    point:ulabel_pointer);

{	MAKEULABEL creates a new ulabel, and is used after a 
	failure of findulabel
}

var	i,j:integer;
	leroy:ulabel_pointer;
	temp:^secondary_label_table;
	
begin
a_ulabel(myzone,leroy,max_lab_chars-mylabel.labinfo[0]); { get a new one }
copyls(xseto(mylabel.labinfo),xseto(leroy^.text));
leroy^.nodeptr:=NIL;
leroy^.next:=NIL;
if point<>NIL	{ if POINT is non-NIL, do list insertion }
then	begin
	leroy^.next:=point^.next;
	point^.next:=leroy
	end
else	begin	{ otherwise insert in the primary or secondary table }
	i:=mylabel.labinfo[0];
	if i=0
	then	{ zero length goes into the primary direct entry }
		myzone.ltable.direct:=leroy
	else	begin	{ off secondary table }
		temp:=myzone.ltable.stable[mylabel.labinfo[1]];
		if temp=NIL
		then	{ construct the secondary }
			begin
			a_slt(myzone,temp);
			temp^.direct:=NIL;
			for j:=0 to 255
			do	temp^.lchain[j]:=NIL;
			myzone.ltable.stable[mylabel.labinfo[1]]:=temp
			end;
		if i=1
		then	{ direct entry of secondary table }
			temp^.direct:=leroy
		else	begin
			leroy^.next:=temp^.lchain[mylabel.labinfo[2]];
			temp^.lchain[mylabel.labinfo[2]]:=leroy
			end
		end
	end
end; { makeulabel }

function findulabel(	var myzone:zone_entry;
			var mylabel:exp_label;
			var point:ulabel_pointer):boolean;

{	FINDULABEL looks for a unique label in the specified zone.

	If it finds the label, it returns true and sets the
	POINT argument to the ulable's index in the zone's
	label_table.

	If it cannot find the label, it returns false, and sets
	POINT to be either NIL if the label is the first on its
	chain or to point to the existing label it should follow
}

var	i,cresult:integer;
	temp:^secondary_label_table;
	spoint:ulabel_pointer;

begin
i:=mylabel.labinfo[0];
findulabel:=false;

if i>1
then	begin	{ normal case, search chain }
	temp:=myzone.ltable.stable[mylabel.labinfo[1]];
	if temp=NIL
	then	point:=NIL
	else	begin	{ search for label down chain }
		point:=NIL;
		spoint:=temp^.lchain[mylabel.labinfo[2]];
		while spoint<>NIL
		do	begin
			cresult:=lcomp(mylabel.labinfo,spoint^.text);
			if cresult=0
			then	begin
				point:=spoint;
				findulabel:=true;
				spoint:=NIL	{ kick out of loop }
				end
			else	if cresult>0
				then	begin   { after this one }
					point:=spoint;
					spoint:=spoint^.next
					end
				else	spoint:=NIL	{ before here }
			end
		end
	end
else	begin
	if i=0
	then	{ special case for root }
		point:=myzone.ltable.direct
	else	{ length is one, direct from secondary }
		begin
		temp:=myzone.ltable.stable[mylabel.labinfo[1]];
		if temp=NIL
		then	point:=NIL
		else	point:=temp^.direct
		end;
	findulabel:=point<>NIL
	end

end; { findulabel }

function goulabel(var myzone:zone_entry;
		  var mylabel:exp_label):ulabel_pointer;

{	GOULABEL returns a ulabel pointer for the label specified
	by mylabel, creating it if necessary
}

var	point:ulabel_pointer;

begin
while not findulabel(myzone,mylabel,point)
do	makeulabel(myzone,mylabel,point);

goulabel:=point

end; { goulabel }

function finddname(var myzone:zone_entry;
			var myname:exp_dname;
			var missing:integer;
			var point:dname_pointer):boolean;

var	found:boolean;
	current_level:integer;
	ltpoint:label_hashtable_pointer;
	spoint,last_match:dname_pointer;
	lcheck:ulabel_pointer;

begin
current_level:=1;
last_match:=NIL;

repeat	found:=false;
	if findulabel(myzone,myname.dlabels[myname.count-current_level+1],lcheck)
	then	{ if the label exists, it is worth doing a search }
		begin
		ltpoint:=myzone.dtable[current_level];
		if ltpoint=NIL
		then	spoint:=NIL
		else	spoint:=ltpoint^.dname_hash[hashls(
				myname.dlabels[myname.count-current_level+1].labinfo)];
		while (spoint<>NIL) and not(found)
		do	if spoint^.more<>last_match
			then	spoint:=spoint^.dname_chain
			else	if lcheck=spoint^.dlabel.labptr
				then	if elcomp(myname.dlabels[myname.count-current_level+1],
							spoint)
					then	begin	{ labels are the same }
						found:=true;
						last_match:=spoint
						end
					else	spoint:=spoint^.dname_chain
				else	spoint:=spoint^.dname_chain;
		if spoint<>nil
		then	current_level:=current_level+1
		end
until	not(found) or (current_level>myname.count);

point:=last_match;
finddname:=found;
if found
then	missing:=0
else	missing:=myname.count-current_level+1

end; { finddname }

function makedname(var myzone:zone_entry;
		   var myname:exp_label;
		       level:integer;
		       point:dname_pointer):dname_pointer;

{	MAKEDNAME makes a new dname with LEVEL labels using the
	LEVEL-1 labels pointed to by POINT.
}

var	j:integer;
	child:dname_pointer;

begin
a_dname(myzone,child);
with child^
do	begin
	dlabel.labptr:=goulabel(myzone,myname);
	dlabel.case_mod:=myname.case_mod;
	more:=point;
	j:=hashls(myname.labinfo);
	if myzone.dtable[level]=NIL
	then	a_lht(myzone,myzone.dtable[level]);
	dname_chain:=myzone.dtable[level]^.dname_hash[j];
	myzone.dtable[level]^.dname_hash[j]:=child
	end;

makedname:=child

end; { makedname }

function godname(var myzone:zone_entry;
		 var myname:exp_dname):dname_pointer;

{	GODNAME returns a pointer to the specified domain name,
	creating one if necessary
}

var	i,missing:integer;
	point:dname_pointer;

begin
if not finddname(myzone,myname,missing,point)
then	for i:=missing downto 1
	do	point:=makedname(myzone,
				myname.dlabels[i],
				myname.count-i+1,
				point);

godname:=point;

end; { godname }

function newnode(var myzone:zone_entry):node_pointer;

{	NEWNODE gets a new node from free storage and initializes
	all of its pointers to NIL
}
var	foo:node_pointer;

begin
a_node(myzone,foo);
with foo^
do	begin
	node_lchain:=NIL;
	up_ptr:=NIL;
	side_ptr:=NIL;
	down_ptr:=NIL;
	down_tbl:=NIL;
	rr_ptr:=NIL
	end;

newnode:=foo

end; { newnode }

procedure hashson(var myzone:zone_entry;
		      mynode:node_pointer);

{	HASHSON creates a has table for the specified node	}

var	chain:node_pointer;
	break:node_pointer;
	insert:node_pointer;
	done:boolean;
	index:label_hashrange;

begin
if mynode^.down_tbl=NIL
then	begin
	a_lht(myzone,mynode^.down_tbl);
	for index:=0 to label_hashmod-1
	do	mynode^.down_tbl^.node_hash[index]:=NIL;
	chain:=mynode^.down_ptr;
	mynode^.down_ptr:=NIL;
	while	chain<>NIL
	do	begin
		break:=chain^.side_ptr;
		chain^.side_ptr:=NIL;
		index:=hashls(chain^.node_label.labptr^.text);
		insert:=mynode^.down_tbl^.node_hash[index];
		if insert=NIL
		then	mynode^.down_tbl^.node_hash[index]:=chain
		else	if lcomp(chain^.node_label.labptr^.text,
				insert^.node_label.labptr^.text)
			> 0
			then	begin (* insert after first node *)
				done:=false;
				while not(done)
				do if insert^.side_ptr=NIL
					then	done:=true
					else	if lcomp(chain^.node_label.labptr^.text,
							insert^.side_ptr^.node_label.labptr^.text)
						<0
						then	done:=true
						else	insert:=insert^.side_ptr;
				chain^.side_ptr:=insert^.side_ptr;
				insert^.side_ptr:=chain
				end
			else	begin (* insert at head of list *)
				chain^.side_ptr:=insert;
				mynode^.down_tbl^.node_hash[index]:=chain
				end;
		chain:=break
		end
	end
end; { hashson }

function makeson(var myzone:zone_entry;
		     father:node_pointer;	{ new father }
		 var leroy:exp_label;		{ name of child }
		     brother:node_pointer	{ prior brother, if any }
		):node_pointer;

{	MAKESON creates a new child node using an insertion pointer
	supplied in brother.  In general, this function will be called
	after a call to FINDSON fails, and uses the insertion data supplied
	by a losing findson call.
}
var	child:node_pointer;
	temp:label_hashrange;
begin
child:=newnode(myzone);
with child^
do	begin
	up_ptr:=father;
	if brother=NIL	{ insert child }
	then	{ first child of this father }
		begin
		if father^.down_tbl=NIL
		then	begin
			side_ptr:=father^.down_ptr;
			father^.down_ptr:=child
			end
		else	begin
			temp:=hashls(leroy.labinfo);
			side_ptr:=father^.down_tbl^.node_hash[temp];
			father^.down_tbl^.node_hash[temp]:=child
			end
		end
	else	begin	{ just another kid }
		side_ptr:=brother^.side_ptr;
		brother^.side_ptr:=child
		end;
	{ set up the child's node label }
	node_label.case_mod:=leroy.case_mod;
	node_label.labptr:=goulabel(myzone,leroy)
	end;

makeson:=child;

end; { makeson }

function findson(var mynode:node_pointer;
		var mylabel:exp_label;
		var return_ptr:node_pointer;
		var n_searched:integer):boolean;

{	FINDSON looks for the node labeled MYLABEL at the father node
	specified by MYNODE.  If the son is found , the function returns
	true, and returns a pointer to the specified node via return_ptr

	If the function returns false, return_ptr is set to indicate where
	such a son should be inserted.  If at the start of the list,
	NIL is returned, otherwise a pointer to a node to which the new
	son should be appended

	In any case, n_searched is set to be the number of label
	comparisons which were necessary to determine the result.  This
	information is used to guide the use of hashson.}

var	anchor,comp_ptr:node_pointer;
	cresult:integer;

begin
n_searched:=0;	{ have not searched any yet }
anchor:=nil;	{ remember insert value in anchor }
{ can we use fast pointer table ? }
if (mynode^.down_tbl<>NIL) { table exists }
then	comp_ptr:=mynode^.down_tbl^.node_hash[hashls(mylabel.labinfo)]
else	comp_ptr:=mynode^.down_ptr;

if comp_ptr=NIL
then	{ easy case, nothing to search }
	begin
	return_ptr:=anchor;
	findson:=false
	end
else	begin
	repeat	cresult:=lcomp(mylabel.labinfo
				,comp_ptr^.node_label.labptr^.text);
		n_searched:=n_searched+1;
		if cresult>0
		then	{ move on to next comparison }
			begin
			anchor:=comp_ptr;
			comp_ptr:=anchor^.side_ptr
			end
	until	(cresult<=0) or (comp_ptr=NIL);
	findson:=cresult=0;
	if cresult=0
	then	return_ptr:=comp_ptr
	else	return_ptr:=anchor
	end;

end; { findson }

function findnode(var myzone:zone_entry;
		  var myplace:exp_dname;
		  var return_ptr:node_pointer)
		:integer;

{	FINDNODE looks for the specified node.  The value of the FINDNODE
	function is the number of labels that could not be matched.

	return_ptr is set to point to the last node that matched.
}

var	i:integer;
	toss:integer;
	now_at:node_pointer;

begin
return_ptr:=myzone.zone_node;	{ match root without thought }
i:=myplace.count-1;

repeat	if i>0
	then	if findson(return_ptr,myplace.dlabels[i],now_at,toss)
		then	begin
			i:=i-1;
			return_ptr:=now_at
			end
until	(i=0) or (return_ptr=NIL);

findnode:=i

end; { findnode }

function gonode(var myzone:zone_entry;
		var myplace:exp_dname):node_pointer;

{	GONODE finds the node in the specified zone and returns a pointer
	to it, creating it if it must.
}

const	search_thresh=50;	{ how bad findson can get before hash table
				  is created }

var	son_ptr,now_at:node_pointer;
	search_count,i:integer;

begin
now_at:=myzone.zone_node;	{ match root without thought }

for i:=myplace.count-1 downto 1
do	begin
	if findson(now_at,myplace.dlabels[i],son_ptr,search_count)
	then	now_at:=son_ptr
	else	now_at:=makeson(myzone,now_at,myplace.dlabels[i],son_ptr);

	if (search_count>search_thresh)	{ create hash table if required }
		AND
	   (now_at^.up_ptr^.down_tbl=NIL)
	then	hashson(myzone,now_at^.up_ptr)
	end;

gonode:=now_at

end; { gonode }

procedure walknode(mynode:node_pointer;
		   procedure callee;
		   table_index:integer;
		   sequence:integer);

{	WALKNODE walks the node tree below the specified node,
	calling the specified procedure with an argument of a
	node pointer.

	Tbale index refers to the hash index of this node or -1
	if parent's down pointer isn't hashed.

	Sequence is the position of this label on its hash chain or whatever
}

var	callnode:node_pointer;
	hashed:boolean;
	child_slot,child_sequence:integer;

begin
callee(mynode,table_index,sequence);
hashed:=mynode^.down_tbl<>NIL;
child_slot:=-1;	{ assume not hashed }

repeat	if hashed
	then	begin
		child_slot:=child_slot+1;
		callnode:=mynode^.down_tbl^.node_hash[child_slot];
		end
	else	callnode:=mynode^.down_ptr;
	child_sequence:=1;

	while callnode<>NIL
	do	begin
		walknode(callnode,callee,child_slot,child_sequence);
		callnode:=callnode^.side_ptr;
		child_sequence:=child_sequence+1
		end;

until	(child_slot=(label_hashmax)) or not(hashed)
end;

function makechunk(var	myzone:zone_entry;
		   var	newchunk:exp_chunk;
			level:integer;
			splice:rdchunk_pointer)
		:rdchunk_pointer;

var	created:rdchunk_pointer;
	i:integer;
begin
a_rdchunk(myzone,created);	{ allocate a new chunk }
with created^
do	begin
	more:=splice;	{ splice on tail of other chunks }

	i:=hashchunk(newchunk);
	rdchain:=myzone.rdtable[level,i];	{ add to zone chunk list }
	myzone.rdtable[level,i]:=created;

	ckind:=newchunk.ckind;	{ make the chunk }
	case ckind of

	lit_chunk:	begin
			a_litstring(myzone,litdata,
				   max_binary_octets-newchunk.lit_data_count);
			litdata^.lcount:=newchunk.lit_data_count;
			for i:=1 to litdata^.lcount
			do	litdata^.ldata[i]:=newchunk.lit_data[i]
			end;	

	name_chunk:	rrname:=godname(myzone,newchunk.rrname);

	end { case }
	end;

makechunk:=created

end; { makechunk }

function findrdata(var myzone:zone_entry;	{ zone for chunks }
		var newrr:exp_rr;	{ rr with imbedded chunks }
		var missing:integer;	{ number of chunks	  }
		var point:rdchunk_pointer
		):boolean;

{	FINDRDATA looks for encoded version of the chunk chain specified
	in NEWRR.  It does so by first looking for a chunk that matches
	the last chunk, then a chunk chain that matches the last 2 chunks
	etc.

	FINDRDATA can obviously find 0 or more of the required chunks.
	If it finds them all it returns true.

	In any case, it returns with missing set to the number of
	chunks which must be added to the chain, and POINT set to the
	chain it did find.  
}

var	current_level:integer;
	spoint:rdchunk_pointer;		{ chunk being examined for match }
	last_match:rdchunk_pointer;	{ match so far }
	found:boolean;

begin
if newrr.chunk_count=0
then	begin
	missing:=0;
	point:=NIL;
	findrdata:=true
	end
else	begin
	current_level:=0;
	last_match:=NIL;
	repeat	current_level:=current_level+1;
		spoint:=myzone.rdtable[current_level,
			hashchunk(newrr.chunks[newrr.chunk_count-current_level+1])];
		found:=false;
		repeat	if spoint<>NIL
			then	if spoint^.more<>last_match
				then	spoint:=spoint^.rdchain
				else	if chcomp(newrr.chunks[newrr.chunk_count-current_level+1],
							spoint,
							true)
					then	begin
						last_match:=spoint;
						found:=true
						end
					else	spoint:=spoint^.rdchain
		until	(spoint=NIL) or (found=true)
	until	(found=false) or (current_level=newrr.chunk_count);
	if found
	then	missing:=0
	else	missing:=newrr.chunk_count-current_level+1;
	findrdata:=found;
	point:=last_match
	end

end; { findrdata }

function gordata(var myzone:zone_entry;	{ zone for chunks }
		var newrr:exp_rr	{ rr with imbedded chunks }
		):rdchunk_pointer;

{	GORDATA looks for a preexisting set of rdchunks that match
	a set of rdchunks in the new RR, if not found, they are
	created.  Note that this matching must be exact, i.e. case
	sensitive.

}

var	point:rdchunk_pointer;
	missing,i:integer;

begin
if newrr.chunk_count=0
then	gordata:=NIL
else	begin
	if not findrdata(myzone,newrr,missing,point)
	then	for i:=missing downto 1
		do	point:=makechunk(myzone,
					newrr.chunks[i],
					newrr.chunk_count-i+1,
					point);
	gordata:=point
	end

end; { gordata }

procedure zinit(var myzone:zone_entry);

{	ZINIT initializes a zone entry to be empty.  Note that
	the loaded switch may require locking to ensure synchronization
	with other processes
}

var	i,j:integer;
	myclass:dclass;
	mytype:dtype;
	rnode:exp_label;

begin
with myzone
do	begin
	zsoa:=NIL;	{ initialize SOA information }
	zsoa_rr:=NIL;

	loaded:=false;

{	for myclass:=dclass_l_bound to dclass_h_bound
	do	for mytype:=dtype_l_bound to dtype_h_bound
		do	rrtable[mytype,myclass]:=NIL;	  }

	for i:=1 to 255
	do	dtable[i]:=NIL;

	for i:=1 to max_chunk
	do	for j:=0 to 255
		do	rdtable[i,j]:=NIL;

	{ initialize the label table }
	ltable.direct:=NIL;
	for i:=0 to 255
	do	ltable.stable[i]:=NIL;

	{ make a null label }
	zone_node:=newnode(myzone);

	{ make the root node }
	rnode.labinfo[0]:=0;
	zone_node^.node_label.labptr:=goulabel(myzone,rnode);

	end

end; { zinit }

function makerr(var myzone:zone_entry;
		    mynode:node_pointer;
		var myrr:exp_rr):rr_pointer;

{	MAKERR creates a new RR block at the end of the RRs which
	already exist at a specific node, but does not create the chunk
	chains.
}

var	child:rr_pointer;
	rr_anchor:rr_pointer;

begin
{	create the block	}
a_rr(myzone,child);
with child^
do	begin
	next:=NIL;	{ always insert at end }
{	node:=mynode;	}
	ttl:=myrr.ttl;
	rrtype:=myrr.rrtype;
	rrclass:=myrr.rrclass;
	rdata:=NIL;
{	rrchain:=NIL}
	end;

if mynode^.rr_ptr=NIL	{ add to node's RR chain }
then	mynode^.rr_ptr:=child
else	begin
	rr_anchor:=mynode^.rr_ptr;
	while rr_anchor^.next<>NIL
	do	rr_anchor:=rr_anchor^.next;
	rr_anchor^.next:=child
	end;

{	add it to the zone list by type and class	
if myzone.rrtable[child^.rrtype,child^.rrclass]=NIL
then	myzone.rrtable[child^.rrtype,child^.rrclass]:=child
else	begin
	rr_anchor:=myzone.rrtable[child^.rrtype,child^.rrclass];
	while rr_anchor^.rrchain<>NIL
	do	rr_anchor:=rr_anchor^.rrchain;
	rr_anchor^.rrchain:=child
	end;	   }

makerr:=child;

end; { makerr }
procedure makelt(var myzone:zone_entry);

{	MAKELT makes a label table for the specified zone
}

var	now_at:node_pointer;
	myfbp:file_blk_ptr;

	procedure ltindex(input_node:node_pointer);

	{	LTINDEX adds the specified node to the label table
		specified in the call to makelt.  Note the use of
		circular chains.
	}

	
	begin
	with input_node^.node_label.labptr^
	do	if nodeptr=NIL
		then	begin	{ first addition }
			nodeptr:=input_node;
			input_node^.node_lchain:=input_node
			end
		else	begin	{ add to circular list }
			input_node^.node_lchain:=nodeptr^.node_lchain;
			nodeptr^.node_lchain:=input_node
			end
	end; { ltindex }

	procedure lttry(input_node:node_pointer);

	{	This procedure tests a node to see if it should be added to
		its zone's label table.

		If the zone is the cache zone, then all nodes are so
		added.

		If the zone is an authoritative one, then the test is
		whether the father is authoritative, and no NS records
		are present.  Note that the top node of a zone is indexed
		by force in the main code of makelt
	}

	var	found_ns:boolean;
		scan:rr_pointer;

	begin
	if myzone.zone_is_cache
	then	ltindex(input_node)	{ always index cache nodes }
	else	{ nodes in authoritative zones must have a father }
		if input_node^.up_ptr<>NIL
		then	{ and the father must be authoritative }
			if input_node^.up_ptr^.node_lchain<>NIL
			then	{ and must be free of NS delegations }
				begin	{ look for NS records }
				found_ns:=false;
				scan:=input_node^.rr_ptr;
				while not(found_ns)
					AND
				      (scan<>NIL)
				do	if scan^.rrtype=NS
					then	found_ns:=true
					else	scan:=scan^.next;
				if not(found_ns)
				then	ltindex(input_node)
				end
	end; { lttry }

begin

if myzone.zone_is_cache
then	now_at:=myzone.zone_node
else	begin
	now_at:=myzone.zsoa;
	if now_at<>NIL
	then	ltindex(now_at)
	else	begin
		myfbp:=ofile(fatl);
		writeln(myfbp^.fident, 'ADDRR internal error during makelt');
		cfile(myfbp);
		end
	end;

if now_at<>NIL
then	walknode(now_at,lttry,-1,1)
end; { makelt }
function rrbin(myrr:rr_pointer;
		 first:integer;
		 last:integer):integer;

{	RRBIN returns an right shifted integer equal to the concatenation
	of the FIRST through last bytes of binary data in a RR
}

var	sum,index,length:integer;
	scan:rdchunk_pointer;
	myfbp:file_blk_ptr;

begin
sum:=0;
scan:=myrr^.rdata;

repeat	if scan=NIL
	then	begin
		    myfbp:=ofile(fatl);
		    writeln(myfbp^.fident, 'ADDRR internal error');
		    cfile(myfbp);
		end
	else	if scan^.ckind=name_chunk
		then	scan:=scan^.more
		else	begin
			length:=scan^.litdata^.lcount;
			if first<=length
			then	for index:=first to min(last,length)
				do	sum:=bshift(sum,8)+scan^.litdata^.ldata[index];
			first:=first-length;
			last:=last-length
			end
until	first<=0;

rrbin:=sum;

end; { rrbin }
procedure soa_setup(var myzone:zone_entry);

{	SOA_setup copies data from the zone SOA RR to the zone entry
	and checks to see that all authoritative TTLs are
	at least equal to the zone minimum
}

var	mynode:node_pointer;
	scanrr,myrr:rr_pointer;
	myfbp:file_blk_ptr;

	procedure ttl_check(mynode:node_pointer);

	var	scanrr:rr_pointer;

	begin
	if mynode^.node_lchain<>NIL
	then	begin
		scanrr:=mynode^.rr_ptr;
		while scanrr<>NIL
		do	begin
			if scanrr^.ttl<myzone.zone_config.zone_minimum
			then	scanrr^.ttl:=myzone.zone_config.zone_minimum;
			scanrr:=scanrr^.next
			end
		end
	end; { ttl check }

begin
if myzone.zsoa=NIL
then	begin
	myfbp:=ofile(fatl);
	writeln(myfbp^.fident, 'No SOA for SOA setup');
	cfile(myfbp);
	end
else	begin
	scanrr:=myzone.zsoa^.rr_ptr;	{ set myrr to point to the SOA RR }
	myrr:=NIL;
	while myrr=NIL
	do	if scanrr=NIL
		then begin	
			 myfbp:=ofile(fatl);
			 writeln(myfbp^.fident, 'ADDRR internal error');
			 cfile(myfbp);
		     end
		else	if scanrr^.rrtype=SOA
			then	myrr:=scanrr
			else	scanrr:=scanrr^.next
	end;

{ setup fields in the zone entry }
with myzone
do	begin
	zsoa_rr:=myrr;
	with zone_config
	do	begin
		zone_serial:=rrbin(myrr,1,4);
		zone_refresh:=rrbin(myrr,5,8);
		zone_retry:=rrbin(myrr,9,12);
		zone_expire:=rrbin(myrr,13,16);
		zone_minimum:=rrbin(myrr,17,20)
		end
	end;

walknode(mynode,ttl_check,-1,1);

end; { soa_setup }
function concrr(	var myzone:zone_entry;
			    mynode:node_pointer;
			var myrr:exp_rr):boolean;

{	CONCRR adds the specified RR to the specified node	}

var	child:rr_pointer;
begin
{	***** should check for duplicates someday ***** }
child:=makerr(myzone,mynode,myrr);	{ create new rr block on end }
child^.rdata:=gordata(myzone,myrr);
concrr:=true
end; { concrr }

function addrr(	var myzone:zone_entry;
		var myplace:exp_dname;
		var mynode:node_pointer;	{ set on return }
		var myrr:exp_rr):boolean;

{	ADDRR adds the specified RR to the specified zone,
	returning TRUE if all went well
}

begin
mynode:=gonode(myzone,myplace);	{ find the node to begin work at }
addrr:=concrr(myzone,mynode,myrr)

end { addrr }
.