/usr/share/perl5/Mail/DKIM/DNS.pm is in libmail-dkim-perl 0.39-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #!/usr/bin/perl
# Copyright 2007 Messiah College. All rights reserved.
# Jason Long <jlong@messiah.edu>
use strict;
use warnings;
# This class contains a method to perform synchronous DNS queries.
# Hopefully some day it will have a method to perform
# asynchronous DNS queries.
package Mail::DKIM::DNS;
use Net::DNS;
our $TIMEOUT = 10;
# query- returns a list of RR objects
# or an empty list if the domain record does not exist
# (e.g. in the case of NXDOMAIN or NODATA)
# or throws an error on a DNS query time-out or other transient error
# (e.g. SERVFAIL)
#
# if an empty list is returned, $@ is also set to a string explaining
# why no records were returned (e.g. "NXDOMAIN").
#
sub query
{
my ($domain, $type) = @_;
my $rslv = Net::DNS::Resolver->new()
or die "can't create DNS resolver";
#
# perform the DNS query
# if the query takes too long, we should generate an error
#
my $resp;
my $remaining_time = alarm(0); # check time left, stop the timer
my $deadline = time + $remaining_time;
eval
{
# set a 10 second timeout
local $SIG{ALRM} = sub { die "DNS query timeout for $domain\n" };
alarm $TIMEOUT;
# the query itself could cause an exception, which would prevent
# us from resetting the alarm before leaving the eval {} block
# so we wrap the query in a nested eval {} block
eval
{
$resp = $rslv->query($domain, $type);
};
my $E = $@;
alarm 0;
die $E if $E;
};
my $E = $@;
alarm 0;
# restart the timer if it was active
if ($remaining_time > 0)
{
my $dt = $deadline - time;
# make sure the timer expiration will trigger a signal,
# even at the expense of stretching the interval by one second
alarm($dt < 1 ? 1 : $dt);
}
die $E if $E;
if ($resp)
{
my @result = grep { lc $_->type eq lc $type } $resp->answer;
return @result if @result;
}
$@ = $rslv->errorstring;
return () if ($@ eq "NOERROR" || $@ eq "NXDOMAIN");
die "DNS error: $@\n";
}
# query_async() - perform a DNS query asynchronously
#
# my $waiter = query_async("example.org", "TXT",
# Callbacks => {
# Success => \&on_success,
# Error => \&on_error,
# },
# );
# my $result = $waiter->();
#
sub query_async
{
my ($domain, $type, %prms) = @_;
my $callbacks = $prms{Callbacks} || {};
my $on_success = $callbacks->{Success} || sub { $_[0] };
my $on_error = $callbacks->{Error} || sub { die $_[0] };
my $waiter = sub {
my @resp;
my $warning;
eval {
@resp = query($domain, $type);
$warning = $@;
undef $@;
};
$@ and return $on_error->($@);
$@ = $warning;
return $on_success->(@resp);
};
return $waiter;
}
1;
|