view release on metacpan or  search on metacpan

lib/Zuzu/Module/DNS.pm  view on Meta::CPAN

	elsif ( $type eq 'SRV' ) {
		$out{target} = $value;
		$out{port} = 0 + $rr->port;
		$out{priority} = 0 + $rr->priority;
		$out{weight} = 0 + $rr->weight;
	}

	return \%out;
}

sub _lookup_records {
	my ( $name, $type_value ) = @_;

	my $query_name = _str( $name, '' );
	my $type = _record_type($type_value);
	my $resolver = _resolver();
	my $packet = $resolver->query( $query_name, $type );
	if ( !$packet ) {
		my $error = $resolver->errorstring;
		return [] if _no_data_error($error);
		die "DNSException: $error";
	}

	my @records;
	for my $rr ( $packet->answer ) {
		next if uc( $rr->type // '' ) ne $type;
		push @records, _record_dict( $query_name, $type, $rr );
	}

	return \@records;
}

sub _addresses {
	my ( $name, $family_value ) = @_;

	my $query_name = _str( $name, '' );
	my $family = lc _str( $family_value, 'any' );
	my $socket_family;
	if ( $family eq 'any' ) {
		$socket_family = AF_UNSPEC;
	}
	elsif ( $family eq 'ipv4' ) {
		$socket_family = AF_INET;
	}
	elsif ( $family eq 'ipv6' ) {
		$socket_family = AF_INET6;
	}
	else {
		die "DNSException: unsupported address family '$family'";
	}

	my ( $err, @results ) = getaddrinfo(
		$query_name,
		undef,
		{
			family => $socket_family,
			socktype => SOCK_STREAM,
		},
	);
	if ($err) {
		return [] if $err =~ /(?:Name or service not known|nodename nor servname|no address)/i;
		die "DNSException: $err";
	}

	my %seen;
	my @addresses;
	for my $result ( @results ) {
		my ( $host_err, $host ) = getnameinfo( $result->{addr}, NI_NUMERICHOST );
		next if $host_err;
		next if $seen{$host}++;
		push @addresses, $host;
	}

	return \@addresses;
}

sub _reverse_name {
	my ( $address ) = @_;

	if ( $address =~ /\A([0-9]{1,3}(?:\.[0-9]{1,3}){3})\z/ ) {
		my @octets = split /\./, $1;
		die "DNSException: invalid IPv4 address '$address'"
			if grep { $_ > 255 } @octets;
		return join( '.', reverse @octets ) . '.in-addr.arpa';
	}

	my $packed = inet_pton( AF_INET6, $address );
	if ( defined $packed ) {
		my $hex = unpack 'H*', $packed;
		return join( '.', reverse split //, $hex ) . '.ip6.arpa';
	}

	die "DNSException: invalid IP address '$address'";
}

sub _reverse {
	my ( $address_value ) = @_;

	my $address = _str( $address_value, '' );
	my $records = _lookup_records( _reverse_name($address), 'PTR' );
	return [ map { $_->{target} } @{ $records } ];
}

sub _async_task {
	my ( $runtime, $name, $work, $wrap ) = @_;

	my $worker = $runtime->_new_task(
		name => "$name.worker",
		start => 1,
		schedule => 1,
		thunk => $work,
	);
	return $runtime->_new_task(
		name => $name,
		schedule => 1,
		thunk => sub {
			my $value = $worker->await;
			return defined $wrap ? $wrap->($value) : $value;
		},
	);
}