#!/usr/bin/env perl
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Net::Amazon::Route53;
use Getopt::Long;
use Pod::Usage;

# Show help page or man
my $man  = 0;
my $help = 0;

# Either keyfile + friendly name
my $keyfile = $ENV{HOME} . '/.aws-secrets';
my $keyname = '';

# Or key and id
my $key = '';
my $id  = '';

# Other options, command-specific
my %options = (
    comment         => '',
    callerreference => '',
    wait            => 0,
    type            => '',
    name            => '',
    ttl             => '',
);
my (@_value);

GetOptions(
    'help|?'    => \$help,
    'man'       => \$man,
    'keyfile=s' => \$keyfile,
    'keyname=s' => \$keyname,
    'key=s'     => \$key,
    'id=s'      => \$id,

    'comment=s'         => \$options{comment},
    'callerreference=s' => \$options{callerreference},
    'wait'              => \$options{wait},
    'type=s'            => \$options{type},
    'name=s'            => \$options{name},
    'ttl=s'             => \$options{ttl},
    'value=s'           => \@_value,

) or pod2usage(1);
$options{value} = \@_value;
pod2usage(1) if $help;
pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;

pod2usage("Either provide a keyname/keyfile, or a key/id\n") if ( !length $keyname and ( !length $key or !length $id ) );
if ( length $keyname ) {
    pod2usage("Need a keyfile when a keyname is given\n") if ( !length $keyfile );
    die("No such keyfile: $keyfile\n") if ( !-f $keyfile );
    my $keyfile_contents = do {
        local $/;
        open my $f, '<', $keyfile or die "Cannot open $keyfile for reading: $!";
        my $tmp = <$f>;
        close $f or die "Cannot close $keyfile: $!";
        $tmp;
    };
    my %awsSecretAccessKeys;
    eval "$keyfile_contents" or die "Cannot parse $keyfile\'s contents.\n";
    die("No such friendly key $keyname in $keyfile\n")      if !exists $awsSecretAccessKeys{$keyname};
    die("Friendly key $keyname in $keyfile misses 'id'\n")  if !exists $awsSecretAccessKeys{$keyname}{id};
    die("Friendly key $keyname in $keyfile misses 'key'\n") if !exists $awsSecretAccessKeys{$keyname}{key};
    $id      = $awsSecretAccessKeys{$keyname}{id};
    $key     = $awsSecretAccessKeys{$keyname}{key};
    $keyfile = $keyname = '';
}
if ( length $key or length $id ) {
    pod2usage("Both id and key must be given\n") if ( !length $key or !length $id );
}

pod2usage("Need an action") if ( !@ARGV );

my %actions = (
    'list'        => \&do_list,
    'nameservers' => \&do_nameservers,
    'zone'        => \&do_zone,
    'record'      => \&do_record,
);
my $action = shift @ARGV;
pod2usage("Need an action\nUse route53 --help to list the allowed actions") unless defined $action;
pod2usage("Unrecognised action: $action\nUse route53 --help to list the allowed actions")unless exists $actions{$action};
pod2usage("Resource Record name need to end in a dot") if $options{name} and $options{name} !~ /\.$/;
pod2usage("Resource Record TTL need to be numeric") if $options{ttl} and $options{ttl} !~ /^\d+$/;

my $route53 = Net::Amazon::Route53->new( id => $id, key => $key );

my $outcome = $actions{$action}->( $route53, @ARGV );
print $outcome;

sub do_list
{
    my $route53      = shift;
    my @hosted_zones = $route53->get_hosted_zones();
    return "No hosted zones associated with this account\n" if !@hosted_zones;
    my $output = '';
    for my $hosted_zone (@hosted_zones) {
        $output .= "Hosted zone:\n";
        $output .= "  id: " . $hosted_zone->id . "\n";
        $output .= "  name: " . $hosted_zone->name . "\n";
        $output .= "  callerreference: " . $hosted_zone->callerreference . "\n";
        $output .= "  comment: " . $hosted_zone->comment . "\n";
    }
    return $output;
}

sub do_nameservers
{
    my $route53      = shift;
    my $which        = shift;
    my @hosted_zones = $route53->get_hosted_zones($which);
    return "No hosted zones associated with this account\n" if ( !$which and !@hosted_zones );
    return "No such hosted zone $which\n"                   if ( $which  and !@hosted_zones );
    my $output = '';
    for my $hosted_zone (@hosted_zones) {
        if ( !$which ) {
            $output .= "Hosted zone:\n";
            $output .= "  id: " . $hosted_zone->id . "\n";
            $output .= "  name: " . $hosted_zone->name . "\n";
            $output .= "  callerreference: " . $hosted_zone->callerreference . "\n";
            $output .= "  comment: " . $hosted_zone->comment . "\n";
        }
        my @nameservers = @{ $hosted_zone->nameservers };
        for my $nameserver (@nameservers) {
            $output .= ( $which ? '' : '  nameserver: ' ) . "$nameserver\n";
        }
    }
    return $output;
}

