#!/usr/local/bin/perl -w
# $Id: check.pl,v 3.1 2000-06-03 03:12:12+09 nagoya Exp $
# dhcpd.leases を読み結果をダンプに追加して HTML を吐くだけ
#
# usage: $0 [-s] [-p] -l dhcpd.leases [-d D] [-r R] [-c C] [-n N]
# -s               : site_local_check() を呼び出す
# -p               : ping check をおこなう(要 root 権限)
# -l dhcpd.leases  : dhcpd.leases のパスを指定(必須)
# -d DUMPFILE      : dump file のパスを指定(オプションなしならば dump しない)
# -r REFRESH-TIME  : (デフォルトは 60)
# -c CRON-RERIOD   : (デフォルトは 180)
# -n NETMASK       : サブネットマスク(VLSM未対応、デフォルトは 24)

use strict;
use vars qw($opt_s $opt_p $opt_l $opt_d $opt_r $opt_c $opt_n);
use Getopt::Std;
use Time::Local;
use FileHandle;
use Fcntl ':flock';
use Net::Ping;
use POSIX;

getopts('spl:d:r:c:n:');
my $refresh_time = $opt_r || 60;
my $cron_period = $opt_c || 180;
my $network_address = make_network_address($opt_n || 24);
my $ping_timeout = 1; # てきとうな秒数( >0, by perldoc Net::Ping)
my $nkf = 'nkf -j';
my %color = (
	     'body' => '#faf0e6',   # linen
	     'text' => '#000000',   # black
	     'Alive' => '#ffff00',  # yellow
	     'Dead' =>  '#87cefe',  # LightSkyBlue
	     'warn' => '#ff0000',   # red
	    );
my $footer = "<a href=\"./index.html\">戻る</a>"; # see print_html()
my $now = time;
my (%lease, %current);

read_leases_file($opt_l, \%lease);
check_entries(\%lease, \%current);
site_local_check(\%current) if $opt_s;
summary_entries(\%current);
dump_entries($opt_d, \%current) if $opt_d;
$now = time; # check_entries() に時間がかかる(ping のため)ので再設定する
print_html(\%current);


# $_[0] (dhcpd.leases) を読んで $_[1] を次のような hash への参照とする
# 参考: dhcpd.leases(5)
#
# $_[1]->{IPアドレス} = {
#   'starts' => starts,  ; epoch 
#   'ends' => ends,      ; epoch
#   'macaddr' => hardware ethernet address,
#   'hostname' => client-hostname|hostname,
#   'other' => スカラー配列への参照
# }
sub read_leases_file {
     my $f = new FileHandle "< $_[0]" or die "$_[0] $!";
     my $ipaddr;
     while ($_ = $f->getline) {
	  chomp;
	  if (/^lease ([\d+\.]+) \{$/o) {
	       $ipaddr = $1;
	       # ipaddr が重複しているときは最後のものを優先する(OK?)
	       delete $_[1]->{$ipaddr}; 
	  } elsif (/^\t(starts|ends) \S+ (\S+) (\S+);$/o) {
	       $_[1]->{$ipaddr}{$1} = epoch($2, $3);
	  } elsif (/^\thardware \S+ (\S+);$/o) {
	       $_[1]->{$ipaddr}{macaddr} = $1;
	  } elsif (/^\t(?:client-)hostname \"(.*)\";$/o) {
	       $_[1]->{$ipaddr}{hostname} = $1
	  } elsif (/^\t(\S+);$/o) {
	       push @{$_[1]->{$ipaddr}{other}}, $1;
	  } elsif (/^\}/o) {
	       # no operation in here
	  } else {
	       # no operation in here
	  }
     }
     $f->close;
}

