2008-09-18 10:34:17 +02:00
|
|
|
package Lemonldap::NG::Portal::Menu;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
use Exporter 'import';
|
2008-09-21 11:50:32 +02:00
|
|
|
use Lemonldap::NG::Portal::SharedConf;
|
2008-10-08 11:40:24 +02:00
|
|
|
use Lemonldap::NG::Portal::_LDAP;
|
2008-09-18 10:34:17 +02:00
|
|
|
use XML::LibXML;
|
2008-09-21 11:50:32 +02:00
|
|
|
use Safe;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
|
|
|
|
|
|
|
our @ISA = qw(Exporter);
|
|
|
|
|
2008-09-26 09:36:30 +02:00
|
|
|
### ACCESS CONTROL DISPLAY SYSTEM
|
|
|
|
|
2008-11-17 15:02:50 +01:00
|
|
|
our ( $defaultCondition, $locationCondition, $locationRegexp, $cfgNum, $path ) =
|
2008-10-07 22:15:48 +02:00
|
|
|
( undef, undef, undef, 0 );
|
2008-09-26 09:36:30 +02:00
|
|
|
|
2008-11-14 08:16:26 +01:00
|
|
|
sub _safe {
|
|
|
|
my $self = shift;
|
2008-11-21 18:51:52 +01:00
|
|
|
return $self->{_safe} if ( $self->{_safe} );
|
2008-11-14 08:16:26 +01:00
|
|
|
$self->{_safe} = new Safe;
|
2008-11-21 18:51:52 +01:00
|
|
|
my @t =
|
|
|
|
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
|
|
|
|
foreach (@t) {
|
2008-11-19 12:19:06 +01:00
|
|
|
my $sub = $_;
|
2008-11-21 18:51:52 +01:00
|
|
|
unless (/::/) {
|
2008-11-19 12:19:06 +01:00
|
|
|
$sub = "$self->{caller}::$_";
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
s/^.*:://;
|
|
|
|
}
|
2008-11-21 18:51:52 +01:00
|
|
|
next if ( __PACKAGE__->can($_) );
|
2008-11-17 15:02:50 +01:00
|
|
|
eval "sub $_ {
|
2008-11-17 16:06:58 +01:00
|
|
|
return $sub(\$path,\@_);
|
2008-11-17 15:02:50 +01:00
|
|
|
}";
|
2008-11-21 18:51:52 +01:00
|
|
|
print STDERR "$@\n" if ($@);
|
2008-11-17 15:02:50 +01:00
|
|
|
}
|
2008-11-21 18:51:52 +01:00
|
|
|
$self->{_safe}->share( '&encode_base64', @t );
|
2008-11-14 08:16:26 +01:00
|
|
|
return $self->{_safe};
|
|
|
|
}
|
2008-09-26 09:36:30 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
my $catlevel = 0;
|
|
|
|
|
|
|
|
# CONSTRUCTOR
|
|
|
|
sub new {
|
|
|
|
my $class = shift;
|
|
|
|
my $self = {};
|
2008-10-07 22:15:48 +02:00
|
|
|
bless( $self, $class );
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Get configuration
|
2008-10-07 22:15:48 +02:00
|
|
|
$self->Lemonldap::NG::Portal::Simple::getConf(@_)
|
2008-11-21 08:27:08 +01:00
|
|
|
or $self->abort("Unable to get configuration");
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Portal is required
|
2008-11-21 08:27:08 +01:00
|
|
|
$self->abort("Portal object required") unless ( $self->{portalObject} );
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2008-09-26 09:36:30 +02:00
|
|
|
# Fill sessionInfo
|
|
|
|
&Lemonldap::NG::Portal::Simple::getSessionInfo( $self->{portalObject} );
|
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Default values
|
|
|
|
$self->{apps}->{xmlfile} ||= 'apps-list.xml';
|
|
|
|
$self->{apps}->{imgpath} ||= 'apps/';
|
2008-10-07 22:15:48 +02:00
|
|
|
$self->{modules}->{appslist} = 0
|
|
|
|
unless defined $self->{modules}->{appslist};
|
|
|
|
$self->{modules}->{password} = 0
|
|
|
|
unless defined $self->{modules}->{password};
|
2008-09-19 17:28:00 +02:00
|
|
|
$self->{modules}->{logout} = 1 unless defined $self->{modules}->{logout};
|
2008-11-17 15:02:50 +01:00
|
|
|
$self->{'caller'} = caller;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# Set error to 0 by default
|
|
|
|
$self->{error} = PE_OK;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# Print Ppolicy warning messages
|
2008-10-07 22:15:48 +02:00
|
|
|
( $self->{error}, $self->{error_value} ) = $self->_ppolicyWarning;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# Gest POST data
|
2008-10-07 22:15:48 +02:00
|
|
|
my ( $newpassword, $confirmpassword, $oldpassword ) = (
|
2008-09-21 11:50:32 +02:00
|
|
|
$self->{portalObject}->param('newpassword'),
|
|
|
|
$self->{portalObject}->param('confirmpassword'),
|
|
|
|
$self->{portalObject}->param('oldpassword')
|
2008-09-19 17:28:00 +02:00
|
|
|
);
|
|
|
|
|
|
|
|
# Change password (only if newpassword submitted)
|
2008-10-07 22:15:48 +02:00
|
|
|
$self->{error} =
|
|
|
|
$self->_changePassword( $newpassword, $confirmpassword, $oldpassword )
|
|
|
|
if $newpassword;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
2008-10-08 11:40:24 +02:00
|
|
|
sub ldap {
|
|
|
|
my $self = shift;
|
|
|
|
unless ( ref( $self->{ldap} ) ) {
|
|
|
|
my $mesg = $self->{ldap}->bind
|
|
|
|
if ( $self->{ldap} = Lemonldap::NG::Portal::_LDAP->new($self) );
|
|
|
|
if ( $mesg->code != 0 ) {
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return $self->{ldap};
|
|
|
|
}
|
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
sub error {
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Copied from Simple.pm
|
2008-09-19 17:28:00 +02:00
|
|
|
# Add a value possibility (stored in $self->{error_value}
|
2008-09-18 10:34:17 +02:00
|
|
|
my $self = shift;
|
2008-09-19 17:28:00 +02:00
|
|
|
my $error_string;
|
|
|
|
$error_string .= $self->{error_value} if defined $self->{error_value};
|
2008-10-07 22:15:48 +02:00
|
|
|
$error_string .=
|
|
|
|
&Lemonldap::NG::Portal::_i18n::error( $self->{error},
|
2008-09-18 10:34:17 +02:00
|
|
|
shift || $ENV{HTTP_ACCEPT_LANGUAGE} );
|
2008-09-19 17:28:00 +02:00
|
|
|
return $error_string;
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
sub error_type {
|
|
|
|
my $self = shift;
|
2008-10-07 22:15:48 +02:00
|
|
|
return &Lemonldap::NG::Portal::Simple::error_type($self);
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# displayModule($modulename)
|
|
|
|
# Return true if the user can see the module
|
|
|
|
# Use for HTML::Template variable
|
2008-09-19 17:28:00 +02:00
|
|
|
sub displayModule {
|
2008-09-18 10:34:17 +02:00
|
|
|
my $self = shift;
|
|
|
|
my ($modulename) = @_;
|
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
# Manage "0" and "1" rules
|
2008-09-26 09:36:30 +02:00
|
|
|
return 1 if ( $self->{modules}->{$modulename} eq "1" );
|
|
|
|
return 0 if ( $self->{modules}->{$modulename} eq "0" );
|
|
|
|
|
|
|
|
# Else parse display condition
|
|
|
|
my $cond = $self->{modules}->{$modulename};
|
|
|
|
$cond =~ s/\$(\w+)/$self->{portalObject}->{sessionInfo}->{$1}/g;
|
2008-11-14 08:16:26 +01:00
|
|
|
return $self->_safe->reval("sub {return ( $cond )}");
|
2008-09-18 10:34:17 +02:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# displayTab
|
|
|
|
# Tells which tab should be selected
|
|
|
|
# Design for Jquery tabs
|
|
|
|
sub displayTab {
|
|
|
|
my $self = shift;
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# Display password tab if password change is needed or failed
|
2008-10-07 22:15:48 +02:00
|
|
|
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")
|
|
|
|
);
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
return "appslist" if ( $self->displayModule("appslist") );
|
|
|
|
return "logout";
|
|
|
|
}
|
|
|
|
|
|
|
|
# appslistMenu
|
|
|
|
# HTML code for application list menu
|
|
|
|
sub appslistMenu {
|
|
|
|
my $self = shift;
|
|
|
|
my $root = $self->_getXML;
|
|
|
|
|
|
|
|
# Display all categories and applications
|
2008-10-07 22:15:48 +02:00
|
|
|
return $self->_displayCategory( $root, $catlevel );
|
2008-09-19 17:28:00 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# appslistDescription
|
|
|
|
# HTML code for application description
|
|
|
|
sub appslistDescription {
|
|
|
|
my $self = shift;
|
|
|
|
my $root = $self->_getXML;
|
|
|
|
|
|
|
|
# Display application description
|
|
|
|
return $self->_displayDescription($root);
|
|
|
|
}
|
|
|
|
|
|
|
|
# _getXML
|
|
|
|
# return XML root element object
|
|
|
|
sub _getXML {
|
2008-09-18 10:34:17 +02:00
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
# Parse XML file
|
|
|
|
my $parser = XML::LibXML->new();
|
|
|
|
$parser->validation('1');
|
2008-10-07 22:15:48 +02:00
|
|
|
my $xml = $parser->parse_file( $self->{apps}->{xmlfile} );
|
2008-09-18 10:34:17 +02:00
|
|
|
my $root = $xml->documentElement;
|
|
|
|
|
|
|
|
# Filter XML file with user's authorizations
|
|
|
|
$self->_filterXML($root);
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
return $root;
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# _displayCategory
|
|
|
|
# Create HTML code for a category
|
2008-09-19 17:28:00 +02:00
|
|
|
sub _displayCategory {
|
2008-09-18 10:34:17 +02:00
|
|
|
my $self = shift;
|
2008-10-07 22:15:48 +02:00
|
|
|
my ( $cat, $catlevel ) = @_;
|
2008-09-18 10:34:17 +02:00
|
|
|
my $html;
|
|
|
|
my $catname;
|
|
|
|
|
|
|
|
# Category name
|
2008-10-07 22:15:48 +02:00
|
|
|
if ( $catlevel > 0 ) { $catname = $cat->getAttribute('name') || " "; }
|
|
|
|
else { $catname = "Menu"; }
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Init HTML list
|
|
|
|
$html .= "<ul class=\"category cat-level-$catlevel\">\n";
|
2008-09-19 17:28:00 +02:00
|
|
|
$html .= "<li class=\"catname\"><span>$catname</span>\n";
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Display applications first
|
|
|
|
my @appnodes = $cat->findnodes("application");
|
2008-09-19 17:28:00 +02:00
|
|
|
$html .= "<ul>" if scalar @appnodes;
|
2008-09-18 10:34:17 +02:00
|
|
|
foreach (@appnodes) {
|
|
|
|
$html .= $self->_displayApplication($_);
|
|
|
|
}
|
2008-09-19 17:28:00 +02:00
|
|
|
$html .= "</ul>" if scalar @appnodes;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Display subcategories
|
|
|
|
my @catnodes = $cat->findnodes("category");
|
|
|
|
$catlevel++;
|
|
|
|
foreach (@catnodes) {
|
2008-10-07 22:15:48 +02:00
|
|
|
$html .= $self->_displayCategory( $_, $catlevel );
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# Close HTML list
|
2008-09-19 17:28:00 +02:00
|
|
|
$html .= "</li>\n</ul>\n";
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
return $html;
|
|
|
|
}
|
|
|
|
|
2008-11-12 17:09:35 +01:00
|
|
|
sub _userParam {
|
|
|
|
my ( $self, $arg ) = @_;
|
|
|
|
$arg =~ s/\$([\w]+)/$self->{portalObject}->{sessionInfo}->{$1}/g;
|
|
|
|
return $arg;
|
|
|
|
}
|
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# _displayApplication
|
|
|
|
# Create HTML code for an application
|
2008-09-19 17:28:00 +02:00
|
|
|
sub _displayApplication {
|
2008-09-18 10:34:17 +02:00
|
|
|
my $self = shift;
|
|
|
|
my ($app) = @_;
|
|
|
|
my $html;
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Get application items
|
2008-10-07 22:15:48 +02:00
|
|
|
my $appid = $app->getAttribute('id');
|
2008-09-18 10:34:17 +02:00
|
|
|
my $appname = $app->getElementsByTagName('name')->string_value() || $appid;
|
2008-11-12 17:09:35 +01:00
|
|
|
my $appuri =
|
|
|
|
$self->_userParam( $app->getElementsByTagName('uri')->string_value()
|
|
|
|
|| "#" );
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
# Display application
|
2008-10-07 22:15:48 +02:00
|
|
|
$html .=
|
|
|
|
"<li title=\"$appid\" class=\"appname\"><span><a href=\"$appuri\">$appname</a></span></li>\n";
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
return $html;
|
|
|
|
}
|
|
|
|
|
|
|
|
# _displayDescription
|
|
|
|
# Create HTML code for application description
|
|
|
|
sub _displayDescription {
|
|
|
|
my $self = shift;
|
|
|
|
my ($root) = @_;
|
|
|
|
my $html;
|
|
|
|
|
|
|
|
my @apps = $root->getElementsByTagName('application');
|
|
|
|
foreach (@apps) {
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Get application items
|
2008-10-07 22:15:48 +02:00
|
|
|
my $appid = $_->getAttribute('id');
|
2008-09-18 10:34:17 +02:00
|
|
|
my $appname = $_->getElementsByTagName('name')->string_value();
|
2008-11-12 17:09:35 +01:00
|
|
|
my $appuri =
|
|
|
|
$self->_userParam( $_->getElementsByTagName('uri')->string_value()
|
|
|
|
|| "#" );
|
2008-09-18 10:34:17 +02:00
|
|
|
my $appdesc = $_->getElementsByTagName('description')->string_value();
|
|
|
|
my $applogofile = $_->getElementsByTagName('logo')->string_value();
|
2008-10-07 22:15:48 +02:00
|
|
|
my $applogo = $self->{apps}->{imgpath} . $applogofile;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
# Display application
|
2008-09-18 10:34:17 +02:00
|
|
|
$html .= "<div id=\"$appid\" class=\"appsdesc\">\n";
|
2008-10-07 22:15:48 +02:00
|
|
|
$html .=
|
|
|
|
"<a href=\"$appuri\"><img src=\"$applogo\" alt=\"$appid logo\" /></a>\n"
|
|
|
|
if $applogofile;
|
2008-09-18 10:34:17 +02:00
|
|
|
$html .= "<p class=\"appname\">$appname</p>\n" if defined $appname;
|
|
|
|
$html .= "<p class=\"appdesc\">$appdesc</p>\n" if defined $appdesc;
|
|
|
|
$html .= "</div>\n";
|
|
|
|
}
|
|
|
|
|
|
|
|
return $html;
|
|
|
|
}
|
|
|
|
|
|
|
|
# _filterXML
|
2008-10-07 22:15:48 +02:00
|
|
|
# Remove unauthorized nodes
|
2008-09-18 10:34:17 +02:00
|
|
|
sub _filterXML {
|
|
|
|
my $self = shift;
|
|
|
|
my ($root) = @_;
|
|
|
|
|
|
|
|
my @apps = $root->getElementsByTagName('application');
|
|
|
|
foreach (@apps) {
|
|
|
|
my $appdisplay = $_->getElementsByTagName('display')->string_value();
|
2008-11-12 17:09:35 +01:00
|
|
|
my $appuri =
|
|
|
|
$self->_userParam( $_->getElementsByTagName('uri')->string_value() );
|
2008-10-07 22:15:48 +02:00
|
|
|
|
|
|
|
# Remove node if display is "no"
|
|
|
|
$_->unbindNode if ( $appdisplay eq "no" );
|
|
|
|
|
|
|
|
# Keep node if display is "yes"
|
|
|
|
next if ( $appdisplay eq "yes" );
|
2008-09-26 09:36:30 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
# Check grant function if display is "auto" (this is the default)
|
|
|
|
$_->unbindNode unless ( $self->_grant($appuri) );
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
# Hide empty categories
|
|
|
|
$self->_hideEmptyCategory($root);
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
# _hideEmptyCategory
|
2008-10-07 22:15:48 +02:00
|
|
|
#
|
2008-09-18 10:34:17 +02:00
|
|
|
sub _hideEmptyCategory {
|
|
|
|
my $self = shift;
|
|
|
|
my ($cat) = @_;
|
|
|
|
|
|
|
|
# Check subnodes
|
|
|
|
my @catnodes = $cat->findnodes("category");
|
|
|
|
my @appnodes = $cat->findnodes("application");
|
|
|
|
|
|
|
|
# Check each subcategory
|
|
|
|
foreach (@catnodes) {
|
|
|
|
$self->_hideEmptyCategory($_);
|
|
|
|
}
|
|
|
|
|
|
|
|
# Update node list
|
|
|
|
@catnodes = $cat->findnodes("category");
|
|
|
|
|
|
|
|
# Remove the node if it contains no category or no application
|
|
|
|
unless ( scalar(@catnodes) || scalar(@appnodes) ) {
|
|
|
|
$cat->unbindNode;
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
# _changePassword
|
|
|
|
# Change user's password
|
2008-10-16 09:35:42 +02:00
|
|
|
# TODO: Check used Auth module and change password for LDAP or DBI
|
2008-09-18 10:34:17 +02:00
|
|
|
sub _changePassword {
|
|
|
|
my $self = shift;
|
2008-10-07 22:15:48 +02:00
|
|
|
my ( $newpassword, $confirmpassword, $oldpassword ) = @_;
|
2008-09-19 17:28:00 +02:00
|
|
|
my $err;
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# Verify confirmation password matching
|
2008-10-07 22:15:48 +02:00
|
|
|
return PE_PASSWORD_MISMATCH unless ( $newpassword eq $confirmpassword );
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
# Connect to LDAP
|
2008-10-08 11:40:24 +02:00
|
|
|
unless ( $self->{portalObject}->ldap ) {
|
|
|
|
return PE_LDAPCONNECTFAILED;
|
|
|
|
}
|
2008-09-19 17:28:00 +02:00
|
|
|
|
2008-09-21 11:50:32 +02:00
|
|
|
my $ldap = $self->{portalObject}->{ldap};
|
2008-10-07 22:15:48 +02:00
|
|
|
my $dn = $self->{portalObject}->{sessionInfo}->{"dn"};
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
# First case: no ppolicy
|
2008-09-21 11:50:32 +02:00
|
|
|
if ( !$self->{portalObject}->{ldapPpolicyControl} ) {
|
2008-09-19 17:28:00 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
my $mesg =
|
|
|
|
$ldap->modify( $dn, replace => { userPassword => $newpassword } );
|
2008-09-19 17:28:00 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
return PE_WRONGMANAGERACCOUNT
|
|
|
|
if ( $mesg->code == 50 || $mesg->code == 8 );
|
2008-09-19 17:28:00 +02:00
|
|
|
return PE_LDAPERROR unless ( $mesg->code == 0 );
|
2008-11-21 18:51:52 +01:00
|
|
|
$self->_storePassword($newpassword);
|
2008-09-19 17:28:00 +02:00
|
|
|
return PE_PASSWORD_OK;
|
2008-10-07 22:15:48 +02:00
|
|
|
}
|
|
|
|
else {
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
# require Perl module
|
|
|
|
eval 'require Net::LDAP::Control::PasswordPolicy';
|
|
|
|
if ($@) {
|
2008-10-07 22:15:48 +02:00
|
|
|
print STDERR
|
|
|
|
"Module Net::LDAP::Control::PasswordPolicy not found in @INC\n";
|
2008-09-19 17:28:00 +02:00
|
|
|
return PE_LDAPERROR;
|
|
|
|
}
|
|
|
|
no strict 'subs';
|
|
|
|
|
|
|
|
# Create Control object
|
|
|
|
my $pp = Net::LDAP::Control::PasswordPolicy->new;
|
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
my $mesg = $ldap->modify(
|
|
|
|
$dn,
|
|
|
|
replace => { userPassword => $newpassword },
|
|
|
|
control => [$pp]
|
|
|
|
);
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
# 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");
|
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
return PE_WRONGMANAGERACCOUNT
|
|
|
|
if ( $mesg->code == 50 || $mesg->code == 8 );
|
2008-11-21 18:51:52 +01:00
|
|
|
$self->_storePassword($newpassword) && return PE_PASSWORD_OK
|
|
|
|
if ( $mesg->code == 0 );
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
if ( defined $resp ) {
|
|
|
|
my $pp_error = $resp->pp_error;
|
|
|
|
if ( defined $pp_error ) {
|
|
|
|
return [
|
|
|
|
PE_PP_PASSWORD_EXPIRED,
|
|
|
|
PE_PP_ACCOUNT_LOCKED,
|
|
|
|
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,
|
|
|
|
PE_PP_PASSWORD_IN_HISTORY,
|
|
|
|
]->[$pp_error];
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return PE_LDAPERROR;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2008-10-16 09:35:42 +02:00
|
|
|
# _storePassword
|
|
|
|
# Store new password in session if storePassword parameter is set
|
|
|
|
sub _storePassword {
|
|
|
|
my $self = shift;
|
2008-11-21 18:51:52 +01:00
|
|
|
my ($password) = @_;
|
2008-10-16 09:35:42 +02:00
|
|
|
if ( $self->{portalObject}->{storePassword} ) {
|
|
|
|
$self->{portalObject}->{sessionInfo}->{_password} = $password;
|
2008-11-21 18:51:52 +01:00
|
|
|
|
2008-10-16 09:35:42 +02:00
|
|
|
# Update session
|
2008-11-21 18:51:52 +01:00
|
|
|
&Lemonldap::NG::Portal::Simple::updateSession( $self->{portalObject},
|
|
|
|
{ _password => $password } );
|
2008-10-16 09:35:42 +02:00
|
|
|
}
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# _ppolicyWarning
|
|
|
|
# Return ppolicy warnings get in AuthLDAP.pm
|
|
|
|
sub _ppolicyWarning {
|
2008-10-07 22:15:48 +02:00
|
|
|
my $self = shift;
|
2008-09-19 17:28:00 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
# Grace
|
|
|
|
if (
|
|
|
|
defined $self->{portalObject}->{ppolicy}
|
|
|
|
->{grace_authentications_remaining} )
|
|
|
|
{
|
|
|
|
return ( PE_PP_GRACE,
|
|
|
|
$self->{portalObject}->{ppolicy}
|
|
|
|
->{grace_authentications_remaining} );
|
|
|
|
}
|
2008-09-19 17:28:00 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
# Expiration warning
|
|
|
|
if ( defined $self->{portalObject}->{ppolicy}->{time_before_expiration} ) {
|
|
|
|
return ( PE_PP_EXP_WARNING,
|
|
|
|
$self->{portalObject}->{ppolicy}->{time_before_expiration} );
|
|
|
|
}
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
# Return PE_OK
|
|
|
|
return ( PE_OK, undef );
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
2008-09-21 11:50:32 +02:00
|
|
|
# _grant
|
|
|
|
# Check user's authorization
|
|
|
|
sub _grant {
|
|
|
|
my $self = shift;
|
|
|
|
my ($uri) = @_;
|
2008-11-17 15:02:50 +01:00
|
|
|
$uri =~ m{(\w+)://([^/:]+)(:\d+)?(/.*)?$};
|
|
|
|
my ( $protocol, $vhost, $port );
|
|
|
|
( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
|
|
|
|
$path ||= '/';
|
2008-09-21 11:50:32 +02:00
|
|
|
$self->_compileRules() if ( $cfgNum != $self->{portalObject}->{cfgNum} );
|
2008-10-07 22:15:48 +02:00
|
|
|
return -1 unless ( defined( $defaultCondition->{$vhost} ) );
|
2008-11-21 18:51:52 +01:00
|
|
|
|
2008-10-07 22:15:48 +02:00
|
|
|
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);
|
|
|
|
}
|
|
|
|
}
|
2008-09-21 11:50:32 +02:00
|
|
|
}
|
|
|
|
unless ( $defaultCondition->{$vhost} ) {
|
2008-10-07 22:15:48 +02:00
|
|
|
print STDERR
|
|
|
|
"Application $uri did not match any configured virtual host\n";
|
2008-09-21 11:50:32 +02:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
return &{ $defaultCondition->{$vhost} }($self);
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2008-09-26 09:36:30 +02:00
|
|
|
# _compileRules
|
|
|
|
# Parse configured rules
|
2008-09-21 11:50:32 +02:00
|
|
|
sub _compileRules {
|
2008-09-26 09:36:30 +02:00
|
|
|
my $self = shift;
|
2008-09-21 11:50:32 +02:00
|
|
|
foreach my $vhost ( keys %{ $self->{portalObject}->{locationRules} } ) {
|
|
|
|
my $i = 0;
|
2008-09-26 09:36:30 +02:00
|
|
|
foreach ( keys %{ $self->{portalObject}->{locationRules}->{$vhost} } ) {
|
2008-09-21 11:50:32 +02:00
|
|
|
if ( $_ eq 'default' ) {
|
|
|
|
$defaultCondition->{$vhost} =
|
2008-09-26 09:36:30 +02:00
|
|
|
$self->_conditionSub(
|
|
|
|
$self->{portalObject}->{locationRules}->{$vhost}->{$_} );
|
2008-09-21 11:50:32 +02:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
$locationCondition->{$vhost}->[$i] =
|
2008-10-07 22:15:48 +02:00
|
|
|
$self->_conditionSub(
|
|
|
|
$self->{portalObject}->{locationRules}->{$vhost}->{$_} );
|
2008-09-21 11:50:32 +02:00
|
|
|
$locationRegexp->{$vhost}->[$i] = qr/$_/;
|
|
|
|
$i++;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2008-09-26 09:36:30 +02:00
|
|
|
# Default policy
|
|
|
|
$defaultCondition->{$vhost} ||= $self->_conditionSub('accept');
|
2008-09-21 11:50:32 +02:00
|
|
|
}
|
|
|
|
$cfgNum = $self->{portalObject}->{cfgNum};
|
|
|
|
1;
|
|
|
|
}
|
|
|
|
|
2008-09-26 09:36:30 +02:00
|
|
|
# _conditionSub
|
|
|
|
# Return subroutine giving authorization condition
|
|
|
|
sub _conditionSub {
|
|
|
|
my $self = shift;
|
|
|
|
my ($cond) = @_;
|
2008-09-21 11:50:32 +02:00
|
|
|
return sub { 1 }
|
|
|
|
if ( $cond =~ /^accept$/i );
|
|
|
|
return sub { 0 }
|
|
|
|
if ( $cond =~ /^(?:deny$|logout)/i );
|
|
|
|
$cond =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e;
|
|
|
|
$cond =~ s/\$(\w+)/\$self->{portalObject}->{sessionInfo}->{$1}/g;
|
|
|
|
my $sub;
|
2008-11-14 08:16:26 +01:00
|
|
|
$sub = $self->_safe->reval("sub {my \$self = shift; return ( $cond )}");
|
2008-09-21 11:50:32 +02:00
|
|
|
return $sub;
|
|
|
|
}
|
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
1;
|
|
|
|
|
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
Lemonldap::NG::Portal::Menu - Enhanced menu to display to authenticated users
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
use Lemonldap::NG::Portal::Menu;
|
|
|
|
my $menu = Lemonldap::NG::Portal::Menu->new(
|
|
|
|
{
|
2008-09-21 11:50:32 +02:00
|
|
|
portalObject => $portal,
|
2008-09-18 10:34:17 +02:00
|
|
|
apps => {
|
|
|
|
xmlfile => "/var/lib/lemonldap-ng/conf/apps-list.xml",
|
|
|
|
imgpath => "apps/",
|
|
|
|
},
|
|
|
|
modules => {
|
|
|
|
appslist => 1,
|
|
|
|
password => 1,
|
|
|
|
logout => 1,
|
|
|
|
},
|
|
|
|
}
|
|
|
|
);
|
|
|
|
|
|
|
|
# Print HTML code of authorized applications list
|
2008-09-19 17:28:00 +02:00
|
|
|
print $menu->appslistMenu;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
Lemonldap::NG::Portal::Menu provides these web modules:
|
|
|
|
|
|
|
|
=over
|
|
|
|
|
|
|
|
=item * Application list: display a full menu with all authorized applications
|
|
|
|
|
|
|
|
=item * Password: allow the user to change its password (with LDAP auth only)
|
|
|
|
|
|
|
|
=item * Logout: display a simple logout confirmation page
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
These web modules are designed to be used in HTML::Template, with the help of
|
|
|
|
Jquery scripts. Without that, this will only output raw HTML code.
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
|
|
|
L<Lemonldap::NG::Portal>,
|
|
|
|
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/EnhancedMenu
|
|
|
|
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation
|
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
Clement OUDOT E<lt>clement@oodo.netE<gt> E<lt>coudot@linagora.comE<gt>
|
2008-09-18 10:34:17 +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>
|
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
|
|
|
Copyright (C) 2005-2007 by Xavier Guimard E<lt>x.guimard@free.frE<gt>
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|