sub do_zone
{
    my $route53 = shift;
    my $which   = shift;
    die "Need a zone or action name\n" if !$which;

    # actions
    if ( $which eq 'create' ) {
        my $zone = shift;
        die "Need a zone name to create\n" if !$zone;
        die "Zone needs to end in a dot\n" if $zone !~ /\.$/;
        $options{callerreference} = sprintf( "%s-%s-%s", $zone, time, $$ )
          if !length $options{callerreference};
        print
          "Creating new zone '$zone'\n",
          "  comment:          '$options{comment}'\n",
          "  caller reference: '$options{callerreference}'\n";
        my $new_zone = Net::Amazon::Route53::HostedZone->new(
            route53         => $route53,
            name            => $zone,
            comment         => $options{comment},
            callerreference => $options{callerreference},
        );
        eval { $new_zone->create( wait => $options{wait}, @_ ) }
          or die "Could not create zone $zone: $@\n";
        return "Zone created\n";
    }
    if ( $which eq 'delete' ) {
        my $zone = shift;
        die "Need a zone name to delete\n" if !$zone;
        die "Zone needs to end in a dot\n" if $zone !~ /\.$/;
        my @hosted_zones = $route53->get_hosted_zones($zone);
        return "No such hosted zone $zone\n" if ( !@hosted_zones );
        eval { $hosted_zones[0]->delete( wait => $options{wait}, @_ ) }
          or die "Could not delete zone $zone: $@\n";
        return "Zone deleted\n";
    }

    # Not an action; bail out if it doesn't look like a zone
    die "Unrecognised action/zone $which\n" if ( $which !~ /\.$/ );

    do_nameservers( $route53, $which );
}

sub do_record
{
    my $route53 = shift;
    my $which   = shift;
    die "Need a zone or action name\n" if !$which;

    # actions
    if ( $which eq 'list' or $which =~ /\.$/ ) {
        my $zone = ($which =~ /\.$/ ? $which : shift );
        die "Need a zone name to list\n"   if !$zone;
        die "Zone needs to end in a dot\n" if $zone !~ /\.$/;
        my @hosted_zones = $route53->get_hosted_zones($zone);
        return "No such hosted zone $zone\n" if ( !@hosted_zones );
        my $output = '';
        for my $rrs ( @{ $hosted_zones[0]->resource_record_sets() } ) {
            next if $options{type} and uc($rrs->type) ne uc($options{type});
            next if $options{ttl} and $rrs->ttl ne $options{ttl};
            if ( @{$options{value}} and @{$options{value}} > 0 ) {
                next if !scalar grep { my $v = $_; scalar grep { $_ eq $v } @{$options{value}} } @{ $rrs->values };
            }
            next if $options{name} and $rrs->name ne $options{name};
            $output .= sprintf("%s %s %s %s\n",
                $rrs->name,
                $rrs->type,
                $rrs->ttl,
                join(' ', @{$rrs->values}),
            );
        }
        return $output;
    }
    if ( $which eq 'delete' ) {
        my $zone = shift;
        die "Need a zone name to delete\n" if !$zone;
        die "Zone needs to end in a dot\n" if $zone !~ /\.$/;
        my @hosted_zones = $route53->get_hosted_zones($zone);
        return "No such hosted zone $zone\n" if ( !@hosted_zones );

        my @records = @{ $hosted_zones[0]->resource_record_sets() };
        @records = grep { $_->name eq $options{name} } @records if length $options{name};
        # weed out by record type, ttl, and value
        @records = grep { $_->type eq $options{type} } @records if $options{type};
        @records = grep { $_->ttl eq $options{ttl} } @records if length $options{ttl};
        if ( @{ $options{value} } ) {
            @records = grep { my $r = $_; grep { my $v = $_; scalar grep { $_ eq $v } @{$options{value}} } @{ $r->values } } @records;
        }
        die "No record matches\n" if (!@records);
        die "Too many records match:\n", join(
            "\n",
            map {
                sprintf( "%s %s %s %s", $_->name, $_->type, $_->ttl, join( ' ', @{ $_->values } ) )
              } @records
          ),
          "\n"
          if @records > 1;
        eval { $records[0]->delete( wait => $options{wait}, @_ ) }
          or die "Could not delete record: $@\n";
        return "Record deleted\n";
    }
    if ( $which eq 'create' ) {
        my $zone = shift;
        die "Need a zone name to create a record for\n" if !$zone;
        die "Zone needs to end in a dot\n" if $zone !~ /\.$/;
        my @hosted_zones = $route53->get_hosted_zones($zone);
        return "No such hosted zone $zone\n" if ( !@hosted_zones );
        my @errors;
        push @errors, "Need a --name for the new record\n" if !length $options{name};
        push @errors, "Need a --ttl for the new record\n" if !length $options{ttl};
        push @errors, "Need a --type for the new record\n" if !length $options{type};
        push @errors, "Need one or more --value for the new record\n" if !@{$options{value}};
        push @errors, "Unrecognised --type for record: $options{type}\n"
            if ( length $options{type} and $options{type} !~ /^(A|AAAA|CNAME|MX|NS|PTR|SOA|SPF|SRV|TXT)$/i );
        die join('',@errors) if @errors;
        my $new_record = Net::Amazon::Route53::ResourceRecordSet->new(
            route53 => $route53,
            hostedzone => $hosted_zones[0],
            name => $options{name},
            ttl => $options{ttl},
            type => uc $options{type},
            values => $options{value},
        );
        eval { $new_record->create( wait => $options{wait}, @_ ) }
          or die "Could not create record: $@\n";
        return "Record created\n";
    }

    # Not an action
    die "Unrecognised action $which\n";
}

