371 lines
11 KiB
Perl
371 lines
11 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;
|
|
require SOAP::Lite;
|
|
|
|
our $VERSION = '0.2';
|
|
|
|
## @method void startSoapServices()
|
|
# Check the URI requested (PATH_INFO environment variable) and launch the
|
|
# corresponding SOAP methods using soapTest().
|
|
# If "soapOnly" is set, reject otehr request. Else, simply return.
|
|
sub startSoapServices {
|
|
my $self = shift;
|
|
$self->{CustomSOAPServices} ||= {};
|
|
|
|
# TODO: insert here the SAML SOAP functions
|
|
$self->{CustomSOAPServices}->{'/SAMLAuthority'} = ''
|
|
if ( $self->{SAMLIssuer} );
|
|
if (
|
|
$ENV{PATH_INFO}
|
|
and my $tmp = {
|
|
%{ $self->{CustomSOAPServices} },
|
|
'/sessions' => 'getAttributes isAuthorizedURI',
|
|
'/adminSessions' => 'getAttributes setAttributes isAuthorizedURI '
|
|
. 'newSession deleteSession get_key_from_all_sessions',
|
|
'/config' => 'getConfig lastCfg getXmlMenu'
|
|
}->{ $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)
|
|
# 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
|
|
#@return session => { error => code , cookies => { cookieName1 => value ,... } }
|
|
sub getCookies {
|
|
my $self = shift;
|
|
$self->{error} = PE_OK;
|
|
( $self->{user}, $self->{password} ) = ( shift, shift );
|
|
$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 authenticate removeOther grantSession
|
|
store buildCookie)
|
|
);
|
|
}
|
|
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 );
|
|
}
|
|
}
|
|
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->_getLmConf() 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 (int 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;
|
|
}
|
|
|
|
# Initialize values relative to URI.
|
|
$uri =~ m{(\w+)://([^/:]+)(:\d+)?(/.*)?$} or return -1;
|
|
|
|
my ( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
|
|
$path ||= '/';
|
|
|
|
# Location rules variables.
|
|
my ( $defaultCondition, $locationCondition, $locationRegexp );
|
|
|
|
# Compile location rules.
|
|
foreach my $vhost ( keys %{ $self->{locationRules} } ) {
|
|
my $i = 0;
|
|
foreach my $vpath ( keys %{ $self->{locationRules}->{$vhost} } ) {
|
|
if ( $vpath eq 'default' ) {
|
|
$defaultCondition->{$vhost} =
|
|
$self->_conditionSub( $id,
|
|
$self->{locationRules}->{$vhost}->{$vpath} );
|
|
}
|
|
else {
|
|
$locationCondition->{$vhost}->[$i] =
|
|
$self->_conditionSub( $id,
|
|
$self->{locationRules}->{$vhost}->{$vpath} );
|
|
$locationRegexp->{$vhost}->[$i] = qr/$vpath/;
|
|
$i++;
|
|
}
|
|
}
|
|
$defaultCondition->{$vhost} ||= $self->_conditionSub( $id, 'accept' );
|
|
}
|
|
|
|
# Test rules.
|
|
unless ( defined( $defaultCondition->{$vhost} ) ) {
|
|
$self->lmLog( "No default condition builded", 'warn' );
|
|
return 0;
|
|
}
|
|
if ( defined $locationRegexp->{$vhost} ) {
|
|
for ( my $i = 0 ; $i < @{ $locationRegexp->{$vhost} } ; $i++ ) {
|
|
if ( $path =~ $locationRegexp->{$vhost}->[$i] ) {
|
|
return &{ $locationCondition->{$vhost}->[$i] }($self);
|
|
}
|
|
}
|
|
}
|
|
return 0 unless ( $defaultCondition->{$vhost} );
|
|
return &{ $defaultCondition->{$vhost} }($self);
|
|
return 1;
|
|
}
|
|
|
|
=begin WSDL
|
|
|
|
_IN file $string Menu XML file complete path
|
|
_RETURN $getXmlMenuResponse Response
|
|
|
|
=end WSDL
|
|
|
|
=cut
|
|
|
|
##@method SOAP::Data getXmlMenu(string file)
|
|
#@param file
|
|
#@return SOAP::Data
|
|
sub getXmlMenu {
|
|
my $self = shift;
|
|
my ($file) = @_;
|
|
die 'file is required' unless ($file);
|
|
die 'file cannot be read' unless ( -r $file );
|
|
|
|
# Load XML::Simple
|
|
use XML::Simple;
|
|
|
|
# Get XML content
|
|
my $xml = new XML::Simple( ForceArray => '1' );
|
|
|
|
return _buildSoapHash( $xml->XMLin($file) );
|
|
}
|
|
|
|
#######################
|
|
# 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);
|
|
}
|
|
|
|
## @method private CODE _conditionSub(string cond)
|
|
# Return subroutine giving authorization condition.
|
|
# @param $cond boolean expression
|
|
# @return Compiled routine
|
|
sub _conditionSub {
|
|
my ( $self, $id, $cond ) = splice @_;
|
|
my $h = $self->getApacheSession( $id, 1 );
|
|
return sub { 1 }
|
|
if ( $cond =~ /^accept$/i );
|
|
return sub { 0 }
|
|
if ( !$h or $cond =~ /^(?:deny$|logout)/i );
|
|
$cond =~ s/\$date/&POSIX::strftime("%Y%m%d%H%M%S",localtime())/e;
|
|
$cond =~ s/\$(\w+)/$h->{$1}/g;
|
|
my $sub;
|
|
$sub = $self->safe->reval("sub {my \$self = shift; return ( $cond )}");
|
|
return $sub;
|
|
}
|
|
|
|
1;
|
|
|