#!/usr/bin/perl -Tw
#
# secondary.pl version 1.3
#
# Copyright 2001 Michael Grant. All rights reserved. 
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
#  1.Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
#  2.Redistributions in binary form must reproduce the above
#    copyright notice, this list of conditions and the following
#    disclaimer in the documentation and/or other materials provided
#    with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY MICHAEL GRANT ``AS IS'' AND ANY
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL MICHAEL GRANT OR
# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
# OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# The views and conclusions contained in the software and
# documentation are those of the authors and should not be
# interpreted as representing official policies, either expressed or
# implied, of Michael Grant.
#
# based on Comboform from http://cgi-lib.berkeley.edu/
#
# This perl script runs as a cgi.  It requires cgi-lib.pl which
# should also be in the cgi directory.
#
# This script edits files which are included into version 8 or 9
# named.conf files.  It checks the syntax and does some sanity
# checking on the domain name and ip address to avoid obvious
# errors.
#

require 5.001;
use strict;
no strict "refs";
use POSIX qw(ctime);
use Fcntl qw(:DEFAULT :flock);
use File::Basename;

require "./cgi-lib.pl";

if (! exists $ENV{REMOTE_USER}) {
      &CgiDie("REMOTE_USER not set, did you log in?");
}
  
my $remote_user;
if ($ENV{REMOTE_USER} =~ /^([-\@\w.]+)$/) {
  $remote_user = $1;			# now untainted
} else {
      &CgiDie("Bad data in REMOTE_USER");
}

# THE FOLLOWING VARIABLES MAY NEED CHANGING FOR YOUR SYSTEM

# This is the directory where the named database files are kept.
# This is typically /etc/namedb.
my $namedbdir = "/usr/local/etc/namedb";

# This is the name of the secondary directory within $namedbdir
# where zone transfers are stored. This is typically "secondary".
# This need not be writable by the web server.
my $secondarydir = "secondary";

# This is the name of the websecondary directory within $namedbdir
# where this script creates the include files.  This directory
# needs to be writable by the web server.
my $includedir = "websecondary";

# $includefile is the name of a file which you have added to your
# named.conf file.  The web server must be able to write to this file.
my $includefile = "$namedbdir/$includedir/websecondary.inc";

# named.conf
my $namedconffile = "$namedbdir/named.conf";

# $namedbuserfile is the file which is included in $includefile.
# $remote_user is the user which authenticated to
# the web server.  The web server must be able to write to these
# files (hence the directory probably should be owned by the web server).
my $namedbuserfile = "$namedbdir/$includedir/$remote_user";

# Command line to call to get named to reload its config.
# This is a setuid script or sudo command that does 
#   kill -1 `cat /var/run/named.pid`
# and should return any output or errors that named produces
my $reloadconf = "/usr/local/sbin/named-reload";

# Password file used by apache to authorize this program.
# This is used to update the user's password
my $passwordfile = "/usr/local/www/cgi-bin/users";

# STOP HERE, YOU SHOULDN't HAVE TO MODIFY ANYTHING BELOW HERE

my %domainnames; # domains in use

sub read_namedconf {
  my $filename = shift;
  my $ignore = shift;

  undef $/;

  return if ($filename eq $ignore);

  open(CONF, "<$filename") or &CgiDie("Can't open $filename");

  my $conf = <CONF> || "";

  $conf =~ s/\/\/.*$//gm;	# remove // comments
  $conf =~ s/\#.*$//gm;		# remove # comments
  $conf =~ s/\/\*.*?\*\///gs;	# remove /* comments */

  my @lines = split(/\n/, $conf);

  my $lineno = 0;
  foreach my $i (@lines) {
    $lineno++;
    if ($i =~ /zone\s+"(.*)"/) {
      $domainnames{$1} = "at $filename:$lineno"; # flag.  used to print error msg
    }
    elsif ($i =~ /include\s+"(.*)"/) {
      my $inc_file = $1;
      if ($inc_file =~ /^\//) {
	read_namedconf($inc_file, $ignore);
      } else {
	read_namedconf(dirname($filename)."/".$inc_file, $ignore);
      }
    }
  }

  close(CONF);
  $/ = "\n";
}

MAIN: {
  my (%input);  # The CGI data

  # Read in all the variables set by the form
  if (&ReadParse(\%input)) {
    &ProcessForm(\%input);
  } else {
    &PrintForm;
  }
}

# message is used to pass a message to PrintForm
my $message = "";

