File Coverage

blib/lib/Net/Duo.pm

Criterion	Covered	Total	%
statement	100	115	86.9
branch	14	26	53.8
condition	7	14	50.0
subroutine	17	17	100.0
pod	3	3	100.0
total	141	175	80.5

# Perl interface for the Duo multifactor authentication service.
#
# This Perl module collection provides a Perl interface to the Duo multifactor
# authentication service (https://www.duosecurity.com/).  It differs from the
# Perl API sample code in that it abstracts some of the API details and throws
# rich exceptions rather than requiring the caller deal with JSON data
# structures directly.
#
# This module is intended primarily for use as a base class for more
# specialized Perl modules implementing the specific Duo APIs, but it can also
# be used directly to make generic API calls.

package Net::Duo 1.01;

use 5.014;
use strict;
use warnings;

use Carp qw(croak);
use Digest::SHA qw(hmac_sha1_hex);
use HTTP::Request;
use JSON ();
use LWP::UserAgent 6.00;
use Net::Duo::Exception;
use Perl6::Slurp;
use POSIX qw(strftime);
use URI::Escape qw(uri_escape_utf8);

# All dies are of constructed objects, which perlcritic misdiagnoses.
## no critic (ErrorHandling::RequireCarping)

##############################################################################
# Constructor
##############################################################################

# Create a new Net::Duo object, which will be used for subsequent calls.
#
# $class - Class of object to create
# $args  - Anonymous hash of arguments with the following keys:
#   api_hostname    - API hostname for the Duo API integration
#   integration_key - Public key for the Duo API integration
#   key_file        - Path to file with integration information
#   secret_key      - Secret key for the Duo API integration
#   user_agent      - User agent object to use instead of LWP::UserAgent
#
# Returns: Newly-created object
#  Throws: Net::Duo::Exception on any failure
sub new {
    my ($class, $args_ref) = @_;
    my $self = {};

    # Load integration information from key_file if set.
    my $keys;
    if ($args_ref->{key_file}) {
        my $json     = JSON->new->relaxed(1);
        my $key_data = slurp($args_ref->{key_file});
        $keys = eval { $json->decode($key_data) };
        if ($@) {
            die Net::Duo::Exception->propagate($@);
        }
    }

    # Integration data from $args_ref overrides key_file data.
    for my $key (qw(api_hostname integration_key secret_key)) {
        $self->{$key} = $args_ref->{$key} // $keys->{$key};
        if (!defined($self->{$key})) {
            my $error = "missing parameter to Net::Duo::new: $key";
            die Net::Duo::Exception->internal($error);
        }
    }

    # Create or set the user agent object.
    $self->{agent} = $args_ref->{user_agent} // LWP::UserAgent->new;

    # Create the JSON decoder that we'll use for subsequent operations.
    $self->{json} = JSON->new->utf8(1);

    # Bless and return the new object.
    bless($self, $class);
    return $self;
}

##############################################################################
# General methods
##############################################################################

# Internal method to canonicalize the arguments.  The Duo API requires that
# all data be URL-encoded and then either used as GET arguments or sent in the
# POST body.
#
# $self     - Net::Duo object
# $args_ref - Reference to hash of arguments (may be undef)
#
# Returns: URL-encoded string representing those arguments
#          undef if there are no arguments
sub _canonicalize_args {
    my ($self, $args_ref) = @_;

    # Return undef if there are no arguments.
    return if !defined($args_ref);

    # Encode the arguments into a list of key and value pairs.
    my @pairs;
    while (my ($key, $value) = each %{$args_ref}) {
        my $encoded_key   = uri_escape_utf8($key);
        my $encoded_value = uri_escape_utf8($value);
        my $pair          = $encoded_key . q{=} . $encoded_value;
        push(@pairs, $pair);
    }

    # Return the arguments joined with &.
    return join(q{&}, sort(@pairs));
}

