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
|
|
|
|
2011-07-20 10:41:09 +02:00
|
|
|
our $VERSION = '1.1.1';
|
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 @_;
|
2010-05-03 18:49:57 +02:00
|
|
|
$self->{user} = $user;
|
|
|
|
$self->{password} = $password;
|
|
|
|
$self->{id} = $sessionid if ( defined($sessionid) && $sessionid );
|
2010-05-12 06:04:10 +02:00
|
|
|
$self->{error} = PE_OK;
|
2009-02-24 18:53:59 +01:00
|
|
|
$self->lmLog( "SOAP authentication request for $self->{user}", 'debug' );
|
|
|
|
unless ( $self->{user} && $self->{password} ) {
|
|
|
|
$self->{error} = PE_FORMEMPTY;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->{error} = $self->_subProcess(
|
|
|
|
qw(authInit userDBInit getUser setAuthSessionInfo setSessionInfo
|
2010-10-21 12:28:47 +02:00
|
|
|
setMacros setLocalGroups setGroups setPersistentSessionInfo authenticate
|
|
|
|
removeOther grantSession store authFinish buildCookie)
|
2009-02-24 18:53:59 +01:00
|
|
|
);
|
2010-05-05 18:49:26 +02:00
|
|
|
$self->updateSession();
|
2009-02-24 18:53:59 +01:00
|
|
|
}
|
|
|
|
my @tmp = ();
|
|
|
|
push @tmp, SOAP::Data->name( error => $self->{error} );
|
|
|
|
my @cookies = ();
|
|
|
|
unless ( $self->{error} ) {
|
|
|
|
foreach ( @{ $self->{cookie} } ) {
|
|
|
|
push @cookies, SOAP::Data->name( $_->name, $_->value );
|
|
|
|
}
|
2010-05-12 06:04:10 +02:00
|
|
|
push @cookies,
|
|
|
|
SOAP::Data->name( $self->{cookieName} . 'update', time() );
|
2009-02-24 18:53:59 +01:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
my @cookieNames = split /\s+/, $self->{cookieName};
|
|
|
|
foreach (@cookieNames) {
|
|
|
|
push @cookies, SOAP::Data->name( $_, 0 );
|
|
|
|
}
|
|
|
|
}
|
|
|
|
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);
|
|
|
|
my $h = $self->getApacheSession( $id, 1 );
|
|
|
|
my @tmp = ();
|
|
|
|
unless ($h) {
|
|
|
|
$self->_sub( 'userNotice',
|
|
|
|
"SOAP attributes request: session $id not found" );
|
|
|
|
push @tmp, SOAP::Data->name( error => 1 )->type('int');
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$self->_sub( 'userInfo',
|
|
|
|
"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} ) );
|
2009-04-03 18:17:57 +02:00
|
|
|
untie %$h;
|
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);
|
|
|
|
my $h = $self->getApacheSession($id);
|
|
|
|
unless ($h) {
|
|
|
|
$self->lmLog( "Session $id does not exists ($@)", 'warn' );
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
$self->lmLog( "SOAP request to update session $id", 'debug' );
|
|
|
|
$h->{$_} = $args->{$_} foreach ( keys %{$args} );
|
|
|
|
untie %$h;
|
|
|
|
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 @_;
|
2009-04-03 18:17:57 +02:00
|
|
|
my $h = $self->getApacheSession();
|
|
|
|
if ($@) {
|
|
|
|
$self->lmLog( "Unable to create session", 'error' );
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
$h->{$_} = $args->{$_} foreach ( keys %{$args} );
|
|
|
|
$h->{_utime} = time();
|
|
|
|
$args->{$_} = $h->{$_} foreach ( keys %$h );
|
|
|
|
untie %$h;
|
|
|
|
$self->lmLog( "SOAP request to store $args->{_session_id} ($args->{uid})",
|
|
|
|
'debug' );
|
|
|
|
return SOAP::Data->name( attributes => _buildSoapHash($args) );
|
|
|
|
}
|
|
|
|
|
|
|
|
## @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);
|
|
|
|
my $h = $self->getApacheSession($id);
|
|
|
|
return 0 if ($@);
|
|
|
|
$self->lmLog( "SOAP request to delete session $id", 'debug' );
|
|
|
|
return $self->_deleteSession($h);
|
|
|
|
}
|
|
|
|
|
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;
|
|
|
|
require Lemonldap::NG::Common::Apache::Session;
|
|
|
|
|
|
|
|
#die $self->{globalStorage};
|
|
|
|
my $tmp = $self->{globalStorage};
|
|
|
|
no strict 'refs';
|
|
|
|
return $self->{globalStorage}
|
|
|
|
->get_key_from_all_sessions( $self->{globalStorageOptions}, @_ );
|
2010-10-30 11:03:52 +02:00
|
|
|
|
|
|
|
#return &{"$tmp\::get_key_from_all_sessions"}( $self->{globalStorage},
|
|
|
|
# $self->{globalStorageOptions}, @_ );
|
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.
|
|
|
|
my $h = $self->getApacheSession( $id, 1 );
|
|
|
|
unless ($h) {
|
|
|
|
$self->lmLog( "Session $id does not exists ($@)", 'warn' );
|
|
|
|
return 0;
|
|
|
|
}
|
2010-09-17 12:23:49 +02:00
|
|
|
$self->{sessionInfo} = $h;
|
|
|
|
my $r = $self->_grant($uri);
|
|
|
|
untie %$h;
|
|
|
|
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.
|
|
|
|
my $h = $self->getApacheSession( $id, 1 );
|
|
|
|
unless ($h) {
|
|
|
|
$self->lmLog( "Session $id does not exists ($@)", 'warn' );
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
$self->{sessionInfo} = $h;
|
|
|
|
return _buildSoapHash( { menu => $self->appslist() } );
|
2010-01-19 17:50:38 +01:00
|
|
|
|
|
|
|
}
|
|
|
|
|
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;
|
|
|
|
|