[feature] New robot parameter "allowed_external_origin" to defined external...

[feature] New robot parameter "allowed_external_origin" to defined external links allowed to be included in sanitized HTML.

src/lib/Sympa/ConfDef.pm

@@ -411,6 +411,15 @@ our @params = (
         'default'      => 10240,     ## 10 kiB,
         'vhost'        => '1',
     },
+    {   'name'       => 'allowed_external_origin',
+        'gettext_id' => 'Allowed external links in sanitized HTML',
+        'gettext_comment' =>
+            'When the HTML content of a message must be sanitized, links ("href" or "src" attributes) with the hosts listed in this parameter will not be scrubbed. If "*" character is included, it matches any subdomains. Single "*" allows any hosts.',
+        'split_char' => ',',
+        'optional'   => '1',
+        'sample'     => '*.example.org,www.example.com',
+        'vhost'      => '1',
+    },
 
     {   'name'       => 'sympa_packet_priority',
         'gettext_id' => 'Default priority for a packet',

src/lib/Sympa/HTMLSanitizer.pm

@@ -32,6 +32,7 @@ use Scalar::Util qw();
 use URI;
 
 use Sympa;
+use Conf;
 use Sympa::Tools::Text;
 
 # Returns a specialized HTML::StripScripts::Parser object built with the
@@ -48,8 +49,39 @@ sub new {
             EscapeFiltered  => 0,
         }
     );
-    $self->{_shsAllowedOrigin} =
-        URI->new(Sympa::get_url($robot_id))->canonical->authority;
+
+    my @allowed_origins = (
+        Sympa::get_url($robot_id),
+        split /\s*,\s*/,
+        (Conf::get_robot_conf($robot_id, 'allowed_external_origin') || '')
+    );
+    $self->{_shsAllowedOriginRe} = '\A(?:' . join(
+        '|',
+        map {
+            my $uri;
+            unless (defined $_ and length $_) {
+                ;
+            } elsif (m{\A[-+\w]+:}) {
+                $uri = URI->new($_)->canonical;
+            } elsif ($_ =~ m{\A//}) {
+                $uri = URI->new('http:' . $_)->canonical;
+            } else {
+                $uri = URI->new('http://' . $_)->canonical;
+            }
+
+            if ($uri
+                and ($uri->scheme eq 'http' or $uri->scheme eq 'https')) {
+                my $regexp = $uri->authority;
+                # Escape metacharacters except wildcard '*'.
+                $regexp =~
+                    s/([^\s\w\x80-\xFF])/($1 eq '*') ? '.*' : "\\$1"/eg;
+
+                ($regexp);
+            } else {
+                ();
+            }
+            } @allowed_origins
+    ) . ')\z';
 
     return $self;
 }
@@ -64,7 +96,7 @@ sub validate_src_attribute {
     # URLs with the same host etc.
     return $text if $uri->scheme and $uri->scheme eq 'cid';
     return $text unless $uri->authority;
-    return $text if $uri->authority eq $self->{_shsAllowedOrigin};
+    return $text if $uri->authority =~ $self->{_shsAllowedOriginRe};
 
     return undef;
 }