2007-02-24 21:23:17 +01:00
|
|
|
package Lemonldap::NG::Manager::SOAPServer;
|
|
|
|
|
|
|
|
use strict;
|
2009-04-03 18:17:57 +02:00
|
|
|
|
2009-06-29 14:04:43 +02:00
|
|
|
our $VERSION = '0.31';
|
2009-06-08 18:29:13 +02:00
|
|
|
|
2009-04-03 18:17:57 +02:00
|
|
|
die 'This module is now obsolete. You have to use the portal as "proxy".
|
|
|
|
See http://wiki.lemonldap.ow2.org/xwiki/bin/view/NG/DocSOAP';
|
2009-06-29 11:42:44 +02:00
|
|
|
|
2007-02-24 21:23:17 +01:00
|
|
|
use SOAP::Transport::HTTP;
|
2009-02-03 10:36:13 +01:00
|
|
|
use Lemonldap::NG::Common::Conf; #link protected config Configuration hash reference
|
2007-02-28 13:56:35 +01:00
|
|
|
use UNIVERSAL qw(isa);
|
2007-02-24 21:23:17 +01:00
|
|
|
|
2008-02-08 17:56:42 +01:00
|
|
|
our $VERSION = "0.3";
|
2007-02-24 21:23:17 +01:00
|
|
|
|
2007-02-28 13:56:35 +01:00
|
|
|
# Initialization
|
2007-02-24 21:23:17 +01:00
|
|
|
|
2007-02-28 13:56:35 +01:00
|
|
|
sub new {
|
|
|
|
my ( $class, @args ) = @_;
|
|
|
|
my $self;
|
|
|
|
if ( ref( $args[0] ) ) {
|
|
|
|
$self = $args[0];
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
%$self = @args;
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
2007-02-28 13:56:35 +01:00
|
|
|
bless $self, $class;
|
|
|
|
# Arguments verification
|
2007-02-28 23:36:19 +01:00
|
|
|
if( $self->{type} eq 'sessions' ) {
|
|
|
|
unless( $self->{realSessionStorage} ) {
|
|
|
|
die qq/The "realSessionStorage" parameter is required/;
|
2007-02-28 13:56:35 +01:00
|
|
|
return ();
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
2007-02-28 23:36:19 +01:00
|
|
|
eval "use " . $self->{realSessionStorage};
|
|
|
|
die $@ if($@);
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
unless ( $self->{configStorage} ) {
|
|
|
|
die qq/The "configStorage" parameter is required\n/;
|
|
|
|
return ();
|
|
|
|
}
|
2008-11-17 17:59:56 +01:00
|
|
|
$self->{config} = Lemonldap::NG::Common::Conf->new( $self->{configStorage} );
|
2007-02-28 23:36:19 +01:00
|
|
|
die "Configuration not loaded" unless $self->{config};
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
2007-02-28 13:56:35 +01:00
|
|
|
return $self;
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
2007-02-28 23:36:19 +01:00
|
|
|
sub init {
|
|
|
|
my $self = shift;
|
|
|
|
if( $self->{type} eq 'sessions' ) {
|
2007-05-06 16:41:30 +02:00
|
|
|
$Lemonldap::NG::Manager::SOAPService::Sessions::authorizedFunctions =
|
|
|
|
$self->{AuthorizedFunctions} || 'get';
|
2007-02-28 23:36:19 +01:00
|
|
|
$Lemonldap::NG::Manager::SOAPService::Sessions::config = $self;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$Lemonldap::NG::Manager::SOAPService::Config::config = $self->{config};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2007-02-28 13:56:35 +01:00
|
|
|
# Main process
|
|
|
|
|
|
|
|
*process = \&start;
|
|
|
|
|
|
|
|
sub start {
|
2007-02-28 23:36:19 +01:00
|
|
|
my $self;
|
2007-02-28 13:56:35 +01:00
|
|
|
if ( ref( $_[0] ) and isa( $_[0], __PACKAGE__ ) ) {
|
2007-02-28 23:36:19 +01:00
|
|
|
$self = shift;
|
2007-02-28 13:56:35 +01:00
|
|
|
}
|
|
|
|
else {
|
2007-02-28 23:36:19 +01:00
|
|
|
$self = shift->new(@_);
|
2007-02-28 13:56:35 +01:00
|
|
|
}
|
2007-02-28 23:36:19 +01:00
|
|
|
$self->init();
|
|
|
|
my $service = ($self->{type} eq 'sessions')
|
|
|
|
? 'Lemonldap::NG::Manager::SOAPService::Sessions'
|
|
|
|
: 'Lemonldap::NG::Manager::SOAPService::Config';
|
|
|
|
SOAP::Transport::HTTP::CGI->dispatch_to($service)->handle;
|
2007-02-28 13:56:35 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
# Description of SOAP service
|
2007-02-28 23:36:19 +01:00
|
|
|
package Lemonldap::NG::Manager::SOAPService::Config;
|
2007-02-28 13:56:35 +01:00
|
|
|
|
|
|
|
our $config;
|
2007-02-24 21:23:17 +01:00
|
|
|
|
|
|
|
sub available {
|
2007-02-28 13:56:35 +01:00
|
|
|
shift;
|
|
|
|
my @t = $config->available(@_);
|
|
|
|
return \@t;
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub lastCfg {
|
2007-02-28 13:56:35 +01:00
|
|
|
shift;
|
|
|
|
return $config->lastCfg(@_);
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub store {
|
2007-02-28 13:56:35 +01:00
|
|
|
shift;
|
|
|
|
return $config->store(@_);
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub load {
|
2007-02-28 13:56:35 +01:00
|
|
|
shift;
|
|
|
|
return $config->load(@_);
|
2007-02-24 21:23:17 +01:00
|
|
|
}
|
|
|
|
|
2007-02-28 23:36:19 +01:00
|
|
|
package Lemonldap::NG::Manager::SOAPService::Sessions;
|
|
|
|
|
|
|
|
our $config;
|
2007-05-06 16:41:30 +02:00
|
|
|
our $authorizedFunctions = 'get';
|
2007-02-28 23:36:19 +01:00
|
|
|
|
|
|
|
sub newsession {
|
2007-05-06 16:41:30 +02:00
|
|
|
unless( $authorizedFunctions =~ /\bnew\b/ ) {
|
|
|
|
print STDERR "Lemonldap::NG::Manager::SOAPService: 'new' is not authorized. Set 'AuthorizedFunctions' parameter if needed.\n";
|
|
|
|
return 0;
|
|
|
|
}
|
2007-03-18 19:33:38 +01:00
|
|
|
my( $class, $args ) = @_;
|
|
|
|
$args ||= {};
|
2007-02-28 23:36:19 +01:00
|
|
|
my %h;
|
|
|
|
eval {
|
|
|
|
tie %h, $config->{realSessionStorage}, undef, $config->{realSessionStorageOptions};
|
|
|
|
};
|
2007-05-06 16:41:30 +02:00
|
|
|
if ($@) {
|
|
|
|
print STDERR "Lemonldap::NG::Manager::SOAPService: $@\n";
|
|
|
|
return 0;
|
|
|
|
}
|
2007-02-28 23:36:19 +01:00
|
|
|
$h{$_} = $args->{$_} foreach ( keys %{ $args } );
|
|
|
|
$h{_utime} = time();
|
|
|
|
$args->{$_} = $h{$_} foreach ( keys %h );
|
|
|
|
untie %h;
|
|
|
|
return $args;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub get {
|
2007-05-06 16:41:30 +02:00
|
|
|
return 0 unless( $authorizedFunctions =~ /\bget\b/ );
|
2007-03-18 19:33:38 +01:00
|
|
|
my( $class, $id ) = @_;
|
|
|
|
my %h;
|
2007-02-28 23:36:19 +01:00
|
|
|
eval {
|
|
|
|
tie %h, $config->{realSessionStorage}, $id, $config->{realSessionStorageOptions};
|
|
|
|
};
|
2008-01-15 10:23:06 +01:00
|
|
|
if ($@) {
|
|
|
|
print STDERR "Lemonldap::NG::Manager::SOAPService: $@\n";
|
|
|
|
return 0;
|
|
|
|
}
|
2007-02-28 23:36:19 +01:00
|
|
|
my $args;
|
|
|
|
$args->{$_} = $h{$_} foreach ( keys %h );
|
|
|
|
untie %h;
|
|
|
|
return $args;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub set {
|
2007-05-06 16:41:30 +02:00
|
|
|
return 0 unless( $authorizedFunctions =~ /\bset\b/ );
|
2007-02-28 23:36:19 +01:00
|
|
|
my( $class, $id, $args ) = @_;
|
2007-03-18 19:33:38 +01:00
|
|
|
my %h;
|
2007-02-28 23:36:19 +01:00
|
|
|
eval {
|
2008-01-15 10:23:06 +01:00
|
|
|
tie %h, $config->{realSessionStorage}, $id, $config->{realSessionStorageOptions};
|
2007-02-28 23:36:19 +01:00
|
|
|
};
|
2008-01-15 10:23:06 +01:00
|
|
|
if ($@) {
|
|
|
|
print STDERR "Lemonldap::NG::Manager::SOAPService: $@\n";
|
|
|
|
return 0;
|
|
|
|
}
|
2007-02-28 23:36:19 +01:00
|
|
|
$h{$_} = $args->{$_} foreach ( keys %{ $args } );
|
|
|
|
untie %h;
|
|
|
|
return $args;
|
|
|
|
}
|
|
|
|
|
2008-01-16 11:47:50 +01:00
|
|
|
sub delete {
|
|
|
|
return 0 unless( $authorizedFunctions =~ /\bdelete\b/ );
|
|
|
|
my( $class, $id ) = @_;
|
|
|
|
my %h;
|
|
|
|
eval {
|
|
|
|
tie %h, $config->{realSessionStorage}, $id, $config->{realSessionStorageOptions};
|
|
|
|
};
|
|
|
|
if ($@) {
|
|
|
|
print STDERR "Lemonldap::NG::Manager::SOAPService: $@\n";
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
tied(%h)->delete;
|
|
|
|
}
|
|
|
|
|
2007-02-24 21:23:17 +01:00
|
|
|
1;
|
|
|
|
__END__
|
2007-02-28 13:56:35 +01:00
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
2009-06-29 11:42:44 +02:00
|
|
|
Lemonldap::NG::Manager::SOAPServer - Obsolete : now SOAP services are included
|
|
|
|
in the Lemonldap::NG portal.
|
2007-02-28 13:56:35 +01:00
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
2009-06-29 11:42:44 +02:00
|
|
|
This module is obsolete. Now, use the portal.
|
2007-02-28 13:56:35 +01:00
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
2009-06-29 11:42:44 +02:00
|
|
|
L<Lemonldap::NG::Portal>,
|
2007-02-28 13:56:35 +01:00
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
|
|
|
Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
|
|
|
|
2007-04-14 15:12:11 +02:00
|
|
|
=head1 BUG REPORT
|
|
|
|
|
|
|
|
Use OW2 system to report bug or ask for features:
|
|
|
|
L<http://forge.objectweb.org/tracker/?group_id=274>
|
|
|
|
|
|
|
|
=head1 DOWNLOAD
|
|
|
|
|
|
|
|
Lemonldap::NG is available at
|
|
|
|
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
|
|
|
|
2007-02-28 13:56:35 +01:00
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
|
|
|
Copyright (C) 2007 by Xavier Guimard
|
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.8 or,
|
|
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
|
|
|
|
=cut
|