2017-01-06 13:30:41 +01:00
|
|
|
package Lemonldap::NG::Common::Conf::Backends::SOAP;
|
2007-02-24 21:23:17 +01:00
|
|
|
|
|
|
|
use strict;
|
2016-01-07 13:34:34 +01:00
|
|
|
use utf8;
|
2007-02-24 21:23:17 +01:00
|
|
|
use SOAP::Lite;
|
2017-08-29 17:20:54 +02:00
|
|
|
use Lemonldap::NG::Common::Conf::Constants;
|
2007-02-24 21:23:17 +01:00
|
|
|
|
2019-02-12 18:21:38 +01:00
|
|
|
our $VERSION = '2.1.0';
|
2007-05-06 16:41:30 +02:00
|
|
|
|
2009-02-17 15:56:38 +01:00
|
|
|
#parameter proxy Url of SOAP service
|
|
|
|
#parameter proxyOptions SOAP::Lite parameters
|
|
|
|
|
2007-05-06 16:41:30 +02:00
|
|
|
BEGIN {
|
2008-11-17 17:59:56 +01:00
|
|
|
*Lemonldap::NG::Common::Conf::_soapCall = \&_soapCall;
|
2010-03-01 21:32:28 +01:00
|
|
|
*Lemonldap::NG::Common::Conf::_connect = \&_connect;
|
2009-06-23 22:36:44 +02:00
|
|
|
|
2007-05-06 16:41:30 +02:00
|
|
|
sub SOAP::Transport::HTTP::Client::get_basic_credentials {
|
2017-01-06 13:30:41 +01:00
|
|
|
return $Lemonldap::NG::Common::Conf::Backends::SOAP::username =>
|
|
|
|
$Lemonldap::NG::Common::Conf::Backends::SOAP::password;
|
2007-05-06 16:41:30 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
our ( $username, $password ) = ( '', '' );
|
2007-02-24 21:23:17 +01:00
|
|
|
|
|
|
|
sub prereq {
|
|
|
|
my $self = shift;
|
2007-02-28 13:56:35 +01:00
|
|
|
unless ( $self->{proxy} ) {
|
2011-07-07 17:08:45 +02:00
|
|
|
$Lemonldap::NG::Common::Conf::msg .=
|
|
|
|
"proxy parameter is required in SOAP configuration type \n";
|
2007-02-24 21:23:17 +01:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
1;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub _connect {
|
2007-02-28 13:56:35 +01:00
|
|
|
my $self = shift;
|
|
|
|
return $self->{service} if ( $self->{service} );
|
|
|
|
my @args = ( $self->{proxy} );
|
|
|
|
if ( $self->{proxyOptions} ) {
|
|
|
|
push @args, %{ $self->{proxyOptions} };
|
|
|
|
}
|
2017-02-19 18:04:49 +01:00
|
|
|
$self->{ns} ||= 'urn:/Lemonldap/NG/Common/PSGI/SOAPService';
|
2007-02-28 23:36:19 +01:00
|
|
|
return $self->{service} = SOAP::Lite->ns( $self->{ns} )->proxy(@args);
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub _soapCall {
|
|
|
|
my $self = shift;
|
|
|
|
my $func = shift;
|
2007-05-06 16:41:30 +02:00
|
|
|
$username = $self->{User};
|
|
|
|
$password = $self->{Password};
|
2009-06-23 22:36:44 +02:00
|
|
|
my $r = $self->_connect->$func(@_);
|
|
|
|
if ( $r->fault() ) {
|
|
|
|
print STDERR "SOAP error : " . $r->fault()->{faultstring};
|
|
|
|
return ();
|
|
|
|
}
|
|
|
|
return $r->result;
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub available {
|
|
|
|
my $self = shift;
|
2007-02-28 13:56:35 +01:00
|
|
|
return @{ $self->_soapCall( 'available', @_ ) };
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub lastCfg {
|
|
|
|
my $self = shift;
|
2007-02-28 13:56:35 +01:00
|
|
|
return $self->_soapCall( 'lastCfg', @_ );
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
2014-04-04 16:20:43 +02:00
|
|
|
# lock and unlock must not be requested by the SOAP client, since
|
|
|
|
# they will be done by the SOAP server when storing the config
|
2007-03-04 15:52:51 +01:00
|
|
|
sub lock {
|
2014-04-04 16:20:43 +02:00
|
|
|
return 1;
|
2007-03-04 15:52:51 +01:00
|
|
|
}
|
|
|
|
|
2014-04-04 16:20:43 +02:00
|
|
|
sub unlock {
|
|
|
|
return 1;
|
|
|
|
}
|
2007-03-04 15:52:51 +01:00
|
|
|
|
|
|
|
sub isLocked {
|
2014-04-04 16:20:43 +02:00
|
|
|
return 1;
|
2007-03-04 15:52:51 +01:00
|
|
|
}
|
|
|
|
|
2007-02-24 21:23:17 +01:00
|
|
|
sub store {
|
|
|
|
my $self = shift;
|
2007-02-28 13:56:35 +01:00
|
|
|
return $self->_soapCall( 'store', @_ );
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub load {
|
|
|
|
my $self = shift;
|
2017-08-28 18:37:31 +02:00
|
|
|
my $conf = $self->_soapCall( 'getConfig', @_ );
|
|
|
|
|
|
|
|
# Force empty hash that are not converted by SOAP
|
|
|
|
foreach ( keys %{ $conf || {} } ) {
|
|
|
|
if ( $_ =~ /$hashParameters/ ) {
|
|
|
|
$conf->{$_} ||= {};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return $conf;
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
1;
|