program makedb;

include {NOLIST} 'domain:jsys.def';
include {NOLIST} 'pascal:extern.pas';		
include {NOLIST} 'domain:mdep.def';
include {NOLIST} 'domain:master.def';
include {NOLIST} 'domain:lparse.def';
include {NOLIST} 'domain:msub.hdr';
include {NOLIST} 'domain:fload.hdr';
include {NOLIST} 'domain:irdata.hdr';
include {NOLIST} 'domain:dump.hdr';
include {NOLIST} 'domain:addrr.hdr';
include {NOLIST} 'domain:mdep.hdr';
include {NOLIST} 'domain:pp.hdr';
include {NOLIST} 'domain:alloc.hdr';
include {NOLIST} 'domain:lparse.hdr';
include {NOLIST} 'domain:tport.hdr';
var	idex,ret,ac1,ac2,ac3,my_address,i,j,toss:integer;
	null_origin:exp_dname;
	master:master_block_pointer;
	infile:filename;
	logfile:file of char;
	logfn:filename;
	cpib:pib;
	cdata:zone_cdata;
	inatom:atom;
	zp:zone_entry_pointer;
	search_node:node_pointer;
	ncd:boolean;
	dumpflag:boolean;
	statflag:boolean;
	delflag:boolean;
	totstg:stgmap;stg_idex:satype;
	null_dns:dname_string;

{ scan_error and parse_errors come from fload in this version }

procedure scan_error(var mypib:pib;
			str:string40);
extern;
procedure parse_error(var mypib:pib;
			str:string11);
extern;

procedure toss_atom;

begin
if not getatom(cpib,inatom)	{ eat keyword }
then cpib.ok:=false;
end;
procedure anyload;

begin
with cpib,cdata,master^
do
begin { with }
if smatch(line,1,'zloadf         ')
then	loadtype:=zloadf
else	if smatch(line,1,'zloadfd        ')
	then	loadtype:=zloadfd
	else	if smatch(line,1,'cloadf         ')
		then	loadtype:=cloadf
		else	if smatch(line,1,'zloadn         ')
			then	loadtype:=zloadn
			else	ok:=false;

toss_atom;

{ Parse off zone name, class, and default interval unless
  a cache load }

if not ok
then	scan_error(cpib,'Unable to understand load type          ')
else	begin
	toss_blanks(cpib);
	case loadtype of

	zloadf,
	zloadfd,
	zloadn:	begin	{ get zone name, class, and default
			  timeout }
		ncd:=false;	{ assume failure }
		if getdname(cpib,null_origin,zone_to_load)
		then if getatom(cpib,inatom)
		then if cvclass(inatom,loadclass)
		then if getatom(cpib,inatom)
		then if cvtime(inatom,default_rinterval)
		then ncd:=true;
		ok:=ok and ncd
		end;

	cloadf:	zone_to_load.count:=0	{ set root }

	end { case }
	end;

{ Parse off filename for file loads, list of hosts if a
  network load }

if ok
then	begin
	case  loadtype of

	zloadf,
	zloadfd,
	cloadf:	getfn(cpib,refresh_file);

	zloadn:	begin
		hostcount:=0;
		repeat	if getdname(cpib,null_origin,
					hosts[hostcount+1])
			then	hostcount:=hostcount+1
		until	not(ismore(cpib))
			 or
			(hostcount=max_zlhosts);
		end
	end {case}
	end;

if ok
then	check_end(cpib);

if ok
then	{ get a zone to set up }
	if loadtype <> cloadf
	then	begin
		search_node:=gonode(search_zone,zone_to_load);
		if search_node^.zone_ptr=NIL
		then	begin
			a_zone(search_node^.zone_ptr);
			zp:=search_node^.zone_ptr
			end
		else	scan_error(cpib,'Already loaded                          ');
		zp:=search_node^.zone_ptr
		end
	else	{ cache load }
		if cache_pointer=NIL
		then	begin
			a_zone(cache_pointer);
			zp:=cache_pointer
			end
		else	scan_error(cpib,'Already loaded                          ');

if ok
then	{ setup parameters in zone block }
	case loadtype of

	zloadf,
	zloadfd,
	zloadn:	zp^.zone_config:=cdata;

	cloadf: zp^.zone_is_cache:=true
	end;

