Skip to content

Commit

Permalink
replaced servers method in Mojo::IOLoop::Resolver with servers attribute
Browse files Browse the repository at this point in the history
  • Loading branch information
@kraih
kraih committed Nov 16, 2011
1 parent 3ec3125 commit 05e6e80
Show file tree
Hide file tree
Showing 6 changed files with 91 additions and 132 deletions.
2 changes: 2 additions & 0 deletions Changes
View file
Expand Up @@ -8,6 +8,8 @@ This file documents the revision history for Perl extension Mojolicious.
- Deprecated Mojo::IOLoop->write in favor of
Mojo::IOLoop::Stream->write.
- Deprecated on_* methods in Mojo::IOLoop.
- Replaced servers method in Mojo::IOLoop::Resolver with servers
attribute.
- Added EXPERIMENTAL is_readable method to Mojo::IOLoop::Stream.
- Added EXPERIMENTAL charset method to Mojo::Content.
- Added EXPERIMENTAL write event to Mojo::IOLoop::Stream.
Expand Down
108 changes: 41 additions & 67 deletions lib/Mojo/IOLoop/Resolver.pm
View file
Expand Up @@ -11,10 +11,28 @@ use constant DEBUG => $ENV{MOJO_RESOLVER_DEBUG} || 0;
# IPv6 DNS support requires "AF_INET6" and "inet_pton"
use constant IPV6 => defined &Socket::AF_INET6 && defined &Socket::inet_pton;

# Try to detect DNS servers once
my $SERVERS = ['8.8.8.8', '8.8.4.4'];
if (-r '/etc/resolv.conf') {
my $file = IO::File->new('< /etc/resolv.conf');
my @servers;
for my $line (<$file>) {

# New DNS server
if ($line =~ /^nameserver\s+(\S+)$/) {
push @servers, $1;
warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
}
}
unshift @$SERVERS, @servers;
}
unshift @$SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};

has ioloop => sub {
require Mojo::IOLoop;
Mojo::IOLoop->singleton;
};
has servers => sub { [@$SERVERS] };
has timeout => 3;

# IPv4 (RFC 3986)
Expand All @@ -37,30 +55,6 @@ my $IPV6_RE = qr/(?:
| (?: (?: $H16_RE : ){0,6} $H16_RE )? ::
)/x;

# DNS server (default to Google Public DNS)
my $SERVERS = ['8.8.8.8', '8.8.4.4'];

# Try to detect DNS server
if (-r '/etc/resolv.conf') {
my $file = IO::File->new('< /etc/resolv.conf');
my @servers;
for my $line (<$file>) {

# New DNS server
if ($line =~ /^nameserver\s+(\S+)$/) {
push @servers, $1;
warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
}
}
unshift @$SERVERS, @servers;
}

# User defined DNS server
unshift @$SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};

# Always start with first DNS server
my $CURRENT_SERVER = 0;

# DNS record types
my $DNS_TYPES = {
'*' => 0x00ff,
Expand Down Expand Up @@ -145,6 +139,7 @@ sub lookup {
);
}

# "I wonder where Bart is, his dinner's getting all cold... and eaten."
sub parse {
my ($self, $res) = @_;

Expand Down Expand Up @@ -189,7 +184,7 @@ sub resolve {

# Build request
my $loop = $self->ioloop;
my $server = $self->servers;
my $server = $self->servers->[0];
my $req = $self->build($id, $type, $name);
weaken $self;
return $loop->defer(sub { $self->$cb([]) })
Expand All @@ -203,41 +198,27 @@ sub resolve {
$self->timeout => sub {
return unless $self->{requests}->{$id};
warn "RESOLVE TIMEOUT $id ($server)\n" if DEBUG;
$CURRENT_SERVER++;
$self->_cleanup;
$self->_cleanup(1);
}
)
};
$self->_start($server, $req);
}

# "I wonder where Bart is, his dinner's getting all cold... and eaten."
sub servers {
my $self = shift;

# New servers
if (@_) {
@$SERVERS = @_;
$CURRENT_SERVER = 0;
}

# List all
return @$SERVERS if wantarray;

# Current server
$CURRENT_SERVER = 0 unless $SERVERS->[$CURRENT_SERVER];
return $SERVERS->[$CURRENT_SERVER];
}

