113 lines
2.7 KiB
Perl
113 lines
2.7 KiB
Perl
package Qpsmtpd::Base;
|
|
use strict;
|
|
|
|
use Net::DNS;
|
|
use Net::IP;
|
|
|
|
sub new {
|
|
return bless {}, shift;
|
|
};
|
|
|
|
sub tildeexp {
|
|
my ($self, $path) = @_;
|
|
$path =~ s{^~([^/]*)} {
|
|
$1 ? (getpwnam($1))[7]
|
|
: ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])
|
|
}ex;
|
|
return $path;
|
|
}
|
|
|
|
sub is_localhost {
|
|
my ($self, $ip) = @_;
|
|
return if ! $ip;
|
|
return 1 if $ip =~ /^127\./; # IPv4
|
|
return 1 if $ip =~ /:127\./; # IPv4 mapped IPv6
|
|
return 1 if $ip eq '::1'; # IPv6
|
|
return;
|
|
}
|
|
|
|
sub is_valid_ip {
|
|
my ($self, $ip) = @_;
|
|
|
|
if (Net::IP::ip_is_ipv4($ip)) {
|
|
return if $ip eq '0.0.0.0';
|
|
return if $ip eq '255.255.255.255';
|
|
return if $ip =~ /255/;
|
|
return 1;
|
|
};
|
|
return 1 if Net::IP::ip_is_ipv6($ip);
|
|
|
|
return;
|
|
}
|
|
|
|
sub is_ipv6 {
|
|
my ($self, $ip) = @_;
|
|
return if !$ip;
|
|
return Net::IP::ip_is_ipv6($ip);
|
|
};
|
|
|
|
sub get_resolver {
|
|
my ($self, %args) = @_;
|
|
return $self->{_resolver} if $self->{_resolver};
|
|
my $timeout = 5;
|
|
if (defined $args{timeout}) {
|
|
$timeout = delete $args{timeout};
|
|
}
|
|
$self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
|
|
$self->{_resolver}->tcp_timeout($timeout);
|
|
$self->{_resolver}->udp_timeout($timeout);
|
|
return $self->{_resolver};
|
|
}
|
|
|
|
sub get_async_resolver {
|
|
my ( $self, %args ) = @_;
|
|
return $self->{_async_resolver} if $self->{_async_resolver};
|
|
|
|
my $async_res;
|
|
eval 'use Net::DNS::Async';
|
|
if ($@) {
|
|
warn "could not load Net::DNS::Async, is it installed?";
|
|
return;
|
|
}
|
|
|
|
my $res = Net::DNS::Resolver->new(dnsrch => 0);
|
|
$res->tcp_timeout(0); # Net::DNS::Async handles its own timeouts
|
|
$res->tcp_timeout(0);
|
|
|
|
$self->{_async_resolver} = Net::DNS::Async->new( %args );
|
|
$self->{_async_resolver}{Resolver} = $res;
|
|
return $self->{_async_resolver};
|
|
}
|
|
|
|
sub resolve_a {
|
|
my ($self, $name) = @_;
|
|
my $q = $self->get_resolver->query($name, 'A') or return;
|
|
return map { $_->address } grep { $_->type eq 'A' } $q->answer;
|
|
}
|
|
|
|
sub resolve_aaaa {
|
|
my ($self, $name) = @_;
|
|
my $q = $self->get_resolver->query($name, 'AAAA') or return;
|
|
return map { $_->address } grep { $_->type eq 'AAAA' } $q->answer;
|
|
}
|
|
|
|
sub resolve_mx {
|
|
my ($self, $name) = @_;
|
|
my $q = $self->get_resolver->query($name, 'MX') or return;
|
|
return map { $_->exchange } grep { $_->type eq 'MX' } $q->answer;
|
|
}
|
|
|
|
sub resolve_ns {
|
|
my ($self, $name) = @_;
|
|
my $q = $self->get_resolver->query($name, 'NS') or return;
|
|
return map { $_->nsdname } grep { $_->type eq 'NS' } $q->answer;
|
|
}
|
|
|
|
sub resolve_ptr {
|
|
my ($self, $name) = @_;
|
|
my $q = $self->get_resolver->query($name, 'PTR') or return;
|
|
return map { $_->ptrdname } grep { $_->type eq 'PTR' } $q->answer;
|
|
}
|
|
|
|
1;
|