#!/usr/bin/perl
#
# Copyright 2006-2009 SPARTA, Inc.  All rights reserved.  See the COPYING
# file distributed with this software for details.
#

use strict;

use Net::DNS;
use Net::DNS::SEC::Tools::conf;
use Net::DNS::SEC::Validator;
use Net::DNS::Packet;
use Net::SMTP;
use Getopt::Long qw(:config no_ignore_case_always);
use Sys::Syslog;
use IO::File;
use POSIX;
use Data::Dumper;
use File::Temp qw(tempfile);
$Data::Dumper::Purity = 1;

#
# Detect required Perl modules.
#
use Net::DNS::SEC::Tools::BootStrap;
dnssec_tools_load_mods('Date::Parse'	=> "",
		       'Net::DNS::SEC'  => "");

########################################################
# Defaults

my %opts = (
        t => 3600, # default to one hour
        v => 0, # verbose on
        c => 0 # don't configure files
);

########################################################
# main

# Parse command-line options
GetOptions(\%opts,
             'a|anchor_data_file=s',
             'c|config=s',
             'f|foreground|fg',
             'k|dnsval_conf_file=s',
             'h|help',
             'L|syslog',
             'm|mail_contact_addr=s',
             'n|named_conf_file=s',
             'N|no_error',
             'p|print',
             'r|resolv_conf_file=s',
             's|smtp_server=s',
             'nomail',
             'S|single_run',
             't|sleeptime=i',
	     'T|tmp_dir=s',
             'v|verbose',
             'V|Version',
             'w|hold_time=s',
             'z|zone=s',
             'test_revoke=s',
           );

if ($opts{'h'}) {
    usage();
}

if ($opts{'V'}) {
    show_version();
}
# Parse the dnssec-tools.conf file
my %dtconf = parseconfig();

# then $dtconf{'name_of_option_in_dnssec-tools.conf'}
# contains the value of that option as set in the conf file

# newkeyfile will hold data about new keys detected,
# but not yet added to config files (waiting for add_holddown_time
# to expire). Read this file if it exists, and write to it
# any time the %newkeys structure is modified.
my $newkeyfile = $opts{'a'} ? $opts{'a'}
                        : $dtconf{'taanchorfile'};

my $resfile = $opts{'r'} ? $opts{'r'}
                        : $dtconf{'taresolvconffile'};

my $ncfile = $opts{'n'} ? $opts{'n'}
                        : $dtconf{'tanamedconffile'};

my $dvfile = $opts{'k'} ? $opts{'k'}
                        : $dtconf{'tadnsvalconffile'};

my $contactaddr = $opts{'m'} ? $opts{'m'}
                             : $dtconf{'tacontact'};

my $smtpserver =  $opts{'s'} ? $opts{'s'}
                             : $dtconf{'tasmtpserver'};

my $tmpdir =  $opts{'T'} ? $opts{'T'}
                             : $dtconf{'tatmpdir'};

if (!$dvfile && !$ncfile) {
    usage("You need to specify at least a dnsval.conf (-k) file or named.conf (-n) file.");
}
if ($dvfile && ! -f $dvfile) {
    usage("File \"$dvfile\" does not exist");
}
if ($ncfile && ! -f $ncfile) {
    usage("File \"$ncfile\" does not exist");
}

if (!$smtpserver) {
    print STDERR "smtpserver is undefined\n";
}

my $sleeptime = $opts{'t'} ? $opts{'t'}
                           : $dtconf{'tasleeptime'};

my $holdtime = $opts{'w'} ? $opts{'w'}
                           : $dtconf{'taholdtime'};

my $initrun = 1;

# determine zones to be managed
my @zones;
push @zones, split(/,/,$opts{'z'}) if ($opts{'z'});
my %revzones;
for (my $i = 0; $i <=$#zones; $i++) {
    $revzones{$zones[$i]} = $i;
}

my %keystorage;

my %newkeys;
load_newkeys();

my %remkeys;

my %sleeptimes;
my %active_refresh_times;

my %zone_configfile_map;
my %zone_retry_times;

my $once;

# below is used for testing the REVOKE bit in the
# absence of any real implementation. See the
# 'test_revoke' command line option.
my $revoke;
if ($opts{'test_revoke'}) {
    $revoke = 1;
} else {
    $revoke = 0;
}

if ((!$contactaddr) && (!$opts{'L'}) && (!$opts{'p'})) {
    usage();
}

if ($opts{'c'}) {
    my $conffile = getconffile();
    my $didnconf = 0;
    my $didvconf = 0;
    my $didtime = 0;
    my $didcontact = 0;
    my $didsmtp = 0;
    open(CONF,$conffile) or die "unable to open \"$conffile\".";
    usage () unless $opts{'c'};
    open(OUT,">$opts{'c'}") or die "unable to open \"$opts{'c'}\" for writing.";
    while(<CONF>) {
        next if (/^tasleeptime/ && ($opts{'t'}));
        next if (/^tasholdime/ && ($opts{'w'}));
        next if (/^tasmtpserver/ && ($opts{'s'}));
        next if (/^tacontact/ && ($opts{'m'}));
        next if (/^taresolvconffile/ && ($opts{'r'}));
        next if (/^tanamedconffile/ && ($opts{'n'}));
        next if (/^tadnsvalconffile/ && ($opts{'k'}));
        print OUT $_;
    }
    if ($opts{'t'}) {
        print OUT "tasleeptime\t" . $sleeptime . "\n";
    }
    if ($opts{'w'}) {
        print OUT "taholdtime\t" . $holdtime . "\n";
    }
    if ($opts{'s'}) {
        print OUT "tasmtpserver\t" . $smtpserver . "\n";
    }
    if ($opts{'m'}) {
        print OUT "tacontact\t" . $contactaddr . "\n";
    }
    if ($opts{'r'}) {
        print OUT "taresolvconffile\t" . $resfile . "\n";
    }
    if ($opts{'n'}) {
        print OUT "tanamedconffile\t" . $ncfile . "\n";
    }
    if ($opts{'k'}) {
        print OUT "tadnsvalconffile\t" . $dvfile . "\n";
    }
    close (OUT);
    close (CONF);

} else {
    $once = $opts{'S'};
    get_zones_keys(\%keystorage);
    &daemonize if (!$opts{'f'});
    do {
        my $newsleeptime = &checkkeys($sleeptime);
        if (!$once) {
	    Verbose("sleeping for $newsleeptime seconds\n");
            sleep($newsleeptime);
        }
    } while (!$once);
}

sub load_newkeys {
    # load in the newkeys info from file if available
    open (FILE, "< $newkeyfile") or warn "can't open newkey file: $!";
    my $undefval = $/;
    undef $/;
    eval <FILE>;
    warn "can't recreate newkey data from file: $@" if $@;
    close FILE;
    $/ = $undefval;
}

sub save_newkeys {
    # whenever newkeys is modified, write it out
    Verbose("Writing new keys to $newkeyfile\n");
    open (FILE, "> $newkeyfile")
      or warn "can't open newkeys file: $!";
    print FILE
      Data::Dumper->Dump([\%newkeys], [qw(*newkeys)]);
    close FILE or warn "can't close newkeys file: $!";
}


sub show_version {
    print STDERR "Version: 1.2\n";
    print STDERR "DNSSEC-Tools Version: 1.5\n";
    exit(1);
}

