#!/usr/bin/perl
# Script to help manage dns through cloudflare rest api
# http://www.cloudflare.com/docs/client-api.html
#
# jason jorgensen <jasonj@innominatus.com>
# 10-09-2012 - initial version
# 10-25-2012 - added 'add' action

$apiurl = 'https://www.cloudflare.com/api_json.html';
$apitkn = '';                           # api token provided from https://www.cloudflare.com/my-account.html
$apiemail = 'example@domain.com';       # login email address, also used to log in to account via web
@domains = ('domain.com');              # list of domains you have with cloudflare

$debug = 0;

if (! $ARGV[0]) {
  print "Usage: $0 <action> (action arguments space delimited)\n";
  print "  Configured, valid domains: @domains\n";
  print "  Examples: $0 list\n";
  print "            $0 list domain=$domains[0]\n";
  print "            $0 list domain=$domains[0] output=bind # output all the existing records in a bind-ish format\n";
  print "            $0 list domain=$domains[0] output=json # output all the existing records in json format\n";
  print "            $0 add domain=$domains[0] type=A sub=testrecord value=127.0.0.1 mode=1   # create a new 'A' record where cloudflare will proxy\n";
  print "            $0 add domain=$domains[0] type=MX sub=testmail value=127.0.0.1 priority=10 mode=0   # create a new 'MX' record where cloudflare will not proxy\n";
  print "            $0 delete domain=$domains[0] type=A sub=testrecord # delete a record with a sub\n";
  print "            $0 delete domain=$domains[0] id=634354764 # delete a single record with id\n";
  print "\n";
  print "  Note: raw output (default) is terse json format\n";
  print "        json output is human readable json format\n";
  print "\n";
  print "  Actions:\n";
  print "    list   : domain=$domains[0]\n";
  print "             output=[raw, bind, csv, json]\n";
  print "    add    : domain=$domains[0]\n";
  print "             type=[A, CNAME, MX, NS, TXT]\n";
  print "             sub=www or mail\n";
  print "             priority=10\n";
  print "             value=271.23.51.83 or example.com\n";
  print "    delete : domain=$domains[0]\n";
  print "             sub=www or mail\n";
  print "             id=35907682 or 35924682\n";
  exit 1;
}

# use perl modules
use URI::Escape;
use LWP::UserAgent;
use HTTP::Request::Common qw/GET POST/;
use JSON;
use Net::DNS;
if ($debug) { use Data::Dumper; }

# defaults
$output = "raw";

# store action arguments
$action = $ARGV[0];
print "DEBUG: action: $action\n" if $debug;
print "DEBUG: \$\#ARGV: ".$#ARGV."\n" if $debug;
for ($c=1;$c<=$#ARGV;$c++){
  print "DEBUG: ARGV[$c]: $ARGV[$c]\n" if $debug;
  ($key, $value) = split ('=', $ARGV[$c]);
  $args{$key} = $value;
  if ($key eq "output") { $output = $value; }
  if ($key eq "domain") { @domains = ($value); }
  if ($key eq "type") { $type = ($value); }
  if ($key eq "sub") { $sub = ($value); }
  if ($key eq "id") { $id = ($value); }
  if ($key eq "value") { $content = ($value); }
  if ($key eq "priority") { $priority = ($value); }
  if ($key eq "mode") { $mode = ($value); }
}
print "DEBUG: ".Dumper(%args)."\n" if $debug > 1;

$ua = new LWP::UserAgent;
$ua->agent('Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/28.0.1500.71 Safari/537.36'); # cloudflare started bitching about libwww-perl as the user agent... whatever
$ua->timeout(10);


if ($action eq "list") {
  &action_list()
}
elsif ($action eq "add") {
  &action_add()
}
elsif ($action eq "delete") {
  &action_delete()
}

exit;

