diff --git a/src/cgi/sympa_soap_server.fcgi.in b/src/cgi/sympa_soap_server.fcgi.in index 0ed8b976d..e963d9bb6 100644 --- a/src/cgi/sympa_soap_server.fcgi.in +++ b/src/cgi/sympa_soap_server.fcgi.in @@ -9,8 +9,8 @@ # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER -# Copyright 2017, 2018, 2019 The Sympa Community. See the AUTHORS.md file at -# the top-level directory of this distribution and at +# Copyright 2017, 2018, 2019, 2023 The Sympa Community. See the +# AUTHORS.md file at the top-level directory of this distribution and at # . # # This program is free software; you can redistribute it and/or modify @@ -39,7 +39,7 @@ use Sympa::List; use Sympa::Log; use Sympa::Spool::Listmaster; use Sympa::WWW::SOAP; -use Sympa::WWW::SOAP::Transport; +use Sympa::WWW::SOAP::FastCGI; ## Load sympa config unless (Conf::load()) { @@ -81,8 +81,7 @@ my $all_lists = Sympa::List::get_lists('*'); # Soap part ############################################################################## -Sympa::WWW::SOAP::Transport->new( - cookie_expire => $Conf::Conf{'cookie_expire'}) +Sympa::WWW::SOAP::FastCGI->new(cookie_expire => $Conf::Conf{'cookie_expire'}) ->dispatch_with({'urn:sympasoap' => 'Sympa::WWW::SOAP'})->handle; __END__ diff --git a/src/lib/Makefile.am b/src/lib/Makefile.am index b4120da6c..1d5e67389 100644 --- a/src/lib/Makefile.am +++ b/src/lib/Makefile.am @@ -6,7 +6,7 @@ # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER -# Copyright 2017, 2018, 2019, 2021, 2022 The Sympa Community. See the +# Copyright 2017, 2018, 2019, 2021, 2022, 2023 The Sympa Community. See the # AUTHORS.md file at the top-level directory of this distribution and at # . # @@ -233,7 +233,8 @@ nonCLI_modules = \ Sympa/WWW/SharedDocument.pm \ Sympa/WWW/Session.pm \ Sympa/WWW/SOAP.pm \ - Sympa/WWW/SOAP/Transport.pm \ + Sympa/WWW/SOAP/FastCGI.pm \ + Sympa/WWW/SOAP/Lite.pm \ Sympa/WWW/Tools.pm nobase_modules_DATA = $(CLI_modules) $(nonCLI_modules) diff --git a/src/lib/Sympa/WWW/SOAP.pm b/src/lib/Sympa/WWW/SOAP.pm index e08fd454f..f21d56974 100644 --- a/src/lib/Sympa/WWW/SOAP.pm +++ b/src/lib/Sympa/WWW/SOAP.pm @@ -8,7 +8,7 @@ # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER -# Copyright 2017, 2018, 2019, 2020, 2021 The Sympa Community. See the +# Copyright 2017, 2018, 2019, 2020, 2021, 2023 The Sympa Community. See the # AUTHORS.md file at the top-level directory of this distribution and at # . # @@ -73,7 +73,8 @@ sub checkCookie { $log->syslog('debug', 'SOAP checkCookie'); - return SOAP::Data->name('result')->type('string')->value($sender); + return Sympa::WWW::SOAP::Data->name('result')->type('string') + ->value($sender); } sub lists { @@ -144,7 +145,7 @@ sub lists { } } - return SOAP::Data->name('listInfo')->value(\@result); + return Sympa::WWW::SOAP::Data->name('listInfo')->value(\@result); } sub login { @@ -200,7 +201,7 @@ sub login { $ENV{'SESSION_ID'} = $session->{'id_session'}; ## Also return the cookie value - return SOAP::Data->name('result')->type('string') + return Sympa::WWW::SOAP::Data->name('result')->type('string') ->value($ENV{SESSION_ID}); } @@ -286,7 +287,7 @@ sub casLogin { $ENV{'SESSION_ID'} = $session->{'id_session'}; ## Also return the cookie value - return SOAP::Data->name('result')->type('string') + return Sympa::WWW::SOAP::Data->name('result')->type('string') ->value($ENV{SESSION_ID}); } @@ -353,7 +354,7 @@ sub getUserEmailByCookie { ->faultstring('Could not get email from cookie')->faultdetail(''); } - return SOAP::Data->name('result')->type('string') + return Sympa::WWW::SOAP::Data->name('result')->type('string') ->value($session->{'email'}); } @@ -442,13 +443,13 @@ sub amI { if ($list) { if ($function eq 'subscriber') { - return SOAP::Data->name('result')->type('boolean') + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') ->value($list->is_list_member($user)); } elsif ($function eq 'editor') { - return SOAP::Data->name('result')->type('boolean') + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') ->value($list->is_admin('actual_editor', $user)); } elsif ($function eq 'owner') { - return SOAP::Data->name('result')->type('boolean') + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') ->value($list->is_admin('owner', $user) || Sympa::is_listmaster($list, $user)); } else { @@ -516,32 +517,34 @@ sub info { my $result_item; $result_item->{'listAddress'} = - SOAP::Data->name('listAddress')->type('string') + Sympa::WWW::SOAP::Data->name('listAddress')->type('string') ->value(Sympa::get_address($list)); $result_item->{'subject'} = - SOAP::Data->name('subject')->type('string') + Sympa::WWW::SOAP::Data->name('subject')->type('string') ->value($list->{'admin'}{'subject'}); $result_item->{'homepage'} = - SOAP::Data->name('homepage')->type('string') + Sympa::WWW::SOAP::Data->name('homepage')->type('string') ->value(Sympa::get_url($list, 'info')); ## determine status of user if ($list->is_admin('owner', $sender) or Sympa::is_listmaster($list, $sender)) { $result_item->{'isOwner'} = - SOAP::Data->name('isOwner')->type('boolean')->value(1); + Sympa::WWW::SOAP::Data->name('isOwner')->type('boolean') + ->value(1); } if ($list->is_admin('actual_editor', $sender)) { $result_item->{'isEditor'} = - SOAP::Data->name('isEditor')->type('boolean')->value(1); + Sympa::WWW::SOAP::Data->name('isEditor')->type('boolean') + ->value(1); } if ($list->is_list_member($sender)) { $result_item->{'isSubscriber'} = - SOAP::Data->name('isSubscriber')->type('boolean')->value(1); + Sympa::WWW::SOAP::Data->name('isSubscriber')->type('boolean') + ->value(1); } - #push @result, SOAP::Data->type('listType')->value($result_item); - return SOAP::Data->value([$result_item]); + return Sympa::WWW::SOAP::Data->value([$result_item]); } $log->syslog('info', 'Info %s from %s aborted, unknown requested action in scenario', @@ -651,13 +654,14 @@ sub createList { die SOAP::Fault->faultcode('Server') ->faultstring('Internal error'); } elsif ($report->[1] eq 'notice') { - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') + ->value(1); } elsif ($report->[1] eq 'user') { die SOAP::Fault->faultcode('Server')->faultstring('Undef') ->faultdetail($reason_string); } } - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } sub closeList { @@ -730,13 +734,14 @@ sub closeList { die SOAP::Fault->faultcode('Server') ->faultstring('Internal error'); } elsif ($report->[1] eq 'notice') { - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') + ->value(1); } elsif ($report->[1] eq 'user') { die SOAP::Fault->faultcode('Server')->faultstring('Undef') ->faultdetail($reason_string); } } - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } sub add { @@ -819,13 +824,14 @@ sub add { die SOAP::Fault->faultcode('Server') ->faultstring('Internal error'); } elsif ($report->[1] eq 'notice') { - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') + ->value(1); } elsif ($report->[1] eq 'user') { die SOAP::Fault->faultcode('Server')->faultstring('Undef') ->faultdetail($reason_string); } } - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } sub del { @@ -901,13 +907,14 @@ sub del { die SOAP::Fault->faultcode('Server') ->faultstring('Internal error'); } elsif ($report->[1] eq 'notice') { - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') + ->value(1); } elsif ($report->[1] eq 'user') { die SOAP::Fault->faultcode('Server')->faultstring('Undef') ->faultdetail($reason_string); } } - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } sub review { @@ -975,9 +982,10 @@ sub review { $log->syslog('err', 'No subscribers in list "%s"', $list->{'name'}); push @resultSoap, - SOAP::Data->name('result')->type('string') + Sympa::WWW::SOAP::Data->name('result')->type('string') ->value('no_subscribers'); - return SOAP::Data->name('return')->value(\@resultSoap); + return Sympa::WWW::SOAP::Data->name('return') + ->value(\@resultSoap); } do { ## Owners bypass the visibility option @@ -987,13 +995,13 @@ sub review { ## Lower case email address $user->{'email'} =~ y/A-Z/a-z/; push @resultSoap, - SOAP::Data->name('item')->type('string') + Sympa::WWW::SOAP::Data->name('item')->type('string') ->value($user->{'email'}); } } while ($user = $list->get_next_list_member()); $log->syslog('info', 'Review %s from %s accepted', $listname, $sender); - return SOAP::Data->name('return')->value(\@resultSoap); + return Sympa::WWW::SOAP::Data->name('return')->value(\@resultSoap); } $log->syslog('info', 'Review %s from %s aborted, unknown requested action in scenario', @@ -1087,7 +1095,7 @@ sub fullReview { $log->syslog('info', 'FullReview %s from %s accepted', $listname, $sender); - return SOAP::Data->name('return')->value(\@result); + return Sympa::WWW::SOAP::Data->name('return')->value(\@result); } sub signoff { @@ -1139,13 +1147,14 @@ sub signoff { die SOAP::Fault->faultcode('Server') ->faultstring('Internal error'); } elsif ($report->[1] eq 'notice') { - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') + ->value(1); } elsif ($report->[1] eq 'user') { die SOAP::Fault->faultcode('Server')->faultstring('Undef') ->faultdetail($reason_string); } } - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } sub subscribe { @@ -1199,13 +1208,14 @@ sub subscribe { die SOAP::Fault->faultcode('Server') ->faultstring('Internal error'); } elsif ($report->[1] eq 'notice') { - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean') + ->value(1); } elsif ($report->[1] eq 'user') { die SOAP::Fault->faultcode('Server')->faultstring('Undef') ->faultdetail($reason_string); } } - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } ## Which list the user is subscribed to @@ -1317,9 +1327,7 @@ sub which { push @result, $listInfo; } -# return SOAP::Data->name('return')->type->('ArrayOfString') -# ->value(\@result); - return SOAP::Data->name('return')->value(\@result); + return Sympa::WWW::SOAP::Data->name('return')->value(\@result); } sub getDetails { @@ -1374,7 +1382,7 @@ sub getDetails { ->faultdetail('Use : '); } - return SOAP::Data->name('return')->value(\%result); + return Sympa::WWW::SOAP::Data->name('return')->value(\%result); } sub setDetails { @@ -1450,7 +1458,7 @@ sub setDetails { ->faultdetail("SOAP setDetails : update user failed") unless $list->update_list_member($sender, %user); - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } sub setCustom { @@ -1491,13 +1499,6 @@ sub setCustom { ->faultdetail('Use : '); } %newcustom = %{$subscriber->{custom_attribute} // {}}; - #if(! defined $list->{'admin'}{'custom_attribute'}{$key} ) { - # return SOAP::Data->name('result')->type('boolean')->value(0); - #} - - # Workaround for possible bug in SOAP::Lite. - Encode::_utf8_off($key); - Encode::_utf8_off($value); if ($value eq '') { undef $newcustom{$key}; @@ -1513,7 +1514,7 @@ sub setCustom { unless $list->update_list_member($sender, custom_attribute => \%newcustom); - return SOAP::Data->name('result')->type('boolean')->value(1); + return Sympa::WWW::SOAP::Data->name('result')->type('boolean')->value(1); } ## Return a structure in SOAP data format @@ -1529,26 +1530,18 @@ sub struct_to_soap { } if ($format eq 'as_string') { - my @all; - my $formated_data; - foreach my $k (keys %$data) { - push @all, Encode::decode_utf8($k . '=' . $data->{$k}); - } - - $formated_data = join ';', @all; - $soap_data = SOAP::Data->type('string')->value($formated_data); + return Sympa::WWW::SOAP::Data->type('string') + ->value(join ';', + map { sprintf '%s=%s', $_, $data->{$_} } keys %$data); } else { - my $formated_data; - foreach my $k (keys %$data) { - $formated_data->{$k} = - SOAP::Data->name($k)->type($types{'listType'}{$k}) - ->value($data->{$k}); - } - - $soap_data = SOAP::Data->value($formated_data); + return Sympa::WWW::SOAP::Data->value( + { map { + ($_ => Sympa::WWW::SOAP::Data->name($_) + ->type($types{listType}{$_})->value($data->{$_})) + } keys %$data + } + ); } - - return $soap_data; } sub get_reason_string { @@ -1579,3 +1572,23 @@ sub get_reason_string { } 1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::WWW::SOAP - Dispatcher for SOAP + +=head1 DESCRIPTION + +TBD. + +=head1 HISTORY + +On Sympa 4.0.a8, the feature of SOAP server was introduced, +and L appeared. +On Sympa 6.2a.41 it was renamed to L, +and on Sympa 6.2.25b.3 renamed to L. + +=cut diff --git a/src/lib/Sympa/WWW/SOAP/Transport.pm b/src/lib/Sympa/WWW/SOAP/FastCGI.pm similarity index 82% rename from src/lib/Sympa/WWW/SOAP/Transport.pm rename to src/lib/Sympa/WWW/SOAP/FastCGI.pm index 741f171de..d4ea65636 100644 --- a/src/lib/Sympa/WWW/SOAP/Transport.pm +++ b/src/lib/Sympa/WWW/SOAP/FastCGI.pm @@ -1,15 +1,10 @@ # -*- indent-tabs-mode: nil; -*- # vim:ft=perl:et:sw=4 -# $Id$ # # Sympa - SYsteme de Multi-Postage Automatique # -# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel -# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, -# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites -# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER -# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level -# directory of this distribution and at +# Copyright 2017, 2023 The Sympa Community. See the +# AUTHORS.md file at the top-level directory of this distribution and at # . # # This program is free software; you can redistribute it and/or modify @@ -25,7 +20,7 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see . -package Sympa::WWW::SOAP::Transport; +package Sympa::WWW::SOAP::FastCGI; use strict; use warnings; @@ -34,6 +29,7 @@ use SOAP::Transport::HTTP; use Sympa::Log; use Sympa::WWW::Session; +use Sympa::WWW::SOAP::Lite; use Sympa::WWW::Tools; # 'base' pragma doesn't work here @@ -46,7 +42,7 @@ sub new { return $class if ref $class; my %options = @_; - my $self = $class->SUPER::new(); + my $self = $class->SUPER::new()->transport('Sympa::WWW::SOAP::Transport'); $self->{_ss_birthday} = [stat $PROGRAM_NAME]->[9] if $PROGRAM_NAME; $self->{_ss_cookie_expire} = $options{cookie_expire} || 0; @@ -135,3 +131,27 @@ sub handle { } 1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::WWW::SOAP::FastCGI - HTTP/FastCGI transport for SOAP + +=head1 DESCRIPTION + +TBD. + +=head1 HISTORY + +On Sympa 4.0.a8, the feature of SOAP server was introduced, +and L appeared. +On Sympa 6.2a.41 it was renamed to L, +on Sympa 6.2.25b.3 renamed to L, +and on Sympa 6.2.73b renamed to L. + +Note that L in current release +is a different module. + +=cut diff --git a/src/lib/Sympa/WWW/SOAP/Lite.pm b/src/lib/Sympa/WWW/SOAP/Lite.pm new file mode 100644 index 000000000..1b32a7f53 --- /dev/null +++ b/src/lib/Sympa/WWW/SOAP/Lite.pm @@ -0,0 +1,112 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 +# +# Sympa - SYsteme de Multi-Postage Automatique +# +# Copyright 2023 The Sympa Community. See the +# AUTHORS.md file at the top-level directory of this distribution and at +# . +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +use strict; +use warnings; +use Encode qw(); +use SOAP::Lite; + +package Sympa::WWW::SOAP::Transport; + +# 'base' pragma doesn't work here +our @ISA = qw(SOAP::Transport); + +sub AUTOLOAD { + our $AUTOLOAD; + + my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2); + return if $method eq 'DESTROY'; + + no strict 'refs'; + *$AUTOLOAD = sub { + shift->proxy->$method( + map { (defined $_ and not ref $_) ? Encode::encode_utf8($_) : $_ } + @_ + ); + }; + goto &$AUTOLOAD; +} + +1; + +package Sympa::WWW::SOAP::Data; + +# 'base' pragma doesn't work here +our @ISA = qw(SOAP::Data); + +sub type { + my $self = shift; + if (@_) { + my ($type, @value) = @_; + + if ($type eq 'string') { + return $self->SUPER::type($type, + map { Encode::decode_utf8($_) } @value); + } + } + + return $self->SUPER::type(@_); +} + +sub value { + my $self = shift; + + if (($self->type // '') eq 'string') { + return $self->SUPER::value(map { Encode::decode_utf8($_) } @_); + } + + return $self->SUPER::value(@_); +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::WWW::SOAP::Lite - Overrides on SOAP::Lite for Sympa + +=head1 DESCRIPTION + +This module provides following subclasses of those in L. + +=over + +=item C + +The C method will decode strings to utf8-flagged ones. + +=item C + +This will encode utf8-flagged parameters to byte-strings and pass them to +dispatched SOAP methods. + +=back + +=head1 HISTORY + +L was introdiced on Sympa 6.2.73b. +Note that, at this time, L +in earlier release was renamed to L. + +=cut