sub usage {
    my ($extratext) = @_;
    print STDERR "\nError:\n  $extratext\n\n" if ($extratext);

    print STDERR "trustman [-k /PATH/TO/DNSVAL.CONF] [-n /PATH/TO/NAMED.CONF] [-z ZONE] [-L] [-f]\n         [-S] [-c OUTCONFIGFILE] [-v] [-V]

File Options:
       --anchor_data_file FILE (-a)
       --config FILE (-c)
       --dnsval_conf_file /PATH/TO/DNSVAL.CONF (-k)
       --named_conf_file /PATH/TO/NAMED.CONF (-n)
       --resolv_conf_file CONFFILE (-r)
       --tmp_dir TMPDIR (-T)

Logging and Output Options:
       --mail_contact_addr EMAIL_ADDRESS (-m)
       --smtp_server SMTPSERVERNAME (-s)
       --no_error (-N)
       --print (-p)
       --syslog (-L)
       --nomail

Operational Options:
       --zone ZONE (-z)
       --hold_time SECONDS (-w)
       --single_run (-S)
       --foreground (-f)
       --sleeptime SECONDS (-t)

Testing Options:
       --test_revoke

Help Options:
       --help (-h)
       --verbose (-v)
       --version (-V)

Extra Notes:
    - If a zone is not specified, all zones in the key_containing_files
      will be checked.

    - If missing options are not specified on the command line, some
      values will be read from the dnssec-tools.conf.  Run with the -c
      flag to generate suitable dnssec-tools.conf configuration lines.
";
    exit(1);
}

##################################################################
# checkkeys does most of the work for all of trustman
#

