Commit 26c944ca authored by Yadd's avatar Yadd
Browse files

LEMONLDAP::NG : UserDB system updated + general perltidy

parent edb22bc8
......@@ -6,7 +6,7 @@ use Lemonldap::NG::Portal::Simple;
our $VERSION = '0.1';
sub authInit {
1;
PE_OK;
}
# By default, authentication is valid if REMOTE_USER environment
......
......@@ -7,7 +7,7 @@ use AuthCAS;
our $VERSION = '0.03';
sub authInit {
1;
PE_OK;
}
sub extractFormInfo {
......
package Lemonldap::NG::Portal::AuthLDAP;
use Lemonldap::NG::Portal::Simple;
use Lemonldap::NG::Portal::_LDAP;
our $VERSION = '0.1';
sub ldap {
my $self = shift;
return $self->{ldap} || Lemonldap::NG::Portal::_LDAP->new({portal=>$self});
unless ( ref( $self->{ldap} ) ) {
my $mesg = $self->{ldap}->{bind}
if ( $self->{ldap} = Lemonldap::NG::Portal::_LDAP->new($self) );
if ( $mesg->{code} ) {
print STDERR $mesg->error . "\n";
return 0;
}
}
return $self->{ldap};
}
sub authInit {
my $self = shift;
return $self->ldap;
PE_OK;
}
sub extractFormInfo {
......@@ -30,13 +38,18 @@ sub setAuthSessionInfo {
sub authenticate {
my $self = shift;
unless ( $self->ldap ) {
return PE_LDAPCONNECTFAILED;
}
# Check if we use Ppolicy control
if ( $self->{ldapPpolicyControl} ) {
# require Perl module
eval 'require Net::LDAP::Control::PasswordPolicy';
if ($@) {
print STDERR "Module Net::LDAP::Control::PasswordPolicy not found in @INC\n";
print STDERR
"Module Net::LDAP::Control::PasswordPolicy not found in @INC\n";
return PE_LDAPERROR;
}
no strict 'subs';
......@@ -45,7 +58,7 @@ sub authenticate {
my $pp = Net::LDAP::Control::PasswordPolicy->new;
# Bind with user credentials
my $mesg = $self->ldap->{ldap}->bind(
my $mesg = $self->ldap->bind(
$self->{dn},
password => $self->{password},
control => [$pp]
......@@ -54,9 +67,11 @@ sub authenticate {
# Get server control response
my ($resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
# Get expiration warning and graces
$self->{ppolicy}->{time_before_expiration} = $resp->time_before_expiration;
$self->{ppolicy}->{grace_authentications_remaining} = $resp->grace_authentications_remaining;
# Get expiration warning and graces
$self->{ppolicy}->{time_before_expiration} =
$resp->time_before_expiration;
$self->{ppolicy}->{grace_authentications_remaining} =
$resp->grace_authentications_remaining;
# Get bind response
return PE_OK if ( $mesg->code == 0 );
......@@ -87,7 +102,7 @@ sub authenticate {
else {
return PE_BADCREDENTIALS
unless (
$self->ldap->_bind( $self->{dn}, $self->{password} ) );
$self->ldap->bind( $self->{dn}, password => $self->{password} ) );
}
$self->{sessionInfo}->{authenticationLevel} = 2;
PE_OK;
......
......@@ -13,6 +13,7 @@ sub authInit {
$self->{SSLRequire} = 1 unless ( defined $self->{SSLRequire} );
$self->{SSLVar} ||= 'SSL_CLIENT_S_DN_Email';
$self->{SSLLDAPField} ||= 'mail';
PE_OK;
}
# Authentication is made by Apache with SSL and here before searching the LDAP
......
......@@ -25,15 +25,17 @@ sub existingSession {
# to the requested URL. If it does not come from our domain, we add
# ID in URL
sub autoRedirect {
my $self = shift;
my $tmp = $self->{domain};
my $self = shift;
my $tmp = $self->{domain};
my $cookieName = $self->{cookieName};
if ( $self->{urldc} and $self->{urldc} !~ m#https?://[^/]*$tmp/#oi
and $self->{id} and $self->{urldc} !~ m#[\?&]?$cookieName=\w+&?#oi )
if ( $self->{urldc}
and $self->{urldc} !~ m#https?://[^/]*$tmp/#oi
and $self->{id}
and $self->{urldc} !~ m#[\?&]?$cookieName=\w+&?#oi )
{
$self->{urldc} .= ( $self->{urldc} =~ /\?{1}/oi ) ? '&' : '?' ;
$self->{urldc} .= $cookieName . "=" . $self->{id} ;
$self->{urldc} .= ( $self->{urldc} =~ /\?{1}/oi ) ? '&' : '?';
$self->{urldc} .= $cookieName . "=" . $self->{id};
}
return $self->SUPER::autoRedirect(@_);
}
......
......@@ -13,10 +13,11 @@ our @ISA = qw(Exporter);
### ACCESS CONTROL DISPLAY SYSTEM
our($defaultCondition,$locationCondition,$locationRegexp,$cfgNum)=(undef,undef,undef,0);
our ( $defaultCondition, $locationCondition, $locationRegexp, $cfgNum ) =
( undef, undef, undef, 0 );
my $safe = new Safe;
$safe->share( '&encode_base64' );
$safe->share('&encode_base64');
my $catlevel = 0;
......@@ -24,11 +25,12 @@ my $catlevel = 0;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
bless( $self, $class );
# Get configuration
$self->Lemonldap::NG::Portal::Simple::getConf(@_) or die "Unable to get configuration";
$self->Lemonldap::NG::Portal::Simple::getConf(@_)
or die "Unable to get configuration";
# Portal is required
die("Portal object required") unless ( $self->{portalObject} );
......@@ -38,43 +40,49 @@ sub new {
# Default values
$self->{apps}->{xmlfile} ||= 'apps-list.xml';
$self->{apps}->{imgpath} ||= 'apps/';
$self->{modules}->{appslist} = 0 unless defined $self->{modules}->{appslist};
$self->{modules}->{password} = 0 unless defined $self->{modules}->{password};
$self->{modules}->{appslist} = 0
unless defined $self->{modules}->{appslist};
$self->{modules}->{password} = 0
unless defined $self->{modules}->{password};
$self->{modules}->{logout} = 1 unless defined $self->{modules}->{logout};
# Set error to 0 by default
$self->{error} = PE_OK;
# Print Ppolicy warning messages
($self->{error}, $self->{error_value}) = $self->_ppolicyWarning;
( $self->{error}, $self->{error_value} ) = $self->_ppolicyWarning;
# Gest POST data
my ($newpassword, $confirmpassword, $oldpassword) = (
my ( $newpassword, $confirmpassword, $oldpassword ) = (
$self->{portalObject}->param('newpassword'),
$self->{portalObject}->param('confirmpassword'),
$self->{portalObject}->param('oldpassword')
);
# Change password (only if newpassword submitted)
$self->{error} = $self->_changePassword($newpassword, $confirmpassword, $oldpassword) if $newpassword;
$self->{error} =
$self->_changePassword( $newpassword, $confirmpassword, $oldpassword )
if $newpassword;
return $self;
}
sub error {
# Copied from Simple.pm
# Add a value possibility (stored in $self->{error_value}
my $self = shift;
my $error_string;
$error_string .= $self->{error_value} if defined $self->{error_value};
$error_string .= &Lemonldap::NG::Portal::_i18n::error( $self->{error},
$error_string .=
&Lemonldap::NG::Portal::_i18n::error( $self->{error},
shift || $ENV{HTTP_ACCEPT_LANGUAGE} );
return $error_string;
}
sub error_type {
my $self = shift;
return &Lemonldap::NG::Portal::Simple::error_type( $self );
return &Lemonldap::NG::Portal::Simple::error_type($self);
}
# displayModule($modulename)
......@@ -84,7 +92,7 @@ sub displayModule {
my $self = shift;
my ($modulename) = @_;
# Manage "0" and "1" rules
# Manage "0" and "1" rules
return 1 if ( $self->{modules}->{$modulename} eq "1" );
return 0 if ( $self->{modules}->{$modulename} eq "0" );
......@@ -100,21 +108,27 @@ sub displayModule {
# Design for Jquery tabs
sub displayTab {
my $self = shift;
# Display password tab if password change is needed or failed
return "password" if (
(scalar(grep{/^$self->{error}$/} (
25, #PE_PP_CHANGE_AFTER_RESET
27, #PE_PP_MUST_SUPPLY_OLD_PASSWORD
28, #PE_PP_INSUFFICIENT_PASSWORD_QUALITY
29, #PE_PP_PASSWORD_TOO_SHORT
30, #PE_PP_PASSWORD_TOO_YOUNG
31, #PE_PP_PASSWORD_IN_HISTORY
32, #PE_PP_GRACE
33, #PE_PP_EXP_WARNING
34, #PE_PASSWORD_MISMATCH
))) && $self->displayModule("password")
);
return "password"
if (
(
scalar(
grep { /^$self->{error}$/ } (
25, #PE_PP_CHANGE_AFTER_RESET
27, #PE_PP_MUST_SUPPLY_OLD_PASSWORD
28, #PE_PP_INSUFFICIENT_PASSWORD_QUALITY
29, #PE_PP_PASSWORD_TOO_SHORT
30, #PE_PP_PASSWORD_TOO_YOUNG
31, #PE_PP_PASSWORD_IN_HISTORY
32, #PE_PP_GRACE
33, #PE_PP_EXP_WARNING
34, #PE_PASSWORD_MISMATCH
)
)
)
&& $self->displayModule("password")
);
return "appslist" if ( $self->displayModule("appslist") );
return "logout";
......@@ -127,7 +141,7 @@ sub appslistMenu {
my $root = $self->_getXML;
# Display all categories and applications
return $self->_displayCategory($root,$catlevel);
return $self->_displayCategory( $root, $catlevel );
}
# appslistDescription
......@@ -140,7 +154,6 @@ sub appslistDescription {
return $self->_displayDescription($root);
}
# _getXML
# return XML root element object
sub _getXML {
......@@ -149,7 +162,7 @@ sub _getXML {
# Parse XML file
my $parser = XML::LibXML->new();
$parser->validation('1');
my $xml = $parser->parse_file($self->{apps}->{xmlfile});
my $xml = $parser->parse_file( $self->{apps}->{xmlfile} );
my $root = $xml->documentElement;
# Filter XML file with user's authorizations
......@@ -162,13 +175,13 @@ sub _getXML {
# Create HTML code for a category
sub _displayCategory {
my $self = shift;
my ($cat, $catlevel) = @_;
my ( $cat, $catlevel ) = @_;
my $html;
my $catname;
# Category name
if ($catlevel > 0) { $catname = $cat->getAttribute('name') || " "; }
else { $catname = "Menu"; }
if ( $catlevel > 0 ) { $catname = $cat->getAttribute('name') || " "; }
else { $catname = "Menu"; }
# Init HTML list
$html .= "<ul class=\"category cat-level-$catlevel\">\n";
......@@ -186,7 +199,7 @@ sub _displayCategory {
my @catnodes = $cat->findnodes("category");
$catlevel++;
foreach (@catnodes) {
$html .= $self->_displayCategory($_,$catlevel);
$html .= $self->_displayCategory( $_, $catlevel );
}
# Close HTML list
......@@ -201,19 +214,19 @@ sub _displayApplication {
my $self = shift;
my ($app) = @_;
my $html;
# Get application items
my $appid = $app->getAttribute('id');
my $appid = $app->getAttribute('id');
my $appname = $app->getElementsByTagName('name')->string_value() || $appid;
my $appuri = $app->getElementsByTagName('uri')->string_value() || "#";
my $appuri = $app->getElementsByTagName('uri')->string_value() || "#";
# Display application
$html .= "<li title=\"$appid\" class=\"appname\"><span><a href=\"$appuri\">$appname</a></span></li>\n";
$html .=
"<li title=\"$appid\" class=\"appname\"><span><a href=\"$appuri\">$appname</a></span></li>\n";
return $html;
}
# _displayDescription
# Create HTML code for application description
sub _displayDescription {
......@@ -223,17 +236,20 @@ sub _displayDescription {
my @apps = $root->getElementsByTagName('application');
foreach (@apps) {
# Get application items
my $appid = $_->getAttribute('id');
my $appid = $_->getAttribute('id');
my $appname = $_->getElementsByTagName('name')->string_value();
my $appuri = $_->getElementsByTagName('uri')->string_value() || "#";
my $appuri = $_->getElementsByTagName('uri')->string_value() || "#";
my $appdesc = $_->getElementsByTagName('description')->string_value();
my $applogofile = $_->getElementsByTagName('logo')->string_value();
my $applogo = $self->{apps}->{imgpath}.$applogofile;
my $applogo = $self->{apps}->{imgpath} . $applogofile;
# Display application
# Display application
$html .= "<div id=\"$appid\" class=\"appsdesc\">\n";
$html .= "<a href=\"$appuri\"><img src=\"$applogo\" alt=\"$appid logo\" /></a>\n" if $applogofile;
$html .=
"<a href=\"$appuri\"><img src=\"$applogo\" alt=\"$appid logo\" /></a>\n"
if $applogofile;
$html .= "<p class=\"appname\">$appname</p>\n" if defined $appname;
$html .= "<p class=\"appdesc\">$appdesc</p>\n" if defined $appdesc;
$html .= "</div>\n";
......@@ -243,7 +259,7 @@ sub _displayDescription {
}
# _filterXML
# Remove unauthorized nodes
# Remove unauthorized nodes
sub _filterXML {
my $self = shift;
my ($root) = @_;
......@@ -251,17 +267,17 @@ sub _filterXML {
my @apps = $root->getElementsByTagName('application');
foreach (@apps) {
my $appdisplay = $_->getElementsByTagName('display')->string_value();
my $appuri = $_->getElementsByTagName('uri')->string_value();
my $appuri = $_->getElementsByTagName('uri')->string_value();
# Remove node if display is "no"
$_->unbindNode if ( $appdisplay eq "no" );
# Keep node if display is "yes"
next if ( $appdisplay eq "yes" );
# Remove node if display is "no"
$_->unbindNode if ($appdisplay eq "no");
# Check grant function if display is "auto" (this is the default)
$_->unbindNode unless ( $self->_grant($appuri) );
# Keep node if display is "yes"
next if ($appdisplay eq "yes");
# Check grant function if display is "auto" (this is the default)
$_->unbindNode unless ($self->_grant($appuri));
}
# Hide empty categories
......@@ -271,7 +287,7 @@ sub _filterXML {
}
# _hideEmptyCategory
#
#
sub _hideEmptyCategory {
my $self = shift;
my ($cat) = @_;
......@@ -301,11 +317,11 @@ sub _hideEmptyCategory {
# Change user's password
sub _changePassword {
my $self = shift;
my ($newpassword, $confirmpassword, $oldpassword) = @_;
my ( $newpassword, $confirmpassword, $oldpassword ) = @_;
my $err;
# Verify confirmation password matching
return PE_PASSWORD_MISMATCH unless ($newpassword eq $confirmpassword);
return PE_PASSWORD_MISMATCH unless ( $newpassword eq $confirmpassword );
# Connect to LDAP
$err = &Lemonldap::NG::Portal::Simple::connectLDAP( $self->{portalObject} );
......@@ -316,22 +332,26 @@ sub _changePassword {
return $err unless ( $err eq PE_OK );
my $ldap = $self->{portalObject}->{ldap};
my $dn = $self->{portalObject}->{sessionInfo}->{"dn"};
my $dn = $self->{portalObject}->{sessionInfo}->{"dn"};
# First case: no ppolicy
if ( !$self->{portalObject}->{ldapPpolicyControl} ) {
my $mesg = $ldap->modify($dn, replace => { userPassword => $newpassword } );
my $mesg =
$ldap->modify( $dn, replace => { userPassword => $newpassword } );
return PE_WRONGMANAGERACCOUNT if ( $mesg->code == 50 || $mesg->code == 8 );
return PE_WRONGMANAGERACCOUNT
if ( $mesg->code == 50 || $mesg->code == 8 );
return PE_LDAPERROR unless ( $mesg->code == 0 );
return PE_PASSWORD_OK;
} else {
}
else {
# require Perl module
eval 'require Net::LDAP::Control::PasswordPolicy';
if ($@) {
print STDERR "Module Net::LDAP::Control::PasswordPolicy not found in @INC\n";
print STDERR
"Module Net::LDAP::Control::PasswordPolicy not found in @INC\n";
return PE_LDAPERROR;
}
no strict 'subs';
......@@ -339,14 +359,19 @@ sub _changePassword {
# Create Control object
my $pp = Net::LDAP::Control::PasswordPolicy->new;
my $mesg = $ldap->modify($dn, replace => { userPassword => $newpassword }, control => [ $pp ]);
my $mesg = $ldap->modify(
$dn,
replace => { userPassword => $newpassword },
control => [$pp]
);
# TODO: use setPassword with oldpassword if needed
# Get server control response
my ($resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
return PE_WRONGMANAGERACCOUNT if ( $mesg->code == 50 || $mesg->code == 8 );
return PE_WRONGMANAGERACCOUNT
if ( $mesg->code == 50 || $mesg->code == 8 );
return PE_PASSWORD_OK if ( $mesg->code == 0 );
if ( defined $resp ) {
......@@ -374,41 +399,47 @@ sub _changePassword {
# _ppolicyWarning
# Return ppolicy warnings get in AuthLDAP.pm
sub _ppolicyWarning {
my $self = shift;
my $self = shift;
# Grace
if (defined $self->{portalObject}->{ppolicy}->{grace_authentications_remaining} ) {
return ( PE_PP_GRACE, $self->{portalObject}->{ppolicy}->{grace_authentications_remaining} );
}
# Grace
if (
defined $self->{portalObject}->{ppolicy}
->{grace_authentications_remaining} )
{
return ( PE_PP_GRACE,
$self->{portalObject}->{ppolicy}
->{grace_authentications_remaining} );
}
# Expiration warning
if (defined $self->{portalObject}->{ppolicy}->{time_before_expiration} ) {
return ( PE_PP_EXP_WARNING, $self->{portalObject}->{ppolicy}->{time_before_expiration} );
}
# Expiration warning
if ( defined $self->{portalObject}->{ppolicy}->{time_before_expiration} ) {
return ( PE_PP_EXP_WARNING,
$self->{portalObject}->{ppolicy}->{time_before_expiration} );
}
# Return PE_OK
return ( PE_OK, undef);
# Return PE_OK
return ( PE_OK, undef );
}
# _grant
# Check user's authorization
sub _grant {
my $self = shift;
my ($uri) = @_;
$uri =~ m#(\w+)://([^/:]+)(:\d+)?(/.*)#;
my ($protocol,$vhost,$port,$path) = ($1,$2,$3,$4);
my ( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
$self->_compileRules() if ( $cfgNum != $self->{portalObject}->{cfgNum} );
return -1 unless ( defined ( $defaultCondition->{$vhost} ) );
if (defined $locationRegexp->{$vhost} ) { # Not just a default rule
for ( my $i = 0 ; $i < @{ $locationRegexp->{$vhost} } ; $i++ ) {
if ( $path =~ $locationRegexp->{$vhost}->[$i] ) {
return &{ $locationCondition->{$vhost}->[$i] }($self);
}
}
return -1 unless ( defined( $defaultCondition->{$vhost} ) );
if ( defined $locationRegexp->{$vhost} ) { # Not just a default rule
for ( my $i = 0 ; $i < @{ $locationRegexp->{$vhost} } ; $i++ ) {
if ( $path =~ $locationRegexp->{$vhost}->[$i] ) {
return &{ $locationCondition->{$vhost}->[$i] }($self);
}
}
}
unless ( $defaultCondition->{$vhost} ) {
print STDERR "Application $uri did not match any configured virtual host\n";
print STDERR
"Application $uri did not match any configured virtual host\n";
return 0;
}
return &{ $defaultCondition->{$vhost} }($self);
......@@ -429,7 +460,8 @@ sub _compileRules {
}
else {
$locationCondition->{$vhost}->[$i] =
$self->_conditionSub( $self->{portalObject}->{locationRules}->{$vhost}->{$_} );
$self->_conditionSub(
$self->{portalObject}->{locationRules}->{$vhost}->{$_} );
$locationRegexp->{$vhost}->[$i] = qr/$_/;
$i++;
}
......
......@@ -64,8 +64,9 @@ sub localStorageObject {
my $self = shift;
eval "use " . $self->{localStorage};
if ($@) {
print STDERR "Unable to load " . $self->{localStorage}
. ", local configuration cache is disabled: $@\n";
print STDERR "Unable to load "
. $self->{localStorage}
. ", local configuration cache is disabled: $@\n";
return 0;
}
my $refLocalStorage;
......@@ -126,7 +127,10 @@ sub setGroups {
if ( $self->{ldapGroupBase} ) {
my $mesg = $self->{ldap}->search(
base => $self->{ldapGroupBase},
filter => "(|(member=" . $self->{dn} . ")(uniqueMember=" . $self->{dn} . "))",
filter => "(|(member="
. $self->{dn}
. ")(uniqueMember="
. $self->{dn} . "))",
attrs => ["cn"],