Merge pull request #516 from ikedas/issue-461-addition-trial5 by ikedas

Improving data sources

cpanfile

@@ -250,7 +250,7 @@ feature 'Encode::Locale', 'Useful when running command line utilities in the con
 };
 
 feature 'remote-list-including', 'Required when including members of a remote list.' => sub {
-    requires 'IO::Socket::SSL', '>= 0.90';
+    requires 'LWP::Protocol::https';
 };
 
 feature 'Mail::DKIM::Verifier', 'Required in order to use DKIM features (both for signature verification and signature insertion).' => sub {
@@ -269,10 +269,17 @@ feature 'ldap', 'Required to query LDAP directories. Sympa can do LDAP-based aut
     # openldap-devel is needed to build the Perl code
     requires 'Net::LDAP', '>= 0.40';
 
-    # Note: 'Net::LDAP::Entry', 'Net::LDAP::Util' and 'Net::LDAPS' are also
+    # Note: 'Net::LDAP::Entry' and 'Net::LDAP::Util' are also
     #   included in perl-ldap.
 };
 
+feature 'ldap-secure', 'Required to query LDAP directories over TLS.' => sub {
+    requires 'Net::LDAP', '>= 0.40';
+    requires 'IO::Socket::SSL', '>= 0.90';
+
+    # Note: 'Net::LDAPS' is also included in perl-ldap.
+};
+
 feature 'Net::SMTP', 'This is required if you set "list_check_smtp" sympa.conf parameter, used to check existing aliases before mailing list creation.' => sub {
     requires 'Net::SMTP';
 };

default/web_tt2/edit.tt2

@@ -24,7 +24,7 @@
         <div class="row">
             [% FOREACH kS = pS.format ~%]
                 [% NEXT UNLESS kS.privilege == 'read' || kS.privilege == 'write' ~%]