sub checkkeys {
    my $sleep = shift;

    my %keys_to_verify;
    foreach my $k (keys %keystorage) {
        @{$keys_to_verify{$k}} = @{$keystorage{$k}};
    }

    my @zones_to_check;

    foreach my $z (@zones) {
    # check all zones to see if $active_refresh_times{$z} has been reached
         my $now = localtime();
         my $nowsecs = str2time($now);
         if ($nowsecs >= $active_refresh_times{$z}) {
             push @zones_to_check, $z;
         } elsif ($initrun) { # first time through, check all zones
             push @zones_to_check, $z;
         }
    }

    Verbose("Checking zone keys for validity\n");
    foreach my $z (@zones_to_check) {
        my $query;
        $query = resolve_and_check_dnskey($z,$dvfile);
        my %pendingnewkeys;
        if (keys %newkeys) {
            for (my $i = 0; $i <= $#{$newkeys{$z}}; $i++) {
                my $pendingkeyobj = { flags => $newkeys{$z}[$i]{flags},
                                      protocol => $newkeys{$z}[$i]{protocol},
                                      algorithm => $newkeys{$z}[$i]{algorithm},
                                      key => $newkeys{$z}[$i]{key},
                                      found => 0,
                                    };
		Verbose("  pending key for $z\n");
                push (@{$pendingnewkeys{$z}}, $pendingkeyobj);
            }
        }

# check the RRSIG over the DNKSEY
        if ($query) {
	    my $origttl;
            foreach my $rrsigrec (grep { $_->type eq 'RRSIG' } $query->answer) {

		 # This assumes that the orig TTLs are always the same
		 # (which they should be).  XXX: Turn this into a
		 # warning if not?
                 $origttl = $rrsigrec->orgttl;

                 my $sigexp = $rrsigrec->sigexpiration;
                 my $retryobj = { ottl => $origttl,
                                  sigexp => $sigexp
                                };
                 $zone_retry_times{$z} = $retryobj;
                 my ($refresh_secs,$refresh_time) = compute_sleepsecs($origttl, $sigexp);
		 Verbose("  $z ...  refresh_secs=$refresh_secs, refresh_time=$refresh_time\n");
                 $sleeptimes{$z} =  $refresh_secs;
                 $active_refresh_times{$z} = $refresh_time;
                 last; # only need one sleep time per zone
		 # XXX: yeah, but should we have the shortest or the longest?
		 # (in theory they *should* be the same...)
            }

	    if (!$origttl) {
		Verbose("No original TTL found for $z???");
	    }

# if an RRSET is received which does NOT contain a pending
# new key, remove that new key from the %newkeys
            foreach my $keyrec (grep { $_->type eq 'DNSKEY' } $query->answer) {
                next if (!($keyrec->flags & 1));
                my $ttl = $keyrec->ttl;
                my $key = $keyrec->key;
                $key =~ s/\s+//g; # remove all spaces
                my $nonmatch;
                # we don't care if a DNSKEY record is found with the
                # revoke bit set unless it is a key we have stored
                # so check for a match first
                $nonmatch = compare_keys(\%keystorage, $z, $keyrec, $key);
                if ($nonmatch) {
                # may be a new key, remember it.
                # check if this key is already in %newkeys

                # also need to find any keys in %newkeys which do
                # NOT appear in a subsequent RRSET

                    my $notnewkey = 0;
                    if (keys %newkeys) {
                        for (my $i = 0; $i <= $#{$newkeys{$z}}; $i++) {
                            if ($newkeys{$z}[$i]{key} eq $key &&
                                $newkeys{$z}[$i]{flags} eq $keyrec->flags &&
                                $newkeys{$z}[$i]{protocol} eq $keyrec->protocol &&
                                $newkeys{$z}[$i]{algorithm} eq $keyrec->algorithm )
                            {
                                $notnewkey = 1;
                                if (keys %pendingnewkeys) {
                                    for (my $i = 0; $i <= $#{$pendingnewkeys{$z}}; $i++) {
                                        if ($pendingnewkeys{$z}[$i]{key} eq $key &&
                                            $pendingnewkeys{$z}[$i]{flags} eq $keyrec->flags &&
                                            $pendingnewkeys{$z}[$i]{protocol} eq $keyrec->protocol &&
                                            $pendingnewkeys{$z}[$i]{algorithm} eq $keyrec->algorithm ) {
                                            $pendingnewkeys{$z}[$i]{found} = 1;
                                        }
                                    }
                                }

                            }
                        }
                    }
                    if (!$notnewkey) {

                        my $add_holddown_time =
			  compute_add_holddown($origttl, $holdtime);
                        my $newkeyobj = { flags => $keyrec->flags,
                                          protocol => $keyrec->protocol,
                                          algorithm => $keyrec->algorithm,
                                          key => $key,
                                          holdtime => $add_holddown_time,
                                        };
			Verbose("  adding holddown for new key in $z ($add_holddown_time seconds from now)\n");
                        push(@{$newkeys{$z}},$newkeyobj);
                        my $notif = "A new key has been received for zone " . $z . ".\n   It will be added when the add holddown time is reached.\n";
                        notify($notif) if ($opts{'v'});
			save_newkeys();
                    }
                # check if it has the revoke bit set
                # or if we're trying to test the revoke functionality
                } elsif (($keyrec->flags & 128) ||
                         ($revoke == 1)) {
                    # this key is being revoked
                    if ($dvfile) {
                        revoke_ta_dnsvalconf($z,$keyrec);
                    }
                    if ($ncfile) {
                        revoke_ta_namedconf($z,$keyrec);
                    }

# verify that ALL keys in %keystorage (now %keys_to_verify) were matched.
# if a known key disappears, set its remove_holddown timer for
# removal if it doesn't reappear in time
                } else {
                # if this is neither a new key, nor a revoked key
                # if it is a configured trust anchor, delete it from
                # the keys_to_verify structure so we know it is not
                # "removed"

                    for (my $i = 0; $i <= $#{$keys_to_verify{$z}}; $i++) {
                        if ($keys_to_verify{$z}[$i]{key} eq $key &&
                            $keys_to_verify{$z}[$i]{flags} eq $keyrec->flags &&
                            $keys_to_verify{$z}[$i]{protocol} eq $keyrec->protocol &&
                            $keys_to_verify{$z}[$i]{algorithm} eq $keyrec->algorithm ) {
                            splice @{$keys_to_verify{$z}},$i,1;
                        }
                    }
                    # if it appears in the %remkeys struct, since it has
                    # now reappeared, remove it from remkeys
                    if (keys %remkeys) {
                        for (my $i = 0; $i <= $#{$remkeys{$z}}; $i++) {
                            if ($remkeys{$z}[$i]{key} eq $key &&
                                $remkeys{$z}[$i]{flags} eq $keyrec->flags &&
                                $remkeys{$z}[$i]{protocol} eq $keyrec->protocol &&
                                $remkeys{$z}[$i]{algorithm} eq $keyrec->algorithm ){
                                splice @{$remkeys{$z}},$i,1;
                            }
                        }
                    }

                }

            }

# only want to remove pending keys which do not appear in this
# RRSET if the query was successful. Will deal with the unsuccessful
# query below

            for (my $k = 0; $k <= $#{$pendingnewkeys{$z}}; $k++) {
                # any pending key still not marked found should be
                # removed from %newkeys
                if (!$pendingnewkeys{$z}[$k]{found}) {
                    for (my $j = 0; $j <= $#{$newkeys{$z}}; $j++) {
                      # find the entry in newkeys that corresponds to
                      # the pending key not found
                        if ($newkeys{$z}[$j]{key} eq
                            $pendingnewkeys{$z}[$k]{key} &&
                            $newkeys{$z}[$j]{flags} eq
                            $pendingnewkeys{$z}[$k]{flags} &&
                            $newkeys{$z}[$j]{protocol} eq
                            $pendingnewkeys{$z}[$k]{protocol} &&
                            $newkeys{$z}[$j]{algorithm} eq
                            $pendingnewkeys{$z}[$k]{algorithm} ) {
                            splice @{$newkeys{$z}},$j,1;
                            # notify of this action if Verbose
                            my $notif = "Pending new key for zone " . $z . " has been removed.\n";
                            notify($notif) if ($opts{'v'});
			    save_newkeys();
                        }
                    }
                }
            }
        } else {
            my $notif = "query for keys failed for zone " . $z . "\n";
            notify($notif) if ($opts{'v'});
            my $refresh_secs = compute_queryfail_sleepsecs(
                                   $zone_retry_times{$z}{'ottl'},
                                   $zone_retry_times{$z}{'sigexp'});
            $sleeptimes{$z} =  $refresh_secs;
        }
    }

# all zones have been queried, and queries have been processed

    if (%newkeys) {
        my @newkeyzones;

	Verbose("checking new keys for timing\n");
	
        # if add_holddown_time has been reached, notify

        my $now = localtime();
        my $nowsecs = str2time($now);

        foreach my $z (keys %newkeys) {
            for (my $i = 0; $i <= $#{$newkeys{$z}}; $i++) {
                if ($nowsecs >= $newkeys{$z}[$i]{holdtime}) {
                    # notify about this key
		    Verbose(" hold down timer for $z reached (now = $nowsecs > $newkeys{$z}[$i]{holdtime})\n");
                    push @newkeyzones, $z;
                } else {
		    Verbose(" hold down timer for $z still in the future (" .
			    ($newkeys{$z}[$i]{holdtime}- $nowsecs) . " seconds)\n");
		}
            }
        }
        foreach my $z (@newkeyzones) {
        # these are all zones for which new keys have reached their
        # add holddown time. add these keys as new trust anchors
        # to the appropriate config files
            if ($ncfile && ($zone_configfile_map{$z} eq $ncfile)) {
                add_ta_namedconf($z);
            }
            if ($dvfile && ($zone_configfile_map{$z} eq $dvfile)) {
                add_ta_dnsvalconf($z);
            }
        # now that this key has been added to the appropriate
        # config file(s), put it in keystorage and remove it
        # from newkeys
            for (my $i =0; $i <= $#{$newkeys{$z}}; $i++) {
                my $newstorageobj = { flags => $newkeys{$z}[$i]{flags},
                                      protocol => $newkeys{$z}[$i]{protocol},
                                      algorithm => $newkeys{$z}[$i]{algorithm},
                                      key => $newkeys{$z}[$i]{key},
                                    };
                push (@{$keystorage{$z}}, $newstorageobj);

                splice @{$newkeys{$z}},$i,1;
		save_newkeys();
            }
        }
#        if (($contactaddr) && (@newkeyzones)) { # mail it
#            mailcontact(0,$smtpserver,$contactaddr,@newkeyzones);
#        }

    }

    if (keys %remkeys) {
    # see if any remkeys have reached their holdtimes
    # if so, remove them from the config file
        my $now = localtime();
        my $nowsecs = str2time($now);

        foreach my $z (keys %remkeys) {
            for (my $i = 0; $i <= $#{$remkeys{$z}}; $i++) {
                if ($nowsecs >= $remkeys{$z}[$i]{holdtime}) {
                # mark this for deletion
                    if ($zone_configfile_map{$z} eq $ncfile) {
                        remove_ta_namedconf($z, $remkeys{$z}[$i]{key},
                                            $remkeys{$z}[$i]{flags},
                                            $remkeys{$z}[$i]{protocol},
                                            $remkeys{$z}[$i]{algorithm});
                    }
                    if ($zone_configfile_map{$z} eq $dvfile) {
                        remove_ta_dnsvalconf($z, $remkeys{$z}[$i]{key},
                                            $remkeys{$z}[$i]{flags},
                                            $remkeys{$z}[$i]{protocol},
                                            $remkeys{$z}[$i]{algorithm});
                    }
                # remove this key from remkeys now, it has been removed
                    splice @{$remkeys{$z}},$i,1;
                }
            }
        }
    }

    foreach my $z (keys %keys_to_verify) {
    # any zones/keys still in %keys_to_verify did not appear
    # in a query, but are configured trust anchors.
    # Set the remove holddown time (30 days) for these keys
    # and add to remkeys for processing on next go


        my $remove_holddown_time = compute_remove_holddown();
        for (my $i = 0; $i <= $#{$keys_to_verify{$z}}; $i++) {
            my $remkeyobj = { flags => $keys_to_verify{$z}[$i]{flags},
                              protocol => $keys_to_verify{$z}[$i]{protocol},
                              algorithm => $keys_to_verify{$z}[$i]{algorithm},
                              key => $keys_to_verify{$z}[$i]{key},
                              holdtime => $remove_holddown_time,
                            };
            # only add this key if it isn't already there
            my $addit = 1;
            if (keys %remkeys) {
                for (my $i = 0; $i <= $#{$remkeys{$z}}; $i++) {
                    if ($remkeys{$z}[$i]{key} eq $remkeyobj->{key} &&
                        $remkeys{$z}[$i]{flags} eq $remkeyobj->{flags} &&
                        $remkeys{$z}[$i]{protocol} eq $remkeyobj->{protocol} &&
                        $remkeys{$z}[$i]{algorithm} eq $remkeyobj->{algorithm}){
                        $addit = 0;
                    }
                }
            }
            if ($addit) { push (@{$remkeys{$z}},$remkeyobj); }
        }
    }

    $initrun = 0;

    foreach my $z (keys %sleeptimes) {
        if ($sleep > $sleeptimes{$z} &&
            $sleeptimes{$z} > 0) {
            $sleep = $sleeptimes{$z};
        }
        # otherwise, just leaving the current $sleep
    }
    return $sleep;

} # end checkkeys

