BEGIN {

     $sockaddr_t = 'S n a4 x8';

     $WEIGHT_PER_USER = 100; # should be consistent with poller
     $need_maint = 0;
   $poller_sleep = 300;
  $poller_config = "sweet.config";
     $hostmaster = "schemers.leland.stanford.edu";

}


## NOTE: handle_best_request still contains two hard-coded references
## to stanford.edu. You should change them to match your domain.

LBDB::add_static(
    "zephyr.sloc.stanford.edu",T_TXT,rr_TXT("dsodb.stanford.edu")
);

LBDB::add_static(
    "zephyr.sloc.stanford.edu",T_TXT,rr_TXT("dsodb.stanford.edu"),1,C_HS
);


LBDB::add_static("zephyr.sloc.stanford.edu",T_SOA,
         rr_SOA(hostname,
                  "schemers.slapshot.stanford.edu",
                  time, 86400, 86400, 86400, 0)
);


LBDB::add_static("best.stanford.edu",T_SOA,
         rr_SOA(hostname,$hostmaster,time, 86400, 86400, 86400, 0)
);

LBDB::add_dynamic("echo.stanford.edu"     => \&handle_echo_request);
LBDB::add_dynamic("residual.stanford.edu" => \&handle_residual_request);
LBDB::add_dynamic("date.stanford.edu"     => \&handle_date_request);
LBDB::add_dynamic("passwd.stanford.edu"   => \&handle_passwd_request);
LBDB::add_dynamic("best.stanford.edu"     => \&handle_best_request);

LBDB::add_dynamic("exit" => 
	sub {
	  my($domain,$residual,$qtype,$qclass,$dm) = @_;
	  $dm->{'answer'}  .= dns_answer(QPTR, T_TXT, C_IN, 60, rr_TXT("bye"));
	  $dm->{'ancount'} += 1;
	  $::done=1;
	  return 1;
	}
);

LBDB::add_dynamic("random.stanford.edu"   => 
		sub {
			my($domain,$residual,$qtype,$qclass,$dm) = @_;

			$residual = 10 unless $residual;

			$dm->{'answer'} .= dns_answer(
	                      QPTR, T_TXT,C_IN,60,
			      rr_TXT(int(rand($residual))));
			$dm->{'ancount'} += 1;	
			return 1;
		}
);


############################################################
# dynamic domain handlers...


sub handle_date_request {
  my($domain,$residual,$qtype,$qclass,$dm) = @_;
  my($date);

  chop($date = `date`);

  $dm->{'answer'}  .= dns_answer(QPTR, T_TXT, C_IN, 60, rr_TXT($date));
  $dm->{'ancount'} += 1;
  
  return 1;
}

sub handle_residual_request {
  my($domain,$residual,$qtype,$qclass,$dm) = @_;

  $dm->{'answer'}  .= dns_answer(QPTR, T_TXT, C_IN, 60, rr_TXT("$residual"));
  $dm->{'ancount'} += 1;
  return 1;
}

sub handle_echo_request {
  my($domain,$residual,$qtype,$qclass,$dm) = @_;

  $dm->{'answer'} .= 
           dns_answer(QPTR, T_TXT, C_IN, 60, rr_TXT("$residual.$domain"));
  $dm->{'ancount'} += 1;
  return 1;
}

sub handle_passwd_request {
  my($domain,$residual,$qtype,$qclass,$dm) = @_;

  $_ = $residual;
  if (/\./) { 
     ($field,$residual) = /([^.]*)\.(.*)/;
  } else {
     $field = '';
  }

  my($name,$passwd,$uid,$gid,$q,$c,$gcos,$dir,$shell) = getpwnam($residual);
  my($entry);

  if ($name) {
     if ($field) {
       if ($field eq 'name') { $entry = "$name"; } 
       elsif ($field eq 'uid') { $entry = "$uid"; } 
       elsif ($field eq 'gid') { $entry = "$gid"; } 
       elsif ($field eq 'gcos') { $entry = "$gcos"; } 
       elsif ($field eq 'dir') { $entry = "$dir"; } 
       elsif ($field eq 'shell') { $entry = "$shell"; } 
       else { 
           $dm->{'rcode'} = NXDOMAIN;
       }
     } else { 
       $entry = "$name:*:$uid:$gid:$gcos:$dir:$shell";
     }
  } else {
       $dm->{'rcode'} = NXDOMAIN;
  }

  $dm->{'answer'}  .=  dns_answer(QPTR, T_TXT, C_IN, 60, rr_TXT($entry));
  $dm->{'ancount'} += 1;
  return 1;
}

