view release on metacpan or  search on metacpan

lib/Net/DNS/Create/Route53.pm  view on Meta::CPAN

    map { $set{$_} } keys %set;
}

my @domain;
sub _domain() { @domain } # Hook for testing
sub domain($$) {
    my ($package, $domain, $entries) = @_;

    my @entries = map { ;
                        my $rr = lc $_->type;

                        $rr eq 'soa' ? () : # Amazon manages its own SOA stuff. Just ignore things we might have.
                        $rr eq 'rp'  ? (warn("Amazon doesn't support RP records :-(") && ()) :

                        $rr eq 'a' || $rr eq 'mx' || $rr eq 'ns' || $rr eq 'srv' || $rr eq 'txt' ? () : # Handled specially, below

                        +{
                          action => 'create',
                          name   => $_->name.'.',
                          ttl    => $_->ttl,
                          type   => uc $rr,
                          $rr eq 'cname' ? (value => $_->cname.'.') :
                          (err => warn "Don't know how to handle \"$rr\" RRs yet.")

                         }
                    } @$entries;

    # Amazon wants all NS,MX,TXT and SRV entries for a particular name in one of their entries. We get them in as
    # separate entries so first we have to group them together.
    push @entries, map { my @set = @$_;
                         my $rr = lc $set[0]->type;
                         $rr eq 'ns' && $set[0]->name.'.' eq $domain ? () : # Amazon manages its own NS stuff. Just ignore things we might have.
                         +{
                           action => 'create',
                           name   => $set[0]->name.'.',
                           ttl    => $set[0]->ttl,
                           type   => uc $rr,
                           $rr eq 'a'     ? (records => [map { $_->address } @set]) :
                           $rr eq 'mx'    ? (records => [map { $_->preference." ".$_->exchange.'.' } @set]) :
                           $rr eq 'ns'    ? (records => [map { $_->nsdname.'.' } @set] ) :
                           $rr eq 'srv'   ? (records => [map { $_->priority ." ".$_->weight ." ".$_->port ." ".$_->target.'.' } @set]) :
                           $rr eq 'txt'   ? (records => [map { join ' ', txt($_->char_str_list) } @set]) :
                           (err => die uc($rr)." can't happen here!")
                          }
                       } group_by_type_and_name(qr/^(?:mx|ns|srv|txt|a)$/, $entries);

    push @domain, { name => $domain,
                    entries => \@entries };
}

my $counter = rand(1000);
sub master() {
    my ($package) = @_;
    local $|=1;

    for my $domain (@domain) {
        my $zone = hosted_zone(full_host($domain->{name}));
        if (!$zone && scalar @{$domain->{entries}}) {
            my $hostedzone = Net::Amazon::Route53::HostedZone->new(route53 => r53,
                                                                   name => $domain->{name},
                                                                   comment=>(getpwuid($<))[0].'/'.__PACKAGE__,
                                                                   callerreference=>__PACKAGE__."-".localtime."-".($counter++));
            print "New Zone: $domain->{name}...";
            $hostedzone->create();
            $zone = $hostedzone;
            print "Created. Nameservers:\n".join('', map { "  $_\n" } @{$zone->nameservers});
        }

        if ($zone) {
            my $current = [ grep { $_->type ne 'SOA' && ($_->type ne 'NS' || $_->name ne $domain->{name}) } @{$zone->resource_record_sets} ];
            my $new = [ map { Net::Amazon::Route53::ResourceRecordSet->new(%{$_},
                                                                           values => [$_->{value} // @{$_->{records}}],
                                                                           route53 => r53,
                                                                           hostedzone => $zone) } @{$domain->{entries}} ];
            printf "%s: %d -> %d\n", $domain->{name}, scalar @$current, scalar @$new;
            my $change = scalar @$current > 0 ? r53->atomic_update($current,$new) :
                         scalar @$new     > 0 ? r53->batch_create($new)           :
                                                undef;

            unless (scalar @{$domain->{entries}}) {
                print "Deleting $domain->{name}\n";
                $zone->delete;
            }
        }
    }
}

sub domain_list($@) {
    my $zone = hosted_zone(full_host($_[0]));
    printf "%-30s %-30s %s\n", $zone ? $zone->id : '', $_[0], !$zone ? '' : ' ['.join(" ",@{$zone->nameservers}).']';
}

sub master_list($$) {
    # This doesn't really make sense in the route53 context
}

1;
__END__

=head1 NAME

Net::DNS::Create::Route53 - Amazon AWS Route53 backend for Net::DNS::Create

=head1 SYNOPSIS

 use Net::DNS::Create qw(Route53), default_ttl => "1h",
                                   amazon_id => "AKIxxxxxxx",
                                   amazon_key => "kjdhakjsfnothisisntrealals";

 domain "example.com", { %records };

 master;

=head1 DESCRIPTION

You should never use B<Net::DNS::Create::Route53> directly. Instead pass "Route53"
to B<< L<Net::DNS::Create> >> in the "use" line.

=head1 OPTIONS

The following options are specific to B<Net::DNS::Create::Route53>: