#!/usr/bin/perl
#
# $Id: valtz,v 0.7 2003/07/10 16:39:30 magnus Exp $
#
# <BSD-license>
#
# Copyright (c) 2003, Magnus Bodin, <magnus@bodin.org>, http://x42.com
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
#
# 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.
#
# Neither the name of Magnus Bodin, x42.com nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "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 THE COPYRIGHT
# OWNER 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.
#
# </BSD-license>


use strict;
use Getopt::Std;
use File::Temp qw/ tempfile /;
use File::Copy qw/ move /;


my $VERSION = '0.8';


$| = 1;
my %opt;
getopts('?fFhHiIqrRtT:', \%opt);


# Validation errors
my $verrs_total = 0;

# "Permission" errors with respect to what record types are allowed
my $perrs_total = 0;


##
# global location registry
# (reset for every zone file)
my %loreg;

# NOTE : DO NOT CHANGE the id numbers
my %validation_msg = (
    1001 => 'badly formed; should be just two ASCII letters',
    1002 => 'location is not previously defined in a %-line',
    1003 => 'invalid syntax',
    1004 => 'invalid syntax of integer',
    1005 => 'parts must only contain ASCII letters, digits and - characters',
    1006 => 'parts must not begin with the - character',
    1007 => 'parts must not end with the - character',
    1008 => 'integer out of bounds',
    1009 => 'must have at least three labels to be valid as mail address',
    1010 => 'must not be 2(NS), 5(CNAME), 6(SOA), 12(PTR), 15(MX) or 252(AXFR)',
    1011 => 'IP address found where hostname expected'
);

# NOTE : ONLY translate the right-hand part
my %token_name = (
    'lo' => 'Location',
    'ipprefix' => 'IP prefix',
    'fqdn' =>  'Domain name',
    'ip' => 'IP number',
    'x' => 'Host name',
    'ttl' => 'TTL',
    'timestamp' => 'Timestamp',
    'lo' => 'Location',
    'dist' => 'Distance',
    's' => 'Text',
    'p' => 'Pointer',
    'mname' => 'Master name',
    'rname' => 'Role name',
    'ser' => 'Serial number',
    'ref' => 'Refresh time',
    'ret' => 'Retry time',
    'exp' => 'Expire time',
    'min' => 'Minimum time',
    'n' => 'Record type number',
    'rdata' => 'Resource data',
    'port' => 'Port',
    'priority' => 'Priority',
    'weight' => 'Weight'
);

my %record_type = (
    '%' => ':location',
    '.' => 'NS',
    '&' => 'NS+A',
    '=' => 'A+PTR',
    '+' => 'A',
    '@' => 'MX+A?',
    '#' => ':comment',
    '-' => ':disabled +',
    "'" => 'TXT',
    '^' => 'PTR',
    'C' => 'CNAME',
    'S' => 'SRV',
    'Z' => 'SOA',
    ':' => 'GENERIC'
);

# NOTE : This should NOT be translated!
my %line_type = (
    '%' => [ ':location', 'lo:ipprefix', 'lo' ],
    '.' => [ 'NS(+A?)', 'fqdn:ip:x:ttl:timestamp:lo', 'fqdn' ],
    '&' => [ 'NS(+A?)', 'fqdn:ip:x:ttl:timestamp:lo', 'fqdn' ],
    '=' => [ 'A+PTR', 'fqdn:ip:ttl:timestamp:lo', 'fqdn:ip' ],
    '+' => [ 'A', 'fqdn:ip:ttl:timestamp:lo', 'fqdn:ip' ],
    '@' => [ 'MX(+A?)', 'fqdn:ip:x:dist:ttl:timestamp:lo', 'fqdn' ],
    '#' => [ ':comment', '', '' ],
    '-' => [ ':disabled +', '', '' ],
    "'" => [ 'TXT', 'fqdn:s:ttl:timestamp:lo', 'fqdn:s' ],
    '^' => [ 'PTR', 'fqdn:p:ttl:timestamp:lo', 'fqdn:p' ],
    'C' => [ 'CNAME', 'fqdn:p:ttl:timestamp:lo', 'fqdn:p' ],
    'S' => [ 'SRV', 'fqdn:ip:x:port:weight:priority:ttl:timestamp:lo',
	     'fqdn:x:port' ],
    'Z' => [ 'SOA', 'fqdn:mname:rname:ser:ref:ret:exp:min:ttl:timestamp:lo',
            'fqdn:mname:rname' ],
    ':' => [ 'GENERIC', 'fqdn:n:rdata:ttl:timestamp:lo', 'fqdn:n:rdata' ]
);


