#!/usr/bin/perl -w

use strict;

use Getopt::Std;
use Time::Local;
use Net::DNS;
use Net::DNS::Update;
use Net::DNS::Resolver;
use MIME::Base64;

use vars qw( %hOpts );

sub _usage
{
  print("bgpo-client.pl  -a <prefix> | -q <prefix> [ -n <name server>][ -p <port>][ -t][ -v][ -h]\n");
  print(" -a :  Add a verification code for a prefix\n");
  print(" -q :  Query for a verification code for a prefix\n");
  print(" -t :  This option allows the interactive specification of Trust anchor key IDs\n");
}

sub _reversePrefix
{
  my $p_sPrefix = shift;

  # Make sure the prefix is a set of number with a cidr length at the end
  if ($p_sPrefix !~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/)
  {
    warn("Prefix must be specified in standard CIDR format (a.b.c.d/e), not: $p_sPrefix");
    $p_sPrefix = undef;
  }
  else
  {
    my @lTarget = ($1, $2, $3, $4, $5);

    # Make sure that the prefix is a set of valid octets and a valid cidr mask.
    if ($1 > 255 || $2 > 255 || $3 > 255 || $4 > 255 || $5 > 32)
    {
      warn("Prefix: $p_sPrefix is not valid");
      $p_sPrefix = undef;
    }
    else
    {
      # Reverse the string.
      $p_sPrefix = $lTarget[4]
                   . "/"
                   . $lTarget[3]
                   . "."
                   . $lTarget[2]
                   . "."
                   . $lTarget[1]
                   . "."
                   . $lTarget[0];
    }
  }

  return $p_sPrefix;
}

sub _getNS
{
  my $p_sZone = shift;
  my @lRet;

  my $oRes = new Net::DNS::Resolver;

  # Get the current NSes
  my $oNsPkt = $oRes->query("bgp-origin.org", "NS");
  if (defined($oNsPkt))
  {
    foreach my $oRR ($oNsPkt->answer())
    {
      # Get the first NS record, and just use that.
      if ($oRR->type() eq "NS")
      {
        push(@lRet, $oRR->nsdname());
      }
    }
  }
  return @lRet;
}