# $_[0] は read_leases_file で与えられる hash への参照
# $_[1] は以下のような hash への参照になる
# 
# $_[1]->{'networks'} = サブネットのスカラー配列への参照
# $_[1]->{サブネット} = {
#    'total_lease' => number of effective leased addresses,
#    'total_ping' => number of leased addresses which alive by ping,
#    'total_warn' => number of leased addresses which has some trouble,
#    'hosts' => IPアドレスのスカラー配列への参照
#    'host' => $_[0]->{IPアドレス} のコピー(というか参照)
#    'host' => {'ping'} => 'Alive'|'Dead'
#  }
sub check_entries {
     # ping への反応をチェックするにはroot権限が必要
     # ping の並列化をすれば速くなるのだけど…
     my $p = $opt_p ? Net::Ping->new('icmp', $ping_timeout) : undef;
     
     while (my ($ipaddr, $a) = each %{$_[0]}) {
	  # タイムオーバーしたエントリは無視
	  $now > $_[0]->{$ipaddr}{ends} and next;
	  
	  my $net = &$network_address($ipaddr);
	  $_[1]->{$net}{host}{$ipaddr} = $_[0]->{$ipaddr};
	  
	  $_[1]->{$net}{host}{$ipaddr}{ping} =
	       $opt_p ? ($p->ping($ipaddr) ? 'Alive' : 'Dead') : '';
     }
     $p->close if $opt_p;
     
     $_[1]->{networks} = [sort ipaddr_cmp keys %{$_[1]}];
     for (@{$_[1]->{networks}}) {
	  $_[1]->{$_}{hosts} = [sort ipaddr_cmp keys %{$_[1]->{$_}{host}}];
	  for my $k (qw(lease ping warn)) {
	       $_[1]->{$_}{"total_$k"} = 0;
	  }
     }
}

sub summary_entries {
     for (@{$_[0]->{networks}}) {
	  my $a = $_[0]->{$_};
	  for (@{$a->{hosts}}) {
	       my $b = $a->{host}{$_};
	       $a->{'total_lease'}++;
	       $a->{'total_ping'}++ if $b->{ping} eq 'Alive';
	       $a->{'total_warn'}++ if $b->{warn};
	  }
     }
     for (@{$_[0]->{networks}}) {
	  for my $k (qw(lease ping warn)) {
	       $_[0]->{"total_$k"} += $_[0]->{$_}{"total_$k"};
	  }
     }
}

# HTML モジュールを使うべきなのかなあ
sub print_html {
     my $o = new FileHandle "| $nkf" or die "$nkf $!";
     my $t = strftime "%Y/%m/%d %H:%M:%S", localtime($now);
     my $e = strftime "%a, %d %b %Y %H:%M:%S GMT", gmtime($now + $cron_period);
     $o->print(<<"HTML_HEADER");
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html lang="ja">
<head>
  <meta http-equiv="content-type" content="text/html; charset=iso-2022-jp">
  <meta http-equiv="refresh" content="$refresh_time">
  <meta http-equiv="expires" content="$e">
  <meta name="generater" content="$0">
  <title>Information of address assignment by DHCP</title>
</head>
<body bgcolor="$color{body}" text="$color{text}">
  <h1><a name="top">DHCPアドレス割り当て状況 [$t 現在]</a></h1>
HTML_HEADER
     print_subnets($o, @_);
     print_hosts($o, @_);
     $o->print(<<"HTML_END");
<hr>$footer
</body>
</html>
HTML_END
     $o->close;
}

sub print_subnets {
     my ($WS, $WE) = ("<font color=\"$color{warn}\">", '</font>');

     $_[0]->print("\n", <<"T");
<table border=1><col span=4><caption>サブネットごとの統計</caption>
  <tr>
    <th>サブネット</th>
    <th>有効期間内である<br>割り当て済みアドレス数</th>
    <th>unicast ping に<br>反応したアドレス数</th>
    <th>登録に問題の<br>あるアドレス数</th>
  </tr>
T
     for (@{$_[1]->{networks}}) {
	  my ($S, $E) = $_[1]->{$_}{'total_warn'} ? ($WS, $WE) : ('', '');
	  $_[0]->print(<<"T");
  <tr>
    <td align=right><a href="\#$_">$_</a></td>
    <td align=right>$_[1]->{$_}{total_lease}</td>
    <td align=right>$_[1]->{$_}{total_ping}</td>
    <td align=right>$S$_[1]->{$_}{total_warn}$E</td>
  </tr>
T
     }
     my ($S, $E) = $_[1]->{'total_warn'} ? ($WS, $WE) : ('', '');
     $_[0]->print(<<"T");
   <tr>
     <td align=center>合計</td>
     <td align=right>$_[1]->{total_lease}</td>
     <td align=right>$_[1]->{total_ping}</td>
     <td align=right>$S$_[1]->{total_warn}$E</td>
   </tr>
 </table>
T
}
  