sub validate_integer
{
    my ($s, $boundary) = @_;
    my $result = 0;

    if ($s =~ /^(\d+)$/)
    {
        my $i = $1;

        $result = 1008 if $boundary && ($i >= $boundary);
    }
    else
    {
        $result = 1004;
    }

    return $result;
}


# NOTE : No translation here!
my %token_validator = (
    'lo' => [ 2, sub {
        my ($type, $s) = @_;
        my $result = 0;
        return 1001 unless $s =~ /^[a-z][a-z]$/i;
        if ($type eq '%')
        {
            $loreg{$s}++;
        }
        else
        {
            return 1002 unless exists($loreg{$s});
        }
        return $result;
    }],
    'ipprefix' => [ 3, sub {
        my ($type, $s) = @_;
        my $result = 0;
        if ($s =~ /^(\d+)(\.(\d+)(\.(\d+)(\.(\d+))?)?)?$/)
        {
            my ($a, $b, $c, $d) = ($1, $3, $5, $7);
            $a ||= 0;
            $b ||= 0;
            $c ||= 0;
            $d ||= 0;
            if (($a > 255) || ($b > 255) || ($c > 255) || ($d > 255))
            {
                $result = 1003;
            }
        }
        else
        {
            $result = 1003;
        }
        return $result;
    }],
    'fqdn' => [ 3, sub {
        my ($type, $s) = @_;
        my $result = 0;
        # remove OK wildcard prefixing, to simplify test.
        $s =~ s/^\*\.([a-z0-9].*)$/$1/i;
        # check all parts
        for my $hostpart (split /\./, $s)
        {
            return 1005 unless $hostpart =~ /^_?[-a-z0-9]+$/i;
            return 1006 if $hostpart =~ /^-/;
            return 1007 if $hostpart =~ /-$/;
        }
        return $result;
    }],
    'ip' => [ 4, sub {
        my ($type, $s) = @_;
        my $result = 0;
        if ($s =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\.?$/)
        {
            my ($a, $b, $c, $d) = ($1, $3, $5, $7);
            $a ||= 0;
            $b ||= 0;
            $c ||= 0;
            $d ||= 0;
            if (($a > 255) || ($b > 255) || ($c > 255) || ($d > 255))
            {
                $result = 1003
            }
        }
        else
        {
            $result = 1003;
        }
        return $result;
    }],
    'x' => [ 5, sub {
        my ($type, $s) = @_;
        my $result = 0;

	# Check to see if someone put an IP address in a hostname
	# field. The motivation for this was MX records where many
	# people expect an IP address to be a valid response, but I
	# see no harm in enforcing it elsewhere.
	return 1011 if $s =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\.?$/;

        # check all parts
        for (split /\./, $s)
        {
            return 1005 unless /^[-[a-z0-9]+$/i;
            return 1006 if /^-/;
            return 1007 if /-$/;
        }
        return $result;
    }],
    'ttl' => [ 6, sub {
        my ($type, $s) = @_;
    my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'timestamp' => [ 7, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'dist' => [ 9, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 65536);
        return $result;
    }],
    's' => [ 10, sub {
        my ($type, $s) = @_;
        my $result = 0;
        # TODO : Validation needed?
        return $result;
    }],
    'p' => [ 11, sub {
        my ($type, $s) = @_;
        my $result = 0;
        # check all parts
        for (split /\./, $s)
        {
            return 1005 unless /^_?[-[a-z0-9]+$/i;
            return 1006 if /^-/;
            return 1007 if /-$/;
        }
        return $result;
    }],
    'mname' => [ 12, sub {
        my ($type, $s) = @_;
        my $result = 0;
        # check all parts
        for (split /\./, $s)
        {
            return 1005 unless /^[-[a-z0-9]+$/i;
            return 1006 if /^-/;
            return 1007 if /-$/;
        }
        return $result;
    }],
    'rname' => [ 13, sub {
        my ($type, $s) = @_;
        my $result = 0;

        # check all parts
        my @parts = split /\./, $s;
        return 1009 if @parts < 3;

        for (split /\./, $s)
        {
            return 1005 unless /^[-[a-z0-9]+$/i;
            return 1006 if /^-/;
            return 1007 if /-$/;
        }
        return $result;
    }],
    'ser' => [ 14, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'ref' => [ 15, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'ret' => [ 16, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'exp' => [ 17, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'min' => [ 18, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 2**32);
        return $result;
    }],
    'n' => [ 19, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 65535);

        return 1010 if ($s==2)||($s==5)||($s==6)||($s==12)||($s==15)||($s==252);

        return $result;
    }],
    'rdata' => [ 20, sub {
        my ($type, $s) = @_;
        # TODO : Validation needed?
        my $result = 0;
        return $result;
     }],
    'port' => [ 21, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 65536);
        return $result;
    }],
    'priority' => [ 22, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 65536);
        return $result;
    }],
    'weight' => [ 23, sub {
        my ($type, $s) = @_;
        my $result = validate_integer($s, 65536);
        return $result;
    }],



);


sub validate_line ($)
{
    my ($s) = @_;

    my $result = [ 0, '', '', [] ];

    $s =~ s/\s+$//;

    if (length($s))
    {
        my $type = substr($s, 0, 1); $$result[2] = $type;
        my $rest = substr($s, 1);
        if (exists($line_type{$type}))
        {
            my $lt = $line_type{$type};
            my @mask = split /\:/, $line_type{$type}->[1];
            my @mandatory = split /\:/, $line_type{$type}->[2];

            if (@mask > 0)
            {
                my $c = 0;
                my @tokens = split /\:/, $rest;
                my $ip = '';

                my $vals = @tokens;
                $vals = $#mandatory if $#mandatory > $vals;

                for my $t (0..$vals)
                {
                    my $token = $tokens[$t];
                    # sanity check; should not fail
                    if ($c > $#mask)
                    {
                        # silently ignore excessive fields
                        # as tinydns-data does now
                    }
                    elsif (exists($token_validator{$mask[$c]}))
                    {
                        my $validator = $token_validator{$mask[$c]};

                        if (length($token))
                        {
                            # Remember fqdn for later
                            if (($c eq 0) && ($mask[0] eq 'fqdn'))
                            {
                                my $tmp = $token;
                                $tmp =~ s/\.$//;
                                push @{$$result[3]}, $tmp;
                            }

                            # Remember x as fqdn IF ip is specified
                            if (($mask[$c] eq 'ip') && (length($token)))
                            {
                                $ip = $token;
                            }

                            #
                            if (length($ip) && ($mask[$c] eq 'x'))
                            {
                                my $tmp = $token;
                                $tmp =~ s/\.$//;
                                push @{$$result[3]}, $tmp;
                            }

                            # perform validation

                            my $tv = &{$$validator[1]}($type, $token);
                            if ($tv)
                            {
                                $$result[0] ^= (2 ** $$validator[0]);
                                $$result[1] .=
                                  "\npos $c; $mask[$c]; $validation_msg{$tv}";
                            }
                        }
                        elsif ($mandatory[$c] eq $mask[$c])
                        {
                            my $mand = 1;
                            $mand = 0 if ($opt{r}) && ($mask[$c] eq 'fqdn');
                            $mand = 0 if ($opt{R}) && ($mask[$c] eq 'mname');
                            $mand = 0 if ($opt{R}) && ($mask[$c] eq 'p');
                            $mand = 0 if ($opt{R}) && ($mask[$c] eq 'rdata');
                            $mand = 0 if ($opt{i}) && ($mask[$c] eq 'ip');

                            if ($mand)
                            {
                                $$result[0] ^= (2 ** $$validator[0]);
                                $$result[1] .= "\npos $c; $mask[$c]; ".
                                $token_name{$mask[$c]}.' is mandatory';
                            }
                        }
                        # else ignore nonmandatory blanks

                    }
                    else
                    {
                        # somebody has modified program in a wrong way
                        $result = [ 1,
                          "VALIDATOR FAILS ON TOKENS OF TYPE ".$mask[$c]." $c" ];
                    }
                    $c++;
                }
            }

            if ($$result[0])
            {
                $$result[1] = "expected: ".$line_type{$type}->[1]."\n".
                    $$result[1];
            }

        }
        else
        {
            $result = [ 1, sprintf("unknown record type: #%02x",
                ord($type)) ];
        }
    }

    $$result[1] =~ s/^\n+//;
    $$result[1] =~ s/\n+/\n/g;

    # result is now [ iErrno, sErrtxt, sRecordType, [ sFQDN ] ]
    return $result;
}

sub p ($$)
{
    my ($fhv, $line) = @_;
    for my $fh (@{$fhv})
    {
        print $fh $line."\n";
    }
}

sub funiq (@)
{
    my @files = @_;
    my %ufiles;
    for my $curpat (@files)
    {
        for my $elem (glob $curpat)
        {
            $ufiles{$elem}++;
        }
    }
    return [ sort keys %ufiles ];
}

sub read_file ($$)
{
    my ($vfile, $cache) = @_;
    my %vresult;
    my $result = [ ];

    if (exists $cache->{file}->{$vfile})
    {
        $result = $cache->{file}->{$vfile};
    }
    else
    {
        if (open(FILER, $vfile))
        {
            while (<FILER>)
            {
                chomp;
                s/^\s+//;
                s/\s+$//;
                next if /^#/;
                next if /^$/;
                $vresult{$_}++;
            }
            close FILER;
            $cache->{file}->{$vfile} = [ sort keys %vresult ];
            $result = $cache->{file}->{$vfile};
        }
    }

    return $result;
}


sub read_filter ($$)
{
    my ($file, $cache) = @_;
    my $f = {};

    if (open(FILEF, $file))
    {
        while (<FILEF>)
        {
            chomp;
            s/^\s+//;
            s/\s+$//;

            if (/^(\w+)\s+(.+)$/)
            {
                my ($key, $value) = ($1, $2);
                my (@values, @tempvalues);
                if ($value =~ m#^file:(.+)#)
                {
                    my $vfile = $1;
                    @tempvalues = @{read_file($vfile, $cache)};
                }
                else
                {
                    @tempvalues = ( $value );
                }

                if ($key =~ /^zonefiles?$/)
                {
                    # This is a globbing action
                    for (@tempvalues)
                    {
                        push @values, @{funiq($_)};
                    }
                }
               else
               {
                    @values = @tempvalues;
               }

               for (@values)
               {
                    $f->{lc $key}->{$_}++;
               }
           }
        }
        close FILEF;
    }
    else
    {
        print STDERR "Warning: Couldn't open filterfile: $file; $!\n";
    }

    return $f;
}

sub regexped_patterns ($)
{
    my ($h) = @_;
    my $result = [ ];

    for my $pat (keys %{$h})
    {
        unless ($pat =~ /^\^.+\$$/)
        {
        $pat =~ s/\.+$//;

            # fix a regexp for the lazy notation
            $pat =~ s/^[\*\.]+//;
            $pat =~ s/\./\\./g;
            $pat = '^(.*\\.)?'.$pat.'\.?$';
        }
        push @{$result}, $pat;
    }
    return $result;
}


sub check_pattern ($$)
{
    my ($pattern, $fqdn) = @_;
    my $result = 0;

    if ($fqdn =~ /$pattern/)
    {
        $result = 1;
    }
    else
    {
        $result = 0;
    }

    return $result;
}


sub make_char_regexp ($)
{
    my ($chars) = @_;
    my @rc;
    my $regexp;

    for (split /\s+/, $chars)
    {
        if (/^\d+$/)
        {
            $regexp .= sprintf("\\%03o", $_);
        }
        else
        {
            for (split //, $_)
            {
                $regexp .= "\\$_";
            }
        }
    }

    if (length($regexp))
    {
        $regexp = "[$regexp]";
    }
    else
    {
        $regexp = '.';
    }

    return $regexp;
}


sub do_filterfile ($$)
{
    my ($filterfile, $cache) = @_;
    my $result = '';
    my $output = [ \*STDERR ];
    my @extralogs;

    my $f = read_filter($filterfile, $cache);

    $$f{allowtype} = (keys %{$$f{allowtype}})[0];
    $$f{allowtype} .= $opt{T};

    my $allowtyperegex = make_char_regexp($$f{allowtype});

    if ($$f{extralog})
    {
        for my $logfile (sort keys %{$$f{extralog}})
        {
            my ($fname, $fhandle);
            # open logfiles and put them int @{$output};
            ($fhandle, $fname) = tempfile();
            if ($fhandle)
            {
                push @{$output}, $fhandle;
                push @extralogs, [ $fhandle, $fname, $logfile ];
            }
            else
            {
                print STDERR "Warning: Couldn't create tempfile for ${logfile}.\n";
            }
        }
    }

    my @zonefiles = sort keys %{$$f{zonefile}};
    if (@zonefiles == 0)
    {
        push @zonefiles, '-';
    }
    for my $zonefile (@zonefiles)
    {
        my $info = 0;
    my $filehandle = \*STDIN;
    my $fopen = 1;
    if ($zonefile ne '-')
    {
        $fopen = open( $filehandle, $zonefile );
    }
        if ($fopen)
        {
            my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
            p $output, "File $temp";

            %loreg = ();
            my $errs = 0;
            my $lno = 0;
            while (<$filehandle>)
            {
                $lno++;
                my $line = $_;
                chomp($line);
                my $v = validate_line($line);
                for ($v)
                {
                    my $ok = 1;
                    my $fqdnok = 1;
                    my $reason = '';

                    if ($$v[0])
                    {
                        $errs++;
                        $verrs_total++;
                        $$v[1] =~ s/\n/\n    /g;
                        p $output, "  line $lno; err $$v[0] $line\n    ".$$v[1];
                    }
                    else
                    {
                        if (length($$v[2]))
                        {
                            if ($$v[2] !~ /$allowtyperegex/)
                            {
                                $ok=0;
                                if (($$v[2] ne '#') || ($opt{t} == 1))
                                {
                                     $errs++;
                                     $perrs_total++;
                                     p $output, "  line $lno; err -1 $line";
                                     p $output, "    record type $$v[2] disallowed; allowed: $$f{allowtype}";
                                }
                            }
                            else
                            {
                                # just check fqdn if record contains it
                                if (@{$$v[3]})
                                {
                                    # Check $$v[3] against allowed fqdn:s:wq!
                                    if (keys %{$$f{deny}})
                                    {
                                        my $patterns = regexped_patterns($$f{deny});
                                        # Default ALLOW ALL
                                        $ok = $fqdnok = 1;
                                        $reason = 'default allow ^.*$';

                                        for my $pat (@{$patterns})
                                        {
                                            for (@{$$v[3]})
                                            {
                                                if (check_pattern($pat, $_))
                                                {
                                                    $ok = $fqdnok = 0;
                                                    $reason = 'deny '.$pat;
                                                }
                                            }
                                        }
                                    }
                                    elsif (keys %{$$f{allow}})
                                    {
                                        my $patterns = regexped_patterns($$f{allow});
                                        # Default DENY ALL
                                        $ok = $fqdnok = 0;
                                        $reason = 'default deny ^.*$';

                                        for my $pat (@{$patterns})
                                        {
                                            for (@{$$v[3]})
                                            {
                                                if (check_pattern($pat, $_))
                                                {
                                                    $ok = $fqdnok = 1;
                                                    $reason = $pat;
                                                }
                                            }
                                        }
                                    } # if deny/allow
                                } # if fqdn
                            } # if recordtype ok
                        }

                        if ($ok && length($line))
                        {
                            print STDOUT "$line\n" unless $opt{q};
                        }
                        else
                        {
                            if ($fqdnok == 0)
                            {
                                $errs++;
                                $perrs_total++;
                                p $output, "  line $lno; err -2; $line";
                                p $output, "    use of fqdn denied; $reason";
                                if ($opt{I})
                                {
                                    print STDOUT "# line $lno; err -2; $line\n";
                                    print STDOUT "#   use of fqdn denied; $reason\n";
                                }
                            }
                        }
                    }
                } # for ($v)
            } # while (<$filehandle>)
            close $filehandle unless $zonefile eq '-';
            my $plur = ($errs == 1) ? '' : 's';
            p $output, "$lno lines, $errs error${plur}.";
        }
        else
        {
            p $output, "Warning: Trouble opening '$zonefile'; $!";
        }
    }


    # Close all extra logfiles
    for my $el (@extralogs)
    {
        if (close($$el[0]))
        {
            if (move($$el[1], $$el[2]))
            {
                print STDERR "Copy of logfile portion to $$el[2]\n";
            }
            else
            {
                print STDERR "Warning: Couldn't rename tempfile to $$el[2].\n";
                unlink $$el[1];
            }
        }
        else
        {
            print STDERR "Warning: Couldn't close tempfile for $$el[2].\n";
            unlink $$el[1];
        }
    }

    return $result;
}

#
## Start
#

my $files = funiq(@ARGV);

sub usage {
  print <<"--EOT";
valtz $VERSION - validate tinydns-data files

Usage:
 $0 [-r] [-R] [-i] tinydns-file1 [tinydns-file2...]

 $0 [-HiIqrRt] [-T types] -f tinydns-file1 [tinydns-file2 ...]

 $0 valtz [-fHiIqrRt] [-T types] -F filter-file1 [filter-file2 ...]

Flags:
 -h           print usage information
 -f           filter invalid lines (filter mode)
 -F           filter using configuration files (advanced filter mode)
 -r           allow "fqdn" fields to be empty
 -R           allow "mname" and "p" fields to be empty
 -i           allow "ip" fields to be empty
 -I           include rejected lines as comments (filtering only)
 -q           don't print valid lines to standard out (filtering only)
 -t           don't ignore comment lines (filtering only)
 -T <types>   allow additional record types (advanced filtering only)

Errors are generally printed to standard error, and the exit code
shall reflect the presense of both usage and validation errors. See
the man page for details.

--EOT
}

if ($opt{h} || $opt{H} || $opt{'?'}) {
  usage();

  # If they asked for help, ignore whatever else they may have done
  # wrong.
  exit 0;
}

if (@{$files} == 0) {
  usage();
  exit 4;
}

if ($opt{F})
{
    my $cache = {};
    $cache->{file} = {};
    for my $file (@{$files})
    {
        my $result = do_filterfile($file, $cache);
    }

}
else
{

    my $output = [ \*STDERR ];

    for my $zonefile (sort @{$files})
    {
    my $filehandle = \*STDIN;
    my $fopen = 1;
    if ($zonefile ne '-')
    {
        $fopen = open( $filehandle, $zonefile );
    }
        if ($fopen)
        {
            %loreg = ();
            my $errs = 0;
            my $lno = 0;
            while (<$filehandle>)
            {
                $lno++;
                my $line = $_;
                chomp($line);
                my $v = validate_line($line);
                for ($v)
                {
                    if ($$v[0])
                    {
            my $temp = ($zonefile eq '-') ? '<STDIN>' : $zonefile;
                        p $output, "File $temp" unless $errs;
                        $errs++;
                        $verrs_total++;
                        $$v[1] =~ s/\n/\n    /g;
                        p $output, "  line $lno; err $$v[0] $line\n    ".$$v[1];
                        if ($opt{I})
                        {
                             print STDOUT "# line $lno; err $$v[0] $line
                             print STDOUT "# $$v[1]; \n";
                        }
                    }
                    else
                    {
                        # Echo NON-ERRORS to STDOUT
                        if ($opt{f})
                        {
                            print STDOUT "$line\n" unless $opt{q};
                        }
                    }
                }
            }
            close $filehandle unless $zonefile eq '-';
        }
        else
        {
            p $output, "Error: Trouble opening '$zonefile'; $!";
        }
    }
}

if ($verrs_total + $perrs_total)
{
    my $exitcode = $verrs_total > 0 ? 1 : 0;
    $exitcode += $perrs_total > 0 ? 2 : 0;
    exit $exitcode;
}