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