my ($conffileh, $tmpfileh, $tmpfile, $currenttmpdir, $oldsep);

sub start_read_config {
    my ($currentfile) = @_;

    $oldsep = $/;
    $/ = ";";

    $conffileh = new IO::File;
    Die("Failed to create a file handle for opening $currentfile")
      if (!$conffileh);

    if (!$conffileh->open("$currentfile")) {
	Die("Failed to open the file handle for reading $currentfile")
    }
}

sub end_read_config {
    $conffileh->close();
    $/ = $oldsep;
}

sub start_tmpfile {
    my ($currentfile) = @_;

    my $newfile = $currentfile;
    $newfile =~ s/(.*)\/([^\/]*)(\.[^\/]*)/$2-XXXXXX/; # contains dir path
    my ($base, $suffix);
    ($currenttmpdir, $base, $suffix) = ($1, $2, $3);
    if (!$suffix) {
	# doesn't contain dir path
	$newfile =~ s/^([^\/]*)(\.[^\/]*)/$1-XXXXXX/;
	($currenttmpdir, $base, $suffix) = ("/tmp",$1, $2);
    }
    if (!$suffix) {
	$newfile = "tmpfile-XXXXXX";
	$currenttmpdir = "/tmp";
	$suffix = ".conf";
    }
    $currenttmpdir = $tmpdir if ($tmpdir);
    ($tmpfileh, $tmpfile) = tempfile($newfile,
				     DIR => $currenttmpdir,
				     SUFFIX => $suffix);

    Die("Failed to open $currenttmpdir/$newfile.$suffix") if (!$tmpfileh);

    start_read_config($currentfile);

    Verbose("Opened $currenttmpdir/$tmpfile to create a replacement for $currentfile\n");
    return ($tmpfileh, $tmpfile)
}

sub end_tmpfile {
    my ($currentfile) = @_;
    end_read_config($currentfile);
    $tmpfileh->close();
    # rename TMP to $ncfile
    my $origname = $currentfile . ".orig";
    if (!rename($currentfile,$origname)) {
	Die("Fatal Error:  Failed to rename $currentfile to $origname!");
    }
    if (!rename ($tmpfile,$currentfile)) {
	Die("Fatal Error:  Failed to rename newly created $tmpfile to $currentfile;\nAn appropriate -T flag or tatmpdir setting may correct this problem.");
    }
    Verbose("Closed $tmpfile and renamed back to $currentfile\n");
    $tmpfileh = undef;
}

