File Coverage

blib/lib/DNS/SerialNumber/Check.pm
Criterion Covered Total %
statement 18 57 31.5
branch 0 10 0.0
condition 0 6 0.0
subroutine 6 12 50.0
pod 2 2 100.0
total 26 87 29.8


line stmt bran cond sub pod time code
1             package DNS::SerialNumber::Check;
2              
3 1     1   30138 use 5.006;
  1         5  
  1         38  
4 1     1   6 use warnings;
  1         3  
  1         28  
5 1     1   5 use strict;
  1         7  
  1         43  
6 1     1   1177 use Net::DNS;
  1         118268  
  1         127  
7 1     1   11 use Carp qw/croak/;
  1         3  
  1         49  
8              
9 1     1   5 use vars qw/$VERSION/;
  1         2  
  1         545  
10             $VERSION = '0.02';
11              
12             sub new {
13 0     0 1   my $class = shift;
14 0           bless {},$class;
15             }
16              
17             sub check {
18 0     0 1   my $self = shift;
19 0   0       my $zone = shift || croak "no zone provided";
20 0           my $nameservers = shift;
21 0           my %serial;
22              
23 0 0         if (defined $nameservers ) {
24 0 0         if (ref $nameservers ne "ARRAY") {
25 0           croak "nameservers must be an array reference";
26             }
27 0           for (@$nameservers) {
28 0           my $re = $self->_qrsoa($zone,$_);
29 0           $serial{$_} = $re;
30             }
31             } else {
32 0           my $res = Net::DNS::Resolver->new;
33 0           my $answer = $res->query($zone, 'NS');
34 0 0         if (defined $answer) {
35 0           my @rr= $answer->answer;
36 0           for (@rr) {
37 0           my $ns = $_->rdatastr;
38 0           my $re = $self->_qrsoa($zone,$ns);
39 0           $serial{$ns} = $re;
40             }
41             }
42             }
43              
44 0           my %result;
45 0           $result{info} = \%serial;
46 0           my %rev = reverse %serial;
47 0           my @keys = keys %rev;
48 0 0 0       $result{status} = ($keys[0] && @keys == 1) ? 1 : 0;
49            
50 0           DNS::SerialNumber::Check::Result->new(\%result);
51             }
52              
53             sub _qrsoa {
54 0     0     my $self = shift;
55 0           my $zone = shift;
56 0           my $host = shift;
57 0           my $res = Net::DNS::Resolver->new(nameservers => [$host]);
58 0           my $query = $res->query($zone, "SOA");
59 0 0         defined $query ? ($query->answer)[0]->serial : '';
60             }
61              
62              
63             package DNS::SerialNumber::Check::Result;
64              
65             sub new {
66 0     0     my $class = shift;
67 0           my $result = shift;
68            
69 0           bless $result,$class;
70             }
71              
72             sub status {
73 0     0     my $self = shift;
74 0           $self->{status};
75             }
76              
77             sub info {
78 0     0     my $self = shift;
79 0           $self->{info};
80             }
81              
82             1;
83              
84              
85             =head1 NAME
86              
87             DNS::SerialNumber::Check - check the consistency of a zone's DNS serial number
88              
89             =head1 VERSION
90              
91             Version 0.02
92              
93              
94             =head1 SYNOPSIS
95              
96             use DNS::SerialNumber::Check;
97              
98             my $sn = DNS::SerialNumber::Check->new;
99             my $re = $sn->check("example.com"); # or,
100             my $re = $sn->check("example.com",['ns1.example.com','ns2.example.com']);
101              
102             print $re->status;
103             use Data::Dumper;
104             print Dumper $re->info;
105              
106              
107             =head1 METHODS
108              
109             =head2 new()
110              
111             Initialize the object.
112              
113             my $sn = DNS::SerialNumber::Check->new;
114              
115             =head2 check(zonename,[nameservers])
116              
117             Check if the zone serial number in each nameserver for the given zonename is consistent.
118              
119             my $re = $sn->check("example.com"); # or,
120             my $re = $sn->check("example.com",['ns1.example.com','ns2.example.com']);
121              
122             The first will check from the zone's default nameservers (from its NS records).
123             The second will check from the specified nameservers you provided.
124              
125             =head2 status()
126              
127             Shows the status code within the result, 1 for OK, 0 for BAD.
128              
129             print $re->status;
130              
131             =head2 info()
132              
133             A hashref, shows each nameserver of the zone with the serial number.
134              
135             use Data::Dumper;
136             print Dumper $re->info;
137              
138              
139             =head1 SEE ALSO
140              
141             Net::DNS
142              
143              
144             =head1 AUTHOR
145              
146             Ken Peng
147              
148              
149             =head1 BUGS/LIMITATIONS
150              
151             If you have found bugs, please send email to
152              
153              
154             =head1 SUPPORT
155              
156             You can find documentation for this module with the perldoc command.
157              
158             perldoc DNS::SerialNumber::Check
159              
160              
161             =head1 COPYRIGHT & LICENSE
162              
163             Copyright 2011 Ken Peng, all rights reserved.
164              
165             This program is free software; you can redistribute it and/or modify
166             it under the same terms as Perl itself.