lemonldap-ng/modules/lemonldap-ng-portal/lib/Lemonldap/NG/Portal/_SOAP.pm

325 lines
9.3 KiB
Perl

## @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;
use Lemonldap::NG::Portal::_LibAccess;
require SOAP::Lite;
use Safe;
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 );
use base qw(Lemonldap::NG::Portal::_LibAccess);
our $VERSION = '1.0.0';
## @method void startSoapServices()
# Check the URI requested (PATH_INFO environment variable) and launch the
# corresponding SOAP methods using soapTest().
# If "soapOnly" is set, reject other request. Else, simply return.
sub startSoapServices {
my $self = shift;
# Load SOAP services
$self->{CustomSOAPServices} ||= {};
if (
$ENV{PATH_INFO}
and my $tmp = {
%{ $self->{CustomSOAPServices} },
'/sessions' =>
'getCookies getAttributes isAuthorizedURI getMenuApplications',
'/adminSessions' => 'getAttributes setAttributes isAuthorizedURI '
. 'newSession deleteSession get_key_from_all_sessions',
'/config' => 'getConfig lastCfg'
}->{ $ENV{PATH_INFO} }
)
{
$self->soapTest($tmp);
$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
##@method SOAP::Data getCookies(string user,string password, string sessionid)
# 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
#@param sessionid optional session identifier
#@return session => { error => code , cookies => { cookieName1 => value ,... } }
sub getCookies {
my ( $self, $user, $password, $sessionid ) = splice @_;
$self->{user} = $user;
$self->{password} = $password;
$self->{id} = $sessionid if ( defined($sessionid) && $sessionid );
$self->{error} = PE_OK;
$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
setMacros setLocalGroups setGroups setPersistentSessionInfo authenticate
removeOther grantSession store authFinish buildCookie)
);
$self->updateSession();
}
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 );
}
push @cookies,
SOAP::Data->name( $self->{cookieName} . 'update', time() );
}
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 {
my ( $self, $id ) = splice @_;
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} ) );
untie %$h;
}
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
return $res;
}
## @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 {
my ( $self, $id, $args ) = splice @_;
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;
}
##@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;
my $conf = $self->{lmConf}->getConf() or die("No configuration available");
return $conf;
}
##@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();
}
## @method SOAP::Data newSession(hashref args)
# Store a new session.
# @return Session datas
sub newSession {
my ( $self, $args ) = splice @_;
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 {
my ( $self, $id ) = splice @_;
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);
}
##@method SOAP::Data get_key_from_all_sessions
# Returns key from all sessions
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}, @_ );
#return &{"$tmp\::get_key_from_all_sessions"}( $self->{globalStorage},
# $self->{globalStorageOptions}, @_ );
}
=begin WSDL
_IN id $string Cookie value
_IN uri $string URI to test
_RETURN $isAuthorizedURIResponse Response
=end WSDL
=cut
## @method boolean isAuthorizedURI (string id, string uri)
# Check user's authorization for uri.
# @param $id Id of the session
# @param $uri URL string
# @return True if granted
sub isAuthorizedURI {
my $self = shift;
my ( $id, $uri ) = @_;
die 'id is required' unless ($id);
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;
}
$self->{sessionInfo} = $h;
my $r = $self->_grant($uri);
untie %$h;
return $r;
}
=begin WSDL
_IN id $string Cookie value
_RETURN $getMenuApplicationsResponse Response
=end WSDL
=cut
##@method SOAP::Data getMenuApplications(string id)
# @param $id Id of the session
#@return SOAP::Data
sub getMenuApplications {
my ( $self, $id ) = splice @_;
die 'id is required' unless ($id);
$self->lmLog( "SOAP getMenuApplications request for id $id", 'debug' );
# 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() } );
}
#######################
# Private subroutines #
#######################
##@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);
}
1;