sub action_add {
  if (! $domains[0]) {
    print "Please specify a domain as argument, 'domain=example.com'\n";
  }
  if (! $type) {
    print "Please specify a record type as argument, 'type=[A, CNAME, MX, NS, TXT, SRV]'\n";
  }
  if (! $sub) {
    print "Please specify a subdomain name as argument, 'sub=www' or 'sub=mail.office' or 'sub=ar_fre.photos'\n";
  }
  if (! $content) {
    print "Please specify a value for your record type as argument, 'value=1.2.3.4' or 'value=fully.qualified.domain.name'\n";
  }
  if (! $mode) { $mode = 0; }

  # curl API POST URL example
  # curl https://www.cloudflare.com/api_json.html \
  #   -d 'a=rec_new' \
  #   -d 'tkn=8afbe6dea02407989af4dd4c97bb6e25' \
  #   -d 'email=sample@example.com' \
  #   -d 'z=example.com' \
  #   -d 'type=A'
  #   -d 'name=sub'
  #   -d 'content=1.2.3.4'
  #   -d 'service_mode=1'
  #
  if ($domains[0] && $type && $sub && $content) {
    if ($priority) {
      $req = POST $apiurl, [ tkn          => $apitkn,
                             email        => $apiemail,
                             a            => 'rec_new',
                             z            => $domains[0],
                             ttl          => 1,
                             type         => $type,
                             name         => $sub,
                             content      => $content,
                             prio         => $priority,
                           ];
    }
    else {
      $req = POST $apiurl, [ tkn          => $apitkn,
                             email        => $apiemail,
                             a            => 'rec_new',
                             z            => $domains[0],
                             ttl          => 1,
                             type         => $type,
                             name         => $sub,
                             content      => $content,
                           ];
    }
    $response = $ua->request($req)->content;
    print "DEBUG: raw content: $response\n" if $debug;

    ($recid) = $response =~ /\"rec_id\":\"(\d+)\"/;
    print "DEBUG: new record id: $recid\n";
    if ($mode > 0) {
      # service mode is whether or not cloudflare will cache content for that subdomain, but it cant be set from a rec_add, only rec_edit apparently.
      # curl https://www.cloudflare.com/api_json.html \
      #   -d 'a=rec_edit' \
      #   -d 'tkn=8afbe6dea02407989af4dd4c97bb6e25' \
      #   -d 'id=9001' \
      #   -d 'email=sample@example.com' \
      #   -d 'z=example.com' \
      #   -d 'type=A'
      #   -d 'name=sub'
      #   -d 'content=1.2.3.4'
      #   -d 'service_mode=1'
      #   -d 'ttl=1'


      $req = POST $apiurl, [ tkn          => $apitkn,
                             email        => $apiemail,
                             a            => 'rec_edit',
                             z            => $domains[0],
                             id           => $recid,
                             ttl          => 1,
                             type         => $type,
                             name         => $sub,
                             content      => $content,
                             service_mode => $mode,
                           ];
    }
    $response .= $ua->request($req)->content;
    print "DEBUG: raw content: $response\n" if $debug;

  }
  $type = "raw";
  &dooutput($output, $domain, $response)

}

sub action_delete {
  if (! $domains[0]) {
    print "Please specify a domain as argument, 'domain=example.com'\n";
  }
  if ($sub) {
    $decoded = &jsonoutput($domains[0], &all_records);
    foreach $obj (@{$decoded->{response}{recs}{objs}}) {
      if ($obj->{display_name} eq $sub) {
        $sub_id = $obj->{rec_id};
        $sub_name = $obj->{display_name};
      }
    }
    if (! $sub_id) {
      print "That subdomain name does not have an associated id, therefore cant be deleted.\n";
    }
  }

  if ($id) {
    $sub_id = $id;
    $decoded = &jsonoutput($domains[0], &all_records);
    foreach $obj (@{$decoded->{response}{recs}{objs}}) {
      if ($obj->{rec_id} eq $id) {
        $sub_name = $obj->{display_name};
      }
    }
    if (! $sub_name) {
      print "That id does not have an associated subdomain name, therefore cant be deleted.\n";
    }
  }

  if (! $sub_id) {
    print "Please specify a subdomain name or id as argument, 'sub=www' or 'sub=mail.office' or 'id=123465243'\n";
  }
  

  # curl API POST URL example
  # curl https://www.cloudflare.com/api_json.html \
  #   -d 'a=rec_delete'
  #   -d 'tkn=8afbe6dea02407989af4dd4c97bb6e25' \
  #   -d 'email=sample@example.com' \
  #   -d 'z=example.com'
  #   -d 'id=9001'

  if ($domains[0] && $sub_id && $sub_name) {
    $req = POST $apiurl, [ tkn          => $apitkn,
                           email        => $apiemail,
                           a            => 'rec_delete',
                           z            => $domains[0],
                           id           => $sub_id,
                         ];
    print "DEBUG: delete request for name, id: $sub_name, $sub_id\n" if $debug;
    $response = 'debug' if $debug;
    $response = $ua->request($req)->content if ! $debug;
    print "DEBUG: raw content: $response\n" if $debug;

    $type = "raw";
    &dooutput($output, $domain, $response)
  }

}

sub action_list {
  $response = &all_records();
  &dooutput($output, $domain, $response);
}

#subs

