# Session server plugin for SOAP call
#
# This plugin adds the following entry points:
# * POST /sessions , methods: getCookies getAttributes isAuthorizedURI
# * POST /adminSessions, methods: getAttributes setAttributes isAuthorizedURI
# newSession deleteSession getCipheredToken
# get_key_from_all_sessions
# * POST /config , methods: getConfig lastCfg
#
# There is no conflict with REST server, they can be used together
package Lemonldap::NG::Portal::Plugins::SOAPServer;
use strict;
use Mouse;
use Lemonldap::NG::Portal::Main::Constants qw(
PE_OK
PE_FORMEMPTY
);
our $VERSION = '2.0.10';
extends qw(
Lemonldap::NG::Portal::Main::Plugin
Lemonldap::NG::Common::Conf::AccessLib
);
has server => ( is => 'rw' );
has configStorage => (
is => 'ro',
lazy => 1,
default => sub {
$_[0]->{p}->HANDLER->localConfig->{configStorage};
}
);
has exportedAttr => (
is => 'rw',
lazy => 1,
default => sub {
my $conf = $_[0]->{conf};
if ( $conf->{exportedAttr} and $conf->{exportedAttr} !~ /^\s*\+/ ) {
return [ split /\s+/, $conf->{exportedAttr} ];
}
else {
my @attributes = (
'authenticationLevel', 'groups',
'ipAddr', '_startTime',
'_utime', '_lastSeen',
'_session_id', '_session_kind',
);
if ( my $exportedAttr = $conf->{exportedAttr} ) {
$exportedAttr =~ s/^\s*\+\s+//;
@attributes = ( @attributes, split( /\s+/, $exportedAttr ) );
}
# convert @attributes into hash to remove duplicates
my %attributes = map( { $_ => 1 } @attributes );
%attributes =
( %attributes, %{ $conf->{exportedVars} }, %{ $conf->{macros} },
);
return [ sort keys %attributes ];
}
}
);
########
# WSDL #
########
has wsdl => (
is => 'ro',
lazy => 1,
default => sub {
my ($self) = @_;
my @cookies = ( $self->conf->{cookieName} );
push @cookies, $self->conf->{cookieName} . 'http'
if ( $self->conf->{securedCookie} >= 2 );
my $cookieList = join "\n",
map { "" } @cookies;
my $attrList = join "\n", map {
""
} @{ $self->exportedAttr };
my $resp = join( '', );
close DATA;
$resp =~ s/\$cookieList/$cookieList/g;
$resp =~ s/\$attrList/$attrList/g;
$resp =~ s/\$portal/$self->conf->{portal}/ge;
return [
200,
[
'Content-Type' => 'application/wsdl+xml',
'Content-Length' => length($resp)
],
[$resp]
];
}
);
# INITIALIZATION
sub init {
my ($self) = @_;
eval {
require Lemonldap::NG::Common::PSGI::SOAPServer;
require Lemonldap::NG::Common::PSGI::SOAPService;
};
if ($@) {
$self->error($@);
return 0;
}
$self->server( Lemonldap::NG::Common::PSGI::SOAPServer->new );
if ( $self->conf->{soapSessionServer} ) {
$self->addUnauthRoute(
sessions => { '*' => 'unauthSessions' },
['POST']
)
->addUnauthRoute(
adminSessions => 'unauthAdminSessions',
['POST']
)
->addAuthRoute(
sessions => { '*' => 'badSoapRequest' },
['POST']
)
->addAuthRoute(
adminSessions => { '*' => 'badSoapRequest' },
['POST']
);
}
if ( $self->conf->{soapConfigServer} ) {
$self->addUnauthRoute( config => { '*' => 'config' }, ['POST'] )
->addAuthRoute( config => { '*' => 'badSoapRequest' }, ['POST'] );
}
if ( $self->conf->{wsdlServer} ) {
$self->addUnauthRoute( 'portal.wsdl' => 'getWsdl', ['GET'] )
->addAuthRoute( 'portal.wsdl' => 'getWsdl', ['GET'] );
}
return 1;
}
# SOAP DISPATCHERS
sub unauthSessions {
my ( $self, $req ) = @_;
return $self->dispatch_to( $req,
qw(error getCookies getAttributes isAuthorizedURI getMenuApplications)
);
}
sub unauthAdminSessions {
my ( $self, $req ) = @_;
return $self->dispatch_to(
$req,
qw(getCookies getAttributes isAuthorizedURI getMenuApplications
newSession setAttributes deleteSession getCipheredToken
get_key_from_all_sessions)
);
}
sub config {
my ( $self, $req ) = @_;
return $self->dispatch_to( $req, qw(getConfig lastCfg) );
}
sub badSoapRequest {
my ( $self, $req ) = @_;
return $self->p->sendError( $req, 'Bad request', 400 );
}
# Private dispatcher
sub dispatch_to {
my ( $self, $req, @functions ) = @_;
unless ( $req->env->{HTTP_SOAPACTION} ) {
return $self->p->sendError( $req, 'SOAP requests only', 400 );
}
return $self->server->dispatch_to(
Lemonldap::NG::Common::PSGI::SOAPService->new(
$self, $req, @functions
)
)->handle($req);
}
# RESPONSE METHODS
# Called in SOAP context, returns cookies in an array.
# This subroutine works only for portals working with user and password
sub getWsdl {
return $_[0]->wsdl;
}
sub error {
my ( $self, $no, $lang ) = @_;
return "Error $no";
}
=begin WSDL
_IN user $string User name
_IN password $string Password
_RETURN $getCookiesResponse Response
=end WSDL
=cut
sub getCookies {
my ( $self, $req, $user, $password, $sessionid ) = @_;
$self->logger->debug("SOAP authentication request for $user");
$req->{user} = $user;
$req->data->{password} = $password;
if ($sessionid) {
$req->{id} = $sessionid;
$req->{force} = 1;
}
$req->{error} = PE_OK;
# User and password are required
unless ( $req->{user} && $req->data->{password} ) {
$req->{error} = PE_FORMEMPTY;
}
# Launch process
else {
$req->steps( [
qw(getUser authenticate setAuthSessionInfo),
@{ $self->p->betweenAuthAndData },
$self->p->sessionData,
@{ $self->p->afterData },
$self->p->validSession,
@{ $self->p->endAuth },
]
);
$req->{error} = $self->p->process($req);
$self->logger->debug(
"SOAP authentication result for $user: code $req->{error}");
$self->p->updateSession($req);
}
my @tmp = ();
push @tmp, SOAP::Data->name( errorCode => $req->{error} );
my @cookies = ();
unless ( $req->{error} ) {
for ( my $i = 0 ; $i < @{ $req->respHeaders } ; $i += 2 ) {
if ( $req->respHeaders->[$i] eq 'Set-Cookie' ) {
my ( $k, $v ) =
( $req->respHeaders->[ $i + 1 ] =~ /^(\w+)\s*=\s*([^;]*)/ );
push @cookies, SOAP::Data->name( $k, $v )->type("string");
}
}
}
push @tmp, SOAP::Data->name( cookies => \SOAP::Data->value(@cookies) );
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
#TODO: updateStatus
#$self->p->updateStatus($req);
return $res;
}
# Return attributes of the session identified by $id.
# @param $id Cookie value
=begin WSDL
_IN id $string Cookie value
_RETURN $getAttributesResponse Response
=end WSDL
=cut
sub getAttributes {
my ( $self, $req, $id ) = @_;
die 'id is required' unless ($id);
my $session = $self->p->getApacheSession( $id, kind => '' );
my @tmp = ();
unless ($session) {
$self->userLogger->notice(
"SOAP attributes request: session $id not found");
push @tmp, SOAP::Data->name( error => 1 )->type('int');
}
else {
my $wtt = $session->data->{ $self->conf->{whatToTrace} };
$self->userLogger->info(
"SOAP attributes request for " . ( $wtt ? $wtt : $id ) );
push @tmp, SOAP::Data->name( error => 0 )->type('int');
push @tmp,
SOAP::Data->name(
attributes => _buildSoapHash(
$session->data,
( (
$session->{_session_kind}
and $session->{_session_kind} eq 'SSO'
)
? ( @{ $self->exportedAttr } )
: ()
)
)
);
}
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
return $res;
}
# Update data in the session referenced by $id
# @param $id Id of the session
# @param $args data to store
=begin WSDL
_IN id $string Cookie value
_RETURN $setAttributesResponse Response
=end WSDL
=cut
sub setAttributes {
my ( $self, $req, $id, $args ) = @_;
die 'id is required' unless ($id);
my $infos = {};
%$infos = %$args;
my $session = $self->p->getApacheSession( $id, info => $infos );
unless ($session) {
$self->logger->warn("Session $id does not exists ($@)");
return 0;
}
$self->logger->debug("SOAP request to update session $id");
return 1;
}
# Return Lemonldap::NG configuration. Warning, this is not a well formed
# SOAP::Data object so it can be difficult to read by other languages than
# Perl. It's not really a problem since this function is written to be read by
# Lemonldap::NG components and is not designed to be shared.
sub getConfig {
my ( $self, $req, $id ) = @_;
my $conf = $self->confAcc->getConf( { raw => 1, cfgNum => $id } )
or die("No configuration available");
return $conf;
}
# SOAP method that return the last configuration number.
# Call Lemonldap::NG::Common::Conf::lastCfg().
sub lastCfg {
my $self = shift;
return $self->confAcc->lastCfg;
}
# Store a new session.
sub newSession {
my ( $self, $req, $args ) = @_;
$args ||= {};
my $infos = {};
%$infos = %$args;
$infos->{_utime} = time();
my $session = $self->p->getApacheSession( undef, info => $infos );
unless ($session) {
$self->logger->error("Unable to create session");
return 0;
}
$self->logger->debug(
"SOAP request create a new session (" . $session->id . ")" );
return SOAP::Data->name( attributes => _buildSoapHash( $session->data ) );
}
# Deletes an existing session
sub deleteSession {
my ( $self, $req, $id ) = @_;
die('id parameter is required') unless ($id);
my $session = $self->p->getApacheSession( $id, kind => '' );
return 0 unless ($session);
$self->logger->debug("SOAP request to delete session $id");
return $self->p->_deleteSession( $req, $session );
}
# Returns key from all sessions
sub getCipheredToken {
my ( $self, $req ) = @_;
require Lemonldap::NG::Portal::Lib::OneTimeToken;
return $self->conf->{cipher}->encrypt(
Lemonldap::NG::Portal::Lib::OneTimeToken->new(
{ p => $self->p, conf => $self->conf, timeout => 5 }
)->createToken()
);
}
sub get_key_from_all_sessions {
my $self = shift;
my $req = shift;
my $token = shift;
# Verify that token is valid (must be unciphered by client)
require Lemonldap::NG::Portal::Lib::OneTimeToken;
unless (
Lemonldap::NG::Portal::Lib::OneTimeToken->new(
{ p => $self->p, conf => $self->conf }
)->getToken($token)
)
{
die SOAP::Fault->faultcode('Server.Custom')->faultstring('Bad token');
}
my $moduleOptions = $self->conf->{globalStorageOptions} || {};
$moduleOptions->{backend} = $self->conf->{globalStorage};
require Lemonldap::NG::Common::Apache::Session;
no strict 'refs';
return Lemonldap::NG::Common::Apache::Session->get_key_from_all_sessions(
$moduleOptions, @_ );
}
# Check user's authorization for uri.
# @param $id Id of the session
# @param $uri URL string
=begin WSDL
_IN id $string Cookie value
_IN uri $string URI to test
_RETURN $isAuthorizedURIResponse Response
=end WSDL
=cut
sub isAuthorizedURI {
my ( $self, $req, $id, $url ) = @_;
die 'id is required' unless ($id);
die 'uri is required' unless ($url);
die 'Bad uri' unless ( $url =~ m#^https?://([^/]+)(/.*)?$# );
my ( $host, $uri ) = ( $1, $2 );
# Get user session.
my $session = $self->p->getApacheSession($id);
unless ($session) {
$self->logger->warn("Session $id does not exists");
return 0;
}
$req->{sessionInfo} = $session->data;
my $r =
$self->p->HANDLER->grant( $req, $req->{sessionInfo}, $uri, undef, $host );
return $r;
}
# @param $id Id of the session
#######################
# Private subroutines #
#######################
##@fn private SOAP::Data _buildSoapHash()
# Serialize a hashref into SOAP::Data. Types are fixed to "string".
# @return SOAP::Data serialized data
sub _buildSoapHash {
my ( $h, @keys ) = @_;
my @tmp = ();
@keys = keys %$h unless (@keys);
foreach (@keys) {
if ( ref( $h->{$_} ) eq 'ARRAY' ) {
push @tmp, SOAP::Data->name( $_, @{ $h->{$_} } );
}
elsif ( ref( $h->{$_} ) ) {
push @tmp, SOAP::Data->name( $_ => _buildSoapHash( $h->{$_} ) );
}
else {
push @tmp, SOAP::Data->name( $_, $h->{$_} )->type('string')
if ( defined( $h->{$_} ) );
}
}
return \SOAP::Data->value(@tmp);
}
1;
__DATA__
$cookieList
$attrList