2009-02-24 18:53:59 +01:00
|
|
|
## @file
|
|
|
|
# SOAP methods for Lemonldap::NG portal
|
|
|
|
|
|
|
|
## @class
|
|
|
|
# Add SOAP methods to the Lemonldap::NG portal.
|
|
|
|
package Lemonldap::NG::Portal::_SOAP;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use Lemonldap::NG::Portal::Simple;
|
2010-09-17 12:23:49 +02:00
|
|
|
use Lemonldap::NG::Portal::_LibAccess;
|
2009-02-24 18:53:59 +01:00
|
|
|
require SOAP::Lite;
|
2010-10-02 17:45:10 +02:00
|
|
|
use base qw(Lemonldap::NG::Portal::_LibAccess);
|
2009-02-24 18:53:59 +01:00
|
|
|
|
2014-10-27 12:19:25 +01:00
|
|
|
our $VERSION = '1.4.2';
|
2009-06-08 18:29:13 +02:00
|
|
|
|
2009-02-24 18:53:59 +01:00
|
|
|
## @method void startSoapServices()
|
|
|
|
# Check the URI requested (PATH_INFO environment variable) and launch the
|
|
|
|
# corresponding SOAP methods using soapTest().
|
2010-09-27 16:18:48 +02:00
|
|
|
# If "soapOnly" is set, reject other request. Else, simply return.
|
2009-02-24 18:53:59 +01:00
|
|
|
sub startSoapServices {
|
|
|
|
my $self = shift;
|
2009-04-08 18:31:13 +02:00
|
|
|
|
2010-09-27 16:18:48 +02:00
|
|
|
# Load SOAP services
|
|
|
|
$self->{CustomSOAPServices} ||= {};
|
2009-02-24 18:53:59 +01:00
|
|
|
if (
|
2009-02-25 19:10:07 +01:00
|
|
|
$ENV{PATH_INFO}
|
|
|
|
and my $tmp = {
|
2009-10-12 18:55:35 +02:00
|
|
|
%{ $self->{CustomSOAPServices} },
|
2010-09-27 16:18:48 +02:00
|
|
|
'/sessions' =>
|
|
|
|
'getCookies getAttributes isAuthorizedURI getMenuApplications',
|
2010-01-07 12:07:48 +01:00
|
|
|
'/adminSessions' => 'getAttributes setAttributes isAuthorizedURI '
|
2009-04-03 18:17:57 +02:00
|
|
|
. 'newSession deleteSession get_key_from_all_sessions',
|
2010-09-27 16:18:48 +02:00
|
|
|
'/config' => 'getConfig lastCfg'
|
2009-02-24 18:53:59 +01:00
|
|
|
}->{ $ENV{PATH_INFO} }
|
|
|
|
)
|
|
|
|
{
|
2011-07-20 10:41:09 +02:00
|
|
|
|
|
|
|
# If $tmp is a HASHREF, extract SOAP functions and Object
|
|
|
|
# tmp->f: functions list
|
|
|
|
# tmp->o: object
|
|
|
|
if ( ref($tmp) =~ /HASH/ ) {
|
|
|
|
$self->soapTest( $tmp->{f}, $tmp->{o} );
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->soapTest($tmp);
|
|
|
|
}
|
2009-02-24 18:53:59 +01:00
|
|
|
$self->{soapOnly} = 1;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->soapTest("getCookies error");
|
|
|
|
}
|
|
|
|
$self->abort( 'Bad request', 'Only SOAP requests are accepted here' )
|
|
|
|
if ( $self->{soapOnly} );
|
|
|
|
}
|
|
|
|
|
|
|
|
####################
|
|
|
|
# SOAP subroutines #
|
|
|
|
####################
|
|
|
|
|
|
|
|
=begin WSDL
|
|
|
|
|
|
|
|
_IN user $string User name
|
|
|
|
_IN password $string Password
|
|
|
|
_RETURN $getCookiesResponse Response
|
|
|
|
|
|
|
|
=end WSDL
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2010-10-03 12:26:50 +02:00
|
|
|
##@method SOAP::Data getCookies(string user,string password, string sessionid)
|
2009-02-24 18:53:59 +01:00
|
|
|
# Called in SOAP context, returns cookies in an array.
|
|
|
|
# This subroutine works only for portals working with user and password
|
|
|
|
#@param user uid
|
|
|
|
#@param password password
|
2010-05-03 18:49:57 +02:00
|
|
|
#@param sessionid optional session identifier
|
2009-02-24 18:53:59 +01:00
|
|
|
#@return session => { error => code , cookies => { cookieName1 => value ,... } }
|
|
|
|
sub getCookies {
|
2010-05-12 06:04:10 +02:00
|
|
|
my ( $self, $user, $password, $sessionid ) = splice @_;
|
2014-06-25 12:01:17 +02:00
|
|
|
$self->lmLog( "SOAP authentication request for $user", 'debug' );
|
2012-09-08 19:20:08 +02:00
|
|
|
|
2010-05-03 18:49:57 +02:00
|
|
|
$self->{user} = $user;
|
|
|
|
$self->{password} = $password;
|
2014-06-25 12:01:17 +02:00
|
|
|
if ( defined($sessionid) && $sessionid ) {
|
|
|
|
$self->{id} = $sessionid;
|
|
|
|
$self->{force} = 1;
|
|
|
|
}
|
|
|
|
|
2014-07-24 17:48:32 +02:00
|
|
|
$self->{error} = PE_OK;
|
2012-09-08 19:20:08 +02:00
|
|
|
|
|
|
|
# Skip extractFormInfo step, as we already get input data
|
|
|
|
$self->{skipExtractFormInfo} = 1;
|
|
|
|
|
|
|
|
# User and password are required
|
2009-02-24 18:53:59 +01:00
|
|
|
unless ( $self->{user} && $self->{password} ) {
|
|
|
|
$self->{error} = PE_FORMEMPTY;
|
|
|
|
}
|
2012-09-08 19:20:08 +02:00
|
|
|
|
|
|
|
# Launch process
|
2009-02-24 18:53:59 +01:00
|
|
|
else {
|
|
|
|
$self->{error} = $self->_subProcess(
|
2012-09-08 19:20:08 +02:00
|
|
|
qw(authInit userDBInit extractFormInfo getUser setAuthSessionInfo
|
2012-02-09 10:01:04 +01:00
|
|
|
setSessionInfo setMacros setGroups setPersistentSessionInfo
|
|
|
|
setLocalGroups authenticate grantSession removeOther
|
|
|
|
store authFinish buildCookie)
|
2009-02-24 18:53:59 +01:00
|
|
|
);
|
2012-09-08 19:20:08 +02:00
|
|
|
$self->lmLog(
|
|
|
|
"SOAP authentication result for $user: code $self->{error}",
|
|
|
|
'debug' );
|
2010-05-05 18:49:26 +02:00
|
|
|
$self->updateSession();
|
2009-02-24 18:53:59 +01:00
|
|
|
}
|
|
|
|
my @tmp = ();
|
2012-06-11 15:11:25 +02:00
|
|
|
push @tmp, SOAP::Data->name( errorCode => $self->{error} );
|
2009-02-24 18:53:59 +01:00
|
|
|
my @cookies = ();
|
|
|
|
unless ( $self->{error} ) {
|
|
|
|
foreach ( @{ $self->{cookie} } ) {
|
2012-06-12 17:46:18 +02:00
|
|
|
push @cookies,
|
|
|
|
SOAP::Data->name( $_->name, $_->value )->type("string");
|
2009-02-24 18:53:59 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
push @tmp, SOAP::Data->name( cookies => \SOAP::Data->value(@cookies) );
|
|
|
|
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
|
|
|
|
$self->updateStatus;
|
|
|
|
return $res;
|
|
|
|
}
|
|
|
|
|
|
|
|
=begin WSDL
|
|
|
|
|
|
|
|
_IN id $string Cookie value
|
|
|
|
_RETURN $getAttributesResponse Response
|
|
|
|
|
|
|
|
=end WSDL
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
|
|
|
##@method SOAP::Data getAttributes(string id)
|
|
|
|
# Return attributes of the session identified by $id.
|
|
|
|
# @param $id Cookie value
|
|
|
|
# @return SOAP::Data sequence
|
|
|
|
sub getAttributes {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $id ) = splice @_;
|
2009-02-24 18:53:59 +01:00
|
|
|
die 'id is required' unless ($id);
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
my $session = $self->getApacheSession( $id, 1 );
|
|
|
|
|
2009-02-24 18:53:59 +01:00
|
|
|
my @tmp = ();
|
2014-10-27 12:19:25 +01:00
|
|
|
unless ($session) {
|
2009-02-24 18:53:59 +01:00
|
|
|
$self->_sub( 'userNotice',
|
|
|
|
"SOAP attributes request: session $id not found" );
|
|
|
|
push @tmp, SOAP::Data->name( error => 1 )->type('int');
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->_sub( 'userInfo',
|
2014-02-26 11:57:49 +01:00
|
|
|
"SOAP attributes request for "
|
|
|
|
. $session->data->{ $self->{whatToTrace} } );
|
2009-02-24 18:53:59 +01:00
|
|
|
push @tmp, SOAP::Data->name( error => 0 )->type('int');
|
|
|
|
push @tmp,
|
2012-06-12 17:46:18 +02:00
|
|
|
SOAP::Data->name(
|
2014-02-26 11:57:49 +01:00
|
|
|
attributes => _buildSoapHash( $session->data, $self->exportedAttr )
|
|
|
|
);
|
2009-02-24 18:53:59 +01:00
|
|
|
}
|
|
|
|
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
|
|
|
|
return $res;
|
|
|
|
}
|
|
|
|
|
2009-04-03 18:17:57 +02:00
|
|
|
## @method SOAP::Data setAttributes(string id,hashref args)
|
|
|
|
# Update datas in the session referenced by $id
|
|
|
|
# @param $id Id of the session
|
|
|
|
# @param $args datas to store
|
|
|
|
# @return true if succeed
|
|
|
|
sub setAttributes {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $id, $args ) = splice @_;
|
2009-04-03 18:17:57 +02:00
|
|
|
die 'id is required' unless ($id);
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
my $session = $self->getApacheSession($id);
|
|
|
|
|
2014-10-27 12:19:25 +01:00
|
|
|
unless ($session) {
|
2009-04-03 18:17:57 +02:00
|
|
|
$self->lmLog( "Session $id does not exists ($@)", 'warn' );
|
|
|
|
return 0;
|
|
|
|
}
|
2014-02-26 11:57:49 +01:00
|
|
|
|
2009-04-03 18:17:57 +02:00
|
|
|
$self->lmLog( "SOAP request to update session $id", 'debug' );
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
my $infos = {};
|
|
|
|
$infos->{$_} = $args->{$_} foreach ( keys %{$args} );
|
|
|
|
|
|
|
|
$session->update($infos);
|
|
|
|
|
2009-04-03 18:17:57 +02:00
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2009-02-24 18:53:59 +01:00
|
|
|
##@method SOAP::Data getConfig()
|
|
|
|
# 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.
|
|
|
|
# @return hashref serialized in SOAP by SOAP::Lite
|
|
|
|
sub getConfig {
|
|
|
|
my $self = shift;
|
2010-11-04 15:52:17 +01:00
|
|
|
my $conf = $self->{lmConf}->getConf() or die("No configuration available");
|
2009-02-24 18:53:59 +01:00
|
|
|
return $conf;
|
|
|
|
}
|
|
|
|
|
2009-06-23 22:36:44 +02:00
|
|
|
##@method int lastCfg()
|
|
|
|
# SOAP method that return the last configuration number.
|
|
|
|
# Call Lemonldap::NG::Common::Conf::lastCfg().
|
|
|
|
# @return Last configuration number
|
|
|
|
sub lastCfg {
|
|
|
|
my $self = shift;
|
|
|
|
return $self->{lmConf}->lastCfg();
|
|
|
|
}
|
|
|
|
|
2009-04-03 18:17:57 +02:00
|
|
|
## @method SOAP::Data newSession(hashref args)
|
|
|
|
# Store a new session.
|
|
|
|
# @return Session datas
|
|
|
|
sub newSession {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $args ) = splice @_;
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
my $session = $self->getApacheSession();
|
|
|
|
|
2014-10-27 12:19:25 +01:00
|
|
|
unless ($session) {
|
2009-04-03 18:17:57 +02:00
|
|
|
$self->lmLog( "Unable to create session", 'error' );
|
|
|
|
return 0;
|
|
|
|
}
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
my $infos = {};
|
|
|
|
$infos->{$_} = $args->{$_} foreach ( keys %{$args} );
|
|
|
|
$infos->{_utime} = time();
|
|
|
|
|
|
|
|
$session->update($infos);
|
|
|
|
|
|
|
|
$self->lmLog(
|
|
|
|
"SOAP request to store "
|
|
|
|
. $session->id . " ("
|
|
|
|
. $session->data->{ $self->{whatToTrace} } . ")",
|
|
|
|
'debug'
|
|
|
|
);
|
|
|
|
|
|
|
|
return SOAP::Data->name( attributes => _buildSoapHash( $session->data ) );
|
2009-04-03 18:17:57 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
## @method SOAP::Data deleteSession()
|
|
|
|
# Deletes an existing session
|
|
|
|
sub deleteSession {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $id ) = splice @_;
|
2009-04-03 18:17:57 +02:00
|
|
|
die('id parameter is required') unless ($id);
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
my $session = $self->getApacheSession($id);
|
|
|
|
|
2014-10-27 12:19:25 +01:00
|
|
|
return 0 unless ($session);
|
2014-02-26 11:57:49 +01:00
|
|
|
|
2009-04-03 18:17:57 +02:00
|
|
|
$self->lmLog( "SOAP request to delete session $id", 'debug' );
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
return $self->_deleteSession($session);
|
2009-04-03 18:17:57 +02:00
|
|
|
}
|
|
|
|
|
2010-01-19 17:50:38 +01:00
|
|
|
##@method SOAP::Data get_key_from_all_sessions
|
|
|
|
# Returns key from all sessions
|
2009-04-03 18:17:57 +02:00
|
|
|
sub get_key_from_all_sessions {
|
|
|
|
my $self = shift;
|
|
|
|
shift;
|
|
|
|
|
2014-02-26 11:57:49 +01:00
|
|
|
my $moduleOptions = $self->{globalStorageOptions} || {};
|
|
|
|
$moduleOptions->{backend} = $self->{globalStorage};
|
|
|
|
my $module = "Lemonldap::NG::Common::Apache::Session";
|
|
|
|
|
|
|
|
require $module;
|
2010-10-30 11:03:52 +02:00
|
|
|
|
2014-02-26 11:57:49 +01:00
|
|
|
no strict 'refs';
|
|
|
|
return $module->get_key_from_all_sessions( $moduleOptions, @_ );
|
2009-04-03 18:17:57 +02:00
|
|
|
}
|
|
|
|
|
2010-01-18 16:39:01 +01:00
|
|
|
=begin WSDL
|
|
|
|
|
|
|
|
_IN id $string Cookie value
|
|
|
|
_IN uri $string URI to test
|
|
|
|
_RETURN $isAuthorizedURIResponse Response
|
|
|
|
|
|
|
|
=end WSDL
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2010-09-27 16:18:48 +02:00
|
|
|
## @method boolean isAuthorizedURI (string id, string uri)
|
2010-01-07 12:07:48 +01:00
|
|
|
# Check user's authorization for uri.
|
|
|
|
# @param $id Id of the session
|
|
|
|
# @param $uri URL string
|
|
|
|
# @return True if granted
|
2010-01-19 17:50:38 +01:00
|
|
|
sub isAuthorizedURI {
|
2010-01-07 12:07:48 +01:00
|
|
|
my $self = shift;
|
2010-01-19 17:50:38 +01:00
|
|
|
my ( $id, $uri ) = @_;
|
2010-03-01 21:32:28 +01:00
|
|
|
die 'id is required' unless ($id);
|
2010-01-07 12:07:48 +01:00
|
|
|
die 'uri is required' unless ($uri);
|
|
|
|
|
|
|
|
# Get user session.
|
2014-02-26 11:57:49 +01:00
|
|
|
my $session = $self->getApacheSession( $id, 1 );
|
|
|
|
|
2014-10-27 12:19:25 +01:00
|
|
|
unless ($session) {
|
2014-02-26 11:57:49 +01:00
|
|
|
$self->lmLog( "Session $id does not exists", 'warn' );
|
2010-01-07 12:07:48 +01:00
|
|
|
return 0;
|
|
|
|
}
|
2014-02-26 11:57:49 +01:00
|
|
|
|
|
|
|
$self->{sessionInfo} = $session->data;
|
2010-09-17 12:23:49 +02:00
|
|
|
my $r = $self->_grant($uri);
|
2014-02-26 11:57:49 +01:00
|
|
|
|
2010-09-17 12:23:49 +02:00
|
|
|
return $r;
|
2010-01-07 12:07:48 +01:00
|
|
|
}
|
|
|
|
|
2010-01-19 17:50:38 +01:00
|
|
|
=begin WSDL
|
|
|
|
|
2010-09-27 16:18:48 +02:00
|
|
|
_IN id $string Cookie value
|
|
|
|
_RETURN $getMenuApplicationsResponse Response
|
2010-01-19 17:50:38 +01:00
|
|
|
|
|
|
|
=end WSDL
|
|
|
|
|
|
|
|
=cut
|
|
|
|
|
2010-09-27 16:18:48 +02:00
|
|
|
##@method SOAP::Data getMenuApplications(string id)
|
|
|
|
# @param $id Id of the session
|
2010-01-19 17:50:38 +01:00
|
|
|
#@return SOAP::Data
|
2010-09-27 16:18:48 +02:00
|
|
|
sub getMenuApplications {
|
|
|
|
my ( $self, $id ) = splice @_;
|
|
|
|
die 'id is required' unless ($id);
|
2010-01-19 17:50:38 +01:00
|
|
|
|
2010-09-27 16:18:48 +02:00
|
|
|
$self->lmLog( "SOAP getMenuApplications request for id $id", 'debug' );
|
2010-01-19 17:50:38 +01:00
|
|
|
|
2010-09-27 16:18:48 +02:00
|
|
|
# Get user session.
|
2014-02-26 11:57:49 +01:00
|
|
|
my $session = $self->getApacheSession( $id, 1 );
|
|
|
|
|
2014-10-27 12:19:25 +01:00
|
|
|
unless ($session) {
|
2014-02-26 11:57:49 +01:00
|
|
|
$self->lmLog( "Session $id does not exists", 'warn' );
|
2010-09-27 16:18:48 +02:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2014-02-26 11:57:49 +01:00
|
|
|
$self->{sessionInfo} = $session->data;
|
2011-12-02 10:34:01 +01:00
|
|
|
|
|
|
|
# Build application list
|
|
|
|
my $appslist = $self->appslist();
|
|
|
|
|
|
|
|
# Return result
|
|
|
|
return _buildSoapHash( { menu => $appslist } );
|
2010-01-19 17:50:38 +01:00
|
|
|
|
|
|
|
}
|
|
|
|
|
2012-06-12 17:46:18 +02:00
|
|
|
#########################
|
|
|
|
# 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 {
|
2013-01-03 19:14:34 +01:00
|
|
|
my @attributes =
|
|
|
|
( 'authenticationLevel', 'groups', 'ipAddr', 'startTime', '_utime' );
|
2012-06-12 17:46:18 +02:00
|
|
|
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;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2010-01-07 12:07:48 +01:00
|
|
|
#######################
|
|
|
|
# Private subroutines #
|
|
|
|
#######################
|
|
|
|
|
2010-01-19 17:50:38 +01:00
|
|
|
##@fn private SOAP::Data _buildSoapHash()
|
|
|
|
# Serialize a hashref into SOAP::Data. Types are fixed to "string".
|
|
|
|
# @return SOAP::Data serialized datas
|
|
|
|
sub _buildSoapHash {
|
|
|
|
my ( $h, @keys ) = @_;
|
|
|
|
my @tmp = ();
|
|
|
|
@keys = keys %$h unless (@keys);
|
|
|
|
foreach (@keys) {
|
|
|
|
if ( ref( $h->{$_} ) eq 'ARRAY' ) {
|
|
|
|
push @tmp,
|
|
|
|
SOAP::Data->name( $_, \SOAP::Data->value( @{ $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);
|
|
|
|
}
|
|
|
|
|
2009-02-24 18:53:59 +01:00
|
|
|
1;
|
|
|
|
|