Using OpenID with Perl

OpenID is a way to log in to web sites. Web sites including Google, Wordpress, and Flickr support this technology. You can obtain an OpenID easily from My OpenID.

Here I discuss Net::OpenID::Consumer, a popular client for this technology.

Try it

send.cgi

#!/usr/local/bin/perl
use warnings;
use strict;
use Net::OpenID::Consumer;
use LWP::UserAgent;
use CGI;
use CGI::Carp 'fatalsToBrowser';
binmode STDOUT, ":utf8";
use utf8;
my $cgi = CGI->new();
my $openid = $cgi->param("openid");
# Do a quickie check of the input
fail ('No OpenID')  if ! $openid;
# I'm not sure this regex is a perfect solution.
fail ('Bad OpenID') if $openid =~ /[^a-z0-9\._:\/-]/i;

# Workaround for a known problem with myopenid. Change "http" to "https".
$openid =~ s@(^http://|^(?!https))@https://@ if $openid =~ /myopenid/;

my $csr = Net::OpenID::Consumer->new
    (
     # The user agent which sends the openid off to the server.
     ua    => LWP::UserAgent->new,
     # Who we are.
     required_root => 'http://www.lemoda.net/',
     # Our password.
     consumer_secret => 'xYZabC0123',
 );
my $claimed_id = $csr->claimed_identity($openid);
if ($claimed_id) {
    my $check_url = $claimed_id->check_url (
     # The place we go back to.
     return_to  => 'http://www.lemoda.net/perl/openid/response.cgi',
     # Having this simplifies the login process.
     trust_root => 'http://www.lemoda.net/',
    );
    # Automatically redirect the user to the endpoint.
    print $cgi->redirect ($check_url);
} else {
    fail ("claimed_identity for '$openid' failed", $csr->errcode());
}
exit 0;

# Error handler

sub fail
{
    my ($message, $errcode) = @_;
    print $cgi->header (-charset => 'utf-8'), $cgi->start_html();
    print "<h1>There was a problem</h1>\n";
    print "<p><b>$message</b></p>\n";
    if ($errcode) {
        print "<p>The error code was <code>$errcode</code></p>\n";
        if ($errcode == "no_identity_server") {
            # This has happened many times!
            print <<EOF;
<p>An OpenID is a URL which identifies you uniquely. I could not find
an identity web server at '$openid'. Is it a valid URL? Is the URL
your unique identity?</p>
EOF
        }
    }
    if ($message eq 'Bad OpenID' && $openid =~ /\@/) {
        print <<EOF;
<p>It looks like you entered an email address rather than an
OpenID. An OpenID is a Url which identifies you, like
<code>http://example.myopenid.com/</code>.</p>
EOF
    }
    print $cgi->end_html;
    exit 0;
}

response.cgi

#!/usr/local/bin/perl
use warnings;
use strict;
use Net::OpenID::Consumer;
use LWP::UserAgent;
use CGI;
binmode STDOUT, ":utf8";
use utf8;
my $cgi = CGI->new();
my $csr = Net::OpenID::Consumer->new
    (
     # The root of our URL.
     required_root => 'http://www.lemoda.net/',
     # Our password.
     consumer_secret => 'xYZabC0123',
     # Where to get the information from.
     args  => $cgi,
 );
# Start of HTML output
print $cgi->header(-charset => 'utf-8'), $cgi->start_html();
print "<h1>response.cgi</h1>\n";

$csr->handle_server_response
    (
     not_openid => sub {
         print "That's not an OpenID message. Did you just type in the URL?";
     },
     setup_required => sub {
         my $setup_url = shift;
         print "You need to do something <a href='$setup_url'>here</a>.";
     },
     cancelled => sub {
         print 'You cancelled your login.\n';
     },
     verified => sub {
         my $vident = shift;
         my $url = $vident->url;
         print "You are verified as '$url'.";
     },
     error => \&handle_errors,
 );

print $cgi->end_html();

exit 0;

# Handle errors, suggest possible causes of the error.

sub handle_errors
{
    my ($err) = @_;
    print "<b>Error: $err</b>. \n";
    if ($err eq 'server_not_allowed') {
        print <<EOF;
You may have gone to an http: server and come back from an https:
server. This happens with "myopenid.com".
EOF
    } elsif ($err eq 'naive_verify_failed_return') {
        print 'Oops! Did you reload this page?';
    }
}