-                [% IF kS.name == 'subscribed' || kS.name == 'included' || kS.name == 'id' ~%]
+                [% IF kS.name == 'subscribed' || kS.name == 'inclusion' || kS.name == 'inclusion_ext' ~%]
                     [% NEXT %] [%~# FIXME %]
                 [%~ END %]
 

default/web_tt2/subscriber_table.tt2

@@ -155,14 +155,14 @@
                             [%|optdesc('reception')%][% u.reception %][%END%]
                         </td>
                         <td>
-                            [% IF u.subscribed %]
-                                [% IF u.included %]
-                                    [%|loc%]subscribed[%END%]<br />[% u.sources %]
-                                [% ELSE %]
-                                    [%|loc%]subscribed[%END%]
-                                [% END %]
-                            [% ELSE %]
-                                [% u.sources %]
+                            [% IF u.subscribed %][%|loc%]subscribed[%END%][% END ~%]
+                            [% IF u.subscribed && u.inclusion.defined() %]<br />[% END ~%]
+                            [% IF u.inclusion.defined() ~%]
+                                [% IF u.inclusion_label ~%]
+                                    [% u.inclusion_label %]
+                                [%~ ELSE ~%]
+                                    [%|loc%]included[%END%]
+                                [%~ END %]
                             [% END %]
                         </td>
                         <td>

src/cgi/wwsympa.fcgi.in

@@ -4752,7 +4752,6 @@ sub _review_member {
     my @users;
     my $size;
     my $sortby = lc($in{'sortby'} || 'email');
-    my %sources;
     ## Access control
     return undef unless defined check_authz('do_review', 'review');
@@ -4846,7 +4845,7 @@ sub _review_member {
     }
     foreach my $i (@members) {
         # Add user
-        _prepare_subscriber($i, \@additional_fields, \%sources);
+        _prepare_subscriber($i, \@additional_fields);
         push @{$param->{'members'}}, $i;
     }
@@ -5032,7 +5031,6 @@ sub do_show_exclude {
 sub do_search {
     wwslog('info', '(%s)', $in{'filter'});
-    my %sources;
     my %emails;
     ## Additional DB fields
@@ -5074,7 +5072,7 @@ sub do_search {
         }
         ## Add user
-        _prepare_subscriber($i, \@additional_fields, \%sources);
+        _prepare_subscriber($i, \@additional_fields);
         $record++;
         push @{$param->{'members'}}, $i;
@@ -15169,22 +15167,15 @@ sub do_search_user {
             }
             if ($role eq 'member') {
-                $param->{'which'}{$l}{'is_member'} = 1;
-                $param->{'which'}{$l}{'reception'} =
-                    $list->{'user'}{'reception'};
-                $param->{'which'}{$l}{'include_source'} =
-                    $list->{'user'}{'include_source'};
-                $param->{'which'}{$l}{'bounce'} = $list->{'user'}{'bounce'};
-                $param->{'which'}{$l}{'topic'}  = $list->{'user'}{'topic'};
-                $param->{'which'}{$l}{'included'} =
-                    $list->{'user'}{'included'}
-                    if ($list->{'user'}{'included'} == 1);
-                $param->{'which'}{$l}{'subscribed'} =
-                    $list->{'user'}{'subscribed'}
-                    if ($list->{'user'}{'subscribed'} == 1);
-                my $un = $list->{'user'}{'subscribed'};
-#		 $param->{'which'}{$l}{'subscribed'} = 1;
-
+                $param->{'which'}{$l}{'is_member'}  = 1;
+                $param->{'which'}{$l}{'subscribed'} = 1
+                    if $list->{'user'}{'subscribed'};
+                my @keys = qw(reception bounce topic);
+                @{$param->{'which'}{$l}}{@keys} = @{$list->{'user'}}{@keys};
+
+                # Compat. <= 6.2.44
+                $param->{'which'}{$l}{'included'} = 1
+                    if defined $list->{'user'}{'inclusion'};
             } elsif ($role eq 'owner') {
                 $param->{'which'}{$l}{'is_owner'} = 1;
             } elsif ($role eq 'editor') {
@@ -16792,16 +16783,15 @@ sub do_lca {
 sub _prepare_subscriber {
     my $user              = shift;
     my $additional_fields = shift;
-    my $sources           = shift;
-    ## Add user
+    #FIXME: don't overwrite.
     $user->{'date'} =
-        $language->gettext_strftime("%d %b %Y", localtime($user->{'date'}));
+        $language->gettext_strftime("%d %b %Y", localtime $user->{'date'});
     $user->{'update_date'} =
         $language->gettext_strftime("%d %b %Y",
-        localtime($user->{'update_date'}));
-    ## Reception mode and topics
+        localtime $user->{'update_date'});
+    # Reception mode and topics.
     $user->{'reception'} ||= 'mail';
     if (($user->{'reception'} eq 'mail') && $user->{'topics'}) {
         $user->{'reception'} =
@@ -16812,10 +16802,6 @@ sub _prepare_subscriber {
     $user->{'domain'}       = $1;
     $user->{'pictures_url'} = $list->find_picture_url($user->{'email'});
-    ## Check data sources
-    $user->{'sources'} = $list->get_datasource_name($user->{'id'})
-        if ($user->{'id'});
-
     if (@{$additional_fields}) {
         my @fields;
         foreach my $f (@{$additional_fields}) {
@@ -16824,6 +16810,12 @@ sub _prepare_subscriber {
         $user->{'additional'} = join ',', @fields;
     }
+    # Compat. <= 6.2.44
+    if (defined $user->{'inclusion'}) {
+        $user->{'included'} = 1;
+        $user->{'sources'}  = $language->gettext('included');
+    }
+
     return 1;
 }

src/lib/Makefile.am

@@ -55,7 +55,14 @@ nobase_modules_DATA = \
 	Sympa/DatabaseDriver/PostgreSQL.pm \
 	Sympa/DatabaseDriver/SQLite.pm \
 	Sympa/DatabaseManager.pm \
-	Sympa/Datasource.pm \
+	Sympa/DataSource.pm \
+	Sympa/DataSource/File.pm \
+	Sympa/DataSource/LDAP.pm \
+	Sympa/DataSource/LDAP2.pm \
+	Sympa/DataSource/List.pm \
+	Sympa/DataSource/RemoteDump.pm \
+	Sympa/DataSource/RemoteFile.pm \
+	Sympa/DataSource/SQL.pm \
 	Sympa/Family.pm \
 	Sympa/HTML/FormatText.pm \
 	Sympa/HTMLDecorator.pm \
@@ -94,6 +101,7 @@ nobase_modules_DATA = \
 	Sympa/Request/Handler/global_signoff.pm \
 	Sympa/Request/Handler/help.pm \
 	Sympa/Request/Handler/import.pm \
+	Sympa/Request/Handler/include.pm \
 	Sympa/Request/Handler/index.pm \
 	Sympa/Request/Handler/info.pm \
 	Sympa/Request/Handler/invite.pm \

src/lib/Sympa/DataSource.pm

+# -*- indent-tabs-mode: nil; -*-
+# vim:ft=perl:et:sw=4
+# $Id$
+
+# Sympa - SYsteme de Multi-Postage Automatique
+#
+# Copyright 2019 The Sympa Community. See the AUTHORS.md file at
+# the top-level directory of this distribution and at
+# <https://github.com/sympa-community/sympa.git>.
+#
+# 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 <http://www.gnu.org/licenses/>.
+
+package Sympa::DataSource;
+
+use strict;
+use warnings;
+use Digest::MD5 qw();
+use English qw(-no_match_vars);
+
+use Sympa;
+use Sympa::Log;
+use Sympa::Regexps;
+use Sympa::Tools::Text;
+
+my $log = Sympa::Log->instance;
+
+sub required_modules { [] }
+
+sub new {
+    $log->syslog('debug2', '%s,%s,%s,...');
+    my $class   = shift;
+    my $type    = shift;
+    my $role    = shift;
+    my %options = @_;
+
+    return undef unless $type;
+    return undef if $type =~ /[^\w:]/;
+
+    # Load appropriate subclasses.
+    $type = sprintf 'Sympa::DataSource::%s', $type unless $type =~ /::/;
+    unless (eval sprintf('require %s', $type)
+        and $type->isa('Sympa::DataSource')) {
+        $log->syslog('err', 'Unable to use %s module: %s',
+            $type, $EVAL_ERROR || 'Not a Sympa::DataSource class');
+        return undef;
+    }
+
+    my $list = $options{context};
+    if (grep { $role eq $_ } qw(member owner editor)) {
+        die 'bug in logic. Ask developer' unless ref $list eq 'Sympa::List';
+    }
+
+    # Get default user options.
+    my ($defopts, @required);
+    if ($options{default_user_options}) {
+        $defopts  = $options{default_user_options};
+        @required = qw(reception visibility);
+    } elsif ($role eq 'member') {
+        $defopts  = $list->{'admin'}{'default_user_options'};
+        @required = qw(reception visibility);
+    } elsif ($role eq 'owner') {
+        my @keys = qw(visibility reception profile info);
+        @{$defopts}{@keys} = @options{@keys};
+        @required = qw(reception visibility profile);
+    } elsif ($role eq 'editor') {
+        my @keys = qw(visibility reception info);
+        @{$defopts}{@keys} = @options{@keys};
+        @required = qw(reception visibility);
+    }
+    # Complement required attributes.
+    #FIXME: check not only existence but also validity of values
+    if (@required) {
+        my $defdefs = {
+            reception  => 'mail',
+            visibility => 'noconceal',
+            profile    => 'normal',
+        };
+        my @missing =
+            grep { not(defined $defopts->{$_} and length $defopts->{$_}) }
+            @required;
+        @{$defopts}{@missing} = @{$defdefs}{@missing} if @missing;
+    }
+    my @defkeys = sort keys %{$defopts || {}};
+    my @defvals = @{$defopts || {}}{@defkeys} if @defkeys;
+
+    return $type->_new(
+        %options,
+        _role    => $role,
+        _defkeys => [@defkeys],
+        _defvals => [@defvals],
+    );
+}
+
+sub _new {
+    my $class   = shift;
+    my %options = @_;
+
+    return bless {%options} => $class;
+}
+
+sub open {
+    my $self = shift;
+
+    # Check if required module such as DBD is installed.
+    foreach my $module (@{$self->required_modules}) {
+        unless (eval "require $module") {
+            $log->syslog(
+                'err',
+                'A module for %s is not installed. You should download and install %s',
+                ref($self),
+                $module
+            );
+            Sympa::send_notify_to_listmaster('*', 'missing_dbd',
+                {db_type => ref($self), db_module => $module});
+            return undef;
+        }
+    }
+
+    my $dsh = $self->_open;
+    return undef unless $dsh;
+    $self->{_ds} = $dsh if ref $dsh;
+
+    return $dsh;
+}
+
+sub _open {1}
+
+sub __dsh { shift->{_ds}; }
+
+sub next {
+    my $self = shift;
+
+    while (1) {
+        my $entry =
+            ($self->role eq 'custom_attribute')
+            ? $self->_next_ca
+            : $self->_next;
+        last unless $entry;
+
+        my ($email, $other_value) = @$entry;
+        next unless defined $email and length $email;
+        unless (Sympa::Tools::Text::valid_email($email)) {
+            $log->syslog('err', 'Skip badly formed email address: "%s"',
+                $email);
+            next;
+        }
+        $email = Sympa::Tools::Text::canonic_email($email);
+
+        if ($self->role eq 'custom_attribute') {
+            next unless ref $other_value eq 'HASH' and %$other_value;
+        }
+
+        return [$email, $other_value];
+    }
+
+    return;
+}
+
+# _next() and _next_ca() should be implemented explicitly by subclasses.
+
+sub close {
+    my $self = shift;
+
+    $self->_close if ref $self->{_ds};
+    delete $self->{_ds};
+
+    return 1;
+}
+
+sub _close {0}
+
+sub name {
+    my $self = shift;
+
+    return $self->{name} || $self->get_short_id;
+}
+
+sub role {
+    shift->{_role};
+}
+
+# Returns a real unique ID for an include datasource.
+sub get_id {
+    my $self = shift;
+
+    my $context = $self->{context} || '';
+    $context = $context->get_id if ref $context eq 'Sympa::List';
+
+    sprintf 'context=%s;id=%s;role=%s;name=%s', $context,
+        $self->get_short_id, $self->role, ($self->{name} || '');
+}
+
+# Returns a unique ID for an include datasource.
+# Old name: Sympa::Datasource::_get_datasource_id().
+sub get_short_id {
+    my $self = shift;
+
+    my @items = map { ($_, $self->{$_}) } sort grep {
+                defined $_
+            and length $_
+            and !/\A_/
+            and !ref $self->{$_}    # Omit context
+            and defined $self->{$_}
+            and length $self->{$_}
+            and !/passw(or)?d/
+            and !/\Aname\z/
+    } keys %$self;
+
+    return substr Digest::MD5::md5_hex(join ',', @items), -8;
+}
+
+sub is_allowed_to_sync {
+    my $self = shift;
+
+    my $ranges = $self->{nosync_time_ranges};
+    return 1 unless defined $ranges and length $ranges;
+
+    $ranges =~ s/^\s+//;
+    $ranges =~ s/\s+$//;
+    my $rsre = Sympa::Regexps::time_ranges();
+    return 1 unless ($ranges =~ /^$rsre$/);
+
+    $log->syslog('debug', "Checking whether sync is allowed at current time");
+
+    my ($sec, $min, $hour) = localtime(time);
+    my $now = 60 * int($hour) + int($min);
+
+    foreach my $range (split(/\s+/, $ranges)) {
+        next
+            unless ($range =~
+            /^([012]?[0-9])(?:\:([0-5][0-9]))?-([012]?[0-9])(?:\:([0-5][0-9]))?$/
+            );
+        my $start = 60 * int($1) + int($2);
+        my $end   = 60 * int($3) + int($4);
+        $end += 24 * 60 if ($end < $start);
+
+        $log->syslog('debug',
+                  "Checking for range from "
+                . sprintf('%02d', $start / 60) . "h"
+                . sprintf('%02d', $start % 60) . " to "
+                . sprintf('%02d', ($end / 60) % 24) . "h"
+                . sprintf('%02d', $end % 60));
+
+        next if ($start == $end);
+
+        if ($now >= $start && $now <= $end) {
+            $log->syslog('debug', 'Failed, sync not allowed');
+            return 0;
+        }
+
+        $log->syslog('debug', "Pass ...");
+    }
+
+    $log->syslog('debug', "Sync allowed");
+    return 1;
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Sympa::DataSource - Base class of Sympa data source subclasses
+
+=head1 SYNOPSIS
+
+  # To implemnt Sympa::DataSource::Foo:
+
+  package Sympa::DataSource::Foo;
+
+  use base qw(Sympa::DataSource);
+  
+  sub _open {
+      my $self = shift;
+      ...
+      return $handle;
+  }
+  
+  sub _next {
+      my $self = shift;
+      ...
+      return [$email, $gecos];
+  }
+  
+  1;
+  
+  # To use Sympa::DataSource::Foo:
+  
+  usr Sympa::DataSource;
+  
+  $ds = Sympa::DataSource->new('Foo', 'member', context => $list,
+      key => val, ...);
+  if ($ds and $ds->open) {
+      while (my $member = $ds->next) {
+          ...
+      }
+      $ds->close;
+  }
+
+=head1 DESCRIPTION
+
+TBD.
+
+=head2 Methods
+
+=over
+
+=item new ( $type, $role, context =E<gt> $that, [ I<key> =E<gt> I<val>, ... ] )
+
+I<Constructor>.
+Creates a new instance of L<Sympa::DataSource>.
+
+Parameters:
+
+=over
+
+=item $type
+
+Type of data source.
+This corresponds to impemented subclasses.
+
+=item $role
+
+Role of data source.
+C<'member'>, C<'owner'>, C<'editor'> or C<'custom_attribute'>.
+
+=item context =E<gt> $that
+
+Context. L<Sympa::List> instance and so on.
+
+=item I<key> =E<gt> I<val>, ...
+
+Optional or mandatory parameters.
+
+=back
+
+Returns:
+
+A new instance, or C<undef> on failure.
+
+=item close ( )
+
+I<Instance method>.
+Closes backend and does cleanup.
+
+=item next ( )
+
+I<Instance method>.
+Returns the next entry in data source.
+Data source should have been opened.
+
+=item open ( )
+
+I<Instance method>.
+Opens backend and returns handle.
+
+=item get_id ( )
+
+I<Instance method>.
+Gets unique ID of the instance.
+
+=item get_short_id ( )
+
+I<Instance method>.
+Gets data source ID, a hexadecimal string with 8 columns.
+
+=item name ( )
+
+I<Instance method>.
+Gets human-readable name of data source.
+Typically it is value of {name} attribute or result of get_short_id().
+
+=item role ( )
+
+I<Instance method>.
+Returns $role set by new().
+
+=item __dsh ( )
+
+I<Instance method>, I<protected>.
+Returns native query handle which L<_open>() returned.
+This may be used only at inside of each subclass.
+
+=back
+
+=head2 Methods subclass should implement
+
+=over
+
+=item required_modules
+
+I<Class or instance method>.
+TBD.
+
+=item _open ( [ options... ] )
+
+I<Instance mthod>.
+TBD.
+
+=item _next ( [ options... ] )
+
+I<Instance method>, I<mandatory>.
+TBD.
+
+=item _next_ca ( [ options... ] )
+
+I<Instance method>, I<mandatory> if the data source supports custom attribute.
+TBD.
+
+=item _close (  )
+
+I<Instance method>.
+TBD.
+
+=back
+
+=head2 Attributes
+
+=over
+
+=item {context}
+
+Context of the data source set by new().
+