__END__

=head1 NAME

route53 - Manage your DNS entries on Amazon's Route53 service

=head1 DESCRIPTION

B<route53> will manage your Amazon Route 53 account

=head1 SYNOPSIS

route53 {key and id} [options] action [action arguments]

Either C<-keyfile> and C<-keyname> or C<-id> and C<-key> must be provided.

=head2 OPTIONS

=over 8

=item B<-keyfile>

The file which contains the keys and ids for the Route53 service,
in the format used by Amazon's "route53.pl" script:

    %awsSecretAccessKeys = (
        "my-aws-account" => {
            id => "ABCDEFG",
            key => "12345",
        },
    );

Defaults to C<~/.aws-secrets> when not given.

=item B<-keyname>

The name of the key to be used; in the above C<-keyfile> example,
it could be C<my-aws-account>.

=item B<-id>

The AWS id to be used; in the above example it could be
C<ABCDEFG>.

=item B<-key>

The AWS key to be used; in the above example it could be
C<12345>.

=item B<-wait>

For the commands which support it, waits for the change requested to be in
C<INSYNC> status before returning.  This is done by querying for the change
status every 2 seconds until the change is C<INSYNC>. Defaults to 0, meaning
the requests return immediately.

=item B<-help>

Prints the help page and exits

=item B<-man>

Prints the manual page and exits

=back

=head1 ARGUMENTS

B<route53> performs a number of B<actions>, each of which may take
a number of arguments:

=over 8

=item B<list>

Lists the hosted zones currently associated with the account.
Takes no arguments.

=item B<nameservers>

Lists the nameservers for all the hosted zones currently associated with the
account. Takes a hosted zone name as an optional argument to just show the
nameservers associated with that zone.

=item B<zone>

Performs actions on a specific DNS zone. If a zone name is given, rather than
an action, it shows the nameservers associated with the zone.

Possible actions are:

=over 8

=item B<create>

Needs C<--comment> and optional C<--callerreference>. Creates a new zone.
Supports the C<--wait> option.

=item B<delete>

Deletes the zone. The zone needs to be empty (containing only NS and SOA
entries) before Amazon's Route53 allows its deletion. Supports the C<--wait>
option.

=back

=item B<record>

Performs actions on a specific DNS zone record. A DNS zone name must be given.
If no action is provided, it lists all records for the zone.

Possible actions are:

=over 8

=item B<list>

This is the default action if no action is specified. Lists all DNS records for
the zone.

If a C<--type> is given, it lists only the records of the given type.
If a C<--name> is given, it lists only the records which have the given name.
If a C<--ttl> is given, it lists only the records which have the given TTL.
If a C<--value> is given, it lists only the records which have a value matching the given one.

Wildcard records (i.e. C<*.example.com>) are displayed as C<\052.example.com>.
The same format must be used to create a wildcard record.

=item B<delete>

Deletes one DNS record for the zone given. Can only delete a record which
is univocally identified by filtering the records list by C<--name>, C<--type>,
C<--ttl> and C<--value>. Dies listing the matching records if too many entries
match. Supports the C<--wait> option.

=item B<create>

Creates a DNS record for the zone given. Needs all the following options
in order to create the record: C<--name>, C<--type>, C<--ttl> and one or
more C<--value>. Supports the C<--wait> option.

=back

=back

=head1 EXAMPLES

=head2 Specify your credentials

