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