File Coverage

blib/lib/WebService/SSLLabs.pm

Criterion	Covered	Total	%
statement	74	109	67.8
branch	12	24	50.0
condition	0	6	0.0
subroutine	16	22	72.7
pod	9	9	100.0
total	111	170	65.2

package WebService::SSLLabs;

use strict;
use warnings;
use JSON();
use URI::Escape();
use LWP::UserAgent();
use WebService::SSLLabs::Info();
use WebService::SSLLabs::Host();
use WebService::SSLLabs::Endpoint();
use WebService::SSLLabs::StatusCodes();

our $VERSION = '0.33';

sub _MINIMUM_ETA_TIME { return 10; }

sub new {
    my ($class) = @_;
    my $self = {};
    bless $self, $class;
    $self->{url} = 'https://api.ssllabs.com/api/v2/';
    $self->{ua}  = LWP::UserAgent->new();
    $self->{ua}->env_proxy();
    return $self;
}

sub _parse_success {
    my ( $self, $response ) = @_;
    $self->{max_assessments} =
      $response->headers()->header('X-Max-Assessments');
    $self->{current_assessments} =
      $response->headers()->header('X-Current-Assessments');
    return;
}

sub max_assessments {
    my ($self) = @_;
    return $self->{max_assessments};
}

sub current_assessments {
    my ($self) = @_;
    return $self->{current_assessments};
}

sub info {
    my ($self)   = @_;
    my $url      = $self->{url} . 'info';
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        $self->_parse_success($response);
        return WebService::SSLLabs::Info->new(
            JSON::decode_json( $response->decoded_content() ) );
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

sub _translate_params {
    my ( $self, %params ) = @_;
    my %translated_params;
    foreach my $key ( sort { $a cmp $b } sort keys %params ) {
        if ( defined $params{$key} ) {
            my $translated_key = $key;
            $translated_key =~ s/_([[:lower:]])/uc $1/egsmx;
            $translated_params{$translated_key} = $params{$key};
        }
    }
    return %translated_params;
}

sub analyze {
    my ( $self, %params ) = @_;
    my %translated_params = $self->_translate_params(%params);
    my $url               = $self->{url} . 'analyze?' . (
        join q[&],
        map {
                URI::Escape::uri_escape_utf8($_) . q[=]
              . URI::Escape::uri_escape_utf8( $translated_params{$_} )
        } sort _sort_ssllabs_params keys %translated_params
    );
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        $self->_parse_success($response);
        my $host = WebService::SSLLabs::Host->new(
            JSON::decode_json( $response->decoded_content() ) );
        $self->{_previous_host} = $host;
        return $host;
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
    return;
}

sub previous_eta {
    my ($self) = @_;
    my $eta = _MINIMUM_ETA_TIME();
    if ( $self->{_previous_host} ) {
        my $host_eta = $self->{_previous_host}->eta();
        if (   ( defined $host_eta )
            && ( $host_eta =~ /^\d+$/smx )
            && ( $host_eta >= $eta ) )
        {
            $eta = $host_eta;
        }
    }
    return $eta;
}

sub _sort_ssllabs_params {
    if ( $a eq 'host' ) {
        return -1;
    }
    elsif ( $b eq 'host' ) {
        return 1;
    }
    if ( $a eq 's' ) {
        return -1;
    }
    elsif ( $b eq 's' ) {
        return 1;
    }
    else {
        return $a cmp $b;
    }
}

sub get_endpoint_data {
    my ( $self, %params ) = @_;
    my %translated_params = $self->_translate_params(%params);
    my $url               = $self->{url} . 'getEndpointData?' . (
        join q[&],
        map {
                URI::Escape::uri_escape_utf8($_) . q[=]
              . URI::Escape::uri_escape_utf8( $translated_params{$_} )
        } sort _sort_ssllabs_params keys %translated_params
    );
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        $self->_parse_success($response);
        return WebService::SSLLabs::Endpoint->new(
            JSON::decode_json( $response->decoded_content() ) );
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

sub get_status_codes {
    my ($self)   = @_;
    my $url      = $self->{url} . 'getStatusCodes';
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        $self->_parse_success($response);
        return WebService::SSLLabs::StatusCodes->new(
            JSON::decode_json( $response->decoded_content() ) );
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

sub get_root_certs_raw {
    my ($self)   = @_;
    my $url      = $self->{url} . 'getRootCertsRaw';
    my $response = $self->{ua}->get($url);
    if ( $response->is_success() ) {
        $self->_parse_success($response);
        return $response->decoded_content();
    }
    else {
        Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
    }
}

1;    # End of WebService::SSLLabs
__END__