File Coverage

blib/lib/Net/DNS/Nameserver/Trivial.pm
Criterion Covered Total %
statement 63 261 24.1
branch 0 92 0.0
condition 0 64 0.0
subroutine 21 28 75.0
pod 2 2 100.0
total 86 447 19.2


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