## @file
# OpenID Issuer file

## @class
# OpenID Issuer class
package Lemonldap::NG::Portal::IssuerDBOpenID;

use strict;
use Lemonldap::NG::Portal::Simple;

our $VERSION = '0.01';

## @method void issuerDBInit()
# Do nothing
# @return Lemonldap::NG::Portal error code
sub issuerDBInit {
    my $self = shift;
    eval { require Lemonldap::NG::Common::OpenID::Server };
    $self->abort( 'Unable to load Net::OpenID::Server', $@ ) if ($@);
    $self->{openIdSecret} ||= $self->{cipher}->encrypt(0);
    return PE_OK;
}

## @apmethod int issuerForUnAuthUser()
# Do nothing
# @return Lemonldap::NG::Portal error code
sub issuerForUnAuthUser {
    my $self = shift;

    # Restore datas
    $self->restoreOpenIDprm();
    my $mode = $self->param('openid.mode');

    unless ($mode) {
        $self->lmLog( 'OpenID SP test', 'debug' );
        return PE_OPENID_EMPTY;
    }

    if ( $mode eq 'associate' ) {
        return $self->_openIDResponse( $self->openIDServer->_mode_associate() );
    }
    elsif ( $mode eq 'check_authentication' ) {
        return $self->_openIDResponse(
            $self->openIDServer->_mode_check_authentication() );
    }
    else {
        $self->storeOpenIDprm();
        return PE_OK;
    }
}

## @apmethod int issuerForAuthUser()
# Do nothing
# @return Lemonldap::NG::Portal error code
sub issuerForAuthUser {
    my $self = shift;

    # Restore datas
    $self->restoreOpenIDprm();
    my $mode = $self->param('openid.mode');

    unless ($mode) {
        $self->lmLog( 'OpenID SP test', 'debug' );
        return PE_OPENID_EMPTY;
    }

    unless ( $mode =~ /^checkid_(?:immediate|setup)/ ) {
        $self->lmLog(
"OpenID error : $mode is not known at this step (issuerForAuthUser)",
            'error'
        );
        return PE_ERROR;
    }
    return $self->_openIDResponse( $self->openIDServer->_mode_checkid() );
}

## @apmethod int issuerLogout()
# TODO
# @return Lemonldap::NG::Portal error code
sub issuerLogout {
    PE_OK;
}

sub storeOpenIDprm {
    my $self = shift;
    delete( $self->{_prm}->{lmhidden_openidprm} );
    $self->setHiddenFormValue( 'openidprm',
        Storable::nfreeze( $self->{_prm} ) );
}

sub restoreOpenIDprm {
    my $self = shift;
    return if ( $self->{openIDRestored} );
    if ( my $tmp = $self->getHiddenFormValue('openidprm') ) {
        $self->lmLog( 'Restore OpenID parameters', 'debug' );
        eval {
            $tmp = Storable::thaw($tmp);
            $self->{_prm}->{$_} = $tmp->{$_} foreach ( keys %$tmp );
        };
    }
    $self->{openIDRestored} = 1;
}

