dhcpd/list_leases.cgi

   1 #!/usr/local/bin/perl
   2 # list_leases.cgi
   3 # List all active leases
   4
   5 require './dhcpd-lib.pl';
   6 require 'timelocal.pl';
   7 &ReadParse();
   8 $timenow = time();
   9
  10 %access = &get_module_acl();
  11 &error_setup($text{'eacl_aviol'});
  12 &error("$text{'eacl_np'} $text{'eacl_psl'}") unless $access{'r_leases'};
  13
  14 if ($in{'network'}) {
  15         $desc = &text('listl_network', "<tt>$in{'network'}</tt>",
  16                                "<tt>$in{'netmask'}</tt>");
  17         }
  18 print "Refresh: $config{'lease_refresh'}\r\n"
  19         if ($config{'lease_refresh'});
  20 &ui_print_header($desc, $text{'listl_header'}, "");
  21
  22 # Work out how many IPs we have in our subnet ranges
  23 %ranges = ( );
  24 $conf = &get_config();
  25 @subnets = &find("subnet", $conf);
  26 foreach $shared (&find("shared-network", $conf)) {
  27         push(@subnets, &find("subnet", $shared->{'members'}));
  28         }
  29 foreach $subnet (@subnets) {
  30         if ($in{'network'}) {
  31                 # Only count ranges in specified subnet
  32                 if ($subnet->{'values'}->[0] ne $in{'network'}) {
  33                         next;
  34                         }
  35                 }
  36         $subnet->{'ips'} = 0;
  37         @ranges = &find("range", $subnet->{'members'});
  38         foreach $pool (&find("pool", $subnet->{'members'})) {
  39                 push(@ranges, &find("range", $pool->{'members'}));
  40                 }
  41         foreach $range (@ranges) {
  42                 local @rv = @{$range->{'values'}};
  43                 shift(@rv) if ($rv[0] eq "dynamic-bootp");
  44                 foreach $ip (&expand_ip_range($rv[0], $rv[1])) {
  45                         if (&within_network($ip)) {
  46                                 $ranges{$ip} = $subnet;
  47                                 }
  48                         $subnet->{'ips'}++;
  49                         }
  50                 }
  51         }
  52
  53 if (!-r $config{'lease_file'}) {
  54         # No leases file
  55         print "<b>".&text('listl_lfnotexist',$config{'lease_file'})."</b><p>\n";
  56         }
  57 elsif (!&tokenize_file($config{'lease_file'}, \@tok)) {
  58         # Leases file is not valid or empty
  59         print "<b>",&text('listl_lfnotcont',$config{'lease_file'}),"</b><p>\n";
  60         }
  61 else {
  62         # Parse lease file
  63         $i = $j = 0;
  64         local @nw = split(/\./, $in{'network'});
  65         local @nm = split(/\./, $in{'netmask'});
  66         LEASE: while($i < @tok) {
  67                 $lease = &parse_struct(\@tok, \$i, $j++, $config{'lease_file'});
  68                 next if (!$lease || $lease->{'name'} ne 'lease');
  69                 local $mems = $lease->{'members'};
  70                 local $starts = &find('starts', $mems);
  71                 local $ends = &find('ends', $mems);
  72                 $lease->{'stime'} = &lease_time($starts);
  73                 $lease->{'etime'} = &lease_time($ends);
  74                 if ($lease->{'etime'} < $timenow ||
  75                     $lease->{'stime'} > $timenow) {
  76                         if ($in{'all'}) { $lease->{'expired'}++; }
  77                         else { next; }
  78                         }
  79                 next if (!&within_network($lease->{'values'}->[0]));
  80                 push(@leases, $lease);
  81                 }
  82
  83         # Show links to select mode, if not showing a single subnet
  84         if (!$in{'network'}) {
  85                 @links = ( );
  86                 foreach $m (0, 1) {
  87                         $msg = $text{'listl_mode_'.$m};
  88                         if ($m != $in{'bysubnet'}) {
  89                                 $msg = "<a href='list_leases.cgi?bysubnet=$m'>".
  90                                        "$msg</a>";
  91                                 }
  92                         push(@links, $msg);
  93                         }
  94                 print "<b>$text{'listl_mode'}</b> ",
  95                       &ui_links_row(\@links),"<br>\n";
  96                 }
  97
  98         if ($in{'bysubnet'}) {
  99                 # Show table of subnets, with lease usage
 100                 print &ui_columns_start([
 101                         $text{'index_net'}, $text{'index_desc'},
 102                         $text{'listl_size'}, $text{'listl_used'},
 103                         $text{'listl_pc'} ], 100);
 104                 foreach $subnet (@subnets) {
 105                         %used = ( );
 106                         foreach $lease (@leases) {
 107                                 $r = $ranges{$lease->{'values'}->[0]};
 108                                 if ($r eq $subnet && !$lease->{'expired'}) {
 109                                         $used{$lease->{'values'}->[0]}++;
 110                                         }
 111                                 }
 112                         $used = scalar(keys %used);
 113                         print &ui_columns_row([
 114                                 $subnet->{'values'}->[0],
 115                                 &html_escape($subnet->{'comment'}),
 116                                 $subnet->{'ips'},
 117                                 $used,
 118                                 $subnet->{'ips'} ?
 119                                         int(100*$used / $subnet->{'ips'})."%" :
 120                                         "",
 121                                 ]);
 122                         }
 123                 print &ui_columns_end();
 124                 }
 125         elsif (@leases) {
 126                 # Sort leases by selected type
 127                 if ($in{'sort'} eq 'ipaddr') {
 128                         @leases = sort { &ip_compare($a, $b) } @leases;
 129                         }
 130                 elsif ($in{'sort'} eq 'ether') {
 131                         @leases = sort { &ether_compare($a, $b) } @leases;
 132                         }
 133                 elsif ($in{'sort'} eq 'host') {
 134                         @leases = sort { &hostname_compare($a, $b) } @leases;
 135                         }
 136                 elsif ($in{'sort'} eq 'start') {
 137                         @leases = sort { $a->{'stime'} <=> $b->{'stime'} }
 138                                        @leases;
 139                         }
 140                 elsif ($in{'sort'} eq 'end') {
 141                         @leases = sort { $a->{'etime'} <=> $b->{'etime'} }
 142                                        @leases;
 143                         }
 144                 elsif ($config{'lease_sort'} == 1) {
 145                         @leases = sort { &ip_compare($a, $b) } @leases;
 146                         }
 147                 elsif ($config{'lease_sort'} == 2) {
 148                         @leases = sort { &hostname_compare($a, $b) } @leases;
 149                         }
 150
 151                 # Show available and used
 152                 $leased = 0;
 153                 foreach $lease (@leases) {
 154                         $ip = $lease->{'values'}->[0];
 155                         if ($ranges{$ip} && !$donelease{$ip}++ &&
 156                             !$lease->{'expired'}) {
 157                                 $leased++;
 158                                 }
 159                         }
 160                 if (keys %ranges) {
 161                         print &text('listl_allocs',
 162                             scalar(keys %ranges), $leased,
 163                             int($leased*100/scalar(keys %ranges))),"<p>\n";
 164                         }
 165
 166                 # Table header, with sorting
 167                 @tds = ( "width=5" );
 168                 print &ui_form_start("delete_leases.cgi", "post");
 169                 print &ui_hidden("all", $in{'all'});
 170                 print &ui_hidden("network", $in{'network'});
 171                 print &ui_hidden("netmask", $in{'netmask'});
 172                 @links = ( &select_all_link("d"), &select_invert_link("d") );
 173                 $links = "<table width=100%><tr><td>".
 174                          &ui_links_row(\@links).
 175                          "</td><td align=right>".
 176                          &ui_links_row([ "<a href='list_leases.cgi?$in'>".
 177                                          "$text{'listl_refresh'}</a>" ]).
 178                          "</td></tr></table>\n";
 179                 print $links;
 180                 print &ui_columns_start([
 181                         "",
 182                         &sort_link("ipaddr"),
 183                         &sort_link("ether"),
 184                         &sort_link("host"),
 185                         &sort_link("start"),
 186                         &sort_link("end"),
 187                         ], 100, 0, \@tds);
 188
 189                 foreach $lease (@leases) {
 190                         local @cols;
 191                         local $mems = $lease->{'members'};
 192                         local $starts = &find('starts', $mems);
 193                         local $ends = &find('ends', $mems);
 194                         local $ht = $lease->{'expired'} ? "i" : "tt";
 195                         push(@cols, "<$ht>$lease->{'values'}->[0]</$ht>");
 196                         local $hard = &find('hardware', $mems);
 197                         push(@cols,$hard->{'values'}->[1] ?
 198                                 "<tt>$hard->{'values'}->[1]</tt>" :
 199                                  "<i>$text{'listl_unknown'}</i>");
 200                         local $client = &find('client-hostname', $mems);
 201                         push(@cols, $client ? "<tt>".&html_escape(
 202                                               $client->{'values'}->[0])."</tt>"
 203                                             : undef);
 204                         if ($config{'lease_tz'}) {
 205                                 $s = &make_date($lease->{'stime'});
 206                                 $e = &make_date($lease->{'etime'});
 207                                 }
 208                         else {
 209                                 $s = $starts->{'values'}->[1]." ".
 210                                      $starts->{'values'}->[2];
 211                                 $e = $ends->{'values'}->[1]." ".
 212                                      $ends->{'values'}->[2];
 213                                 }
 214
 215                         push(@cols, "<tt>$s</tt>");
 216                         push(@cols, "<tt>$e</tt>");
 217                         print &ui_checked_columns_row(\@cols, \@tds, "d",
 218                                                       $lease->{'index'});
 219                         }
 220                 print &ui_columns_end();
 221                 print $links;
 222                 print &ui_form_end([ [ undef, $text{'listl_delete'} ] ]);
 223                 }
 224         else {
 225                 print "<b>",&text($in{'all'} ? 'listl_lfnotcont' :
 226                                   'listl_lfnotcont2', $config{'lease_file'}),
 227                       "</b><p>\n";
 228                 }
 229         if (!$in{'all'} && !$in{'bysubnet'}) {
 230                 print &ui_form_start("list_leases.cgi");
 231                 print &ui_hidden("all", 1);
 232                 print &ui_hidden("network", $in{'network'});
 233                 print &ui_hidden("netmask", $in{'netmask'});
 234                 print &ui_form_end([ [ undef, $text{'listl_all'} ] ]);
 235                 }
 236         }
 237
 238 &ui_print_footer("", $text{'listl_return'});
 239
 240 sub lease_time
 241 {
 242 local @d = split(/\//, $_[0]->{'values'}->[1]);
 243 local @t = split(/:/, $_[0]->{'values'}->[2]);
 244 local $t;
 245 eval { $t = timegm($t[2], $t[1], $t[0], $d[2], $d[1]-1, $d[0]-1900) };
 246 return $@ ? undef : $t;
 247 }
 248
 249 sub ip_compare
 250 {
 251 $a->{'values'}->[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
 252 local ($a1, $a2, $a3, $a4) = ($1, $2, $3, $4);
 253 $b->{'values'}->[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
 254 return  $a1 < $1 ? -1 :
 255         $a1 > $1 ? 1 :
 256         $a2 < $2 ? -1 :
 257         $a2 > $2 ? 1 :
 258         $a3 < $3 ? -1 :
 259         $a3 > $3 ? 1 :
 260         $a4 < $4 ? -1 :
 261         $a4 > $4 ? 1 : 0;
 262 }
 263
 264 sub hostname_compare
 265 {
 266 local $client_a = &find_value('client-hostname', $a->{'members'});
 267 local $client_b = &find_value('client-hostname', $b->{'members'});
 268 return lc($client_a) cmp lc($client_b);
 269 }
 270
 271 sub ether_compare
 272 {
 273 local $ether_a = &find('hardware', $a->{'members'});
 274 local $ether_b = &find('hardware', $b->{'members'});
 275 return lc($ether_a->{'values'}->[1]) cmp lc($ether_b->{'values'}->[1]);
 276 }
 277
 278 sub sort_link
 279 {
 280 local ($c) = @_;
 281 if ($in{'sort'} eq $c) {
 282         return $text{'listl_'.$c};
 283         }
 284 else {
 285         return "<a href='list_leases.cgi?all=$in{'all'}&network=$in{'network'}&netmask=$in{'netmask'}&sort=$c'>".$text{'listl_'.$c}."</a>";
 286         }
 287 }
 288
 289 sub within_network
 290 {
 291 local ($ip) = @_;
 292 if ($in{'network'}) {
 293         # Is lease within network/netmask?
 294         local @ad = split(/\./, $ip);
 295         for($k=0; $k<4; $k++) {
 296                 if ((int($ad[$k]) & int($nm[$k])) != int($nw[$k])) {
 297                         return 0;
 298                         }
 299                 }
 300         }
 301 return 1;
 302 }