if ok
then	{ load files if file load }
	case loadtype of

	zloadf,
	zloadfd,
	cloadf:	if fzload(zp^,zone_to_load,refresh_file)
		then	begin
			zp^.loaded:=true;
			for stg_idex:=sd_slt to sd_litstring (* Total stats *)
			do begin
			   totstg[stg_idex,sa_units]:=totstg[stg_idex,sa_units]+zp^.sadata[stg_idex,sa_units];
			   totstg[stg_idex,sa_aus]:=totstg[stg_idex,sa_aus]+zp^.sadata[stg_idex,sa_aus]
			   end;
			if statflag or dumpflag
			then begin
				 writeln(logfile);
				 write(logfile,'Data Structure Stats for file ');
				 d_file(logfile,refresh_file);
				 writeln(logfile);
				 dmp_zstg(logfile, zp^);
				 if dumpflag then dmpzone(logfile,zp^)
			     end;
			if statflag or dumpflag or delflag
			then begin
				 writeln(logfile);
				 writeln(logfile,del_count(zp^):3,
					 ' delegations found');
				 writeln(logfile)
			     end;
			if delflag
			then begin (* write out delegations *)
				 writeln(logfile);
				 write(logfile,'Delegations for file ');
				 d_file(logfile,refresh_file);
				 writeln(logfile);
				 dmp_dels(logfile,zp^)
			     end
			end
		else	scan_error(cpib,'File load failed                        ');

	zloadn:

	end;

end; { with }
end; { anyload }
procedure getads(var myst:server_type);

{ parse a server name and an optional sequence of addresses }

begin
with cpib,myst
do   begin
	 addresses_ready:=false;
	 address_count:=0;
	 toss_blanks(cpib);
	 if ismore(cpib)
	 then if getdns(cpib,null_dns,server_name)
	      then begin
		       while ismore(cpib) and ok
		       do begin
			      toss_blanks(cpib);
			      if ismore(cpib)
			      then if getatom(cpib,inatom)
				   then if address_count<max_server_addresses
				        then begin
						 address_count:=address_count+1;
						 if cvina(inatom,server_addresses[address_count].ipaddress)
						 then begin
							  addresses_ready:=true;
							  toss_blanks(cpib)
						      end
					     end
					else scan_error(cpib,'Too many addresses                      ')
				   else parse_error(cpib,'address    ')
			  end;
		       check_end(cpib)
		   end
	      else parse_error(cpib,'name       ')
	 else parse_error(cpib,'name       ');
	 if ok and not(addresses_ready)	(* setup addresses if possible *)
	 then if getadr(myst,true,false,false,0) then
     end;
end; { getads }
procedure getpref;

(* GETPREF scans a line which must be of the form

   APREF mask value eta

   mask must be a IP address expressed in dotted decimal form

   value must be a IP address expressed in dotted decimal form

   eta must be an integer>0 and is the ETA in MS *)

var success:boolean;
    maskatom,valatom,etaatom:atom;
    mask,val,eta,idex:integer;
begin
success:=false;	(* assume failure *)
with cpib,master^.measure
do if ismore(cpib)
   then if getatom(cpib,maskatom)
        then begin
		 toss_blanks(cpib);
		 if ismore(cpib)
		 then if getatom(cpib,valatom)
		      then begin
			   toss_blanks(cpib);
			   if ismore(cpib)
			   then if getatom(cpib,etaatom)
				then if cvina(maskatom,mask) and
				        cvina(valatom,val) and
					cvint(etaatom,eta)
			              then if eta>0
					   then begin
					        idex:=1;
						while (idex<prfmax) and	(* NOT <= *)
						       (prefm[idex]<>0)
						do idex:=idex+1;
						if idex=prfmax
						then scan_error(cpib,'Preference table overflow               ')
						else begin
							prefm[idex]:=mask;
							prefv[idex]:=val;
							prefe[idex]:=eta;
							success:=true
						     end;
						check_end(cpib)
						end
			   end			    
	     end
end;
begin { main }
null_dns[1]:=0;

for stg_idex:=sd_slt to sd_litstring (* Clear total storage stats *)
do begin
       totstg[stg_idex,sa_units]:=0;
       totstg[stg_idex,sa_aus]:=0
   end;

reset(input,'TTY:');
rewrite(output,'TTY:');

imaster;
master:=getmaster;

{ initialize default server and resolver addresses }
master^.resolve_addrs.address_count:=0;
master^.resolve_dserve.server_count:=0;

{ Set version number }
master^.dbvers:=dbvern;
master^.measure.dupver:=dbvern;

{ initialize measurement parameters }
with master^.measure
do begin
	infttl:=10;		{ limit for JSYS looping }
	plttl:=20;		{ primitive lock disms time in MS }
	lckttl:=200;		{ MS wait for exclusive to clear }
	rwaiti:=20;		{ initial MS wait for resolver }
	rwait:=20;		{ subsequent MS wait for resolver }
	ripoll:=20;		{ resolver idle poll interval }
	rbpoll:=20;		{ resolver busy poll interval }
	qtoi:=1500;		{ query initial timeout }
	qtor:=1000;		{ query retransmission timeout }
	qtoq:=2000;		{ query timeout for quiet interval }
	
	dynsw:=1;		{ use dynamic timeouts }
	dynnum:=3;		{ ETA to timeout ratio of 3/2 }
	dynden:=2;

	udphl:=10*60*1000;      { halflife of ten minutes }

	rmttl:=20;		{ resolver max TTL }
	maxit:=3;		{ max tries per address per request }
	maxst:=6;		{ max tries per server per request }
	prefe[0]:=5000;		{ pref zero eta = 5000 }
	
	dfgra.tquanta:=20;
	udpgra.tquanta:=20;
	nsugra.tquanta:=5;
   end;

