##@file
# Menu for Lemonldap::NG portal
##@class
# Menu class for Lemonldap::NG portal
package Lemonldap::NG::Portal::Menu;
use strict;
use warnings;
require Lemonldap::NG::Common::CGI;
use Lemonldap::NG::Portal::SharedConf;
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
use Safe;
#inherits Net::LDAP::Control::PasswordPolicy
our $VERSION = '0.3';
### ACCESS CONTROL DISPLAY SYSTEM
our ( $defaultCondition, $locationCondition, $locationRegexp, $cfgNum, $path ) =
( undef, undef, undef, 0 );
## @method private Safe _safe()
# Build and returns security jail.
# Includes custom functions
# @return Safe object
sub _safe {
my $self = shift;
return $self->{_safe} if ( $self->{_safe} );
$self->{_safe} = new Safe;
$self->{customFunctions} ||= $self->{portalObject}->{customFunctions};
my @t =
$self->{customFunctions} ? split( /\s+/, $self->{customFunctions} ) : ();
foreach (@t) {
my $sub = $_;
unless (/::/) {
$sub = "$self->{caller}::$_";
}
else {
s/^.*:://;
}
next if ( __PACKAGE__->can($_) );
eval "sub $_ {
return $sub(\$path,\@_);
}";
$self->{portalObject}->lmLog( $@, 'error' ) if ($@);
}
$self->{_safe}->share_from( 'main', ['%ENV'] );
$self->{_safe}->share_from( 'Lemonldap::NG::Common::Safelib',
$Lemonldap::NG::Common::Safelib::functions );
$self->{_safe}->share( '&encode_base64', @t );
return $self->{_safe};
}
my $catlevel = 0;
##@cmethod Lemonldap::NG::Portal::Menu new(hashRef args)
# Constructor.
# $args->{portalObject} is required.
#@param $args hash reference
#@return new object
sub new {
my $class = shift;
my $self = {};
bless( $self, $class );
# Get configuration
$self->Lemonldap::NG::Portal::Simple::getConf(@_)
or Lemonldap::NG::Common::CGI->abort(
"Unable to read $class->new() parameters");
# Portal is required
Lemonldap::NG::Common::CGI->abort("Portal object required")
unless ( $self->{portalObject} );
# Fill sessionInfo (yet done in portal...)
#&Lemonldap::NG::Portal::Simple::getSessionInfo( $self->{portalObject} );
# Default values
$self->{apps}->{imgpath} ||= '/apps/';
$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};
$self->{'caller'} = caller;
# Store POST data in $self->{portalObject}
$self->{portalObject}->{'newpassword'} =
$self->{portalObject}->param('newpassword');
$self->{portalObject}->{'confirmpassword'} =
$self->{portalObject}->param('confirmpassword');
$self->{portalObject}->{'oldpassword'} =
$self->{portalObject}->param('oldpassword');
$self->{portalObject}->{'dn'} =
$self->{portalObject}->{sessionInfo}->{'dn'};
$self->{portalObject}->{'user'} =
$self->{portalObject}->{sessionInfo}->{'_user'};
# Password modification functions (TODO merge Menu.pm in Simple.pm to inherits those functions)
# Default to LDAP
$self->{portalObject}->{passwordDB} ||= 'LDAP';
if ( $self->{portalObject}->{passwordDB} =~ /DBI/i ) {
use Lemonldap::NG::Portal::PasswordDBDBI; #inherits
use Lemonldap::NG::Portal::_DBI
; #link protected dbi Object used to change passwords only
*_modifyPassword =
*Lemonldap::NG::Portal::PasswordDBDBI::modifyPassword;
*_passwordDBInit =
*Lemonldap::NG::Portal::PasswordDBDBI::passwordDBInit;
}
if ( $self->{portalObject}->{passwordDB} =~ /Null/i ) {
use Lemonldap::NG::Portal::PasswordDBNull; #inherits
*_modifyPassword =
*Lemonldap::NG::Portal::PasswordDBNull::modifyPassword;
*_passwordDBInit =
*Lemonldap::NG::Portal::PasswordDBNull::passwordDBInit;
}
if ( $self->{portalObject}->{passwordDB} =~ /LDAP/i ) {
use Lemonldap::NG::Portal::PasswordDBLDAP; #inherits
use Lemonldap::NG::Portal::_LDAP
'ldap'; #link protected ldap Object used to change passwords only
*_modifyPassword =
*Lemonldap::NG::Portal::PasswordDBLDAP::modifyPassword;
*_passwordDBInit =
*Lemonldap::NG::Portal::PasswordDBLDAP::passwordDBInit;
}
# Change password (only if newpassword submitted)
$self->{portalObject}->{error} = &_passwordDBInit( $self->{portalObject} )
if $self->{portalObject}->{'newpassword'};
$self->{portalObject}->{error} = &_modifyPassword( $self->{portalObject} )
if $self->{portalObject}->{'newpassword'};
return $self;
}
## @method boolean displayModule(string modulename)
# Return true if the user can see the module.
# Use for HTML::Template variable.
# @param $modulename string
# @return boolean
sub displayModule {
my ( $self, $modulename ) = splice @_;
# Manage "0" and "1" rules
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;
return $self->_safe->reval("sub {return ( $cond )}");
return 0;
}
## @method string displayTab()
# Tells which tab should be selected.
# Design for Jquery tabs.
# @return password, appslist or logout
sub displayTab {
my $self = shift;
# Display password tab if password change is needed or failed
return "password"
if (
(
scalar(
grep { $_ == $self->{portalObject}->{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
39, #PE_BADOLDPASSWORD
)
)
)
&& $self->displayModule("password")
);
return "appslist" if ( $self->displayModule("appslist") );
return "logout";
}
## @method string appslistMenu()
# Returns HTML code for application list menu.
# @return HTML string
sub appslistMenu {
my $self = shift;
# We no more use XML file for menu configuration
unless ( defined $self->{portalObject}->{applicationList} ) {
$self->{portalObject}->abort(
"XML menu configuration is deprecated",
"Please use lmMigrateConfFiles2ini to migrate your menu configuration"
);
}
# Use configuration to get menu parameters
my $applicationList = $self->{portalObject}->{applicationList};
my $filteredList = $self->_filter($applicationList);
return $self->_displayConfCategory( "", $applicationList, $catlevel );
}
## @method string appslistDescription()
# Returns HTML code for application description.
# @return HTML string
sub appslistDescription {
my $self = shift;
# We no more use XML file for menu configuration
unless ( defined $self->{portalObject}->{applicationList} ) {
$self->{portalObject}->lmLog(
"XML menu configuration is deprecated. Please use lmMigrateConfFiles2ini to migrate your menu configuration",
'error'
);
return " ";
}
# Use configuration to get menu parameters
my $applicationList = $self->{portalObject}->{applicationList};
return $self->_displayConfDescription( "", $applicationList );
}
## @method string _displayConfCategory()
# Creates and returns HTML code for a category.
# @param catname Category name
# @param cathash Hash of category elements
# @param catlevel Category level
# @return HTML string
sub _displayConfCategory {
my ( $self, $catname, $cathash, $catlevel ) = splice @_;
my $html;
my $key;
# Init HTML list
$html .= "
\n";
$html .= "- \n";
$html .= "$catname\n" if $catname;
# Increase category level
$catlevel++;
# Extract applications from hash
my $apphash;
foreach $key ( keys %$cathash ) {
next if $key =~ /(type|options)/;
if ( $cathash->{$key}->{type} eq "application" ) {
$apphash->{$key} = $cathash->{$key};
}
}
# display applications first
if ( scalar keys %$apphash > 0 ) {
$html .= "
";
foreach $key ( keys %$apphash ) {
$html .= $self->_displayConfApplication( $key, $apphash->{$key} );
}
$html .= "
";
}
# Display subcategories
foreach $key ( keys %$cathash ) {
next if $key =~ /(type|options)/;
if ( $cathash->{$key}->{type} eq "category" ) {
$html .=
$self->_displayConfCategory( $key, $cathash->{$key}, $catlevel );
}
}
# Close HTML list
$html .= " \n";
$html .= "
\n";
return $html;
}
## @method private string _userParam(string arg)
# Returns value of $arg variable stored in session.
# @param $arg string to modify
# @return string modified
sub _userParam {
my ( $self, $arg ) = splice @_;
$arg =~ s/\$([\w]+)/$self->{portalObject}->{sessionInfo}->{$1}/g;
return $arg;
}
## @method private string _displayConfApplication()
# Creates HTML code for an application.
# @param $appid Application ID
# @param $apphash Hash of application elements
# @return HTML string
sub _displayConfApplication {
my $self = shift;
my ( $appid, $apphash ) = @_;
my $html;
my $key;
# Get application items
my $appname = $apphash->{options}->{name} || $appid;
my $appuri = $apphash->{options}->{uri} || "";
# Display application
$html .=
""
. ( $appuri ? "$appname" : "$appname" )
. "\n";
# Detect sub applications
my $subapphash;
foreach $key ( keys %$apphash ) {
next if $key =~ /(type|options)/;
if ( $apphash->{$key}->{type} eq "application" ) {
$subapphash->{$key} = $apphash->{$key};
}
}
# Display sub applications
if ( scalar keys %$subapphash > 0 ) {
$html .= "";
foreach $key ( keys %$subapphash ) {
$html .=
$self->_displayConfApplication( $key, $subapphash->{$key} );
}
$html .= "
";
}
$html .= "";
return $html;
}
## @method private string _displayConfDescription()
# Create HTML code for application description.
# @param $appid Application ID
# @param $apphash Hash
# @return HTML string
sub _displayConfDescription {
my $self = shift;
my ( $appid, $apphash ) = @_;
my $html;
my $key;
if ( defined $apphash->{type} and $apphash->{type} eq "application" ) {
# Get application items
my $appname = $apphash->{options}->{name} || $appid;
my $appuri = $apphash->{options}->{uri} || "";
my $appdesc = $apphash->{options}->{description};
my $applogofile = $apphash->{options}->{logo};
my $applogo = $self->{apps}->{imgpath} . $applogofile
if $applogofile;
# Display application description
$html .= "\n";
$html .=
"
![\"$appid](\"$applogo\")
\n"
if $applogofile;
$html .= "
$appname
\n" if defined $appname;
$html .= "
$appdesc
\n" if defined $appdesc;
$html .= "
\n";
}
# Sublevels
foreach $key ( keys %$apphash ) {
next if $key =~ /(type|options)/;
$html .= $self->_displayConfDescription( $key, $apphash->{$key} );
}
return $html;
}
## @method private string _filter()
# Duplicate hash reference
# Remove unauthorized menu elements
# Hide empty categories
# @param $apphash Menu elements
# @return filtered hash
sub _filter {
my ( $self, $apphash ) = splice @_;
my $filteredHash;
my $key;
# Copy hash reference into a new hash
foreach $key ( keys %$apphash ) {
$filteredHash->{$key} = $apphash->{$key};
}
# Filter hash
$self->_filterHash($filteredHash);
# Hide empty categories
$self->_isCategoryEmpty($filteredHash);
return $filteredHash;
}
## @method private string _filterHash()
# Remove unauthorized menu elements
# @param $apphash Menu elements
# @return filtered hash
sub _filterHash {
my $self = shift;
my ($apphash) = @_;
my $key;
my $appkey;
foreach $key ( keys %$apphash ) {
next if $key =~ /(type|options)/;
if ( $apphash->{$key}->{type} eq "category" ) {
# Filter the category
$self->_filterHash( $apphash->{$key} );
}
if ( $apphash->{$key}->{type} eq "application" ) {
# Find sub applications and filter them
foreach $appkey ( keys %{ $apphash->{$key} } ) {
next if $appkey =~ /(type|options)/;
# We have sub elements, so we filter them
$self->_filterHash( $apphash->{$key} );
}
# Check rights
my $appdisplay = $apphash->{$key}->{options}->{display}
|| "auto";
my $appuri = $apphash->{$key}->{options}->{uri};
# Remove if display is "no"
delete $apphash->{$key} and next if ( $appdisplay eq "no" );
# Keep node if display is "yes"
next if ( $appdisplay eq "yes" );
# Check grant function if display is "auto" (this is the default)
delete $apphash->{$key} unless ( $self->_grant($appuri) );
next;
}
}
}
## @method private void _isCategoryEmpty()
# Check if a category is empty
# @param $apphash Menu elements
# @return boolean
sub _isCategoryEmpty {
my $self = shift;
my ($apphash) = @_;
my $key;
# Test sub categories
foreach $key ( keys %$apphash ) {
next if $key =~ /(type|options)/;
if ( $apphash->{$key}->{type} eq "category" ) {
delete $apphash->{$key}
if $self->_isCategoryEmpty( $apphash->{$key} );
}
}
# Test this category
if ( $apphash->{type} and $apphash->{type} eq "category" ) {
# Temporary store 'options'
my $tmp_options = $apphash->{options};
delete $apphash->{type};
delete $apphash->{options};
if ( scalar( keys %$apphash ) ) {
# There are sub categories or sub applications
# Restore type and options
$apphash->{type} = "category";
$apphash->{options} = $tmp_options;
# Return false
return 0;
}
else {
# Return true
return 1;
}
}
return 0;
}
## @method private boolean _grant(string uri)
# Check user's authorization for $uri.
# @param $uri URL string
# @return True if granted
sub _grant {
my ( $self, $uri ) = splice @_;
$uri =~ m{(\w+)://([^/:]+)(:\d+)?(/.*)?$} or return 0;
my ( $protocol, $vhost, $port );
( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
$path ||= '/';
$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);
}
}
}
unless ( $defaultCondition->{$vhost} ) {
$self->{portalObject}
->lmLog( "Application $uri did not match any configured virtual host",
'warn' );
return 0;
}
return &{ $defaultCondition->{$vhost} }($self);
return 1;
}
## @method private boolean _compileRules()
# Parse configured rules and compile them
# @return True
sub _compileRules {
my $self = shift;
foreach my $vhost ( keys %{ $self->{portalObject}->{locationRules} } ) {
my $i = 0;
foreach ( keys %{ $self->{portalObject}->{locationRules}->{$vhost} } ) {
if ( $_ eq 'default' ) {
$defaultCondition->{$vhost} =
$self->_conditionSub(
$self->{portalObject}->{locationRules}->{$vhost}->{$_} );
}
else {
$locationCondition->{$vhost}->[$i] =
$self->_conditionSub(
$self->{portalObject}->{locationRules}->{$vhost}->{$_} );
$locationRegexp->{$vhost}->[$i] = qr/$_/;
$i++;
}
}
# Default policy
$defaultCondition->{$vhost} ||= $self->_conditionSub('accept');
}
$cfgNum = $self->{portalObject}->{cfgNum};
1;
}
## @method private CODE _conditionSub(string cond)
# Return subroutine giving authorization condition.
# @param $cond boolean expression
# @return Compiled routine
sub _conditionSub {
my ( $self, $cond ) = splice @_;
return sub { 1 }
if ( $cond =~ /^(?:accept|unprotect)$/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;
$sub = $self->_safe->reval("sub {my \$self = shift; return ( $cond )}");
return $sub;
}
1;
__END__
=head1 NAME
=encoding utf8
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(
{
portalObject => $portal,
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
print $menu->appslistMenu;
=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,
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/EnhancedMenu
http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation
=head1 AUTHOR
Clement OUDOT Eclement@oodo.netE Ecoudot@linagora.comE
=head1 BUG REPORT
Use OW2 system to report bug or ask for features:
L
=head1 DOWNLOAD
Lemonldap::NG is available at
L
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005-2007 by Clement OUDOT Eclement@oodo.netE
Ecoudot@linagora.comE
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