if (!getopts("a:q:n:p:tvh", \%hOpts))
{
  warn("Unable to get options,");
  _usage();
}
# User must either attest to a mapping, or be querying for one.
elsif (!defined($hOpts{'a'}) && !defined($hOpts{'q'}))
{
  warn("Must specify command.");
  _usage();
}
else
{
  my $sNameserver = $hOpts{'n'};
  my $iPort =  $hOpts{'p'};

  my $bVerbose = $hOpts{'v'};

  # If this is an attestation...
  my $sTarget = $hOpts{'a'};
  if (defined($sTarget))
  {
    # For now/simplicity/pending feedback, this script just assumes that
    # we are using GPG
    my $sGpgCmd = `which gpg`;
    chomp($sGpgCmd);

    # You're going to need to sign this, so you need something like GPG.
    if (!defined($sGpgCmd) || "" eq $sGpgCmd || $sGpgCmd =~ /^no/)
    {
      warn("Unable to run without GPG");
    }
    # Reverse the order of the prefix for querying.
    elsif (defined($sTarget = _reversePrefix($sTarget)))
    {
      my $pOldHandle = select(STDOUT);
      $| = 1;
      print("Origin: ");
      my $sOrigins = <STDIN>;
      chomp($sOrigins);
      print("How many days until expiration (0 == no expiration): ");
      my $sExp = <STDIN>;
      chomp($sExp);
      print("Are you specifying:\n1 - trust\n2 - distrust\n3 - revocation of former trust\nPlease enter the number: ");
      my $iCode = <STDIN>;
      chomp($iCode);

      select($pOldHandle);

      # Expiration must be a number of days.
      if ($sExp !~ /^\D+$/)
      {
        $sExp = 0;
      }

      # Code can only be in this ranges.
      if ($iCode =~ /^[^123]$/)
      {
        warn("Code must be 1, 2, or 3");
      }
      # Origins can only be a comma delimited list of ASNs.
      elsif ($sOrigins !~ /^[0-9,]+$/)
      {
        warn("Origin set must be numeric values separated by comas (no spaces).");
      }
      else
      {
        # After passing all the checks above, this is the moment of
        # inception.
        my $iIncep = timegm(localtime());

        # If the user has specified an expiration in days, convert to
        # an absolute timestamp (in UTC time).
        if ($sExp > 0)
        {
          $sExp *= 86400;
          $sExp += $iIncep;
        }

        my $sTmpFile = "/tmp/pski-client-" . time() .".tmp";

        if ($bVerbose)
        {
          system("echo -n '$sTarget $sOrigins $iCode $iIncep $sExp'");
        }

        # Make and format the action/attestation.
        system("echo -n '$sTarget $sOrigins $iCode $iIncep $sExp' | $sGpgCmd -b -a | perl -e '
\$s=<STDIN>;
\$s=<STDIN>;
while(\$s=<STDIN>)
{
  chomp(\$s);
  if (\$s ne \"\")
  {
    if (defined(\$sLast))
    {
      print \$sLast, \" \";
    }
    \$sLast=\$s
  }
}' > $sTmpFile");

        # Create and format the update packet.
        my $oPkt = Net::DNS::Update->new('actions.bgp-origin.org');
        $oPkt->push(update => rr_add("$sTarget.actions.bgp-origin.org 3600 IN TXT \"$sTarget $sOrigins $iCode $iIncep $sExp " . `cat $sTmpFile` . "\""));

        if ($bVerbose)
        {
          $oPkt->print();
        }
        # Create a resolver and use either the nameserver specified by the user
        # or find BGP-Origin's authoritative nameservers.
        my $oRes = Net::DNS::Resolver->new();
        if (defined($sNameserver))
        {
          $oRes->nameserver($sNameserver);
        }
        else
        {
          my @lNS = _getNS();

          if (scalar(@lNS) <= 0)
          {
            warn("Unable to lookup nameservers for bgp-origin.org");
          }
          else
          {
            $oRes->nameservers(@lNS);
          }
        }

        if (defined($iPort))
        {
          $oRes->port($iPort);
        }

        $oRes->udppacketsize(4096);
        my $oResPkt = $oRes->send($oPkt);
        if ($bVerbose && defined($oResPkt))
        {
          $oResPkt->print();
        }

        # Cleanup our tmp file.
        unlink($sTmpFile);
      }
    }
  }
  # Otherwise, this must be a query...
  elsif (defined($sTarget = _reversePrefix($hOpts{'q'})))
  {
    # Create a resolver and use either the nameserver specified by the user
    # or find BGP-Origin's authoritative nameservers.
    my $oRes = Net::DNS::Resolver->new();
    if (defined($sNameserver))
    {
      $oRes->nameserver($sNameserver);
    }
    else
    {
      my @lNs = _getNS();
      $oRes->nameservers(@lNs);
    }

    if (defined($iPort))
    {
      $oRes->port($iPort);
    }

    # Users can specify a list of keys that are the ONLY keys they want to
    # hear from.
    my $sTrustAnchors = undef;

    # Only prompt for trust anchors if the -t option was specified.
    if (defined($hOpts{'t'}))
    {
      my $sTA = undef;
      print("Enter any trust anchors that you would like to use for this query (a blank line terminates the loop).\n");
      print("Trust Anchor Key Fingerprint: ");
      $sTA = <STDIN>;
      chomp($sTA);
      while (defined($sTA) && $sTA ne "")
      {
        if (defined($sTrustAnchors))
        {
          $sTrustAnchors .= " ";
        }
        $sTrustAnchors .= $sTA;
        print("Trust Anchor Key Fingerprint: ");
        $sTA = <STDIN>;
        chomp($sTA);
      }
    }

    # Create and format query packet.
    my $oPkt = Net::DNS::Packet->new("$sTarget.actions.bgp-origin.org.", "TXT", "IN");
    # If the user specified any trust anchors, add them to the additional section.
    if (defined($sTrustAnchors))
    {
      $oPkt->push(additional => Net::DNS::RR->new("require.bgp-origin.org. 60 IN TXT \"$sTrustAnchors\""));
    }

    my $oRetPkt = $oRes->send($oPkt);
    $oRetPkt->print();
  }
}