{ initialize for zone loading }
irinit;
pp_init;
zinit(master^.search_zone);

null_origin.count:=0;

{ ask for the name of the configuration file }

repeat	write(output, 'Enter configuration file name: ');
        break(output);
        readln(input, infile);
until	pib_init(cpib, infile);

{ ask for the name of the log file }

write(output, 'Enter log file name: ');
break(output);
readln(input, logfn);
rewrite(logfile,logfn);

logfile^:=chr(12);
tstamp(logfile);
writeln(logfile,' Configuration file is: ',infile);
writeln(logfile);

statflag:=false;
delflag:=false;
dumpflag:=false;

with cpib,cdata,master^
do	while not eof(dfile)
	do  begin
	    ok:=true;
	    gline(cpib);

	    idex:=1;
	    repeat	if line[idex]<>chr(cr)
			then	write(logfile,line[idex]);
			idex:=idex+1
	    until	(idex>max_line_char) or (line[idex-1]=chr(cr));
	    writeln(logfile);
	    
	    { check for comment line }
	    toss_blanks(cpib);
	    if ismore(cpib)
	    then if smatch(line,1,'dump           ')
		        then dumpflag:=true
		 else if smatch(line,1,'nodump         ')
			then dumpflag:=false
		 else if smatch(line,1,'stat           ')
		        then statflag:=true
		 else if smatch(line,1,'nostat         ')
			then statflag:=false
		 else if smatch(line,1,'del            ')
		        then delflag:=true
		 else if smatch(line,1,'nodel          ')
			then delflag:=false
		 else if smatch(line,1,'apref          ')
		         then begin
				  toss_atom;
				  toss_blanks(cpib);
				  getpref
			      end
		 else if smatch(line,1,'raddr          ')
		 	then { set resolver addresses }
			     begin
				 toss_atom;
				 getads(resolve_addrs)
				 end
		 else if smatch(line,1,'dserve         ')
		      then { set default server address }
			    begin
				toss_atom;
				{ Set absurd length so ancestor test fails }
				resolve_dserve.server_at_len:=260;
				if resolve_dserve.server_count<max_search_servers
				then begin
				     resolve_dserve.server_count:=resolve_dserve.server_count+1;
				     getads(resolve_dserve.servers[resolve_dserve.server_count])
				     end
			        else scan_error(cpib,'Too many default servers                ')
			    end
                 else anyload { assume its a file load }
		
	    end;

close(cpib.dfile);

{ Write out summary information }

if statflag or dumpflag
then begin
	 Writeln(logfile,'***** Total zone usage *****');
	 Writeln(logfile);
	 dmp_stg(logfile,totstg,0);
	 Writeln(logfile)
	 end;

{set source host address}

jsys(gthst, -2, ret;0;ac1,    {get host address} 
     ac2, ac3, my_address); 
if ret=3
then writeln(logfile, 'jsys GTHST failed');

jsys(gthst,-2,ret;2,master^.measure.mname,my_address);

with master^.resolve_addrs
do begin
       if address_count=0
       then begin
		 address_count:=1;
		 server_addresses[1].ipaddress:=my_address;
		 addresses_ready:=true;
		 server_name[1]:=1;
		 server_name[2]:=ord('*');
		 server_name[3]:=0 (* so print routine doesn't die *)
	    end;
       writeln(logfile);
       write(logfile,'Resolver addresses for ');
       toss:=dmpdns(logfile,xseto(server_name));
       write(logfile,' are: ');
       d_sa(logfile,master^.resolve_addrs,false);
       writeln(logfile);
       writeln(logfile)
   end;


with master^.resolve_dserve
do if server_count=0
   then writeln(logfile,'***** No default servers were specified *****')
   else begin
	     sort_sa(master^.resolve_dserve);
	     writeln(logfile,'Default servers are: ');
	     for i:=1 to server_count
	     do begin
		     toss:=dmpdns(logfile,xseto(servers[i].server_name));
		     d_sa(logfile,servers[i],false);
		     writeln(logfile)
		end;
	     writeln(logfile)
	end;
writeln(logfile);


i:=cntpage(master^.used_pages);
j:=db_last_page-db_first_page+1;
write(logfile,i:3,' pages used out of ',j:3);
i:=(i*100) div j;
writeln(logfile,' (',i:2,'%)');
close(logfile);
wmaster

end. { main }