#!/usr/bin/perl -Tw
#Copyright 1998-1999, Randall Maas.  All rights reserved.  This program is free
#software; you can redistribute it and/or modify it under the same terms as
#PERL itself.                                                                   

=head1 NAME

CfgNamed -- a tool to help change your DNS settings

=head1 DESCRIPTION

This is a tool to help modify and keep your DNS server files up to date.

=head1 Command Line Parameters

The parameters are a broken down into three categories:

=over 1

=item Retrieving entries

C<--fetch>, C<--list-forward>, C<--list-primaries>,
C<--list-reverse>, C<--list-secondaries>

=item Adding, changing, removing entries

C<--delete>,
C<--remove>, C<--rename>,
C<--set>

=item Cleanliness

C<--xref>

=back

=head2 Retrieving Entries

=over 1

=item C<--fetch >I<NAME>

=item C<--fetch=>I<NAME>

This will retrieve the list of recipients in the group I<NAME>.  If I<NAME>
is a regular expression, information will retrieved for every group that matches
the pattern.

=item C<--list-forward>

This will retrieve the list of name to address domains being served.

=item C<--list-primaries>

This will retrieve the list of primary domains being served.

=item C<--list-reverse>

This will retrieve the list of reverse DNS domains (address to name) being
served.

=item C<--list-secondaries>

This will retrieve the list of secondary domains being served.

=back

=head2 Adding, Changing, or Removing Entries.

The following specify how the change various entries.  Typically the can not be
intermized on the same command line.  (Exceptions are noted).

=over 1

=item C<--comment >I<NAME>=I<TEXT>

This will add a comment record (TXT) describing the named machine.

=item C<--delete >I<NAME>

=item C<--delete=>I<NAME>

This will remove the alias(es) specified by I<NAME>.  It will also remove
from any mail alias(es) (or groups) any member(s) that matches I<NAME>.  I<NAME>
may be a regular expression.  (Can be used with C<--remove> and C<--rename>).

=item C<--remove >I<NAME>

=item C<--remove=>I<NAME>

Like C<delete> above, this will remove the mail group(s) specified by I<NAME>.
I<NAME> may be a regular expression.  (Can be used with C<--delete> and
C<--rename>)

=item C<--rename> I<NAME-NEW>=I<NAME-OLD>

This will change all of the occurrences or references that match I<NAME-OLD> to
the newer form of I<NAME-NEW>.  This may be a group name, and / or members of a
group.  This may be a regular expression, similar to;

	s/NAME-OLD/NAME-NEW/

=item C<--set> I<NAME>=I<MEMBERS>

This will create a group called I<NAME> with a set of specified members
I<MEMBERS>.
(Can be used with C<--delete> and  C<--remove>).

=back

=head2 Cleanliness

=over 1

=item C<--xref>

=item C<--xref >I<FWD-NAME-SPACE>

This will have the reverse and forward namespaces properly cross referenced and
up to date.

=back

=head1 Files

=head1 See Also

L<CfgTie::CfgArgs> for more information on the standard parameters
L<named(8)>

=head1 Notes

=head2 Author

Randall Maas (L<randym@acm.org>)

=cut

local %MyArgs;
my $Prg="CfgNamed";
use CfgTie::TieNamed;
use CfgTie::CfgArgs;

sub is_tainted {not eval {my @r = join('',@_),kill 0; 1;};}
sub Help
{
   print "CfgNamed allows you to change settings for your DNS server\n".
	"\nUSAGE: CfgNamed [OPTIONS]\n";
   print "\nSpecific operations:\n".
	"\t    --list-primaries\tThis will list the primary domains\n".
	"\t    --list-secondaries\tThis will list the secondary domains\n".
	"\t    --list-forward\tThis will list the name to address domains\n".
	"\t    --list-reverse\tThis will list the reverse DNS domains\n".

	"\t    --xref\tCross references the primary and reverse DNS tables\n";
   print CfgTie::CfgArgs::Help(),"\n";
}

sub Warranty ()
{
   print "No warranty.\n"
}

sub Copyright ()
{
   print "$Prg\nCopyright 1998-1999, Randall Maas.  All rights reserved.  ".
    "This program is free\nsoftware; you can redistribute it and/or modify ".
    "it under the same terms as PERL itself.\n\n";
}