# "Mrs. Simpson, bathroom is not for customers.
# Please use the crack house across the street."
sub _cleanup {
my $self = shift;
my ($self, $next) = @_;

# Next server
push @{$self->servers}, shift @{$self->servers} if $next;

# Socket
delete $self->{started};
return unless my $loop = $self->ioloop;
$loop->drop(delete $self->{id}) if $self->{id};

# Requests
for my $id (keys %{$self->{requests}}) {
my $r = delete $self->{requests}->{$id};
$r->{cb}->($self, []);
Expand Down Expand Up @@ -322,24 +303,18 @@ sub _start {

# New socket
weaken $self;
my %args = (
$self->{id} = $self->ioloop->client(
address => $server,
port => 53,
args => {Proto => 'udp', Type => SOCK_DGRAM}
);
$self->{id} = $self->ioloop->client(
%args => sub {
args => {Proto => 'udp', Type => SOCK_DGRAM},
sub {
my ($loop, $stream, $error) = @_;
if ($error) {
$CURRENT_SERVER++;
return $self->_cleanup;
}
return $self->_cleanup(1) if $error;
$stream->on(close => sub { $self->_cleanup });
$stream->on(
error => sub {
warn "RESOLVE FAILURE ($server)\n" if DEBUG;
$CURRENT_SERVER++;
$self->_cleanup;
$self->_cleanup(1);
}
);
$stream->on(
Expand Down Expand Up @@ -407,6 +382,15 @@ L<Mojo::IOLoop::Resolver> implements the following attributes.
Loop object to use for I/O operations, defaults to the global L<Mojo::IOLoop>
singleton.
=head2 C<servers>
my $servers = $resolver->servers;
$resolver = $resolver->servers(['8.8.8.8', '8.8.4.4']);
IP addresses of C<DNS> servers used for lookups, defaults to the value of
the C<MOJO_DNS_SERVER> environment variable, auto detection, C<8.8.8.8> or
C<8.8.4.4>.
=head2 C<timeout>
my $timeout = $resolver->timeout;
Expand Down Expand Up @@ -465,16 +449,6 @@ records, C<*> will query for all at once.
Since this is a "stub resolver" it depends on a recursive name server for DNS
resolution.
=head2 C<servers>
my @all = $resolver->servers;
my $current = $resolver->servers;
$resolver->servers('8.8.8.8', '8.8.4.4');
IP addresses of C<DNS> servers used for lookups, defaults to the value of
the C<MOJO_DNS_SERVER> environment variable, auto detection, C<8.8.8.8> or
C<8.8.4.4>.
=head1 DEBUGGING
You can set the C<MOJO_RESOLVER_DEBUG> environment variable to get some
Expand Down
64 changes: 27 additions & 37 deletions t/mojo/ioloop_tls.t
View file
Expand Up @@ -68,15 +68,13 @@ $port = Mojo::IOLoop->generate_port;
$server = $client = '';
my ($drop, $running, $server_error, $server_close, $client_close);
Mojo::IOLoop->drop(Mojo::IOLoop->recurring(0 => sub { $drop++ }));
my %args = (
$loop->server(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
tls_ca => 't/mojo/certs/ca.crt'
);
$loop->server(
%args => sub {
tls_ca => 't/mojo/certs/ca.crt',
sub {
my ($loop, $stream) = @_;
$stream->write('test', sub { shift->write('321') });
$running = Mojo::IOLoop->is_running;
Expand All @@ -85,14 +83,12 @@ $loop->server(
$stream->on(read => sub { $server .= pop });
}
);
%args = (
my $id = $loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/client.crt',
tls_key => 't/mojo/certs/client.key'
);
my $id = $loop->client(
%args => sub {
tls_key => 't/mojo/certs/client.key',
sub {
my ($loop, $stream) = @_;
$stream->write('tset', sub { shift->write('123') });
$stream->on(close => sub { $client_close++ });
Expand All @@ -112,13 +108,13 @@ ok !$server_error, 'no error';

# Invalid client certificate
$server_error = '';
%args = (
$id = $loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/badcert.key',
tls_key => 't/mojo/certs/badcert.crt'
tls_key => 't/mojo/certs/badcert.crt',
sub { $server_error = pop }
);
$id = $loop->client(%args => sub { $server_error = pop });
$loop->timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
Expand All @@ -128,22 +124,22 @@ ok $server_error, 'has error';
$loop = Mojo::IOLoop->new;
$port = Mojo::IOLoop->generate_port;
my $client_error = $server_error = '';
%args = (
$loop->server(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
tls_ca => 't/mojo/certs/ca.crt',
tls_verify => sub {0}
tls_verify => sub {0},
sub { $server_error = pop }
);
$loop->server(%args => sub { $server_error = pop });
%args = (
$id = $loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/client.crt',
tls_key => 't/mojo/certs/client.key'
tls_key => 't/mojo/certs/client.key',
sub { $client_error = pop }
);
$id = $loop->client(%args => sub { $client_error = pop });
$loop->timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
Expand All @@ -155,31 +151,27 @@ $loop = Mojo::IOLoop->new;
$port = Mojo::IOLoop->generate_port;
$server = $client = '';
$server_close = $client_close = 0;
%args = (
$loop->server(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
tls_ca => 't/mojo/certs/ca.crt',
tls_verify => sub {1}
);
$loop->server(
%args => sub {
tls_verify => sub {1},
sub {
my ($loop, $stream) = @_;
$stream->write('test', sub { shift->write('321') });
$stream->on(close => sub { $server_close++ });
$stream->on(error => sub { $server_error = pop });
$stream->on(read => sub { $server .= pop });
}
);
%args = (
$id = $loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/client.crt',
tls_key => 't/mojo/certs/client.key'
);
$id = $loop->client(
%args => sub {
tls_key => 't/mojo/certs/client.key',
sub {
my ($loop, $stream) = @_;
$stream->write('tset', sub { shift->write('123') });
$stream->on(close => sub { $client_close++ });
Expand Down Expand Up @@ -207,27 +199,25 @@ ok $client_error, 'has error';
$loop = Mojo::IOLoop->new;
$port = Mojo::IOLoop->generate_port;
$server_error = $client_error = '';
%args = (
$loop->server(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/server.crt',
tls_key => 't/mojo/certs/server.key',
tls_ca => 'no cert'
);
$loop->server(
%args => sub {
tls_ca => 'no cert',
sub {
my ($loop, $stream) = @_;
$stream->write('test', sub { shift->write('321') });
$stream->on(error => sub { $server_error = pop });
}
);
%args = (
$id = $loop->client(
port => $port,
tls => 1,
tls_cert => 't/mojo/certs/client.crt',
tls_key => 't/mojo/certs/client.key'
tls_key => 't/mojo/certs/client.key',
sub { $client_error = pop }
);
$id = $loop->client(%args => sub { $client_error = pop });
$loop->timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
Expand Down
31 changes: 13 additions & 18 deletions t/mojo/resolver.t
View file
Expand Up @@ -7,7 +7,7 @@ BEGIN {
$ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
}

use Test::More tests => 29;
use Test::More tests => 25;

# "Oh, I'm in no condition to drive. Wait a minute.
# I don't have to listen to myself. I'm drunk."
Expand Down Expand Up @@ -36,23 +36,18 @@ ok !$r->is_ipv6('1.1.1.1.1.1'), 'not an IPv4 address';
my $r2 = Mojo::IOLoop::Resolver->new;
is $r->ioloop, $r2->ioloop, 'same ioloop';

# Shared server pool
$r->servers('8.8.8.8', '1.2.3.4');
is_deeply [$r->servers], ['8.8.8.8', '1.2.3.4'], 'right servers';
is scalar $r->servers, '8.8.8.8', 'right server';
$r2->servers('8.8.8.8', '1.2.3.4');
is_deeply [$r2->servers], ['8.8.8.8', '1.2.3.4'], 'right servers';
is scalar $r2->servers, '8.8.8.8', 'right server';
$r->servers('1.2.3.4');
is_deeply [$r->servers], ['1.2.3.4'], 'right servers';
is scalar $r->servers, '1.2.3.4', 'right server';
is_deeply [$r2->servers], ['1.2.3.4'], 'right servers';
is scalar $r2->servers, '1.2.3.4', 'right server';
$r->servers('1.2.3.4', '4.3.2.1');
is_deeply [$r->servers], ['1.2.3.4', '4.3.2.1'], 'right servers';
is scalar $r->servers, '1.2.3.4', 'right server';
is_deeply [$r2->servers], ['1.2.3.4', '4.3.2.1'], 'right servers';
is scalar $r2->servers, '1.2.3.4', 'right server';
# Separate server pools
$r->servers(['8.8.8.8', '1.2.3.4']);
is_deeply $r->servers, ['8.8.8.8', '1.2.3.4'], 'right servers';
is $r->servers->[0], '8.8.8.8', 'right server';
$r2->servers(['8.8.4.4', '4.3.2.1']);
is_deeply $r2->servers, ['8.8.4.4', '4.3.2.1'], 'right servers';
is $r2->servers->[0], '8.8.4.4', 'right server';
$r->servers(['1.2.3.4']);
is_deeply $r->servers, ['1.2.3.4'], 'right servers';
is $r->servers->[0], '1.2.3.4', 'right server';
is_deeply $r2->servers, ['8.8.4.4', '4.3.2.1'], 'right servers';
is $r2->servers->[0], '8.8.4.4', 'right server';

# Lookup "localhost" (pass through)
my $result;
Expand Down

0 comments on commit 05e6e80

Please sign in to comment.