2009-04-07 22:38:24 +02:00
|
|
|
## @file
|
|
|
|
# UserDB SAML module
|
|
|
|
|
|
|
|
## @class
|
|
|
|
# UserDB SAML module
|
|
|
|
package Lemonldap::NG::Portal::UserDBSAML;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use Lemonldap::NG::Portal::Simple;
|
2010-02-26 11:53:43 +01:00
|
|
|
use Lemonldap::NG::Portal::_SAML;
|
|
|
|
our @ISA = qw(Lemonldap::NG::Portal::_SAML);
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
|
|
|
|
|
|
|
## @apmethod int userDBInit()
|
|
|
|
# Check if authentication module is SAML
|
|
|
|
# @return Lemonldap::NG::Portal error code
|
|
|
|
sub userDBInit {
|
|
|
|
my $self = shift;
|
|
|
|
if ( $self->{authentication} =~ /^SAML/
|
|
|
|
or $self->{stack}->[0]->[0]->{m} =~ /^SAML/ )
|
|
|
|
{
|
|
|
|
return PE_OK;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
## @apmethod int getUser()
|
|
|
|
# Does nothing
|
|
|
|
# @return Lemonldap::NG::Portal error code
|
|
|
|
sub getUser {
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @apmethod int setSessionInfo()
|
2010-03-01 18:16:42 +01:00
|
|
|
# Get all required attributes
|
2009-04-07 22:38:24 +02:00
|
|
|
# @return Lemonldap::NG::Portal error code
|
|
|
|
sub setSessionInfo {
|
2010-03-01 18:16:42 +01:00
|
|
|
my $self = shift;
|
|
|
|
my $server = $self->{_lassoServer};
|
2010-03-03 17:54:23 +01:00
|
|
|
my $login = $self->{_lassoLogin};
|
2010-03-01 18:16:42 +01:00
|
|
|
my $idp = $self->{_idp};
|
|
|
|
|
|
|
|
my $exportedAttr;
|
|
|
|
|
|
|
|
# Get all required attributes, not already set
|
|
|
|
# in setAuthSessionInfo()
|
|
|
|
foreach ( keys %{ $self->{samlIDPMetaDataExportedAttributes}->{$idp} } ) {
|
|
|
|
|
|
|
|
# Extract fields from exportedAttr value
|
|
|
|
my ( $mandatory, $name, $format, $friendly_name ) =
|
|
|
|
split( /;/,
|
|
|
|
$self->{samlIDPMetaDataExportedAttributes}->{$idp}->{$_} );
|
|
|
|
|
|
|
|
# Keep mandatory attributes not sent in authentication response
|
|
|
|
if ( $mandatory and not defined $self->{sessionInfo}->{$_} ) {
|
|
|
|
$exportedAttr->{$_} =
|
|
|
|
$self->{samlIDPMetaDataExportedAttributes}->{$idp}->{$_};
|
|
|
|
$self->lmLog( "Attribute $_ will be requested to $idp", 'debug' );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
unless ( keys %$exportedAttr ) {
|
|
|
|
$self->lmLog(
|
|
|
|
"All mandatory attributes were present in authentication response",
|
|
|
|
'debug'
|
|
|
|
);
|
|
|
|
return PE_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Build Attribute Request
|
2010-03-03 17:54:23 +01:00
|
|
|
my $IDPentityID = $self->{_idpList}->{$idp}->{entityID};
|
|
|
|
my $query =
|
|
|
|
$self->createAttributeRequest( $server, $login, $IDPentityID,
|
|
|
|
$exportedAttr );
|
|
|
|
|
|
|
|
unless ($query) {
|
|
|
|
$self->lmLog( "Unable to build attribute request for $idp", 'error' );
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Use SOAP to send request and get response
|
|
|
|
my $query_url = $query->msg_url;
|
|
|
|
my $query_body = $query->msg_body;
|
|
|
|
|
|
|
|
# Send SOAP request and manage response
|
|
|
|
my $response = $self->sendSOAPMessage( $query_url, $query_body );
|
|
|
|
|
|
|
|
unless ($response) {
|
|
|
|
$self->lmLog( "No attribute response to SOAP request", 'error' );
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Manage Attribute Response
|
|
|
|
my $result = $self->processAttributeResponse( $server, $response );
|
|
|
|
|
|
|
|
unless ($result) {
|
|
|
|
$self->lmLog( "Fail to process attribute response", 'error' );
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Attributes in response
|
|
|
|
my @response_attributes;
|
|
|
|
eval {
|
|
|
|
@response_attributes =
|
|
|
|
$result->getAssertion()->AttributeStatement()->Attribute();
|
|
|
|
};
|
|
|
|
if ($@) {
|
|
|
|
$self->lmLog( "No attributes defined in attribute response", 'error' );
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Check we have all required attributes
|
|
|
|
foreach ( keys %$exportedAttr ) {
|
|
|
|
|
|
|
|
# Extract fields from exportedAttr value
|
|
|
|
my ( $mandatory, $name, $format, $friendly_name ) =
|
|
|
|
split( /;/, $exportedAttr->{$_} );
|
|
|
|
|
|
|
|
# Try to get value
|
|
|
|
my $value = $self->getAttributeValue( $name, $format, $friendly_name,
|
|
|
|
\@response_attributes );
|
|
|
|
|
|
|
|
unless ($value) {
|
|
|
|
$self->lmLog(
|
|
|
|
"Attribute $_ is mandatory, but was not delivered by $idp",
|
|
|
|
'error' );
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Store value in sessionInfo
|
|
|
|
$self->{sessionInfo}->{$_} = $value;
|
|
|
|
}
|
2010-03-01 18:16:42 +01:00
|
|
|
|
|
|
|
return PE_OK;
|
|
|
|
|
2009-04-07 22:38:24 +02:00
|
|
|
}
|
|
|
|
|
2009-06-04 11:13:03 +02:00
|
|
|
## @apmethod int setGroups()
|
|
|
|
# Does nothing
|
|
|
|
# @return Lemonldap::NG::Portal error code
|
|
|
|
sub setGroups {
|
|
|
|
PE_OK;
|
|
|
|
}
|
2010-03-01 18:16:42 +01:00
|
|
|
|
2009-04-07 22:38:24 +02:00
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2010-01-03 09:09:59 +01:00
|
|
|
=encoding utf8
|
|
|
|
|
2010-03-01 18:16:42 +01:00
|
|
|
Lemonldap::NG::Portal::UserDBSAML - SAML User backend
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
use Lemonldap::NG::Portal::UserDBSAML;
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
2010-03-01 18:16:42 +01:00
|
|
|
Collect all required attributes trough SAML Attribute Requests
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
2010-03-01 18:16:42 +01:00
|
|
|
L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::AuthSAML>, L<Lemonldap::NG::Portal::_SAML>
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
2010-03-01 18:16:42 +01:00
|
|
|
Xavier Guimard, E<lt>x.guimard@free.frE<gt>, Clement Oudot, E<lt>coudot@linagora.comE<gt>
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
|
|
|
Copyright (C) 2009 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
|