Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Maxime Besson
lemonldap-ng
Commits
01785de7
Commit
01785de7
authored
Jan 31, 2010
by
Yadd
Browse files
* "SKIP" in SAML tests
* "= splice @_" instead of "= @_" avoid memory duplication
parent
c0ab1344
Changes
19
Hide whitespace changes
Inline
Side-by-side
build/lemonldap-ng/debian/liblemonldap-ng-portal-perl.install
View file @
01785de7
debian
/
tmp
/
etc
/
lemonldap
-
ng
/
apps
-
list
*
debian
/
tmp
/
usr
/
share
/
lemonldap
-
ng
/
bin
/
purgeCentralCache
debian
/
tmp
/
usr
/
share
/
lemonldap
-
ng
/
portal
-
skins
debian
/
tmp
/
usr
/
share
/
man
/
man3
/
Lemonldap
::
NG
::
Portal
*
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/AuthBasic.pm
View file @
01785de7
...
...
@@ -38,7 +38,7 @@ BEGIN {
# @return Apache constant
sub
run
($$)
{
my
$class
;
(
$class
,
$apacheRequest
)
=
@_
;
(
$class
,
$apacheRequest
)
=
splice
@_
;
if
(
time
()
-
$lastReload
>
$reloadTime
)
{
unless
(
my
$tmp
=
$class
->
testConf
(
1
)
==
OK
)
{
$class
->
lmLog
(
"
$class
: No configuration found
",
'
error
'
);
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/CDA.pm
View file @
01785de7
...
...
@@ -19,6 +19,7 @@ use base qw(Lemonldap::NG::Handler::SharedConf);
# @return Apache constant
sub
run
($$)
{
my
$class
;
(
$class
,
$apacheRequest
)
=
splice
@_
;
$cda
=
1
;
return
$class
->
SUPER::
run
(
$apacheRequest
);
}
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/CGI.pm
View file @
01785de7
...
...
@@ -35,7 +35,7 @@ sub new {
unless
Lemonldap::NG::Handler::
_CGI
->
testConf
()
==
OK
;
# Arguments
my
@args
=
@_
;
my
@args
=
splice
@_
;
if
(
ref
(
$args
[
0
]
)
)
{
%$self
=
(
%$self
,
%
{
$args
[
0
]
}
);
}
...
...
@@ -143,7 +143,7 @@ sub user {
# @param $group name of the Lemonldap::NG group to test
# @return boolean : true if user is in this group
sub
group
{
my
(
$self
,
$group
)
=
@_
;
my
(
$self
,
$group
)
=
splice
@_
;
return
(
$datas
->
{
groups
}
=~
/\b$group\b/
);
}
...
...
@@ -203,7 +203,7 @@ sub lmLog {
# @param $vhost Virtual Host to test
# @return boolean : true if $vhost is available
sub
vhostAvailable
{
my
(
$self
,
$vhost
)
=
@_
;
my
(
$self
,
$vhost
)
=
splice
@_
;
return
defined
(
$defaultCondition
->
{
$vhost
}
);
}
...
...
@@ -212,7 +212,7 @@ sub vhostAvailable {
# @param $uri URI string
# @param $vhost Optional virtual host (default current virtual host)
sub
grant
{
my
(
$self
,
$uri
,
$vhost
)
=
@_
;
my
(
$self
,
$uri
,
$vhost
)
=
splice
@_
;
$vhost
||=
$ENV
{
SERVER_NAME
};
$apacheRequest
=
Lemonldap::NG::Apache::
Request
->
new
(
{
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/Proxy.pm
View file @
01785de7
...
...
@@ -56,7 +56,7 @@ $UA->requests_redirectable( [] );
# Called for Apache response (PerlResponseHandler).
# @return Apache constant
sub
run
($$)
{
(
$class
,
$r
)
=
@_
;
(
$class
,
$r
)
=
splice
@_
;
my
$url
=
$r
->
uri
;
$url
.=
"
?
"
.
$r
->
args
if
(
$r
->
args
);
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/SharedConf.pm
View file @
01785de7
...
...
@@ -61,7 +61,7 @@ BEGIN {
# init is overloaded to call only localInit. globalInit is called later.
# @param $args hash containing parameters
sub
init
($$)
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
# TODO reloadTime in defaultValuesInit ?
$reloadTime
=
$args
->
{
reloadTime
}
||
600
;
$class
->
localInit
(
$args
);
...
...
@@ -72,7 +72,7 @@ sub init($$) {
# @param $args hash containing parameters
# @return boolean
sub
defaultValuesInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
# Local configuration overrides global configuration
my
%h
=
(
%$args
,
%$localConfig
);
...
...
@@ -83,7 +83,7 @@ sub defaultValuesInit {
# Load parameters and build the Lemonldap::NG::Common::Conf object.
# @return boolean
sub
localInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
die
(
"
$class
: unable to build configuration :
$Lemonldap
::NG::Common::Conf::msg
"
)
...
...
@@ -118,7 +118,7 @@ sub localInit {
# @param $r Apache2::RequestRec object
# @return Apache constant
sub
run
($$)
{
my
(
$class
,
$r
)
=
@_
;
my
(
$class
,
$r
)
=
splice
@_
;
if
(
time
()
-
$lastReload
>
$reloadTime
)
{
unless
(
my
$tmp
=
$class
->
testConf
(
1
)
==
OK
)
{
$class
->
lmLog
(
"
$class
: No configuration found
",
'
error
'
);
...
...
@@ -138,7 +138,7 @@ sub run($$) {
# @param $local boolean
# @return Apache constant
sub
testConf
{
my
(
$class
,
$local
)
=
@_
;
my
(
$class
,
$local
)
=
splice
@_
;
my
$conf
=
$lmConf
->
getConf
(
{
local
=>
$local
}
);
unless
(
ref
(
$conf
)
)
{
$class
->
lmLog
(
...
...
@@ -163,7 +163,7 @@ sub testConf {
# Local parameters have best precedence on configuration parameters.
# @return Apache constant
sub
setConf
{
my
(
$class
,
$conf
)
=
@_
;
my
(
$class
,
$conf
)
=
splice
@_
;
# Local configuration overrides global configuration
$cfgNum
=
$conf
->
{
cfgNum
};
...
...
@@ -183,7 +183,7 @@ sub setConf {
# @param $r current request
# @return Apache constant (OK or SERVER_ERROR)
sub
refresh
($$)
{
my
(
$class
,
$r
)
=
@_
;
my
(
$class
,
$r
)
=
splice
@_
;
$class
->
lmLog
(
"
$class
: request for configuration reload
",
'
notice
'
);
$r
->
handler
("
perl-script
");
if
(
$class
->
testConf
(
0
)
==
OK
)
{
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/Simple.pm
View file @
01785de7
...
...
@@ -183,7 +183,7 @@ sub logout_mp2 : method {
# @param $mess message to log
# @param $level string (debug, info, warning or error)
sub
lmLog
{
my
(
$class
,
$mess
,
$level
)
=
@_
;
my
(
$class
,
$mess
,
$level
)
=
splice
@_
;
die
"
Level is required
"
unless
(
$level
);
if
(
MP
()
==
2
)
{
Apache2::
ServerRec
->
log
->
$level
(
$mess
);
...
...
@@ -201,7 +201,7 @@ sub lmLog {
# @param $r current request
# @param $s string to use
sub
lmSetApacheUser
{
my
(
$class
,
$r
,
$s
)
=
@_
;
my
(
$class
,
$r
,
$s
)
=
splice
@_
;
return
unless
(
$s
);
if
(
MP
()
==
2
)
{
$r
->
user
(
$s
);
...
...
@@ -216,7 +216,7 @@ sub lmSetApacheUser {
# @param $str string
# @return string
sub
regRemoteIp
{
my
(
$class
,
$str
)
=
@_
;
my
(
$class
,
$str
)
=
splice
@_
;
if
(
MP
()
==
2
)
{
$str
=~
s/\$datas->\{ip\}/\$apacheRequest->connection->remote_ip/g
;
}
...
...
@@ -232,7 +232,7 @@ sub regRemoteIp {
# @param $h Name of the header
# @param $v Value of the header
sub
lmSetHeaderIn
{
my
(
$r
,
$h
,
$v
)
=
@_
;
my
(
$r
,
$h
,
$v
)
=
splice
@_
;
if
(
MP
()
==
2
)
{
return
$r
->
headers_in
->
set
(
$h
=>
$v
);
}
...
...
@@ -247,7 +247,7 @@ sub lmSetHeaderIn {
# @param $h Name of the header
# @return Value of the header
sub
lmHeaderIn
{
my
(
$r
,
$h
)
=
@_
;
my
(
$r
,
$h
)
=
splice
@_
;
if
(
MP
()
==
2
)
{
return
$r
->
headers_in
->
{
$h
};
}
...
...
@@ -262,7 +262,7 @@ sub lmHeaderIn {
# @param $h Name of the header
# @param $v Value of the header
sub
lmSetErrHeaderOut
{
my
(
$r
,
$h
,
$v
)
=
@_
;
my
(
$r
,
$h
,
$v
)
=
splice
@_
;
if
(
MP
()
==
2
)
{
return
$r
->
err_headers_out
->
set
(
$h
=>
$v
);
}
...
...
@@ -277,7 +277,7 @@ sub lmSetErrHeaderOut {
# @param $h Name of the header
# @param $v Value of the header
sub
lmSetHeaderOut
{
my
(
$r
,
$h
,
$v
)
=
@_
;
my
(
$r
,
$h
,
$v
)
=
splice
@_
;
if
(
MP
()
==
2
)
{
return
$r
->
headers_out
->
set
(
$h
=>
$v
);
}
...
...
@@ -292,7 +292,7 @@ sub lmSetHeaderOut {
# @param $h Name of the header
# @return Value of the header
sub
lmHeaderOut
{
my
(
$r
,
$h
,
$v
)
=
@_
;
my
(
$r
,
$h
,
$v
)
=
splice
@_
;
if
(
MP
()
==
2
)
{
return
$r
->
headers_out
->
{
$h
};
}
...
...
@@ -391,7 +391,7 @@ sub init($$) {
# (statusProcess()) in wanted and launch childInit().
# @param $args reference to the initialization hash
sub
localInit
($$)
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
if
(
$localStorage
=
$args
->
{
localStorage
}
)
{
$localStorageOptions
=
$args
->
{
localStorageOptions
};
$localStorageOptions
->
{
namespace
}
||=
"
lemonldap
";
...
...
@@ -420,7 +420,7 @@ sub localInit($$) {
# - cleanLocalStorage() after each requests
# @return True
sub
childInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
return
1
if
(
$childInitDone
);
# We don't initialise local storage in the "init" subroutine because it can
...
...
@@ -436,7 +436,7 @@ sub childInit {
sub
{
return
$class
->
initLocalStorage
(
$_
[
1
],
$_
[
0
]
);
}
);
$s
->
push_handlers
(
PerlPostConfigHandler
=>
sub
{
my
(
$c
,
$l
,
$t
,
$s
)
=
@_
;
my
(
$c
,
$l
,
$t
,
$s
)
=
splice
@_
;
$s
->
add_version_component
('
Lemonldap::NG::Handler
');
}
)
unless
(
$args
->
{
hideSignature
}
);
...
...
@@ -499,7 +499,7 @@ sub globalInit {
# - the list of the compiled functions (compiled with conditionSub())
# @param $args reference to the configuration hash
sub
locationRulesInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
$locationCount
=
0
;
# Pre compilation : both regexp and conditions
...
...
@@ -527,7 +527,7 @@ sub locationRulesInit {
# locationRulesInit().
# @param $cond The boolean expression to use
sub
conditionSub
{
my
(
$class
,
$cond
)
=
@_
;
my
(
$class
,
$cond
)
=
splice
@_
;
return
sub
{
1
}
if
(
$cond
=~
/^accept$/i
);
return
sub
{
0
}
...
...
@@ -581,7 +581,7 @@ sub conditionSub {
# Set default values for non-customized variables
# @param $args reference to the configuration hash
sub
defaultValuesInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
# Other values
$cookieName
=
$args
->
{
cookieName
}
||
$cookieName
||
'
lemonldap
';
...
...
@@ -603,7 +603,7 @@ sub defaultValuesInit {
# Verify that portal variable exists. Die unless
# @param $args reference to the configuration hash
sub
portalInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
die
("
portal parameter required
")
unless
(
$args
->
{
portal
}
);
if
(
$args
->
{
portal
}
=~
/[\$\(&\|"']/
)
{
my
$portal
=
$class
->
conditionSub
(
$args
->
{
portal
}
);
...
...
@@ -620,7 +620,7 @@ sub portalInit {
# Initialize the Apache::Session::* module choosed to share user's variables.
# @param $args reference to the configuration hash
sub
globalStorageInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
$globalStorage
=
$args
->
{
globalStorage
}
or
die
"
globalStorage required
";
eval
"
use
$globalStorage
;
";
die
(
$@
)
if
(
$@
);
...
...
@@ -632,7 +632,7 @@ sub globalStorageInit {
# headers into the HTTP request.
# @param $args reference to the configuration hash
sub
forgeHeadersInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
# Creation of the subroutine who will generate headers
my
%tmp
;
...
...
@@ -663,7 +663,7 @@ sub forgeHeadersInit {
# Prepare local cache (if not done before by Lemonldap::NG::Common::Conf)
# @return Apache2::Const::DECLINED
sub
initLocalStorage
{
my
(
$class
,
$r
)
=
@_
;
my
(
$class
,
$r
)
=
splice
@_
;
if
(
$localStorage
and
not
$refLocalStorage
)
{
eval
"
use
$localStorage
;
\$
refLocalStorage = new
$localStorage
(
\$
localStorageOptions);
";
...
...
@@ -676,7 +676,7 @@ sub initLocalStorage {
## @imethod protected void postUrlInit()
# Prepare methods to post form attributes
sub
postUrlInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
return
unless
(
$args
->
{
post
}
);
eval
'
use Apache2::Filter;use URI
';
$transform
=
{};
...
...
@@ -750,7 +750,7 @@ qq{<html><body onload="document.getElementById('f').submit()"><form id="f" metho
## @rmethod protected void updateStatus(string user,string url,string action)
# Inform the status process of the result of the request if it is available.
sub
updateStatus
{
my
(
$class
,
$user
,
$url
,
$action
)
=
@_
;
my
(
$class
,
$user
,
$url
,
$action
)
=
splice
@_
;
eval
{
print
$statusPipe
"
$user
=>
"
.
$apacheRequest
->
hostname
...
...
@@ -763,7 +763,7 @@ sub updateStatus {
# Grant or refuse client using compiled regexp and functions
# @return True if the user is granted to access to the current URL
sub
grant
{
my
(
$class
,
$uri
)
=
@_
;
my
(
$class
,
$uri
)
=
splice
@_
;
for
(
my
$i
=
0
;
$i
<
$locationCount
;
$i
++
)
{
return
&
{
$locationCondition
->
[
$i
]
}(
$datas
)
if
(
$uri
=~
$locationRegexp
->
[
$i
]
);
...
...
@@ -776,7 +776,7 @@ sub grant {
# Inform the status processus and call logForbidden().
# @return Apache2::Const::FORBIDDEN
sub
forbidden
{
my
(
$class
,
$uri
)
=
@_
;
my
(
$class
,
$uri
)
=
splice
@_
;
if
(
$datas
->
{
_logout
}
)
{
$class
->
updateStatus
(
$datas
->
{
$whatToTrace
},
$_
[
0
],
'
LOGOUT
'
);
my
$u
=
$datas
->
{
_logout
};
...
...
@@ -796,7 +796,7 @@ sub forbidden {
# @param $uri uri asked
# @param $datas hash re to user's datas
sub
logForbidden
{
my
(
$class
,
$uri
,
$datas
)
=
@_
;
my
(
$class
,
$uri
,
$datas
)
=
splice
@_
;
$class
->
lmLog
(
'
User "
'
.
$datas
->
{
$whatToTrace
}
...
...
@@ -811,7 +811,7 @@ sub logForbidden {
# authorizated. This method has to be overloaded to use different logs systems
# @param $uri uri asked
sub
logGranted
{
my
(
$class
,
$uri
,
$datas
)
=
@_
;
my
(
$class
,
$uri
,
$datas
)
=
splice
@_
;
$class
->
lmLog
(
'
User "
'
.
$datas
->
{
$whatToTrace
}
...
...
@@ -834,7 +834,7 @@ sub hideCookie {
## @rmethod protected string encodeUrl(string url)
# Encode URl in the format used by Lemonldap::NG::Portal for redirections.
sub
encodeUrl
{
my
(
$class
,
$url
)
=
@_
;
my
(
$class
,
$url
)
=
splice
@_
;
my
$u
=
$url
;
if
(
$url
!~
m#^https?://#
)
{
my
$portString
=
$port
||
$apacheRequest
->
get_server_port
();
...
...
@@ -857,7 +857,7 @@ sub encodeUrl {
# @param $arg optionnal GET parameters
# @return Apache2::Const::REDIRECT
sub
goToPortal
{
my
(
$class
,
$url
,
$arg
)
=
@_
;
my
(
$class
,
$url
,
$arg
)
=
splice
@_
;
$class
->
lmLog
(
"
Redirect
"
.
$apacheRequest
->
connection
->
remote_ip
...
...
@@ -896,7 +896,7 @@ sub fetchId {
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR)
sub
run
($$)
{
my
$class
;
(
$class
,
$apacheRequest
)
=
@_
;
(
$class
,
$apacheRequest
)
=
splice
@_
;
return
DECLINED
unless
(
$apacheRequest
->
is_initial_req
);
my
$args
=
$apacheRequest
->
args
;
...
...
@@ -1038,7 +1038,7 @@ sub localUnlog {
# @return Apache2::Const value returned by goToPortal()
sub
unlog
($$)
{
my
$class
;
(
$class
,
$apacheRequest
)
=
@_
;
(
$class
,
$apacheRequest
)
=
splice
@_
;
$class
->
localUnlog
;
$class
->
updateStatus
(
$apacheRequest
->
connection
->
remote_ip
,
$apacheRequest
->
uri
,
'
LOGOUT
'
);
...
...
@@ -1085,7 +1085,7 @@ sub redirectFilter {
# @param $r Current request
# @return Apache2::Const::OK
sub
status
($$)
{
my
(
$class
,
$r
)
=
@_
;
my
(
$class
,
$r
)
=
splice
@_
;
$class
->
lmLog
(
"
$class
: request for status
",
'
debug
'
);
unless
(
$statusPipe
and
$statusOut
)
{
$class
->
lmLog
(
"
$class
: status page can not be displayed
",
'
error
'
);
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/Status.pm
View file @
01785de7
...
...
@@ -242,7 +242,7 @@ sub timeUp {
# @param $cat Category to display
# @param $max Number of lines to display
sub
topByCat
{
my
(
$cat
,
$max
)
=
@_
;
my
(
$cat
,
$max
)
=
splice
@_
;
my
$i
=
0
;
print
"
<pre>
\n
";
foreach
(
...
...
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/Vhost.pm
View file @
01785de7
...
...
@@ -24,7 +24,7 @@ our $VERSION = '0.55';
# virtual host
# @param $args reference to the configuration hash
sub
locationRulesInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
foreach
my
$vhost
(
keys
%
{
$args
->
{
locationRules
}
}
)
{
$locationCount
->
{
$vhost
}
=
0
;
foreach
(
sort
keys
%
{
$args
->
{
locationRules
}
->
{
$vhost
}
}
)
{
...
...
@@ -53,7 +53,7 @@ sub locationRulesInit {
# headers into the HTTP request.
# @param $args reference to the configuration hash
sub
forgeHeadersInit
{
my
(
$class
,
$args
)
=
@_
;
my
(
$class
,
$args
)
=
splice
@_
;
# Creation of the subroutine who will generate headers
foreach
my
$vhost
(
keys
%
{
$args
->
{
exportedHeaders
}
}
)
{
...
...
@@ -98,7 +98,7 @@ sub sendHeaders {
# Grant or refuse client using compiled regexp and functions
# @return True if the user is granted to access to the current URL
sub
grant
{
my
(
$class
,
$uri
)
=
@_
;
my
(
$class
,
$uri
)
=
splice
@_
;
my
$vhost
=
$apacheRequest
->
hostname
;
for
(
my
$i
=
0
;
$i
<
$locationCount
->
{
$vhost
}
;
$i
++
)
{
if
(
$uri
=~
$locationRegexp
->
{
$vhost
}
->
[
$i
]
)
{
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Menu.pm
View file @
01785de7
...
...
@@ -142,8 +142,7 @@ sub new {
# @param $modulename string
# @return boolean
sub
displayModule
{
my
$self
=
shift
;
my
(
$modulename
)
=
@_
;
my
(
$self
,
$modulename
)
=
splice
@_
;
# Manage "0" and "1" rules
return
1
if
(
$self
->
{
modules
}
->
{
$modulename
}
eq
"
1
"
);
...
...
@@ -237,8 +236,7 @@ sub appslistDescription {
# @param catlevel Category level
# @return HTML string
sub
_displayConfCategory
{
my
$self
=
shift
;
my
(
$catname
,
$cathash
,
$catlevel
)
=
@_
;
my
(
$self
,
$catname
,
$cathash
,
$catlevel
)
=
splice
@_
;
my
$html
;
my
$key
;
...
...
@@ -289,7 +287,7 @@ sub _displayConfCategory {
# @param $arg string to modify
# @return string modified
sub
_userParam
{
my
(
$self
,
$arg
)
=
@_
;
my
(
$self
,
$arg
)
=
splice
@_
;
$arg
=~
s/\$([\w]+)/$self->{portalObject}->{sessionInfo}->{$1}/g
;
return
$arg
;
}
...
...
@@ -385,8 +383,7 @@ sub _displayConfDescription {
# @param $apphash Menu elements
# @return filtered hash
sub
_filter
{
my
$self
=
shift
;
my
(
$apphash
)
=
@_
;
my
(
$self
,
$apphash
)
=
splice
@_
;
my
$filteredHash
;
my
$key
;
...
...
@@ -501,8 +498,7 @@ sub _isCategoryEmpty {
# @param $uri URL string
# @return True if granted
sub
_grant
{
my
$self
=
shift
;
my
(
$uri
)
=
@_
;
my
(
$self
,
$uri
)
=
splice
@_
;
$uri
=~
m{(\w+)://([^/:]+)(:\d+)?(/.*)?$}
or
return
0
;
my
(
$protocol
,
$vhost
,
$port
);
(
$protocol
,
$vhost
,
$port
,
$path
)
=
(
$
1
,
$
2
,
$
3
,
$
4
);
...
...
@@ -562,8 +558,7 @@ sub _compileRules {
# @param $cond boolean expression
# @return Compiled routine
sub
_conditionSub
{
my
$self
=
shift
;
my
(
$cond
)
=
@_
;
my
(
$self
,
$cond
)
=
splice
@_
;
return
sub
{
1
}
if
(
$cond
=~
/^accept$/i
);
return
sub
{
0
}
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Notification.pm
View file @
01785de7
...
...
@@ -61,7 +61,7 @@ BEGIN {
# @param $storage same syntax as Lemonldap::NG::Common::Conf object
# @return Lemonldap::NG::Portal::Notification object
sub
new
{
my
(
$class
,
$storage
)
=
@_
;
my
(
$class
,
$storage
)
=
splice
@_
;
my
$self
=
bless
{},
$class
;
(
%$self
)
=
(
%$storage
);
unless
(
$self
->
{
p
}
)
{
...
...
@@ -87,7 +87,7 @@ sub new {
# @param $mess Text to log
# @param $level Level (debug|info|notice|error)
sub
lmLog
{
my
(
$self
,
$mess
,
$level
)
=
@_
;
my
(
$self
,
$mess
,
$level
)
=
splice
@_
;
$self
->
{
p
}
->
lmLog
(
"
[Notification]
$mess
",
$level
);
}
...
...
@@ -97,7 +97,7 @@ sub lmLog {
# @param $portal Lemonldap::NG::Portal object that call
# @return HTML fragment containing form content
sub
getNotification
{
my
(
$self
,
$portal
)
=
@_
;
my
(
$self
,
$portal
)
=
splice
@_
;
my
(
@notifs
,
$form
);
# Get user datas,
...
...
@@ -157,7 +157,7 @@ sub getNotification {
# @param $portal Lemonldap::NG::Portal object that call
# @return true if all checkboxes have been checked
sub
checkNotification
{
my
(
$self
,
$portal
)
=
@_
;
my
(
$self
,
$portal
)
=
splice
@
_
,
0
,
2
;
my
(
$refs
,
$checks
);
# First, rebuild environment (cookies,...)
...
...
@@ -260,7 +260,7 @@ sub checkNotification {
# @param $xml XML string containing notification
# @return number of notifications done
sub
newNotification
{
my
(
$self
,
$xml
)
=
@_
;
my
(
$self
,
$xml
)
=
splice
@_
;
eval
{
$xml
=
$parser
->
parse_string
(
$xml
);
};
if
(
$@
)
{
$self
->
lmLog
(
"
Unable to read XML file : $@
",
'
error
'
);
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/UserDBLDAP.pm
View file @
01785de7
...
...
@@ -90,7 +90,7 @@ sub search {
# '; ' separator
# @return Lemonldap::NG::Portal constant
sub
setSessionInfo
{
my
(
$self
)
=
@_
;
my
$self
=
shift
;
$self
->
{
sessionInfo
}
->
{
dn
}
=
$self
->
{
dn
};
unless
(
$self
->
{
exportedVars
}
)
{
foreach
(
qw(uid cn mail)
)
{
...
...
@@ -121,7 +121,7 @@ sub setSessionInfo {
# Load all groups in $groups.
# @return Lemonldap::NG::Portal constant
sub
setGroups
{
my
(
$self
)
=
@_
;
my
$self
=
shift
;
my
$groups
=
$self
->
{
sessionInfo
}
->
{
groups
};
$self
->
{
ldapGroupObjectClass
}
||=
"
groupOfNames
";
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_LDAP.pm
View file @
01785de7
...
...
@@ -74,7 +74,7 @@ sub new {
sub
bind
{
my
$self
=
shift
;
my
$mesg
;
my
(
$dn
,
%args
)
=
@_
;
my
(
$dn
,
%args
)
=
splice
@_
;
unless
(
$dn
)
{
$dn
=
$self
->
{
portal
}
->
{
managerDn
};
$args
{
password
}
=
$self
->
{
portal
}
->
{
managerPassword
};
...
...
@@ -186,9 +186,7 @@ sub userBind {
# @param $oldpassword Current password
# @return Lemonldap::NG::Portal constant
sub
userModifyPassword
{
my
$self
=
shift
;
my
(
$dn
,
$newpassword
,
$confirmpassword
,
$oldpassword
)
=
@_
;
my
(
$self
,
$dn
,
$newpassword
,
$confirmpassword
,
$oldpassword
)
=
splice
@_
;
my
$err
;
my
$mesg
;
...
...
modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_Multi.pm
View file @
01785de7
...
...
@@ -19,7 +19,7 @@ our $VERSION = '0.11';
# @param $portal Lemonldap::NG::Portal::Simple object
# @return new Lemonldap::NG::Portal::_Multi object
sub
new
{
my
(
$class
,
$portal
)
=
@_
;
my
(
$class
,
$portal
)
=
splice
@_
;
my
$self
=
bless
{
p
=>
$portal
,
res
=>
PE_NOSCHEME
},
$class
;
my
@stack
=
(
$portal
->
{
authentication
},
$portal
->
{
userDB
}
);
for
(
my
$i
=
0
;
$i
<
2
;
$i
++
)
{
...
...
@@ -50,7 +50,7 @@ sub new {
# @param type 0 for authentication, 1 for userDB
# @return Lemonldap::NG::Portal error code returned by method $sub
sub
try
{
my
(
$self
,
$sub
,
$type
)
=
@_
;
my
(
$self
,
$sub
,
$type
)
=
splice
@_
;
my
$res
;
my
$s
=
$self
->
{
stack
}
->
[
$type
]
->
[
0
]
->
{
m} . "::$sub";
my $old = $self->{stack}
->
[
$type
]
->
[
0
]
->
{
n
};
...
...
@@ -91,7 +91,7 @@ sub try {
# @param type 0 for authentication, 1 for userDB
# return true if an other module is available
sub
next
{
my
(
$self
,
$type
)
=
@_
;
my
(
$self
,
$type
)
=
splice
@_
;
if
(
$self
->
{
stack
}
->
[
$type
]
->
[
0
]
->
{
n
}
eq
$self
->
{
stack
}
->
[
1
-
$type
]
->
[
0
]
->
{
n
}
and
$self
->
{
stack
}
->
[
1
-
$type
]
->
[
1
]
)
...
...
@@ -112,7 +112,7 @@ sub next {
# @param $sub name of the method who has failed
# @return Lemonldap::NG::Portal error code
sub
replay
{
my
(
$self
,
$sub
)
=
@_
;
my
(
$self
,
$sub
)
=
splice
@_
;
my
@subs
=
();