sub all_records {
  $c = 0;   # using this to limit the number of requests to just 5 incase there is a problem with the queries. find a nicer way to catch this
  $maxc = 10;
  $pagination = 0;
  #$response = '"has_more":true';
  $response = undef;
  until ($c >= $maxc) {
    foreach $domain (@domains) {
      # curl API POST URL example
      # curl https://www.cloudflare.com/api_json.html \
      #   -d 'a=rec_load_all' \
      #   -d 'tkn=8afbe6dea02407989af4dd4c97bb6e25' \
      #   -d 'email=sample@example.com' \
      #   -d 'z=example.com
      $req = POST $apiurl, [ tkn    => $apitkn,
                             email  => $apiemail,
                             a      => 'rec_load_all',
                             z      => $domain,
                             o      => $pagination,
                           ];
      $newresponse = $ua->request($req)->content;

      # if the api says there are no more records, end the loop
      if ($newresponse =~ /\"has_more\"\:false/) { $c = $maxc; }

      # if there was an error then end the loop
      if ($newresponse =~ /\"result\"\:\"error\"/) { $c = $maxc; }

      # add current count to pagination offset
      ($count) = ($newresponse =~ /\"count\":(\d+)/);
      $pagination += $count;
      #print "DEBUG: pagination: $pagination\n";

      if ($response) {
        # get the count from the new content

        # if there is already some content, i have to take on more objects to existing json output

        # first get rid of the previous contents closing section
        $response =~ s/\]\}\}\,\"result\"\:\"success\"\,\"msg\"\:null\}/,/;

        # then remove the new contents beginning section
        $newresponse =~ s/.*?"objs"\:\[//;
      }
      $response .= $newresponse;
      print "DEBUG: raw content: $response\n" if $debug;
  
    }
#exit;
    $c++;
  }
  return $response;
}

sub dooutput {
  my $type = shift;
  my $domain = shift;
  my $response = shift;

  if ($type eq "json") { print Dumper(&jsonoutput($domain, $response)); }
  elsif ($type eq "csv") { print &csvoutput($domain, $response); }
  elsif ($type eq "bind") { print &bindoutput($domain, $response); }
  else { print &rawoutput($domain, $response)."\n"; }

}


sub rawoutput {
  my $domain = shift;
  my $raw = shift;
  return $raw;
}

sub csvoutput {
  # this is json full output selectively displayed in csv
  my $domain = shift;
  my $raw = shift;

  $csv = '"name","type","content","priority","id","cached"'."\n";
  my $decoded = &jsonoutput($domain, $raw);
  print "DEBUG: output back from jsonoutput: $decoded\n" if $debug;
  print "DEBUG: decoded->{response}{recs}{count}: ".$decoded->{response}{recs}{count}."\n" if $debug;
  foreach $obj (@{$decoded->{response}{recs}{objs}}) {
    print "DEBUG: name: ".$obj->{name}."\n" if $debug;
    $csv .= '"'.$obj->{name}.'","'.$obj->{type}.'","'.$obj->{content}.'","'.$obj->{prio}.'","'.$obj->{rec_id}.'","'.$obj->{service_mode}.'"'."\n";
  }

  return $csv;
}

sub jsonoutput {
  my $domain = shift;
  my $encoded = shift;

  $json = new JSON;
  $decodedjson = $json->decode($encoded);

  return $decodedjson;
}

sub bindoutput {
  my $domain = shift;
  my $raw = shift;

#  my $res   = Net::DNS::Resolver->new;
#  my $query = $res->query("example.com", "NS");
#
#  if ($query) {
#      foreach $rr (grep { $_->type eq 'NS' } $query->answer) {
#          print $rr->nsdname, "\n";
#      }
#  }
#  else {
#      warn "query failed: ", $res->errorstring, "\n";
#  }

  $bind = "; SOA Record\n";
  $bind .= "$domain.	3600	IN	SOA	ns1.$domain.	ns2.$domain. (\n";
  $bind .= "		".time()."\n";
  $bind .= "		28800\n";
  $bind .= "		7200\n";
  $bind .= "		604800\n";
  $bind .= "		86400\n";
  $bind .= "		) \n";
  $bind .= "\n";

  my $decoded = &jsonoutput($domain, $raw);
  print "DEBUG: output back from jsonoutput: $decoded\n" if $debug;
  print "DEBUG: decoded->{response}{recs}{count}: ".$decoded->{response}{recs}{count}."\n" if $debug;
  foreach $obj (@{$decoded->{response}{recs}{objs}}) {
    print "DEBUG: name: ".$obj->{name}."\n" if $debug;
    $bind .= $obj->{display_name}."\t".$obj->{ttl}."\t".$obj->{type}."\t".$obj->{prio}."\t".$obj->{content}."\t; id: ".$obj->{rec_id}. " cached: ".$obj->{service_mode}."\n";
  }

  return $bind;


}














