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