Changes in script buildPortalWSDL (Lemonldap-473)
This commit is contained in:
François-Xavier Deltombe
parent
72933217b5
commit
21617d55e6
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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#(.*)#<element name="$1" type="xsd:string"></element># 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#(.*)#<element name="$1" type="xsd:string" nillable="true"></element>#
|
||||
foreach (@attr);
|
||||
$xml =~ s/__ATTRLIST__/join("\n",@attr)/ges;
|
||||
return $xml;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -1,8 +1,26 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use Lemonldap::NG::Common::BuildWSDL;
|
||||
use Lemonldap::NG::Portal::SharedConf;
|
||||
|
||||
print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<<EOT);
|
||||
my $portal = Lemonldap::NG::Portal::SharedConf->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 { "<element name='$_' type='xsd:string'></element>" } @cookies;
|
||||
|
||||
my $attrList = join "\n",
|
||||
map { "<element name='$_' type='xsd:string' nillable='true'></element>" }
|
||||
$portal->attributeList;
|
||||
|
||||
print <<EOT;
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
|
||||
<wsdl:definitions
|
||||
|
|
@ -22,12 +40,12 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<<EOT);
|
|||
|
||||
<complexType name="CookiesSequence">
|
||||
<sequence>
|
||||
__XMLCOOKIELIST__
|
||||
$cookieList
|
||||
</sequence>
|
||||
</complexType>
|
||||
<complexType name="AttributesSequence">
|
||||
<sequence>
|
||||
__ATTRLIST__
|
||||
$attrList
|
||||
</sequence>
|
||||
</complexType>
|
||||
<complexType name="GetCookieResponse">
|
||||
|
|
@ -99,7 +117,7 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<<EOT);
|
|||
|
||||
<wsdl:service name="authenticationService">
|
||||
<wsdl:port binding="impl:authenticationBinding" name="authenticationPort">
|
||||
<wsdlsoap:address location="__PORTAL__" />
|
||||
<wsdlsoap:address location="$portal->{portal}" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
|
||||
|
|
@ -134,7 +152,7 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<<EOT);
|
|||
|
||||
<wsdl:service name="notificationService">
|
||||
<wsdl:port binding="impl:notificationBinding" name="notificationPort">
|
||||
<wsdlsoap:address location="__PORTAL__/notification" />
|
||||
<wsdlsoap:address location="$portal->{portal}/notification" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
|
||||
|
|
@ -211,7 +229,7 @@ print Lemonldap::NG::Common::BuildWSDL->new->buildWSDL(<<EOT);
|
|||
|
||||
<wsdl:service name="sessionsService">
|
||||
<wsdl:port binding="impl:sessionsBinding" name="sessionsPort">
|
||||
<wsdlsoap:address location="__PORTAL__/sessions" />
|
||||
<wsdlsoap:address location="$portal->{portal}/sessions" />
|
||||
</wsdl:port>
|
||||
</wsdl:service>
|
||||
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 #
|
||||
#######################
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user