Lemonldap::NG::Portal::OpenID::Server - Add capability to manage extensions to

  use Lemonldap::NG::Portal::OpenID::Server;
  blah blah blah

## @file
# Subclass of Net::OpenID::Server that manage OpenID extensions

## @class
# Subclass of Net::OpenID::Server that manage OpenID extensions
package Lemonldap::NG::Portal::OpenID::Server;

use strict;
use base qw(Net::OpenID::Server);
use fields qw(_extensions);
use Net::OpenID::Server;
use Lemonldap::NG::Common::Regexp;

use constant DEBUG => 0;

our $VERSION = '1.0.0';

my $OPENID2_NS        = qq!http://specs.openid.net/auth/2.0!;
my $OPENID2_ID_SELECT = qq!http://specs.openid.net/auth/2.0/identifier_select!;

*_push_url_arg = *Net::OpenID::Server::_push_url_arg;

## @cmethod Lemonldap::NG::Portal::OpenID::Server new(hash opts)
# Call Net::OpenID::Server::new() and store extensions
# @param %opts Net::OpenID::Server options
# @return Lemonldap::NG::Portal::OpenID::Server new object
sub new {
    my $class = shift;
    my $self  = fields::new($class);
    my %opts  = splice @_;
    $self->$_( delete $opts{$_} ) foreach (qw(extensions));
    $self->SUPER::new(%opts);

    #$self->{get_args} = sub { $self->param(@_) };
}

## @method protected void extensions()
# Manage "extensions" constructor parameter
sub extensions {
    my $self = shift;
    $self->{_extensions} = shift;
}

