#!/usr/bin/perl
#
# DHCP Reporting, Revision 2.1
# 
# Copyright (C) 1997-2002 John G. Drummond (omar@omar.org)
# http://www.omar.org/opensource/
#
# Feel free to email me with comments, criticisms, or questions.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# This program uses Stephen Brenner's cgi-lib.pl, included at the end
# of the file for compactness.  See the copyright statement preceding
# the cgi-lib.pl code.
#

#################################################################
###--------------------------OPTIONS--------------------------###

	# Change to your dhcp file and dhcpd.conf:
	# (Currently set to ISC DHCP defaults)

my $dhcpfile = "/var/lib/dhcp/dhcpd.leases";
my $dhcpdconf = "/etc/dhcp/dhcpd.conf";

	# change to the relative (web) path to the cgi directory where
	# reportdhcp.pl is located (usually /cgi-bin):

my $CGI = "/cgi-bin";

	# change to reflect your system name

my $sysname = "PSU12-Sritrang";

###----------------------End of Options-----------------------###
#################################################################



  # MAIN PROGRAM #

ReadParse(*values);			#contained in cgi-lib.pl, at the bottom.
print "Content-type: text/html\n\n";
print "<html>\n<head>\n";
print "<title>reportdhcp.pl - DHCP Reporting</title>\n</head>";

&ParseConfig();
&ParseLeaseFile();

#perform the requested action... 

if ($values{"sort"} eq "ipsort") {&sortip;}
elsif ($values{"sort"} eq "namesort") {&sortname;}
elsif ($values{"sort"} eq "agesort") {&sortdate;}
elsif ($values{"dostats"} || $ARGV[0] eq "test") {&stats;}
elsif ($values{"findip"}) {&findip;}
elsif ($values{"findmac"}) {&findmac;}
elsif ($values{"findname"}) {&findname;}
else {&dohtml;}					#default action, even if input is bogus
print "</body></html>";
exit 0;

 # END MAIN PROGRAM #


# Sorts entries by the client-hostname field
sub sortname {
	my %names;
	$counter=0;		
	foreach $ip (@ips) {
		$name = $lease{$ip}{"client-hostname"};
		$names{$name.$counter}=$ip; #counter keeps identical names from clobbering
		$counter++;
	}
	my @sorted = sort(keys(%names));
	print "<H2>$sysname</H2>\n";
	print "<h2>Entries in dhcpd.leases sorted by name</h2>\n";
	&PrintEntries(\@sorted, \%names);
}

