Index: lib/GeoDNS.pm =================================================================== --- lib/GeoDNS.pm (Revision 687) +++ lib/GeoDNS.pm (Arbeitskopie) @@ -100,18 +100,23 @@ if ($data->{$label}) { - my @hosts; - if ($query_type =~ m/^(A|ANY|TXT)$/x) { + my (@v4hosts, @v6hosts); + if ($query_type =~ m/^(A|AAAA|ANY|TXT)$/x) { my (@groups) = $self->pick_groups($config_base, $peer_host, $label); for my $group (@groups) { - push @hosts, $self->pick_hosts($config_base, $group); - last if @hosts; + push @v4hosts, $self->pick_hosts($config_base, $group, 'a'); + last if @v4hosts; # add ">= 2" to force at least two hosts even if the second one won't be as local } + for my $group (@groups) { + push @v6hosts, $self->pick_hosts($config_base, $group, 'aaaa'); + last if @v6hosts; + # add ">= 2" to force at least two hosts even if the second one won't be as local + } } if ($query_type eq 'A' or $query_type eq 'ANY') { - for my $host (@hosts) { + for my $host (@v4hosts) { push @ans, Net::DNS::RR->new( name => $domain, ttl => $ttl, @@ -121,8 +126,19 @@ } } + if ($query_type eq 'AAAA' or $query_type eq 'ANY') { + for my $host (@v6hosts) { + push @ans, Net::DNS::RR->new( + name => $domain, + ttl => $ttl, + type => 'AAAA', + address => $host->{ip} + ); + } + } + if ($query_type eq 'TXT' or $query_type eq 'ANY') { - for my $host (@hosts) { + for my $host (@v4hosts, @v6hosts) { push @ans, Net::DNS::RR->new( name => $domain, ttl => $ttl, @@ -215,29 +231,32 @@ } sub pick_hosts { - my ($self, $config_base, $group_name) = @_; + my ($self, $config_base, $group_name, $qtype) = @_; my $group = $config_base->{data}->{$group_name}; - return unless $group and $group->{a}; + return unless $group and $group->{$qtype}; my @answer; my $max = $config_base->{max_hosts} || 2; my $loop = 0; - unless ($group->{total_weight}) { + unless ($group->{'total_weight' . $qtype}) { # find total weight; my $total = 0; my @servers = (); - for (sort { $a->[1] <=> $b->[1] } @{$group->{a}}) { + for (sort { $a->[1] <=> $b->[1] } @{$group->{$qtype}}) { $total += $_->[1]; + # Normalization will do nothing if there is no colon + # in the host name + $_->[0] = _normalize_AAAA($_->[0]); push @servers, [0,$_]; } - $group->{servers} = \@servers; - $group->{total_weight} = $total; + $group->{'servers' . $qtype} = \@servers; + $group->{'total_weight' . $qtype} = $total; } - my $total_weight = $group->{total_weight}; + my $total_weight = $group->{'total_weight' . $qtype}; #warn Data::Dumper->Dump([\{$group->{servers}}], [qw(servers)]); @@ -249,7 +268,7 @@ my $n = int(rand( $total_weight )); my $host; my $total = 0; - for (@{$group->{servers}}) { + for (@{$group->{'servers' . $qtype}}) { next if $_->[0]; $total += $_->[1]->[1]; if ($total > $n) { @@ -263,8 +282,15 @@ my $hostname = $host->[0]; - my $ip = $hostname =~ m/^\d{1,3}(.\d{1,3}){3}$/x ? $hostname : $config_base->{hosts}->{$hostname}->{ip}; - + my $ip; + if ($hostname =~ m/^\d{1,3}(.\d{1,3}){3}$/x) { + $ip = $hostname; + } elsif ($hostname =~ m/:/x) { + $ip = $hostname; + } else { + $ip = $config_base->{hosts}->{$hostname}->{ip}; + } + push @answer, ({ name => $hostname, ip => $ip, weight => $host->[1] }); } @@ -428,11 +454,16 @@ my ($host, $ip, $groups) = split(/\s+/,$_,3); die "Bad configuration line: [$_]\n" unless $groups; $host = "$host." unless $host =~ m/\.$/; + my $rtype = "a"; + if ($ip =~ m/:/){ + $rtype = "aaaa"; + } $config_base->{hosts}->{$host} = { ip => $ip }; for my $group_name (split /\s+/, $groups) { $group_name = '' if $group_name eq '@'; - $config_base->{data}->{$group_name}->{a} ||= []; - push @{$config_base->{data}->{$group_name}->{a}}, [ $host, 1 ]; + # Add the host to it's group, according to querty type + $config_base->{data}->{$group_name}->{$rtype} ||= []; + push @{$config_base->{data}->{$group_name}->{$rtype}}, [ $host, 1 ]; } } } @@ -454,6 +485,33 @@ return 1; } +sub _normalize_AAAA { + # This is taken from DNS::RR::AAAA::new_from_string + # Unfortunately, AAAA.pm does not perform this algorithm + # for records created from a hash + my $string = shift; + if ($string =~ /^(.*):(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { + my ($front, $a, $b, $c, $d) = ($1, $2, $3, $4, $5); + $string = $front . sprintf(":%x:%x", + ($a << 8 | $b), + ($c << 8 | $d)); + } + + if ($string =~ /^(.*)::(.*)$/) { + my ($front, $back) = ($1, $2); + my @front = split(/:/, $front); + my @back = split(/:/, $back); + my $fill = 8 - (@front ? $#front + 1 : 0) + - (@back ? $#back + 1 : 0); + my @middle = (0) x $fill; + my @addr = (@front, @middle, @back); + $string = sprintf("%x:%x:%x:%x:%x:%x:%x:%x", + map { hex $_ } @addr); + } + return $string; +} + + 1; Index: t/example.com.json =================================================================== --- t/example.com.json (Revision 687) +++ t/example.com.json (Arbeitskopie) @@ -3,7 +3,8 @@ "data" : { "": { "ns": { "ns1.example.net": null, "ns2.example.net": null } }, "foo": { - "a": [ [ "192.168.1.2", 10 ], [ "192.168.1.3", 10 ], [ "192.168.1.4", 10 ] ] + "a": [ [ "192.168.1.2", 10 ], [ "192.168.1.3", 10 ], [ "192.168.1.4", 10 ] ], + "aaaa": [ ["fd06:c1d3:e902::2", 10], ["fd06:c1d3:e902:202:a5ff:fecd:13a6", 10], ["fd06:c1d3:e902::4", 10] ] }, "weight": { "a": [ [ "192.168.1.2", 100 ], [ "192.168.1.3", 50 ], [ "192.168.1.4", 25 ] ] Index: t/reply_01.t =================================================================== --- t/reply_01.t (Revision 687) +++ t/reply_01.t (Arbeitskopie) @@ -10,6 +10,9 @@ ok(@ans = $g->reply_handler("foo.example.com", "IN", "A", "192.168.0.10"), "get basic reply"); like($ans[1]->[0]->address, qr/192.168.1.[234]/, 'correct A record came back'); +ok(@ans = $g->reply_handler("foo.example.com", "IN", "AAAA", "192.168.0.10"), "get basic reply"); +like($ans[1]->[1]->address, qr/fd06:c1d3:e902:.*:.*:.*:.*/, 'correct AAAA record came back'); + ok(@ans = $g->reply_handler("foo.example.com", "IN", "ANY", "192.168.0.10"), "ANY request"); like((map { $_->address } grep { $_->type eq 'A' } @{ $ans[1] })[0], qr/192.168.1.[234]/, 'correct A record came back'); Index: t/pick_hosts.t =================================================================== --- t/pick_hosts.t (Revision 687) +++ t/pick_hosts.t (Arbeitskopie) @@ -7,7 +7,7 @@ my $config_base = $g->config('example.com.'); -is(my @ans = $g->pick_hosts($config_base, "ftp.cpan"), 2, "two answers returned (out of 3)"); +is(my @ans = $g->pick_hosts($config_base, "ftp.cpan", 'a'), 2, "two answers returned (out of 3)"); #use Data::Dumper; #my $x = $config_base->{groups}->{"ftp.cpan"}->{servers}; @@ -15,7 +15,7 @@ my $first; foreach my $res (@ans) { - ok(grep(/^$res->{name}/, map { $_->[1]->[0] } @{$config_base->{data}->{"ftp.cpan"}->{servers}}), "host belongs to the group"); + ok(grep(/^$res->{name}/, map { $_->[1]->[0] } @{$config_base->{data}->{"ftp.cpan"}->{serversa}}), "host belongs to the group"); is($res->{ip}, $config_base->{hosts}->{$res->{name}}->{ip}, "correct IP returned for host"); if ($first) {