File Coverage

blib/lib/Net/OpenID/Consumer/Lite.pm

Criterion	Covered	Total	%
statement	18	83	21.6
branch	0	26	0.0
condition	0	2	0.0
subroutine	6	13	46.1
pod	0	2	0.0
total	24	126	19.0

package Net::OpenID::Consumer::Lite;
use strict;
use warnings;
use 5.00800;
our $VERSION = '0.04';
use LWP::UserAgent;
use Carp ();

my $TIMEOUT = 4;
our $IGNORE_SSL_ERROR = 0;

sub _ua {
    my $agent = "Net::OpenID::Consumer::Lite/$Net::OpenID::Consumer::Lite::VERSION";
    LWP::UserAgent->new(
        agent        => $agent,
        timeout      => $TIMEOUT,
        max_redirect => 0,
    );
}

sub _get {
    my $url = shift;
    my $ua = _ua();
    my $res = $ua->get($url);
    unless ($IGNORE_SSL_ERROR) {
    use Data::Dumper; warn Dumper($res);
        if ( my $warnings = $res->header('Client-SSL-Warning') ) {
            Carp::croak("invalid ssl? ${url}, ${warnings}");
        }
    }
    unless ($res->is_success) {
        Carp::croak("cannot get $url : @{[ $res->status_line ]}");
    }
    $res;
}

sub check_url {
    my ($class, $server_url, $return_to, $extensions) = (shift, shift, shift, shift);
    Carp::croak("missing params")      unless $return_to;
    Carp::croak("this module supports only https: $server_url") unless $server_url =~ /^https/;

    my $url = URI->new($server_url);
    my %args = (
        'openid.mode' => 'checkid_immediate',
        'openid.return_to' => $return_to,
    );
    if ($extensions) {
        my $i = 1;
        while (my ($ns, $args) = each %$extensions) {
            my $ext_alias = "e$i";
            $args{"openid.ns.$ext_alias"} = $ns;
            while (my ($key, $val) = each %$args) {
                $args{"openid.${ext_alias}.${key}"} = $val;
            }
            $i++;
        }
    }
    $url->query_form(%args);
    return $url->as_string;
}

sub _check_authentication {
    my ($class, $request) = @_;
    my $url = do {
        $request->{'openid.mode'} = 'check_authentication';
        my $request_url = URI->new($request->{'openid.op_endpoint'});
        $request_url->query_form(%$request);
        $request_url;
    };
    my $res = _get($url);
    $res->is_success() or die "cannot load $url";
    my $content = $res->content;
    return _parse_keyvalue($content)->{is_valid} ? 1 : 0;
}

sub handle_server_response {
    my $class = shift;
    my $request = shift;
    my %callbacks_in = @_;
    my %callbacks = ();

    for my $cb (qw(not_openid setup_required cancelled verified error)) {
        $callbacks{$cb} = delete( $callbacks_in{$cb} )
            || sub { Carp::croak( "No " . $cb . " callback" ) };
    }

    my $mode = $request->{'openid.mode'};
    unless ($mode) {
        return $callbacks{not_openid}->();
    }

    if ($mode eq 'cancel') {
        return $callbacks{cancelled}->();
    }

    if (my $url = $request->{'openid.user_setup_url'}) {
        return $callbacks{'setup_required'}->($url);
    }

    if ($class->_check_authentication($request)) {
        my $vident;
        for my $key (split /,/, $request->{'openid.signed'}) {
            $vident->{$key} = $request->{"openid.$key"};
        }
        return $callbacks{'verified'}->($vident);
    } else {
        return $callbacks{'error'}->();
    }
}

sub _parse_keyvalue {
    my $reply = shift;
    my %ret;
    $reply =~ s/\r//g;
    foreach ( split /\n/, $reply ) {
        next unless /^(\S+?):(.*)/;
        $ret{$1} = $2;
    }
    return \%ret;
}


1;
__END__