# fields from post
my $inref;

sub ProcessForm {
  ($inref) = shift; # $inref is a reference to %input
  my $mtime;
  my $i;

#
# The "refresh" button
#
  if ($inref->{"TYPE"} eq "refresh") {
      &PrintForm();
      return;
  }

#
# The "Change password" button
#
  if ($inref->{"TYPE"} eq "change password") {
      my $oldpw =  $inref->{"oldpw"};
      my $newpw1 =  $inref->{"newpw1"};
      my $newpw2 =  $inref->{"newpw2"};
      $message = ChangePassword($oldpw, $newpw1, $newpw2);
      &PrintForm();
      return;
  }

#
# Otherwise, we'll assume the "update" button was pressed
#
  if ($inref->{"mtime"} ne "never") {
    $mtime = (stat($namedbuserfile))[9];
    if (defined $mtime && $mtime ne $inref->{"mtime"}) {
      $message = "$namedbuserfile changed on disk, your changes have been cancelled.";
      &PrintForm();
      return;
    }
  }

  read_namedconf($namedconffile, $namedbuserfile);

  # Check the form
  for ($i = 1; $i <= $inref->{"lines"}; $i++) {
    my $domain =  $inref->{"domain".$i} if defined  $inref->{"domain".$i};
    my $master =  $inref->{"master".$i} if defined  $inref->{"master".$i};
    my $comment = $inref->{"comment".$i} if defined  $inref->{"comment".$i};
    my $delete =  $inref->{"delete".$i} if defined  $inref->{"delete".$i};

    if ($i > 1000) {
      &CgiDie("Too many domains");
    }

    if (!$master && !$domain) {
      if ($i == $inref->{"lines"}) {
	last;
      }
      if ($delete) {
	next;
      } else {
	&CgiDie("Line $i must have a domain and a master (or delete it with the checkbox)\n");
      }
    }
    if ($delete) {
      next;
    }

    if ($domain !~ /\S+(\.\S+)+/) {
	&CgiDie("Invalid domain name \"$domain\" on line $i\n");
      }
    
    # define $octet as a regular expression matching a number 0-255
    my $octet = '(\d|\d\d|1\d\d|2[0-4]\d|25[0-5])';

    # match x.y.z.w or x.y.z.w;x.y.z.v...
    if ($master !~ /^$octet\.$octet\.$octet\.$octet(;\s*$octet\.$octet\.$octet\.$octet)*;?$/) {
      &CgiDie("Invalid ip address \"$master\". Format: ipaddr or ipaddr;ipaddr;... \n");
    }

    # check if $domain is duplicate
    if (exists $domainnames{$domain}) {
      &CgiDie("Duplicate domain \"$domain\" on line $i and $domainnames{$domain}\n");
    }
    $domainnames{$domain} = "line $i";
  }

  rename ($namedbuserfile, $namedbuserfile.".old");

  open (DB, ">$namedbuserfile" ) || &CgiDie("Error: Cannot open $namedbuserfile for writing");

  # Process the form
  for ($i = 1; $i <= $inref->{"lines"}; $i++) {
    if ($i > 1000) {
      &CgiDie("Too many domains");
    }

    my $domain =  $inref->{"domain".$i} if exists  $inref->{"domain".$i};
    my $master =  $inref->{"master".$i} if exists  $inref->{"master".$i};
    my $comment = $inref->{"comment".$i} if exists  $inref->{"comment".$i};
    my $delete =  $inref->{"delete".$i} if exists  $inref->{"delete".$i};

    if (!$master && !$domain && ($i == $inref->{"lines"})) {
      last;
    }
    if ($delete || (!$master && !$domain && !$comment)) {
      next;
    }
    
    print DB "# $comment\n" if ($comment);
    print DB "zone \"$domain\" {\n";
    print DB "\ttype slave;\n";
    print DB "\tfile \"$secondarydir/$domain\";\n";
    print DB "\tmasters {\n";
    $master =~ s/;$//;  # remove trailing ; 
    print DB "\t\t$master;\n";
    print DB "\t};\n";
    print DB "};\n";
    print DB "\n";
  }

  close (DB);

  $message = "Update of $namedbuserfile succeeded.<BR>\n";

  # make sure there's an include in $includefile for this user
  $message .= UpdateInclude();

  # call user function to reload named.conf file
  {
    my @ENV;

    $ENV{"PATH"}="/bin:/usr/bin";

    if (!open(CMD, "$reloadconf|")) {
      $message .= "$reloadconf: $_\n";
    } else {
      while (<CMD>) {
	$message .= $_;
	$message .= "<BR>";
      }
      close(CMD);
    }

  }

  &PrintForm();

  # debug info
#  print &PrintVariables($inref);
#  print &HtmlBot;
}

