# Author: dmrz
package IPAMUserAgent;
our $VERSION = "1.05";

=head1 NAME

IPAMUserAgent - Helper module for IPAM WAPI scripts written in Perl

=head1 CONFIGURATION

Module parameters can be automatically read from environment variables and/or
(using Config::Simple) from a config file like this:

 IPAM_WAPI https://ipam.illinois.edu/wapi/v2.7.3
 IPAM_USERNAME janedoe
 IPAM_PASSWORD correcthorsebatterystaple
 IPAM_USE_GPG_AGENT 0

You can also supply these parameters to the constructor (e.g. after reading the
values from somewhere else).

=head1 SYNOPSIS

 use IPAMUserAgent;
 use JSON qw( decode_json );

 my $ua = IPAMUserAgent->new();
 #my $ua = IPAMUserAgent->new(IPAM_CONFIG_FILE => "/path/to/config");

 $ua->timeout(180);  # see LWP::UserAgent

 $ua->debug_enable(1);

 my $WAPI = $ua->wapi;

 my $existing_hosts_for_fqdn = decode_json
   $ua->get( "$WAPI/record:host?name:=$fqdn" )
     ->decoded_content;

=head1 DEPENDENCIES

Requires (and inherits from) LWP::UserAgent, optionally uses Config::Simple.

=head1 SEE ALSO

add_host_ip.pl (example script which uses this module)

LWP::UserAgent

=cut

use warnings;
use strict;
use Carp;

use LWP::UserAgent;
use parent qw(LWP::UserAgent);

# Initialize (first invocation only) and return configuration hashref
sub _cfg {
  my $self = shift;
  my %overrides = @_;

  unless ($self->{IPAMUserAgent_cfg}) {
    my %cfg =
      (# Location of config file (defaults to ~/.ipam_config)
       "IPAM_CONFIG_FILE" => $overrides{IPAM_CONFIG_FILE} || $ENV{IPAM_CONFIG_FILE} || "$ENV{HOME}/.ipam_config",

       # WAPI base URL including version
       "IPAM_WAPI" => undef,

       # IPAM credentials (if unset, will prompt user)
       "IPAM_USERNAME" => undef,
       "IPAM_PASSWORD" => undef,

       # If set to 1 (or any other true value), then instead of
       # prompting for password in tty, we'll try to request it from a
       # running gpg-agent (using gpg-connect-agent, which must be in
       # your path).  This provides a way to cache your password
       # across multiple script invocations without storing it in a
       # file or environment variable.  Safety not guaranteed; use at
       # your own risk.
       "IPAM_USE_GPG_AGENT" => 0,
      );

    # read config file, overriding defaults
    if (-r $cfg{IPAM_CONFIG_FILE}) {
      if (eval { require Config::Simple; 1; }) {
	Config::Simple->import_from($cfg{IPAM_CONFIG_FILE}, \%cfg) or die Config::Simple->error();
      } else {
	warn "Found $cfg{IPAM_CONFIG_FILE} but can't load Config::Simple";
      }
    }

    # environment variables and manual overrides supersede config file
    foreach (keys %cfg) {
      $cfg{$_} = $ENV{$_} if exists $ENV{$_};
      $cfg{$_} = $overrides{$_} if exists $overrides{$_};
    }

    $self->{IPAMUserAgent_cfg} = \%cfg;
  }

  return $self->{IPAMUserAgent_cfg};
}

