package Yahoo::BBAuth;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
use Carp;
use CGI;
use URI;
use LWP::UserAgent;
use Digest::MD5 qw(md5_hex);
our $VERSION = '0.01';
__PACKAGE__->mk_accessors(qw/
appid secret userhash appdata timeout token WSSID
cookie access_credentials_error sig_validation_error
/);
my $WSLOGIN_PREFIX = 'https://api.login.yahoo.com/WSLogin/V1/';
sub new {
my ($class, %param) = @_;
croak('appid and secret required')
if !exists $param{appid} or !exists $param{secret};
bless {
appid => $param{appid},
secret => $param{secret},
}, $class;
}
sub auth_url {
my ($self, %param) = @_;
my $url = URI->new($WSLOGIN_PREFIX . 'wslogin');
my %query = (appid => $self->appid);
$query{appdata} = $param{appdata} if exists $param{appdata};
$query{send_userhash} = 1 if exists $param{send_userhash};
$url->query_form(%query);
$self->_create_auth_url($url);
}
sub _create_auth_url {
my ($self, $url) = @_;
unless (ref $url) { # not URI object
$url = URI->new($url);
}
my %query = $url->query_form;
$url->query_form([%query, (ts => time)]);
my $sig = md5_hex($url->path_query . $self->secret);
# sig must be last
$url->as_string . "&sig=$sig";
}
sub validate_sig {
my ($self, %param) = @_;
my $cgi = CGI->new;
$self->userhash($cgi->param('userhash')) if defined $cgi->param('userhash');
$self->appdata($cgi->param('appdata')) if defined $cgi->param('appdata');
my $ts = exists $param{ts} ? $param{ts} : $cgi->param('ts');
my $sig = exists $param{sig} ? $param{sig} : $cgi->param('sig');
my ($relative_url, $get_sig) = $cgi->request_uri =~ /^(.+)&sig=(\w{32})$/;
unless (defined $get_sig) {
$self->sig_validation_error(
"Invalid url may have been passed - relative_url: $relative_url"
);
return;
}
if ($get_sig ne $sig) {
$self->sig_validation_error(
"Invalid sig may have been passed: $get_sig , $sig"
);
return;
}
my $current_time = time;
my $clock_skew = abs(time - $ts);
if ($clock_skew >= 600) {
$self->sig_validation_error(
"Invalid timestamp - clock_skew is $clock_skew seconds, current time is $current_time, ts is $ts"
);
return;
}
my $sig_input = $relative_url . $self->secret;
my $calculated_sig = md5_hex($sig_input);
if ($calculated_sig eq $sig) {
return 1;
} else {
$self->sig_validation_error(
"calculated_sig was $calculated_sig, supplied sig was $sig, sig input was $sig_input"
);
return;
}
}
sub _get_access_credentials {
my $self = shift;
my $url = $self->_access_url;
my $ua = LWP::UserAgent->new;
my $res = $ua->get($url);
if ($res->is_error) {
$self->access_credentials_error($res->status_line);
return;
}
my $content = $res->content;
if ($content =~ m!<ErrorCode>(.+)</ErrorCode>!) {
$self->access_credentials_error(
"Error code returned in XML response: $1"
);
return;
}
if ($content =~ /(Y=.*)/) {
$self->cookie($1);
} else {
$self->access_credentials_error('No cookie found');
return;
}
if ($content =~ m!<WSSID>(.+)</WSSID>!) {
$self->WSSID($1);
} else {
$self->access_credentials_error('No WSSID found');
return;
}
if ($content =~ m!<Timeout>(.+)</Timeout>!) {
$self->timeout($1);
} else {
$self->access_credentials_error('No timeout found');
return;
}
return 1;
}
sub _access_url {
my $self = shift;
unless (defined $self->token) {
my $cgi = CGI->new;
$self->token($cgi->param('token'));
}
my $url = URI->new($WSLOGIN_PREFIX. 'wspwtoken_login');
$url->query_form(token => $self->token, appid => $self->appid);
$self->_create_auth_url($url);
}
sub _create_auth_ws_url {
my ($self, $url) = @_;
unless (defined $self->cookie) {
return unless $self->_get_access_credentials;
}
unless (ref $url) {
$url = URI->new($url);
}
$url->query_form(
WSSID => $self->WSSID,
appid => $self->appid,
);
$url->as_string;
}
sub auth_ws_get_call {
my ($self, $url) = @_;
$self->_auth_ws_call($url, 'get');
}
sub auth_ws_post_call {
my ($self, $url) = @_;
$self->_auth_ws_call($url, 'post');
}
sub _auth_ws_call {
my ($self, $url, $method) = @_;
$url = $self->_create_auth_ws_url($url);
my $ua = LWP::UserAgent->new;
$ua->default_header(Cookie => $self->cookie);
my $res = $ua->$method($url);
if ($res->is_error) {
$self->access_credentials_error($res->status_line);
return;
}
$res->content;
}
1;
__END__
=head1 NAME
Yahoo::BBAuth - Perl interface to the Yahoo! Browser-Based Authentication.
=head1 SYNOPSIS
my $bbauth = Yahoo::BBAuth->new(
appid => $appid,
secret => $secret,
);
# Create an authentication link
printf '<a href="%s">Click here to authorize</a>', $bbauth->auth_url;
# After the user authenticates successfully, Yahoo returns the user to the page you
# dictated when you signed up. To verify whether authentication succeeded, you need to
# validate the signature:
if ($bbauth->validate_sig()) {
print 'Authentication Successful';
} else {
print 'Authentication Failed. Error is: '.$bbauth->sig_validation_error;
}
my $url = 'http://photos.yahooapis.com/V1.0/listAlbums';
my $xml = $bbauth->auth_ws_get_call($url);
unless ($xml) {
print 'WS call setup Failed. Error is: '. $bbauth->access_credentials_error;
} else {
print 'Look at response for other errors or success: '.$xml;
}
=head1 DESCRIPTION
This module priovides you an Object Oriented interface for Yahoo! Browser-Based Authentication.
This module is ported from official PHP class library(http://developer.yahoo.com/auth/quickstart/bbauth_quickstart.zip).
=head1 METHODS
=head2 new(appid => $appid, secret => $secret)
Returns an instance of this module.
You must set the your application id and shared secret.
=head2 auth_url(%param)
Create the Login URL used to fetch authentication credentials.
This is the first step in the browser authentication process.
You can set the %param to send_userhash and appdata if you need(optinal).
The appdata typically a session id that Yahoo will transfer to the target application upon successful authentication.
If send_userhash set, the send_userhash=1 request will be appended to the request URL so that the userhash will be returned by Yahoo! after successful authentication.
=head2 validate_sig
Validates the signature returned by Yahoo's browser authentication services.
Returns true if the sig is validated. Returns undef if any error occurs.
If undef is returned, $self->sig_validation_error should contain a string describing the error.
=head2 auth_ws_get_call($url)
Make an authenticated web services call using HTTP GET.
Returns responce if successful, a string is returned containing the web service response which might be XML, JSON, or some other type of text.
If an error occurs, the error is stored in $self->access_credentials_error.
=head2 auth_ws_post_call($url)
Make an authenticated web services call using HTTP POST.
=head2 sig_validation_error
Returns error message when validate_sig failed.
=head2 access_credentials_error
Returns error message when auth_ws_get_call or auth_ws_post_call failed.
=head1 ACCESSORS
=over 4
=item appid
=item secret
=item userhash
=item appdata
=item timeout
=item token
=item WSSID
=item cookie
=back
=head1 AUTHOR
Jiro Nishiguchi E<lt>jiro@cpan.orgE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
=over 4
=item * http://developer.yahoo.com/auth/
=back
=cut