sub sregHook {
    my ( $self, %prm ) = splice @_;
    my ( %r, @req, @opt );
    while ( my ( $k, $v ) = each %prm ) {
        if ( $k eq 'policy_url' ) {
            if ( $v =~
m{^https?://(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9]|[a-zA-Z])[.]?)|(?:[0-9]+[.][0-9]+[.][0-9]+[.][0-9]+)))(?::(?:(?:[0-9]*)))?(?:/(?:(?:(?:(?:(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+\$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*)(?:;(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+\$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*))*)(?:/(?:(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+\$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*)(?:;(?:(?:[a-zA-Z0-9\-_.!~*'():@&=+\$,]+|(?:%[a-fA-F0-9][a-fA-F0-9]))*))*))*))))?$}
              )
            {
                $self->{openIdCustomerPolicy} = $v;
            }
            else {
                $self->lmLog( "Bad policy url", 'error' );
            }
        }
        elsif ( $k eq 'required' ) {
            push @req, split( /,/, $v );
        }
        elsif ( $k eq 'optional' ) {
            push @opt,
              grep { defined $self->{"openIdSreg_$_"} } split( /,/, $v );
        }
        else {
            $self->lmLog( "Unknown OpenID SREG request $k", 'error' );
        }
    }

    # If a required data is not available, returns nothing
    foreach my $k (@req) {
        unless ( $self->{"openIdSreg_$k"} ) {
            $self->lmLog(
"Parameter $k is required by customer but not defined in configuration",
                'notice'
            );
            return ();
        }
    }
    foreach my $k ( @req, @opt ) {
        unless ( $k =~
/^(?:(?:(?:full|nick)nam|languag|postcod|timezon)e|country|gender|email|dob)$/
          )
        {
            $self->lmLog(
                "Requested parameter $k is not a valid OpenID SREG parameter",
                'error' );
            return ();
        }
        $r{$k} = $self->{sessionInfo}->{ $self->{"openIdSreg_$k"} };
    }
    return %r;
}

sub openIDServer {
    my $self = shift;
    return $self->{_openidserver} if ( $self->{_openidserver} );
    $self->{_openidPortal} = $self->{portal} . "/openidserver/";
    $self->{_openidPortal} =~ s#(?<!:)//#/#g;

    $self->{_openidserver} = Lemonldap::NG::Common::OpenID::Server->new(

        # TODO
        server_secret => sub { return $self->{openIdSecret} },
        post_args     => $self->{_prm},
        get_args      => $self->{_prm},
        endpoint_url => $self->{_openidPortal},
        setup_url    => $self->{_openidPortal},
        get_user     => sub {
            return $self->{sessionInfo}
              ->{ $self->{OpenIdAttr} || $self->{whatToTrace} };
        },
        get_identity => sub {
            my ( $u, $identity ) = @_;
            return $identity unless $u;
            return $self->{_openidPortal} . $u;
        },
        is_identity => sub {
            my ( $u, $identity ) = @_;
            return 0 unless ( $u and $identity );
            if ( $u eq ( split '/', $identity )[-1] ) {
                return 1;
            }
            else {
                $self->{_badOpenIdentity} = 1;
                return 0;
            }
        },
        is_trusted => sub {
            my ( $u, $trust_root, $is_identity ) = @_;
            return 0 unless ( $u and $is_identity );
            if ( $self->{sessionInfo}->{"_openidTrust$trust_root"} ) {
                $self->lmLog( 'OpenID request already trusted', 'debug' );
                return 1;
            }
            elsif ( $self->param("confirm") ) {
                $self->updateSession( { "_openidTrust$trust_root" => 1 } );
                return 1;
            }
            else {
                $self->lmLog( 'OpenID request not trusted', 'debug' );
                $self->{_openIdTrustRequired} = 1;
                return 0;
            }
        },
        extensions => {
            sreg => sub {
                return $self->sregHook(@_);
            },
        },
    );
    return $self->{_openidserver};
}

sub _openIDResponse {
    my ( $self, $type, $data ) = splice @_;

    # TODO: use autoRedirect instead
    if ( $type eq 'redirect' ) {
        $self->lmLog( 'OpenID redirection', 'debug' );
        print $self->redirect($data);
    }
    elsif ( $type eq 'setup' ) {
        if ( $self->{_openIdTrustRequired} ) {

            # TODO
            $self->info(
                '<h2>'
                  . &Lemonldap::NG::Portal::_i18n::msg( PM_OPENID_EXCHANGE,
                    $ENV{HTTP_ACCEPT_LANGUAGE} )
                  . "</h2>"
            );
            $self->lmLog( 'OpenID confirmation', 'debug' );
            $self->storeOpenIDprm();
            return PE_CONFIRM;
        }
        if ( $self->{_badOpenIdentity} ) {
            $self->userNotice(
"The user $self->{sessionInfo}->{_user} tries to use the id \"$data->{identity}\" on $data->{trust_root}"
            );
            return PE_OPENID_BADID;
        }
    }
    else {
        $self->lmLog( 'OpenID generated page', 'debug' );
        print $self->header($type);
        print $data;
    }
    $self->quit();
    PE_OK;
}

1;

__END__

=head1 NAME

=encoding utf8

Lemonldap::NG::Portal::IssuerDBOpenID - OpenID IssuerDB for Lemonldap::NG

=head1 DESCRIPTION

OpenID Issuer implementation in LemonLDAP::NG

=head1 SEE ALSO

L<Lemonldap::NG::Portal>

=head1 AUTHOR

Xavier Guimard, E<lt>x.guimard@free.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Xavier Guimard

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut