2008-12-26 20:18:23 +01:00
|
|
|
##@file
|
|
|
|
# Menu for Lemonldap::NG portal
|
|
|
|
|
|
|
|
##@class
|
|
|
|
# Menu class for Lemonldap::NG portal
|
2008-09-18 10:34:17 +02:00
|
|
|
package Lemonldap::NG::Portal::Menu;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
2008-12-25 15:14:15 +01:00
|
|
|
require Lemonldap::NG::Common::CGI;
|
2008-09-21 11:50:32 +02:00
|
|
|
use Lemonldap::NG::Portal::SharedConf;
|
2009-12-11 22:17:06 +01:00
|
|
|
use Lemonldap::NG::Common::Safelib; #link protected safe Safe object
|
2008-09-21 11:50:32 +02:00
|
|
|
use Safe;
|
2010-09-04 13:49:03 +02:00
|
|
|
use constant SAFEWRAP => ( Safe->can("wrap_code_re") ? 1 : 0 );
|
2009-02-12 20:48:53 +01:00
|
|
|
|
2009-02-03 10:36:13 +01:00
|
|
|
#inherits Net::LDAP::Control::PasswordPolicy
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2009-12-10 12:30:43 +01:00
|
|
|
our $VERSION = '0.3';
|
2008-09-18 10:34:17 +02:00
|
|
|
|
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-12-28 09:36:52 +01:00
|
|
|
## @method private Safe _safe()
|
2008-12-26 20:18:23 +01:00
|
|
|
# Build and returns security jail.
|
|
|
|
# Includes custom functions
|
2008-12-28 09:36:52 +01:00
|
|
|
# @return Safe object
|
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-12-11 18:02:02 +01:00
|
|
|
$self->{customFunctions} ||= $self->{portalObject}->{customFunctions};
|
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
|
|
|
}";
|
2009-02-12 20:48:53 +01:00
|
|
|
$self->{portalObject}->lmLog( $@, 'error' ) if ($@);
|
2008-11-17 15:02:50 +01:00
|
|
|
}
|
2009-04-21 15:24:38 +02:00
|
|
|
$self->{_safe}->share_from( 'main', ['%ENV'] );
|
|
|
|
$self->{_safe}->share_from( 'Lemonldap::NG::Common::Safelib',
|
|
|
|
$Lemonldap::NG::Common::Safelib::functions );
|
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;
|
|
|
|
|
2008-12-29 11:28:31 +01:00
|
|
|
##@cmethod Lemonldap::NG::Portal::Menu new(hashRef args)
|
2008-12-28 09:36:52 +01:00
|
|
|
# Constructor.
|
2008-12-26 20:18:23 +01:00
|
|
|
# $args->{portalObject} is required.
|
2008-12-28 09:36:52 +01:00
|
|
|
#@param $args hash reference
|
|
|
|
#@return new object
|
2008-09-18 10:34:17 +02:00
|
|
|
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(@_)
|
2009-02-12 20:48:53 +01:00
|
|
|
or Lemonldap::NG::Common::CGI->abort(
|
|
|
|
"Unable to read $class->new() parameters");
|
2008-10-07 22:15:48 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Portal is required
|
2009-02-12 20:48:53 +01:00
|
|
|
Lemonldap::NG::Common::CGI->abort("Portal object required")
|
|
|
|
unless ( $self->{portalObject} );
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2009-02-14 09:55:19 +01:00
|
|
|
# Fill sessionInfo (yet done in portal...)
|
|
|
|
#&Lemonldap::NG::Portal::Simple::getSessionInfo( $self->{portalObject} );
|
2008-09-26 09:36:30 +02:00
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
# Default values
|
2010-02-11 13:39:42 +01:00
|
|
|
$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
|
|
|
|
2009-06-02 17:34:13 +02:00
|
|
|
# Store POST data in $self->{portalObject}
|
2009-07-01 10:52:14 +02:00
|
|
|
$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'};
|
2008-09-19 17:28:00 +02:00
|
|
|
|
2009-12-11 22:17:06 +01:00
|
|
|
# Password modification functions (TODO merge Menu.pm in Simple.pm to inherits those functions)
|
2010-01-27 15:04:41 +01:00
|
|
|
# Default to LDAP
|
|
|
|
$self->{portalObject}->{passwordDB} ||= 'LDAP';
|
2010-03-01 21:32:28 +01:00
|
|
|
if ( $self->{portalObject}->{passwordDB} =~ /DBI/i ) {
|
2009-12-10 12:30:43 +01:00
|
|
|
use Lemonldap::NG::Portal::PasswordDBDBI; #inherits
|
2010-01-15 23:01:04 +01:00
|
|
|
use Lemonldap::NG::Portal::_DBI
|
2010-01-27 15:04:41 +01:00
|
|
|
; #link protected dbi Object used to change passwords only
|
2009-12-11 22:17:06 +01:00
|
|
|
*_modifyPassword =
|
|
|
|
*Lemonldap::NG::Portal::PasswordDBDBI::modifyPassword;
|
|
|
|
*_passwordDBInit =
|
|
|
|
*Lemonldap::NG::Portal::PasswordDBDBI::passwordDBInit;
|
2010-01-25 15:32:22 +01:00
|
|
|
}
|
2010-03-01 21:32:28 +01:00
|
|
|
if ( $self->{portalObject}->{passwordDB} =~ /Null/i ) {
|
|
|
|
use Lemonldap::NG::Portal::PasswordDBNull; #inherits
|
|
|
|
*_modifyPassword =
|
|
|
|
*Lemonldap::NG::Portal::PasswordDBNull::modifyPassword;
|
|
|
|
*_passwordDBInit =
|
|
|
|
*Lemonldap::NG::Portal::PasswordDBNull::passwordDBInit;
|
|
|
|
}
|
2010-01-27 15:04:41 +01:00
|
|
|
if ( $self->{portalObject}->{passwordDB} =~ /LDAP/i ) {
|
2009-12-10 12:30:43 +01:00
|
|
|
use Lemonldap::NG::Portal::PasswordDBLDAP; #inherits
|
2010-01-15 23:01:04 +01:00
|
|
|
use Lemonldap::NG::Portal::_LDAP
|
|
|
|
'ldap'; #link protected ldap Object used to change passwords only
|
2009-12-11 22:17:06 +01:00
|
|
|
*_modifyPassword =
|
|
|
|
*Lemonldap::NG::Portal::PasswordDBLDAP::modifyPassword;
|
|
|
|
*_passwordDBInit =
|
|
|
|
*Lemonldap::NG::Portal::PasswordDBLDAP::passwordDBInit;
|
2009-12-10 12:30:43 +01:00
|
|
|
}
|
|
|
|
|
2008-09-19 17:28:00 +02:00
|
|
|
# Change password (only if newpassword submitted)
|
2010-01-15 23:01:04 +01:00
|
|
|
$self->{portalObject}->{error} = &_passwordDBInit( $self->{portalObject} )
|
2009-07-01 10:52:14 +02:00
|
|
|
if $self->{portalObject}->{'newpassword'};
|
2010-01-15 23:01:04 +01:00
|
|
|
$self->{portalObject}->{error} = &_modifyPassword( $self->{portalObject} )
|
2009-07-01 10:52:14 +02:00
|
|
|
if $self->{portalObject}->{'newpassword'};
|
2008-09-18 10:34:17 +02:00
|
|
|
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
2008-12-30 10:37:56 +01:00
|
|
|
## @method boolean displayModule(string modulename)
|
2008-12-26 20:18:23 +01:00
|
|
|
# Return true if the user can see the module.
|
|
|
|
# Use for HTML::Template variable.
|
|
|
|
# @param $modulename string
|
|
|
|
# @return boolean
|
2008-09-19 17:28:00 +02:00
|
|
|
sub displayModule {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $modulename ) = splice @_;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
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;
|
2010-09-04 13:49:03 +02:00
|
|
|
return (
|
|
|
|
SAFEWRAP
|
|
|
|
? $self->safe->wrap_code_ref(
|
|
|
|
$self->safe->reval("sub{return($cond)}")
|
|
|
|
)
|
|
|
|
: $self->safe->reval("sub{return($cond)}")
|
|
|
|
);
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
2008-12-28 09:36:52 +01:00
|
|
|
## @method string displayTab()
|
2008-12-26 20:18:23 +01:00
|
|
|
# Tells which tab should be selected.
|
|
|
|
# Design for Jquery tabs.
|
2008-12-28 09:36:52 +01:00
|
|
|
# @return password, appslist or logout
|
2008-09-19 17:28:00 +02:00
|
|
|
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(
|
2010-01-15 23:01:04 +01:00
|
|
|
grep { $_ == $self->{portalObject}->{error} } (
|
2008-10-07 22:15:48 +02:00
|
|
|
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
|
2009-12-10 12:30:43 +01:00
|
|
|
39, #PE_BADOLDPASSWORD
|
2008-10-07 22:15:48 +02:00
|
|
|
)
|
|
|
|
)
|
|
|
|
)
|
|
|
|
&& $self->displayModule("password")
|
|
|
|
);
|
2008-09-19 17:28:00 +02:00
|
|
|
|
|
|
|
return "appslist" if ( $self->displayModule("appslist") );
|
|
|
|
return "logout";
|
|
|
|
}
|
|
|
|
|
2008-12-28 09:36:52 +01:00
|
|
|
## @method string appslistMenu()
|
2008-12-26 20:18:23 +01:00
|
|
|
# Returns HTML code for application list menu.
|
2008-12-28 09:36:52 +01:00
|
|
|
# @return HTML string
|
2008-09-19 17:28:00 +02:00
|
|
|
sub appslistMenu {
|
|
|
|
my $self = shift;
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# We no more use XML file for menu configuration
|
|
|
|
unless ( defined $self->{portalObject}->{applicationList} ) {
|
2010-02-11 09:44:57 +01:00
|
|
|
$self->{portalObject}->abort(
|
|
|
|
"XML menu configuration is deprecated",
|
|
|
|
"Please use lmMigrateConfFiles2ini to migrate your menu configuration"
|
2010-01-20 18:17:21 +01:00
|
|
|
);
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Use configuration to get menu parameters
|
2010-01-08 12:51:04 +01:00
|
|
|
my $applicationList = $self->{portalObject}->{applicationList};
|
2010-01-15 23:01:04 +01:00
|
|
|
my $filteredList = $self->_filter($applicationList);
|
|
|
|
return $self->_displayConfCategory( "", $applicationList, $catlevel );
|
2008-09-19 17:28:00 +02:00
|
|
|
}
|
|
|
|
|
2008-12-28 09:36:52 +01:00
|
|
|
## @method string appslistDescription()
|
2008-12-26 20:18:23 +01:00
|
|
|
# Returns HTML code for application description.
|
2008-12-28 09:36:52 +01:00
|
|
|
# @return HTML string
|
2008-09-19 17:28:00 +02:00
|
|
|
sub appslistDescription {
|
|
|
|
my $self = shift;
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# 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 " ";
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Use configuration to get menu parameters
|
2010-01-08 12:51:04 +01:00
|
|
|
my $applicationList = $self->{portalObject}->{applicationList};
|
|
|
|
return $self->_displayConfDescription( "", $applicationList );
|
2008-09-19 17:28:00 +02:00
|
|
|
}
|
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
## @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 {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $catname, $cathash, $catlevel ) = splice @_;
|
2010-01-08 12:51:04 +01:00
|
|
|
my $html;
|
|
|
|
my $key;
|
|
|
|
|
|
|
|
# Init HTML list
|
|
|
|
$html .= "<ul class=\"category cat-level-$catlevel\">\n";
|
|
|
|
$html .= "<li class=\"catname\">\n";
|
|
|
|
$html .= "<span>$catname</span>\n" if $catname;
|
|
|
|
|
|
|
|
# Increase category level
|
|
|
|
$catlevel++;
|
|
|
|
|
|
|
|
# Extract applications from hash
|
|
|
|
my $apphash;
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$cathash ) {
|
|
|
|
next if $key =~ /(type|options)/;
|
|
|
|
if ( $cathash->{$key}->{type} eq "application" ) {
|
2010-01-08 12:51:04 +01:00
|
|
|
$apphash->{$key} = $cathash->{$key};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# display applications first
|
2010-01-15 23:01:04 +01:00
|
|
|
if ( scalar keys %$apphash > 0 ) {
|
2010-01-08 12:51:04 +01:00
|
|
|
$html .= "<ul>";
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$apphash ) {
|
|
|
|
$html .= $self->_displayConfApplication( $key, $apphash->{$key} );
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
$html .= "</ul>";
|
|
|
|
}
|
|
|
|
|
|
|
|
# Display subcategories
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$cathash ) {
|
|
|
|
next if $key =~ /(type|options)/;
|
|
|
|
if ( $cathash->{$key}->{type} eq "category" ) {
|
|
|
|
$html .=
|
|
|
|
$self->_displayConfCategory( $key, $cathash->{$key}, $catlevel );
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Close HTML list
|
|
|
|
$html .= "</li>\n";
|
|
|
|
$html .= "</ul>\n";
|
|
|
|
|
|
|
|
return $html;
|
|
|
|
}
|
|
|
|
|
2008-12-29 11:28:31 +01:00
|
|
|
## @method private string _userParam(string arg)
|
2008-12-26 20:18:23 +01:00
|
|
|
# Returns value of $arg variable stored in session.
|
2008-12-28 09:36:52 +01:00
|
|
|
# @param $arg string to modify
|
|
|
|
# @return string modified
|
2008-11-12 17:09:35 +01:00
|
|
|
sub _userParam {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $arg ) = splice @_;
|
2008-11-12 17:09:35 +01:00
|
|
|
$arg =~ s/\$([\w]+)/$self->{portalObject}->{sessionInfo}->{$1}/g;
|
|
|
|
return $arg;
|
|
|
|
}
|
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
## @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;
|
2010-01-15 23:01:04 +01:00
|
|
|
my ( $appid, $apphash ) = @_;
|
2010-01-08 12:51:04 +01:00
|
|
|
my $html;
|
|
|
|
my $key;
|
|
|
|
|
|
|
|
# Get application items
|
|
|
|
my $appname = $apphash->{options}->{name} || $appid;
|
2010-01-15 23:01:04 +01:00
|
|
|
my $appuri = $apphash->{options}->{uri} || "";
|
2010-01-08 12:51:04 +01:00
|
|
|
|
|
|
|
# Display application
|
|
|
|
$html .=
|
|
|
|
"<li title=\"$appid\" class=\"appname $appid\"><span>"
|
|
|
|
. ( $appuri ? "<a href=\"$appuri\">$appname</a>" : "<a>$appname</a>" )
|
|
|
|
. "</span>\n";
|
|
|
|
|
|
|
|
# Detect sub applications
|
|
|
|
my $subapphash;
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$apphash ) {
|
|
|
|
next if $key =~ /(type|options)/;
|
|
|
|
if ( $apphash->{$key}->{type} eq "application" ) {
|
2010-01-08 12:51:04 +01:00
|
|
|
$subapphash->{$key} = $apphash->{$key};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Display sub applications
|
2010-01-15 23:01:04 +01:00
|
|
|
if ( scalar keys %$subapphash > 0 ) {
|
2010-01-08 12:51:04 +01:00
|
|
|
$html .= "<ul>";
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$subapphash ) {
|
|
|
|
$html .=
|
|
|
|
$self->_displayConfApplication( $key, $subapphash->{$key} );
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
$html .= "</ul>";
|
|
|
|
}
|
|
|
|
|
|
|
|
$html .= "</li>";
|
|
|
|
return $html;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method private string _displayConfDescription()
|
|
|
|
# Create HTML code for application description.
|
|
|
|
# @param $appid Application ID
|
|
|
|
# @param $apphash Hash
|
2010-01-20 18:17:21 +01:00
|
|
|
# @return HTML string
|
2010-01-08 12:51:04 +01:00
|
|
|
sub _displayConfDescription {
|
|
|
|
my $self = shift;
|
2010-01-15 23:01:04 +01:00
|
|
|
my ( $appid, $apphash ) = @_;
|
2010-01-08 12:51:04 +01:00
|
|
|
my $html;
|
|
|
|
my $key;
|
|
|
|
|
|
|
|
if ( defined $apphash->{type} and $apphash->{type} eq "application" ) {
|
2010-01-15 23:01:04 +01:00
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
# Get application items
|
|
|
|
my $appname = $apphash->{options}->{name} || $appid;
|
|
|
|
my $appuri = $apphash->{options}->{uri} || "";
|
|
|
|
my $appdesc = $apphash->{options}->{description};
|
|
|
|
my $applogofile = $apphash->{options}->{logo};
|
2010-01-25 15:32:22 +01:00
|
|
|
my $applogo = $self->{apps}->{imgpath} . $applogofile
|
|
|
|
if $applogofile;
|
2010-01-08 12:51:04 +01:00
|
|
|
|
|
|
|
# Display application description
|
|
|
|
$html .= "<div id=\"$appid\" class=\"appsdesc\">\n";
|
|
|
|
$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";
|
|
|
|
}
|
|
|
|
|
|
|
|
# Sublevels
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$apphash ) {
|
|
|
|
next if $key =~ /(type|options)/;
|
|
|
|
$html .= $self->_displayConfDescription( $key, $apphash->{$key} );
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
return $html;
|
|
|
|
}
|
2009-08-20 16:19:40 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
## @method private string _filter()
|
|
|
|
# Duplicate hash reference
|
|
|
|
# Remove unauthorized menu elements
|
|
|
|
# Hide empty categories
|
|
|
|
# @param $apphash Menu elements
|
|
|
|
# @return filtered hash
|
2010-01-08 12:51:04 +01:00
|
|
|
sub _filter {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $apphash ) = splice @_;
|
2010-01-08 12:51:04 +01:00
|
|
|
my $filteredHash;
|
|
|
|
my $key;
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Copy hash reference into a new hash
|
2010-01-15 23:01:04 +01:00
|
|
|
foreach $key ( keys %$apphash ) {
|
2010-01-08 12:51:04 +01:00
|
|
|
$filteredHash->{$key} = $apphash->{$key};
|
|
|
|
}
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Filter hash
|
|
|
|
$self->_filterHash($filteredHash);
|
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
# Hide empty categories
|
2010-01-20 18:17:21 +01:00
|
|
|
$self->_isCategoryEmpty($filteredHash);
|
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
return $filteredHash;
|
|
|
|
}
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
## @method private string _filterHash()
|
|
|
|
# Remove unauthorized menu elements
|
|
|
|
# @param $apphash Menu elements
|
|
|
|
# @return filtered hash
|
2010-01-08 12:51:04 +01:00
|
|
|
sub _filterHash {
|
|
|
|
my $self = shift;
|
2010-01-20 18:17:21 +01:00
|
|
|
my ($apphash) = @_;
|
2010-01-08 12:51:04 +01:00
|
|
|
my $key;
|
2010-01-20 18:17:21 +01:00
|
|
|
my $appkey;
|
2010-01-08 12:51:04 +01:00
|
|
|
|
|
|
|
foreach $key ( keys %$apphash ) {
|
2010-01-15 23:01:04 +01:00
|
|
|
next if $key =~ /(type|options)/;
|
2010-01-08 12:51:04 +01:00
|
|
|
if ( $apphash->{$key}->{type} eq "category" ) {
|
2010-01-15 23:01:04 +01:00
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
# Filter the category
|
2010-01-20 18:17:21 +01:00
|
|
|
$self->_filterHash( $apphash->{$key} );
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
2010-01-15 23:01:04 +01:00
|
|
|
if ( $apphash->{$key}->{type} eq "application" ) {
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# 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} );
|
|
|
|
}
|
|
|
|
|
2010-01-08 12:51:04 +01:00
|
|
|
# Check rights
|
2010-01-25 15:32:22 +01:00
|
|
|
my $appdisplay = $apphash->{$key}->{options}->{display}
|
|
|
|
|| "auto";
|
2010-01-15 23:01:04 +01:00
|
|
|
my $appuri = $apphash->{$key}->{options}->{uri};
|
2010-01-08 12:51:04 +01:00
|
|
|
|
|
|
|
# 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) );
|
2010-01-15 23:01:04 +01:00
|
|
|
next;
|
2010-01-08 12:51:04 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
}
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
## @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;
|
2008-09-26 09:36:30 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# 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} );
|
2009-08-20 16:19:40 +02:00
|
|
|
}
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Test this category
|
2010-01-22 12:25:37 +01:00
|
|
|
if ( $apphash->{type} and $apphash->{type} eq "category" ) {
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Temporary store 'options'
|
|
|
|
my $tmp_options = $apphash->{options};
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
delete $apphash->{type};
|
|
|
|
delete $apphash->{options};
|
|
|
|
|
|
|
|
if ( scalar( keys %$apphash ) ) {
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# There are sub categories or sub applications
|
|
|
|
# Restore type and options
|
|
|
|
$apphash->{type} = "category";
|
|
|
|
$apphash->{options} = $tmp_options;
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Return false
|
|
|
|
return 0;
|
2010-03-01 21:32:28 +01:00
|
|
|
}
|
2010-01-20 18:17:21 +01:00
|
|
|
else {
|
2008-09-18 10:34:17 +02:00
|
|
|
|
2010-01-20 18:17:21 +01:00
|
|
|
# Return true
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
return 0;
|
2008-09-18 10:34:17 +02:00
|
|
|
}
|
|
|
|
|
2008-12-29 11:28:31 +01:00
|
|
|
## @method private boolean _grant(string uri)
|
2008-12-26 20:18:23 +01:00
|
|
|
# Check user's authorization for $uri.
|
2008-12-28 09:36:52 +01:00
|
|
|
# @param $uri URL string
|
|
|
|
# @return True if granted
|
2008-09-21 11:50:32 +02:00
|
|
|
sub _grant {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $uri ) = splice @_;
|
2009-08-20 16:19:40 +02:00
|
|
|
$uri =~ m{(\w+)://([^/:]+)(:\d+)?(/.*)?$} or return 0;
|
2008-11-17 15:02:50 +01:00
|
|
|
my ( $protocol, $vhost, $port );
|
|
|
|
( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
|
|
|
|
$path ||= '/';
|
2010-01-25 15:32:22 +01: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} ) {
|
2009-02-12 20:48:53 +01:00
|
|
|
$self->{portalObject}
|
|
|
|
->lmLog( "Application $uri did not match any configured virtual host",
|
|
|
|
'warn' );
|
2008-09-21 11:50:32 +02:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
return &{ $defaultCondition->{$vhost} }($self);
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2008-12-28 09:36:52 +01:00
|
|
|
## @method private boolean _compileRules()
|
2008-12-26 20:18:23 +01:00
|
|
|
# Parse configured rules and compile them
|
2008-12-28 09:36:52 +01:00
|
|
|
# @return True
|
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-12-29 11:28:31 +01:00
|
|
|
## @method private CODE _conditionSub(string cond)
|
2008-12-26 20:18:23 +01:00
|
|
|
# Return subroutine giving authorization condition.
|
2008-12-28 09:36:52 +01:00
|
|
|
# @param $cond boolean expression
|
|
|
|
# @return Compiled routine
|
2008-09-26 09:36:30 +02:00
|
|
|
sub _conditionSub {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $cond ) = splice @_;
|
2008-09-21 11:50:32 +02:00
|
|
|
return sub { 1 }
|
2010-05-05 10:13:44 +02:00
|
|
|
if ( $cond =~ /^(?:accept|unprotect)$/i );
|
2008-09-21 11:50:32 +02:00
|
|
|
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;
|
2010-09-04 13:49:03 +02:00
|
|
|
my $sub = "sub {my \$self = shift; return ( $cond )}";
|
|
|
|
$sub = (
|
|
|
|
SAFEWRAP
|
|
|
|
? $self->safe->wrap_code_ref( $self->safe->reval($sub) )
|
|
|
|
: $self->safe->reval($sub)
|
|
|
|
);
|
2008-09-21 11:50:32 +02:00
|
|
|
return $sub;
|
|
|
|
}
|
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
1;
|
|
|
|
|
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2010-01-03 09:09:59 +01:00
|
|
|
=encoding utf8
|
|
|
|
|
2008-09-18 10:34:17 +02:00
|
|
|
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
|
|
|
|
|
2009-01-28 18:37:10 +01:00
|
|
|
Copyright (C) 2005-2007 by Clement OUDOT E<lt>clement@oodo.netE<gt>
|
|
|
|
E<lt>coudot@linagora.comE<gt>
|
2008-09-18 10:34:17 +02: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
|
|
|
|
|
|
|
|
|