File Coverage

blib/lib/GlbDNS.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package GlbDNS;
2              
3 8     8   329546 use 5.008008;
  8         79  
  8         4321  
4 8     8   57 use strict;
  8         16  
  8         349  
5 8     8   46 use warnings;
  8         28  
  8         648  
6             our $VERSION = '0.30';
7 8     8   10013 use Net::DNS::Nameserver;
  8         1340966  
  8         388  
8 8     8   11957 use Data::Dumper;
  8         128884  
  8         592  
9 8     8   12137 use threads;
  0            
  0            
10             use threads::shared;
11             use LWP::Simple;
12             use List::Util qw(sum);
13             my %status : shared;
14             my %stats : shared;
15             use Geo::IP;
16             my %counters : shared;
17              
18             use GlbDNS::Resolver::Base;
19             use GlbDNS::Resolver::ShowServer;
20             use GlbDNS::Resolver::ShowLocation;
21             #to enable testing
22             our %TEST = ( noadmin => 0,
23             nosocket => 0
24             );
25              
26             sub new {
27             my $class = shift;
28             my $self = bless {}, $class;
29             my $daemon = shift;
30             $self->{name} = $daemon->name;
31              
32             $self->{dns} = Net::DNS::Nameserver->new(
33             Verbose => $main::config{debug} || 0,
34             LocalAddr => $daemon->options->{address},
35             LocalPort => $daemon->options->{port},
36             ReplyHandler => sub { $self->request(@_) },
37             ) unless ($TEST{nosocket});
38              
39             #threads->create(sub { while(1) { sleep 60; print Dumper(\%counters) } });
40             threads->create(\&admin) unless ($TEST{noadmin});
41              
42             $self->{resolver_hook} = [
43             GlbDNS::Resolver::ShowLocation->new(),
44             GlbDNS::Resolver::ShowServer->new(),
45             GlbDNS::Resolver::Base->new(),
46             ];
47             return $self;
48             }
49              
50             sub admin {
51             my $sock = IO::Socket::INET->new
52             (Listen => 5,
53             LocalAddr => 'localhost',
54             LocalPort => 9000,
55             Proto => 'tcp',
56             Reuse => 1
57             );
58             while(my $connection = $sock->accept) {
59             $connection->print(Dumper \%counters);
60             $connection->print(Dumper \%status);
61             close($connection);
62             }
63             }
64              
65             sub check_service {
66              
67             my ($ip, $url, $expect, $interval) = @_;
68             $url =~s/^\///;
69             while(1) {
70             my $foo = get("http://$ip/$url");
71             if ($foo && $foo =~/$expect/) {
72             $status{$ip} = $status{$ip} + 1;
73             } else {
74             $status{$ip} = 0;
75             }
76             sleep $interval;
77             }
78             }
79              
80             sub start {
81             my $self = shift;
82             $0 = "$self->{name} worker - waiting for status checks before accepting requests";
83             while(keys %status && sum(values %status) == 0) {
84             sleep 1;
85             }
86             $0 = "$self->{name} worker - accepting requests";
87              
88             foreach my $check (values %{$self->{checks}}) {
89             $status{$check->{ip}} = 0;
90             threads->create('check_service', $check->{ip}, $check->{url}, $check->{expect}, ($check->{interval} || 5));
91             }
92              
93             $self->{dns}->main_loop;
94             }
95              
96              
97             sub request {
98             my $self = shift;
99             $counters{Request}++;
100             foreach my $hook (@{$self->{resolver_hook}}) {
101             if (my @answer = $hook->request($self, @_)) {
102             return @answer;
103             }
104             }
105             }
106              
107              
108             sub get_host {
109             my $self = shift;
110             my $qname = shift;
111             my @query = split(/\./, $qname);
112             while(@query) {
113             my $test_domain = join (".", @query);
114             if($self->{hosts}->{$test_domain}) {
115             return $self->{hosts}->{$test_domain};
116             }
117             shift @query;
118             }
119             return;
120             }
121              
122              
123             1;
124             __END__