sub by_weight { $weight{$a} <=> $weight{$b}; }

sub handle_best_request {
   my($domain,$residual,$qtype,$qclass,$dm) = @_;

   my($the_host,$the_ip,$answer,$qname,$group);

   $qname = $residual;

   unless ($group = $best_groups{$qname}) {
       $dm->{'rcode'} = NXDOMAIN;
       return 1;
   } 

   if ($qtype == T_A || $qtype == T_MX || $qtype == T_ANY) {

        @$group = sort by_weight @$group; 
        $the_host = @$group[0];
        $weight{$the_host} += 2 * $WEIGHT_PER_USER;

        $the_ip    = $ip_host{$the_host};
        $the_host .= ".stanford.edu" if ($the_host !~ /\.stanford\.edu/i);

        $answer = dns_answer(QPTR, T_CNAME, C_IN, 0, rr_CNAME($the_host));

        $answer .= dns_answer(
                  dns_simple_dname($the_host),
                  T_A,C_IN,3600,
                  rr_A($the_ip));

      $dm->{'answer'}  .= $answer;
      $dm->{'ancount'} += 2;
   } else {
      $dm->{'rcode'} = NXDOMAIN;
   }
   return 1;
}

sub start_poller {
    &write_log("starting poller");
    if (($poller_id=fork)==0) { 
       exec "./poller -d -s -f $poller_config -i $poller_sleep";
    }
}

sub restart_poller {
    local($pid) = wait;
    return if ($pid != $poller_id);
    &write_log("restarting poller");
    if (($poller_id=fork)==0) { 
     exec "./poller -d -s -f $poller_config -i $poller_sleep";
   }
}

sub poller_exit {
    $::SIG{'CHLD'} = 'IGNORE';
    if ($poller_id) {
	&write_log("killing poller($poller_id)");
	kill 'QUIT',$poller_id;
    }
}

sub load_config {
    local($file) = @_;
    my($host,$bg,$a,$b,$c,$d,$ipaddr,$weight,$ip,$groups);

    &write_log("load_config") if $debug;

    %weight=();
    %best_groups=();
    %ip_host=();

    open(CONFIG,$file) || &write_log("Can't open config file: $file: $!");

    while(<CONFIG>) {
       s/^\s+//;
       s/\s+$//;
       next if /^#/ || /^$/;
       ($weight,$host,$ip,$groups) = split(/\s+/,$_,4);
       print "  loading $_\n" if $debug;
       $_ = $ip;
       ($a,$b,$c,$d) =  /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
       $ipaddr = ($a<<24)|($b<<16)|($c<<8)|$d;
       $ip_host{$host} = $ipaddr;
       $weight{$host} = $weight;
       foreach $group (split(/\s+/,$groups)) {
           $best_groups{$group} = [] unless defined $best_groups{$group};
           $bg = $best_groups{$group};
	   push(@$bg,$host);
       }
    }
    close(CONFIG);
}

############################################################
# standard hooks

sub catch_hup { 
    $need_maint=1; 
    $need_reload=1; 
}

sub do_maint {
    &write_log("do_maint") if $debug;
    if ($need_reload) {
        &write_log("reloading config") if $debug;
        &load_config("$poller_config.lb");
	$need_reload=0;
    }
    $need_maint=0;
}

sub clean_exit {
    &write_log("received signal, exiting...") ;
    &poller_exit;
    &close_log;
    exit(0);
}

sub init_signals {
    $::SIG{'INT'} = 'clean_exit';
    $::SIG{'QUIT'} = 'clean_exit';
    $::SIG{'TERM'} = 'clean_exit';
    $::SIG{'CHLD'} = 'restart_poller';
    $::SIG{'HUP'} = 'catch_hup';
}


srand(time/$$);

&init_signals;
&start_poller if ($poller_sleep);
&load_config("$poller_config.lb");

1;