# Sorts entries by lease start date
sub sortdate {
	my %ages;
	foreach $ip (@ips) {
		$age = $lease{$ip}{"starts"};
		@age1 = split(/ /, $age);	
		@date = split (/\//, $age1[1]);
		@hour = split (/:/, $age1[2]);
		$age = $date[0].$date[1].$date[2].$hour[0].$hour[1].$hour[2];
		$ages{$age}=$ip;
	}
	@sorted = sort(keys(%ages));
	print "<H2>$sysname</H2>\n";
	print "<h2>Entries in dhcpd.leases sorted by age</h2>\n";
	&PrintEntries(\@sorted, \%ages);
}

#Sorts entries by IP address (Actually, they're already sorted.  Sorta. ;) )
sub sortip {
	print "<H2>$sysname</H2>\n";
	print "<h2>Entries in dhcpd.leases sorted by IP address</h2>\n";
	&PrintEntries(\@ips)
}

#Finds entry for a given IP address.
sub findip {
	$ip = $values{"findip"};
	chomp($ip);
	print "<H2>$sysname</H2>\n";	
	print "<table border=1><tr><th>IP</th><th>MAC</th>";
	print "<th>Name</th><th>Starts</th><th>Ends</th></tr>";
	print "<tr><td>$ip</td><td>".$lease{$ip}{"hardware"}; 
	print "</td><td> &nbsp; ".$lease{$ip}{"client-hostname"}."</td>";
	print "<td>"; 	
	&parsedate($lease{$ip}{"starts"});
	print "</td><td>"; 
	&parsedate($lease{$ip}{"ends"});
	print "</td></tr></table>";
	print "</table><center><a href=\"$CGI/reportdhcp.pl\">Back</a></center>";
}

#Finds entry for a given MAC address (hardware id in leases file)
sub findmac {
	$mac = $values{"findmac"};
	print "<H2>$sysname</H2>\n";
	print "<table border=1><tr><th>IP</th><th>MAC</th>";
	print "<th>Name</th><th>Starts</th><th>Ends</th></tr>";
	foreach $ip (@ips) {
		if ($lease{$ip}{"hardware"} =~ /$mac/) {
			print "<tr><td>$ip</td><td>".$lease{$ip}{"hardware"};
			print "</td><td> &nbsp; ".$lease{$ip}{"client-hostname"}."</td>";
			print "<td>".$lease{$ip}{"starts"}."</td><td>";
			print $lease{$ip}{"ends"}."</td></tr>";
		}
	}
	print "</table><center><a href=\"$CGI/reportdhcp.pl\">Back</a></center>";
}

#Finds an entry based on a given name (client-hostname in leases file)
sub findname {
	$name = $values{"findname"};
	print "<H2>$sysname</H2>\n";
	print "<table border=1><tr><th>IP</th><th>MAC</th>";
	print "<th>Name</th><th>Starts</th><th>Ends</th></tr>";
	foreach $ip (@ips) {
		if ($lease{$ip}{"client-hostname"} =~ /$name/) {
			print "<tr><td>$ip</td><td>".$lease{$ip}{"hardware"};
			print "</td><td> &nbsp; ".$lease{$ip}{"client-hostname"}."</td>";
			print "<td>".$lease{$ip}{"starts"}."</td><td>";
			print $lease{$ip}{"ends"}."</td></tr>";
		}
	}
	print "</table><center><a href=\"$CGI/reportdhcp.pl\">Back</a></center>";
}

#Prints general statistics table
sub stats {
	print "<H2>$sysname</H2>\n";
	print "<center><h3>General Statistics</h3>\n";
	print "<table border=1><tr><th colspan=3>Total Leases in file:</th>";
	print "<td colspan=2>$entries</td></tr>\n";
	print "<tr><th colspan=3>Abandoned Leases:</th><td colspan=2>";
	my $abcount = 0;
	my $expcount = 0;
	my $ip="";

	foreach $ip (@ips) {

		if (!$lease{$ip}{"hardware"}) {
			$abcount++;
		}
		elsif ($lease{$ip}{"binding"} eq "free") {
			$expcount++;
		}


	}
	print "$abcount</td></tr>\n";
	print "<tr><th colspan=3>Expired Leases:</th><td colspan=2>";
	print "$expcount</td></tr>\n";
	print "<tr><th colspan=5>Usage by Network</th></tr>\n";
	print "<tr><td><b>Network</b></td><td><b>Netmask</b></td>";
	print "<td><b>Active</b></td><td><b>Abandoned</b></td><td><b>Expired</b></td></tr>\n";
	foreach $net (@networks) {
		my $count=0;
		my $abcount=0;
		my $expcount=0;
		my $wtf=0;
		foreach $entry (@ips) {
			if (&isinrange ($range{$net}, $entry) eq "true") {



				if (!$lease{$entry}{"hardware"}) {
					$abcount++;
				} 
				elsif ($lease{$entry}{"binding"} eq "free") {
					$expcount++;
				}
				elsif ($lease{$entry}{"binding"} eq "active") {
					$count++;
				}
				else {
					$wtf++;  #Used for debugging only
				}
			}	
		}
		print "<tr><td>$net</td><td><i>$nets{$net}</i><td><b>$count</b></td>";
		print "<td>$abcount</td><td>$expcount</td></tr>\n";	
	}
	print "</table>\n<a href=\"$CGI/reportdhcp.pl\">Back</a>\n</html>";
}

#Parses lease file date into a more easily readable format
sub parsedate {
	@date = split(/ /, $_[0]);

	%months =	("01", "January",
			"02", "February",
			"03", "March",
			"04", "April",
			"05", "May",
			"06", "June",
			"07", "July",
			"08", "August",
			"09", "September",
			"10", "October",
			"11", "November",
			"12", "December");
	
	%days =		("0", "Sunday",
		 	"1", "Monday",
			"2", "Tuesday",
			"3", "Wednesday",
			"4", "Thursday",
			"5", "Friday",
			"6", "Saturday");

	$date[0] = $days{$date[0]}. ", ";
	@day = split (/\//, $date[1]);
	$date[1] = $months{$day[1]} . " $day[2], $day[0] ";
	print @date, " GMT";
}
	
#Checks to see if a given address is in a given range, by octet.
#Probably inefficient as hell.  
sub isinrange ($$) {
	my ($rangestr, $ip) = @_;
        local @success;
        @ranges = split (/:/, $rangestr);
        local @ip = split (/\./, $ip);
        foreach $range (@ranges) {
                local @bounds = split(/-/, $range);
                @lower=split(/\./, $bounds[0]);
                @upper=split(/\./, $bounds[1]);
                for ($i=0; $i<4; $i++) {
                        if (($ip[$i] >= $lower[$i]) && ($ip[$i] <= $upper[$i])) {
                                $success[$i] = 1;
                        }
                        else {
                                $success[$i] = 0;
                        }
                }
                local $test = $success[0]+$success[1]+$success[2]+$success[3];
                if ($test == 4) {
                        return "true";    #success!
                }
        }
        return "false";   #failure!
}


#Reads and munges the dhcpd.conf file
sub ParseConfig {

	unless(open (IN, $dhcpdconf)) {
		&CgiDie("Error: unable to open file $dhcpdconf: $!"); #CgiDie from cgi-lib.pl.
		exit -1;
	}
	my @info = <IN>;
	close (IN) or &CgiDie ("Couldn't close $dhcpdconf: $!");

	my $line;
	my @parts;
	my $i = 0;
	my $dlt;	#not doing anything with dlt yet!	
	our %range;
	
	while ($line=$info[$i]) {		# parse the dhcpd.conf file
	
		if ($line =~ m/^#/) { # ignore commented lines
			$i++;
			next;
		}
	
		if ($line =~ m/default-lease-time/) {	#found default lease time
			@parts= split(/\s/, $line);
			$dlt = $parts[1];
		}
	
	        if ($line =~ m/subnet/) {
	                my @parts = split (/\s/, $line);
	                my $j = 0;
	                foreach $part(@parts) {
	                        if ($part eq "subnet") {
	                                $netwk =  $parts[$j+1];
	                                $mask = $parts[$j+3];
	                                $nets{$netwk} = $mask;            #save net and mask pairs in a hash
	                        }
	                	$j++;
	                }
	        }
		if ($line =~ m/range/) {				# get address range
			my @parts = split (/\s/, $line);
	                $j = 0;
			foreach $part(@parts) {
				if ($part eq "range") {		# Potential list of ranges... 
					chop ($parts[$j+2]);
					$range{$netwk} .= $parts[$j+1] . "-" . $parts[$j+2] . ":";
				}
				$j++;
			}
		}
	        $i++;
	}
	our @networks = sort(keys(%nets));
}


#Prints out sorted tables for other routines
sub PrintEntries {

	my ($sortref, $dataref) = @_; 		# have to pass as a referece
	my @sorted = @$sortref;			# dereference for my sanity
	if ($dataref) {
		our %data = %$dataref;		# "                       "
	}
	print "<p><a href=\"$CGI/reportdhcp.pl\">Back to main</a></p>\n";

	## offer filter button
	print '<form action="'.$CGI.'/reportdhcp.pl" method="POST">';
	print "<b>Filter:</b> ";
	if ($values{"filteractive"}) {
	     	print "<input type=\"checkbox\" name=\"filteractive\" value=\"1\" CHECKED> Active Leases Only\n";
	}
	else {
	     	print "<input type=\"checkbox\" name=\"filteractive\" value=\"1\"> Active Leases Only\n";
	}
	print "<input type=\"hidden\" name=\"sort\" value=\"".$values{"sort"}."\">\n";
       	print '<br><input type="submit" value="Refresh Screen"></form>';

	## Calculate current GMT 
	my ($sec, $min, $hr, $mond, $mon, $year, $weekd, $yeard, $dls) = gmtime(time);
	$year += 1900;
	$mon++;
	if ($mon < 10) {
		$mon = "0" . $mon;
	}
	my $curgmt = "$weekd $year/$mon/$mond $hr:$min:$sec";
	print "Current time is: <b> ";
	&parsedate($curgmt);
	print "</b><br>\n";

	print "\n<table border=1><tr><th>\&nbsp\;</th><th>IP</th><th>MAC</th>\n";
	print "<th>Name</th><th>Status</th><th>Starts</th><th>Ends</th></tr>\n";
	
	foreach $entry (@sorted) {
		if ($dataref) {
			$ip = $data{$entry};
		}
		else {
			$ip = $entry;
		}
		unless ($values{"filteractive"} && $lease{$ip}{"binding"} eq "free") {
			print "<tr><td>\n";
			print '<form action="'.$CGI.'/reportdhcp.pl" method="POST">';
	        	print "\n<input type=\"hidden\" name=\"findip\" value=\"$ip\">";
	        	print '<input type="submit" value="Select"></form></td>';
			print "\n<td><font size=-1>$ip</td>\n";
			print "<td><font size=-1>".$lease{$ip}{"hardware"}."</td>\n";
			print "<td><font size=-1> &nbsp; ".$lease{$ip}{"client-hostname"}."</td>\n";
			print "<td><font size=-1>".$lease{$ip}{"binding"}."</td>\n";
			print "<td><font size=-1>";
			&parsedate($lease{$ip}{"starts"});
			print "</td>\n";
			print "<td><font size=-1>";
			&parsedate($lease{$ip}{"ends"});
			print "</td></tr>\n";
		}
	}
	print "</table>\n<p><a href=\"$CGI/reportdhcp.pl\">Back to main</a></p>\n";
	print "</body></html>\n";

}

# Reads and munges the leases file generated by dhcpd
sub ParseLeaseFile {
	
	our %lease;
	unless(open (IN, $dhcpfile)) {
		print "\nError: unable to open file $dhcpfile: $! \n";
		exit -1;
	}	
	my @leases = <IN>;
	my $data = "";
	foreach $line (@leases) {
		unless ($line =~ m/^#/) { # ignore commented lines
			$data .= $line;
		}
	}
	my @data = split (/lease /, $data); 	#split each lease into an array entry
	foreach (@data) {	                #create hash of hashes keyed on ip from the array
		my @temp = split(/{/, $_);
		chop($temp[0]);			# 0 is IP 
		chop($temp[1]);			# 1 is the rest...
		chop($temp[1]);
		$temp[1] =~ tr/\t//d;
		@t = split(/;\n/, $temp[1]);	#split each lease on newline 
		my $i=0;
		while ($t[$i]) {
			my $string = $t[$i];
			$string =~ tr/\n//d;
	 		$string =~ s/^\s*//; # remove any leading spaces 
			@words = split(/\s+/, $string); #hashes keyed on first word
	
			if ($words[0]) {
				$key = shift(@words);
				$lease{$temp[0]}{$key}="@words";
				$lease{$temp[0]}{"hardware"}=~ s/ethernet//;		
				$lease{$temp[0]}{"binding"}=~ s/state //;		
			}
			$i++;
		}
	}
	my @temp = sort(keys(%lease));
	my $prev = "";					# checks for duplicates
	@ips=grep($_ ne $prev && (($prev) = $_), @temp);
	$entries = @ips;
}

#Prints the base page
sub dohtml {

print << "HTMLDONE";
<body>
<center>
<h3>DHCP Reporting!</h3>
<font size=-1>v. 2.1 by <a href=\"mailto:omar\@allwrong.com\">John G. Drummond</a>
</font>
<p>

<H2>$sysname</H2>
<table border=1> 
<tr>
	<td>General Stats</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method=\"POST\">
	<input type=\"hidden\" name=\"dostats\" value=\"yes\">
	<input type=\"submit\" value=\"GO!\"></form>
	</td>
</tr>


<tr>
	<td>DHCP lease file entries, sorted by IP</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method=\"POST\">
	<input type=\"hidden\" name=\"sort\" value=\"ipsort\">
	<input type=\"submit\" value="GO!"></form>
	</td>
</tr>
<tr>
	<td>DHCP lease file entries, sorted by Age</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method=\"POST\">
	<input type=\"hidden\" name=\"sort\" value=\"agesort\">
	<input type=\"submit\" value=\"GO!\">
	</form>
	</td>
</tr>
<tr>
	<td>DHCP lease file entries, sorted by Name</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method=\"POST\">
	<input type=\"hidden\" name=\"sort\" value=\"namesort\">
	<input type=\"submit\" value=\"GO!\">
	</form>
	</td>
</tr>
</table>
<p>

<table border=1>
<tr>
	<td>Find the entry for this IP address:</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method="POST">
	<input type=\"text\" name=\"findip\" length=\"25\">
	<input type=\"submit\" value=\"GO!\">
	</form>
	</td>
</tr>
<tr>
	<td>Find the entry for this MAC address:</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method=\"POST\">
	<input type=\"text\" name=\"findmac\" length=\"25\">
	<input type=\"submit\" value=\"GO!\">
	</form>
	</td>
</tr>
<tr>
	<td>Find the entry for this Client Name:</td>
	<td>
	<form action=\"$CGI/reportdhcp.pl\" method="POST">
	<input type=\"text\" name=\"findname\" length=\"25\">
	<input type=\"submit\" value=\"GO!\">
	</form>
	</td>
</tr>
</table>
</body>
</html>
HTMLDONE
}

BEGIN {
#Stephen Brenner's cgi-lib.pl is included below for compactness,
#in its entirety for completeness.  Copyright statement follows:

#------- Begin cgi-lib.pl ---------

# Perl Routines to Manipulate CGI input
# cgi-lib@pobox.com
# $Id: cgi-lib.pl,v 2.18 1999/02/23 08:16:43 brenner Exp $
#
# Copyright (c) 1993-1999 Steven E. Brenner  
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
#
# Thanks are due to many people for reporting bugs and suggestions

# For more information, see:
#     http://cgi-lib.stanford.edu/cgi-lib/

$cgi_lib'version = sprintf("%d.%02d", q$Revision: 2.18 $ =~ /(\d+)\.(\d+)/);


# Parameters affecting cgi-lib behavior
# User-configurable parameters affecting file upload.
$cgi_lib'maxdata    = 131072;    # maximum bytes to accept via POST - 2^17
$cgi_lib'writefiles =      0;    # directory to which to write files, or
                                 # 0 if files should not be written
$cgi_lib'filepre    = "cgi-lib"; # Prefix of file names, in directory above

# Do not change the following parameters unless you have special reasons
$cgi_lib'bufsize  =  8192;    # default buffer size when reading multipart
$cgi_lib'maxbound =   100;    # maximum boundary length to be encounterd
$cgi_lib'headerout =    0;    # indicates whether the header has been printed


# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# key/value pairs in %in, using "\0" to separate multiple selections

# Returns >0 if there was input, 0 if there was no input 
# undef indicates some failure.

# Now that cgi scripts can be put in the normal file space, it is useful
# to combine both the form and the script in one place.  If no parameters
# are given (i.e., ReadParse returns FALSE), then a form could be output.

# If a reference to a hash is given, then the data will be stored in that
# hash, but the data from $in and @in will become inaccessable.
# If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,
# information is stored there, rather than in $in, @in, and %in.
# Second, third, and fourth parameters fill associative arrays analagous to
# %in with data relevant to file uploads. 

# If no method is given, the script will process both command-line arguments
# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
# This is intended to aid debugging and may be changed in future releases

sub ReadParse {
  # Disable warnings as this code deliberately uses local and environment
  # variables which are preset to undef (i.e., not explicitly initialized)
  local ($perlwarn);
  $perlwarn = $^W;
  $^W = 0;

  local (*in) = shift if @_;    # CGI input
  local (*incfn,                # Client's filename (may not be provided)
	 *inct,                 # Client's content-type (may not be provided)
	 *insfn) = @_;          # Server's filename (for spooled files)
  local ($len, $type, $meth, $errflag, $cmdflag, $got, $name);
	
  binmode(STDIN);   # we need these for DOS-based systems
  binmode(STDOUT);  # and they shouldn't hurt anything else 
  binmode(STDERR);
	
  # Get several useful env variables
  $type = $ENV{'CONTENT_TYPE'};
  $len  = $ENV{'CONTENT_LENGTH'};
  $meth = $ENV{'REQUEST_METHOD'};
  
  if ($len > $cgi_lib'maxdata) { #'
      &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");
  }
  
  if (!defined $meth || $meth eq '' || $meth eq 'GET' || 
      $meth eq 'HEAD' ||
      $type eq 'application/x-www-form-urlencoded') {
    local ($key, $val, $i);
	
    # Read in text
    if (!defined $meth || $meth eq '') {
      $in = $ENV{'QUERY_STRING'};
      $cmdflag = 1;  # also use command-line options
    } elsif($meth eq 'GET' || $meth eq 'HEAD') {
      $in = $ENV{'QUERY_STRING'};
    } elsif ($meth eq 'POST') {
        if (($got = read(STDIN, $in, $len) != $len))
	  {$errflag="Short Read: wanted $len, got $got\n";};
    } else {
      &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
    }

    @in = split(/[&;]/,$in); 
    push(@in, @ARGV) if $cmdflag; # add command-line parameters

    foreach $i (0 .. $#in) {
      # Convert plus to space
      $in[$i] =~ s/\+/ /g;

      # Split into key and value.  
      ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

      # Convert %XX from hex numbers to alphanumeric
      $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
      $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;

      # Associate key and value
      $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
      $in{$key} .= $val;
    }

  } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
    # for efficiency, compile multipart code only if needed
$errflag = !(eval <<'END_MULTIPART');

    local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
    local ($bpos, $lpos, $left, $amt, $fn, $ser);
    local ($bufsize, $maxbound, $writefiles) = 
      ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);


    # The following lines exist solely to eliminate spurious warning messages
    $buf = ''; 

    ($boundary) = $type =~ /boundary="([^"]+)"/; #";   # find boundary
    ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
    &CgiDie ("Boundary not provided: probably a bug in your server") 
      unless $boundary;
    $boundary =  "--" . $boundary;
    $blen = length ($boundary);

    if ($ENV{'REQUEST_METHOD'} ne 'POST') {
      &CgiDie("Invalid request method for  multipart/form-data: $meth\n");
    }

    if ($writefiles) {
      local($me);
      stat ($writefiles);
      $writefiles = "/tmp" unless  -d _ && -w _;
      # ($me) = $0 =~ m#([^/]*)$#;
      $writefiles .= "/$cgi_lib'filepre"; 
    }

    # read in the data and split into parts:
    # put headers in @in and data in %in
    # General algorithm:
    #   There are two dividers: the border and the '\r\n\r\n' between
    # header and body.  Iterate between searching for these
    #   Retain a buffer of size(bufsize+maxbound); the latter part is
    # to ensure that dividers don't get lost by wrapping between two bufs
    #   Look for a divider in the current batch.  If not found, then
    # save all of bufsize, move the maxbound extra buffer to the front of
    # the buffer, and read in a new bufsize bytes.  If a divider is found,
    # save everything up to the divider.  Then empty the buffer of everything
    # up to the end of the divider.  Refill buffer to bufsize+maxbound
    #   Note slightly odd organization.  Code before BODY: really goes with
    # code following HEAD:, but is put first to 'pre-fill' buffers.  BODY:
    # is placed before HEAD: because we first need to discard any 'preface,'
    # which would be analagous to a body without a preceeding head.

    $left = $len;
   PART: # find each part of the multi-part while reading data
    while (1) {
      die $@ if $errflag;

      $amt = ($left > $bufsize+$maxbound-length($buf) 
	      ?  $bufsize+$maxbound-length($buf): $left);
      $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
      die "Short Read: wanted $amt, got $got\n" if $errflag;
      $left -= $amt;

      $in{$name} .= "\0" if defined $in{$name}; 
      $in{$name} .= $fn if $fn;

      $name=~/([-\w]+)/;  # This allows $insfn{$name} to be untainted
      if (defined $1) {
        $insfn{$1} .= "\0" if defined $insfn{$1}; 
        $insfn{$1} .= $fn if $fn;
      }
 
     BODY: 
      while (($bpos = index($buf, $boundary)) == -1) {
        if ($left == 0 && $buf eq '') {
	  foreach $value (values %insfn) {
            unlink(split("\0",$value));
	  }
	  &CgiDie("cgi-lib.pl: reached end of input while seeking boundary " .
		  "of multipart. Format of CGI input is wrong.\n");
        }
        die $@ if $errflag;
        if ($name) {  # if no $name, then it's the prologue -- discard
          if ($fn) { print FILE substr($buf, 0, $bufsize); }
          else     { $in{$name} .= substr($buf, 0, $bufsize); }
        }
        $buf = substr($buf, $bufsize);
        $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
        $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
	die "Short Read: wanted $amt, got $got\n" if $errflag;
        $left -= $amt;
      }
      if (defined $name) {  # if no $name, then it's the prologue -- discard
        if ($fn) { print FILE substr($buf, 0, $bpos-2); }
        else     { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
      }
      close (FILE);
      last PART if substr($buf, $bpos + $blen, 2) eq "--";
      substr($buf, 0, $bpos+$blen+2) = '';
      $amt = ($left > $bufsize+$maxbound-length($buf) 
	      ? $bufsize+$maxbound-length($buf) : $left);
      $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
      die "Short Read: wanted $amt, got $got\n" if $errflag;
      $left -= $amt;


      undef $head;  undef $fn;
     HEAD:
      while (($lpos = index($buf, "\r\n\r\n")) == -1) { 
        if ($left == 0  && $buf eq '') {
	  foreach $value (values %insfn) {
            unlink(split("\0",$value));
	  }
	  &CgiDie("cgi-lib: reached end of input while seeking end of " .
		  "headers. Format of CGI input is wrong.\n$buf");
        }
        die $@ if $errflag;
        $head .= substr($buf, 0, $bufsize);
        $buf = substr($buf, $bufsize);
        $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
        $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
        die "Short Read: wanted $amt, got $got\n" if $errflag;
        $left -= $amt;
      }
      $head .= substr($buf, 0, $lpos+2);
      push (@in, $head);
      @heads = split("\r\n", $head);
      ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
      ($ct) = grep (/^\s*Content-Type:/i, @heads);

      ($name) = $cd =~ /\bname="([^"]+)"/i; #"; 
      ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;  

      ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
      ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
      $incfn{$name} .= (defined $in{$name} ? "\0" : "") . 
        (defined $fname ? $fname : "");

      ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i;  #";
      ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
      $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;

      if ($writefiles && defined $fname) {
        $ser++;
	$fn = $writefiles . ".$$.$ser";
	open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
        binmode (FILE);  # write files accurately
      }
      substr($buf, 0, $lpos+4) = '';
      undef $fname;
      undef $ctype;
    }

1;
END_MULTIPART
    if ($errflag) {
      local ($errmsg, $value);
      $errmsg = $@ || $errflag;
      foreach $value (values %insfn) {
        unlink(split("\0",$value));
      }
      &CgiDie($errmsg);
    } else {
      # everything's ok.
    }
  } else {
    &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
  }

  # no-ops to avoid warnings
  $insfn = $insfn;
  $incfn = $incfn;
  $inct  = $inct;

  $^W = $perlwarn;

  return ($errflag ? undef :  scalar(@in)); 
}


# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document

sub PrintHeader {
  return "Content-type: text/html\n\n";
}


# HtmlTop
# Returns the <head> of a document and the beginning of the body
# with the title and a body <h1> header as specified by the parameter

sub HtmlTop
{
  local ($title) = @_;

  return <<END_OF_TEXT;
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
END_OF_TEXT
}


# HtmlBot
# Returns the </body>, </html> codes for the bottom of every HTML page

sub HtmlBot
{
  return "</body>\n</html>\n";
}


# SplitParam
# Splits a multi-valued parameter into a list of the constituent parameters

sub SplitParam
{
  local ($param) = @_;
  local (@params) = split ("\0", $param);
  return (wantarray ? @params : $params[0]);
}


# MethGet
# Return true if this cgi call was using the GET request, false otherwise

sub MethGet {
  return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");
}


# MethPost
# Return true if this cgi call was using the POST request, false otherwise

sub MethPost {
  return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");
}


# MyBaseUrl
# Returns the base URL to the script (i.e., no extra path or query string)
sub MyBaseUrl {
  local ($ret, $perlwarn);
  $perlwarn = $^W; $^W = 0;
  $ret = 'http://' . $ENV{'SERVER_NAME'} .  
         ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
         $ENV{'SCRIPT_NAME'};
  $^W = $perlwarn;
  return $ret;
}