You need to specify your credentials with one of the following notations.
All the examples below use the C<--keyname> notation, defaulting to using
the C<~/.aws-secrets> file.

    # Uses ~/.aws-secrets as repository, key name is specified
    $ route53 --keyname my-aws-keyname

    # Uses the given key file and key name
    $ route53 --keyfile ~/.aws --keyname my-aws-keyname

    # Uses the given key and id
    $ route53 --key ABCDE --id DEFG

=head2 List your zones

Lists the zones names, ids and comments:

    $ route53 --keyname my-aws-account list
    Hosted zone:
      id: /hostedzone/ABCDEFG
      name: example.com.
      callerreference: FGHIJK
      comment: Zone for example.com.
    Hosted zone:
      id: /hostedzone/FGHJKL
      name: anotherexample.com.
      callerreference: QWERTY
      comment: Zone for anotherexample.com.

=head2 Get all nameservers (and details) for all zones

Displays a verbose list of the zone details and the nameservers
which are authoritative for the zone:

    $ route53 --keyname my-aws-account nameservers
    Hosted zone:
      id: /hostedzone/ABCDEFG
      name: example.com.
      callerreference: FGHIJK
      comment: Zone for example.com.
      nameserver: ns-123.awsdns-123.com
      nameserver: ns-123.awsdns-123.co.uk
      nameserver: ns-123.awsdns-123.org
    Hosted zone:
      id: /hostedzone/FGHJKL
      name: anotherexample.com.
      callerreference: QWERTY
      comment: Zone for anotherexample.com.
      nameserver: ns-456.awsdns-456.com
      nameserver: ns-456.awsdns-456.co.uk
      nameserver: ns-456.awsdns-456.org

=head2 Get just the nameservers for a specific zone

Displays a terse list of the nameservers, one per line:

    $ route53 --keyname my-aws-account nameservers example.com.
    ns-123.awsdns-123.com
    ns-123.awsdns-123.co.uk
    ns-123.awsdns-123.org

This allows the nameservers to be used in scripting:

    $ for nameserver in
        $( route53 --keyname my-aws-account nameservers example.com. );
      do
        # do whatever you want with $nameserver
      done;

=head2 Create a new zone

Creates a new zone:

    $ route53 --keyname my-aws-account zone create example.com. \
        --comment 'Zone for example.com.'
        --callerreference 'unique id for this'

You can optionally specify C<--wait> to wait for the zone to have been
effectively created. Otherwise the command returns as soon as the request
has been sent to Route 53.

=head2 Delete a zone

Deletes a zone (assuming the zone contains only C<SOA> and C<NS> records):

    $ route53 --keyname my-aws-account zone delete example.com.

You can optionally specify C<--wait> to wait for the zone to have been
effectively deleted. Otherwise the command returns as soon as the request
has been sent to Route 53.

=head2 List all DNS records for a zone

Lists all DNS records for a zone:

    $ route53 --keyname my-aws-account record list example.com.
    example.com. A 14400 127.0.0.1
    example.com. MX 14400 127.0.0.1
    example.com. NS 172800 ns-123.awsdns-123.com. ns-123.awsdns-123.co.uk. ns-123.awsdns-123.org.
    example.com. SOA 900 ns-123.awsdns-123.com. awsdns-hostmaster.amazon.com. 1 7200 900 1209600 86400
    \052.example.com. A 300 127.0.0.1

You can optionally specify C<--type> to display only DNS records of a given type:

    $ route53 --keyname my-aws-account record list example.com. --type A
    example.com. A 14400 127.0.0.1
    \052.example.com. A 300 127.0.0.1

=head2 Delete a specific DNS record for a zone

This example assumes we want to remove the C<\052.example.com.> entry.  One can
check which parameters are needed to get the correct entry with the
C<record list> first:

    $ route53 --keyname my-aws-account record list example.com. --type A
    example.com. A 14400 127.0.0.1
    \052.example.com. A 300 127.0.0.1
    $ route53 --keyname my-aws-account record list example.com. --type A --ttl 300
    \052.example.com. A 300 127.0.0.1

Or can read the error message given in case there are too many matching records:

    $ route53 --keyname my-aws-account record delete example.com. --type A
    Too many records match:
    example.com. A 14400 127.0.0.1
    \052.example.com. A 300 127.0.0.1

The lone record deletion:

    $ route53 --keyname my-aws-account record delete example.com. --type A --ttl 300

=head2 Create a new DNS record for the zone

This adds a new record for the zone:

    $ route53 --keyname my-aws-account record create example.com. \
        --name test.example.com. --type A --ttl 300 \
        --value 127.0.0.1

=cut

=head1 AUTHOR

Marco FONTANI <mfontani@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Marco FONTANI.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut