Refactoring. Adding soap_url_local parameter.

src/cgi/wwsympa.fcgi.in

@@ -110,7 +110,7 @@ our $session;
 our $plugins;
 my $loop = 0;
-my ($robot, $robot_object);
+my $robot;
 my $ip;
 my $rss;
 my $ajax;
@@ -1034,7 +1034,6 @@ while ($query = new_loop()) {
     undef $param;
     undef $list;
     undef $robot;
-    undef $robot_object;
     undef $ip;
     undef $rss;
     undef $ajax;
@@ -1095,58 +1094,15 @@ while ($query = new_loop()) {
         $log->syslog('debug3', 'Changed Param: %s', $k);
     }
-    ## Parse CGI parameters
-    #    &CGI::ReadParse();
-
     # Determin robot.
     # N.B. As of 6.2.15, the http_host parameter will match with the host name
     # and path locally detected by server.  If remotely detected host name
     # and / or path should be differ, the proxy must adjust them.
-    my $request_host = Sympa::Tools::WWW::get_server_name() || '';
-    my $request_path = $ENV{'REQUEST_URI'} || '';
-    if ($request_host) {
-        my $selected_path = '';
-        foreach my $rid (Sympa::List::get_robots()) {
-            my $local_url = Conf::get_robot_conf($rid, 'http_host');
-            unless ($local_url) {
-                $local_url = Conf::get_robot_conf($rid, 'wwsympa_url');
-            } elsif ($local_url =~ m{\A[-+\w]+:}) {
-                ;
-            } elsif ($local_url =~ m{\A//}) {
-                $local_url = 'http:' . $local_url;
-            } else {
-                $local_url = 'http://' . $local_url;
-            }
-            next unless $local_url;
-
-            my $uri = URI->new($local_url);
-            next
-                unless $uri
-                    and $uri->scheme
-                    and grep { $uri->scheme eq $_ } qw(http https);
-
-            my $host = lc ($uri->host || '');
-            my $path = $uri->path || '/';
-            #FIXME:might need percent-decode hosts and paths
-            next
-                unless $request_host eq $host
-                    and 0 == index $request_path, $path;
-
-            # The longest path wins.
-            ($robot, $selected_path) = ($rid, $path)
-                if length $selected_path < length $path;
-        }
-    }
-    $robot ||= $Conf::Conf{'domain'};
-
-    # Not yet implemented
-    ### Create Robot object
-    #$robot_object = new Robot $robot;
-    ## Default robot
-    if ($robot eq $Conf::Conf{'host'}) {    #FIXME:Use domain.
-        $param->{'default_robot'} = 1;
-    }
+    $robot = Sympa::Tools::WWW::get_robot('http_host', 'wwsympa_url');
+    # Default robot.
+    $param->{'default_robot'} = 1
+        if $robot eq $Conf::Conf{'domain'};
     $ip = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} || 'undef';

src/lib/Conf.pm

@@ -2016,14 +2016,6 @@ sub _infer_server_specific_parameter_values {
         };
     }
 
-    ## Default SOAP URL corresponds to default robot
-    if ($param->{'config_hash'}{'soap_url'}) {
-        my $url = $param->{'config_hash'}{'soap_url'};
-        $url =~ s/^http(s)?:\/\/(.+)$/$2/;
-        $param->{'config_hash'}{'robot_by_soap_url'}{$url} =
-            $param->{'config_hash'}{'domain'};
-    }
-
     return 1;
 }
 
@@ -2105,13 +2097,6 @@ sub _infer_robot_parameter_values {
         $param->{'config_hash'}{'blacklist'}{$action} = 1;
     }
 
-    ## Create a hash to deduce robot from SOAP url
-    if ($param->{'config_hash'}{'soap_url'}) {
-        my $url = $param->{'config_hash'}{'soap_url'};
-        $url =~ s/^http(s)?:\/\/(.+)$/$2/;
-        $Conf{'robot_by_soap_url'}{$url} =
-            $param->{'config_hash'}{'robot_name'};
-    }
     # Hack because multi valued parameters are not available for Sympa 6.1.
     if (defined $param->{'config_hash'}{'automatic_list_families'}) {
         my @families = split ';',

src/lib/Sympa/ConfDef.pm

@@ -84,9 +84,10 @@ our @params = (
         'file'       => 'sympa.conf',
         'edit'       => '1',
     },
-    {   'name'     => 'soap_url',
-        'optional' => '1',
-        'vhost'    => '1',
+    {   'name'       => 'soap_url',
+        'gettext_id' => 'URL of SympaSOAP',
+        'vhost'      => '1',
+        'optional'   => '1',
     },
     {   'name'            => 'process_archive',
         'default'         => 'off',
@@ -1520,11 +1521,16 @@ our @params = (
     },
     # { your_lists_size: not yet implemented. }
     {   'name'       => 'http_host',
-        'gettext_id' => 'URL behind proxy',
+        'gettext_id' => 'URL prefix of WWSympa behind proxy',
         'vhost'      => '1',
         'file'       => 'sympa.conf',
         'optional'   => '1',
     },
+    {   'name'       => 'soap_url_local',
+        'gettext_id' => 'URL of SympaSOAP behind proxy',
+        'vhost'      => '1',
+        'optional'   => '1',
+    },
     {   'name' => 'password_validation',
         'gettext_id' =>
             'The password validation techniques to be used against user passwords that are added to mailing lists. Options come from Data::Password (http://search.cpan.org/~razinf/Data-Password-1.07/Password.pm#VARIABLES)',

src/lib/Sympa/SOAP/Transport.pm

@@ -30,6 +30,7 @@ use SOAP::Transport::HTTP;
 
 use Sympa::Session;
 use Sympa::Tools::File;
+use Sympa::Tools::WWW;
 
 # 'base' pragma doesn't work here
 our @ISA = qw(SOAP::Transport::HTTP::FCGI);
@@ -38,16 +39,9 @@ sub request {
     my $self = shift;
 
     if (my $request = $_[0]) {
-
-        ## Select appropriate robot
-        if ($Conf::Conf{'robot_by_soap_url'}
-            {$ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'}}) {
-            $ENV{'SYMPA_ROBOT'} =
-                $Conf::Conf{'robot_by_soap_url'}
-                {$ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'}};
-        } else {
-            $ENV{'SYMPA_ROBOT'} = $Conf::Conf{'host'};
-        }
+        # Select appropriate robot.
+        $ENV{'SYMPA_ROBOT'} =
+            Sympa::Tools::WWW::get_robot('soap_url_local', 'soap_url');
 
         ## Empty cache of the List.pm module
         Sympa::List::init_list_cache();

src/lib/Sympa/Tools/WWW.pm

@@ -31,12 +31,14 @@ use strict;
 use warnings;
 use English qw(-no_match_vars);
 use File::Path qw();
+use URI;
 
 use Sympa;
 use Conf;
 use Sympa::ConfDef;
 use Sympa::Constants;
 use Sympa::Language;
+use Sympa::List;
 use Sympa::LockedFile;
 use Sympa::Log;
 use Sympa::Regexps;
@@ -220,11 +222,59 @@ sub get_my_url {
         . $original_path_info;
 }
 
+# Determine robot.
+sub get_robot {
+    my @keys = @_;
+
+    my $request_host = _get_server_name();
+    my $request_path = $ENV{'REQUEST_URI'} || '';
+    my $robot_id;
+
+    if (defined $request_host and length $request_host) {
+        my $selected_path = '';
+        foreach my $rid (Sympa::List::get_robots()) {
+            my $local_url;
+            foreach my $key (@keys) {
+                $local_url = Conf::get_robot_conf($rid, $key);
+                last if $local_url;
+            }
+            next unless $local_url;
+
+            if ($local_url =~ m{\A[-+\w]+:}) {
+                ;
+            } elsif ($local_url =~ m{\A//}) {
+                $local_url = 'http:' . $local_url;
+            } else {
+                $local_url = 'http://' . $local_url;
+            }
+
+            my $uri = URI->new($local_url);
+            next
+                unless $uri
+                    and $uri->scheme
+                    and grep { $uri->scheme eq $_ } qw(http https);
+
+            my $host = lc ($uri->host || '');
+            my $path = $uri->path || '/';
+            #FIXME:might need percent-decode hosts and/or paths
+            next
+                unless $request_host eq $host
+                    and 0 == index $request_path, $path;
+
+            # The longest path wins.
+            ($robot_id, $selected_path) = ($rid, $path)
+                if length $selected_path < length $path;
+        }
+    }
+
+    return (defined $robot_id) ? $robot_id : $Conf::Conf{'domain'};
+}
+
 # Old name: (part of) get_header_field() in wwsympa.fcgi.
 # NOTE: As of 6.2.15, less trustworthy "X-Forwarded-Server:" request field is
 # _no longer_ referred and this function returns only locally detected server
 # name.
-sub get_server_name {
+sub _get_server_name {
     my $server = $ENV{SERVER_NAME};
     return undef unless defined $server and length $server;