sub print_hosts {
     my @entries = qw(IPアドレス MACアドレス ping starts ends その他);
     my $entries = scalar @entries;
     my $ths = '<tr>' . join('', map {"<th>$_</th>"} @entries) . '</tr>';

     my %c = ('Alive' => '', 'Dead' => '',);
     if ($opt_p) {
	  for (qw(Alive Dead)) { $c{$_} = " bgcolor=\"$color{$_}\""; };
     }
     for my $net (@{$_[1]->{networks}}) {
	  my $p = $_[1]->{$net};
	  my $lease = $p->{total_lease};
	  my $alive = $p->{total_ping};
	  my $dead = $lease - $alive;
	   $_[0]->print("\n", <<"T");
<p>
<table border=0><col span=4>
  <tr>
    <th><a name="$net"></a><a href="#top">$net</a></th>
    <th>Lease: $lease</th>
    <th$c{Alive}>Alive: $alive</th>
    <th$c{Dead}>Dead: $dead</th>
  </tr>
</table>
<table border=1><col span=$entries>$ths
T
	  for my $ip (@{$p->{hosts}}) {	  
	       my $a = $p->{host}{$ip};
	       my $m = $a->{macaddr};
	       my $p = $a->{ping} || '<br>';
	       my ($s, $e) = map {
		    strftime("%Y/%m/%d<br>%H:%M:%S", localtime($a->{$_}))
	       } qw(starts ends);
	       my @o;
	       $a->{hostname} and push @o, "\"$a->{hostname}\"";
	       $a->{other} and push @o, @{$a->{other}};
	       my $o = @o ? join '<br>', @o : '<br>';
	       my @tds = map {"<td nowrap>$_</td>"}($ip, $m, $p, $s, $e, $o);
	       my $c = $opt_p ? " bgcolor=\"$color{$a->{ping}}\"" : '';
	       $_[0]->print("<tr$c>@tds</tr>\n");
	  }
	  $_[0]->print("</table>\n");
     }
     $_[0]->print("</p>\n");
}

# @_ = ("YYYY/MM/DD", "hh:mm:ss") -> UNIX epoch
sub epoch {
     my ($year, $mon, $mday) = split '/', $_[0];
     $year -= 1900;
     $mon -= 1;
     my ($hours, $min, $sec) = split ':', $_[1];
     return timegm($sec, $min, $hours, $mday, $mon, $year);
}

sub make_network_address {
     my $x = $_[0];
     
     if ($x == 24) {
	  return sub {
	       return ($_[0] =~ /^(\d+\.\d+\.\d+)\./o)[0] . '.0/24';
	  };
     } elsif ($x == 16) {
	  return sub {
	       return ($_[0] =~ /^(\d+\.\d+)\./o)[0] . '.0.0/16';
	  };
     } elsif ($x > 24) {	# 25 ... 31
	  my $n = (0xff << (32 - $x)) & 0xff;
	  return sub {
	       my ($a, $b, $c, $d) = split /\./o, $_[0], 4;
	       return "$a.$b.$c." . ($d & $n) . "/$x";
	  };
     } elsif ($x > 16) {	# 17 ... 23
	  my $n = (0xff << (24 - $x)) & 0xff;
	  return sub {
	       my ($a, $b, $c) = split /\./o, $_[0], 4;
	       return "$a.$b." . ($c & $n) . ".0/$x";
	  };
     } elsif ($x > 8) {		# 9 ... 15
	  my $n = (0xff << (16 - $x)) & 0xff;
	  return sub {
	       my ($a, $b) = split /\./o, $_[0], 3;
	       return "$a." . ($b & $n) . ".0.0/$x";
	  };
     } else { # netmask =< 8 ということはなさそうなのでサボっている
	  die "Sorry, I can't support netmask /$x, abort at";
     }
}

