view release on metacpan or  search on metacpan

lib/Mozilla/Persona/Check.pm  view on Meta::CPAN

# Copyrights 2012 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.00.
use warnings;
use strict;

package Mozilla::Persona::Check;
use vars '$VERSION';
$VERSION = '0.12';

use base 'Exporter';

our @EXPORT = qw/check_identity/;

use open 'utf8';
use Log::Report         qw/persona/;

use LWP::UserAgent           ();

sub check_browserid_file($);
sub check_login($$$);

my $ua;


sub check_identity(%)
{   my %args = @_;

    my $identity = $args{identity} or panic;
    my $password = $args{password} or panic;

    my ($user, $domain) = split m/\@/, $identity, 2;
    defined $domain
        or error __x"identity should have a form like: username\@example.com";

    my $website  = URI->new("https://$domain");
    check_browserid_file $website;
    check_login $website, $identity, $password;
}

sub check_browserid_file($)
{   my $website  = shift;
    my $wk       = URI->new_abs('/.well-known/browserid', $website);

    $ua        ||= LWP::UserAgent->new;
    my $response = $ua->get($wk);

    $response->is_success
        or error __x"could not get {uri}: {err}"
             , uri => $wk, err => $response->status_line;

    my $ct = $response->content_type;
    unless($ct eq 'application/json')
    {   print <<__HELP;
ERROR>>>
When downloading $wk
I discovered that the content-type is not 'application/json', but
'$ct'.  You need to change the configuration of your
webserver.  For Apache, you need to add something like

    <Directory \$YOUR_DOCROOT/.well-known>
      <Files browserid>
         ForceType application/json
      </Files>
    </Directory>

to your VirtualHost.
__HELP

        error __x"the browserid file is not json";
    }
}

sub check_login($$$)
{   my ($website, $identity, $password) = @_;
    my $login = $website->clone;
    $login->path('/persona/index.pl');

    $ua       ||= LWP::UserAgent->new;
    my $resp    = $ua->post($login
      , {action => 'login', email => $identity, password => $password});

    unless($resp->is_success)
    {   print <<'__HELP_404' if $resp->code==404;
ERROR>>>
This program can only be used to check Mozilla::Persona installations,
not other persona servers.
__HELP_404

        print <<'__HELP_500' if $resp->code==500;
ERROR>>
Login failed: the persona/index.pl script produced an error.  There are