SOAP server (#970)
This commit is contained in:
Xavier Guimard
parent
99d294d7c4
commit
b24343bd10
|
|
@ -9,7 +9,6 @@ lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm
|
|||
lib/Lemonldap/NG/Common/Apache/Session/Store.pm
|
||||
lib/Lemonldap/NG/Common/Captcha.pm
|
||||
lib/Lemonldap/NG/Common/CGI.pm
|
||||
lib/Lemonldap/NG/Common/CGI/SOAPService.pm
|
||||
lib/Lemonldap/NG/Common/Cli.pm
|
||||
lib/Lemonldap/NG/Common/Conf.pm
|
||||
lib/Lemonldap/NG/Common/Conf/AccessLib.pm
|
||||
|
|
@ -38,6 +37,7 @@ lib/Lemonldap/NG/Common/PSGI/Constants.pm
|
|||
lib/Lemonldap/NG/Common/PSGI/Request.pm
|
||||
lib/Lemonldap/NG/Common/PSGI/Router.pm
|
||||
lib/Lemonldap/NG/Common/PSGI/SOAPServer.pm
|
||||
lib/Lemonldap/NG/Common/PSGI/SOAPService.pm
|
||||
lib/Lemonldap/NG/Common/Regexp.pm
|
||||
lib/Lemonldap/NG/Common/Safe.pm
|
||||
lib/Lemonldap/NG/Common/Safelib.pm
|
||||
|
|
@ -55,7 +55,6 @@ t/01-Common-Conf.t
|
|||
t/02-Common-Conf-File.t
|
||||
t/03-Common-Conf-CDBI.t
|
||||
t/03-Common-Conf-RDBI.t
|
||||
t/04-Common-Conf-SOAP.t
|
||||
t/05-Common-Conf-LDAP.t
|
||||
t/20-Common-CGI.t
|
||||
t/30-Common-Safelib.t
|
||||
|
|
|
|||
|
|
@ -5,8 +5,6 @@ use utf8;
|
|||
use Mouse;
|
||||
|
||||
use Lemonldap::NG::Common::Conf;
|
||||
use Lemonldap::NG::Common::Conf::Constants;
|
||||
use Lemonldap::NG::Common::PSGI::Constants;
|
||||
|
||||
has '_confAcc' => ( is => 'rw', isa => 'Lemonldap::NG::Common::Conf' );
|
||||
has 'configStorage' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ sub new {
|
|||
# SOAP::Transport::HTTP::Server::handle(), then return the result to the client.
|
||||
sub handle {
|
||||
my $self = shift->new;
|
||||
my $req = shift;
|
||||
my $req = shift;
|
||||
|
||||
unless ( $req->content_length ) {
|
||||
return [ 411, [], [] ];
|
||||
|
|
|
|||
|
|
@ -3,17 +3,17 @@
|
|||
|
||||
## @class
|
||||
# SOAP wrapper used to restrict exported functions
|
||||
package Lemonldap::NG::Common::CGI::SOAPService;
|
||||
package Lemonldap::NG::Common::PSGI::SOAPService;
|
||||
|
||||
require SOAP::Lite;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @cmethod Lemonldap::NG::Common::CGI::SOAPService new(object obj,string @func)
|
||||
## @cmethod Lemonldap::NG::Common::PSGI::SOAPService new(object obj,string @func)
|
||||
# Constructor
|
||||
# @param $obj object which will be called for SOAP authorizated methods
|
||||
# @param @func authorizated methods
|
||||
# @return Lemonldap::NG::Common::CGI::SOAPService object
|
||||
# @return Lemonldap::NG::Common::PSGI::SOAPService object
|
||||
sub new {
|
||||
my ( $class, $obj, @func ) = @_;
|
||||
s/.*::// foreach (@func);
|
||||
|
|
@ -104,7 +104,13 @@ sub run {
|
|||
'debug' );
|
||||
|
||||
## HERE
|
||||
if ( $self->_grant($service) ) {
|
||||
unless ( $service =~ m#^https?://([^/]+)(/.*)?$# ) {
|
||||
$self->lmLog( "Bad service $service", 'error' );
|
||||
return PE_ERROR;
|
||||
}
|
||||
my ( $host, $uri ) = ( $1, $2 );
|
||||
if ( $self->p->HANDLER->grant( $req->sessionInfo, $1, undef, $2 ) )
|
||||
{
|
||||
$self->lmLog( "CAS service $service access allowed", 'debug' );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,8 @@ use Lemonldap::NG::Portal::Main::Constants qw(
|
|||
our $VERSION = '2.0.0';
|
||||
|
||||
extends 'Lemonldap::NG::Portal::Main::Issuer',
|
||||
'Lemonldap::NG::Portal::Lib::OpenIDConnect';
|
||||
'Lemonldap::NG::Portal::Lib::OpenIDConnect',
|
||||
'Lemonldap::NG::Common::Conf::AccessLib';
|
||||
|
||||
# INITIALIZATION
|
||||
|
||||
|
|
@ -74,28 +75,6 @@ sub init {
|
|||
return 1;
|
||||
}
|
||||
|
||||
# PROPERTIES
|
||||
|
||||
has '_confAcc' => ( is => 'rw', isa => 'Lemonldap::NG::Common::Conf' );
|
||||
|
||||
# Configuration access object
|
||||
# Return _confAcc property if exists or create it. Used for RP registration
|
||||
#@return Lemonldap::NG::Common::Conf object
|
||||
sub confAcc {
|
||||
my $self = shift;
|
||||
return $self->_confAcc if ( $self->_confAcc );
|
||||
|
||||
# TODO: pass args and remove this
|
||||
my $d = `pwd`;
|
||||
chomp $d;
|
||||
my $tmp;
|
||||
unless ( $tmp = Lemonldap::NG::Common::Conf->new( $self->configStorage ) ) {
|
||||
die "Unable to build Lemonldap::NG::Common::Conf "
|
||||
. $Lemonldap::NG::Common::Conf::msg;
|
||||
}
|
||||
return $self->_confAcc($tmp);
|
||||
}
|
||||
|
||||
# RUNNING METHODS
|
||||
|
||||
# Main method (launched only for authenticated users, see Main/Issuer.pm)
|
||||
|
|
|
|||
|
|
@ -2,9 +2,8 @@
|
|||
#
|
||||
# This plugin adds the following entry points:
|
||||
# * POST /sessions , methods: getCookies getAttributes isAuthorizedURI
|
||||
# getMenuApplications
|
||||
# * POST /adminSessions, methods: getAttributes setAttributes isAuthorizedURI
|
||||
# getMenuApplications newSession deleteSession
|
||||
# newSession deleteSession
|
||||
# get_key_from_all_sessions
|
||||
# * POST /config , methods: getConfig lastCfg
|
||||
#
|
||||
|
|
@ -14,18 +13,53 @@ 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.0';
|
||||
|
||||
extends 'Lemonldap::NG::Portal::Main::Plugin';
|
||||
extends 'Lemonldap::NG::Portal::Main::Plugin',
|
||||
'Lemonldap::NG::Common::Conf::AccessLib';
|
||||
|
||||
has server => ( is => 'rw' );
|
||||
|
||||
has exportedAttr => (
|
||||
is => 'rw',
|
||||
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',
|
||||
);
|
||||
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 ];
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
# INITIALIZATION
|
||||
|
||||
sub init {
|
||||
my ($self) = @_;
|
||||
eval { require Lemonldap::NG::Common::PSGI::SOAPServer };
|
||||
eval {
|
||||
require Lemonldap::NG::Common::PSGI::SOAPServer;
|
||||
require Lemonldap::NG::Common::PSGI::SOAPService;
|
||||
};
|
||||
if ($@) {
|
||||
$self->error($@);
|
||||
return 0;
|
||||
|
|
@ -34,26 +68,328 @@ sub init {
|
|||
$self->addUnauthRoute( sessions => 'unauthSessions', ['POST'] );
|
||||
$self->addUnauthRoute( adminSessions => 'unauthAdminSessions', ['POST'] );
|
||||
$self->addUnauthRoute( config => 'config', ['POST'] );
|
||||
$self->addAuthRoute( sessions => 'badSoapRequest' ['POST'] );
|
||||
$self->addAuthRoute( sessions => 'badSoapRequest', ['POST'] );
|
||||
$self->addAuthRoute( adminSessions => 'badSoapRequest', ['POST'] );
|
||||
$self->addAuthRoute( config => 'badSoapRequest' ['POST'] );
|
||||
$self->addAuthRoute( config => 'badSoapRequest', ['POST'] );
|
||||
1;
|
||||
}
|
||||
|
||||
# SOAP DISPATCHERS
|
||||
sub unauthSessions {
|
||||
my ( $self, $req ) = @_;
|
||||
return $self->dispatch_to( $req,
|
||||
qw(getCookies getAttributes isAuthorizedURI getMenuApplications) );
|
||||
}
|
||||
|
||||
sub unauthAdminSessions {
|
||||
my ( $self, $req ) = @_;
|
||||
return $self->dispatch_to(
|
||||
$req,
|
||||
qw(getCookies getAttributes isAuthorizedURI getMenuApplications
|
||||
newSession deleteSession 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
|
||||
|
||||
=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->lmLog( "SOAP authentication request for $user", 'debug' );
|
||||
|
||||
$req->{user} = $user;
|
||||
$req->datas->{password} = $password;
|
||||
if ($sessionid) {
|
||||
$req->{id} = $sessionid;
|
||||
$req->{force} = 1;
|
||||
}
|
||||
|
||||
$req->{error} = PE_OK;
|
||||
|
||||
# User and password are required
|
||||
unless ( $req->{user} && $req->datas->{password} ) {
|
||||
$req->{error} = PE_FORMEMPTY;
|
||||
}
|
||||
|
||||
# Launch process
|
||||
else {
|
||||
$req->{error} = $self->p->process(
|
||||
$req,
|
||||
[
|
||||
qw(getUser setAuthSessionInfo),
|
||||
@{ $self->p->betweenAuthAndDatas },
|
||||
$self->p->sessionDatas,
|
||||
@{ $self->p->afterDatas },
|
||||
]
|
||||
);
|
||||
$self->lmLog(
|
||||
"SOAP authentication result for $user: code $req->{error}",
|
||||
'debug' );
|
||||
$self->p->updateSession($req);
|
||||
}
|
||||
my @tmp = ();
|
||||
push @tmp, SOAP::Data->name( errorCode => $req->{error} );
|
||||
my @cookies = ();
|
||||
unless ( $self->{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) );
|
||||
$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, 1 );
|
||||
|
||||
my @tmp = ();
|
||||
unless ($session) {
|
||||
$self->p->userNotice("SOAP attributes request: session $id not found");
|
||||
push @tmp, SOAP::Data->name( error => 1 )->type('int');
|
||||
}
|
||||
else {
|
||||
$self->p->userInfo( "SOAP attributes request for "
|
||||
. $session->data->{ $self->conf->{whatToTrace} } );
|
||||
push @tmp, SOAP::Data->name( error => 0 )->type('int');
|
||||
push @tmp,
|
||||
SOAP::Data->name( attributes =>
|
||||
_buildSoapHash( $session->data, @{ $self->exportedAttr($req) } )
|
||||
);
|
||||
}
|
||||
my $res = SOAP::Data->name( session => \SOAP::Data->value(@tmp) );
|
||||
return $res;
|
||||
}
|
||||
|
||||
# Update datas in the session referenced by $id
|
||||
# @param $id Id of the session
|
||||
# @param $args datas 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 $session = $self->p->getApacheSession($id);
|
||||
|
||||
unless ($session) {
|
||||
$self->lmLog( "Session $id does not exists ($@)", 'warn' );
|
||||
return 0;
|
||||
}
|
||||
|
||||
$self->lmLog( "SOAP request to update session $id", 'debug' );
|
||||
|
||||
my $infos = {};
|
||||
%$infos = %$args;
|
||||
|
||||
$session->update($infos);
|
||||
|
||||
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( { 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 ) = @_;
|
||||
|
||||
my $session = $self->p->getApacheSession();
|
||||
|
||||
unless ($session) {
|
||||
$self->lmLog( "Unable to create session", 'error' );
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $infos = {};
|
||||
%$infos = %$args;
|
||||
$infos->{_utime} = time();
|
||||
|
||||
$session->update($infos);
|
||||
|
||||
$self->lmLog(
|
||||
"SOAP request to store "
|
||||
. $session->id . " ("
|
||||
. $session->data->{ $self->conf->{whatToTrace} } . ")",
|
||||
'debug'
|
||||
);
|
||||
|
||||
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);
|
||||
|
||||
return 0 unless ($session);
|
||||
|
||||
$self->lmLog( "SOAP request to delete session $id", 'debug' );
|
||||
|
||||
return $self->p->_deleteSession($session);
|
||||
}
|
||||
|
||||
# Returns key from all sessions
|
||||
|
||||
sub get_key_from_all_sessions {
|
||||
my $self = shift;
|
||||
my $req = shift;
|
||||
|
||||
my $moduleOptions = $self->conf->{globalStorageOptions} || {};
|
||||
$moduleOptions->{backend} = $self->conf->{globalStorage};
|
||||
my $module = "Lemonldap::NG::Common::Apache::Session";
|
||||
|
||||
require $module;
|
||||
|
||||
no strict 'refs';
|
||||
return $module->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, 1 );
|
||||
|
||||
unless ($session) {
|
||||
$self->lmLog( "Session $id does not exists", 'warn' );
|
||||
return 0;
|
||||
}
|
||||
|
||||
$self->{sessionInfo} = $session->data;
|
||||
my $r = $self->p->HANDLER->grant( $req, $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 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( $_, @{ $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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user