sub ParseArgs 
{
   my $X = shift;
   CfgTie::CfgArgs::do($X,"comment=s%","xref:s",'list-primaries!',
		'list-secondaries!','--list-reverse!',,'--list-forward!');
   if (!scalar keys %{$X})
     {
        print "Try '$Prg --help' for more information\n";
        exit -1;
     }

   if (exists $X->{'help'})      {Help;}
   if (exists $X->{'copyright'}) {Copyright;}
   if (exists $X->{'warranty'})  {Warranty;}
   if (exists $X->{'help'})      {exit -1;}


   if (CfgTie::CfgArgs::Args_exclusive($X, "fetch",'rename'))
     {exit -1;}
   if (CfgTie::CfgArgs::Args_exclusive($X, "add","fetch",'remove'))
     {exit -1;}
}

ParseArgs(\%MyArgs);
my %DNS;
if (exists $MyArgs{'file'})
  {tie %DNS, CfgTie::TieNamed,$MyArgs{'file'};}
else
  {tie %DNS, CfgTie::TieNamed;}

my %Msgs;
my $Lang='english';
$Msgs{'english'} =
  {
     EXITING => "Exiting.\n",
     GROUP_MISSING => "Group was not specified\n",
     USER_NONAME   => "Your user id does not have a name.",
     USER_BAD_REAL => "Real user id is root.  This is not allowed.",
     USER_BAD_EFF  => "Effective user id is root.  This is not allowed, using the real user id.\n",
  };
my $ErrMsgs = $Msgs{$Lang};

sub ScrubAddresses (@)
{
   my @Ret;
   foreach my $I (@_)
    {
       if ($I =~ /^([\d\w\\\/@!_\-.]+)$/) {$I=$1;} 
        else
       {
          print "$Prg: Item to add has invalid email address: \"$I\"\n";
          next;
       }
       if (&is_tainted($I)) {print "$I is tainted\n";}
       push @Ret, $I;
    }

   @Ret;
}

# Validate the joining set-up
my (%Users, $Id,@Groups);
if (exists $MyArgs{'group'})
  {
     push @Groups,$MyArgs{'group'};
  }

# Fetch anythine now...
if (exists $MyArgs{'fetch'})
  {
     foreach my $I (@{$MyArgs{'fetch'}})
      {
	if (exists $DNS{'primary'}->{$I})
	  {print "$I\t",join(", ", @{$DNS{'primary'}->{$I}}),"\n";}
         else
          {print "$I\n";}
      }
  }

if (exists $MyArgs{'remove'})
  {
     my ($N,%R)=(1);
     foreach my $L (@{$MyArgs{'remove'}})
      {if ($L=~/^([\d\w\-*?{}\[\]_@.]+)$/) {$R{$1}='';};$N++;}
     (tied %DNS)->RENAME(\%R);
  }

if (exists $MyArgs{'rename'})
  {
     print "Renaming stuff\n";
     (tied %DNS)->RENAME($MyArgs{'rename'}); 
  }


if (exists $MyArgs{'xref'})
  {
     if (!length $MyArgs{'xref'})
       {(tied %DNS)->RevXRef();}
      else
       {(tied %DNS)->RevXRef($MyArgs{'xref'});}
  }


sub Listings ($$)
{
   my $DNS = shift;
   my $Args = shift;
   if (exists $Args->{'list-primaries'})
     {
        if (!exists $DNS->{'primary'})
          {print "No primaries\n";}
         else
          {print "primaries: ",join(", ",sort keys %{$DNS->{'primary'}}),"\n";}
     }

   if (exists $Args->{'list-secondaries'})
     {
        if (!exists ($DNS->{'secondary'}))
          {print "No secondaries\n";}
         else
          {print "secondaries: ",
			join(", ",sort keys %{$DNS->{'secondary'}}),"\n";}
     }

   if (exists $Args->{'list-reverse'})
     {
        my @S = (tied %{$DNS})->RevSpaces();
        if (!scalar @S)
          {print "No reverse name spaces\n";}
         else
          {print "reverse name spaces: ",join(", ",sort @S), "\n";}
     }

   if (exists $Args->{'list-forward'})
     {
        my @S = (tied %DNS)->FwdSpaces();
        if (!scalar @S)
          {print "No forward name space:\n";}
         else
          {print "forward name spaces: ",join(", ",sort @S), "\n";}
     }
}

Listings(\%DNS,\%MyArgs);
