File Coverage

blib/lib/Metabrik/Server/Dns.pm
Criterion Covered Total %
statement 9 42 21.4
branch 0 16 0.0
condition 0 6 0.0
subroutine 3 5 60.0
pod 1 2 50.0
total 13 71 18.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # server::dns Brik
5             #
6             package Metabrik::Server::Dns;
7 1     1   582 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         528  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             hostname => [ qw(listen_hostname) ],
21             port => [ qw(listen_port) ],
22             a => [ qw(a_hash) ],
23             aaaa => [ qw(aaaa_hash) ],
24             cname => [ qw(cname_hash) ],
25             mx => [ qw(mx_hash) ],
26             ns => [ qw(ns_hash) ],
27             soa => [ qw(soa_hash) ],
28             recursive_mode => [ qw(0|1) ],
29             cache_file => [ qw(cache_file) ],
30             _dns => [ qw(INTERNAL) ],
31             },
32             attributes_default => {
33             hostname => '127.0.0.1',
34             port => 2053,
35             recursive_mode => 1,
36             cache_file => 'cache.db',
37             },
38             commands => {
39             start => [ qw(listen_hostname|OPTIONAL listen_port|OPTIONAL) ],
40             },
41             require_modules => {
42             'Net::DNS::Nameserver::Trivial' => [ ],
43             },
44             };
45             }
46              
47             sub start {
48 0     0 0   my $self = shift;
49 0           my ($hostname, $port) = @_;
50              
51 0   0       $hostname ||= $self->hostname;
52 0   0       $port ||= $self->port;
53              
54 0           my $zones = {
55             '_' => {
56             slaves => '8.8.4.4',
57             },
58             };
59              
60 0           my $a = $self->a;
61 0 0         if (defined($a)) {
62 0           $zones->{A} = $a;
63             }
64              
65 0           my $aaaa = $self->aaaa;
66 0 0         if (defined($aaaa)) {
67 0           $zones->{AAAA} = $aaaa;
68             }
69              
70 0           my $cname = $self->cname;
71 0 0         if (defined($cname)) {
72 0           $zones->{CNAME} = $cname;
73             }
74              
75 0           my $mx = $self->mx;
76 0 0         if (defined($mx)) {
77 0           $zones->{MX} = $mx;
78             }
79              
80 0           my $ns = $self->ns;
81 0 0         if (defined($ns)) {
82 0           $zones->{NS} = $ns;
83             }
84              
85 0           my $soa = $self->soa;
86 0 0         if (defined($soa)) {
87 0           $zones->{SOA} = $soa;
88             }
89              
90 0 0         my $params = {
91             FLAGS => {
92             ra => $self->recursive_mode,
93             },
94             RESOLVER => {
95             tcp_timeout => 50,
96             udp_timeout => 50,
97             },
98             CACHE => {
99             size => '32m', # size of cache
100             expire => '1d', # expire time of cache
101             init => 1, # clear cache at startup
102             unlink => 1, # destroy cache on exit
103             file => $self->datadir.'/'.$self->cache_file, # cache
104             },
105             SERVER => {
106             address => $hostname,
107             port => $port,
108             verbose => $self->log->level > 2 ? 1 : 0,
109             truncate => 1, # truncate too big
110             timeout => 5, # seconds
111             },
112             LOG => {
113             file => '/dev/null',
114             level => 'INFO'
115             },
116             };
117              
118 0           my $dns;
119 0           eval {
120 0           $dns = Net::DNS::Nameserver::Trivial->new($zones, $params);
121             };
122 0 0         if ($@) {
123 0           chomp($@);
124 0           return $self->log->error("start: Net::DNS server failed: is port [$port] already listening?");
125             }
126              
127              
128 0           $self->log->verbose("start: listening on [$hostname:$port]");
129              
130 0           return $self->_dns($dns)->main_loop;
131             }
132              
133             1;
134              
135             __END__