2008-12-03 14:27:30 +01:00
|
|
|
## @file
|
|
|
|
# Base package for Lemonldap::NG portal
|
|
|
|
#
|
|
|
|
# @copy 2005, 2006, 2007, 2008, Xavier Guimard <x.guimard@free.fr>
|
|
|
|
|
|
|
|
## @class
|
|
|
|
# Base class for Lemonldap::NG portal
|
2006-12-18 12:32:33 +01:00
|
|
|
package Lemonldap::NG::Portal::Simple;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
|
|
|
|
use Exporter 'import';
|
|
|
|
|
|
|
|
use warnings;
|
|
|
|
use MIME::Base64;
|
2008-11-21 18:51:52 +01:00
|
|
|
use Lemonldap::NG::Common::CGI;
|
2007-02-11 09:31:56 +01:00
|
|
|
use CGI::Cookie;
|
2007-03-23 20:56:33 +01:00
|
|
|
require POSIX;
|
2007-03-04 15:52:51 +01:00
|
|
|
use Lemonldap::NG::Portal::_i18n;
|
2008-11-21 18:51:52 +01:00
|
|
|
use Safe;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2008-09-10 12:40:01 +02:00
|
|
|
our $VERSION = '0.86';
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
use base qw(Lemonldap::NG::Common::CGI Exporter);
|
|
|
|
our @ISA;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
# Constants
|
2008-05-30 08:07:37 +02:00
|
|
|
use constant {
|
2008-08-08 18:19:16 +02:00
|
|
|
PE_REDIRECT => -2,
|
|
|
|
PE_DONE => -1,
|
|
|
|
PE_OK => 0,
|
|
|
|
PE_SESSIONEXPIRED => 1,
|
|
|
|
PE_FORMEMPTY => 2,
|
|
|
|
PE_WRONGMANAGERACCOUNT => 3,
|
|
|
|
PE_USERNOTFOUND => 4,
|
|
|
|
PE_BADCREDENTIALS => 5,
|
|
|
|
PE_LDAPCONNECTFAILED => 6,
|
|
|
|
PE_LDAPERROR => 7,
|
|
|
|
PE_APACHESESSIONERROR => 8,
|
|
|
|
PE_FIRSTACCESS => 9,
|
|
|
|
PE_BADCERTIFICATE => 10,
|
|
|
|
PE_PP_ACCOUNT_LOCKED => 21,
|
|
|
|
PE_PP_PASSWORD_EXPIRED => 22,
|
|
|
|
PE_CERTIFICATEREQUIRED => 23,
|
|
|
|
PE_ERROR => 24,
|
|
|
|
PE_PP_CHANGE_AFTER_RESET => 25,
|
|
|
|
PE_PP_PASSWORD_MOD_NOT_ALLOWED => 26,
|
|
|
|
PE_PP_MUST_SUPPLY_OLD_PASSWORD => 27,
|
|
|
|
PE_PP_INSUFFICIENT_PASSWORD_QUALITY => 28,
|
|
|
|
PE_PP_PASSWORD_TOO_SHORT => 29,
|
|
|
|
PE_PP_PASSWORD_TOO_YOUNG => 30,
|
|
|
|
PE_PP_PASSWORD_IN_HISTORY => 31,
|
2008-09-19 17:28:00 +02:00
|
|
|
PE_PP_GRACE => 32,
|
|
|
|
PE_PP_EXP_WARNING => 33,
|
|
|
|
PE_PASSWORD_MISMATCH => 34,
|
|
|
|
PE_PASSWORD_OK => 35,
|
2008-11-24 07:57:18 +01:00
|
|
|
PE_NOTIFICATION => 36,
|
2008-12-03 14:27:30 +01:00
|
|
|
PE_BADURL => 37,
|
2008-05-30 08:07:37 +02:00
|
|
|
};
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2007-01-11 07:42:57 +01:00
|
|
|
# EXPORTER PARAMETERS
|
2008-05-11 21:21:39 +02:00
|
|
|
our @EXPORT =
|
2008-05-25 14:54:45 +02:00
|
|
|
qw( PE_DONE PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT
|
|
|
|
PE_USERNOTFOUND PE_BADCREDENTIALS PE_LDAPCONNECTFAILED PE_LDAPERROR
|
|
|
|
PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE PE_REDIRECT
|
2008-06-06 05:51:39 +02:00
|
|
|
PE_PP_ACCOUNT_LOCKED PE_PP_PASSWORD_EXPIRED PE_CERTIFICATEREQUIRED
|
2008-08-08 18:19:16 +02:00
|
|
|
PE_ERROR PE_PP_CHANGE_AFTER_RESET PE_PP_PASSWORD_MOD_NOT_ALLOWED
|
|
|
|
PE_PP_MUST_SUPPLY_OLD_PASSWORD PE_PP_INSUFFICIENT_PASSWORD_QUALITY
|
|
|
|
PE_PP_PASSWORD_TOO_SHORT PE_PP_PASSWORD_TOO_YOUNG
|
2008-09-19 17:28:00 +02:00
|
|
|
PE_PP_PASSWORD_IN_HISTORY PE_PP_GRACE PE_PP_EXP_WARNING
|
2008-12-03 17:05:27 +01:00
|
|
|
PE_PASSWORD_MISMATCH PE_PASSWORD_OK PE_NOTIFICATION PE_BADURL );
|
2008-05-25 14:54:45 +02:00
|
|
|
our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
|
|
|
|
2008-11-20 19:13:27 +01:00
|
|
|
# Secure jail
|
2008-12-11 18:02:02 +01:00
|
|
|
our $safe;
|
2008-11-20 19:13:27 +01:00
|
|
|
our $self; # Safe cannot share a variable declared with my
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @cmethod new($args)
|
|
|
|
# Class constructor.
|
|
|
|
# @param args hash reference
|
|
|
|
# @return Lemonldap::NG::Portal object
|
2006-12-18 12:32:33 +01:00
|
|
|
sub new {
|
2008-12-06 08:27:35 +01:00
|
|
|
binmode( STDOUT, ":utf8" );
|
2006-12-18 12:32:33 +01:00
|
|
|
my $class = shift;
|
2008-12-07 15:12:36 +01:00
|
|
|
return $class if ( ref($class) );
|
2008-12-11 18:02:02 +01:00
|
|
|
$self = $class->SUPER::new();
|
2008-11-21 18:51:52 +01:00
|
|
|
$self->getConf(@_)
|
|
|
|
or $self->abort( "Configuration error",
|
|
|
|
"Unable to get configuration: $Lemonldap::NG::Common::Conf::msg" );
|
|
|
|
$self->abort( "Configuration error",
|
|
|
|
"You've to indicate a an Apache::Session storage module !" )
|
2006-12-18 12:32:33 +01:00
|
|
|
unless ( $self->{globalStorage} );
|
|
|
|
eval "require " . $self->{globalStorage};
|
2008-11-21 18:51:52 +01:00
|
|
|
$self->abort( "Configuration error",
|
|
|
|
"Module " . $self->{globalStorage} . " not found in \@INC" )
|
|
|
|
if ($@);
|
|
|
|
$self->abort( "Configuration error",
|
|
|
|
"You've to indicate a domain for cookies" )
|
|
|
|
unless ( $self->{domain} );
|
2006-12-18 12:32:33 +01:00
|
|
|
$self->{domain} =~ s/^([^\.])/.$1/;
|
2008-10-07 22:15:48 +02:00
|
|
|
$self->{securedCookie} ||= 0;
|
|
|
|
$self->{cookieName} ||= "lemonldap";
|
|
|
|
$self->{authentication} ||= 'LDAP';
|
|
|
|
$self->{userDB} ||= 'LDAP';
|
2008-06-06 05:51:39 +02:00
|
|
|
$self->{authentication} =~ s/^ldap/LDAP/;
|
2008-12-06 08:27:35 +01:00
|
|
|
$self->{mustRedirect} =
|
|
|
|
( $ENV{REQUEST_METHOD} eq 'POST' or $self->param('logout') ) ? 1 : 0;
|
2008-06-06 05:51:39 +02:00
|
|
|
|
|
|
|
# Authentication module is required and has to be in @ISA
|
2008-10-07 22:15:48 +02:00
|
|
|
foreach (qw(authentication userDB)) {
|
|
|
|
my $tmp =
|
|
|
|
'Lemonldap::NG::Portal::'
|
|
|
|
. ( $_ eq 'userDB' ? 'UserDB' : 'Auth' )
|
|
|
|
. $self->{$_};
|
2008-10-05 20:42:50 +02:00
|
|
|
$tmp =~ s/\s.*$//;
|
|
|
|
eval "require $tmp";
|
2008-11-21 18:51:52 +01:00
|
|
|
$self->abort( "Configuration error", $@ ) if ($@);
|
2008-10-05 20:42:50 +02:00
|
|
|
push @ISA, $tmp;
|
|
|
|
|
|
|
|
# $self->{authentication} and $self->{userDB} can contains arguments
|
|
|
|
# (key1 = scalar_value; key2 = ...)
|
|
|
|
$tmp = $self->{$_};
|
|
|
|
$tmp =~ s/^\w+\s*//;
|
|
|
|
my %h = split( /\s*[=;]\s*/, $tmp ) if ($tmp);
|
|
|
|
%$self = ( %h, %$self );
|
|
|
|
}
|
2008-11-24 07:57:18 +01:00
|
|
|
if ( $self->{notification} ) {
|
|
|
|
require Lemonldap::NG::Common::Notification;
|
|
|
|
}
|
2008-12-07 15:12:36 +01:00
|
|
|
if ( $self->{Soap} ) {
|
|
|
|
require SOAP::Lite;
|
2008-12-07 21:07:52 +01:00
|
|
|
$self->soapTest("${class}::getCookies ${class}::error");
|
2008-12-07 15:12:36 +01:00
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method protected getConf($args)
|
|
|
|
# Copy all parameters in caller object.
|
|
|
|
# @param args hash-ref
|
2006-12-18 12:32:33 +01:00
|
|
|
sub getConf {
|
|
|
|
my ($self) = shift;
|
|
|
|
my %args;
|
|
|
|
if ( ref( $_[0] ) ) {
|
|
|
|
%args = %{ $_[0] };
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
%args = @_;
|
|
|
|
}
|
|
|
|
%$self = ( %$self, %args );
|
|
|
|
1;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method protected string error($lang)
|
2008-12-07 21:07:52 +01:00
|
|
|
# error calls Portal/_i18n.pm to display error in the wanted language.
|
2008-12-03 14:27:30 +01:00
|
|
|
# @param lang optional (browser language is used instead)
|
|
|
|
# @return error message
|
2006-12-18 12:32:33 +01:00
|
|
|
sub error {
|
|
|
|
my $self = shift;
|
2008-12-07 21:07:52 +01:00
|
|
|
my $lang = shift || $ENV{HTTP_ACCEPT_LANGUAGE};
|
2008-12-08 11:56:19 +01:00
|
|
|
my $code = shift || $self->{error};
|
2008-12-07 21:07:52 +01:00
|
|
|
return &Lemonldap::NG::Portal::_i18n::error( $code, $lang );
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method int error_type()
|
2008-09-18 10:34:17 +02:00
|
|
|
# error_type tells if error is positive, warning or negative
|
|
|
|
sub error_type {
|
|
|
|
my $self = shift;
|
2008-12-07 21:07:52 +01:00
|
|
|
my $code = shift || $self->{error};
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Positive errors
|
2008-10-07 22:15:48 +02:00
|
|
|
return "positive"
|
|
|
|
if (
|
|
|
|
scalar(
|
2008-12-07 21:07:52 +01:00
|
|
|
grep { /^$code$/ } (
|
2008-10-07 22:15:48 +02:00
|
|
|
-2, #PE_REDIRECT
|
|
|
|
-1, #PE_DONE,
|
|
|
|
0, #PE_OK
|
|
|
|
35, #PE_PASSWORD_OK
|
|
|
|
)
|
|
|
|
)
|
|
|
|
);
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Warning errors
|
2008-10-07 22:15:48 +02:00
|
|
|
return "warning"
|
|
|
|
if (
|
|
|
|
scalar(
|
2008-12-07 21:07:52 +01:00
|
|
|
grep { /^$code$/ } (
|
2008-10-07 22:15:48 +02:00
|
|
|
1, #PE_SESSIONEXPIRED
|
|
|
|
2, #PE_FORMEMPTY
|
|
|
|
9, #PE_FIRSTACCESS
|
|
|
|
32, #PE_PP_GRACE
|
|
|
|
33, #PE_PP_EXP_WARNING
|
2008-11-24 07:57:18 +01:00
|
|
|
36, #PE_NOTIFICATION
|
2008-12-03 17:05:27 +01:00
|
|
|
37, #PE_BADURL
|
2008-10-07 22:15:48 +02:00
|
|
|
)
|
|
|
|
)
|
|
|
|
);
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Negative errors (default)
|
|
|
|
return "negative";
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method translate_template($$text_ref, $lang)
|
|
|
|
# translate_template is used as an HTML::Template filter to tranlate strings in
|
|
|
|
# the wanted language
|
|
|
|
# @param text_ref reference to the string to translate
|
|
|
|
# @param lang optionnal language wanted. Falls to browser language instead.
|
2008-09-03 18:11:16 +02:00
|
|
|
sub translate_template {
|
2008-09-04 08:05:24 +02:00
|
|
|
my $self = shift;
|
|
|
|
my $text_ref = shift;
|
|
|
|
my $lang = shift || $ENV{HTTP_ACCEPT_LANGUAGE};
|
|
|
|
|
|
|
|
# Get the lang code (2 letters)
|
|
|
|
$lang = lc($lang);
|
|
|
|
$lang =~ s/-/_/g;
|
|
|
|
$lang =~ s/^(..).*$/$1/;
|
|
|
|
|
|
|
|
# Test if a translation is available for the selected language
|
|
|
|
# If not available, return the first translated string
|
|
|
|
# <lang en="Please enter your credentials" fr="Merci de vous autentifier"/>
|
2008-09-18 10:34:17 +02:00
|
|
|
if ( $$text_ref =~ m/$lang=\"(.*?)\"/ ) {
|
|
|
|
$$text_ref =~ s/<lang.*$lang=\"(.*?)\".*?\/>/$1/gx;
|
2008-09-04 08:05:24 +02:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
$$text_ref =~ s/<lang\s+\w+=\"(.*?)\".*?\/>/$1/gx;
|
|
|
|
}
|
2008-09-03 18:11:16 +02:00
|
|
|
}
|
|
|
|
|
2007-01-11 07:42:57 +01:00
|
|
|
# CGI.pm overload to add Lemonldap::NG cookie
|
2006-12-18 12:32:33 +01:00
|
|
|
sub header {
|
|
|
|
my $self = shift;
|
|
|
|
if ( $self->{cookie} ) {
|
|
|
|
$self->SUPER::header( @_, -cookie => $self->{cookie} );
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->SUPER::header(@_);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2007-01-11 07:42:57 +01:00
|
|
|
# CGI.pm overload to add Lemonldap::NG cookie
|
2006-12-18 12:32:33 +01:00
|
|
|
sub redirect {
|
|
|
|
my $self = shift;
|
2007-07-30 21:38:19 +02:00
|
|
|
if ( $self->{cookie} ) {
|
|
|
|
$self->SUPER::redirect( @_, -cookie => $self->{cookie} );
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->SUPER::redirect(@_);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2008-10-05 20:42:50 +02:00
|
|
|
# getSessionInfo
|
|
|
|
# Read session and store it in $self
|
|
|
|
sub getSessionInfo {
|
2008-10-07 22:15:48 +02:00
|
|
|
my $self = shift;
|
2008-10-05 20:42:50 +02:00
|
|
|
my %cookies = fetch CGI::Cookie;
|
|
|
|
|
|
|
|
# Test if Lemonldap::NG cookie is available
|
|
|
|
if ( $cookies{ $self->{cookieName} }
|
|
|
|
and my $id = $cookies{ $self->{cookieName} }->value )
|
|
|
|
{
|
|
|
|
my %h;
|
|
|
|
|
|
|
|
# Trying to recover session from global session storage
|
|
|
|
eval {
|
|
|
|
tie %h, $self->{globalStorage}, $id, $self->{globalStorageOptions};
|
|
|
|
};
|
|
|
|
if ( $@ or not tied(%h) ) {
|
|
|
|
|
|
|
|
# Session not available (expired ?)
|
|
|
|
print STDERR
|
|
|
|
"Session $id isn't yet available ($ENV{REMOTE_ADDR})\n";
|
|
|
|
return undef;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Store session values
|
|
|
|
foreach ( keys %h ) {
|
|
|
|
$self->{sessionInfo}->{$_} = $h{$_};
|
|
|
|
}
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-10-05 20:42:50 +02:00
|
|
|
untie %h;
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
2008-10-16 09:35:42 +02:00
|
|
|
# updateSession
|
|
|
|
# Update information stored in session
|
|
|
|
# TODO: update all caches
|
|
|
|
sub updateSession {
|
2008-11-24 07:57:18 +01:00
|
|
|
my $self = shift;
|
2008-11-21 18:51:52 +01:00
|
|
|
my ($infos) = @_;
|
2008-10-16 09:35:42 +02:00
|
|
|
my %cookies = fetch CGI::Cookie;
|
|
|
|
|
|
|
|
# Test if Lemonldap::NG cookie is available
|
|
|
|
if ( $cookies{ $self->{cookieName} }
|
|
|
|
and my $id = $cookies{ $self->{cookieName} }->value )
|
|
|
|
{
|
|
|
|
my %h;
|
|
|
|
|
|
|
|
# Trying to recover session from global session storage
|
|
|
|
eval {
|
|
|
|
tie %h, $self->{globalStorage}, $id, $self->{globalStorageOptions};
|
|
|
|
};
|
|
|
|
if ( $@ or not tied(%h) ) {
|
|
|
|
|
|
|
|
# Session not available (expired ?)
|
|
|
|
print STDERR
|
|
|
|
"Session $id isn't yet available ($ENV{REMOTE_ADDR})\n";
|
|
|
|
return undef;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Store/update session values
|
|
|
|
foreach ( keys %$infos ) {
|
|
|
|
$h{$_} = $infos->{$_};
|
|
|
|
}
|
|
|
|
|
|
|
|
untie %h;
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
2007-10-22 21:42:19 +02:00
|
|
|
# Externalise functions execution
|
|
|
|
sub _subProcess {
|
|
|
|
my $self = shift;
|
|
|
|
my @subs = @_;
|
|
|
|
my $err = undef;
|
|
|
|
|
|
|
|
foreach my $sub (@subs) {
|
|
|
|
if ( $self->{$sub} ) {
|
|
|
|
last if ( $err = &{ $self->{$sub} }($self) );
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
last if ( $err = $self->$sub );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return $err;
|
|
|
|
}
|
|
|
|
|
2008-05-11 21:21:39 +02:00
|
|
|
sub updateStatus {
|
|
|
|
my ($self) = @_;
|
|
|
|
print $Lemonldap::NG::Handler::Simple::statusPipe (
|
|
|
|
$self->{user} ? $self->{user} : $ENV{REMOTE_ADDR} )
|
|
|
|
. " => $ENV{SERVER_NAME}$ENV{SCRIPT_NAME} "
|
|
|
|
. $self->{error} . "\n"
|
|
|
|
if ($Lemonldap::NG::Handler::Simple::statusPipe);
|
|
|
|
}
|
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
sub notification {
|
|
|
|
my ($self) = @_;
|
|
|
|
return $self->{_notification};
|
|
|
|
}
|
|
|
|
|
2008-12-03 17:41:30 +01:00
|
|
|
##@method string get_url()
|
|
|
|
# check url against XSS attacks
|
|
|
|
sub get_url {
|
|
|
|
my ($self) = @_;
|
2008-12-07 10:02:44 +01:00
|
|
|
return if ( $self->param('url') =~ m#[^A-Za-z0-9\+/=]# );
|
2008-12-03 17:41:30 +01:00
|
|
|
return $self->param('url');
|
|
|
|
}
|
2008-06-06 05:51:39 +02:00
|
|
|
|
2008-12-11 18:02:02 +01:00
|
|
|
##@method private object safe()
|
|
|
|
# Provide the security jail.
|
|
|
|
#@return Safe object
|
|
|
|
sub safe {
|
|
|
|
my $self = shift;
|
|
|
|
return $safe if ($safe);
|
|
|
|
$safe = new Safe;
|
|
|
|
my @t =
|
|
|
|
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
|
|
|
|
foreach (@t) {
|
|
|
|
my $sub = $_;
|
|
|
|
unless (/::/) {
|
|
|
|
$sub = ref($self) . "::$_";
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
s/^.*:://;
|
|
|
|
}
|
|
|
|
next if ( $self->can($_) );
|
|
|
|
eval "sub $_ {
|
|
|
|
return $sub( '$self->{portal}', \@_ );
|
|
|
|
}";
|
|
|
|
print STDERR $@ if ($@);
|
|
|
|
}
|
|
|
|
$safe->share( '$self', '&encode_base64', @t );
|
|
|
|
return $safe;
|
|
|
|
}
|
|
|
|
|
2008-12-07 21:07:52 +01:00
|
|
|
####################
|
|
|
|
# SOAP subroutines #
|
|
|
|
####################
|
2007-01-11 07:42:57 +01:00
|
|
|
|
2008-12-07 21:07:52 +01:00
|
|
|
##@method string SOAP::Data getCookies($user,$password)
|
|
|
|
# Called in SOAP context, returns cookies in an array.
|
|
|
|
# This subroutine works only for portals working with user and password
|
2008-12-07 15:12:36 +01:00
|
|
|
#@param user uid
|
|
|
|
#@param password password
|
|
|
|
#@return session => { error => code , cookies => { cookieName1 => value ,... } }
|
|
|
|
sub getCookies {
|
|
|
|
my $class = shift;
|
|
|
|
$self->{error} = PE_OK;
|
2008-12-07 21:07:52 +01:00
|
|
|
( $self->{user}, $self->{password} ) = ( shift, shift );
|
2008-12-07 15:12:36 +01:00
|
|
|
unless ( $self->{user} && $self->{password} ) {
|
|
|
|
$self->{error} = PE_FORMEMPTY;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->{error} = $self->_subProcess(
|
|
|
|
qw(authInit userDBInit getUser setAuthSessionInfo setSessionInfo
|
|
|
|
setMacros setGroups authenticate store buildCookie log)
|
|
|
|
);
|
|
|
|
}
|
|
|
|
my @tmp = ();
|
|
|
|
push @tmp, SOAP::Data->name( error => $self->{error} );
|
|
|
|
unless ( $self->{error} ) {
|
|
|
|
push @tmp,
|
|
|
|
SOAP::Data->name(
|
|
|
|
cookies => \SOAP::Data->value(
|
|
|
|
SOAP::Data->name( $self->{cookieName} => $self->{id} ),
|
|
|
|
)
|
|
|
|
);
|
|
|
|
}
|
|
|
|
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
|
2008-12-07 21:07:52 +01:00
|
|
|
$self->updateStatus;
|
2008-12-07 15:12:36 +01:00
|
|
|
return $res;
|
|
|
|
}
|
|
|
|
|
2008-12-07 21:07:52 +01:00
|
|
|
###############################################################
|
|
|
|
# MAIN subroutine: call all steps until one returns something #
|
|
|
|
# different than PE_OK #
|
|
|
|
###############################################################
|
|
|
|
|
|
|
|
##@method boolean process()
|
|
|
|
# Main method.
|
|
|
|
# process() call functions issued from :
|
|
|
|
# - itself : controlUrlOrigin, controlExistingSession, setMacros, setGroups, store, buildCookie, log, autoredirect
|
|
|
|
# - authentication module : extractFormInfo, setAuthSessionInfo, authenticate
|
|
|
|
# - user database module : getUser, setSessionInfo
|
|
|
|
#@return 1 if user is all is OK, 0 if session isn't created or a notification has to be done
|
|
|
|
|
|
|
|
sub process {
|
|
|
|
my ($self) = @_;
|
|
|
|
$self->{error} = PE_OK;
|
|
|
|
$self->{error} = $self->_subProcess(
|
|
|
|
qw(checkNotifBack controlUrlOrigin controlExistingSession authInit
|
|
|
|
extractFormInfo userDBInit getUser setAuthSessionInfo setSessionInfo
|
|
|
|
setMacros setGroups authenticate store buildCookie log
|
|
|
|
checkNotification autoRedirect)
|
|
|
|
);
|
|
|
|
$self->updateStatus;
|
|
|
|
return ( ( $self->{error} > 0 ) ? 0 : 1 );
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code checkNotifBack()
|
|
|
|
# 1) Checks if a message has to be notified to the connected user.
|
|
|
|
# @return error code
|
2008-11-24 07:57:18 +01:00
|
|
|
sub checkNotifBack {
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
# TODO
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code controlUrlOrigin()
|
|
|
|
# 2) If the user was redirected here, loads 'url' parameter.
|
|
|
|
# @return error_code
|
2006-12-18 12:32:33 +01:00
|
|
|
sub controlUrlOrigin {
|
|
|
|
my $self = shift;
|
|
|
|
if ( $self->param('url') ) {
|
2008-12-07 10:02:44 +01:00
|
|
|
|
|
|
|
# REJECT NON BASE64 URL
|
|
|
|
return PE_BADURL if ( $self->param('url') =~ m#[^A-Za-z0-9\+/=]# );
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
$self->{urldc} = decode_base64( $self->param('url') );
|
2008-12-07 13:15:40 +01:00
|
|
|
$self->{urldc} =~ s/[\r\n]//sg;
|
2008-12-03 17:05:27 +01:00
|
|
|
|
2008-12-07 10:02:44 +01:00
|
|
|
# REJECT [\0<'"`] in URL or encoded '%' and non protected hosts
|
|
|
|
if ( $self->{urldc} =~ /(?:\0|<|'|"|`|\%(?:00|25|3C|22|27|2C))/
|
2008-12-24 10:12:53 +01:00
|
|
|
or $self->{urldc} !~ m#^https?://(?:$self->{reVHosts}|(?:[^/]*)?$self->{domain})(?:/.*)$# )
|
2008-12-06 08:27:35 +01:00
|
|
|
{
|
2008-12-03 17:41:30 +01:00
|
|
|
delete $self->{urldc};
|
2008-12-06 08:27:35 +01:00
|
|
|
return PE_BADURL;
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
2008-12-06 08:27:35 +01:00
|
|
|
elsif ( $self->{mustRedirect} ) {
|
2008-12-01 10:36:02 +01:00
|
|
|
$self->{urldc} = $self->{portal};
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code controlExistingSession()
|
|
|
|
# 3) Control existing sessions.
|
|
|
|
# To overload to control what to do with existing sessions.
|
2007-02-23 06:31:32 +01:00
|
|
|
# what to do with existing sessions ?
|
2008-12-03 14:27:30 +01:00
|
|
|
# - nothing: user is authenticated and process returns true (default)
|
|
|
|
# - delete and create a new session (not implemented)
|
|
|
|
# - re-authentication (set existingSession => sub{PE_OK})
|
|
|
|
# @return error_code
|
2006-12-18 12:32:33 +01:00
|
|
|
sub controlExistingSession {
|
2008-05-11 21:21:39 +02:00
|
|
|
my $self = shift;
|
2007-02-11 09:31:56 +01:00
|
|
|
my %cookies = fetch CGI::Cookie;
|
2008-05-11 21:21:39 +02:00
|
|
|
|
2008-11-04 17:35:16 +01:00
|
|
|
# Store IP address
|
|
|
|
$self->{sessionInfo}->{ipAddr} = $ENV{REMOTE_ADDR};
|
2008-11-21 18:51:52 +01:00
|
|
|
|
2007-02-11 09:31:56 +01:00
|
|
|
# Test if Lemonldap::NG cookie is available
|
2008-05-11 21:21:39 +02:00
|
|
|
if ( $cookies{ $self->{cookieName} }
|
|
|
|
and my $id = $cookies{ $self->{cookieName} }->value )
|
|
|
|
{
|
2007-03-14 08:28:53 +01:00
|
|
|
my %h;
|
2008-05-11 21:21:39 +02:00
|
|
|
|
2007-02-28 13:56:35 +01:00
|
|
|
# Trying to recover session from global session storage
|
|
|
|
eval {
|
2007-03-14 08:28:53 +01:00
|
|
|
tie %h, $self->{globalStorage}, $id, $self->{globalStorageOptions};
|
2007-02-11 09:31:56 +01:00
|
|
|
};
|
2007-03-14 08:28:53 +01:00
|
|
|
if ( $@ or not tied(%h) ) {
|
2008-05-11 21:21:39 +02:00
|
|
|
|
2007-02-28 13:56:35 +01:00
|
|
|
# Session not available (expired ?)
|
2008-05-11 21:21:39 +02:00
|
|
|
print STDERR
|
|
|
|
"Session $id isn't yet available ($ENV{REMOTE_ADDR})\n";
|
2007-02-11 09:31:56 +01:00
|
|
|
return PE_OK;
|
|
|
|
}
|
2007-03-14 08:28:53 +01:00
|
|
|
|
2007-03-18 19:33:38 +01:00
|
|
|
# Logout if required
|
2008-05-11 21:21:39 +02:00
|
|
|
if ( $self->param('logout') ) {
|
|
|
|
|
2007-03-18 19:33:38 +01:00
|
|
|
# Delete session in global storage
|
2007-03-14 08:28:53 +01:00
|
|
|
tied(%h)->delete;
|
2008-05-11 21:21:39 +02:00
|
|
|
|
2007-03-18 19:33:38 +01:00
|
|
|
# Delete cookie
|
2008-12-01 14:39:52 +01:00
|
|
|
push @{ $self->{cookie} },
|
|
|
|
$self->cookie(
|
2008-12-06 08:27:35 +01:00
|
|
|
-name => $self->{cookieName},
|
|
|
|
-value => 0,
|
|
|
|
-domain => $self->{domain},
|
|
|
|
-path => "/",
|
|
|
|
-secure => 0,
|
|
|
|
-expires => '-1d',
|
2008-12-01 14:39:52 +01:00
|
|
|
@_,
|
|
|
|
);
|
2008-12-03 19:30:57 +01:00
|
|
|
$self->{error} = PE_REDIRECT;
|
2008-12-01 14:39:52 +01:00
|
|
|
$self->_subProcess(qw(log autoRedirect));
|
2007-03-14 08:28:53 +01:00
|
|
|
return PE_FIRSTACCESS;
|
|
|
|
}
|
2007-05-23 08:48:07 +02:00
|
|
|
$self->{id} = $id;
|
2008-05-11 21:21:39 +02:00
|
|
|
|
2007-02-11 09:31:56 +01:00
|
|
|
# A session has been find => calling &existingSession
|
2008-05-11 21:21:39 +02:00
|
|
|
my ( $r, $datas );
|
2007-03-14 08:28:53 +01:00
|
|
|
%$datas = %h;
|
|
|
|
untie(%h);
|
2007-02-11 09:31:56 +01:00
|
|
|
if ( $self->{existingSession} ) {
|
2008-05-11 21:21:39 +02:00
|
|
|
$r = &{ $self->{existingSession} }( $self, $id, $datas );
|
2007-02-11 09:31:56 +01:00
|
|
|
}
|
|
|
|
else {
|
2008-05-11 21:21:39 +02:00
|
|
|
$r = $self->existingSession( $id, $datas );
|
2007-02-11 09:31:56 +01:00
|
|
|
}
|
2008-05-11 21:21:39 +02:00
|
|
|
if ( $r == PE_DONE ) {
|
2008-06-06 05:51:39 +02:00
|
|
|
$self->{error} = $self->_subProcess(qw(log autoRedirect));
|
2007-02-11 09:31:56 +01:00
|
|
|
return $self->{error} || PE_DONE;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return $r;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub existingSession {
|
2008-11-21 18:51:52 +01:00
|
|
|
|
2008-11-20 19:13:27 +01:00
|
|
|
#my ( $self, $id, $datas ) = @_;
|
2008-12-01 10:36:02 +01:00
|
|
|
PE_DONE;
|
2006-12-18 12:32:33 +01:00
|
|
|
}
|
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 4. authInit() : must be implemented in Auth* module
|
2008-11-20 19:13:27 +01:00
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 5. extractFormInfo() : must be implemented in Auth* module:
|
2008-11-20 19:13:27 +01:00
|
|
|
# * set $self->{user}
|
|
|
|
# * authenticate user if possible (or do it in 11.)
|
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 6. userDBInit() : must be implemented in User* module
|
2008-11-20 19:13:27 +01:00
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 7. getUser() : must be implemented in User* module
|
2008-11-20 19:13:27 +01:00
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 8. setAuthSessionInfo() : must be implemented in Auth* module:
|
2008-11-20 19:13:27 +01:00
|
|
|
# * store exported datas in $self->{sessionInfo}
|
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 9. setSessionInfo() : must be implemented in User* module:
|
2008-11-20 19:13:27 +01:00
|
|
|
# * store exported datas in $self->{sessionInfo}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code setMacro()
|
|
|
|
# 10) macro mechanism:
|
2008-11-20 19:13:27 +01:00
|
|
|
# * store macro results in $self->{sessionInfo}
|
2008-12-03 14:27:30 +01:00
|
|
|
# @return error_code
|
2007-01-13 20:34:03 +01:00
|
|
|
sub setMacros {
|
2008-11-20 19:13:27 +01:00
|
|
|
local $self = shift;
|
2008-11-21 08:27:08 +01:00
|
|
|
$self->abort( __PACKAGE__ . ": Unable to get configuration" )
|
2008-11-20 19:13:27 +01:00
|
|
|
unless ( $self->getConf(@_) );
|
|
|
|
while ( my ( $n, $e ) = each( %{ $self->{macros} } ) ) {
|
|
|
|
$e =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
|
2008-12-11 18:02:02 +01:00
|
|
|
$self->{sessionInfo}->{$n} = $self->safe->reval($e);
|
2008-11-20 19:13:27 +01:00
|
|
|
}
|
2007-01-13 20:34:03 +01:00
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code setGroups()
|
|
|
|
# 11) groups mechanism:
|
2008-11-20 19:13:27 +01:00
|
|
|
# * store all groups name that the user match in
|
|
|
|
# $self->{sessionInfo}->{groups}
|
2006-12-18 12:32:33 +01:00
|
|
|
sub setGroups {
|
2008-11-20 19:13:27 +01:00
|
|
|
local $self = shift;
|
|
|
|
my $groups;
|
2008-11-21 18:51:52 +01:00
|
|
|
|
2008-11-20 19:13:27 +01:00
|
|
|
#foreach ( keys %{ $self->{groups} } ) {
|
|
|
|
while ( my ( $group, $expr ) = each %{ $self->{groups} } ) {
|
2008-11-24 07:57:18 +01:00
|
|
|
$expr =~ s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
|
2008-11-21 18:51:52 +01:00
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# TODO : custom Functions
|
2008-12-11 18:02:02 +01:00
|
|
|
$groups .= "$group " if ( $self->safe->reval($expr) );
|
2008-11-20 19:13:27 +01:00
|
|
|
}
|
|
|
|
if ( $self->{ldapGroupBase} ) {
|
|
|
|
my $mesg = $self->{ldap}->search(
|
|
|
|
base => $self->{ldapGroupBase},
|
|
|
|
filter => "(|(member="
|
|
|
|
. $self->{dn}
|
|
|
|
. ")(uniqueMember="
|
|
|
|
. $self->{dn} . "))",
|
|
|
|
attrs => ["cn"],
|
|
|
|
);
|
|
|
|
if ( $mesg->code() == 0 ) {
|
|
|
|
foreach my $entry ( $mesg->all_entries ) {
|
|
|
|
my @values = $entry->get_value("cn");
|
|
|
|
$groups .= $values[0] . " ";
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
$self->{sessionInfo}->{groups} = $groups;
|
2006-12-18 12:32:33 +01:00
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-11-24 07:57:18 +01:00
|
|
|
# 12. authenticate() : must be implemented in Auth* module:
|
2008-11-20 19:13:27 +01:00
|
|
|
# * authenticate the user if not done before
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code store()
|
2008-11-24 07:57:18 +01:00
|
|
|
# 13. Now, the user is known, authenticated and session variable are evaluated.
|
2008-11-20 19:13:27 +01:00
|
|
|
# It's time to store his parameters with Apache::Session::* module
|
2008-12-03 14:27:30 +01:00
|
|
|
# @return error_code
|
2006-12-18 12:32:33 +01:00
|
|
|
sub store {
|
|
|
|
my ($self) = @_;
|
|
|
|
my %h;
|
2007-01-04 09:42:13 +01:00
|
|
|
eval {
|
|
|
|
tie %h, $self->{globalStorage}, undef, $self->{globalStorageOptions};
|
|
|
|
};
|
2008-05-11 21:21:39 +02:00
|
|
|
if ($@) {
|
2007-06-13 14:04:02 +02:00
|
|
|
print STDERR "$@\n";
|
|
|
|
return PE_APACHESESSIONERROR;
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
$self->{id} = $h{_session_id};
|
2007-01-04 09:42:13 +01:00
|
|
|
$h{$_} = $self->{sessionInfo}->{$_}
|
|
|
|
foreach ( keys %{ $self->{sessionInfo} } );
|
2006-12-18 12:32:33 +01:00
|
|
|
$h{_utime} = time();
|
|
|
|
untie %h;
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code buildCookie()
|
2008-11-24 07:57:18 +01:00
|
|
|
# 14. If all is done, we build the Lemonldap::NG cookie
|
2008-12-03 14:27:30 +01:00
|
|
|
# @return error_code
|
2006-12-18 12:32:33 +01:00
|
|
|
sub buildCookie {
|
|
|
|
my $self = shift;
|
2008-08-08 18:19:16 +02:00
|
|
|
push @{ $self->{cookie} },
|
|
|
|
$self->cookie(
|
2006-12-18 12:32:33 +01:00
|
|
|
-name => $self->{cookieName},
|
|
|
|
-value => $self->{id},
|
|
|
|
-domain => $self->{domain},
|
|
|
|
-path => "/",
|
|
|
|
-secure => $self->{securedCookie},
|
|
|
|
@_,
|
2008-08-08 18:19:16 +02:00
|
|
|
);
|
2006-12-18 12:32:33 +01:00
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code log()
|
2008-11-24 07:57:18 +01:00
|
|
|
# 15. By default, nothing is logged. Users actions are logged on applications.
|
2007-01-11 07:42:57 +01:00
|
|
|
# It's easy to override this in the contructor :
|
|
|
|
# my $portal = new Lemonldap::NG::Portal ( {
|
|
|
|
# ...
|
|
|
|
# log => sub {use Sys::Syslog; syslog;
|
|
|
|
# openlog("Portal $$", 'ndelay', 'auth');
|
|
|
|
# syslog('notice', 'User '.$self->{user}.' is authenticated');
|
|
|
|
# },
|
|
|
|
# ...
|
|
|
|
# } );
|
2008-12-03 14:27:30 +01:00
|
|
|
# @return error_code
|
2007-01-11 07:42:57 +01:00
|
|
|
sub log {
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code checkNotification()
|
2008-11-24 07:57:18 +01:00
|
|
|
# 16. Check if messages has to be notified
|
2008-12-03 14:27:30 +01:00
|
|
|
# @return error_code
|
2008-11-24 07:57:18 +01:00
|
|
|
sub checkNotification {
|
|
|
|
my $self = shift;
|
|
|
|
if ( $self->{notification} ) {
|
|
|
|
my $tmp;
|
|
|
|
if ( ref( $self->{notification} ) ) {
|
|
|
|
$tmp = $self->{notification};
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$tmp = $self->{configStorage};
|
|
|
|
$tmp->{dbiTable} = 'notifications';
|
|
|
|
}
|
|
|
|
if ( $self->{_notification} =
|
|
|
|
Lemonldap::NG::Common::Notification->new($tmp)
|
|
|
|
->getNotification( $self->{user} ) )
|
|
|
|
{
|
|
|
|
return PE_NOTIFICATION;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return PE_OK;
|
|
|
|
}
|
|
|
|
|
2008-12-03 14:27:30 +01:00
|
|
|
## @method error_code autoRedirect()
|
|
|
|
# 17) If the user was redirected to the portal, we will now redirect him
|
2007-01-11 07:42:57 +01:00
|
|
|
# to the requested URL
|
2008-12-03 14:27:30 +01:00
|
|
|
# @return error_code
|
2006-12-18 12:32:33 +01:00
|
|
|
sub autoRedirect {
|
|
|
|
my $self = shift;
|
|
|
|
if ( my $u = $self->{urldc} ) {
|
2008-05-11 21:21:39 +02:00
|
|
|
$self->updateStatus;
|
2006-12-18 12:32:33 +01:00
|
|
|
print $self->SUPER::redirect(
|
|
|
|
-uri => $u,
|
|
|
|
-cookie => $self->{cookie},
|
|
|
|
-status => '302 Moved Temporary'
|
|
|
|
);
|
|
|
|
|
|
|
|
# Remove this lines if your browsers does not support redirections
|
|
|
|
# print << "EOF";
|
|
|
|
#<html>
|
|
|
|
#<head>
|
|
|
|
#<script language="Javascript">
|
|
|
|
#function redirect() {
|
2007-01-14 20:39:07 +01:00
|
|
|
# document.location.href='$u';
|
2006-12-18 12:32:33 +01:00
|
|
|
#}
|
|
|
|
#</script>
|
|
|
|
#</head>
|
|
|
|
#<body onload="redirect();">
|
2007-01-14 20:39:07 +01:00
|
|
|
# <h2>The document has moved <a href="$u">HERE</a></h2>
|
2006-12-18 12:32:33 +01:00
|
|
|
#</body>
|
|
|
|
#</html>
|
|
|
|
#EOF
|
|
|
|
exit;
|
|
|
|
}
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|
|
|
|
|
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
Lemonldap::NG::Portal::Simple - Base module for building Lemonldap::NG compatible portals
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
use Lemonldap::NG::Portal::Simple;
|
|
|
|
my $portal = new Lemonldap::NG::Portal::Simple(
|
2007-04-10 07:15:26 +02:00
|
|
|
domain => 'example.com',
|
2006-12-18 12:32:33 +01:00
|
|
|
globalStorage => 'Apache::Session::MySQL',
|
2007-01-14 20:39:07 +01:00
|
|
|
globalStorageOptions => {
|
|
|
|
DataSource => 'dbi:mysql:database=dbname;host=127.0.0.1',
|
|
|
|
UserName => 'db_user',
|
|
|
|
Password => 'db_password',
|
|
|
|
TableName => 'sessions',
|
|
|
|
LockDataSource => 'dbi:mysql:database=dbname;host=127.0.0.1',
|
|
|
|
LockUserName => 'db_user',
|
|
|
|
LockPassword => 'db_password',
|
|
|
|
},
|
2007-05-15 06:31:10 +02:00
|
|
|
ldapServer => 'ldap.domaine.com,ldap-backup.domaine.com',
|
2007-01-14 20:39:07 +01:00
|
|
|
securedCookie => 1,
|
2008-09-10 12:40:01 +02:00
|
|
|
exportedVars => {
|
|
|
|
uid => 'uid',
|
|
|
|
cn => 'cn',
|
|
|
|
mail => 'mail',
|
|
|
|
appli => 'appli',
|
2008-12-07 21:07:52 +01:00
|
|
|
},
|
|
|
|
# Activate SOAP service
|
|
|
|
Soap => 1
|
2006-12-18 12:32:33 +01:00
|
|
|
);
|
2008-12-07 21:07:52 +01:00
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
if($portal->process()) {
|
|
|
|
# Write here the menu with CGI methods. This page is displayed ONLY IF
|
|
|
|
# the user was not redirected here.
|
2008-06-06 05:51:39 +02:00
|
|
|
print $portal->header('text/html; charset=utf8'); # DON'T FORGET THIS (see L<CGI(3)>)
|
2006-12-18 12:32:33 +01:00
|
|
|
print "...";
|
|
|
|
|
|
|
|
# or redirect the user to the menu
|
|
|
|
print $portal->redirect( -uri => 'https://portal/menu');
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
# Write here the html form used to authenticate with CGI methods.
|
|
|
|
# $portal->error returns the error message if athentification failed
|
|
|
|
# Warning: by defaut, input names are "user" and "password"
|
2008-06-06 05:51:39 +02:00
|
|
|
print $portal->header('text/html; charset=utf8'); # DON'T FORGET THIS (see L<CGI(3)>)
|
2006-12-18 12:32:33 +01:00
|
|
|
print "...";
|
|
|
|
print '<form method="POST">';
|
|
|
|
# In your form, the following value is required for redirection
|
|
|
|
print '<input type="hidden" name="url" value="'.$portal->param('url').'">';
|
|
|
|
# Next, login and password
|
|
|
|
print 'Login : <input name="user"><br>';
|
|
|
|
print 'Password : <input name="password" type="password" autocomplete="off">';
|
|
|
|
print '<input type="submit" value="go" />';
|
|
|
|
print '</form>';
|
|
|
|
}
|
|
|
|
|
2008-12-07 21:07:52 +01:00
|
|
|
SOAP mode authentication (client) :
|
|
|
|
|
|
|
|
#!/usr/bin/perl -l
|
|
|
|
|
|
|
|
use SOAP::Lite;
|
|
|
|
use Data::Dumper;
|
|
|
|
|
|
|
|
my $soap =
|
|
|
|
SOAP::Lite->proxy('http://auth.example.com/')
|
|
|
|
->uri('urn:/Lemonldap::NG::Portal::SharedConf');
|
|
|
|
my $r = $soap->getCookies( 'user', 'password' );
|
|
|
|
|
|
|
|
# Catch SOAP errors
|
|
|
|
if ( $r->fault ) {
|
|
|
|
print STDERR "SOAP Error: " . $r->fault->{faultstring};
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
my $res = $r->result();
|
|
|
|
|
|
|
|
# If authentication failed, display error
|
|
|
|
if ( $res->{error} ) {
|
|
|
|
print STDERR "Error: " . $soap->error( 'fr', $res->{error} )->result();
|
|
|
|
}
|
|
|
|
|
|
|
|
# print session-ID
|
|
|
|
else {
|
|
|
|
print "Cookie: lemonldap=" . $res->{cookies}->{lemonldap};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
Lemonldap::NG::Portal::Simple is the base module for building Lemonldap::NG
|
|
|
|
compatible portals. You can use it either by inheritance or by writing
|
|
|
|
anonymous methods like in the example above.
|
|
|
|
|
2006-12-24 09:37:27 +01:00
|
|
|
See L<Lemonldap::NG::Portal::SharedConf> for a complete example of use of
|
2006-12-18 12:32:33 +01:00
|
|
|
Lemonldap::Portal::* libraries.
|
|
|
|
|
|
|
|
=head1 METHODS
|
|
|
|
|
|
|
|
=head2 Constructor (new)
|
|
|
|
|
|
|
|
=head3 Args
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
2007-05-15 06:31:10 +02:00
|
|
|
=item * ldapServer: server(s) used to retrive session informations and to valid
|
|
|
|
credentials (localhost by default). More than one server can be set here
|
|
|
|
separated by commas. The servers will be tested in the specifies order.
|
2007-07-22 22:30:27 +02:00
|
|
|
To use TLS, set "ldap+tls://server" and to use LDAPS, set "ldaps://server"
|
|
|
|
instead of server name. If you use TLS, you can set any of the
|
|
|
|
Net::LDAP->start_tls() sub like this:
|
|
|
|
"ldap/tls://server/verify=none&capath=/etc/ssl"
|
|
|
|
You can also use caFile and caPath parameters.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=item * ldapPort: tcp port used by ldap server.
|
|
|
|
|
|
|
|
=item * ldapBase: base of the ldap directory.
|
|
|
|
|
|
|
|
=item * managerDn: dn to used to connect to ldap server. By default, anonymous
|
|
|
|
bind is used.
|
|
|
|
|
|
|
|
=item * managerPassword: password to used to connect to ldap server. By
|
|
|
|
default, anonymous bind is used.
|
|
|
|
|
2007-07-22 22:30:27 +02:00
|
|
|
=item * securedCookie: set it to 1 if you want to protect user cookies.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2007-07-22 22:30:27 +02:00
|
|
|
=item * cookieName: name of the cookie used by Lemonldap::NG (lemon by default).
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=item * domain: cookie domain. You may have to give it else the SSO will work
|
|
|
|
only on your server.
|
|
|
|
|
|
|
|
=item * globalStorage: required: L<Apache::Session> library to used to store
|
2007-07-22 22:30:27 +02:00
|
|
|
session informations.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=item * globalStorageOptions: parameters to bind to L<Apache::Session> module
|
|
|
|
|
|
|
|
=item * authentication: sheme to authenticate users (default: "ldap"). It can
|
|
|
|
be set to:
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
|
|
|
=item * B<SSL>: See L<Lemonldap::NG::Portal::AuthSSL>.
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
2007-07-22 22:30:27 +02:00
|
|
|
=item * caPath, caFile: if you use ldap+tls you can overwrite cafile or capath
|
|
|
|
options with those parameters. This is usefull if you use a shared
|
|
|
|
configuration.
|
|
|
|
|
2008-05-10 11:31:43 +02:00
|
|
|
=item * ldapPpolicyControl: set it to 1 if you want to use LDAP Password Policy
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=back
|
|
|
|
|
|
|
|
=head2 Methods that can be overloaded
|
|
|
|
|
2007-05-05 16:13:44 +02:00
|
|
|
All the functions above can be overloaded to adapt Lemonldap::NG to your
|
2006-12-18 12:32:33 +01:00
|
|
|
environment. They MUST return one of the exported constants (see above)
|
|
|
|
and are called in this order by process().
|
|
|
|
|
|
|
|
=head3 controlUrlOrigin
|
|
|
|
|
2007-05-05 16:13:44 +02:00
|
|
|
If the user was redirected by a Lemonldap::NG handler, stores the url that will be
|
2006-12-18 12:32:33 +01:00
|
|
|
used to redirect the user after authentication.
|
|
|
|
|
|
|
|
=head3 controlExistingSession
|
|
|
|
|
2007-02-11 09:31:56 +01:00
|
|
|
Controls if a previous session is always available. If true, it call the sub
|
|
|
|
C<existingSession> with two parameters: id and a scalar tied on Apache::Session
|
|
|
|
module choosed to store sessions. See bellow
|
|
|
|
|
|
|
|
=head3 existingSession
|
|
|
|
|
|
|
|
This sub is called only if a previous session exists and is available. By
|
|
|
|
defaults, it returns PE_OK so user is re-authenticated. You can overload it:
|
|
|
|
for example if existingSession just returns PE_DONE: authenticated users are
|
|
|
|
not re-authenticated and C<>process> returns true.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head3 extractFormInfo
|
|
|
|
|
2008-06-11 08:00:26 +02:00
|
|
|
Method implemented into Lemonldap::NG::Portal::Auth* modules. By default
|
|
|
|
(ldap bind), converts form input into object variables ($self->{user} and
|
2006-12-18 12:32:33 +01:00
|
|
|
$self->{password}).
|
|
|
|
|
|
|
|
=head3 formateParams
|
|
|
|
|
|
|
|
Does nothing. To be overloaded if needed.
|
|
|
|
|
|
|
|
=head3 formateFilter
|
|
|
|
|
|
|
|
Creates the ldap filter using $self->{user}. By default :
|
|
|
|
|
2008-05-30 06:47:32 +02:00
|
|
|
$self->{filter} = "(&(uid=" . $self->{user} . ")(objectClass=inetOrgPerson))";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
2008-06-11 08:00:26 +02:00
|
|
|
If $self->{authFilter} is set, it is used instead of this. This is used by
|
|
|
|
Lemonldap::NG::Portal::Auth* modules to overload filter.
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head3 connectLDAP
|
|
|
|
|
|
|
|
Connects to LDAP server.
|
|
|
|
|
|
|
|
=head3 bind
|
|
|
|
|
|
|
|
Binds to the LDAP server using $self->{managerDn} and $self->{managerPassword}
|
|
|
|
if exist. Anonymous bind is provided else.
|
|
|
|
|
|
|
|
=head3 search
|
|
|
|
|
|
|
|
Retrives the LDAP entry corresponding to the user using $self->{filter}.
|
|
|
|
|
2008-06-11 08:00:26 +02:00
|
|
|
=head3 setAuthSessionInfo
|
|
|
|
|
|
|
|
Same as setSessionInfo but implemented in Lemonldap::NG::Portal::Auth* modules.
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head3 setSessionInfo
|
|
|
|
|
|
|
|
Prepares variables to store in central cache (stored temporarily in
|
|
|
|
C<$self->{sessionInfo}>). It use C<exportedVars> entry (passed to the new sub)
|
|
|
|
if defined to know what to store else it stores uid, cn and mail attributes.
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
=head3 getSessionInfo
|
|
|
|
|
|
|
|
Pick up an information stored in session.
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head3 setGroups
|
|
|
|
|
|
|
|
Does nothing by default.
|
|
|
|
|
|
|
|
=head3 authenticate
|
|
|
|
|
2008-06-11 08:00:26 +02:00
|
|
|
Method implemented in Lemonldap::NG::Portal::Auth* modules. By default (ldap),
|
|
|
|
authenticates the user by rebinding to the LDAP server using the dn retrived
|
2006-12-18 12:32:33 +01:00
|
|
|
with search() and the password.
|
|
|
|
|
|
|
|
=head3 store
|
|
|
|
|
|
|
|
Stores the informations collected by setSessionInfo into the central cache.
|
|
|
|
The portal connects the cache using the L<Apache::Session> module passed by
|
|
|
|
the globalStorage parameters (see constructor).
|
|
|
|
|
|
|
|
=head3 unbind
|
|
|
|
|
|
|
|
Disconnects from the LDAP server.
|
|
|
|
|
|
|
|
=head3 buildCookie
|
|
|
|
|
2007-05-05 16:13:44 +02:00
|
|
|
Creates the Lemonldap::NG cookie.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head3 log
|
|
|
|
|
|
|
|
Does nothing. To be overloaded if wanted.
|
|
|
|
|
2007-01-11 07:42:57 +01:00
|
|
|
=head3 autoRedirect
|
|
|
|
|
|
|
|
Redirects the user to the url stored by controlUrlOrigin().
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head2 Other methods
|
|
|
|
|
|
|
|
=head3 process
|
|
|
|
|
|
|
|
Main method.
|
|
|
|
|
|
|
|
=head3 error
|
|
|
|
|
|
|
|
Returns the error message corresponding to the error returned by the methods
|
|
|
|
described above
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
=head3 error_type
|
|
|
|
|
|
|
|
Give the type of the error (positive, warning or positive)
|
|
|
|
|
2008-09-03 18:11:16 +02:00
|
|
|
=head3 translate_template
|
|
|
|
|
|
|
|
Define an HTML::Template filter to translate multilingual strings
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head3 _bind( $ldap, $dn, $password )
|
|
|
|
|
2008-06-06 05:51:39 +02:00
|
|
|
Method used to bind to the ldap server.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head3 header
|
|
|
|
|
2007-05-05 16:13:44 +02:00
|
|
|
Overloads the CGI::header method to add Lemonldap::NG cookie.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head3 redirect
|
|
|
|
|
2007-05-05 16:13:44 +02:00
|
|
|
Overloads the CGI::redirect method to add Lemonldap::NG cookie.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head2 EXPORT
|
|
|
|
|
|
|
|
=head3 Constants
|
|
|
|
|
|
|
|
=over 5
|
|
|
|
|
|
|
|
=item * B<PE_OK>: all is good
|
|
|
|
|
|
|
|
=item * B<PE_SESSIONEXPIRED>: the user session has expired
|
|
|
|
|
|
|
|
=item * B<PE_FORMEMPTY>: Nothing was entered in the login form
|
|
|
|
|
|
|
|
=item * B<PE_USERNOTFOUND>: the user was not found in the (ldap) directory
|
|
|
|
|
|
|
|
=item * B<PE_WRONGMANAGERACCOUNT>: the account used to bind to LDAP server in order to
|
|
|
|
find the user distinguished name (dn) was refused by the server
|
|
|
|
|
|
|
|
=item * B<PE_BADCREDENTIALS>: bad login or password
|
|
|
|
|
|
|
|
=item * B<PE_LDAPERROR>: abnormal error from ldap
|
|
|
|
|
|
|
|
=item * B<PE_APACHESESSIONERROR>: abnormal error from Apache::Session
|
|
|
|
|
|
|
|
=item * B<PE_FIRSTACCESS>: First access to the portal
|
|
|
|
|
|
|
|
=item * B<PE_BADCERTIFICATE>: Wrong certificate
|
|
|
|
|
2008-06-11 08:00:26 +02:00
|
|
|
=item * PE_PP_ACCOUNT_LOCKED: account locked
|
|
|
|
|
|
|
|
=item * PE_PP_PASSWORD_EXPIRED: password axpired
|
|
|
|
|
|
|
|
=item * PE_CERTIFICATEREQUIRED: certificate required
|
|
|
|
|
|
|
|
=item * PE_ERROR: unclassified error
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=back
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
2007-04-02 21:13:05 +02:00
|
|
|
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Portal::SharedConf>, L<CGI>,
|
|
|
|
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
|
|
|
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
|
2007-04-14 15:12:11 +02:00
|
|
|
=head1 BUG REPORT
|
|
|
|
|
|
|
|
Use OW2 system to report bug or ask for features:
|
|
|
|
L<http://forge.objectweb.org/tracker/?group_id=274>
|
|
|
|
|
|
|
|
=head1 DOWNLOAD
|
|
|
|
|
|
|
|
Lemonldap::NG is available at
|
|
|
|
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
2007-02-23 06:31:32 +01:00
|
|
|
Copyright (C) 2005-2007 by Xavier Guimard E<lt>x.guimard@free.frE<gt>
|
2006-12-18 12:32:33 +01: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.8.4 or,
|
|
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
|
|
|
|
=cut
|