sub ipaddr_cmp {
     my ($a1, $a2, $a3, $a4) = split /[\.\/]/o, $a;
     my ($b1, $b2, $b3, $b4) = split /[\.\/]/o, $b;
     return ($a1 <=> $b1 or $a2 <=> $b2 or $a3 <=> $b3 or $a4 <=> $b4);
}

# 
sub dump_entries {
     my $d = new FileHandle ">> $_[0]" or die "$_[0] $!";
     
     # ファイルを排他ロックしてからファイルの末尾へ seek する。
     flock $d, LOCK_EX or die "$_[0] $!";
     $d->seek(0,2);
     
     $d->printf("$now %s\n", join ' ', # 出力
		(map { sprintf "$_:%d:%d", 
			    $_[1]->{$_}{total_lease}, $_[1]->{$_}{total_ping};
		} @{$_[1]->{networks}}));
     
     flock $d, LOCK_UN or die "$_[0] $!"; # ファイルロックを解除する
     $d->close;
}


# 一橋大情報処理センター専用
sub site_local_check {
     my %i;
     my ($S, $E) = ("<font color=\"$color{warn}\">", "</font>");
     local *I;
     
     # dhcpd.conf(の原本)をチェックする
     if (!open I, "< /home/cc/dhcpd/BASE") {
	  warn "$! BASE";
	  return;
     } else {
	  local $/ = "}\n";
	  while (<I>) {
	       my ($h) = /host (\S+) \{/o or next;
	       my ($m) = /hardware ethernet ([a-f:\d]+)/o or next;
	       $i{h}{$m} = $h;
	  }
     }
     # DHCP登録情報をチェックする
     if (!open I, "< /home/cc/dhcpd/MACLIST") {
	  warn "$! MACLIST";
	  return;
     }
     while (<I>) {
	  /^\#/o and next;
	  /Active$/o or next;
	  my ($u, $m, $e) = split /\s+/o, $_, 4;
	  $e =~ s/:[\d:]+$//o;
	  $i{u}{$m}{$u} = 1; # 複数のNICを所有しているユーザもいる
	  $i{m}{$u}{$m} = 1; # 複数のユーザが同じNICを共有しているケースもある
	  $i{e}{$u,$m} = $e; # 登録有効期限(年月日)
     }
     # srv の /etc/passwd (のコピー)を読んで GCOS をチェック
     if (!open I, "< /home/cc/passwd/passwd.srv") {
	  warn "$! passwd.srv";
	  return;
     }
     while (<I>) {
	  my ($u, $g) = (split /:/o, $_, 6)[0,4];
	  defined($i{m}{$u}) or next;
	  while (my ($m, $p) = each %{$i{m}{$u}}) {
	       $i{g}{$u} = $g;
	  }
     }
     # $_[0] にノードの情報を追加する
     for (@{$_[0]->{networks}}) {
	  my $p = $_[0]->{$_};
	  for my $ip (@{$p->{hosts}}) {
	       my $q = $p->{host}{$ip};
	       my $m = $q->{macaddr};
	       if (defined($i{h}{$m})) {
		    push @{$q->{other}}, $i{h}{$m};
		    next;
	       }
	       if (!defined($i{u}{$m})) {
		    push @{$q->{other}}, "${S}MACLIST中にMACアドレスなし${E}";
		    $q->{warn}++;
		    next;
	       }
	       while (my ($u, $r) = each %{$i{u}{$m}}) {
		    if (defined($i{g}{$u})) {
			 push @{$q->{other}}, "$u, $i{g}{$u}, $i{e}{$u,$m}";
		    } else {
			 push @{$q->{other}}, "$u, ${S}?${E}, $i{e}{$u,$m}",
			 "${S}<tt>/etc/passwd</tt>中にユーザ名なし${E}";
			 $q->{warn}++;
		    }
	       }
	  }
     }
}