view release on metacpan or  search on metacpan

lib/DNS/ZoneParse.pm  view on Meta::CPAN

    }
 
    $r = $ttl{'W'} * 7;
    $r = ( $r + $ttl{'D'} ) * 24;
    $r = ( $r + $ttl{'H'} ) * 60;
    $r = ( $r + $ttl{'M'} ) * 60;
    $r = ( $r + $ttl{'S'} );

    die unless $r == $ttl{'S'} + 60 * ( $ttl{'M'} + 60 * ( $ttl{'H'} + 24 * ( $ttl{'D'} + 7 * $ttl{'W'} ) ) );
    return $r;
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Private Methods
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

sub _initialize {
    my $self = shift;
    $dns_id{$self}        = {};
    $dns_soa{$self}       = {};
    $dns_ns{$self}        = [];
    $dns_a{$self}         = [];
    $dns_cname{$self}     = [];
    $dns_mx{$self}        = [];
    $dns_txt{$self}       = [];
    $dns_ptr{$self}       = [];
    $dns_a4{$self}        = [];
    $dns_srv{$self}       = [];
    $dns_hinfo{$self}     = [];
    $dns_rp{$self}        = [];
    $dns_loc{$self}       = [];
    $dns_generate{$self}  = [];
    $dns_last_name{$self} = undef;
    $dns_last_origin{$self} = undef;
    $dns_last_ttl{$self} = undef;
    $dns_last_class{$self} = 'IN'; # Class defaults to IN.
    $dns_found_origins{$self} = {};
    $last_parse_error_count{$self} = 0;
    return 1;
}

sub _load_file {
    my ( $self, $zonefile, $origin ) = @_;
    my $zone_contents;
    if ( ref( $zonefile ) eq 'SCALAR' ) {
        $zone_contents = $$zonefile;
    } else {
        my $inZONE;
        if ( open( $inZONE, '<', $zonefile ) ) {
            local $/;
            $zone_contents = <$inZONE>;
            close( $inZONE );
        } else {
            croak qq[DNS::ZoneParse Could not open input file: "$zonefile":$!];
        }
    }
    if ( $self->_parse( $zonefile, $zone_contents, $origin ) ) { return 1; }
}

sub _parse {
    # Support IsAlnum for unicode names.
    use utf8;
    my ( $self, $zonefile, $contents, $origin ) = @_;
    $self->_initialize();

    # Here's how we auto-detect the zonefile and origin. Note, the zonefile is
    # only used to print out a comment in the file, so its okay if we're
    # inaccurate. First, prefer what the user configures. Next, try to read a
    # comment we would have written if we wrote the file out in the past.
    # Finally, pick up any SOA or $ORIGIN statements present in the file.
    if ( ref( $zonefile ) eq 'SCALAR' ) { $zonefile = ''; }

    if ( !$origin || !$zonefile ) {
        # I don't know why the ( dns)? capture is there, perhaps at one point
        # this module wrote a different header comment? I'll leave it as to
        # preserve whatever backwards compatability this affords us...
        $contents =~ /^\s*;\s*Database file (\S+)( dns)? for (\S+) zone/im;
        if ( !$origin && $3 ) { $origin = $3; }
        if ( !$zonefile && $1 ) { $zonefile = $1; }
    }

    if ( $zonefile ) {
        $zonefile = basename( $zonefile );
    } else {
        $zonefile = 'unknown';
    }

    if ( $origin ) {
        # A trite way of insuring there is a trailing dot on the origin. It's
        # really important you supply a trailing . in an origin when you mean
        # it.
        $origin =~ s/([^.])$/$1./;
    } else {
        $origin = '';
    }

    $dns_id{$self} = {
        ZoneFile => $zonefile,
        Origin   => $origin,
    };

    my $records = $self->_clean_records( $contents );

    # Everything valid in the name, except the '.' character.
    my $valid_name_start_char = q/(?:[\p{IsAlnum}\@_\-*:+=!#$%^&`~,\[\]{}|?'\/]|/
     . join( '|', map { "\\\\$_" } @ESCAPABLE_CHARACTERS ) . ')';

    # The above, but adds the literal '.' character.
    my $valid_name_char        = qr/(?:$valid_name_start_char|[\.\\])/o;
    my $valid_txt_char         = qr/\S+/o;
    my $valid_quoted_txt_char  = qr/.+/o;
    # Like the above, but adds whitespace (space and tabs) too.
    my $valid_quoted_name_char = qr/(?:$valid_name_start_char|[. ;\t()\\])/o;
    my $valid_name             = qr/$valid_name_start_char$valid_name_char*/o;
    my $valid_ip6              = qr/[\@a-zA-Z_\-\.0-9\*:]+/;
    my $rr_type                = qr/\b(?:NS|A|CNAME)\b/i;
    #my $ttl_cls                = qr/(?:($rr_ttl)\s)?(?:($rr_class)\s)?/o;
    my $ttl_cls                = qr/(?:\b((?:$rr_ttl)|(?:$rr_class))\s)?(?:\b((?:$rr_class)|(?:$rr_ttl))\s)?/o;
    my $generate_range         = qr{\d+\-\d+(?:/\d+)?};
    my $last_good_line;