[OpenID] Working Perl Implementation

Amiri Barksdale amiribarksdale at gmail.com
Thu May 31 10:48:05 UTC 2007


In the interest of giving back to the community, I am posting the scripts
that I wrote that successfully use the JanRain libraries for openid logins.

I am writing a Mason web application, so this is in an init block on the
page that handles the post from the login form.

Because I am running Apache 2, I had to do some funky stuff with my redirect
page, so I posted that at the bottom, too.

Amiri

__________


<%args>
$openid_url => undef
</%args>

<%init>
use strict;
use warnings;

use DBI;
use CGI;
use CGI::Session;
use Secret;
use Secret qw($name);
use Secret qw($pass);
use URI;
use URI::Query;
use URI::Escape;
use URI::QueryParam;
use Net::OpenID::JanRain::Consumer;
use Net::OpenID::JanRain::Stores::MySQLStore;

my $dbh;
my $cgi;
my $session;
my $cookie;
my $store;
my $consumer;
my $request;
my $redirect;
my $q;
my $query;
my %query;
my $complete;


unless ( $ARGS{'openid.mode'} ) {
    $dbh = DBI->connect( "dbi:mysql:openid", $name, $pass ) || die
$DBI::errstr;
    $cgi = CGI->new;
    $session = CGI::Session->new( "driver:MySQL", undef, { Handle => $dbh }
);
    $cookie = $cgi->cookie(CGISESSID => $session->id );
#    print $cgi->header(-cookie=>$cookie);
    $store = Net::OpenID::JanRain::Stores::MySQLStore->new($dbh);
    $consumer = Net::OpenID::JanRain::Consumer->new( $session, $store );


    if ($openid_url) {
    $request = $consumer->begin($openid_url);

    if ( $request->status eq 'failure' ) {
        my $redirect5 = "/users/login_failed_all.html";
        $m->comp( "/generic/action/openidredir.ml", url => $redirect5 );
        }

    elsif ( $request->status eq 'success' || 'in_progress' ) {
        my $trust_root = "http://***.***.***.***/users";
        my $return_to  = "http://***.***.***.***/users/openid.html";
        $request->addExtensionArg( "sreg",
"optional","nickname,email,fullname,dob,gender,postcode,country,language,timezone");
        $redirect = $request->redirectURL( $trust_root, $return_to );
        $m->comp( "/generic/action/openidredir.ml", url => $redirect, cookie
=> $cookie );
        }
    }
}

if ( $ARGS{'openid.mode'} ) {
#      $q = URI::Escape::uri_unescape($ENV{QUERY_STRING});
#      $query  = URI::Query->new($q);
#    %query  = $query->hash;

    $dbh = DBI->connect( "dbi:mysql:openid", $name, $pass ) || die
$DBI::errstr;
    $cgi = CGI->new;
    my $sid = $cgi->cookie("CGISESSID");
    $session =     CGI::Session->new( "driver:MySQL", $sid, { Handle => $dbh
} );
    $store = Net::OpenID::JanRain::Stores::MySQLStore->new($dbh);

    $consumer = Net::OpenID::JanRain::Consumer->new( $session, $store );
    $complete = $consumer->complete( \%ARGS );

    if ( $complete->status eq 'success' ) {
        my $redirect1 = "/users/login_done.html";
        $m->comp( "/generic/action/openidredir.ml", url => $redirect1,
cookie => $cookie );
        }

    elsif ( $complete->status eq 'failure' ) {
        my $redirect2 = "/users/completemessage.html";
        $m->comp( "/users/completemessage.html", complete =>
$complete->message, cookie => $cookie );
        }

    elsif ( $complete->status eq 'cancel' ) {
        my $redirect3 = "/users/login_canceled.html";
        $m->comp( "/generic/action/openidredir.ml", url => $redirect3,
cookie => $cookie );
        }

    else {
        my $redirect4 = "/users/login_failed_some.html";
        $m->comp( "/generic/action/openidredir.ml", url => $redirect4,
cookie => $cookie );
        }

}
</%init>
____________________

<%args>
$url
$cookie
</%args>

<%init>
use CGI::Cookie;
use Apache2::RequestRec;
use APR::Table ();
use Apache2::Const -compile => qw(REDIRECT);

$r->method('GET');
$r->headers_in->unset('Content-length');

$r->content_type('text/html');
$r->err_headers_out->add('Set-Cookie' => $cookie) ;
$r->headers_out->set('Location' => $url);
$r->status(Apache2::Const::REDIRECT);
#$m->abort(302);
</%init>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.openid.net/pipermail/openid-general/attachments/20070531/53646ea1/attachment-0002.htm>


More information about the general mailing list