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__ |