diff --git a/lemonldap-ng-common/MANIFEST b/lemonldap-ng-common/MANIFEST
index 5cc953771..081213f00 100644
--- a/lemonldap-ng-common/MANIFEST
+++ b/lemonldap-ng-common/MANIFEST
@@ -3,7 +3,6 @@ lemonldap-ng.ini
lib/Lemonldap/NG/Common.pm
lib/Lemonldap/NG/Common/Apache/Session.pm
lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm
-lib/Lemonldap/NG/Common/BuildWSDL.pm
lib/Lemonldap/NG/Common/CGI.pm
lib/Lemonldap/NG/Common/CGI/SOAPServer.pm
lib/Lemonldap/NG/Common/CGI/SOAPService.pm
diff --git a/lemonldap-ng-common/lib/Lemonldap/NG/Common/BuildWSDL.pm b/lemonldap-ng-common/lib/Lemonldap/NG/Common/BuildWSDL.pm
deleted file mode 100644
index aa4c81bb2..000000000
--- a/lemonldap-ng-common/lib/Lemonldap/NG/Common/BuildWSDL.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-## @file
-# Utility to build WSDL files
-
-## @class
-# Class utility to build WSDL files
-package Lemonldap::NG::Common::BuildWSDL;
-
-use Lemonldap::NG::Common::Conf;
-
-our $VERSION = '1.0.0';
-
-## @cmethod Lemonldap::NG::Common::Conf new(hashref configStorage);
-# Constructor
-# @param $configStorage Configuration access parameters
-# @return Lemonldap::NG::Common::Conf new object
-sub new {
- my ( $class, $configStorage ) = @_;
- my $self = bless {}, $class;
- my $lmConf = Lemonldap::NG::Common::Conf->new($configStorage)
- or die($Lemonldap::NG::Common::Conf::msg);
- $self->{conf} = $lmConf->getConf() or die "Unable to load configuration";
- return $self;
-}
-
-## @method string buildWSDL(string xml)
-# Parse XML string to sustitute macros
-# @param $xml XML string
-# @return Parsed XML string
-sub buildWSDL {
- my ( $self, $xml ) = @_;
- my $portal = $self->{conf}->{portal};
- $portal .= "index.pl" if ( $portal =~ /\/$/ );
- $xml =~ s/__PORTAL__/$portal/gs;
- $xml =~ s/__DOMAIN__/$self->{conf}->{domain}/gs;
-
- # Cookies
- my @cookies = split /\s+/, $self->{conf}->{cookieName};
- s#(.*)## foreach (@cookies);
- $xml =~ s/__XMLCOOKIELIST__/join("\n",@cookies)/ges;
-
- # Attributes
- my @attr = (
- keys %{ $self->{conf}->{exportedVars} },
- keys %{ $self->{conf}->{macros} },
- qw(_timezone ipAddr _password authenticationLevel _session_id xForwardedForAddr startTime _user _utime dn)
- );
- s#(.*)##
- foreach (@attr);
- $xml =~ s/__ATTRLIST__/join("\n",@attr)/ges;
- return $xml;
-}
-
-1;
-
diff --git a/lemonldap-ng-portal/example/scripts/buildPortalWSDL b/lemonldap-ng-portal/example/scripts/buildPortalWSDL
index c73af581d..f3027777b 100644
--- a/lemonldap-ng-portal/example/scripts/buildPortalWSDL
+++ b/lemonldap-ng-portal/example/scripts/buildPortalWSDL
@@ -1,8 +1,26 @@
#!/usr/bin/perl
-use Lemonldap::NG::Common::BuildWSDL;
+use Lemonldap::NG::Portal::SharedConf;
-print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<new( {} );
+
+unless ( $portal->{Soap} ) {
+ print STDERR "Lemonldap::NG Portal SOAP capability is disabled.\n"
+ . "Set 'Soap' option to 1 in manager or lemonldap-ng.ini to enable it.\n";
+ exit;
+}
+
+my @cookies = ( $portal->{cookieName} );
+push @cookies, "$portal->{cookieName}.http"
+ if ( $portal->{securedCookie} >= 2 );
+my $cookieList = join "\n",
+ map { "" } @cookies;
+
+my $attrList = join "\n",
+ map { "" }
+ $portal->attributeList;
+
+print <
new->buildWSDL(<
- __XMLCOOKIELIST__
+$cookieList
- __ATTRLIST__
+$attrList
@@ -99,7 +117,7 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<
-
+
@@ -134,7 +152,7 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<
-
+
@@ -211,7 +229,7 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<
-
+
diff --git a/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Simple.pm b/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Simple.pm
index cc5c6ee2d..2beffaa78 100644
--- a/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Simple.pm
+++ b/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/Simple.pm
@@ -287,10 +287,11 @@ sub new {
$self->loadModule('Lemonldap::NG::Portal::Display');
# Rules to allow redirection
- $self->{mustRedirect} = (
- ( $ENV{REQUEST_METHOD} eq 'POST' and not $self->param('newpassword') )
- or $self->param('logout')
- ) ? 1 : 0;
+ $self->{mustRedirect} =
+ defined $ENV{REQUEST_METHOD}
+ ? ( $ENV{REQUEST_METHOD} eq "POST" and not $self->param('newpassword') )
+ : $self->param('logout') ? 1
+ : 0;
# Push authentication/userDB/passwordDB modules in @ISA
foreach my $type (qw(authentication userDB passwordDB)) {
@@ -451,10 +452,12 @@ sub new {
# Trusted domains
$self->{trustedDomains} ||= "";
- $self->{trustedDomains} = "*" if ($self->{trustedDomains} =~ /(^|\s)\*(\s|$)/);
+ $self->{trustedDomains} = "*"
+ if ( $self->{trustedDomains} =~ /(^|\s)\*(\s|$)/ );
if ( $self->{trustedDomains} and $self->{trustedDomains} ne "*" ) {
$self->{trustedDomains} =~ s#(^|\s+)\.#[^/]+.#g;
- $self->{trustedDomains} = '(' . join( '|', split(/\s+/, $self->{trustedDomains}) ) . ')';
+ $self->{trustedDomains} =
+ '(' . join( '|', split( /\s+/, $self->{trustedDomains} ) ) . ')';
$self->{trustedDomains} =~ s/\./\\./g;
}
@@ -751,10 +754,10 @@ sub buildHiddenForm {
sub isTrustedUrl {
my ( $self, $url ) = splice @_;
return
- $url =~ m#^https?://$self->{reVHosts}(:\d+)?/#o
- || $self->{trustedDomains} eq "*"
- || $self->{trustedDomains}
- && $url =~ m#^https?://$self->{trustedDomains}(:\d+)?/#o ;
+ $url =~ m#^https?://$self->{reVHosts}(:\d+)?/#o
+ || $self->{trustedDomains} eq "*"
+ || $self->{trustedDomains}
+ && $url =~ m#^https?://$self->{trustedDomains}(:\d+)?/#o;
}
## @method boolean checkXSSAttack(string name, string value)
@@ -805,7 +808,7 @@ sub msg {
sub error {
my $self = shift;
my $code = shift || $self->{error};
- if (my $lang = shift) { # only for SOAP error requests
+ if ( my $lang = shift ) { # only for SOAP error requests
$self->{lang} = $self->extract_lang($lang);
}
my $msg;
@@ -820,7 +823,7 @@ sub error {
$msg ||= $self->{ "error_" . $code };
# Use customized message or built-in message
- if (defined $msg) {
+ if ( defined $msg ) {
# Manage UTF-8
utf8::decode($msg);
@@ -2491,12 +2494,13 @@ sub autoRedirect {
{
my $ssl = $self->{urldc} =~ /^https/;
$self->lmLog( 'CDA request', 'debug' );
- $self->{urldc} .=
- ( $self->{urldc} =~ /\?/ ? '&' : '?' )
- . (
- $self->{securedCookie} < 2 or $ssl
- ? $self->{cookieName} . "=" . $self->{id}
- : $self->{cookieName} . "http=" . $self->{sessionInfo}->{_httpSession}
+ $self->{urldc} .= ( $self->{urldc} =~ /\?/ ? '&' : '?' )
+ . (
+ $self->{securedCookie} < 2
+ or $ssl
+ ? $self->{cookieName} . "=" . $self->{id}
+ : $self->{cookieName} . "http="
+ . $self->{sessionInfo}->{_httpSession}
);
}
diff --git a/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SOAP.pm b/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SOAP.pm
index 73b94eae7..8bbe4456c 100644
--- a/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SOAP.pm
+++ b/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SOAP.pm
@@ -98,7 +98,8 @@ sub getCookies {
my @cookies = ();
unless ( $self->{error} ) {
foreach ( @{ $self->{cookie} } ) {
- push @cookies, SOAP::Data->name( $_->name, $_->value )->type("string");
+ push @cookies,
+ SOAP::Data->name( $_->name, $_->value )->type("string");
}
}
push @tmp, SOAP::Data->name( cookies => \SOAP::Data->value(@cookies) );
@@ -135,8 +136,8 @@ sub getAttributes {
"SOAP attributes request for " . $h->{ $self->{whatToTrace} } );
push @tmp, SOAP::Data->name( error => 0 )->type('int');
push @tmp,
- SOAP::Data->name( attributes =>
- _buildSoapHash( $h, split /\s+/, $self->{exportedAttr} ) );
+ SOAP::Data->name(
+ attributes => _buildSoapHash( $h, $self->exportedAttr ) );
untie %$h;
}
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
@@ -301,6 +302,38 @@ sub getMenuApplications {
}
+#########################
+# Auxiliary subroutines #
+#########################
+
+## @method array exportedAttr
+# Parse XML string to sustitute macros
+# @return list of session data available through getAttribute SOAP request
+sub exportedAttr {
+ my $self = shift;
+ if ( $self->{exportedAttr} and $self->{exportedAttr} !~ /^\s*\+/ ) {
+ return split /\s+/, $self->{exportedAttr};
+ }
+ else {
+ my @attributes = (
+ 'authenticationLevel', 'groups',
+ 'ipAddr', 'xForwardedForAddr',
+ 'startTime', '_utime'
+ );
+ if ( my $exportedAttr = $self->{exportedAttr} ) {
+ $exportedAttr =~ s/^\s*\+\s+//;
+ @attributes = ( @attributes, split( /\s+/, $exportedAttr ) );
+ }
+
+ # convert @attributes into hash to remove duplicates
+ my %attributes = map( { $_ => 1 } @attributes );
+ %attributes =
+ ( %attributes, %{ $self->{exportedVars} }, %{ $self->{macros} }, );
+
+ return sort keys %attributes;
+ }
+}
+
#######################
# Private subroutines #
#######################