File Coverage

blib/lib/WWW/Live/Auth.pm

Criterion	Covered	Total	%
statement	22	89	24.7
branch	2	34	5.8
condition	3	39	7.6
subroutine	5	11	45.4
pod	6	7	85.7
total	38	180	21.1

package WWW::Live::Auth;

use strict;
use warnings;

use WWW::Live::Auth::Utils;
use Carp;

require WWW::Live::Auth::SecretKey;
require WWW::Live::Auth::ApplicationToken;
require WWW::Live::Auth::ConsentToken;
require LWP::UserAgent;
require Crypt::SSLeay; # explicitly require, otherwise you get cryptic https failures with LWP
require CGI;

our $VERSION = '1.0.1';
our $CONSENT_BASE_URL = 'https://consent.live.com/';

sub new {
  my ( $proto, %options ) = @_;
  my $class = ref $proto || $proto;

  my $app_id     = delete $options{'application_id'};
  my $secret_key = delete $options{'secret_key'};
  my $client_ip  = delete $options{'client_ip'};
  if ( $secret_key && !ref $secret_key ) {
    $secret_key = WWW::Live::Auth::SecretKey->new( $secret_key );
  }

  $options{'agent'} ||= __PACKAGE__ . "/$VERSION";
  my $self = bless {
    'secret_key'     => $secret_key,
    'application_id' => $app_id,
    '_ua'            => LWP::UserAgent->new( %options ),
    'debug'          => delete $options{'debug'},
  }, $class;
  $self->{'client_ip'} = $client_ip if ( $client_ip );

  return $self;
}

sub proxy {
  my $self = shift;
  return $self->{'_ua'}->proxy( 'https', shift );
}

sub consent_url {
  my ( $self, %args ) = @_;

  my $offers  = $args{'offers'}      || croak('List of offers is required');
  my $privacy = $args{'privacy_url'} || croak('Privacy policy URL is required');
  my $secret  = $self->{'secret_key'}     || croak('Secret key is required');
  my $app_id  = $self->{'application_id'} || croak('Application ID is required');

  if ( ref $offers ) {
    if ( ref $offers ne 'ARRAY' ) {
      $offers = [ $offers ];
    }
    $offers = join ',', map {
      ref $_ ? $_->offer . '.' . $_->action : $_
    } @{ $offers };
  }

  # https://consent.live.com/Delegation.aspx?RU=...&ps=...&pl=...[&app=...][&mkt=...][&appctx=...]
  my $url = sprintf $CONSENT_BASE_URL.'Delegation.aspx?ps=%s&pl=%s',
                    _escape( $offers ), _escape( $privacy );

  if ( $args{'return_url'} ) {
    $url .= '&RU=' . _escape( $args{'return_url'} );
  }

  # Client IP address is optional
  my $app_token = WWW::Live::Auth::ApplicationToken->new(
    $secret->signature_key,
    $app_id,
    $self->{'client_ip'}
  )->as_string;
  $url .= sprintf '&app=%s', $app_token;

  if ( $args{'market'} ) {
    $url .= '&mkt=' . _escape( $args{'market'} );
  }

  if ( $args{'context'} ) {
    $url .= '&appctx=' . _escape( $args{'context'} );
  }

  return $url;
}

sub refresh_url {
  my ( $self, %args ) = @_;
  my $consent_token = $args{'consent_token'} || croak('Consent token is required to construct a refresh URL');
  my $secret  = $self->{'secret_key'}     || croak('Secret key is required to construct a refresh URL');
  my $app_id  = $self->{'application_id'} || croak('Application ID is required to construct a refresh URL');

  if ( !ref $consent_token ) {
    $consent_token = WWW::Live::Auth::ConsentToken->new(
      'consent_token' => $consent_token,
      'secret_key'    => $secret,
    );
  }

  my $offers = join ',', map { $_->offer.'.'.$_->action } $consent_token->offers;

  # https://consent.live.com/RefreshToken.aspx?RU=...&ps=...&reft=...
  my $url = sprintf $CONSENT_BASE_URL.'RefreshToken.aspx?ps=%s&reft=%s',
                    _escape( $offers ),
                    $consent_token->refresh_token;

  if ( $args{'return_url'} ) {
    $url .= '&ru=' . _escape( $args{'return_url'} );
  }

  # Client IP address is optional
  my $app_token = WWW::Live::Auth::ApplicationToken->new(
    $secret->signature_key,
    $app_id,
    $self->{'client_ip'}
  )->as_string;
  $url .= sprintf '&app=%s', $app_token;

  return $url;
}

sub is_delegated_authentication {
  my ( $self, $cgi ) = @_;
  $cgi ||= CGI->new();

  if ( !$cgi->param('action') || $cgi->param('action') ne 'delauth' ) {
    return 0;
  }

  return 1;
}

sub receive_consent {
  my ( $self, $cgi ) = @_;
  $cgi ||= CGI->new();

  # Check we are processing a delegated authentication response
  if ( ! $self->is_delegated_authentication( $cgi ) ) {
    croak('Unable to process consent - request is not a delegated authentication');
  } elsif ( $cgi->param('ResponseCode') ne 'RequestApproved' ) {
    croak('Authentication denied');
  }

  my $consent_token = WWW::Live::Auth::ConsentToken->new(
    'secret_key'    => $self->{'secret_key'},
    'consent_token' => $cgi->param('ConsentToken'),
  );

  my $app_context = _unescape( $cgi->param('appctx') );

  return $consent_token, $app_context;
}

sub refresh_consent {
  my $self = shift;
  my $url = $self->refresh_url( @_ );

  if ( $self->{'debug'} ) {
    warn "About to GET $url";
  }

  my $request  = HTTP::Request->new(GET => $url);
  my $response = $self->{'_ua'}->request( $request );
  if ( $response->is_success ) {
    # {"ConsentToken":"delt%3dEwCoARAn ..."}
    my $raw = $response->content;

    my ($error, $msg) = $raw =~ m/"error":"(.+)"}(.+)/mxs;
    if ( $error ) {
      croak("Could not refresh consent token: $error - $msg");
    }

    my ($consent_token) = $raw =~ m/"ConsentToken":"(.+)"/mxs;
    if ( !$consent_token ) {
      return;
    }
    return WWW::Live::Auth::ConsentToken->new(
      'secret_key'    => $self->{'secret_key'},
      'consent_token' => $consent_token,
    );

  } else {
    croak( 'Could not contact Live service: ' . $response->status_line );
  }
}

1;
__END__