view release on metacpan or  search on metacpan

lib/App/Regather/Plugin/nsupdate.pm  view on Meta::CPAN

# -*- mode: cperl; mode: follow; -*-
#

package App::Regather::Plugin::nsupdate;

=head1 NAME

nsupdate - RFC2136 complaint DNS zone update

=cut

=head1 DESCRIPTION

plugin to update dynamis DNS zone

logics is this:

    1. get target ip address from LDAP obj
    2. get name server/s from reverse zone for network, ip belongs to
    3. get list of zones to be updated
    3.1. from config file
         first ns_zone record is used for PTR

    3.2. from reverse zone TXT records
         get TXT records from reverse zone for network, ip belongs to, and
         a) here we assume, all related zones are served by the same name server/s
         b) each TXT record to suply zone names, should be prefixed

            prefix format is: `PART1:PART2:` where
            PART1 is config file value for 'service' -> 'service-name' -> 'ns_txt_pfx'
            PART2 is index number 0-9 to prioritize zones (0 is the highest priority)
            both parts should end with colon character

            so, zone name in TXT record value starts with offset = length(PART1)+3

            zone with priority 0 is used for PTR
         c) reverse zone name is pushed to the end of list of zones to be updated

    4. check existance and get if exist, A and PTR records for LDAP obj
    4.1. if not exists, then add new either record and return
    4.2. if exists, then check them against LDAP obj data
    4.2.1. if match, then return
    4.2.2. if not match then delete allr records and -> 4.1.

=cut

use strict;
use warnings;
use diagnostics;

use Data::Printer caller_info => 1, class => { expand => 2 }; # temporary stuff, to be removed

use Socket;
use Net::DNS;
use Net::DNS::RR::TSIG;
use Net::LDAP;
use Net::LDAP::Constant qw( LDAP_SYNC_ADD
			    LDAP_SYNC_MODIFY
			    LDAP_SYNC_DELETE );

use constant { UPDATE_UNKNOWN => 0,
	       UPDATE_SUCCESS => 1,
	       UPDATE_ERROR   => 2  };

=head1 METHODS

=head2 new

Creates an instance of the class and saves a reference to its
arguments for further use.

=cut

sub new {
  my $class = shift;
  local %_ = %{$_[0]};

  $_{log}->cc( pr => 'debug', fm => "%s: service %s; called for dn: %s",
	       ls => [ sprintf("%s:%s",__FILE__,__LINE__), $_{s}, $_{obj}->dn, ] ) if $_{v} > 2;

  my $ns_txt_pfx = $_{cf}->get('service', $_{s}, 'ns_txt_pfx');
  my $re    = qr/^$ns_txt_pfx/;
  my $ip    = (split(/ /, $_{obj}->get_value('umiOvpnCfgIfconfigPush')))[0]; # add check for empty
  my $ptr_z = sprintf("%s.in-addr.arpa",
		      join('.', splice( @{[ reverse( @{[ split(/\./, $ip) ]} ) ]},
					1)
			   )
		     );

  my $resolver = new Net::DNS::Resolver;
  my ( @z, @zones, $query, $zone, @rr, @servers );

  if ($_{cf}->is_set('service', $_{s}, 'ns_zone')) {
    push @zones, $_{cf}->get('service', $_{s}, 'ns_zone');
  } else {
    $query = $resolver->query($ptr_z, "TXT");
    if ($query) {