sub UpdateInclude {
  my @incs;

  $/ = "\n";
  sysopen(IF, $includefile, O_RDWR|O_CREAT);

  flock(IF, LOCK_EX) or return "Cannot lock $includefile.<BR>\n";

  while (<IF>) {
    if (/^include \"(.*)\";/) {
      if ($1 eq $namedbuserfile) {
	flock(IF, LOCK_UN);
	close(IF);
	return "";
      }
      push (@incs, $1)
    }
  }

  # if we get here, we need to add $namedbuserfile to $includefile
  seek(IF, 0, 0);
  truncate(IF, 0);
  print IF "# This file was created by websecondary.pl\n";
  print IF "#\n";
  foreach my $i (@incs) {
    print IF "include \"$i\";\n";
  }
  print IF "include \"$namedbuserfile\";\n";

  flock(IF, LOCK_UN);
  close(IF);

  return "$includefile updated.<BR>\n";
}

sub PrintForm {
  my $myhostname;
  my $iaddr;
  my $myipaddr;
  my $comment;
  my $domain;
  my $domainfile;
  my $master;
  my $mtime;

  print &PrintHeader;

  # Get my IP address
  # uses Sys::Hostname.  If this doesn't work, try using Net::Domain hostfqdn()
  # use  Net::Domain qw(hostfqdn);
  # $myhostname = hostfqdn();
  use Sys::Hostname;
  $myhostname = hostname();

  use Socket;
  $iaddr = gethostbyname($myhostname);
  $myipaddr = inet_ntoa($iaddr);

  print &HtmlTop ("Secondary Name Service Editor");

  print "<B>Username:</B> $ENV{REMOTE_USER}<BR>\n";
  print "<B>Secondary name:</B> $myhostname<BR>\n";
  print "<B>IP-addr:</B> $myipaddr<BR>\n";
  my $time_now = localtime;
  print "<B>Localtime:</B> $time_now<BR><BR>\n";

  print "<FORM METHOD=\"POST\" ACTION=\"secondary.pl\">";

  print "<TABLE BORDER=1 CELLSPACING=1 WIDTH=\"100%\">";
  print "<TH><TD><B>Domain<TD><B>Master(s)<TD><B>Comment<TD><B>Last Zone Transfer<TD><B>Delete<TD><B>Insert</TD></TH>\n";

  # open the db file which is included by named.conf
  # if it doesn't exist, fake a null file with /dev/null
  $/="\n\n";
  if (! open(DB, $namedbuserfile)) {
    if ($!>0 && $! != 2) {
      &CgiDie("Cannot open $namedbuserfile: $!");
    }
    open(DB, "/dev/null");
  }

  $mtime = (stat($namedbuserfile))[9];
  if (!defined $mtime) {
    $mtime = "never";
  }
  print "<INPUT NAME=\"mtime\" VALUE=\"$mtime\" TYPE=HIDDEN>\n";

  my $i = 1;  # tracks lines in file
  my $j = 1;  # tracks lines from previous post

  while (<DB>) {
    if (/^(\#\s(.*)\n)?        ## optional comment
	zone\s"(.*)"\s{$       #zone "domain.name" {
	\s+type\sslave;$       #        type slave;
	\s+file\s"(.*)";$      #        file "secondary\domain.name";  (note \=slash)
	\s+masters\s{$         #        masters {
	\s+(\S.*);$            #                10.20.30.40
	\s+};\n                #        };
        };/mx) {               #};
      ($comment, $domain, $domainfile, $master) = ($2, $3, $4, $5);
      $comment = "" if (! defined $comment);

      $mtime = (stat($namedbdir."/".$domainfile))[9];

      if (!defined $mtime) {
	$mtime = "Never";
      } else {
        $mtime = ctime($mtime);
      }

      if (exists  $inref->{"insert".$j} && $inref->{"insert".$j}) {
	print "<TR><TD>$i<TD><INPUT NAME=\"domain$i\">";
	print "        <TD><INPUT NAME=\"master$i\">";
	print "        <TD><INPUT NAME=\"comment$i\">";
	print "        <TD>";
	print "        <TD>";
	print "        <TD>";
	print "</TD></TR>\n";
	$i++;
      } 
      print "<TR><TD>$i<TD><INPUT NAME=\"domain$i\" VALUE=\"$domain\">";
      print "        <TD><INPUT NAME=\"master$i\" VALUE=\"$master\">";
      print "        <TD><INPUT NAME=\"comment$i\" VALUE=\"$comment\">";
      print "        <TD>$mtime";
      print "        <TD><INPUT TYPE=CHECKBOX NAME=\"delete$i\">";
      if (exists  $inref->{"insert".$j} && $inref->{"insert".$j}) {
	print "        <TD>";
      } else {
	print "        <TD><INPUT TYPE=CHECKBOX NAME=\"insert$i\">";
      }
      print "</TD></TR>\n";
      $i++;
      $j++;
    }
  }

  print "<TR><TD>$i<TD><INPUT NAME=\"domain$i\">";
  print "        <TD><INPUT NAME=\"master$i\">";
  print "        <TD><INPUT NAME=\"comment$i\">";
  print "        <TD> ";
  print "        <TD> ";
  print "        <TD> ";
  print "</TD></TR>\n";

  print "</TABLE><BR>\n";

#
# Update and refresh buttons
#
  print "<INPUT TYPE=SUBMIT NAME=TYPE VALUE=\"update\">";
  print "<INPUT TYPE=SUBMIT NAME=TYPE VALUE=\"refresh\">";
  print "<BR><BR>";
#
# The change password fields
#
  print "<B>Change Password</B>\n<BR>";
  print "<TABLE BORDER=0 CELLSPACING=1 WIDTH=\"70%\">";
  print "  <TH><TD><B>Current<TD><B>New<TD><B>Repeat</TD></TH>\n";
  print "  <TR><TD><TD><INPUT TYPE=\"PASSWORD\" NAME=\"oldpw\"</TD>";
  print "      <TD><INPUT TYPE=\"PASSWORD\" NAME=\"newpw1\"</TD>";
  print "      <TD><INPUT TYPE=\"PASSWORD\" NAME=\"newpw2\"</TD>";
  print "  </TR>\n";
  print "</TABLE>\n";
  print "enter old password and new password twice\n<BR>";

#
# Change password button
#
  print "<INPUT TYPE=SUBMIT NAME=TYPE VALUE=\"change password\">";

  # The number of lines in the table
  print "<INPUT NAME=\"lines\" VALUE=\"$i\" TYPE=HIDDEN>";

  print "</FORM><BR>\n";

  if (defined $message && $message) { 
    print "<B>Results:</B><BR>\n";
    print "$message<BR>\n";
  }

  print "<FONT SIZE=-1><A HREF=\"http://grant.org/mgrant/nse.html\">Name Service Editor</A> by Michael Grant</FONT>\n";

  #  Close the document neatly.
  print &HtmlBot;

}

sub ChangePassword {
  my $oldpw = shift;
  my $newpw1 = shift;
  my $newpw2 = shift;

  my %pw;
  my $currpw;

  sysopen(PW, $passwordfile, O_RDWR);

  flock(PW, LOCK_EX) or return "Cannot lock $passwordfile";

  while(<PW>) {
    if (/^(.*):(.*)/) {
      $pw{$1} = $2;
    }
  }

  if (!$pw{$remote_user}) {
    flock(PW, LOCK_UN);
    close(PW);
    return "Can't find password for $remote_user";
  }

  $currpw = $pw{$remote_user};

  if ($currpw eq "") {
    flock(PW, LOCK_UN);
    close(PW);
    return "Cannot find password for $remote_user in $passwordfile";
  }

  if (crypt($oldpw, $currpw) ne $currpw) {
    flock(PW, LOCK_UN);
    close(PW);
    return "Old password is incorrect";
  }

  if (!$newpw1 && !$newpw2) {
    flock(PW, LOCK_UN);
    close(PW);
    return "New password cannot be null";
  }

  if ($newpw1 ne $newpw2) {
    flock(PW, LOCK_UN);
    close(PW);
    return "New passwords do not match";
  }

  $pw{$remote_user} = crypt($newpw1, $currpw);

  seek(PW, 0, 0);
  truncate(PW, 0);
  foreach my $name (keys(%pw)) {
    print PW $name,":",$pw{$name},"\n";
  }

  flock(PW, LOCK_UN);
  close(PW);

  return "Password updated";
}
