line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::DNS::Nameserver::Trivial; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
252455
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
73
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
$VERSION = 0.301; |
6
|
|
|
|
|
|
|
#--------------- |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
9
|
1
|
|
|
1
|
|
17
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
39
|
|
10
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
11
|
1
|
|
|
1
|
|
6
|
use Net::IP::XS; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
12
|
1
|
|
|
1
|
|
6
|
use Net::DNS; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
163
|
|
13
|
1
|
|
|
1
|
|
7
|
use Net::DNS::Nameserver; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
19
|
use Log::Tiny; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
16
|
1
|
|
|
1
|
|
6
|
use List::MoreUtils qw(uniq); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
89
|
|
17
|
1
|
|
|
1
|
|
6
|
use Cache::FastMmap; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
26
|
|
18
|
1
|
|
|
1
|
|
5
|
use Regexp::IPv6 qw($IPv6_re); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
263
|
|
19
|
|
|
|
|
|
|
#======================================================================= |
20
|
1
|
|
|
1
|
|
7
|
use constant A => q/A/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
74
|
|
21
|
1
|
|
|
1
|
|
6
|
use constant A6 => q/A6/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
62
|
|
22
|
1
|
|
|
1
|
|
5
|
use constant IN => q/IN/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
23
|
1
|
|
|
1
|
|
5
|
use constant NS => q/NS/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
24
|
1
|
|
|
1
|
|
6
|
use constant MX => q/MX/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
63
|
|
25
|
1
|
|
|
1
|
|
6
|
use constant TTL => 86400; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
47
|
|
26
|
1
|
|
|
1
|
|
5
|
use constant PTR => q/PTR/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
47
|
|
27
|
1
|
|
|
1
|
|
4
|
use constant SOA => q/SOA/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
63
|
|
28
|
1
|
|
|
1
|
|
11
|
use constant AAAA => q/AAAA/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
29
|
1
|
|
|
1
|
|
5
|
use constant CNAME => q/CNAME/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
30
|
1
|
|
|
1
|
|
4
|
use constant AXFR => q/AXFR/; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6769
|
|
31
|
|
|
|
|
|
|
#======================================================================= |
32
|
|
|
|
|
|
|
sub new { |
33
|
0
|
|
|
0
|
1
|
|
my ($class, $config, $params) = @_; |
34
|
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
|
my $self = bless { }, $class; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Server +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
38
|
|
|
|
|
|
|
$self->{ nameserver } = Net::DNS::Nameserver->new( |
39
|
|
|
|
|
|
|
LocalAddr => $params->{ SERVER }->{ address }, |
40
|
|
|
|
|
|
|
LocalPort => $params->{ SERVER }->{ port }, |
41
|
|
|
|
|
|
|
Verbose => $params->{ SERVER }->{ verbose }, |
42
|
|
|
|
|
|
|
Truncate => $params->{ SERVER }->{ truncate }, |
43
|
|
|
|
|
|
|
IdleTimeout => $params->{ SERVER }->{ timeout }, |
44
|
0
|
|
|
0
|
|
|
ReplyHandler => sub { $self->_handler( @_ ) }, |
45
|
0
|
|
0
|
|
|
|
) || die "Couldn't create nameserver object\n"; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# Resolver +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
48
|
|
|
|
|
|
|
$self->{ resolv } = Net::DNS::Resolver->new( |
49
|
|
|
|
|
|
|
tcp_timeout => $params->{ RESOLVER }->{ tcp_timeout }, |
50
|
|
|
|
|
|
|
udp_timeout => $params->{ RESOLVER }->{ udp_timeout }, |
51
|
0
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Cache ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
54
|
|
|
|
|
|
|
$self->{ cache } = Cache::FastMmap->new( |
55
|
|
|
|
|
|
|
cache_size => $params->{ CACHE }->{ size }, |
56
|
|
|
|
|
|
|
expire_time => $params->{ CACHE }->{ expire }, |
57
|
|
|
|
|
|
|
init_file => $params->{ CACHE }->{ init }, |
58
|
|
|
|
|
|
|
unlink_on_exit => $params->{ CACHE }->{ unlink }, |
59
|
|
|
|
|
|
|
share_file => $params->{ CACHE }->{ file }, |
60
|
0
|
|
|
|
|
|
compress => 1, |
61
|
|
|
|
|
|
|
catch_deadlocks => 1, |
62
|
|
|
|
|
|
|
raw_values => 0, |
63
|
|
|
|
|
|
|
); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Log ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
66
|
0
|
|
|
|
|
|
my @log_level = qw( FAKE DEBUG INFO WARN ERROR FATAL ); |
67
|
0
|
|
0
|
|
|
|
shift @log_level while @log_level and $log_level[ 0 ] ne $params->{ LOG }->{ level }; |
68
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
$self->{ log } = Log::Tiny->new( $params->{ LOG }->{ file } ) or die 'Could not log: ' . Log::Tiny->errstr . "\n"; |
70
|
0
|
|
|
|
|
|
$self->{ log }->log_only( @log_level ); |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
select((select(Log::Tiny::LOG), $| = 1)[0]); # turn off buffering of LOG |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Flags ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
75
|
0
|
|
|
|
|
|
$self->{ _ra } = $params->{ FLAGS }->{ ra }; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# Serial +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
78
|
0
|
|
0
|
|
|
|
$self->{ serial } = $config->{ _ }->{ serial } || $self->_serial; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Slaves +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
81
|
0
|
|
|
|
|
|
$self->{ SL } = { map { $_ => 1 } split( /\s*,\s*/o, $config->{ _ }->{ slaves } ) }; |
|
0
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Nameservers for domain +++++++++++++++++++++++++++++++++++++++++++ |
84
|
0
|
|
|
|
|
|
foreach my $name ( keys %{ $config->{ NS } } ){ |
|
0
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
$self->{ NS }->{ $name } = [ uniq split(/\s*,\s*/, $config->{ NS }->{ $name } ) ]; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
# $self->{ NS } = { |
88
|
|
|
|
|
|
|
# 'example.com' => [ qw( ns.example.com ) ], |
89
|
|
|
|
|
|
|
# }; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# A ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
92
|
0
|
|
|
|
|
|
foreach my $name ( keys %{ $config->{ A } } ){ |
|
0
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
$self->{ A }->{ $name } = [ grep { /^\d+\.\d+\.\d+\.\d+$/o } uniq split( /\s*,\s*/, $config->{ A }->{ $name } ) ]; |
|
0
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
# $self->{ A } = { |
96
|
|
|
|
|
|
|
# 'ns1.example.com' => [ qw( 10.3.57.1 ) ], |
97
|
|
|
|
|
|
|
# }; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# AAAA +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
100
|
0
|
|
|
|
|
|
foreach my $name (keys %{ $config->{ AAAA } } ){ |
|
0
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
$self->{ AAAA }->{ $name } = [ grep { /^$IPv6_re$/o } uniq split( /\s*,\s*/, $config->{ AAAA }->{ $name } ) ]; |
|
0
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
# $self->{ AAAA } = { |
104
|
|
|
|
|
|
|
# 'srv.example.com' => [qw( fe80::20c:29ff:fee2:ed62 )], |
105
|
|
|
|
|
|
|
# 'mail.example.com' => [qw( fe80::21d:7dff:fed5:b3d6 )], |
106
|
|
|
|
|
|
|
# }; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# CNAME ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
109
|
0
|
|
|
|
|
|
foreach my $name ( keys %{ $config->{ CNAME } } ){ |
|
0
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
$self->{ CNAME }->{ $_ } = $name for uniq split( /\s*,\s*/, $config->{ CNAME }->{ $name } ); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
# $self->{ CNAME } = { |
113
|
|
|
|
|
|
|
# 'ns0.example.com' => 'srv.example.com', |
114
|
|
|
|
|
|
|
# }; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# MX +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
117
|
0
|
|
|
|
|
|
foreach my $name ( keys %{ $config->{ MX } } ){ |
|
0
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
$self->{ MX }->{ $name } = [ uniq split(/\s*,\s*/, $config->{ MX }->{ $name } ) ]; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
# $self->{ MX } = { |
121
|
|
|
|
|
|
|
# 'example.com' => [ qw( mail.example.com ) ], |
122
|
|
|
|
|
|
|
# }; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# SOA ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
125
|
0
|
|
|
|
|
|
foreach my $name ( keys %{ $config->{ SOA } } ){ |
|
0
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
$self->{ SOA }->{ $name } = $config->{ SOA }->{ $name }; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
# $self->{ SOA } = { |
129
|
|
|
|
|
|
|
# 'example.com' => [ qw( srv.example.com ) ], |
130
|
|
|
|
|
|
|
# }; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# PTR ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
133
|
0
|
|
|
|
|
|
foreach my $name ( keys %{ $self->{ A } } ){ |
|
0
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
foreach my $ip ( @{ $self->{ A }->{ $name } } ){ |
|
0
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
( my $key = Net::IP::XS->new( $ip )->reverse_ip() ) =~ s/\.$//o; |
136
|
0
|
|
|
|
|
|
$self->{ PTR }->{ $key } = $name; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
} |
139
|
0
|
|
|
|
|
|
foreach my $name (keys %{ $self->{ AAAA } } ){ |
|
0
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
foreach my $ip ( @{ $self->{ AAAA }->{ $name } } ){ |
|
0
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
(my $key = Net::IP::XS->new( $ip )->reverse_ip()) =~ s/\.$//o; |
142
|
0
|
|
|
|
|
|
$self->{ PTR }->{ $key } = $name; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
146
|
0
|
|
|
|
|
|
return $self; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
#======================================================================= |
149
|
|
|
|
|
|
|
# RFC1912 2.2 |
150
|
|
|
|
|
|
|
sub _serial { |
151
|
0
|
|
|
0
|
|
|
my ($self, $sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime( time ); |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
$year += 1900; |
154
|
0
|
|
|
|
|
|
$mon += 1; |
155
|
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
|
$sec = q[0] . $sec if $sec =~ /^\d$/o; |
157
|
0
|
0
|
|
|
|
|
$min = q[0] . $min if $min =~ /^\d$/o; |
158
|
0
|
0
|
|
|
|
|
$hour = q[0] . $hour if $hour =~ /^\d$/o; |
159
|
0
|
0
|
|
|
|
|
$mday = q[0] . $mday if $mday =~ /^\d$/o; |
160
|
0
|
0
|
|
|
|
|
$mon = q[0] . $mon if $mon =~ /^\d$/o; |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
return $year . $mon . $mday . $hour; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
#======================================================================= |
165
|
|
|
|
|
|
|
sub _plain { |
166
|
0
|
|
|
0
|
|
|
my ($self, $str) = @_; |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
$str =~ s/[\s\t]+(\d+)\s*(\)?)\s*;[^\n]+\n?/ $1/go; |
169
|
0
|
|
|
|
|
|
$str =~ s/\(\s*//o; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
return $str; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
#======================================================================= |
174
|
|
|
|
|
|
|
sub _log_response { |
175
|
0
|
|
|
0
|
|
|
my ($self, $peerhost, $qtype, $qname, $val) = @_; |
176
|
|
|
|
|
|
|
|
177
|
0
|
0
|
|
|
|
|
$self->{ log }->INFO( q[ ] . $peerhost . q[ ] . $qname . ' [' . $qtype . '] ' . ( scalar( @{ $val->[ 1 ] } ) ? q[OK] : q[FAIL] ) ); |
|
0
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( "-" x 72 ); |
180
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( 'Code: ' . $val->[0] ); |
181
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( " Ans: " . $self->_plain( $_->string ) ) for @{ $val->[ 1 ] }; |
|
0
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( "Auth: " . $self->_plain( $_->string ) ) for @{ $val->[ 2 ] }; |
|
0
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( " Add: " . $self->_plain( $_->string ) ) for @{ $val->[ 3 ] }; |
|
0
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( "=" x 72 ); |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
#======================================================================= |
188
|
|
|
|
|
|
|
sub _handler { |
189
|
0
|
|
|
0
|
|
|
my ($self, $qname, $qclass, $qtype, $peerhost, $query, $conn) = @_; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# sprawdzamy, czy odpowiedz jest w pamieci cache ------------------- |
192
|
0
|
|
|
|
|
|
my $key = join( q/$/, $qname, $qclass, $qtype ); |
193
|
0
|
|
|
|
|
|
my $val = $self->{ cache }->get( $key ); |
194
|
|
|
|
|
|
|
|
195
|
0
|
0
|
|
|
|
|
if( $val ){ |
196
|
0
|
|
|
|
|
|
$self->_log_response( $peerhost, $qtype, $qname, $val ); |
197
|
0
|
|
|
|
|
|
return @$val; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
#------------------------------------------------------------------- |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
my ($rcode, @ans, @auth, @add, $local); |
202
|
0
|
0
|
0
|
|
|
|
if($qtype eq A and ( exists $self->{ A }->{ $qname} or exists $self->{ CNAME }->{ $qname} )){ |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
203
|
|
|
|
|
|
|
|
204
|
0
|
0
|
|
|
|
|
if($self->{ CNAME }->{ $qname } ){ |
205
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
206
|
|
|
|
|
|
|
name => $qname, |
207
|
|
|
|
|
|
|
ttl => TTL, |
208
|
|
|
|
|
|
|
class => $qclass, |
209
|
|
|
|
|
|
|
type => CNAME, |
210
|
0
|
|
|
|
|
|
cname => $self->{ CNAME }->{ $qname }, |
211
|
|
|
|
|
|
|
); |
212
|
0
|
|
|
|
|
|
$qname = $self->{ CNAME }->{ $qname }; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
foreach my $ip ( @{ $self->{ A }->{ $qname } } ){ |
|
0
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
217
|
|
|
|
|
|
|
name => $qname, |
218
|
|
|
|
|
|
|
ttl => TTL, |
219
|
|
|
|
|
|
|
class => $qclass, |
220
|
|
|
|
|
|
|
type => $qtype, |
221
|
|
|
|
|
|
|
address => $ip, |
222
|
|
|
|
|
|
|
); |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
$local = 1; |
226
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
227
|
|
|
|
|
|
|
}elsif( ( $qtype eq AAAA or $qtype eq A6 ) and ( exists $self->{ AAAA }->{ $qname } or exists $self->{ CNAME }->{ $qname } ) ){ |
228
|
|
|
|
|
|
|
|
229
|
0
|
0
|
|
|
|
|
if($self->{ CNAME }->{ $qname } ){ |
230
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
231
|
|
|
|
|
|
|
name => $qname, |
232
|
|
|
|
|
|
|
ttl => TTL, |
233
|
|
|
|
|
|
|
class => $qclass, |
234
|
|
|
|
|
|
|
type => CNAME, |
235
|
0
|
|
|
|
|
|
cname => $self->{ CNAME }->{ $qname }, |
236
|
|
|
|
|
|
|
); |
237
|
0
|
|
|
|
|
|
$qname = $self->{ CNAME }->{ $qname }; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
foreach my $ip ( @{ $self->{ AAAA }->{ $qname } } ){ |
|
0
|
|
|
|
|
|
|
241
|
0
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
242
|
|
|
|
|
|
|
name => $qname, |
243
|
|
|
|
|
|
|
ttl => TTL, |
244
|
|
|
|
|
|
|
class => $qclass, |
245
|
|
|
|
|
|
|
type => $qtype, |
246
|
|
|
|
|
|
|
address => $ip, |
247
|
|
|
|
|
|
|
); |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
$local = 1; |
251
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
252
|
|
|
|
|
|
|
}elsif( $qtype eq MX and ( exists $self->{ MX }->{ $qname } or exists $self->{ CNAME }->{ $qname } ) ){ |
253
|
|
|
|
|
|
|
MX: |
254
|
0
|
0
|
|
|
|
|
if( $self->{ CNAME }->{ $qname } ){ |
255
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
256
|
|
|
|
|
|
|
name => $qname, |
257
|
|
|
|
|
|
|
ttl => TTL, |
258
|
|
|
|
|
|
|
class => $qclass, |
259
|
|
|
|
|
|
|
type => CNAME, |
260
|
0
|
|
|
|
|
|
cname => $self->{ CNAME }->{ $qname }, |
261
|
|
|
|
|
|
|
); |
262
|
0
|
|
|
|
|
|
$qname = $self->{ CNAME }->{ $qname }; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
0
|
|
|
|
|
|
foreach my $name ( @{$self->{ MX }->{ $qname } } ){ |
|
0
|
|
|
|
|
|
|
266
|
0
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
267
|
|
|
|
|
|
|
name => $qname, |
268
|
|
|
|
|
|
|
ttl => TTL, |
269
|
|
|
|
|
|
|
class => $qclass, |
270
|
|
|
|
|
|
|
type => MX, |
271
|
|
|
|
|
|
|
preference => 10, |
272
|
|
|
|
|
|
|
exchange => $name, |
273
|
|
|
|
|
|
|
); |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
my @ip; |
276
|
0
|
0
|
|
|
|
|
push @ip, @{ $self->{ A }->{ $name } } if exists $self->{ A }->{ $name }; |
|
0
|
|
|
|
|
|
|
277
|
0
|
0
|
|
|
|
|
push @ip, @{ $self->{ AAAA }->{ $name } } if exists $self->{ AAAA }->{ $name }; |
|
0
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
|
279
|
0
|
|
|
|
|
|
for my $ip ( @ip ){ |
280
|
0
|
0
|
|
|
|
|
push @add, Net::DNS::RR->new( |
281
|
|
|
|
|
|
|
name => $name, |
282
|
|
|
|
|
|
|
ttl => TTL, |
283
|
|
|
|
|
|
|
class => IN, |
284
|
|
|
|
|
|
|
type => $ip =~ /:/o ? AAAA : A, |
285
|
|
|
|
|
|
|
address => $ip, |
286
|
|
|
|
|
|
|
); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
0
|
|
|
|
|
|
$local = 1; |
291
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
292
|
|
|
|
|
|
|
}elsif( $qtype eq PTR and exists $self->{ PTR }->{ $qname } ){ |
293
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
294
|
|
|
|
|
|
|
name => $qname . q/./, |
295
|
|
|
|
|
|
|
ttl => TTL, |
296
|
|
|
|
|
|
|
class => $qclass, |
297
|
|
|
|
|
|
|
type => $qtype, |
298
|
0
|
|
|
|
|
|
ptrdname => $self->{ PTR }->{ $qname } . q/./, |
299
|
|
|
|
|
|
|
); |
300
|
|
|
|
|
|
|
|
301
|
0
|
|
|
|
|
|
$local = 1; |
302
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
303
|
|
|
|
|
|
|
}elsif( $qtype eq SOA and exists $self->{ SOA }->{ $qname } ){ |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# SOA ---------------------------------------------------------- |
306
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
307
|
|
|
|
|
|
|
name => $qname . q/./, |
308
|
|
|
|
|
|
|
mname => $self->{ SOA }->{ $qname }, |
309
|
|
|
|
|
|
|
rname => q/root./ . $self->{ SOA }->{ $qname } . q/./, |
310
|
|
|
|
|
|
|
ttl => TTL, |
311
|
|
|
|
|
|
|
class => IN, |
312
|
|
|
|
|
|
|
type => SOA, |
313
|
|
|
|
|
|
|
serial => $self->{ serial }, |
314
|
0
|
|
|
|
|
|
refresh => 10800, # 3 godziny |
315
|
|
|
|
|
|
|
retry => 3600, # 1 godzina |
316
|
|
|
|
|
|
|
expire => 2592000, # 30 dni |
317
|
|
|
|
|
|
|
minimum => TTL, |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
|
320
|
0
|
|
|
|
|
|
$local = 1; |
321
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
322
|
|
|
|
|
|
|
}elsif( $qtype eq NS and exists $self->{ NS }->{ $qname } ){ |
323
|
|
|
|
|
|
|
# NS ----------------------------------------------------------- |
324
|
0
|
|
|
|
|
|
for my $ns ( @{ $self->{ NS }->{ $qname } } ){ |
|
0
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
326
|
|
|
|
|
|
|
name => $qname, |
327
|
|
|
|
|
|
|
ttl => TTL, |
328
|
|
|
|
|
|
|
class => IN, |
329
|
|
|
|
|
|
|
type => NS, |
330
|
|
|
|
|
|
|
nsdname => $ns . q/./, |
331
|
|
|
|
|
|
|
); |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
$local = 1; |
335
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
336
|
|
|
|
|
|
|
}elsif( $qtype eq AXFR and exists $self->{ SOA }->{ $qname } and exists $self->{ SL }->{ $peerhost } ){ |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# SOA ---------------------------------------------------------- |
339
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
340
|
|
|
|
|
|
|
name => $qname . q/./, |
341
|
|
|
|
|
|
|
mname => $self->{ SOA }->{ $qname }, |
342
|
|
|
|
|
|
|
rname => q/root./ . $self->{ SOA }->{ $qname } . q/./, |
343
|
|
|
|
|
|
|
ttl => TTL, |
344
|
|
|
|
|
|
|
class => IN, |
345
|
|
|
|
|
|
|
type => SOA, |
346
|
|
|
|
|
|
|
serial => $self->{ serial }, |
347
|
0
|
|
|
|
|
|
refresh => 10800, # 3 godziny |
348
|
|
|
|
|
|
|
retry => 3600, # 1 godzina |
349
|
|
|
|
|
|
|
expire => 2592000, # 30 dni |
350
|
|
|
|
|
|
|
minimum => TTL, |
351
|
|
|
|
|
|
|
); |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# A ------------------------------------------------------------ |
354
|
0
|
|
|
|
|
|
for my $name ( keys %{ $self->{ A } } ){ |
|
0
|
|
|
|
|
|
|
355
|
0
|
0
|
|
|
|
|
next if $name !~ /$qname/; |
356
|
0
|
|
|
|
|
|
foreach my $ip ( @{ $self->{ A }->{ $name } } ){ |
|
0
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
358
|
|
|
|
|
|
|
name => $name, |
359
|
|
|
|
|
|
|
ttl => TTL, |
360
|
|
|
|
|
|
|
class => $qclass, |
361
|
|
|
|
|
|
|
type => A, |
362
|
|
|
|
|
|
|
address => $ip, |
363
|
|
|
|
|
|
|
); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# CNAME -------------------------------------------------------- |
368
|
0
|
|
|
|
|
|
for my $name ( keys %{ $self->{ CNAME } } ){ |
|
0
|
|
|
|
|
|
|
369
|
0
|
0
|
|
|
|
|
next if $name !~ /$qname/; |
370
|
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
371
|
|
|
|
|
|
|
name => $name, |
372
|
|
|
|
|
|
|
ttl => TTL, |
373
|
|
|
|
|
|
|
class => $qclass, |
374
|
|
|
|
|
|
|
type => CNAME, |
375
|
0
|
|
|
|
|
|
cname => $self->{ CNAME }->{ $name }, |
376
|
|
|
|
|
|
|
); |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# NS ----------------------------------------------------------- |
380
|
0
|
|
|
|
|
|
for my $ns ( @{ $self->{ NS }->{ $qname } } ){ |
|
0
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
push @ans, Net::DNS::RR->new( |
382
|
|
|
|
|
|
|
name => $qname, |
383
|
|
|
|
|
|
|
ttl => TTL, |
384
|
|
|
|
|
|
|
class => IN, |
385
|
|
|
|
|
|
|
type => NS, |
386
|
|
|
|
|
|
|
nsdname => $ns . q/./, |
387
|
|
|
|
|
|
|
); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
# MX ----------------------------------------------------------- |
390
|
0
|
|
|
|
|
|
goto MX; |
391
|
|
|
|
|
|
|
#--------------------------------------------------------------- |
392
|
|
|
|
|
|
|
|
393
|
0
|
|
|
|
|
|
$local = 1; |
394
|
0
|
|
|
|
|
|
$rcode = "NOERROR"; |
395
|
|
|
|
|
|
|
}else{ |
396
|
|
|
|
|
|
|
# poszukujemy informacji o zadanym wezle ----------------------- |
397
|
0
|
0
|
0
|
|
|
|
if( $qtype eq A or $qtype eq PTR or $qtype eq MX or $qtype eq SOA or $qtype eq NS ){ |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
398
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
|
my $q = $self->{ resolv }->send( $query ); |
400
|
|
|
|
|
|
|
|
401
|
0
|
0
|
|
|
|
|
if( $q ){ |
402
|
0
|
|
|
|
|
|
push @ans, $q->answer; |
403
|
0
|
|
|
|
|
|
push @auth, $q->authority; |
404
|
|
|
|
|
|
|
# adres serwera poczty --------------------------------- |
405
|
0
|
0
|
|
|
|
|
if( $qtype eq MX ){ |
406
|
0
|
|
|
|
|
|
my %seen; |
407
|
0
|
|
|
|
|
|
for my $ans ( @ans ){ |
408
|
0
|
0
|
|
|
|
|
my $str = $ans->type eq CNAME ? $ans->cname : $ans->exchange; |
409
|
0
|
|
|
|
|
|
my $res = $self->{ resolv }->query( $str ); |
410
|
0
|
0
|
|
|
|
|
next unless $res; |
411
|
0
|
|
|
|
|
|
for my $ans ( $res->answer ){ |
412
|
0
|
0
|
|
|
|
|
next if $seen{ $ans->name }; |
413
|
0
|
|
|
|
|
|
$seen{ $ans->name } = 1; |
414
|
0
|
|
|
|
|
|
push @add, $ans; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
} |
418
|
0
|
0
|
|
|
|
|
$rcode = scalar( @ans ) ? "NOERROR" : "NXDOMAIN"; |
419
|
|
|
|
|
|
|
}else{ |
420
|
0
|
|
|
|
|
|
$rcode = "NXDOMAIN"; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
}else{ |
423
|
0
|
|
|
|
|
|
$local = 1; |
424
|
0
|
|
|
|
|
|
$rcode = "NOTIMP"; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
#--------------------------------------------------------------- |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# zapis w lokalnej konfiguracji ------------------------------------ |
430
|
0
|
0
|
|
|
|
|
if( $rcode ne 'NOTIMP' ){ |
431
|
0
|
0
|
|
|
|
|
if( $local ){ |
432
|
0
|
|
|
|
|
|
(my $rdom = $qname) =~ s/^[\d\w]+\.//o; # fix it!!! |
433
|
0
|
0
|
0
|
|
|
|
my $dom = ( $qtype eq AXFR || $qtype eq SOA ) ? $qname : $rdom; |
434
|
|
|
|
|
|
|
|
435
|
0
|
0
|
|
|
|
|
if( exists $self->{ NS }->{ $dom } ){ |
436
|
0
|
|
|
|
|
|
for my $ns ( @{ $self->{ NS }->{ $dom } } ){ |
|
0
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
|
438
|
0
|
|
|
|
|
|
push @auth, Net::DNS::RR->new( |
439
|
|
|
|
|
|
|
name => $dom . q/./, |
440
|
|
|
|
|
|
|
ttl => TTL, |
441
|
|
|
|
|
|
|
class => IN, |
442
|
|
|
|
|
|
|
type => NS, |
443
|
|
|
|
|
|
|
nsdname => $ns . q/./, |
444
|
|
|
|
|
|
|
); |
445
|
|
|
|
|
|
|
|
446
|
0
|
0
|
|
|
|
|
my $name = $self->{ CNAME }->{ $ns } ? $self->{ CNAME }->{ $ns } : $ns; |
447
|
0
|
|
|
|
|
|
foreach my $ip ( @{$self->{ A }->{ $name } }, @{ $self->{ AAAA }->{ $name } } ){ |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
448
|
0
|
0
|
|
|
|
|
push @add, Net::DNS::RR->new( |
449
|
|
|
|
|
|
|
name => $ns, |
450
|
|
|
|
|
|
|
ttl => TTL, |
451
|
|
|
|
|
|
|
class => IN, |
452
|
|
|
|
|
|
|
type => $ip =~ /:/o ? AAAA : A, |
453
|
|
|
|
|
|
|
address => $ip, |
454
|
|
|
|
|
|
|
); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
# zewnetrzna nazwa DNS --------------------------------------------- |
460
|
|
|
|
|
|
|
else { |
461
|
0
|
0
|
|
|
|
|
if( scalar( @ans ) ){ |
462
|
0
|
0
|
|
|
|
|
unless( scalar( @auth ) ){ |
463
|
0
|
0
|
0
|
|
|
|
my $str = $qtype eq PTR ? $ans[0]->ptrdname : |
|
|
0
|
|
|
|
|
|
464
|
|
|
|
|
|
|
$qtype eq MX && $ans[0]->type ne CNAME ? $ans[0]->exchange : $qname; |
465
|
|
|
|
|
|
|
|
466
|
0
|
|
|
|
|
|
while( $str =~ /\./o ){ |
467
|
0
|
|
|
|
|
|
my $qry = $self->{ resolv }->query( $str, NS ); |
468
|
0
|
0
|
|
|
|
|
if( $qry ){ |
469
|
0
|
0
|
|
|
|
|
push @auth, $_ for grep { $_->type eq NS or $_->type eq SOA } $qry->answer; |
|
0
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
|
471
|
0
|
|
|
|
|
|
for my $q ( @auth ){ |
472
|
0
|
|
|
|
|
|
my $res = $self->{ resolv }->query( $q->nsdname ); |
473
|
0
|
0
|
|
|
|
|
push @add, $res->answer if $res; |
474
|
|
|
|
|
|
|
} |
475
|
0
|
|
|
|
|
|
last; |
476
|
|
|
|
|
|
|
} |
477
|
0
|
|
|
|
|
|
$str =~ s/^[^\.]+\.//o; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
0
|
|
|
|
|
|
@ans = sort { ref( $b ) cmp ref( $a ) } @ans; |
|
0
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
|
486
|
0
|
0
|
|
|
|
|
my @res = $qtype eq AXFR ? ( $rcode, [ @ans, $ans[0] ], [ ], [ ] ) : ( $rcode, \@ans, \@auth, \@add ); |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# ustawiamy dodatkowe flagi ---------------------------------------- |
489
|
0
|
|
|
|
|
|
my %flags; |
490
|
0
|
0
|
0
|
|
|
|
$flags{ aa } = 1 if $local and scalar( @auth ); |
491
|
0
|
0
|
|
|
|
|
$flags{ ra } = 1 if $self->{ _ra }; |
492
|
0
|
|
|
|
|
|
push @res, \%flags; |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
# zapisujemy odpowiedz w pamieci cache ----------------------------- |
495
|
0
|
|
|
|
|
|
$self->{ cache }->set( $key, \@res ); |
496
|
0
|
|
|
|
|
|
$self->_log_response( $peerhost, $qtype, $qname, \@res ); |
497
|
|
|
|
|
|
|
#------------------------------------------------------------------- |
498
|
|
|
|
|
|
|
|
499
|
0
|
|
|
|
|
|
return @res; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
#======================================================================= |
502
|
|
|
|
|
|
|
sub main_loop { |
503
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
504
|
|
|
|
|
|
|
|
505
|
0
|
|
|
|
|
|
$self->{ log }->DEBUG( 'Starting...' ); |
506
|
0
|
|
|
|
|
|
$self->{ nameserver }->main_loop; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
#======================================================================= |
509
|
|
|
|
|
|
|
1; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=encoding utf8 |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head1 NAME |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Net::DNS::Nameserver::Trivial - Trivial DNS server, that is based on Net::DNS::Nameserver module. |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=head1 SYNOPSIS |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
use Net::DNS::Nameserver::Trivial; |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# Configuration of zone(s) ----------------------------------------- |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
my $zones = { |
525
|
|
|
|
|
|
|
'_' => { |
526
|
|
|
|
|
|
|
'slaves' => '10.1.0.1' |
527
|
|
|
|
|
|
|
}, |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
'A' => { |
530
|
|
|
|
|
|
|
'ns.example.com' => '10.11.12.13', |
531
|
|
|
|
|
|
|
'mail.example.com' => '10.11.12.14', |
532
|
|
|
|
|
|
|
'web.example.com' => '10.11.12.15', |
533
|
|
|
|
|
|
|
'srv.example.com' => '10.11.12.16' |
534
|
|
|
|
|
|
|
}, |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
'AAAA' => { |
537
|
|
|
|
|
|
|
'v6.example.com' => 'fe80::20c:29ff:fee2:ed62', |
538
|
|
|
|
|
|
|
}, |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
'CNAME' => { |
541
|
|
|
|
|
|
|
'srv.example.com' => 'dns.example.com' |
542
|
|
|
|
|
|
|
}, |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
'MX' => { |
545
|
|
|
|
|
|
|
'example.com' => 'mail.example.com' |
546
|
|
|
|
|
|
|
}, |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
'NS' => { |
549
|
|
|
|
|
|
|
'example.com' => 'ns.example.com' |
550
|
|
|
|
|
|
|
}, |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
'SOA' => { |
553
|
|
|
|
|
|
|
'example.com' => 'ns.example.com' |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
}; |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
# Configuration of server ------------------------------------------ |
558
|
|
|
|
|
|
|
my $params = { |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
'FLAGS' => { |
561
|
|
|
|
|
|
|
'ra' => 0, # recursion available |
562
|
|
|
|
|
|
|
}, |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
'RESOLVER' => { |
565
|
|
|
|
|
|
|
'tcp_timeout' => 50, |
566
|
|
|
|
|
|
|
'udp_timeout' => 50 |
567
|
|
|
|
|
|
|
}, |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
'CACHE' => { |
570
|
|
|
|
|
|
|
'size' => 32m, # size of cache |
571
|
|
|
|
|
|
|
'expire' => 3d, # expire time of cache |
572
|
|
|
|
|
|
|
'init' => 1, # clear cache at startup |
573
|
|
|
|
|
|
|
'unlink' => 1, # destroy cache on exit |
574
|
|
|
|
|
|
|
'file' => '../var/lib/cache.db' # cache |
575
|
|
|
|
|
|
|
}, |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
'SERVER' => { |
578
|
|
|
|
|
|
|
'address' => '0.0.0.0', # all interfaces |
579
|
|
|
|
|
|
|
'port' => 53, |
580
|
|
|
|
|
|
|
'verbose' => 0, |
581
|
|
|
|
|
|
|
'truncate' => 1, # truncate too big |
582
|
|
|
|
|
|
|
'timeout' => 5 # seconds |
583
|
|
|
|
|
|
|
}, |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
'LOG' => { |
586
|
|
|
|
|
|
|
'file' => '/var/log/dns/mainlog.log', |
587
|
|
|
|
|
|
|
'level' => 'INFO' |
588
|
|
|
|
|
|
|
}, |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
}; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# Run server ------------------------------------------------------- |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
my $ns = Net::DNS::Nameserver::Trivial->new( $zones, $params ); |
595
|
|
|
|
|
|
|
$ns->main_loop; |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# |
598
|
|
|
|
|
|
|
# ...OR SHORT VERSION with configuration files |
599
|
|
|
|
|
|
|
# |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
use Config::Tiny; |
602
|
|
|
|
|
|
|
use Net::DNS::Nameserver::Trivial; |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
# Read in config of zone ------------------------------------------- |
605
|
|
|
|
|
|
|
my $zones = Config::Tiny->read( '../etc/dom.ini' ); |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
# Read in config of server ----------------------------------------- |
608
|
|
|
|
|
|
|
my $params = Config::Tiny->read( '../etc/dns.ini' ); |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# Run server ------------------------------------------------------- |
611
|
|
|
|
|
|
|
my $ns = Net::DNS::Nameserver::Trivial->new( $zones, $params ); |
612
|
|
|
|
|
|
|
$ns->main_loop; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
=head1 DESCRIPTION |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
The C is a very simple nameserver, that is |
617
|
|
|
|
|
|
|
sufficient for local domains. It supports cacheing, slaves, zone |
618
|
|
|
|
|
|
|
transfer and common records such as A, AAAA, SOA, NS, MX, TXT, PTR, |
619
|
|
|
|
|
|
|
CNAME. This module was tested in an environment with over 1000 users and |
620
|
|
|
|
|
|
|
for now is running in a production environment. |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
The main goal was to produce server, that is very easy in configuration |
623
|
|
|
|
|
|
|
and it can be setup in a few seconds. So You should consider BIND if for |
624
|
|
|
|
|
|
|
some reasons You need more powerful and complex nameserver. |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
This module was prepared to cooperete with C, so it is |
627
|
|
|
|
|
|
|
possible to prepare configuration files and run server with them, |
628
|
|
|
|
|
|
|
as it was shown in an example above. |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=head1 WARNING |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
This version is incompatible with previous versions, because of |
633
|
|
|
|
|
|
|
new format of second configuration file. However modifications are |
634
|
|
|
|
|
|
|
simple. |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
=over 4 |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=item new( $zones, $params ) |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
This is constructor. You have to pass to it hash with configuration of |
643
|
|
|
|
|
|
|
zones and second hash - with configuration for server. |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
The first hash sould contains sections (as shown in a L): |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=over 8 |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=item C<_> |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
This section is a hash, that should contains information of slaves of |
652
|
|
|
|
|
|
|
our server. For example: |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
'_' => { |
655
|
|
|
|
|
|
|
'slaves' => '10.1.0.1' |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=item C |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
This section is a hash, that is a mapping FDQN to IPv4, for example: |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
'A' => { |
664
|
|
|
|
|
|
|
'ns.example.com' => '10.11.12.13', |
665
|
|
|
|
|
|
|
'mail.example.com' => '10.11.12.14', |
666
|
|
|
|
|
|
|
'web.example.com' => '10.11.12.15', |
667
|
|
|
|
|
|
|
'srv.example.com' => '10.11.12.16' |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=item C |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
This section is a hash, that is a mapping FDQN to IPv6, for example: |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
'AAAA' => { |
675
|
|
|
|
|
|
|
'v6.example.com' => 'fe80::20c:29ff:fee2:ed62', |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=item C |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
This section is a hash, that contains information about mail servers |
681
|
|
|
|
|
|
|
for domains. For example, if I is a mail server for |
682
|
|
|
|
|
|
|
domain I, a configuration should looks like this: |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
'MX' => { |
685
|
|
|
|
|
|
|
'example.com' => 'mail.example.com' |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=item C |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
This section is a hash, that contains aliases for hosts. For example, |
691
|
|
|
|
|
|
|
if alias.example.com and alias1.example.com are aliases for a server |
692
|
|
|
|
|
|
|
srv.example.com, a configuration should looks like this: |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
'CNAME' => { |
695
|
|
|
|
|
|
|
'srv.example.com' => 'alias.example.com, alias1.example.com' |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=item C |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
This section is a hash, that contains information about nameservers |
701
|
|
|
|
|
|
|
for a domain. For example: |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
'NS' => { |
704
|
|
|
|
|
|
|
'example.com' => 'ns.example.com' |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=item C |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
This section is a hash, that contains information about authoritative |
710
|
|
|
|
|
|
|
nameserver for a domain. For example: |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
'SOA' => { |
713
|
|
|
|
|
|
|
'example.com' => 'ns.example.com' |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=back |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
The second hash should contains variables sufficient for configuration of |
719
|
|
|
|
|
|
|
server, cache, logs, etc. The meaning of hash elements was shown below. |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=over 8 |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=item C |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
This section describes options of server. |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=over 12 |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=item C |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Timeout for idle connections. |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=item C |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
Local IP address to listen on. Server will be listenting on all |
736
|
|
|
|
|
|
|
interfecas if You specify C<0.0.0.0>. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=item C |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Local port to listen on. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=item C |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
Truncates UDP packets that are to big for the reply |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=item C |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
Be verbose. It is useful only for debugging. |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=back |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=item C |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
This section describes options of server's cache. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=over 12 |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=item C |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
A size of cache, that will be used by server. |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
=item C |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
Expiration time of entries in a cache. It can be diffrent than TTL value. |
765
|
|
|
|
|
|
|
It is effective if makeing of connection to other server is too expensive |
766
|
|
|
|
|
|
|
(i.e. too long). |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=item C |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
Clear cache at startup. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=item C |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
A path to cache file. |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=item C |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
Unlink a cache file on exit. |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=back |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=item C |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
This section describes options of server's log. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=over 12 |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=item C |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
A path to log file. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=item C |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Log level. |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=back |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=item C |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
This section describes options of resolver. |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=over 12 |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
=item C |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
A timeout for TCP connections. |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=item C |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
A timeout for UDP connections. |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=back |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=back |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=item C |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
This method starts main loop of a nameserver. See an example in a SINOPSIS. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=back |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head1 USING CONFIGURATION FILES - examples |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
C was prepared to cooperate with |
825
|
|
|
|
|
|
|
C module. It is possible to prepare configuration files |
826
|
|
|
|
|
|
|
for zones and for server and then make server server run using those |
827
|
|
|
|
|
|
|
files. |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Config file for zone I could looks like this: |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
slaves = 10.1.0.1 |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
[NS] |
834
|
|
|
|
|
|
|
example.com = ns.example.com |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
[SOA] |
837
|
|
|
|
|
|
|
example.com = ns.example.com |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
[MX] |
840
|
|
|
|
|
|
|
example.com = mail.example.com' |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
[AAAA] |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
[CNAME] |
845
|
|
|
|
|
|
|
srv.example.com = alias.example.com, alias1.example.com |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
[A] |
848
|
|
|
|
|
|
|
ns.example.com = 10.11.12.13 |
849
|
|
|
|
|
|
|
mail.example.com = 10.11.12.14 |
850
|
|
|
|
|
|
|
web.example.com = 10.11.12.15 |
851
|
|
|
|
|
|
|
srv.example.com = 10.11.12.16 |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
Config file for server could looks like this: |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
[FLAGS] |
856
|
|
|
|
|
|
|
ra = 0 |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
[RESOLVER] |
859
|
|
|
|
|
|
|
tcp_timeout = 50 |
860
|
|
|
|
|
|
|
udp_timeout = 50 |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
[CACHE] |
863
|
|
|
|
|
|
|
size = 32m |
864
|
|
|
|
|
|
|
expire = 3d |
865
|
|
|
|
|
|
|
init = 1 |
866
|
|
|
|
|
|
|
unlink = 1 |
867
|
|
|
|
|
|
|
file = /var/lib/cache.db |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
[SERVER] |
870
|
|
|
|
|
|
|
address = 0.0.0.0 |
871
|
|
|
|
|
|
|
port = 53 |
872
|
|
|
|
|
|
|
verbose = 0 |
873
|
|
|
|
|
|
|
truncate = 1 |
874
|
|
|
|
|
|
|
timeout = 5 |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
[LOG] |
877
|
|
|
|
|
|
|
file = /var/log/dns/mainlog.log |
878
|
|
|
|
|
|
|
level = INFO |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
And then a code of server shold looks like this: |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
use Config::Tiny; |
883
|
|
|
|
|
|
|
use Net::DNS::Nameserver::Trivial; |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
# Read in config of zone ------------------------------------------- |
886
|
|
|
|
|
|
|
my $zones = Config::Tiny->read( '/path/to/zone/file.ini' ); |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
# Read in config of server ----------------------------------------- |
889
|
|
|
|
|
|
|
my $params = Config::Tiny->read( '/path/to/server/config.ini' ); |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
# Run server ------------------------------------------------------- |
892
|
|
|
|
|
|
|
my $ns = Net::DNS::Nameserver::Trivial->new( $zones, $params ); |
893
|
|
|
|
|
|
|
$ns->main_loop; |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
A complete example is placed in the example directory. |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=over 4 |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
=item Net::IP::XS |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=item Net::DNS |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=item Log::Tiny |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=item List::MoreUtils |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=item Cache::FastMmap |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=item Regexp::IPv6 |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=back |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
None known. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
I'm sure, that they must be there :-) ...but if You found one, give me |
922
|
|
|
|
|
|
|
a feedback. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head1 AUTHOR |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
Strzelecki Ćukasz |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
See http://www.perl.com/perl/misc/Artistic.html |