# Internal method to sign a Duo API call and stores the appropriate
# Authorization header in the HTTP::Request.  For the signature specification,
# see the Duo API documentation.
#
# $self    - Net::Duo object
# $request - HTTP::Request object that will be used for the call
# $path    - URI path for the REST endpoint
# $args    - URI-encoded arguments to the call
#
# Returns: undef
sub _sign_call {
    my ($self, $request, $path, $args) = @_;
    my $date   = $request->header('Date');
    my $method = uc($request->method);
    my $host   = $self->{api_hostname};

    # Generate the request information that should be signed.
    my $data = join("\n", $date, $method, $host, $path, $args // q{});

    # Generate a SHA-1 HMAC as the signature.
    my $signature = hmac_sha1_hex($data, $self->{secret_key});

    # The HTTP Basic Authentication username is the integration key.
    my $username = $self->{integration_key};

    # Set the Authorization header.
    $request->authorization_basic($username, $signature);
    return;
}

# Make a generic Duo API call with no assumptions about its return data type.
# This returns the raw HTTP::Response object without any further processing.
# For most Duo APIs, use call_json instead, which assumes that the call
# returns JSON in a particular structure and checks the status of the HTTP
# response.
#
# $self     - Net::Duo object
# $method   - HTTP method (GET, PUT, POST, or DELETE)
# $path     - URL path to the REST endpoint to call
# $args_ref - Reference to a hash of additional arguments
#
# Returns: The HTTP::Response object from the API call
#  Throws: Net::Duo::Exception on any failure
sub call {
    my ($self, $method, $path, $args_ref) = @_;
    my $host = $self->{api_hostname};
    my $args = $self->_canonicalize_args($args_ref);
    $method = uc($method);

    # Verify that the URL path starts with a slash.
    if ($path !~ m{ \A / }xms) {
        my $error = "REST endpoint '$path' does not begin with /";
        die Net::Duo::Exception->internal($error);
    }

    # Set up the request.
    my $request = HTTP::Request->new;
    $request->method($method);
    $request->protocol('HTTP/1.1');
    $request->date(time());
    $request->header(Host => $host);

    # Use an undocumented feature of LWP::Protocol::https to ensure that the
    # certificate subject is from duosecurity.com.  This header is not passed
    # to the remote host, only used internally by LWP.
    my $subject_regex = qr{ CN=[^=]+ [.] duosecurity [.] com \z }xms;
    $request->header('If-SSL-Cert-Subject' => $subject_regex);

    # Sign the request.
    $self->_sign_call($request, $path, $args);

    # For POST and PUT, send the arguments as form data.  Otherwise, add them
    # to the path as GET parameters.
    if ($method eq 'POST' || $method eq 'PUT') {
        $request->content_type('application/x-www-form-urlencoded');
        $request->content($args);
        $request->uri('https://' . $host . $path);
    } elsif (!defined($args)) {
        $request->uri('https://' . $host . $path);
    } else {
        $request->uri('https://' . $host . $path . q{?} . $args);
    }

    # Make the request and return the response.
    return $self->{agent}->request($request);
}

# Make a generic Duo API call that returns JSON and do the return status
# checking that's common to most of the Duo API calls.  There are a few
# exceptions, like /logo, which do not return JSON and therefore cannot be
# called using this method).
#
# $self     - Net::Duo object
# $method   - HTTP method (GET, PUT, POST, or DELETE)
# $path     - URL path to the REST endpoint to call
# $args_ref - Reference to a hash of additional arguments
#
# Returns: Reference to hash corresponding to the JSON result
#  Throws: Net::Duo::Exception on any failure
sub call_json {
    my ($self, $method, $path, $args_ref) = @_;

    # Use the simpler call() method to do most of the work.  This returns the
    # HTTP::Response object.  Retrieve the content of the response as well.
    my $response = $self->call($method, $path, $args_ref);
    my $content = $response->decoded_content;

    # If the content was empty, we have a failure of some sort.
    if (!defined($content)) {
        if ($response->is_success) {
            die Net::Duo::Exception->protocol('empty response');
        } else {
            die Net::Duo::Exception->http($response);
        }
    }

    # Otherwise, try to decode the JSON.  If we cannot, treat this as an
    # HTTP failure if we didn't get success and a protocol failure
    # otherwise.
    my $data = eval { $self->{json}->decode($content) };
    if ($@) {
        if ($response->is_success) {
            my $error = 'invalid JSON in reply';
            die Net::Duo::Exception->protocol($error, $content);
        } else {
            die Net::Duo::Exception->http($response);
        }
    }

    # Check whether the API call succeeded.  If not, throw an exception.
    if (!defined($data->{stat}) || $data->{stat} ne 'OK') {
        die Net::Duo::Exception->api($data, $content);
    }

    # Return the response portion of the reply.
    if (!defined($data->{response})) {
        my $error = 'no response key in JSON reply';
        die Net::Duo::Exception->protocol($error, $content);
    }
    return $data->{response};
}

1;
__END__