@@ -4,5 +4,8 @@ skeleton server. :-) Mark Andrews <Mark_Andrews@isc.org> pointed out several bugs and mistakes in some of the replies the server sent. +Guillaume Filion fixed bugs and experimented with using BGP data +intead of Geo::IP. + MaxMind (http://www.maxmind.com/) provides us with excellent geo data and open source libraries to access it. CREDITS @@ -1,4 +1,9 @@ -See the SVN history for now :-) -We'll track "user visible changes" here when we start making proper releases some day. + - read .json data files (to bulk save/load configuration) + - support __END__ to stop reading a configuration file + - max_hosts configuration (should probably be renamed?) + - Fix bug that disallowed setting default serial/ttl/primary_ns variables + + r347 - + - see SVN history for history prior to this. :-) \ No newline at end of file Changes @@ -22,7 +22,8 @@ ftphost 192.0.2.5 ftp.dk ftp.europe #ns ns1.example.org #ns ns2.example.org #ttl 300 -#serial 2000 +#serial 2000 +#max_hosts 3 #include config/example.net config/base.sample @@ -5,8 +5,9 @@ use Countries qw(continent); use Geo::IP; use List::Util qw/max/; use Carp; +use JSON qw(); -my $VERSION = ('$Rev: 347 $' =~ m/(\d+)/)[0]; +our $VERSION = ('$Rev: 347 $' =~ m/(\d+)/)[0]; my $HeadURL = ('$HeadURL: http://svn.develooper.com/repos/pgeodns/trunk/pgeodns.pl $' =~ m!http:(//[^/]+.*)/pgeodns.pl!)[0]; my $config; @@ -20,10 +21,6 @@ sub new { bless \%args, $class; } -sub log { - carp @_; -} - sub config { my ($self, $base) = @_; return $config unless $base; @@ -114,7 +111,7 @@ sub reply_handler { push @ans, grep { $_->address eq $config_base->{ns}->{$qname} } @{ ($self->get_ns_records($config_base))[1] }; @add = grep { $_->address ne $config_base->{ns}->{$qname} } @add; return ('NOERROR', \@ans, \@auth, \@add, { aa => 1 }); - } + } elsif ($qname =~ m/^status\.\Q$base\E$/) { my $uptime = time - $stats->{started} || 1; @@ -155,7 +152,7 @@ sub get_soa_record { my ($self, $config_base) = @_; Net::DNS::RR->new ("$config_base->{base}. 3600 IN SOA $config_base->{primary_ns}; - dns.perl.org. $config_base->{serial} 5400 5400 2419200 $config_base->{ttl}"); + support.bitnames.com. $config_base->{serial} 5400 5400 2419200 $config_base->{ttl}"); } sub pick_groups { @@ -185,19 +182,22 @@ sub pick_groups { sub pick_hosts { my ($self, $config_base, $group) = @_; - return unless $config_base->{groups}->{$group}; + return unless $config_base->{groups}->{$group} and $config_base->{groups}->{$group}->{servers}; my @answer; - my $max = 2; - $max = 1 unless scalar @{ $config_base->{groups}->{$group} }; + my $max = $config_base->{max_hosts} || 2; + $max = 1 unless scalar @{ $config_base->{groups}->{$group}->{servers} }; my $loop = 0; while (@answer < $max) { last if ++$loop > 10; # bad configuration could make us loop ... - my ($host) = ( @{ $config_base->{groups}->{$group} } )[rand scalar @{ $config_base->{groups}->{$group} }]; + my ($host) = ( @{ $config_base->{groups}->{$group}->{servers} } + )[rand scalar @{ $config_base->{groups}->{$group}->{servers} }]; + ($host, my $priority) = @$host; next if grep { $host eq $_->{name} } @answer; - push @answer, ({ name => $host, ip => $config_base->{hosts}->{$host}->{ip} }); + my $ip = $host =~ m/^\d{1,3}(.\d{1,3}){3}$/ ? $host : $config_base->{hosts}->{$host}->{ip}; + push @answer, ({ name => $host, ip => $ip }); } @answer; @@ -221,6 +221,8 @@ sub load_config { read_config( shift || 'pgeodns.conf' ); + delete $config->{base}; + # warn Data::Dumper->Dump([\$config], [qw(config)]); # the default serial is timestamp of the newest config file. @@ -254,10 +256,10 @@ sub read_config { die "Oops, recursive inclusion of $file - parent(s): ", join ", ", @config_file_stack; } - push @config_file_stack, $file; - open my $fh, $file - or &log("Can't open config file: $file: $!"); + or warn "Can't open config file: $file: $!\n" and return; + + push @config_file_stack, $file; push @{ $config->{files} }, [$file, (stat($file))[9]]; @@ -266,11 +268,20 @@ sub read_config { s/^\s+//; s/\s+$//; next if /^\#/ or /^$/; + last if /^__END__$/; if (s/^base\s+//) { - $_ .= '.' unless m/\.$/; - $config->{base} = $_; - $config->{bases}->{$_} ||= { base => $_ }; + my ($base_name, $json_file) = split /\s+/, $_; + $base_name .= '.' unless $base_name =~ m/\.$/; + $config->{base} = $base_name; + if ($json_file) { + open my $json_fh, $json_file or warn "Could not open $json_file: $!\n" and next; + push @{ $config->{files} }, [$json_file, (stat($json_file))[9]]; + my $json = eval { local $/ = undef; <$json_fh> }; + close $json_fh; + $config->{bases}->{$base_name} = JSON::jsonToObj($json); + } + $config->{bases}->{$base_name}->{base} ||= $base_name; next; } elsif (s/^include\s+//) { @@ -289,6 +300,7 @@ sub read_config { } elsif (s/^(serial|ttl|primary_ns)\s+//) { $config->{$1} = $_; + next; } } @@ -306,18 +318,19 @@ sub read_config { $config_base->{primary_ns} = $name unless $config_base->{primary_ns}; } - elsif (s/^(serial|ttl|primary_ns)\s+//) { + elsif (s/^(serial|ttl|primary_ns|max_hosts)\s+//) { $config_base->{$1} = $_; } else { s/^\s*10+\s+//; my ($host, $ip, $groups) = split(/\s+/,$_,3); + die "Bad configuration line: [$_]\n" unless $groups; $host = "$host." unless $host =~ m/\.$/; $config_base->{hosts}->{$host} = { ip => $ip }; for my $group_name (split /\s+/, $groups) { $group_name = '' if $group_name eq '@'; - $config_base->{groups}->{$group_name} ||= []; - push @{$config_base->{groups}->{$group_name}}, $host; + $config_base->{groups}->{$group_name}->{servers} ||= []; + push @{$config_base->{groups}->{$group_name}->{servers}}, [ $host, 1 ]; } } } lib/GeoDNS.pm @@ -1,7 +1,9 @@ include config/dist/base -#include config/base +# include config/jsontest + +# include config/base # include config/cpan pgeodns.conf d9965b4dc075fe4c89e1695ce1d33946f53c9f6a Ask Bjørn Hansen ask@develooper.com http://github.com/abh/pgeodns/commit/015a49fbd521759aef23a50ce2d8366587c81cd6 015a49fbd521759aef23a50ce2d8366587c81cd6 2007-08-27T22:04:34-07:00 2007-08-27T22:04:34-07:00 - read .json data files (to bulk save/load configuration) - support __END__ to stop reading a configuration file - max_hosts configuration (should probably be renamed?) - Fix bug that disallowed setting default serial/ttl/primary_ns variables git-svn-id: https://svn.develooper.com/projects/pgeodns/trunk@531 e01dd7d5-6be1-0310-aa60-dbbdb055a346 4097f023d8acb5fe817211be1d4065eee99b1dde Ask Bjørn Hansen ask@develooper.com