# MyFullUrl
# Returns the full URL to the script (i.e., with extra path or query string)
sub MyFullUrl {
  local ($ret, $perlwarn);
  $perlwarn = $^W; $^W = 0;
  $ret = 'http://' . $ENV{'SERVER_NAME'} .  
         ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
         $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
         (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');
  $^W = $perlwarn;
  return $ret;
}


# MyURL
# Returns the base URL to the script (i.e., no extra path or query string)
# This is obsolete and will be removed in later versions
sub MyURL  {
  return &MyBaseUrl;
}


# CgiError
# Prints out an error message which which containes appropriate headers,
# markup, etcetera.
# Parameters:
#  If no parameters, gives a generic error message
#  Otherwise, the first parameter will be the title and the rest will 
#  be given as different paragraphs of the body

sub CgiError {
  local (@msg) = @_;
  local ($i,$name);

  if (!@msg) {
    $name = &MyFullUrl;
    @msg = ("Error: script $name encountered fatal error\n");
  };

  if (!$cgi_lib'headerout) { #')
    print &PrintHeader;	
    print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
  }
  print "<h1>$msg[0]</h1>\n";
  foreach $i (1 .. $#msg) {
    print "<p>$msg[$i]</p>\n";
  }

  $cgi_lib'headerout++;
}