# Returns a new LWP::UserAgent with helpful customizations for making IPAM WAPI
# requests.  %options may include key/value pairs for IPAM_* parameters (which
# will override any values read from environment or config file) as well as
# standard LWP::UserAgent->new options.
sub new {
  my $class = shift;
  my %options = @_;

  my %ipam_overrides = map { $_ => delete $options{$_} }
    (grep { /^IPAM_/ } keys %options);

  my $self = $class->SUPER::new(%options);

  # Initialize configuration
  $self->_cfg(%ipam_overrides);

  # Creating a cookie jar lets us automatically use the ibapauth
  # cookie for subsequent requests in the same session
  $self->cookie_jar({});

  # Automatically croak when a WAPI request fails (not counting the
  # first 401 response before we have sent an Authorization header)
  $self->add_handler
    (response_done => sub {
       my($response, $ua, $h) = @_;
       my $request = $response->request;

       return if $response->is_success;
       return if ($response->code == 401 and not $request->header("Authorization"));

       # Report error from caller's point of view
       local %Carp::Internal;
       $Carp::Internal{$_} = 1 foreach (qw( LWP::UserAgent LWP::Authen::Basic ));
       croak "WAPI ".$request->method." request for '".$request->uri
         ."' failed with '".$response->status_line."':\n".$response->decoded_content."\n";
     });

  return $self;
}

# Adds handlers to print each request and successful response to
# STDERR for debugging
sub debug_enable {
  my $self = shift;
  my ($level) = @_;
  $level = 1 unless defined $level;
  if ($level >= 2) {
    $self->add_handler
      (request_prepare => sub {
         my($request, $ua, $h) = @_;
         warn "DEBUG REQUEST: ".$request->dump(maxlength=>0)."\n";
       });
    $self->add_handler
      (response_done => sub {
         my($response, $ua, $h) = @_;
         if ($response->is_success) {
           warn "DEBUG RESPONSE: \n".$response->dump(maxlength=>0)."\n";
         }
       });
  } else {
    $self->add_handler
      (request_prepare => sub {
         my($request, $ua, $h) = @_;
         warn "DEBUG REQUEST: ".$request->method." ".$request->uri."\n".
           $request->content."\n";
       });
    $self->add_handler
      (response_done => sub {
         my($response, $ua, $h) = @_;
         if ($response->is_success) {
           warn "DEBUG RESPONSE: ".$response->decoded_content."\n";
         }
       });
    }
}

# Returns WAPI base URL, for use in constructing requests
sub wapi {
  return (shift->_cfg->{IPAM_WAPI} or die "IPAM_WAPI is not set (in environment or config file)");
}

# overrides LWP::UserAgent callback method to provide username and password
# from configuration, gpg-agent, and/or prompting for input
sub get_basic_credentials {
  my ($self, $realm, $uri) = @_;
  my $netloc = $uri->host_port;

  my ($username, $password) = @{$self->_cfg}{qw( IPAM_USERNAME IPAM_PASSWORD )};

  ## prompt user for unknown username and/or password

  until($username) {
    die "IPAM_USERNAME not set, can't prompt" unless -t;
    print STDERR "Enter username for $netloc: ";
    chomp($username = <STDIN>);
    # don't use preconfigured password without preconfigured username
    undef $password;
  }

  until($password) {
    if ($self->_cfg->{IPAM_USE_GPG_AGENT}) {
      # Try to ask gpg-agent for a password.  See
      # https://www.gnupg.org/documentation/manuals/gnupg/Agent-GET_005fPASSPHRASE.html
      if ($ENV{GPG_AGENT_INFO}) {
        my $principal = "${username}\@${netloc}";
        $principal =~ s/[^\w\-\.:@]//g;  # remove any undesirable characters
        my $gpgagentcmd = "get_passphrase IPAM:$principal X X $principal";
        my $pwhex = `gpg-connect-agent '$gpgagentcmd' '/bye'`;
        $pwhex =~ /OK (.*)/ and $password = pack("H*", $1);
      } else {
        warn "GPG_AGENT_INFO not found in environment; try running 'gpg-agent --daemon' first?";
      }
    }
    unless ($password) {
      die "IPAM_PASSWORD not set, can't prompt" unless -t;
      system "stty -echo";
      print STDERR "Enter password for $username on $netloc: ";
      chomp($password = <STDIN>);
      print STDERR "\n";  # because we disabled echo
      system "stty echo";
    }
  }

  return ($username, $password);
}


1;