Christophe Maudoux
5 years ago
parent
b2a1f055c3
commit
557f458803
@ -0,0 +1,307 @@ |
||||
package Lemonldap::NG::Portal::Lib::Choice; |
||||
|
||||
use strict; |
||||
use Mouse; |
||||
use Safe; |
||||
use IO::String; |
||||
|
||||
extends 'Lemonldap::NG::Portal::Lib::Wrapper'; |
||||
with 'Lemonldap::NG::Portal::Lib::OverConf'; |
||||
|
||||
our $VERSION = '2.1.0'; |
||||
|
||||
has modules => ( is => 'rw', default => sub { {} } ); |
||||
|
||||
has rules => ( is => 'rw', default => sub { {} } ); |
||||
|
||||
has type => ( is => 'rw' ); |
||||
|
||||
has catch => ( is => 'rw', default => sub { {} } ); |
||||
|
||||
has sessionKey => ( is => 'ro', default => '_choice' ); |
||||
|
||||
my $_choiceRules; |
||||
|
||||
# INITIALIZATION |
||||
|
||||
# init() must be called by module::init() with a number: |
||||
# - 0 for auth |
||||
# - 1 for userDB |
||||
# - 2 for passwordDB ? |
||||
sub init { |
||||
my ( $self, $type ) = @_; |
||||
$self->type($type); |
||||
|
||||
unless ( $self->conf->{authChoiceModules} |
||||
and %{ $self->conf->{authChoiceModules} } ) |
||||
{ |
||||
$self->error("'authChoiceModules' is empty"); |
||||
return 0; |
||||
} |
||||
|
||||
foreach my $name ( keys %{ $self->conf->{authChoiceModules} } ) { |
||||
my @mods = |
||||
split( /[;\|]/, $self->conf->{authChoiceModules}->{$name} ); |
||||
my $module = '::' |
||||
. [ 'Auth', 'UserDB', 'Password' ]->[$type] . '::' |
||||
. $mods[$type]; |
||||
my $over; |
||||
if ( $mods[5] ) { |
||||
eval { $over = JSON::from_json( $mods[5] ) }; |
||||
if ($@) { |
||||
$self->logger->error("Bad over value ($@), skipped"); |
||||
} |
||||
} |
||||
if ( $module = $self->loadModule( $module, $over ) ) { |
||||
$self->modules->{$name} = $module; |
||||
$self->logger->debug( |
||||
[qw(Authentication User Password)]->[$type] |
||||
. " module $name selected" ); |
||||
} |
||||
else { |
||||
$self->logger->error( |
||||
"Choice: unable to load $name, disabling it: " . $self->error ); |
||||
$self->error(''); |
||||
} |
||||
|
||||
# Test if auth module wants to catch some path |
||||
unless ($type) { |
||||
if ( $module->can('catch') ) { |
||||
$self->catch->{$name} = $module->catch; |
||||
} |
||||
} |
||||
|
||||
# Display conditions |
||||
my $safe = Safe->new; |
||||
my $cond = $mods[4]; |
||||
if ( defined $cond and $cond !~ /^$/ ) { |
||||
$self->logger->debug("Found rule $cond for $name"); |
||||
$_choiceRules->{$name} = |
||||
$safe->reval("sub{my(\$env)=\@_;return ($cond)}"); |
||||
if ($@) { |
||||
$self->logger->error("Bad condition $cond: $@"); |
||||
return 0; |
||||
} |
||||
} |
||||
else { |
||||
$self->logger->debug("No rule for $name"); |
||||
$_choiceRules->{$name} = sub { 1 }; |
||||
} |
||||
} |
||||
unless ( keys %{ $self->modules } ) { |
||||
$self->error('Choice: no available modules found, aborting'); |
||||
return 0; |
||||
} |
||||
return 1; |
||||
} |
||||
|
||||
# RUNNING METHODS |
||||
|
||||
sub checkChoice { |
||||
my ( $self, $req ) = @_; |
||||
my $name; |
||||
|
||||
# Check Choice from pdata |
||||
if ( defined $req->pdata->{_choice} ) { |
||||
|
||||
$name = $req->pdata->{_choice}; |
||||
$self->logger->debug("Choice $name selected from pdata"); |
||||
} |
||||
|
||||
unless ($name) { |
||||
|
||||
# Check with catch method |
||||
foreach ( keys %{ $self->catch } ) { |
||||
if ( $req->path_info =~ $self->catch->{$_} ) { |
||||
$name = $_; |
||||
$self->logger->debug( |
||||
"Choice $name selected from " . $req->path_info ); |
||||
last; |
||||
} |
||||
} |
||||
} |
||||
|
||||
unless ($name) { |
||||
|
||||
# Check with other methods |
||||
$name ||= |
||||
$req->param( $self->conf->{authChoiceParam} ) |
||||
|| $req->userData->{_choice} |
||||
|| $req->sessionInfo->{_choice} |
||||
or return 0; |
||||
|
||||
$self->logger->debug("Choice $name selected"); |
||||
} |
||||
|
||||
unless ( defined $self->modules->{$name} ) { |
||||
$self->logger->error("Unknown choice '$name'"); |
||||
return 0; |
||||
} |
||||
|
||||
# Store choice if module loops |
||||
$req->pdata->{_choice} = $name; |
||||
$req->data->{_authChoice} = $name; |
||||
return $name if ( $req->data->{ "enabledMods" . $self->type } ); |
||||
$req->sessionInfo->{_choice} = $name; |
||||
$req->data->{ "enabledMods" . $self->type } = [ $self->modules->{$name} ]; |
||||
$self->p->_authentication->authnLevel("${name}AuthnLevel"); |
||||
return $name; |
||||
} |
||||
|
||||
sub name { |
||||
my ( $self, $req, $type ) = @_; |
||||
unless ($req) { |
||||
return 'Choice'; |
||||
} |
||||
my $n = ref( $req->data->{ "enabledMods" . $self->type }->[0] ); |
||||
$n =~ s/^Lemonldap::NG::Portal::(?:(?:UserDB|Auth)::)?//; |
||||
return $n; |
||||
} |
||||
|
||||
sub getForm { |
||||
my ( $self, $req ) = @_; |
||||
my @authLoop; |
||||
|
||||
# Test authentication choices |
||||
unless ( ref $self->conf->{authChoiceModules} eq 'HASH' ) { |
||||
$self->logger->warn("No authentication choices defined"); |
||||
return []; |
||||
} |
||||
|
||||
foreach ( sort keys %{ $self->conf->{authChoiceModules} } ) { |
||||
|
||||
my $name = $_; |
||||
|
||||
# Name can have a digit as first character |
||||
# for sorting purpose |
||||
# Remove it in displayed name |
||||
$name =~ s/^(\d*)?(\s*)?//; |
||||
|
||||
# Replace also _ by space for a nice display |
||||
$name =~ s/\_/ /g; |
||||
|
||||
# Find modules associated to authChoice |
||||
my ( $auth, $userDB, $passwordDB, $url, $condition ) = |
||||
split( /[;\|]/, $self->conf->{authChoiceModules}->{$_} ); |
||||
|
||||
unless ( $_choiceRules->{$_} ) { |
||||
$self->logger->error("$_ has no rule"); |
||||
$_choiceRules->{$_} = sub { 1 }; |
||||
} |
||||
unless ( $_choiceRules->{$_}->( $req->env ) ) { |
||||
$self->logger->debug( |
||||
"Condition returns false, authentication choice $_ will not be displayed" |
||||
); |
||||
} |
||||
else { |
||||
$self->logger->debug("Displaying authentication choice $_"); |
||||
if ( $auth and $userDB and $passwordDB ) { |
||||
|
||||
# Default URL |
||||
$req->{cspFormAction} ||= ''; |
||||
if ( |
||||
defined $url |
||||
and not $self->checkXSSAttack( 'URI', |
||||
$req->env->{'REQUEST_URI'} ) |
||||
and $url =~ |
||||
q%^(https?://)?[^\s/.?#$].[^\s]+$% # URL must be well formatted |
||||
) |
||||
{ |
||||
#$url .= $req->env->{'REQUEST_URI'}; |
||||
|
||||
# Avoid append same URL |
||||
$req->{cspFormAction} .= " $url" |
||||
unless $req->{cspFormAction} =~ qr%\b$url\b%; |
||||
} |
||||
else { |
||||
$url .= '#'; |
||||
} |
||||
$self->logger->debug("Use URL $url"); |
||||
|
||||
# Options to store in the loop |
||||
my $optionsLoop = { |
||||
name => $name, |
||||
key => $_, |
||||
module => $auth, |
||||
url => $url, |
||||
CHOICE_VALUE => $req->data->{_authChoice}, |
||||
CHOICE_PARAM => $self->conf->{authChoiceParam}, |
||||
}; |
||||
|
||||
# Get displayType for this module |
||||
no strict 'refs'; |
||||
my $displayType = eval { |
||||
"Lemonldap::NG::Portal::Auth::${auth}" |
||||
->can('getForm')->( $self, $req ); |
||||
} || 'logo'; |
||||
|
||||
$self->logger->debug( 'Display type ' |
||||
. ( ref $displayType ? '[ref]' : $displayType ) |
||||
. ' for module $auth' ); |
||||
|
||||
#$optionsLoop->{$displayType} = 1 unless(ref $displayType); |
||||
$optionsLoop->{form} = $displayType; |
||||
my $logo = $_; |
||||
if ( $auth eq 'Custom' ) { |
||||
$logo = |
||||
( $self->{conf}->{customAuth} =~ /::(\w+)$/ )[0]; |
||||
} |
||||
|
||||
# If displayType is logo, check if key.png is available |
||||
if ( -e $self->conf->{templateDir} |
||||
. "/../htdocs/static/common/modules/" |
||||
. $logo |
||||
. ".png" ) |
||||
{ |
||||
$optionsLoop->{logoFile} = $logo . ".png"; |
||||
} |
||||
else { |
||||
$optionsLoop->{logoFile} = $auth . ".png"; |
||||
} |
||||
|
||||
# Register item in loop |
||||
push @authLoop, $optionsLoop; |
||||
|
||||
$self->logger->debug( |
||||
"Authentication choice $name will be displayed"); |
||||
} |
||||
else { |
||||
$req->error("Authentication choice $_ value is invalid"); |
||||
return 0; |
||||
} |
||||
} |
||||
|
||||
} |
||||
|
||||
open my $fh, |
||||
$self->conf->{templateDir} . '/' |
||||
. $self->p->getSkin($req) |
||||
. "/choice.tpl" |
||||
or die $!; |
||||
my $res; |
||||
{ |
||||
local $/ = undef; |
||||
$res = readline $fh; |
||||
} |
||||
close $fh; |
||||
while ( $res =~ m#<TMPL_LOOP NAME="AUTH_LOOP">(.*?)</TMPL_LOOP>#s ) { |
||||
my $content = $1; |
||||
my $new = ''; |
||||
foreach (@authLoop) { |
||||
my $tmp = $content; |
||||
if ( my @match = ( $tmp =~ m#<TMPL_VAR NAME="(\w+)">#gs ) ) { |
||||
foreach my $key (@match) { |
||||
$tmp =~ s#<TMPL_VAR NAME="$key">#$_->{$key}#gs |
||||
if defined $_->{$key}; |
||||
} |
||||
} |
||||
$tmp =~ s#__LLNG_FORM__#<TMPL_INCLUDE NAME="$_->{form}.tpl">#gs; |
||||
$new .= $tmp; |
||||
} |
||||
$res =~ s#<TMPL_LOOP NAME="AUTH_LOOP">.*?</TMPL_LOOP>#$new#s; |
||||
} |
||||
$req->tplParams->{CHOICE_PARAM} = $self->conf->{authChoiceParam}; |
||||
return IO::String->new($res); |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,181 @@ |
||||
package Lemonldap::NG::Portal::Lib::LDAP; |
||||
|
||||
use strict; |
||||
use Mouse; |
||||
use Lemonldap::NG::Portal::Lib::Net::LDAP; |
||||
use Lemonldap::NG::Portal::Main::Constants |
||||
qw(PE_OK PE_LDAPCONNECTFAILED PE_LDAPERROR PE_BADCREDENTIALS); |
||||
|
||||
extends 'Lemonldap::NG::Common::Module'; |
||||
|
||||
our $VERSION = '2.1.0'; |
||||
|
||||
# PROPERTIES |
||||
|
||||
has ldap => ( |
||||
is => 'rw', |
||||
lazy => 1, |
||||
builder => 'newLdap', |
||||
); |
||||
|
||||
has attrs => ( |
||||
is => 'rw', |
||||
lazy => 1, |
||||
builder => sub { |
||||
return [ |
||||
values %{ $_[0]->{conf}->{exportedVars} }, |
||||
values %{ $_[0]->{conf}->{ldapExportedVars} } |
||||
]; |
||||
} |
||||
); |
||||
|
||||
sub newLdap { |
||||
my $self = $_[0]; |
||||
my $ldap; |
||||
|
||||
# Build object and test LDAP connexion |
||||
unless ( |
||||
$ldap = Lemonldap::NG::Portal::Lib::Net::LDAP->new( |
||||
{ p => $self->{p}, conf => $self->{conf} } |
||||
) |
||||
) |
||||
{ |
||||
$self->logger->error("LDAP initialization error: $@"); |
||||
return undef; |
||||
} |
||||
|
||||
# Test connection |
||||
my $msg = $ldap->bind; |
||||
if ( $msg->code ) { |
||||
$self->logger->error( 'LDAP test has failed: ' . $msg->error ); |
||||
} |
||||
elsif ( $self->{conf}->{ldapPpolicyControl} and not $ldap->loadPP() ) { |
||||
$self->logger->error("LDAP password policy error"); |
||||
} |
||||
return $ldap; |
||||
} |
||||
|
||||
has filter => ( |
||||
is => 'rw', |
||||
lazy => 1, |
||||
builder => 'buildFilter', |
||||
); |
||||
|
||||
has mailFilter => ( |
||||
is => 'rw', |
||||
lazy => 1, |
||||
builder => 'buildMailFilter', |
||||
); |
||||
|
||||
sub buildFilter { |
||||
return $_[0]->_buildFilter( $_[0]->conf->{AuthLDAPFilter} |
||||
|| $_[0]->conf->{LDAPFilter} |
||||
|| '(&(uid=$user)(objectClass=inetOrgPerson))' ); |
||||
} |
||||
|
||||
sub buildMailFilter { |
||||
my $f = $_[0]->conf->{mailLDAPFilter} |
||||
|| '(&(mail=$user)(objectClass=inetOrgPerson))'; |
||||
$f =~ s/\$mail\b/\$user/g; |
||||
return $_[0]->_buildFilter($f); |
||||
} |
||||
|
||||
sub _buildFilter { |
||||
my ( $self, $filter ) = @_; |
||||
my $conf = $self->{conf}; |
||||
$self->{p}->logger->debug("LDAP Search base: $_[0]->{conf}->{ldapBase}"); |
||||
$filter =~ s/"/\\"/g; |
||||
$filter =~ s/\$(\w+)/".\$req->{sessionInfo}->{$1}."/g; |
||||
$filter =~ s/\$req->\{sessionInfo\}->\{user\}/\$req->{user}/g; |
||||
$filter =~ |
||||
s/\$req->\{sessionInfo\}->\{(_?password|mail)\}/\$req->{data}->{$1}/g; |
||||
$self->{p}->logger->debug("LDAP transformed filter: $filter"); |
||||
$filter = "sub{my(\$req)=\$_[0];return \"$filter\";}"; |
||||
my $res = eval $filter; |
||||
|
||||
if ($@) { |
||||
$self->error("Unable to build fiter: $@"); |
||||
} |
||||
return $res; |
||||
} |
||||
|
||||
# INITIALIZATION |
||||
|
||||
sub init { |
||||
my ($self) = @_; |
||||
$self->ldap |
||||
or $self->logger->error( |
||||
"LDAP initialization has failed, but let's continue"); |
||||
$self->filter; |
||||
} |
||||
|
||||
# RUNNING METHODS |
||||
|
||||
sub getUser { |
||||
my ( $self, $req, %args ) = @_; |
||||
|
||||
$self->validateLdap; |
||||
|
||||
unless ( $self->ldap ) { |
||||
return PE_LDAPCONNECTFAILED; |
||||
} |
||||
|
||||
$self->bind(); |
||||
|
||||
my $mesg = $self->ldap->search( |
||||
base => $self->conf->{ldapBase}, |
||||
scope => 'sub', |
||||
filter => ( |
||||
$args{useMail} |
||||
? $self->mailFilter->($req) |
||||
: $self->filter->($req) |
||||
), |
||||
defer => $self->conf->{ldapSearchDeref} || 'find', |
||||
attrs => $self->attrs, |
||||
); |
||||
if ( $mesg->code() != 0 ) { |
||||
$self->logger->error( |
||||
'LDAP Search error ' . $mesg->code . ": " . $mesg->error ); |
||||
return PE_LDAPERROR; |
||||
} |
||||
if ( $mesg->count() > 1 ) { |
||||
$self->logger->error('More than one entry returned by LDAP directory'); |
||||
eval { $self->p->_authentication->setSecurity($req) }; |
||||
return PE_BADCREDENTIALS; |
||||
} |
||||
unless ( $req->data->{ldapentry} = $mesg->entry(0) ) { |
||||
$self->userLogger->warn("$req->{user} was not found in LDAP directory"); |
||||
eval { $self->p->_authentication->setSecurity($req) }; |
||||
return PE_BADCREDENTIALS; |
||||
} |
||||
$req->data->{dn} = $req->data->{ldapentry}->dn(); |
||||
PE_OK; |
||||
} |
||||
|
||||
# Validate LDAP connection before use |
||||
sub validateLdap { |
||||
my ($self) = @_; |
||||
unless ($self->ldap |
||||
and $self->ldap->root_dse( attrs => ['supportedLDAPVersion'] ) ) |
||||
{ |
||||
$self->ldap->DESTROY if ( $self->ldap ); |
||||
$self->ldap( $self->newLdap ); |
||||
} |
||||
} |
||||
|
||||
# Bind |
||||
sub bind { |
||||
my $self = shift; |
||||
|
||||
$self->validateLdap; |
||||
|
||||
return undef unless ( $self->ldap ); |
||||
my $msg = $self->ldap->bind(@_); |
||||
if ( $msg->code ) { |
||||
$self->logger->error( $msg->error ); |
||||
return undef; |
||||
} |
||||
return 1; |
||||
} |
||||
|
||||
1; |
||||
@ -0,0 +1,248 @@ |
||||
## @file |
||||
# OpenID SREG extension for Lemonldap::NG::Portal::Issuer::OpenID class |
||||
|
||||
## @class |
||||
# OpenID SREG extension for Lemonldap::NG::Portal::Issuer::OpenID class |
||||
|
||||
package Lemonldap::NG::Portal::Lib::OpenID::SREG; |
||||
|
||||
use strict; |
||||
use Lemonldap::NG::Common::Regexp; |
||||
|
||||
our $VERSION = '2.1.0'; |
||||
|
||||
## @method protected hash sregHook(hash prm) |
||||
# Hook called to add SREG parameters to the OpenID response |
||||
# @return Hash containing wanted parameters |
||||
sub sregHook { |
||||
my ( $self, $req, $u, $trust_root, $is_id, $is_trusted, $prm ) = @_; |
||||
my ( @req, @opt ); |
||||
|
||||
# Refuse federation if rejected by user |
||||
if ( $req->param('confirm') and $req->param('confirm') == -1 ) { |
||||
my %h; |
||||
$h{$_} = undef foreach ( |
||||
qw(fullname nickname language postcode timezone country gender email dob) |
||||
); |
||||
$self->p->updatePersistentSession( $req, \%h ); |
||||
return 0; |
||||
} |
||||
|
||||
# If identity is not trusted, does nothing |
||||
return ( 0, $prm ) unless ( $is_id and $is_trusted ); |
||||
|
||||
$self->logger->debug("SREG start"); |
||||
|
||||
my $accepted = 1; |
||||
|
||||
# Check all parameters |
||||
my @pol; |
||||
while ( my ( $k, $v ) = each %$prm ) { |
||||
|
||||
# Store policy if provided |
||||
if ( $k eq 'policy_url' ) { |
||||
if ( $v =~ Lemonldap::NG::Common::Regexp::HTTP_URI ) { |
||||
push @pol, { url => $v }; |
||||
|
||||
# Question: is it important to notify policy changes ? |
||||
# if yes, uncomment this |
||||
#my $p = |
||||
# $req->{sessionInfo}->{"_openidTrust$trust_root\_Policy"}; |
||||
#$accepted = 0 unless ( $p and $p eq $v ); |
||||
} |
||||
else { |
||||
$self->logger->error("Bad policy url"); |
||||
} |
||||
} |
||||
|
||||
# Parse required attributes |
||||
elsif ( $k eq 'required' ) { |
||||
$self->logger->debug("Required attr $v"); |
||||
push @req, split( /,/, $v ); |
||||
} |
||||
|
||||
# Parse optional attributes |
||||
elsif ( $k eq 'optional' ) { |
||||
$self->logger->debug("Optional attr $v"); |
||||
push @opt, |
||||
grep { defined $self->conf->{"openIdSreg_$trust_root$_"} } |
||||
split( /,/, $v ); |
||||
} |
||||
else { |
||||
$self->logger->error("Unknown OpenID SREG request $k"); |
||||
} |
||||
} |
||||
$req->data->{_openIdTrustExtMsg} .= $self->loadTemplate( |
||||
$req, |
||||
'openIdPol', |
||||
params => { |
||||
policies => \@pol, |
||||
} |
||||
) if (@pol); |
||||
|
||||
# Check if required keys are valid SREG requests |
||||
# Question: reject bad SREG request ? Not done yet |
||||
@req = sregfilter( $self, @req ); |
||||
@opt = sregfilter( $self, @opt ); |
||||
|
||||
# Return if nothing is asked |
||||
return ( 1, {} ) unless ( @req or @opt ); |
||||
|
||||
# If a required data is not available, returns nothing |
||||
foreach my $k (@req) { |
||||
unless ( $self->conf->{"openIdSreg_$k"} ) { |
||||
$self->logger->notice( |
||||
"Parameter $k is required by $trust_root but not defined in configuration" |
||||
); |
||||
|
||||
$req->info( |
||||
$self->loadTemplate( |
||||
$req, 'simpleInfo', |
||||
params => { trspan => "openidRpns,$k" } |
||||
) |
||||
); |
||||
return ( 0, {} ); |
||||
} |
||||
} |
||||
|
||||
# Now set data |
||||
my ( %r, %msg, %ag, %toStore ); |
||||
|
||||
# Requested parameters: check if already agreed or confirm is set |
||||
foreach my $k (@req) { |
||||
my $agree = $req->{sessionInfo}->{"_openidTrust$trust_root\_$k"}; |
||||
if ($accepted) { |
||||
unless ( $req->param('confirm') or $agree ) { |
||||
$accepted = 0; |
||||
} |
||||
elsif ( !$agree ) { |
||||
$toStore{"_openidTrust$trust_root\_$k"} = 1; |
||||
} |
||||
} |
||||
my $tmp = $self->conf->{"openIdSreg_$k"}; |
||||
$tmp =~ s/^\$//; |
||||
$msg{req}->{$k} = $r{$k} = |
||||
$req->{sessionInfo}->{ $self->{"openIdSreg_$k"} } || ''; |
||||
} |
||||
|
||||
# Optional parameters: |
||||
foreach my $k (@opt) { |
||||
my $tmp = $self->conf->{"openIdSreg_$k"}; |
||||
$tmp =~ s/^\$//; |
||||
my $agree = $req->{sessionInfo}->{"_openidTrust$trust_root\_$k"}; |
||||
if ($accepted) { |
||||
|
||||
# First, check if already accepted |
||||
unless ( $req->param('confirm') or defined($agree) ) { |
||||
$accepted = 0; |
||||
$r{$k} = $req->{sessionInfo}->{$tmp} |
||||
|| ''; |
||||
} |
||||
|
||||
# If confirmation is returned, check the value for this field |
||||
elsif ( $req->param('confirm') == 1 ) { |
||||
my $ck = 0; |
||||
if ( defined( $req->param("sreg_$k") ) ) { |
||||
$ck = ( $req->param("sreg_$k") eq 'OK' ) || 0; |
||||
} |
||||
|
||||
# Store the value returned |
||||
if ( !defined($agree) or $agree != $ck ) { |
||||
$toStore{"_openidTrust$trust_root\_$k"} = $ck; |
||||
$agree = $ck; |
||||
} |
||||
} |
||||
} |
||||
|
||||
$msg{opt}->{$k} = $req->{sessionInfo}->{$tmp} || ''; |
||||
|
||||
# Store the value only if user agree it |
||||
if ($agree) { |
||||
$r{$k} = $msg{opt}->{$k}; |
||||
$ag{$k} = 1; |
||||
} |
||||
elsif ( !defined($agree) ) { |
||||
$ag{$k} = 1; |
||||
} |
||||
else { |
||||
$ag{$k} = 0; |
||||
} |
||||
} |
||||
$self->p->updatePersistentSession( $req, \%toStore ) if (%toStore); |
||||
|
||||
# Check if user has agreed request |
||||
if ($accepted) { |
||||
$self->userLogger->info( |
||||
$req->{sessionInfo}->{ $self->conf->{whatToTrace} } |
||||
. " has accepted OpenID SREG exchange with $trust_root" ); |
||||
return ( 1, \%r ); |
||||
} |
||||
|
||||
# else build message and return 0 |
||||
else { |
||||
my ( @mopt, @mreq ); |
||||
|
||||
# No choice for requested parameters: just an information |
||||
foreach my $k (@req) { |
||||
utf8::decode( $msg{req}->{$k} ); |
||||
push @mreq, { k => $k, m => $msg{req}->{$k} }; |
||||
} |
||||
|
||||
# For optional parameters: checkboxes are displayed |
||||
foreach my $k (@opt) { |
||||
utf8::decode( $msg{opt}->{$k} ); |
||||
push @mopt, |
||||
{ |
||||
k => $k, |
||||
m => $msg{opt}->{$k}, |
||||
c => ( $ag{$k} ? 'checked' : '' ) |
||||
}; |
||||
} |
||||
|
||||
$req->data->{_openIdTrustExtMsg} .= $self->loadTemplate( |
||||
$req, |
||||
'openIdTrust', |
||||
params => { |
||||
required => \@mreq, |
||||
optional => \@mopt, |
||||
} |
||||
); |
||||
|
||||
$self->logger->debug('Building validation form'); |
||||
return ( 0, $prm ); |
||||
} |
||||
} |
||||
|
||||
## @method private array sregfilter(array attr) |
||||
# Filter the arguments passed as parameters by checking their compliance with |
||||
# SREG. |
||||
# @return fitered data |
||||
sub sregfilter { |
||||
my ( $self, @attr ) = @_; |
||||
my ( @ret, @rej ); |
||||
|
||||
# Browse attributes |
||||
foreach my $s (@attr) { |
||||
if ( $s =~ |
||||
/^(?:(?:(?:full|nick)nam|languag|postcod|timezon)e|country|gender|email|dob)$/ |
||||
) |
||||
{ |
||||
push @ret, $s; |
||||
} |
||||
else { |
||||
$s =~ s/\W/\./sg; |
||||
push @rej, $s; |
||||
} |
||||
} |
||||
|
||||
# Warn if some parameters are rejected |
||||
if (@rej) { |
||||
$self->logger->warn( "Requested parameter(s) " |
||||
. join( ',', @rej ) |
||||
. "is(are) not valid OpenID SREG parameter(s)" ); |
||||
} |
||||
|
||||
# Return valid SREG parameters |
||||
return @ret; |
||||
} |
||||
1; |
||||
@ -0,0 +1,232 @@ |
||||
## @file |
||||
# Subclass of Net::OpenID::Server that manage OpenID extensions |
||||
|
||||
## @class |
||||
# Subclass of Net::OpenID::Server that manage OpenID extensions |
||||
package Lemonldap::NG::Portal::Lib::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 = '2.1.0'; |
||||
|
||||
use constant OPENID2_NS => 'http://specs.openid.net/auth/2.0'; |
||||
|
||||
use constant OPENID2_ID_SELECT => |
||||
'http://specs.openid.net/auth/2.0/identifier_select'; |
||||
|
||||
*_push_url_arg = |
||||
( $Net::OpenID::Server::VERSION >= 1.09 ) |
||||
? *OpenID::util::push_url_arg |
||||
: *Net::OpenID::Server::_push_url_arg; |
||||
|
||||
## @cmethod Lemonldap::NG::Portal::Lib::OpenID::Server new(hash opts) |
||||
# Call Net::OpenID::Server::new() and store extensions |
||||
# @param %opts Net::OpenID::Server options |
||||
# @return Lemonldap::NG::Portal::Lib::OpenID::Server new object |
||||
sub new { |
||||
my $class = shift; |
||||
my $self = fields::new($class); |
||||
my %opts = @_; |
||||
$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::Lib::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 =~ m!^https?://! ); |
||||
|
||||
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->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 ); |
||||
} |
||||
} |
||||
} |
||||
|
||||
1; |
||||
__END__ |
||||
|
||||
=encoding utf8 |
||||
|
||||
=head1 NAME |
||||
|
||||
Lemonldap::NG::Portal::Lib::OpenID::Server - Add capability to manage extensions to |
||||
Net::OpenID::Server |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
Lemonldap::NG::Portal::Lib::OpenID::Server adds capability to manage extensions to |
||||
Net::OpenID::Server. |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<http://lemonldap-ng.org>, L<Net::OpenID::Server> |
||||
|
||||
=head1 AUTHORS |
||||
|
||||
=over |
||||
|
||||
=item LemonLDAP::NG team L<http://lemonldap-ng.org/team> |
||||
|
||||
=back |
||||
|
||||
=head1 BUG REPORT |
||||
|
||||
Use OW2 system to report bug or ask for features: |
||||
L<https://gitlab.ow2.org/lemonldap-ng/lemonldap-ng/issues> |
||||
|
||||
=head1 DOWNLOAD |
||||
|
||||
Lemonldap::NG is available at |
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274> |
||||
|
||||
=head1 COPYRIGHT AND LICENSE |
||||
|
||||
See COPYING file for details. |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the terms of the GNU General Public License as published by |
||||
the Free Software Foundation; either version 2, or (at your option) |
||||
any later version. |
||||
|
||||
This program is distributed in the hope that it will be useful, |
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of |
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
||||
GNU General Public License for more details. |
||||
|
||||
You should have received a copy of the GNU General Public License |
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>. |
||||
|
||||
=cut |
||||
@ -0,0 +1,52 @@ |
||||
##@file |
||||
# Slave common functions |
||||
|
||||
##@class |
||||
# Slave common functions |
||||
package Lemonldap::NG::Portal::Lib::Slave; |
||||
|
||||
use Exporter; |
||||
use base qw(Exporter); |
||||
use strict; |
||||
|
||||
our @EXPORT = qw(checkIP checkHeader); |
||||
our $VERSION = '2.1.0'; |
||||
|
||||
# RUNNING METHODS |
||||
|
||||
## @method Lemonldap::NG::Portal::_Slave checkIP() |
||||
# @return true if remote IP is accredited in LL::NG conf |
||||
sub checkIP { |
||||
my ( $self, $req ) = @_; |
||||
my $remoteIP = $req->address; |
||||
return 1 |
||||
if (!$self->conf->{slaveMasterIP} |
||||
|| $self->conf->{slaveMasterIP} =~ /\b$remoteIP\b/ ); |
||||
|
||||
$self->userLogger->warn('Client IP not accredited for Slave module'); |
||||
return 0; |
||||
} |
||||
|
||||
## @method Lemonldap::NG::Portal::_Slave checkHeader() |
||||
# @return true if header content matches LL::NG conf |
||||
sub checkHeader { |
||||
my ( $self, $req ) = @_; |
||||
return 1 |
||||
unless ( $self->conf->{slaveHeaderName} |
||||
and $self->conf->{slaveHeaderContent} ); |
||||
|
||||
my $slave_header = 'HTTP_' . uc( $self->{conf}->{slaveHeaderName} ); |
||||
$slave_header =~ s/\-/_/g; |
||||
my $headerContent = $req->env->{$slave_header}; |
||||
$self->logger->debug( |
||||
"Required Slave header => $self->{conf}->{slaveHeaderName}"); |
||||
$self->logger->debug("Received Slave header content => $headerContent"); |
||||
return 1 |
||||
if ( $headerContent |
||||
and $self->conf->{slaveHeaderContent} =~ /\b$headerContent\b/ ); |
||||
|
||||
$self->userLogger->warn('Matching header not found for Slave module '); |
||||
return 0; |
||||
} |
||||
|
||||
1; |
||||
Loading…
Reference in new issue