#!/usr/bin/perl

use Socket;

require 'newgetopt.pl';
require 'lbcd.pl';

# system dependent stuff
$sockaddr_t = 'S n a4 x8';

&NGetOpt("i:i","f:s","s","d");

$opt_i = 120    if !defined($opt_i);
&usage          if !defined($opt_f);
$ppid = getppid if defined($opt_s);
$debug = 1      if defined($opt_d);

$sleep_interval = $opt_i;
$config_file = $opt_f;

&load_config($config_file);
&init_socket(*S);
&init_signals;

while (1) {
  $poll_start = time;
  &poll(*S,*response,*unreachable);
  &dump_status("$config_file.status",*response);
  &dump_unreach("$config_file.unreach",*unreachable);
  &dump_lb("$config_file.lb",*response);
  if ($opt_s) { 
      if (kill('HUP',$ppid)!=1) {
          exit(0);
      }
  }
  &do_maint if ($need_maint);
  $poll_sleep = $sleep_interval - (time - $poll_start);
  sleep($poll_sleep) if ($poll_sleep > 0);
}

sub dump_status {
  local($file,*response) = @_;
  local(*FILE);
  open(FILE,">$file.new");
  
  foreach $host (sort keys %response) {
      $_ = $response{$host};
     ($btime,$ctime,$utime,$l1,$l5,$l15,$tot_user,
                              $uniq_user,$on_console,$resv)=split;
      print FILE "$host $btime $ctime $utime $l1 $l5 $l15 $tot_user $uniq_user $on_console\n";
  }
  close(FILE);
  unlink($file);
  rename("$file.new","$file");
}

sub dump_lb {
  local($file,*response) = @_;
  local(*FILE);
  open(FILE,">$file.new");
  
  foreach $host ( keys %response) {
      $_ = $response{$host};
     ($btime,$ctime,$utime,$l1,$l5,$l15,$tot_user,
                              $uniq_user,$on_console,$resv)=split;

    $WEIGHT_PER_USER = 100;
    $USER_PER_LOAD_UNIT = 3;

    $fudge = ($tot_user - $uniq_user)*($WEIGHT_PER_USER/5);
    $weight = ($uniq_user*$WEIGHT_PER_USER) 
                      + ($USER_PER_LOAD_UNIT*$l1) + $fudge;
    $ip     = $ipaddrs{$host};
    print FILE "$weight $host $ip $aliases{$host}\n";
  }
  close(FILE);
  unlink($file);
  rename("$file.new","$file");
}

sub dump_unreach {
  local($file,*unreachable) = @_;
  local(*FILE);
  open(FILE,">$file.new");

  foreach $host (sort @unreachable) {
     print FILE "$host\n";
  }
  close(FILE);
  unlink($file);
  rename("$file.new","$file");
}

sub poll {
  local(*S,*response,*unreachable)=@_;
  %response=();
  @unreachable = ();

  local(%ipaddrs_to_poll) = %sockaddrs;
  local(@addresses);
  local($retry) = 4;
  local($packet)= pack($LBCD'p_header,
        $LBCD'proto_version,0,$LBCD'op_lb_info,$LBCD'status_request);

  @addresses = keys %ipaddrs_to_poll;
  while($retry && $#addresses >= 0) {
    $start_time = time;
    foreach $addr (@addresses) {
       send(S,$packet,0,$addr) || die "can't send: $!";
       $rin=''; vec($rin,fileno(S),1) = 1;
       ($nfound, $timeleft) = select($rout=$rin,undef,undef,0.100);
       if ($nfound == 1) {
         $buff='';
         $from = recv(S,$buff,8192,0) || die "Can't receive: $!";
         $host = $ipaddrs_to_poll{$from};
         if ($host) {
             ($ver,$id,$op,$status,$btime,$ctime,$utime,$l1,$l5,
                                $l15,$tot_user,$uniq_user,$on_console,$resv)
                                            =unpack($LBCD'p_lb_response,$buff);
             $response{$host} = "$btime $ctime $utime $l1 $l5 $l15 " .
                                         "$tot_user $uniq_user $on_console";
             delete $ipaddrs_to_poll{$from};       
             select(undef,undef,undef,0.100);  # sleep a little...
         }
       }
    }
    --$retry;
    @addresses = keys %ipaddrs_to_poll;
    select(undef,undef,undef,1) 
            if ($retry && $#addresses >= 0 && ($start_time == time));
  }

  foreach $addr (@addresses) {
    push(@unreachable, $ipaddrs_to_poll{$addr});
  }

}

sub init_socket {
 local(*SOCK) = @_;
 chop($hostname=`hostname`);
 local($name, $aliases, $type, $len, $clientaddr) = gethostbyname($hostname);
 die "unable to get my ip address!" if ($name eq '');
 $client = pack($sockaddr_t,PF_INET, 0,$clientaddr);
 socket(SOCK,2,SOCK_DGRAM,0) || die "socket: $!";
 bind(SOCK,$client) || die "bind: $!";
}

sub init_signals {
    $SIG{'HUP'} = 'catch_hup';
}

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

sub do_maint {
    if ($need_reload) {
        print "reloading config\n" if $debug;
        &load_config($config_file);
	$need_reload=0;
    }
    $need_maint=0;
}

sub load_config { 
 local($file) = @_;
 local(*CONFIG);

 %ipaddrs = ();
 %sockaddrs = ();
 %weights = ();
 %aliases = ();

 open(CONFIG,"$file") || die "can't open $file: $!";
 while(<CONFIG>) {
   s/^\s+//;
   s/\s+$//;
   next if /^#/ || /^$/;
   ($host,$weight,$aliases) = split(/\s+/,$_,3);
   $weights{$host} = $weight;
   $aliases{$host} = $aliases;
   $h_name = '';
   ($h_name,$h_aliases,$h_type,$h_len,$h_addr) = gethostbyname($host);
   if ($h_name) {
     $ipaddrs{$host} = &inet_ntoa($h_addr);
     $sockaddrs{pack($sockaddr_t,&PF_INET,$LBCD'proto_portnum,$h_addr)} = $host; 
   } else {
     print STDERR "can't get ip address for: $host\n";
   }

 }

}

sub inet_ntoa {
    local($ip) = @_;
    local($a,$b,$c,$d) = unpack('C4',$ip);
    return "$a.$b.$c.$d";
}

sub usage {
  print<<EOF;

Usage:  $0 [-i internval] -f configfile
  -i interval      time between polls
  -f configfile    configuration file

EOF

 exit(1);
}