1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More;
7
8use IO::Async::Test;
9use IO::Async::Loop;
10
11BEGIN {
12   # Install a fake resolver
13   *IO::Async::Resolver::DNS::res_search =
14   *IO::Async::Resolver::DNS::res_query = sub {
15      my ( $dname, $class, $type ) = @_;
16      my $packet = Net::DNS::Packet->new( $dname, $type, $class );
17      $packet->push( answer => Net::DNS::RR->new( "_gopher._tcp.example.com. 86400 SRV 10 0 70 gopher.l.example.com." ) );
18      $packet->push( answer => Net::DNS::RR->new( "_gopher._tcp.example.com. 86400 SRV 20 10 70 gopher1.example.com." ) );
19      $packet->push( answer => Net::DNS::RR->new( "_gopher._tcp.example.com. 86400 SRV 20 10 70 gopher2.example.com." ) );
20      $packet->push( answer => Net::DNS::RR->new( "_gopher._tcp.example.com. 86400 SRV 20 10 70 gopher3.example.com." ) );
21      $packet->push( answer => Net::DNS::RR->new( "_gopher._tcp.example.com. 86400 SRV 30 0 70 gopher.backuphost.com." ) );
22      $packet->push( additional => Net::DNS::RR->new( "gopher.l.example.com. 86400 A 10.0.0.1" ) );
23      $packet->push( additional => Net::DNS::RR->new( "gopher1.example.com. 86400 A 10.0.1.1" ) );
24      $packet->push( additional => Net::DNS::RR->new( "gopher2.example.com. 86400 A 10.0.1.2" ) );
25      $packet->push( additional => Net::DNS::RR->new( "gopher3.example.com. 86400 A 10.0.1.3" ) );
26      return $packet->data;
27   };
28}
29
30use IO::Async::Resolver::DNS;
31
32my $loop = IO::Async::Loop->new;
33
34testing_loop( $loop );
35
36my $resolver = $loop->resolver;
37
38my ( $pkt, @srv ) = $resolver->res_query(
39   dname => "_gopher._tcp.example.com",
40   type  => "SRV",
41)->get;
42
43isa_ok( $pkt, "Net::DNS::Packet", '$pkt from ->res_query isa Net::DNS::Packet' );
44
45is( scalar @srv, 5, '->res_query yielded 5 records' );
46
47is_deeply( $srv[0],
48   { priority  => 10,
49     weight    => 0,
50     target    => "gopher.l.example.com",
51     port      => 70,
52     address   => [ "10.0.0.1" ] },
53   'First returned SRV record' );
54
55# Can't rely on the exact order of the middle three, but we'll sort them to be
56# sure
57is_deeply( [ sort { $a->{target} cmp $b->{target} } @srv[1..3] ],
58   [ { priority  => 20,
59       weight    => 10,
60       target    => "gopher1.example.com",
61       port      => 70,
62       address   => [ "10.0.1.1" ] },
63     { priority  => 20,
64       weight    => 10,
65       target    => "gopher2.example.com",
66       port      => 70,
67       address   => [ "10.0.1.2" ] },
68     { priority  => 20,
69       weight    => 10,
70       target    => "gopher3.example.com",
71       port      => 70,
72       address   => [ "10.0.1.3" ] } ],
73   'Middle three returned SRV records' );
74
75is_deeply( $srv[4],
76   { priority  => 30,
77     weight    => 0,
78     target    => "gopher.backuphost.com",
79     port      => 70 },
80   'Last returned SRV record' );
81
82done_testing;
83