2009-04-07 22:38:24 +02:00
|
|
|
## @file
|
|
|
|
# Common SAML functions
|
|
|
|
|
|
|
|
## @class
|
|
|
|
# Common SAML functions
|
|
|
|
package Lemonldap::NG::Portal::_SAML;
|
|
|
|
|
|
|
|
use strict;
|
2010-01-29 11:44:56 +01:00
|
|
|
use base qw(Exporter);
|
2010-02-05 18:18:09 +01:00
|
|
|
use XML::Simple;
|
2010-01-29 11:44:56 +01:00
|
|
|
|
2010-02-04 17:02:02 +01:00
|
|
|
our @EXPORT = qw(
|
2010-02-05 18:18:09 +01:00
|
|
|
loadLasso checkLassoError createServer addIDP addProvider getOrganizationName
|
2010-02-04 17:02:02 +01:00
|
|
|
createAuthnRequest createLogin getHttpMethod initAuthnRequest
|
2010-02-09 10:02:39 +01:00
|
|
|
buildAuthnRequestMsg processAuthnResponseMsg getNameIdentifier
|
2010-02-04 17:02:02 +01:00
|
|
|
);
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
2010-02-08 18:24:45 +01:00
|
|
|
our $_samlCache;
|
2009-04-07 22:38:24 +02:00
|
|
|
|
2010-02-08 11:06:21 +01:00
|
|
|
BEGIN {
|
|
|
|
|
|
|
|
# Load Glib if available
|
|
|
|
eval 'use Glib;';
|
|
|
|
if ($@) {
|
|
|
|
print STDERR
|
|
|
|
"Glib Lasso messages will not be catched (require Glib module)\n";
|
|
|
|
eval "use constant GLIB => 0";
|
|
|
|
}
|
|
|
|
else {
|
2010-02-08 11:16:28 +01:00
|
|
|
eval "use constant GLIB => 1";
|
2010-02-08 11:06:21 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
# Load Lasso.pm
|
|
|
|
eval 'use Lasso;';
|
|
|
|
if ($@) {
|
|
|
|
print STDERR "Lasso.pm not loaded :$@";
|
|
|
|
eval 'use constant LASSO => 0;use constant BADLASSO => 0;';
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
no strict 'subs';
|
|
|
|
eval 'use constant LASSO => 1';
|
2010-02-08 18:24:45 +01:00
|
|
|
|
|
|
|
# Check Lasso version >= 2.2.91
|
2010-02-08 11:06:21 +01:00
|
|
|
my $lasso_check_version_mode = Lasso::Constants::CHECK_VERSION_NUMERIC;
|
|
|
|
my $check_version =
|
|
|
|
Lasso::check_version( 2, 2, 91, $lasso_check_version_mode );
|
|
|
|
unless ($check_version) {
|
|
|
|
eval 'use constant BADLASSO => 1';
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
eval 'use constant BADLASSO => 0';
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
2010-01-29 11:44:56 +01:00
|
|
|
## @method boolean loadLasso()
|
|
|
|
# Load Lasso module
|
|
|
|
# @return boolean result
|
|
|
|
sub loadLasso {
|
|
|
|
my $self = shift;
|
|
|
|
|
2010-02-01 16:24:56 +01:00
|
|
|
# Catch GLib Lasso messages (require Glib)
|
2010-02-08 11:06:21 +01:00
|
|
|
if (GLIB) {
|
2010-02-01 16:24:56 +01:00
|
|
|
Glib::Log->set_handler(
|
|
|
|
"Lasso",
|
|
|
|
[qw/ error critical warning message info debug /],
|
|
|
|
sub {
|
|
|
|
$self->lmLog( $_[0] . " error " . $_[1] . ": " . $_[2],
|
|
|
|
'debug' );
|
|
|
|
}
|
|
|
|
);
|
|
|
|
}
|
2010-02-08 18:24:45 +01:00
|
|
|
|
2010-02-08 11:06:21 +01:00
|
|
|
unless (LASSO) {
|
|
|
|
$self->lmLog( "Module Lasso not loaded (see bellow)", 'error' );
|
2010-01-29 11:44:56 +01:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2010-02-08 11:06:21 +01:00
|
|
|
if (BADLASSO) {
|
2010-02-01 15:01:28 +01:00
|
|
|
$self->lmLog( 'Lasso version >= 2.2.91 required', 'error' );
|
2010-01-29 18:33:35 +01:00
|
|
|
return 0;
|
|
|
|
}
|
2010-02-08 18:24:45 +01:00
|
|
|
|
2010-01-29 18:33:35 +01:00
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method boolean checkLassoError(Lasso::Error error, string level)
|
|
|
|
# Log Lasso error code and message if this is actually a Lasso::Error with code > 0
|
|
|
|
# @param Lasso::Error Lasso error object
|
|
|
|
# @param string optional log level (debug by default)
|
|
|
|
# @return 1 if no error
|
|
|
|
sub checkLassoError {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $error, $level ) = splice @_;
|
|
|
|
my $level ||= 'debug';
|
2010-01-29 18:33:35 +01:00
|
|
|
|
2010-02-03 11:59:53 +01:00
|
|
|
# If $error is not a Lasso::Error object, display error string
|
|
|
|
unless ( ref($error) and $error->isa("Lasso::Error") ) {
|
|
|
|
return 1 unless $error;
|
|
|
|
$self->lmLog( "Lasso error: $error", $level );
|
|
|
|
return 0;
|
|
|
|
}
|
2010-01-29 18:33:35 +01:00
|
|
|
|
2010-02-03 11:59:53 +01:00
|
|
|
# Else check error code and error message
|
2010-01-29 18:33:35 +01:00
|
|
|
if ( $error->{code} ) {
|
|
|
|
$self->lmLog(
|
|
|
|
"Lasso error code " . $error->{code} . ": " . $error->{message},
|
|
|
|
$level );
|
|
|
|
return 0;
|
|
|
|
}
|
2010-01-29 11:44:56 +01:00
|
|
|
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2010-02-01 18:07:40 +01:00
|
|
|
## @method Lasso::Server createServer(string metadata, string private_key, string private_key_password, string certificate)
|
2010-01-29 18:33:35 +01:00
|
|
|
# Load service metadata and create Lasso::Server object
|
2010-02-01 15:01:28 +01:00
|
|
|
# @param string metadata
|
2010-02-03 11:59:53 +01:00
|
|
|
# @param string private key
|
2010-02-01 15:01:28 +01:00
|
|
|
# @param string optional private key password
|
|
|
|
# @param string optional certificate
|
2010-01-29 18:33:35 +01:00
|
|
|
# @return Lasso::Server object
|
|
|
|
sub createServer {
|
2010-02-08 18:24:45 +01:00
|
|
|
my ( $self, $metadata, $private_key, $private_key_password, $certificate ) =
|
|
|
|
splice @_;
|
2010-02-08 11:16:28 +01:00
|
|
|
my $server = $_samlCache->{$metadata};
|
2010-02-08 18:24:45 +01:00
|
|
|
return $server if ($server);
|
2010-01-29 18:33:35 +01:00
|
|
|
|
2010-02-03 11:59:53 +01:00
|
|
|
eval {
|
|
|
|
$server = Lasso::Server::new_from_buffers( $metadata, $private_key,
|
2010-02-08 11:06:21 +01:00
|
|
|
$private_key_password, $certificate );
|
2010-02-03 11:59:53 +01:00
|
|
|
};
|
2010-01-29 18:33:35 +01:00
|
|
|
|
2010-02-08 18:24:45 +01:00
|
|
|
if ($@) {
|
2010-02-08 11:16:28 +01:00
|
|
|
$self->checkLassoError($@);
|
|
|
|
return;
|
|
|
|
}
|
2010-01-29 18:33:35 +01:00
|
|
|
|
|
|
|
return $server;
|
|
|
|
}
|
|
|
|
|
2010-02-01 18:07:40 +01:00
|
|
|
## @method boolean addIDP(Lasso::Server server, string metadata, string public_key, string ca_cert_chain)
|
|
|
|
# Add IDP to an existing Lasso::Server
|
|
|
|
# @param Lasso::Server Lasso::Server object
|
|
|
|
# @param string metadata IDP metadata
|
|
|
|
# @param string optional public key
|
|
|
|
# @param string optional ca cert chain
|
|
|
|
# @return boolean result
|
|
|
|
sub addIDP {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $server, $metadata, $public_key, $ca_cert_chain ) = splice @_;
|
2010-02-01 18:07:40 +01:00
|
|
|
|
|
|
|
return 0 unless ( $server->isa("Lasso::Server") and defined $metadata );
|
|
|
|
|
2010-02-08 11:06:21 +01:00
|
|
|
no strict 'subs';
|
2010-02-01 18:07:40 +01:00
|
|
|
return $self->addProvider( $server, Lasso::Constants::PROVIDER_ROLE_IDP,
|
|
|
|
$metadata, $public_key, $ca_cert_chain );
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method boolean addProvider(Lasso::Server server, int role, string metadata, string public_key, string ca_cert_chain)
|
|
|
|
# Add provider to an existing Lasso::Server
|
|
|
|
# @param Lasso::Server Lasso::Server object
|
|
|
|
# @param int role (IDP, SP or Both)
|
|
|
|
# @param string metadata IDP metadata
|
|
|
|
# @param string optional public key
|
|
|
|
# @param string optional ca cert chain
|
|
|
|
# @return boolean result
|
|
|
|
sub addProvider {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $server, $role, $metadata, $public_key, $ca_cert_chain ) =
|
|
|
|
splice @_;
|
2010-02-01 18:07:40 +01:00
|
|
|
|
|
|
|
return 0
|
|
|
|
unless ( $server->isa("Lasso::Server")
|
|
|
|
and defined $role
|
|
|
|
and defined $metadata );
|
|
|
|
|
|
|
|
eval {
|
2010-02-02 22:55:25 +01:00
|
|
|
Lasso::Server::add_provider_from_buffer( $server, $role, $metadata,
|
2010-02-01 18:07:40 +01:00
|
|
|
$public_key, $ca_cert_chain );
|
|
|
|
};
|
|
|
|
|
|
|
|
return $self->checkLassoError($@);
|
|
|
|
|
|
|
|
}
|
2010-02-05 18:18:09 +01:00
|
|
|
|
|
|
|
## @method string getOrganizationName(Lasso::Server server, string idp)
|
|
|
|
# Return name of organization picked up from metadata
|
|
|
|
#@param server Lasso::Server object
|
|
|
|
#@param string entityID
|
|
|
|
#@return string organization name
|
|
|
|
sub getOrganizationName {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $server, $idp ) = splice @_;
|
|
|
|
my ( $provider, $node );
|
2010-02-05 18:18:09 +01:00
|
|
|
|
|
|
|
# Get provider from server
|
|
|
|
eval { $provider = Lasso::Server::get_provider( $server, $idp ); };
|
2010-02-09 21:49:23 +01:00
|
|
|
|
2010-02-08 18:24:45 +01:00
|
|
|
if ($@) {
|
2010-02-08 11:16:28 +01:00
|
|
|
$self->checkLassoError($@);
|
|
|
|
return;
|
|
|
|
}
|
2010-02-05 18:18:09 +01:00
|
|
|
|
|
|
|
# Get organization node
|
|
|
|
eval { $node = Lasso::Provider::get_organization($provider); };
|
2010-02-09 21:49:23 +01:00
|
|
|
|
2010-02-08 18:24:45 +01:00
|
|
|
if ($@) {
|
2010-02-08 11:16:28 +01:00
|
|
|
$self->checkLassoError($@);
|
|
|
|
return;
|
|
|
|
}
|
2010-02-05 18:18:09 +01:00
|
|
|
|
|
|
|
# Extract organization name
|
|
|
|
my $xs = XML::Simple->new();
|
|
|
|
my $data = $xs->XMLin($node);
|
|
|
|
return $data->{OrganizationName}->{content};
|
|
|
|
}
|
|
|
|
|
2010-02-04 17:02:02 +01:00
|
|
|
## @method Lasso::Login createAuthnRequest(Lasso::Server server, string idp)
|
|
|
|
# Create authentication request for selected IDP
|
|
|
|
# @param Lasso::Server server
|
|
|
|
# @param string entityID
|
|
|
|
# @return Lasso::Login object
|
|
|
|
sub createAuthnRequest {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $server, $idp ) = splice @_;
|
2010-02-04 17:02:02 +01:00
|
|
|
|
|
|
|
# Create Lasso Login
|
|
|
|
my $login = $self->createLogin($server);
|
|
|
|
|
|
|
|
unless ($login) {
|
|
|
|
$self->lmLog( 'Unable to create Lasso login', 'error' );
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Get HTTP method for selected IDP
|
|
|
|
my $method = $self->getHttpMethod( $server, $idp );
|
|
|
|
|
|
|
|
$self->lmLog( "Use HTTP method $method", 'debug' );
|
|
|
|
|
|
|
|
# Init authentication request
|
|
|
|
unless ( $self->initAuthnRequest( $login, $idp, $method ) ) {
|
|
|
|
$self->lmLog( "Could not initiate authentication request on $idp",
|
|
|
|
'error' );
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Build authentication request
|
|
|
|
unless ( $self->buildAuthnRequestMsg($login) ) {
|
|
|
|
$self->lmLog( "Could not build authentication request on $idp",
|
|
|
|
'error' );
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
return $login;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method Lasso::Login createLogin(Lasso::Server server)
|
|
|
|
# Create Lasso::Login object
|
|
|
|
# @param Lasso::Server server
|
|
|
|
# @return Lasso::Login object
|
|
|
|
sub createLogin {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $server ) = splice @_;
|
2010-02-04 17:02:02 +01:00
|
|
|
my $login;
|
|
|
|
|
|
|
|
eval { $login = Lasso::Login->new($server); };
|
|
|
|
|
2010-02-09 21:49:23 +01:00
|
|
|
if ($@) {
|
2010-02-04 17:02:02 +01:00
|
|
|
$self->checkLassoError($@);
|
2010-02-09 21:49:23 +01:00
|
|
|
return;
|
|
|
|
}
|
2010-02-04 17:02:02 +01:00
|
|
|
|
|
|
|
return $login;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method int getHttpMethod(Lasso::Server server, string idp)
|
|
|
|
# Find a compatible HTTP method
|
|
|
|
# @param Lasso::Server server
|
|
|
|
# @param string entityID
|
|
|
|
# @return int HTTP method
|
|
|
|
sub getHttpMethod {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $server, $idp ) = splice @_;
|
2010-02-04 17:02:02 +01:00
|
|
|
|
|
|
|
# TODO
|
|
|
|
|
|
|
|
# By default, use HTTP REDIRECT
|
2010-02-08 11:21:34 +01:00
|
|
|
no strict 'subs';
|
2010-02-04 17:02:02 +01:00
|
|
|
return Lasso::Constants::HTTP_METHOD_REDIRECT;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method boolean initAuthnRequest(Lasso::Login login, string idp, int method)
|
|
|
|
# Init authentication request
|
|
|
|
# @param Lasso::Login login
|
|
|
|
# @param string entityID
|
|
|
|
# @param int HTTP method
|
|
|
|
# @return boolean result
|
|
|
|
sub initAuthnRequest {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $login, $idp, $method ) = splice @_;
|
2010-02-04 17:02:02 +01:00
|
|
|
|
|
|
|
eval { Lasso::Login::init_authn_request( $login, $idp, $method ); };
|
|
|
|
|
|
|
|
return $self->checkLassoError($@);
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method boolean buildAuthnRequestMsg(Lasso::Login login)
|
|
|
|
# Build authentication request message
|
|
|
|
# @param Lasso::Login login
|
|
|
|
# @return boolean result
|
|
|
|
sub buildAuthnRequestMsg {
|
2010-02-08 11:06:21 +01:00
|
|
|
my ( $self, $login ) = splice @_;
|
2010-02-04 17:02:02 +01:00
|
|
|
|
|
|
|
eval { Lasso::Login::build_authn_request_msg($login); };
|
|
|
|
|
|
|
|
return $self->checkLassoError($@);
|
|
|
|
}
|
2010-02-01 18:07:40 +01:00
|
|
|
|
2010-02-08 18:24:45 +01:00
|
|
|
## @method boolean processAuthnResponseMsg(Lasso::Login login, string response)
|
|
|
|
# Process authentication response message
|
|
|
|
# @param login Lasso::Login object
|
|
|
|
# @param response SAML response
|
|
|
|
# @return result
|
|
|
|
sub processAuthnResponseMsg {
|
|
|
|
my ( $self, $login, $response ) = splice @_;
|
|
|
|
|
|
|
|
eval { Lasso::Login::process_authn_response_msg( $login, $response ); };
|
|
|
|
|
|
|
|
return $self->checkLassoError($@);
|
|
|
|
}
|
|
|
|
|
2010-02-09 10:02:39 +01:00
|
|
|
## @method Lasso::Saml2NameID getNameIdentifer(Lasso::Profile profile)
|
|
|
|
# Get NameID from Lasso Profile
|
|
|
|
# @param profile Lasso::Profile object
|
|
|
|
# @return result or NULL if error
|
|
|
|
sub getNameIdentifier {
|
|
|
|
my ( $self, $profile ) = splice @_;
|
|
|
|
my $nameid;
|
|
|
|
|
|
|
|
eval { $nameid = Lasso::Profile::get_nameIdentifier($profile); };
|
|
|
|
|
|
|
|
if ($@) {
|
|
|
|
$self->checkLassoError($@);
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
return $nameid;
|
|
|
|
}
|
|
|
|
|
2009-04-07 22:38:24 +02:00
|
|
|
1;
|
2010-01-29 18:33:35 +01:00
|
|
|
|
2009-04-07 22:38:24 +02:00
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2010-01-03 09:09:59 +01:00
|
|
|
=encoding utf8
|
|
|
|
|
2010-01-29 11:44:56 +01:00
|
|
|
Lemonldap::NG::Portal::_SAML
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
2010-01-29 11:44:56 +01:00
|
|
|
use Lemonldap::NG::Portal::_SAML;
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
2010-01-29 11:44:56 +01:00
|
|
|
This module contains common methods for SAML authentication
|
|
|
|
and user information loading
|
|
|
|
|
|
|
|
=head1 METHODS
|
|
|
|
|
|
|
|
=head2 loadLasso
|
|
|
|
|
|
|
|
Load Lasso module
|
2009-04-07 22:38:24 +02:00
|
|
|
|
2010-01-29 18:33:35 +01:00
|
|
|
=head2 checkLassoError
|
|
|
|
|
|
|
|
Log Lasso error code and message if this is actually a Lasso::Error with code > 0
|
|
|
|
|
|
|
|
=head2 createServer
|
|
|
|
|
|
|
|
Load service metadata and create Lasso::Server object
|
|
|
|
|
2010-02-01 18:07:40 +01:00
|
|
|
=head2 addIDP
|
|
|
|
|
|
|
|
Add IDP to an existing Lasso::Server
|
|
|
|
|
|
|
|
=head2 addProvider
|
|
|
|
|
|
|
|
Add provider to an existing Lasso::Server
|
|
|
|
|
2010-02-05 18:18:09 +01:00
|
|
|
=head2 getOrganizationName
|
|
|
|
|
|
|
|
Return name of organization picked up from metadata
|
|
|
|
|
2010-02-04 17:02:02 +01:00
|
|
|
=head2 createAuthnRequest
|
|
|
|
|
|
|
|
Create authentication request for selected IDP
|
|
|
|
|
|
|
|
=head2 createLogin
|
|
|
|
|
|
|
|
Create Lasso::Login object
|
|
|
|
|
|
|
|
=head2 getHttpMethod
|
|
|
|
|
|
|
|
Find a compatible HTTP method
|
|
|
|
|
|
|
|
=head2 initAuthnRequest
|
|
|
|
|
|
|
|
Init authentication request
|
|
|
|
|
|
|
|
=head2 buildAuthnRequestMsg
|
|
|
|
|
|
|
|
Build authentication request message
|
|
|
|
|
2010-02-08 18:24:45 +01:00
|
|
|
=head2 processAuthnResponseMsg
|
|
|
|
|
|
|
|
Process authentication response message
|
|
|
|
|
2010-02-09 10:02:39 +01:00
|
|
|
=head2 getNameIdentifier
|
|
|
|
|
|
|
|
Get NameID from Lasso Profile
|
|
|
|
|
2009-04-07 22:38:24 +02:00
|
|
|
=head1 SEE ALSO
|
|
|
|
|
2010-01-29 11:44:56 +01:00
|
|
|
L<Lemonldap::NG::Portal::AuthSAML>, L<Lemonldap::NG::Portal::UserDBSAML>
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
2010-01-29 11:44:56 +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
|
|
|
|
|
2010-01-29 11:44:56 +01:00
|
|
|
Copyright (C) 2009 by Xavier Guimard, Clement Oudot
|
2009-04-07 22:38:24 +02:00
|
|
|
|
|
|
|
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
|