#
# this parses the dnsval.conf file into pieces.  Specifically:
#   - Reads in a section
#   - Assures the bounding ';' was not within a comment
#   - strips off any leading comments so the first section should be
#     of the "name type" clause it's looking for (eg: ":
#     trust-anchor").
#   - leaves the text in $_
#   - *iff* $tmpfileh is defined, prints out the stripped parts to ensure
#     that they're saved back to the tmp file being created.
sub read_next_ta_chunk {
    $_ = <$conffileh>;

    # the ; separator may be in the middle of a comment unfortunately.
    # read in more lines if so.
    while (/[\n\r]\s*#[^\n\r]*;\s*$/ ||
	   /^\s*#[^\n\r]*;\s*$/) {
	my $nextline = <$conffileh>;
	last if ($nextline eq '');
	$_ .= $nextline;
    }

    # weed out any comments that occur before the starting line we're
    # looking for.
    while (s/^(\s*#[^\n\r]*[\n\r])//) {
	print $tmpfileh $1 if (defined($tmpfileh));
    }
    return $_;
}

# looks for a particular section of the dnsval.conf file
#  (pretty much always "trust-anchor" is likely to be looked for)
sub find_next_ta_chunk_type {
    my ($type) = @_;

    while (read_next_ta_chunk()) {

        my $zonefound = 0;
        if (s/^(\s*\S+\s+$type\s*)//) {
	    # reprint the segment we just read and smashed
            print $tmpfileh "$1";

	    # strip the trailing ;
	    s/\s*;\s*$//;

	    # return the rest for processing
	    return $_;
        } else {
            print $tmpfileh $_;
	}
    }
}
	

#################################################################
# add_ta_namedconf
#
# add keys to a named.conf file which have been detected
# from a validated source, and have passed their add_holddown_time.
#
# implements Section 2.4.1 of RFC 5011
#

sub add_ta_namedconf  {
    my $zone = @_;
    return if (!$ncfile);

    start_tmpfile($ncfile);
    while (<$conffileh>) {
        print $tmpfileh $_;
        if (/^trusted-keys/) {
            print $tmpfileh "\n\n";
            for (my $i =0; $i <= $#{$newkeys{$zone}}; $i++) {
                my $newkey = $zone . " " .
                             $newkeys{$zone}[$i]{flags} . " " .
                             $newkeys{$zone}[$i]{protocol} . " " .
                             $newkeys{$zone}[$i]{algorithm} . " " .
                             $newkeys{$zone}[$i]{key} . "\";\n";
                print $tmpfileh $newkey;
                my $notif = "New key added to " . $ncfile . " for zone " . $zone . "\n";
                notify($notif);
            }
        }
    }
    end_tmpfile($ncfile);
}

#################################################################
# add_ta_dnsvalconf
#
# add keys to a dnsval.conf file which have been detected
# from a validated source, and have passed their add_holddown_time.
#
# implements Section 2.4.1 of RFC 5011
#

sub add_ta_dnsvalconf  {
    my ($zone) = @_;

    next if (!$dvfile);

    my $pat = "trust-anchor";

    start_tmpfile($dvfile);

    while (find_next_ta_chunk_type($pat)) {

        my $zonefound = 0;

	# this is just looking to see if the zone we're adding a
	# key for is already in the file (if it's not they've
	# likely set a security expectation that allowed the key to
	# be auto-added even though it's never been secured).
	my $lookingfor = $_;
	while ($lookingfor) {
	    # no comments
	    next if ($lookingfor =~ s/^\s*#[^\n]*\n+//);
	    # no blank lines
	    next if ($lookingfor =~ s/^\s*\n//);

	    # spot the actual zone-name/data combo
	    $lookingfor =~ s/^\s*(\S+)\s+("*[^"]+"|\S+)\s*//;
	    my ($z, $val) = ($1, $2);
	    # strip off the trailing dot from the zone name
	    $z =~ s/\.$//;
	    if ($z eq $zone) {
		$zonefound = 1;
	    }
	}

	# dump the original contents back out; this should preserve # lines
	print $tmpfileh $_,"\n";

	# print the new keys
	for (my $i =0; $i <= $#{$newkeys{$zone}}; $i++) {
	    my $newkeyentry = $zone . ". \"" .
	      $newkeys{$zone}[$i]{flags} . " " .
		$newkeys{$zone}[$i]{protocol} . " " .
		  $newkeys{$zone}[$i]{algorithm} . " " .
		    $newkeys{$zone}[$i]{key} . "\"";
	    if ($zonefound) {
		print $tmpfileh $newkeyentry . $2;
		Verbose("Adding the following key to $dvfile:\n");
		Verbose($newkeyentry . "\n");
		my $notif = "New key added to " . $dvfile . " for zone " . $zone . "\n";
		notify($notif);
	    } else {
		Verbose("Failed to find original zone key in $ncfile!\n");
	    }
	}
	print $tmpfileh "\n;";
    }
    end_tmpfile($dvfile);
}

######################################################################
# remove_ta_dnsvalconf
#
# remove keys from a dnsval.conf file.
# This usually is required when a known key configured as a trust
# anchor disappears from the query results from a validated
# response, and remains missing for the required hold time.
#

sub remove_ta_dnsvalconf {
    my ($zone, $k, $f, $p, $a) = @_;

    next if (!$dvfile);

    my $pat = "trust-anchor";

    start_tmpfile($dvfile);
    while (find_next_ta_chunk_type($pat)) {

	while ($_ ne '' && s/^\s*(\S+)\s+("*[^"]+"|\S+)\s*//) {
	    my ($z, $val) = ($1, $2);
	    # strip off the trailing dot from the zone name
	    $z =~ s/\.$//;
	    $val =~ s/[\n\r]//g;
	    if ($z eq $zone) {
		my ($flags, $protocol, $algorithm, $key) = $val =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S[^"]+)/;
		$key =~ s/\s+//g;
		$k =~ s/[\n\r]//g;
		if ($k eq $key &&
		    $f eq $flags &&
		    $p eq $protocol &&
		    $a eq $algorithm) {
		    # its a match, comment it out
		    print $tmpfileh "# The following key has been removed.\n";
		    my $remkeyrec = $z . ". " . $val;
		    print $tmpfileh "# " . $remkeyrec . "\n\n";
		    my $notif = "The following key has been removed from zone " . $zone . ": " . $remkeyrec . "\n";
		    notify($notif);
		} else {
		    # add the trailing dot when printing zone name
		    print $tmpfileh $z . ". " . $val . "\n\n";
		}

	    } else {
		# add the trailing dot when printing zone name
		print $tmpfileh $z . ". " . $val . "\n\n";
	    }
	}
	print $tmpfileh "\n;\n";
    }
    end_tmpfile($dvfile);
}

######################################################################
# remove_ta_namedconf
#
# remove keys from a named.conf file.
# This usually is required when a known key configured as a trust
# anchor disappears from the query results from a validated
# response, and remains missing for the required hold time.
#

sub remove_ta_namedconf  {
    my ($zone, $key, $flags, $proto, $algo) = @_;

    next if (!$ncfile);

    my $pat = "^trusted-keys";
    my $trustsection = 0;

    start_tmpfile($ncfile);
    while (<$conffileh>) {
        if (s/^\s*$pat\s*//) {
            print $tmpfileh "trusted-keys {";
            $trustsection = 1;
            s/\s*\{//;
            if ($_ ne '' && /^(\s*\n*)(\S+)\s+(\d+)\s+(\d+)\s+(\d)+\s+(\"*[^"]+"|\S+)\s*/) {
                my ($space, $z, $f, $p, $a, $k) = ($1, $2, $3, $4, $5, $6);
                # strip off the trailing dot from the zone name
                $z =~ s/\.$//;
                $k =~ s/\s+//g;
                $k =~ s/\"//g;
                if ($z eq $zone) {
                    $key =~ s/[\n\r]//g;
                    $key =~ s/\"//g;
                    if ($key eq $k &&
                        $flags eq $f &&
                        $proto eq $p &&
                        $algo eq $a) {
                        # its a match, comment it out
                            print $tmpfileh $space; # attempting to preserve spacing
                            print $tmpfileh "# The following key has been removed.\n";
                            my $remkeyrec = $z . ". " . $f . " " . $p . " " . $a . " " . "\"" . $k . "\";";
                            print $tmpfileh "# " . $remkeyrec . "\n";
                            my $notif = "The following key has been removed from zone " . $zone . ": " . $remkeyrec . "\n";
                            notify($notif);
                    }
                } else {
                # just print it, it's not the key we're looking for
                    print $tmpfileh $_;
                }
            }
        } elsif ($trustsection) {
            if (/\s*\};/) {
                $trustsection = 0;
                print $tmpfileh "\n};\n";
            } elsif ($_ ne '' && /^(\s*\n*)(\S+)\s+(\d+)\s+(\d+)\s+(\d)+\s+(\"*[^"]+"|\S+)\s*/) {

                my ($space, $z, $f, $p, $a, $k) = ($1, $2, $3, $4, $5, $6);
                # strip off the trailing dot from the zone name
                $z =~ s/\.$//;
                $k =~ s/\s+//g;
                $k =~ s/\"//g;
                if ($z eq $zone) {
                    $key =~ s/[\n\r]//g;
                    $key =~ s/\"//g;
                    if ($key eq $k &&
                        $flags eq $f &&
                        $proto eq $p &&
                        $algo eq $a) {
                        # its a match, comment it out
                            print $tmpfileh $space; # attempting to preserve spacing
                            print $tmpfileh "# The following key has been removed.\n";
                            my $remkeyrec = $z . ". " . $f . " " . $p . " " . $a . " " . "\"" . $k . "\";";
                            print $tmpfileh "# " . $remkeyrec . "\n";
                            my $notif = "The following key has been removed from zone " . $zone . ": " . $remkeyrec . "\n";
                            notify($notif);
                    } else {
                    # just print it, it's not the key we're looking for
                        print $tmpfileh $_;
                    }
                } else {
                # just print it, it's not the zone we're looking for
                    print $tmpfileh $_;
                }
            }
        } else {
            print $tmpfileh $_;
        }
    }
    end_tmpfile ($ncfile);
}

################################################################
# revoke_ta_dnsvalconf
#
# implements Section 2.1 Revocation from RFC 5011
# revoke keys marked for revocation in a query response
# from a validated zone.
#

sub revoke_ta_dnsvalconf  {
    my ($zone,$keyrec) = @_;

    next if (!$dvfile);

    my $pat = "trust-anchor";

    start_tmpfile($dvfile);
    while (find_next_ta_chunk_type($pat)) {
	while ($_ ne '' && s/^\s*(\S+)\s+("*[^"]+"|\S+)\s*//) {
	    my ($z, $val) = ($1, $2);
	    # strip off the trailing dot from the zone name
	    $z =~ s/\.$//;
	    $val =~ s/[\n\r]//g;
	    if ($z eq $zone) {
		my ($flags, $protocol, $algorithm, $key) = $val =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S[^"]+)/;
		$key =~ s/\s+//g;
		my $keyin = $keyrec->{key};
		$keyin =~ s/[\n\r]//g;
		if ($keyin eq $key &&
		    $keyrec->{flags} eq $flags &&
		    $keyrec->{protocol} eq $protocol &&
		    $keyrec->{algorithm} eq $algorithm) {
		    # its a match, comment it out
		    print $tmpfileh "# The following key has been revoked.\n";
		    my $revkeyrec = $z . ". " . $val;
		    print $tmpfileh "# " . $revkeyrec . "\n\n";
		    my $notif = "The following key has been revoked from zone " . $z . ":\n" . $revkeyrec . "\n";
		    notify($notif);
		}

	    } else {
		# add the trailing dot when printing zone name
		print $tmpfileh $z . ". " . $val . "\n\n";
	    }
	}
	print $tmpfileh "\n;\n";
    }
    end_tmpfile($dvfile);
}

################################################################
# revoke_ta_namedconf
#
# implements Section 2.1 Revocation from RFC 5011
# revoke keys marked for revocation in a query response
# from a validated zone.
#

sub revoke_ta_namedconf  {
    my ($zone,$keyrec) = @_;

    next if (!$ncfile);

    my $pat = "^trusted-keys";
    my $trustsection = 0;

    start_tmpfile($ncfile);
    while (<$conffileh>) {
        if (s/^\s*$pat\s*//) {
            print $tmpfileh "trusted-keys {";
            $trustsection = 1;
            s/\s*\{//;
            if ($_ ne '' && /^(\s*\n*)(\S+)\s+(\d+)\s+(\d+)\s+(\d)+\s+(\"*[^"]+"|\S+)\s*/) {
                my ($space, $z, $f, $p, $a, $k) = ($1, $2, $3, $4, $5, $6);
                # strip off the trailing dot from the zone name
                $z =~ s/\.$//;
                $k =~ s/\s+//g;
                $k =~ s/\"//g;
                if ($z eq $zone) {
                    my $keyin = $keyrec->{key};
                    $keyin =~ s/[\n\r]//g;
                    if ($keyin eq $k &&
                        $keyrec->{flags} eq $f &&
                        $keyrec->{protocol} eq $p &&
                        $keyrec->{algorithm} eq $a) {
# its a match, comment it out
                            print $tmpfileh $space; # attempting to preserve spacing
                            print $tmpfileh "# The following key has been revoked.\n";
                            my $revkeyrec = $z . ". " . $f . " " . $p . " " . $a . " " . "\"" . $k . "\";";
                            print $tmpfileh "# " . $revkeyrec . "\n";
                            my $notif = "The following key has been revoked from zone " . $z . ":\n" . $revkeyrec . "\n";
                            notify($notif);
                    } else {
                    # just print it, it's not the zone we're looking for
                        print $tmpfileh $_;
                    }
                } else {
                # just print it, it's not the zone we're looking for
                    print $tmpfileh $_;
                }
            }

        } elsif ($trustsection) {
            if (/\s*\};/) {
                $trustsection = 0;
                print $tmpfileh "\n};\n";
            } elsif ($_ ne '' && /^(\s*\n*)(\S+)\s+(\d+)\s+(\d+)\s+(\d)+\s+(\"*[^"]+"|\S+)\s*/) {
                my ($space, $z, $f, $p, $a, $k) = ($1, $2, $3, $4, $5, $6);
                # strip off the trailing dot from the zone name
                $z =~ s/\.$//;
                $k =~ s/\s+//g;
                $k =~ s/\"//g;
                if ($z eq $zone) {
                    my $keyin = $keyrec->{key};
                    $keyin =~ s/[\n\r]//g;
                    if ($keyin eq $k &&
                        $keyrec->{flags} eq $f &&
                        $keyrec->{protocol} eq $p &&
                        $keyrec->{algorithm} eq $a) {
# its a match, comment it out
                            print $tmpfileh $space; # attempting to preserve spacing
                            print $tmpfileh "# The following key has been revoked.\n";
                            my $revkeyrec = $z . ". " . $f . " " . $p . " " . $a . " " . "\"" . $k . "\";";
                            print $tmpfileh "# " . $revkeyrec . "\n";
                    }
                } else {
                # just print it, it's not the key we're looking for
                    print $tmpfileh $_;
                }
            }
        } else {
            print $tmpfileh $_;
        }
    }
    end_tmpfile($ncfile);
}

###############################################################
# get_zones_keys
#
# retrieve zones to be monitored, and their configured trust
# anchors (keys) from config files (named.conf and/or dnsval.conf).
# create the revzones structure for later use.
#

sub get_zones_keys {
# using globals %keystorage and @zones, is this evil?

# if zones are specified on the command line, we will only
# check those zones. Otherwise, check all zones found in config files.
    read_conf_file(\%keystorage, $ncfile, \%zone_configfile_map) if ($ncfile);
    read_dnsval_file(\%keystorage, $dvfile, \%zone_configfile_map) if ($dvfile);

# if @zones exists now, we used only zones from the cmd line,
# so we're done. if not, we got zones from config files, and
# need to populate both @zones and %revzones
    if (!exists ($zones[0])) {
        foreach my $z (keys(%keystorage)) {
            $zones[$#zones + 1] = $z;
            if (!(exists $revzones{$z})) {
                $revzones{$z} = $#zones +1;
            }
        }
    }


    if (!@zones) {
        print STDERR "No zones to check, exiting....\n";
        exit(1);
    }

}

#########################################################
#
# resolve_and_check_dnskey
# called by checkkeys, queries a zone to get the
# DNSKEY record; returns an answer only if it was validated
#

sub resolve_and_check_dnskey {
    my ($z,$file) = @_;
    Verbose(" Checking the live \"$z\" key\n");
    my $validator = new Net::DNS::SEC::Validator(resolv_conf => $resfile,
                                                 dnsval_conf => $file);
    my $r = $validator->res_query($z, "IN", "DNSKEY");
    if ($r && $validator->isvalidated) {
        my ($pkt, $err) = new Net::DNS::Packet(\$r);
        if (!$err) {
            return $pkt;
        }
	Verbose("Got an error!! $err\n");
    }
    if ($r) {
	Verbose("Help! Failed to validate keys for \"$z\"\n");
    } else {
	Verbose("Help! resolving failed\n");
    }
    return undef;
}

#######################################################################
# read_conf_file()
#
# reads in a named.conf style config file pointed to by $file
# looks for trust anchors using $pat and stores key
# information in $storage
#

sub read_conf_file {
    my ($storage, $file, $configmap) = @_;
    Verbose("Reading and parsing trust keys from $file\n");
    my $pat = "trusted-keys";

    # regexp pulled from Fast.pm
    my $pat_maybefullname = qr{[-\w\$\d*]+(?:\.[-\w\$\d]+)*\.?};

    open (FILE, "< $file") or die "can't open config file: $!\n";
    while (<FILE>) {
	if (/$pat/) {
	    while (<FILE>) {
		last if (/^\s*\};/);
		if (/\s*($pat_maybefullname)\s+(257)\s+(\d+)\s+(\d+)\s+\"(.+)\"\s*;/) {

                    my $zonename = $1;
                    my ($flags, $protocol, $algorithm) = ($2, $3, $4);
                    my $key = $5;
                    $zonename =~ s/\.$//;

                    if (keys %revzones) {
# only store key data from zones we are actually checking (@zones)
# if zones were supplied on the command line (-z)

                        if (exists($revzones{$zonename})) {
                            $key =~ s/[\n\r\s]//g;

                            # need to remember where these keys came from
                            $configmap->{$zonename} = $file;

                            my $newstorageobj = { flags => $flags,
                                                  protocol => $protocol,
                                                  algorithm => $algorithm,
                                                  key => $key,
                                                };
			    Verbose(" Found a key for $zonename\n");
                            push (@{$storage->{$zonename}}, $newstorageobj);
                        }
                    }
		}
	    }
	}
    }
    close FILE;
}

#######################################################################
# read_dnsval_file()
#
# reads in a dnsval.conf style config file pointed to by $file
# looks for trust anchors using $pat and stores key
# information in $storage
#

sub read_dnsval_file {
    my ($storage, $file, $configmap) = @_;
    Verbose("Reading and parsing trust keys from $file\n");
    my $pat = "trust-anchor";

    start_read_config($file);

    my $fh = $conffileh;
    while (read_next_ta_chunk()) {
        s/\s;\s*$//;
        if (s/^\s*(\S*)\s*$pat\s*//) {
            my $trustanchor_type = $1;
            while ($_ ne '') {
		next if (s/^[\n\r]\s*//);
		next if (s/^\s*#[^\n\r]*[\n\r]*//);
		last if (! s/^\s*(\S+)\s+("*[^"]+"|\S+)\s*//);
                my ($zonename, $value) = ($1, $2);
                $value =~ s/[\n\r]//g;
                my ($flags, $proto, $algo, $key) = $value =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S[^"]+)/;


                # strip the trailing dot
                $zonename =~ s/\.$//;

                if (keys %revzones) {
# only store key data from zones we are actually checking (@zones)
# if zones were supplied on the command line (-z)

                    if (exists($revzones{$zonename})) {

                        $configmap->{$zonename} = $file;

                        push @{$storage->{$zonename}},
		              { flags => $flags,
			        protocol => $proto,
			        algorithm => $algo,
			        key => $key };
			Verbose(" Found a key for $zonename\n");
	                $storage->{$zonename}[$#{$storage->{$zonename}}]{key} =~ s/\s+//g;
                    }
                } else {
                    $configmap->{$zonename} = $file;

                    push @{$storage->{$zonename}},
		          { flags => $flags,
		            protocol => $proto,
		            algorithm => $algo,
		            key => $key };
		    Verbose(" Found a key for $zonename\n");
	            $storage->{$zonename}[$#{$storage->{$zonename}}]{key} =~ s/\s+//g;
                }
	    }
	}
    }
    $fh->close;
}

#####################################################
# compute_add_holddown
#
# used in implementation of Section 2.4.1 of RFC 5011
#

sub compute_add_holddown {
    my ($ttl, $default) = @_;
    my $holddown;
    my $now = localtime();
    my $nowsecs = str2time($now);
    $default = 2592000 if (!$default);  # default to 30 days

    # return secs since the epoch as the time to release this holddown

    if ($default == -42) {
	# allow 5 seconds from now; unsafe undocumented debugging feature.
	return $nowsecs + 5;
    }

    # Take the maximum of now+TTL or now+specified-default
    if ($ttl > $default) {
        $holddown = $nowsecs + $ttl;
    } else {
        $holddown = $nowsecs + $default;
    }
    return $holddown;
}


#####################################################
# compute_remove_holddown
#
# used in implementation of Section 2.4.2 of RFC 5011
#
# 30 days from "now"

sub compute_remove_holddown {
    my $holddown;
    my $default = 2592000;
    my $now = localtime();
    my $nowsecs = str2time($now);

# return secs since the epoch as the time to release this holddown
    $holddown = $nowsecs + $default;
    return $holddown;
}

####################################################
#
# compute_sleepsecs
#
# implements Section 2.3 of RFC 5011
#
# compute the sleep time in seconds
# min(expiration interval [sigexpiration - now],1/2 * ottl, 15 days)
#

sub compute_sleepsecs {
    my ($ottl,$sexp) = @_;
    $sexp =~ s/(....)(..)(..)(..)(..)(..)/$1-$2-$3T$4:$5:$6/;
    my $sigexp = str2time($sexp);
    my $fifteendays = 129600;
    my $halfottl = $ottl / 2;
    my $now = localtime();
    my $nowsecs = str2time($now);
    my $expinterval = $sigexp - $nowsecs;
    my $actrefsecs;
    if ($halfottl < $expinterval) {
        if ($halfottl < $fifteendays) {
            $actrefsecs = $halfottl;
        } else {
            $actrefsecs = $fifteendays;
        }
    } else {
        if ($expinterval < $fifteendays) {
            $actrefsecs = $expinterval;
        } else {
            $actrefsecs = $fifteendays
        }
    }

    return ($actrefsecs,$actrefsecs+$nowsecs);
}

#################################################################
# compute_queryfail_sleepsecs
#
# compute the number of seconds to sleep in case of a query
# failure.
#
# implements Section 2.3 of RFC 5011
#
# MAX(1 hour, MIN(1 day, 0.1 * ottl, 0.1 * expiration interval[sigexpiration - now])
#

sub compute_queryfail_sleepsecs {
    my ($ottl,$sexp) = @_;
    $sexp =~ s/(....)(..)(..)(..)(..)(..)/$1-$2-$3T$4:$5:$6/;
    my $sigexp = str2time($sexp);
    my $onehour = 3600;
    my $oneday = 86400;
    my $tenth_ottl = $ottl / 10;
    my $now = localtime();
    my $nowsecs = str2time($now);
    my $tenth_expinterval = ($sigexp - $nowsecs) / 10;
    my $refreshsecs;
    if ($tenth_ottl < $tenth_expinterval) {
        if ($tenth_ottl < $oneday) {
            $refreshsecs = $tenth_ottl;
        } else {
            $refreshsecs = $oneday;
        }
    } else {
        if ($tenth_expinterval < $oneday) {
            $refreshsecs = $tenth_expinterval;
        } else {
            $refreshsecs = $oneday;
        }
    }
    if ($refreshsecs >= $onehour) {
        return ($refreshsecs);
    } else {
        return ($onehour);
    }
}

######################################################################
# notify()
#  - depending on configuration, mails or logs notifications

sub notify {
    my ($message) = @_;

    if ($opts{'L'}) {
        openlog('trustman','pid','user') || warn "could not open syslog";
        syslog('warning',"%s", $message);
        closelog();
    }
    if ($opts{'p'}) {
	$| = 1;

	# if in verbose mode, make sure messages are easily detectable
	# within the verbose output.
	Verbose("v" x 70 . "\n");
        print $message;
	Verbose("^" x 70 . "\n");
    }
    if ($smtpserver && $contactaddr && !$opts{'nomail'}) {
	Verbose("  mailing $contactaddr\n");
        mailcontact(0,$smtpserver,$contactaddr,$message);
    }
}


######################################################################
# mailcontact()
#  - emails a contact address with the error output
sub mailcontact {
    my ($ok,$smtp,$contact,$msg) = @_;
    my $fromaddr = 'trustman@localhost';

    Verbose("sending mail to $contact\n");

    # set up the SMTP object and required data
    my $message = Net::SMTP->new($smtp) || die "failed to create smtp message";
    $message->mail($fromaddr);
    $message->to(split(/,\s*/,$contact));
    $message->data();

    # create headers
    $message->datasend("To: " . $contact . "\n");
    $message->datasend("From: " . $fromaddr . "\n");

    # create the body of the message: the warning
    $message->datasend("Subject: trustman notification\n\n");
    $message->datasend($msg);
    $message->datasend("\n\n");

    # finish and send the message
    $message->dataend();
    $message->quit;
}

#######################################################################
# compare_keys()
#
# compares the contents of two keys to see if the new one ($zone,
# $rec, and $keyin) matches a cached one previously stored (in
# $storage->{$zone} )
#
sub compare_keys {
    my ($storage, $zone, $rec, $keyin) = @_;
    my $newkey = 1;
    if (!exists($storage->{$zone})) {
# What would nonexistence of this really mean?
    }
    for (my $i = 0; $i <= $#{$storage->{$zone}}; $i++) {
        if ($storage->{$zone}[$i]{key} eq $keyin &&
            $storage->{$zone}[$i]{flags} eq $rec->flags &&
            $storage->{$zone}[$i]{protocol} eq $rec->protocol &&
            $storage->{$zone}[$i]{algorithm} eq $rec->algorithm) {

            $newkey = 0;
            # any match is good enough, get out now
            $i = $#{$storage->{$zone}} + 1;
	} else {
            $newkey = 1;
        }
    }
    return $newkey;
}

#######################################################################
# Verbose()
#
# prints something(s) to STDERR only if -v was specified.
#
sub Verbose {
    print STDERR @_ if ($opts{'v'});
}

sub Die {
    notify(join("",@_, "\n", "This is a fatal error.  EXITING!\n"));
    print STDERR @_,"\n";
    print STDERR "This is a fatal error.  EXITING!\n";
    exit(1);
}

####################################################################
# daemonize
#
# run as a daemon
#

sub daemonize {
  chdir '/' or die "Can't chdir to /: $!";
  open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
  defined(my $pid = fork()) or die "Can't fork: $!";
  exit if $pid;
  POSIX::setsid() or die "Can't start a new session: $!";
  umask 0;
}

##############################################################################
#

=pod

=head1 NAME

trustman - Manage keys used as trust anchors

=head1 SYNOPSIS

trustman [options]

=head1 DESCRIPTION

B<trustman> manages keys used by DNSSEC as trust anchors in compliance with
RFC5011.  It may be used as a daemon for ongoing key verification or manually
for initialization and one-time key verification.

By default, B<trustman> runs as a daemon to ensure that keys stored locally in
configuration files still match the same keys fetched from the zone where they
are defined.  (B<named.conf> and B<dnsval.conf> are the usual configuration
files.)  These checks can be run once manually (B<-S>) and in the foreground
(B<-f>).

For each key mismatch check, if key mismatches are detected then B<trustman>
performs the following operations:

    - sets an add hold-down timer for new keys;
    - sets a remove hold-down timer for missing keys;
    - removes revoked keys from the configuration file.

On subsequent runs, the timers are checked.  If the timers have expired, keys
are added or removed from the configuration file, as appropriate.

=head1 OPTIONS

B<trustman> takes a number of options, each of which is described in this
section.  Each option name may be shortened to the minimum number of unique
characters, but some options also have an alias (as noted.)  The single-letter
form of each option is denoted in parentheses, e.g.: B<--anchor_data_file>
(B<-a>).

=over #indent

=item B<--anchor_data_file file (-a)>

A persistent data file for storing new keys waiting to be added.

=item B<--config file (-c) >

Create a configure file for B<trustman> from the command line options
given.  This option can be used to create a configuration file which
can be appended to the B<dnssec-tools.conf> file.  It will allow less
command line options to be specified in the future.

=item B<--dnsval_conf_file /path/to/dnsval.conf (-k)>

A B<dnsval.conf> file to read and possibly update.

=item B<--named_conf_file /path/to/named.conf (-n)>

A B<named.conf> file to read and possibly update.

=item B<--tmp_dir directory (-T)>

Specifies where temporary files should be created.  This is used when
creating new versions of the B<dnsval.conf> and B<named.conf> files before
they're moved into place.  Most operating systems require the B</tmp>
directory to be on the same partition as the B<dnsval.conf>/B<named.conf>
files since renames across partitions will fail.

=item B<--zone zone (-z)>

The zone to check.  Specifying this option supersedes the default
configuration file.

=item B<--mail_contact_addr email_address (-m)>

Mail address for the contact person to whom reports should be sent.

=item B<--smtp_server smtpservername (-s)>

SMTP server that B<trustman> should use to send reports by mail.

=item B<--nomail>

Prevents mail from being sent; this is useful for only sending notifications
via B<stdout> (B<-p>) or B<syslog> (B<-L>) even if an SMTP server was
specified in the configuration file.

=item B<--no_error (-N)>

Send report even when there are no errors.

=item B<--print (-p)>

Log messages to B<stdout>.

=item B<--hold_time seconds (-w)>

The value of the hold-down timer.  This is specified in seconds from the time
that a new key is found.  Generally the default and recommended value of 30
days should be used.

=item B<--resolv_conf_file conffile (-r)>

A B<resolv.conf> file to read.  B</dev/null> can be specified to force
I<libval> to recursively answer the query rather than asking other name
servers.)

=item B<--single_run (-S)>

Run only once.

=item B<--foreground (-f)>

Run in the foreground.  B<trustman> will still run in a loop.
To run once, use the B<-S> option instead.

=item B<--syslog (-L)>

Log messages to B<syslog>.

=item B<--sleeptime seconds (-t)>

The number of seconds to sleep between checks.  Default is 3600 (one hour.)

=item B<--test_revoke>

Use this option to test the REVOKE bit.  No known implementation of
the REVOKE bit exists to date.

=item B<--help (-h)>

Display a help message.

=item B<--verbose (-v)>

Verbose output.

=item B<--Version (-V)>

Displays the version information for B<trustman> and the DNSSEC-Tools package.

=back #unindent

=head1 CONFIGURATION

In addition to the command line arguments, the B<dnssec-tools.conf> file can
also be configured with the following tokens to remove the need to use some of
the command-line options.  The command-line options always override the
settings in the B<dnssec-tools.conf> file.

=over

=item B<tasmtpserver servername>

This is equivalent to the B<--smtp_server> flag for specifying where to send
email notices through.

=item B<tacontact contact_email>

This is equivalent to the B<--mail_contact_addr> flag for specifying where to
send email notices to.

=item B<taanchorfile file>

This specifies the file where B<trustman> state information to be kept.
This is equivalent to the B<--anchor_data_file> flag.

=item B<taresolvconffile file>

This specifies the B<resolv.conf> file to use.
This is equivalent to the B<--resolv_conf_file> flag.

=item B<tanamedconffile file>

This specifies the B<named.conf> file to read and write.
This is equivalent to the B<--named_conf_file> flag.

=item B<tadnsvalconffile file>

This specifies the B<dnsval.conf> file to read and write.
This is equivalent to the B<--dnsval_conf_file> flag.

=item B<tatmpfile directory>

This specifies where temporary files should be created.  This is used when
creating new versions of the B<dnsval.conf> and B<named.conf> files before
they're moved into place.  Most operating systems require the B</tmp> directory
to be on the same partition as the B<dnsval.conf>/B<named.conf> files since
renames across partitions will fail.

=head1 COPYRIGHT

Copyright 2006-2009 SPARTA, Inc.  All rights reserved.
See the COPYING file included with the DNSSEC-Tools package for details.

=head1 Author

Lindy Foster, lfoster@users.sourceforge.net

=head1 SEE ALSO

B<Net::DNS::SEC::Tools::conf.pm(3)>,
B<Net::DNS::SEC::Tools::defaults.pm(3)>,

B<dnssec-tools.conf(5)>

=cut