## @method protected list _mode_checkid(string mode, boolean redirect_for_setup)
# Overload Net::OpenID::Server::_mode_checkid to call extensions hook
# @param $mode OpenID mode
# @param $redirect_for_setup indicates that user must be redirected or not for
# setup
# @return (string $type, hashref parameters)
sub _mode_checkid {
    my Lemonldap::NG::Portal::OpenID::Server $self = shift;
    my ( $mode, $redirect_for_setup ) = @_;

    my $return_to = $self->args("openid.return_to");
    return $self->_fail("no_return_to")
      unless ( $return_to
        and $return_to =~ Lemonldap::NG::Common::Regexp::HTTP_URI );

    my $trust_root = $self->args("openid.trust_root") || $return_to;
    $trust_root = $self->args("openid.realm")
      if $self->args('openid.ns') eq $OPENID2_NS;
    return $self->_fail("invalid_trust_root")
      unless ( $trust_root =~ Lemonldap::NG::Common::Regexp::HTTP_URI
        and Net::OpenID::Server::_url_is_under( $trust_root, $return_to ) );

    my $identity = $self->args("openid.identity");

 # chop off the query string, in case our trust_root came from the return_to URL
    $trust_root =~ s/\?.*//;

    my $u = $self->_proxy("get_user");
    if (   $self->args('openid.ns') eq $OPENID2_NS
        && $identity eq $OPENID2_ID_SELECT )
    {
        $identity = $self->_proxy( "get_identity", $u, $identity );
    }
    my $is_identity = $self->_proxy( "is_identity", $u, $identity );
    my $is_trusted =
      $self->_proxy( "is_trusted", $u, $trust_root, $is_identity );

    my ( %extVars, %is_ext_trusted );
    my $is_exts_trusted = 1;
    if ( ref( $self->{_extensions} ) ) {
        my @list = $self->get_args->();
        my %extArgs;
        foreach my $arg (@list) {
            next unless ( $arg =~ /^openid\.(\w+)\.([\w\.]+)?/ );
            my $tmp = $1;
            my $val = $2;
            $extArgs{$tmp}->{$val} = scalar $self->args->($arg);
        }
        foreach my $ns ( keys %{ $self->{_extensions} } ) {
            print STDERR "Launching OpenIP $ns hook\n" if (DEBUG);
            my $h;
            ( $is_ext_trusted{$ns}, $h ) = $self->{_extensions}->{$ns}->(
                $u, $trust_root, $is_identity, $is_trusted,
                delete( $extArgs{$ns} ) || {}
            );
            if ($h) {
                while ( my ( $k, $v ) = each %$h ) {
                    print STDERR "$ns returned data: $k => $v\n" if (DEBUG);
                    $extVars{"$ns.$k"} = $v;
                }
            }
            $is_exts_trusted &&= $is_ext_trusted{$ns};
        }

        # TODO: warn if keys(%extArgs)
    }

    # assertion path:
    if ( $is_identity && $is_trusted && $is_exts_trusted ) {
        my %sArgs = (
            identity     => $identity,
            claimed_id   => $self->args('openid.claimed_id'),
            return_to    => $return_to,
            assoc_handle => $self->args("openid.assoc_handle"),
            ns           => $self->args('openid.ns'),
        );
        $sArgs{additional_fields} = \%extVars if (%extVars);
        my $ret_url = $self->signed_return_url(%sArgs);
        return ( "redirect", $ret_url );
    }

    # Assertion could not be made, so user requires setup (login/trust...
    # something). Two ways that can happen:  caller might have asked us for an
    # immediate return with a setup URL (the default), or explictly said that
    # we're in control of the user-agent's full window, and we can do whatever
    # we want with them now.

    # TODO: call extension sub for setup
    my %setup_args = (
        $self->_setup_map("trust_root"),   $trust_root,
        $self->_setup_map("realm"),        $trust_root,
        $self->_setup_map("return_to"),    $return_to,
        $self->_setup_map("identity"),     $identity,
        $self->_setup_map("assoc_handle"), $self->args("openid.assoc_handle"),
        %extVars,
    );
    $setup_args{ $self->_setup_map('ns') } = $self->args('openid.ns')
      if $self->args('openid.ns');

    my $setup_url = $self->{setup_url}
      or Carp::croak("No setup_url defined.");
    _push_url_arg( \$setup_url, %setup_args );

    if ( $mode eq "checkid_immediate" ) {
        my $ret_url = $return_to;
        if ( $self->args('openid.ns') eq $OPENID2_NS ) {
            _push_url_arg( \$ret_url, "openid.ns",   $self->args('openid.ns') );
            _push_url_arg( \$ret_url, "openid.mode", "setup_needed" );
        }
        else {
            _push_url_arg( \$ret_url, "openid.mode",           "id_res" );
            _push_url_arg( \$ret_url, "openid.user_setup_url", $setup_url );
        }
        return ( "redirect", $ret_url );
    }
    else {

        # the "checkid_setup" mode, where we take control of the user-agent
        # and return to their return_to URL later.

        if ($redirect_for_setup) {
            return ( "redirect", $setup_url );
        }
        else {
            return ( "setup", \%setup_args );
        }
    }
}

#*args = \&get_args;

#sub get_args {
#    my $self = shift;
#
#    if ( my $what = shift ) {
#        Carp::croak("Too many parameters") if @_;
#
#        # Lemonldap::NG only (direct CGI)
#        $self->{get_args} = sub { $what->param( $_[0] ) };
#
#        # INCLUDE IN PROPOSED PATCH FOR Net::OpenID::Server
#        #my $getter;
#        #if ( !ref $what ) {
#        #    Carp::croak("No get_args defined") unless $self->{get_args};
#        #    return $self->{get_args}->($what) || "";
#        #}
#        #elsif ( ref $what eq "HASH" ) {
#        #    $getter = sub { $_[0] ? $what->{ $_[0] } : ( keys %$what ); };
#        #}
#        #elsif ( ref $what eq "Apache" ) {
#        #    my %get = $what->args;
#        #    $getter = sub { $_[0] ? $get{ $_[0] } : ( keys %get ); };
#        #}
#        #elsif ( ref $what eq "CODE" ) {
#        #    $getter = $what;
#        #}
#        #else {
#        #    my $r = eval { $what->can('param') };
#        #    if ( $@ or not $r ) {
#        #        Carp::croak("Unknown parameter type ($what)");
#        #    }
#        #    else {
#        #        $getter = sub {
#        #            $_[0] ? scalar $what->param( $_[0] ) : ( $what->param() );
#        #        };
#        #    }
#        #}
#        #if ($getter) {
#        #    $self->{get_args} = $getter;
#        #}
#    }
#    $self->{get_args};
#}

1;
__END__