# CgiDie
# Identical to CgiError, but also quits with the passed error message.

sub CgiDie {
  local (@msg) = @_;
  &CgiError (@msg);
  die @msg;
}


# PrintVariables
# Nicely formats variables.  Three calling options:
# A non-null associative array - prints the items in that array
# A type-glob - prints the items in the associated assoc array
# nothing - defaults to use %in
# Typical use: &PrintVariables()

sub PrintVariables {
  local (*in) = @_ if @_ == 1;
  local (%in) = @_ if @_ > 1;
  local ($out, $key, $output);

  $output =  "\n<dl compact>\n";
  foreach $key (sort keys(%in)) {
    foreach (split("\0", $in{$key})) {
      ($out = $_) =~ s/\n/<br>\n/g;
      $output .=  "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
    }
  }
  $output .=  "</dl>\n";

  return $output;
}

# PrintEnv
# Nicely formats all environment variables and returns HTML string
sub PrintEnv {
  &PrintVariables(*ENV);
}


# The following lines exist only to avoid warning messages
$cgi_lib'writefiles =  $cgi_lib'writefiles;
$cgi_lib'bufsize    =  $cgi_lib'bufsize ;
$cgi_lib'maxbound   =  $cgi_lib'maxbound;
$cgi_lib'version    =  $cgi_lib'version;
$cgi_lib'filepre    =  $cgi_lib'filepre;

1; #return true 

#------ End cgi-lib.pl -------#

} # End of BEGIN statement

# End reportdhcp.pl
