lemonldap-ng/modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SAML.pm

225 lines
5.6 KiB
Perl
Raw Normal View History

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-01 18:07:40 +01:00
our @EXPORT = qw(loadLasso checkLassoError createServer addIDP addProvider);
2009-04-07 22:38:24 +02:00
our $VERSION = '0.01';
2010-01-29 11:44:56 +01:00
## @method boolean loadLasso()
# Load Lasso module
# @return boolean result
sub loadLasso {
my $self = shift;
# Do not load Lasso twice
return 1 if $self->{_lasso};
2010-02-01 16:24:56 +01:00
# Catch GLib Lasso messages (require Glib)
eval { use Glib; };
unless ($@) {
Glib::Log->set_handler(
"Lasso",
[qw/ error critical warning message info debug /],
sub {
$self->lmLog( $_[0] . " error " . $_[1] . ": " . $_[2],
'debug' );
}
);
}
else {
$self->lmLog(
"Glib Lasso messages will not be catched (require Glib module)",
'info' );
}
2010-01-29 18:33:35 +01:00
# Load Lasso.pm
eval { use Lasso; };
2010-01-29 11:44:56 +01:00
if ($@) {
$self->lmLog( "Module Lasso not found in @INC", 'error' );
$self->lmLog( "$@", 'debug' );
return 0;
}
# Check Lasso version >= 2.2.91
2010-01-29 18:33:35 +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 );
2010-01-29 18:33:35 +01:00
unless ($check_version) {
$self->lmLog( 'Lasso version >= 2.2.91 required', 'error' );
2010-01-29 18:33:35 +01:00
return 0;
}
$self->lmLog( "Module Lasso loaded", 'debug' );
# Remember we have loaded Lasso
$self->{_lasso} = 1;
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 {
my $self = shift;
my $error = shift;
my $level = shift || 'debug';
# Return if $error is not a Lasso::Error object
return 1 unless ( ref($error) and $error->isa("Lasso::Error") );
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
# @param string metadata
# @param string optional private key
# @param string optional private key password
# @param string optional certificate
2010-01-29 18:33:35 +01:00
# @return Lasso::Server object
sub createServer {
my $self = shift;
my $metadata = shift;
my $private_key = shift || '';
my $private_key_password = shift || '';
my $certificate = shift || '';
2010-01-29 18:33:35 +01:00
my $server = Lasso::Server::new_from_buffers( $metadata, $private_key,
$private_key_password, $certificate );
2010-01-29 18:33:35 +01:00
unless ($server) {
$self->lmLog( 'Unable to create Lasso server', 'error' );
}
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 {
my $self = shift;
my $server = shift;
my $metadata = shift;
my $public_key = shift;
my $ca_cert_chain = shift;
2010-02-01 18:07:40 +01:00
return 0 unless ( $server->isa("Lasso::Server") and defined $metadata );
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 {
my $self = shift;
my $server = shift;
my $role = shift;
my $metadata = shift;
my $public_key = shift;
my $ca_cert_chain = shift;
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($@);
}
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
=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
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