Comments in Portal code
This commit is contained in:
Xavier Guimard
parent
88662fc22b
commit
6f2a40e4ed
|
|
@ -2,7 +2,7 @@ package Lemonldap::NG::Portal;
|
|||
|
||||
print STDERR
|
||||
"See Lemonldap::NG::Portal(3) to know which Lemonldap::NG::Portal::* module to use.";
|
||||
our $VERSION = "0.51";
|
||||
our $VERSION = "0.52";
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,10 +3,15 @@ package Lemonldap::NG::Portal::AuthSSL;
|
|||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
|
||||
our $VERSION = '0.03';
|
||||
our $VERSION = '0.04';
|
||||
|
||||
# Authentication is made by Apache with SSL and here before searching the LDAP
|
||||
# Directory.
|
||||
# So authenticate is overloaded to return only PE_OK.
|
||||
|
||||
# Authentication is made here before searching the LDAP Directory
|
||||
our $OVERRIDE = {
|
||||
# By default, authentication is valid if SSL_CLIENT_S_DN_Email environement
|
||||
# variable is present. Adapt it if you want
|
||||
extractFormInfo => sub {
|
||||
my $self = shift;
|
||||
$self->{user} = $self->https('SSL_CLIENT_S_DN_Email');
|
||||
|
|
@ -14,6 +19,8 @@ our $OVERRIDE = {
|
|||
PE_OK;
|
||||
},
|
||||
|
||||
# As we know only user mail, we have to use it to find him in the LDAP
|
||||
# directory
|
||||
formateFilter => sub {
|
||||
my $self = shift;
|
||||
$self->{filter} = "(&(mail=" . $self->{user} . ")(objectClass=person))";
|
||||
|
|
|
|||
|
|
@ -9,12 +9,19 @@ use Safe;
|
|||
*EXPORT_TAGS = *Lemonldap::NG::Portal::Simple::EXPORT_TAGS;
|
||||
*EXPORT = *Lemonldap::NG::Portal::Simple::EXPORT;
|
||||
|
||||
our $VERSION = "0.4";
|
||||
our $VERSION = "0.41";
|
||||
our @ISA = qw(Lemonldap::NG::Portal::Simple);
|
||||
|
||||
# Secure jail
|
||||
our $safe = new Safe;
|
||||
|
||||
##################
|
||||
# OVERLOADED sub #
|
||||
##################
|
||||
|
||||
# getConf: all parameters returned by the Lemonldap::NG::Manager::Conf object
|
||||
# are copied in $self
|
||||
# See Lemonldap::NG::Manager::Conf(3) for more
|
||||
sub getConf {
|
||||
my $self = shift;
|
||||
$self->SUPER::getConf(@_);
|
||||
|
|
@ -28,6 +35,8 @@ sub getConf {
|
|||
1;
|
||||
}
|
||||
|
||||
# Here is implemented the 'groups' mechanism. See Lemnldap::NG::Portal for
|
||||
# more.
|
||||
sub setGroups {
|
||||
my $self = shift;
|
||||
die __PACKAGE__ . ": Unable to get configuration"
|
||||
|
|
@ -61,6 +70,7 @@ sub setGroups {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# Internal sub used to replace Perl expressions in 'groups' rules.
|
||||
sub scanexpr {
|
||||
my $self = shift;
|
||||
local $_ = shift;
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ use warnings;
|
|||
use MIME::Base64;
|
||||
use CGI;
|
||||
|
||||
our $VERSION = '0.41';
|
||||
our $VERSION = '0.42';
|
||||
|
||||
our @ISA = qw(CGI Exporter);
|
||||
|
||||
|
|
@ -27,6 +27,7 @@ sub PE_APACHESESSIONERROR { 8 }
|
|||
sub PE_FIRSTACCESS { 9 }
|
||||
sub PE_BADCERTIFICATE { 10 }
|
||||
|
||||
# EXPORTER PARAMETERS
|
||||
our %EXPORT_TAGS = (
|
||||
'all' => [
|
||||
qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS
|
||||
|
|
@ -40,10 +41,12 @@ our %EXPORT_TAGS = (
|
|||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
# TODO: remove this... and test !
|
||||
our @EXPORT =
|
||||
qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS
|
||||
PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE import );
|
||||
|
||||
# CONSTRUCTOR
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = $class->SUPER::new();
|
||||
|
|
@ -61,11 +64,14 @@ sub new {
|
|||
|
||||
if ( $self->{authentication} eq "SSL" ) {
|
||||
require Lemonldap::NG::Portal::AuthSSL;
|
||||
%$self = ( %$self, %$Lemonldap::NG::Portal::AuthSSL::OVERRIDE );
|
||||
# $Lemonldap::NG::Portal::AuthSSL::OVERRIDE does not overload $self
|
||||
# variables: if the administrator has defined a sub, we respect it
|
||||
%$self = ( %$Lemonldap::NG::Portal::AuthSSL::OVERRIDE, %$self );
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
# getConf basic, copy all parameters in $self. Overloaded in SharedConf.pm
|
||||
sub getConf {
|
||||
my ($self) = shift;
|
||||
my %args;
|
||||
|
|
@ -79,6 +85,7 @@ sub getConf {
|
|||
1;
|
||||
}
|
||||
|
||||
# TODO: create an _i18n.pm like in Lemonldap::NG::Manager
|
||||
sub error {
|
||||
my $self = shift;
|
||||
my $lang = shift;
|
||||
|
|
@ -100,7 +107,7 @@ sub error {
|
|||
else {
|
||||
@message = (
|
||||
'Everything is OK',
|
||||
'Your connection has expired; You must to be authentified once again',
|
||||
'Your connection has expired; You must to be authentified once again',
|
||||
'User and password fields must be filled',
|
||||
'Wrong directory manager account or password',
|
||||
'User not found in directory',
|
||||
|
|
@ -114,6 +121,48 @@ sub error {
|
|||
return $message[ $self->{error} ];
|
||||
}
|
||||
|
||||
# Private sub used to bind to LDAP server both with Lemonldap account and user
|
||||
# credentials if LDAP authentication is used
|
||||
sub _bind {
|
||||
my ( $ldap, $dn, $password ) = @_;
|
||||
my $mesg;
|
||||
if ( $dn and $password ) { # named bind
|
||||
$mesg = $ldap->bind( $dn, password => $password );
|
||||
}
|
||||
else { # anonymous bind
|
||||
$mesg = $ldap->bind();
|
||||
}
|
||||
if ( $mesg->code() != 0 ) {
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
# CGI.pm overload to add Lemonldap::NG cookie
|
||||
sub header {
|
||||
my $self = shift;
|
||||
if ( $self->{cookie} ) {
|
||||
$self->SUPER::header( @_, -cookie => $self->{cookie} );
|
||||
}
|
||||
else {
|
||||
$self->SUPER::header(@_);
|
||||
}
|
||||
}
|
||||
|
||||
# CGI.pm overload to add Lemonldap::NG cookie
|
||||
sub redirect {
|
||||
my $self = shift;
|
||||
if ( $_[0]->{cookie} ) {
|
||||
$self->SUPER::redirect( @_, -cookie => $_[0]->{cookie} );
|
||||
}
|
||||
else {
|
||||
$self->SUPER::redirect(@_);
|
||||
}
|
||||
}
|
||||
|
||||
###################################
|
||||
# MAIN subroutine: call all steps #
|
||||
###################################
|
||||
sub process {
|
||||
my ($self) = @_;
|
||||
$self->{error} = PE_OK;
|
||||
|
|
@ -131,41 +180,7 @@ sub process {
|
|||
} return ( $self->{error} ? 0 : 1 );
|
||||
}
|
||||
|
||||
sub _bind {
|
||||
my ( $ldap, $dn, $password ) = @_;
|
||||
my $mesg;
|
||||
if ( $dn and $password ) { # named bind
|
||||
$mesg = $ldap->bind( $dn, password => $password );
|
||||
}
|
||||
else { # anonymous bind
|
||||
$mesg = $ldap->bind();
|
||||
}
|
||||
if ( $mesg->code() != 0 ) {
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub header {
|
||||
my $self = shift;
|
||||
if ( $self->{cookie} ) {
|
||||
$self->SUPER::header( @_, -cookie => $self->{cookie} );
|
||||
}
|
||||
else {
|
||||
$self->SUPER::header(@_);
|
||||
}
|
||||
}
|
||||
|
||||
sub redirect {
|
||||
my $self = shift;
|
||||
if ( $_[0]->{cookie} ) {
|
||||
$self->SUPER::redirect( @_, -cookie => $_[0]->{cookie} );
|
||||
}
|
||||
else {
|
||||
$self->SUPER::redirect(@_);
|
||||
}
|
||||
}
|
||||
|
||||
# 1. If the user was redirected here, we have to load 'url' parameter
|
||||
sub controlUrlOrigin {
|
||||
my $self = shift;
|
||||
if ( $self->param('url') ) {
|
||||
|
|
@ -174,11 +189,16 @@ sub controlUrlOrigin {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# TODO: delete existing sessions
|
||||
# 2. Control existing sessions
|
||||
# TODO: what to do with existing sessions ?
|
||||
# - delete and create a new session
|
||||
# - re-authentication (actual scheme)
|
||||
sub controlExistingSession {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
# 3. In ldap authentication scheme, we load here user and password from HTML
|
||||
# form
|
||||
sub extractFormInfo {
|
||||
my $self = shift;
|
||||
return PE_FIRSTACCESS
|
||||
|
|
@ -189,16 +209,21 @@ sub extractFormInfo {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# Unused. You can overload if you have to modify user and password before
|
||||
# authentication
|
||||
sub formateParams() {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
# 4. By default, the user is searched in the LDAP server with its UID. To use
|
||||
# it with Active Directory, overload it to use CN instead of UID.
|
||||
sub formateFilter {
|
||||
my $self = shift;
|
||||
$self->{filter} = "(&(uid=" . $self->{user} . ")(objectClass=person))";
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
# 5. First LDAP connexion used to find user DN with the filter defined before.
|
||||
sub connectLDAP {
|
||||
my $self = shift;
|
||||
return PE_LDAPCONNECTFAILED
|
||||
|
|
@ -213,6 +238,7 @@ sub connectLDAP {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 6. LDAP bind with Lemonldap account or anonymous unless defined
|
||||
sub bind {
|
||||
my $self = shift;
|
||||
$self->connectLDAP unless ( $self->{ldap} );
|
||||
|
|
@ -222,6 +248,7 @@ sub bind {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 7. Search the DN
|
||||
sub search {
|
||||
my $self = shift;
|
||||
my $mesg = $self->{ldap}->search(
|
||||
|
|
@ -238,32 +265,37 @@ sub search {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 8. Load all parameters included in exportedVars parameter.
|
||||
# Multi-value parameters are loaded in a single string with
|
||||
# '; ' separator
|
||||
sub setSessionInfo {
|
||||
my ($self) = @_;
|
||||
$self->{sessionInfo}->{dn} = $self->{dn};
|
||||
unless ( $self->{exportedVars} ) {
|
||||
foreach (qw(uid cn mail)) {
|
||||
$self->{sessionInfo}->{$_} = $self->{entry}->get_value($_) || "";
|
||||
$self->{sessionInfo}->{$_} = join( '; ', $self->{entry}->get_value($_) || ("") );
|
||||
}
|
||||
}
|
||||
elsif ( ref( $self->{exportedVars} ) eq 'HASH' ) {
|
||||
foreach ( keys %{ $self->{exportedVars} } ) {
|
||||
$self->{sessionInfo}->{$_} =
|
||||
$self->{entry}->get_value( $self->{exportedVars}->{$_} ) || "";
|
||||
$self->{sessionInfo}->{$_} = join( '; ', $self->{entry}->get_value( $self->{exportedVars}->{$_} ) || ("") );
|
||||
}
|
||||
}
|
||||
else {
|
||||
foreach ( @{ $self->{exportedVars} } ) {
|
||||
$self->{sessionInfo}->{$_} = $self->{entry}->get_value($_) || "";
|
||||
$self->{sessionInfo}->{$_} = join( '; ', $self->{entry}->get_value($_) || ("") );
|
||||
}
|
||||
}
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
# 9. Unused here, but overloaded in SharedConf.pm
|
||||
sub setGroups {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
# 10. Now, LDAP will not be used by Lemonldap except for LDAP
|
||||
# authentication scheme
|
||||
sub unbind {
|
||||
my $self = shift;
|
||||
$self->{ldap}->unbind if $self->{ldap};
|
||||
|
|
@ -271,6 +303,7 @@ sub unbind {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 11. Default authentication: LDAP bind with user credentials
|
||||
sub authenticate {
|
||||
my $self = shift;
|
||||
return PE_OK if ( $self->{id} );
|
||||
|
|
@ -282,6 +315,8 @@ sub authenticate {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 12. Now, the user is authenticated. It's time to store his parameters with
|
||||
# Apache::Session::* module
|
||||
sub store {
|
||||
my ($self) = @_;
|
||||
my %h;
|
||||
|
|
@ -297,6 +332,7 @@ sub store {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 13. If all is done, we build the Lemonldap::NG cookie
|
||||
sub buildCookie {
|
||||
my $self = shift;
|
||||
$self->{cookie} = $self->cookie(
|
||||
|
|
@ -310,6 +346,22 @@ sub buildCookie {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
# 14. By default, nothing is logged. Users actions are logged on applications.
|
||||
# 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');
|
||||
# },
|
||||
# ...
|
||||
# } );
|
||||
sub log {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
# 15. If the user was redirected to the portal, we will now redirect him
|
||||
# to the requested URL
|
||||
sub autoRedirect {
|
||||
my $self = shift;
|
||||
if ( my $u = $self->{urldc} ) {
|
||||
|
|
@ -339,10 +391,6 @@ sub autoRedirect {
|
|||
PE_OK;
|
||||
}
|
||||
|
||||
sub log {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
|
@ -521,14 +569,14 @@ Disconnects from the LDAP server.
|
|||
|
||||
Creates the Lemonldap cookie.
|
||||
|
||||
=head3 autoRedirect
|
||||
|
||||
Redirects the user to the url stored by controlUrlOrigin().
|
||||
|
||||
=head3 log
|
||||
|
||||
Does nothing. To be overloaded if wanted.
|
||||
|
||||
=head3 autoRedirect
|
||||
|
||||
Redirects the user to the url stored by controlUrlOrigin().
|
||||
|
||||
=head2 Other methods
|
||||
|
||||
=head3 process
|
||||
|
|
|
|||
Loading…
Reference in New Issue