view release on metacpan or  search on metacpan

lib/Net/DNS/Lite.pm  view on Meta::CPAN

    my $id;

    my $now = time;

    if (@{$self->{reuse_q}} >= 30000) {
        $self->_open_socket();
    } else {
        delete $self->{reuse_h}{(shift @{$self->{reuse_q}})->[1]}
            while @{$self->{reuse_q}} && $self->{reuse_q}[0][0] <= $now;
    }

    while (1) {
        $id = int rand(65536);
        last if not defined $self->{reuse_h}{$id};
    }

    $id;
}

sub _register_unusable_id {
    my ($self, $id) = @_;

    push @{$self->{reuse_q}}, [ time + $self->{reuse}, $id ];
    $self->{reuse_h}{$id} = 1;
}

sub parse_resolv_conf {
    my ($self, $resolvconf) = @_;

    $self->{server} = [];
    $self->{search} = [];

    my $attempts;
    my $timeout;

    for (split /\n/, $resolvconf) {
        s/\s*[;#].*$//; # not quite legal, but many people insist

        if (/^\s*nameserver\s+(\S+)\s*$/i) {
            my $ip = $1;
            if (my $ipn = parse_address($ip)) {
                push @{ $self->{server} }, $ip;
            } else {
                warn "nameserver $ip invalid and ignored\n";
            }
        } elsif (/^\s*domain\s+(\S*)\s*$/i) {
            $self->{search} = [$1];
        } elsif (/^\s*search\s+(.*?)\s*$/i) {
            $self->{search} = [split /\s+/, $1];
        } elsif (/^\s*sortlist\s+(.*?)\s*$/i) {
            # ignored, NYI
        } elsif (/^\s*options\s+(.*?)\s*$/i) {
            for (split /\s+/, $1) {
                if (/^timeout:(\d+)$/) {
                    $timeout = $1;
                } elsif (/^attempts:(\d+)$/) {
                    $attempts = $1;
                } elsif (/^ndots:(\d+)$/) {
                    $self->{ndots} = $1;
                } else {
                    # debug, rotate, no-check-names, inet6
                }
            }
        }
    }

    if ( $timeout || $attempts ) {
        $timeout ||= 5;
        $attempts ||= 2;
        $self->{timeout} = [ map { $timeout } 1..$attempts ];
    }
}

sub _parse_resolv_conf_file {
    my ($self, $resolv_conf) = @_;

    open my $fh, '<', $resolv_conf
        or Carp::croak "could not open file: $resolv_conf: $!";

    $self->parse_resolv_conf(do { local $/; join '', <$fh> });
}

sub _enc_name($) {
    pack "(C/a*)*", (split /\./, shift), ""
}

sub _enc_qd() {
    no warnings;
    (_enc_name $_->[0]) . pack "nn",
        ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
        ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
}

sub _enc_rr() {
    die "encoding of resource records is not supported";
}

sub dns_pack {
    no warnings;
    my ($req) = @_;

    pack "nn nnnn a* a* a* a*",
        $req->{id},

        ! !$req->{qr}   * 0x8000
        + $opcode_id{$req->{op}} * 0x0800
        + ! !$req->{aa} * 0x0400
        + ! !$req->{tc} * 0x0200
        + ! !$req->{rd} * 0x0100
        + ! !$req->{ra} * 0x0080
        + ! !$req->{ad} * 0x0020
        + ! !$req->{cd} * 0x0010
        + $rcode_id{$req->{rc}} * 0x0001,

        scalar @{ $req->{qd} || [] },
        scalar @{ $req->{an} || [] },
        scalar @{ $req->{ns} || [] },
        scalar @{ $req->{ar} || [] },

        (join "", map _enc_qd, @{ $req->{qd} || [] }),
        (join "", map _enc_rr, @{ $req->{an} || [] }),