diff --git a/cpanfile b/cpanfile index f4bb0e40f..343c126b7 100644 --- a/cpanfile +++ b/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'; }; diff --git a/default/web_tt2/edit.tt2 b/default/web_tt2/edit.tt2 index ae4196689..c03ade467 100644 --- a/default/web_tt2/edit.tt2 +++ b/default/web_tt2/edit.tt2 @@ -24,7 +24,7 @@
[% 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 %] diff --git a/default/web_tt2/subscriber_table.tt2 b/default/web_tt2/subscriber_table.tt2 index ff435d1cc..bfe3a2aa2 100644 --- a/default/web_tt2/subscriber_table.tt2 +++ b/default/web_tt2/subscriber_table.tt2 @@ -155,14 +155,14 @@ [%|optdesc('reception')%][% u.reception %][%END%] - [% IF u.subscribed %] - [% IF u.included %] - [%|loc%]subscribed[%END%]
[% u.sources %] - [% ELSE %] - [%|loc%]subscribed[%END%] - [% END %] - [% ELSE %] - [% u.sources %] + [% IF u.subscribed %][%|loc%]subscribed[%END%][% END ~%] + [% IF u.subscribed && u.inclusion.defined() %]
[% END ~%] + [% IF u.inclusion.defined() ~%] + [% IF u.inclusion_label ~%] + [% u.inclusion_label %] + [%~ ELSE ~%] + [%|loc%]included[%END%] + [%~ END %] [% END %] diff --git a/src/cgi/wwsympa.fcgi.in b/src/cgi/wwsympa.fcgi.in index a68e1ece5..a0053c74f 100644 --- a/src/cgi/wwsympa.fcgi.in +++ b/src/cgi/wwsympa.fcgi.in @@ -4770,7 +4770,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'); @@ -4869,7 +4868,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; } @@ -5055,7 +5054,6 @@ sub do_show_exclude { sub do_search { wwslog('info', '(%s)', $in{'filter'}); - my %sources; my %emails; ## Additional DB fields @@ -5097,7 +5095,7 @@ sub do_search { } ## Add user - _prepare_subscriber($i, \@additional_fields, \%sources); + _prepare_subscriber($i, \@additional_fields); $record++; push @{$param->{'members'}}, $i; @@ -15124,22 +15122,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') { @@ -16747,16 +16738,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'})); + localtime $user->{'update_date'}); - ## Reception mode and topics + # Reception mode and topics. $user->{'reception'} ||= 'mail'; if (($user->{'reception'} eq 'mail') && $user->{'topics'}) { $user->{'reception'} = @@ -16767,10 +16757,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}) { @@ -16779,6 +16765,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; } diff --git a/src/lib/Makefile.am b/src/lib/Makefile.am index a04f43a27..6c5a8ad48 100644 --- a/src/lib/Makefile.am +++ b/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 \ diff --git a/src/lib/Sympa/DataSource.pm b/src/lib/Sympa/DataSource.pm new file mode 100644 index 000000000..03c7b325d --- /dev/null +++ b/src/lib/Sympa/DataSource.pm @@ -0,0 +1,450 @@ +# -*- 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 +# . +# +# 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 . + +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 $that, [ I =E I, ... ] ) + +I. +Creates a new instance of L. + +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 $that + +Context. L instance and so on. + +=item I =E I, ... + +Optional or mandatory parameters. + +=back + +Returns: + +A new instance, or C on failure. + +=item close ( ) + +I. +Closes backend and does cleanup. + +=item next ( ) + +I. +Returns the next entry in data source. +Data source should have been opened. + +=item open ( ) + +I. +Opens backend and returns handle. + +=item get_id ( ) + +I. +Gets unique ID of the instance. + +=item get_short_id ( ) + +I. +Gets data source ID, a hexadecimal string with 8 columns. + +=item name ( ) + +I. +Gets human-readable name of data source. +Typically it is value of {name} attribute or result of get_short_id(). + +=item role ( ) + +I. +Returns $role set by new(). + +=item __dsh ( ) + +I, I. +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. +TBD. + +=item _open ( [ options... ] ) + +I. +TBD. + +=item _next ( [ options... ] ) + +I, I. +TBD. + +=item _next_ca ( [ options... ] ) + +I, I if the data source supports custom attribute. +TBD. + +=item _close ( ) + +I. +TBD. + +=back + +=head2 Attributes + +=over + +=item {context} + +Context of the data source set by new(). + +=item Others + +The other options set by new() may be accessed as attributes. + +=back + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. +See also L. + +=cut + diff --git a/src/lib/Sympa/DataSource/File.pm b/src/lib/Sympa/DataSource/File.pm new file mode 100644 index 000000000..7939fbf7f --- /dev/null +++ b/src/lib/Sympa/DataSource/File.pm @@ -0,0 +1,140 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::File; + +use strict; +use warnings; + +use Sympa::Log; +use Sympa::Regexps; + +use base qw(Sympa::DataSource); + +my $log = Sympa::Log->instance; + +sub _open { + my $self = shift; + + my $fh; + unless (open $fh, '<', $self->{path}) { + $log->syslog('err', 'Unable to open file "%s": %m', $self->{path}); + return undef; + } + + return $fh; +} + +# Old name: (part of) Sympa::List::_include_users_file(). +sub _next { + my $self = shift; + + my $email_re = Sympa::Regexps::email(); + + my $lines = 0; + my $found = 0; + + my $ifh = $self->__dsh; + while (my $line = <$ifh>) { + chomp $line; + + if (++$lines > 49 and not $found) { + $log->syslog( + 'err', + 'Too much errors in file %s. Source file probably corrupted. Cancelling', + $self->{path} + ); + return undef; + } + + # Empty lines are skipped + next if $line =~ /^\s*$/; + next if $line =~ /^\s*\#/; + + # Skip badly formed emails. + unless ($line =~ /\A\s*($email_re)(?:\s+(\S.*))?\z/) { + $log->syslog('err', 'Skip badly formed line: "%s"', $line); + next; + } + my ($email, $gecos) = ($1, $2); + $gecos =~ s/\s+\z// if defined $gecos; + $found++; + + return [$email, $gecos]; + } + + return; +} + +sub _close { + my $self = shift; + + my $fh = $self->__dsh; + return unless ref $fh; + + unless (close $fh) { + $log->syslog('info', 'Can\'t close data source %s: %m', $self); + return undef; + } + + return 1; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::file - Data source based on local file + +=head1 DESCRIPTION + +TBD. + +Each line is expected to start with a valid email address and +an optional display name. + +=head2 Attributes + +=over + +=item {name} + +Short description of this data source. + +=item {path} + +Full path to local file. + +=back + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/DataSource/LDAP.pm b/src/lib/Sympa/DataSource/LDAP.pm new file mode 100644 index 000000000..bb51d2feb --- /dev/null +++ b/src/lib/Sympa/DataSource/LDAP.pm @@ -0,0 +1,212 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::LDAP; + +use strict; +use warnings; + +use Sympa::Database; +use Sympa::Log; + +use base qw(Sympa::DataSource); + +my $log = Sympa::Log->instance; + +sub _open { + my $self = shift; + my %options = @_; + + my $timeout = $options{timeout} || $self->{timeout}; + + #FIXME: Timeout specific to connection + my $db = Sympa::Database->new('LDAP', %$self, timeout => $timeout); + return undef unless $db and $db->connect; + $self->{_db} = $db; + + my $mesg = $self->_open_operation(%options); + return undef unless $mesg; + + $self->{_retrieved} = []; + + return $mesg; +} + +# Method specific to this class. +sub _open_operation { + my $self = shift; + my %options = @_; + + my $ldap_suffix = $options{suffix} || $self->{suffix}; + my $ldap_filter = $options{filter} || $self->{filter}; + my $ldap_attrs = $options{attrs} || $self->{attrs}; + my $ldap_scope = $options{scope} || $self->{scope}; + + my $mesg = $self->{_db}->do_operation( + 'search', + base => $ldap_suffix, + filter => $ldap_filter, + attrs => [split /\s*,\s*/, $ldap_attrs], + scope => $ldap_scope + ); + unless ($mesg) { + $log->syslog( + 'err', + 'LDAP search (single level) failed: %s with data source %s', + $self->{_db}->error, $self + ); + return undef; + } + + return $mesg; +} + +# Method specific to this class. +# Old name: (part of) these functions: +# Sympa::List::_include_users_ldap() and Sympa::List::_include_ldap_ca(). +sub _load_next { + my $self = shift; + my %options = @_; + + my $ldap_attrs = $options{attrs} || $self->{attrs}; + my $ldap_select = $options{select} || $self->{select}; + my $ldap_regex = $options{regex} || $self->{regex}; + # If value of this option is _not_ 'last', this function will process + # an intermediate turn of multiple level data source. + my $turn = $options{turn} || 'last'; + + my ($key_attr, $other_attr, @other_attrs); + if ($turn eq 'last') { + if ($self->role eq 'custom_attribute') { + $key_attr = $self->{email_entry}; + @other_attrs = grep { $key_attr ne $_ } split /\s*,\s*/, + $ldap_attrs; + } else { + ($key_attr, $other_attr) = split /\s*,\s*/, $ldap_attrs; + } + } else { + $key_attr = [split /\s*,\s*/, $ldap_attrs]->[0]; + } + + my @retrieved; + my $mesg = $self->__dsh; + while (my $entry = $mesg->shift_entry) { + my $key_values = $entry->get_value($key_attr, asref => 1); + next unless $key_values and @$key_values; + + my $other_value; + if ($turn eq 'last') { + if ($self->role eq 'custom_attribute') { + $other_value = {}; + foreach my $attr (@other_attrs) { + my $values = $entry->get_value($attr, asref => 1); + next unless $values and @$values; + + $other_value->{$attr} = $values->[0]; + } + } else { + $other_value = + ($entry->get_value($other_attr, asref => 1) || [])->[0] + if $other_attr; + } + } + + foreach my $key_value (@$key_values) { + next unless defined $key_value; + + if ( $ldap_select eq 'regex' + and defined $ldap_regex + and length $ldap_regex) { + next unless $key_value =~ /$ldap_regex/; + } + + if ($turn eq 'last') { + next unless length $key_value; + push @retrieved, [$key_value, $other_value]; + } else { + # Intermediate result can be empty string "". + push @retrieved, [$key_value]; + } + + last if $ldap_select eq 'first'; + } + + last if @retrieved; + } + + return [@retrieved]; +} + +sub _next { + my $self = shift; + my %options = @_; + + unless ($self->{_retrieved} and @{$self->{_retrieved}}) { + $self->{_retrieved} = $self->_load_next(%options); + } + if ($self->{_retrieved} and @{$self->{_retrieved}}) { + return shift @{$self->{_retrieved}}; + } + return; +} + +sub _next_ca { + goto &_next; # '&' is required. +} + +sub _close { + my $self = shift; + + my $db = $self->{_db}; + return unless ref $db; + + unless ($db->disconnect) { + $log->syslog('info', 'Can\'t close data source %s: %s', + $self, $db->error); + return undef; + } + + return 1; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::LDAP - Data source based on LDAP search operation + +=head1 DESCRIPTION + +Returns a list of subscribers extracted from a remote LDAP Directory + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/DataSource/LDAP2.pm b/src/lib/Sympa/DataSource/LDAP2.pm new file mode 100644 index 000000000..27c9bafdf --- /dev/null +++ b/src/lib/Sympa/DataSource/LDAP2.pm @@ -0,0 +1,153 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::LDAP2; + +use strict; +use warnings; + +use Sympa::Log; + +use base qw(Sympa::DataSource::LDAP); # Derived class + +my $log = Sympa::Log->instance; + +use constant required_modules => [qw(Net::LDAP::Util)]; + +sub _open { + my $self = shift; + + my $mesg = $self->SUPER::_open( + timeout => $self->{timeout1}, + suffix => $self->{suffix1}, + filter => $self->{filter1}, + attrs => $self->{attrs1}, + scope => $self->{scope1}, + ); + return undef unless $mesg; + $self->{_ds} = $mesg; # hack __dsh() + + my @values; + while ( + my $entry = $self->SUPER::_next( + attrs => $self->{attrs1}, + select => $self->{select1}, + regex => $self->{regex1}, + turn => 'first' + ) + ) { + push @values, $entry->[0] if defined $entry->[0]; + } + $self->{_attr1values} = [@values]; + + return 1; +} + +# Old name: (part of) Sympa::List::_include_users_ldap_2level(). +sub _load_next { + my $self = shift; + my %options = @_; + + if ($options{turn} eq 'first') { + $self->SUPER::_load_next(%options); + return; + } + + while (my $value = shift @{$self->{_attr1values} || []}) { + my ($escaped, $suffix, $filter); + + # Escape LDAP characters occurring in attribute for search base. + if ($options{suffix} =~ /[[]attrs1[]]\z/) { + # [attrs1] should be a DN, because it is search base or its root. + # Note: Don't canonicalize DN, because some LDAP servers e.g. AD + # don't conform to standard on matching rule and canonicalization + # might hurt integrity (cf. GH #474). + unless (defined Net::LDAP::Util::canonical_dn($value)) { + $log->syslog('err', 'Attribute value is not a DN: %s', + $value); + next; + } + $escaped = $value; + } else { + # [attrs1] may be an attributevalue in DN. + $escaped = Net::LDAP::Util::escape_dn_value($value); + } + ($suffix = $options{suffix}) =~ s/[[]attrs1[]]/$escaped/g; + + # Escape LDAP characters occurring in attribute for search filter. + $escaped = Net::LDAP::Util::escape_filter_value($value); + ($filter = $options{filter}) =~ s/[[]attrs1[]]/$escaped/g; + + my $mesg = $self->SUPER::_open_operation( + suffix => $suffix, + filter => $filter, + attrs => $options{attrs}, + scope => $options{scope} + ); + next unless $mesg; + $self->{_ds} = $mesg; # hack __dsh() + + $self->SUPER::_load_next(%options); + last if $self->{_retrieved} and @{$self->{_retrieved}}; + } + + return; +} + +sub _next { + my $self = shift; + + return $self->SUPER::_next( + suffix => $self->{suffix2}, + filter => $self->{filter2}, + attrs => $self->{attrs2}, + scope => $self->{scope2}, + select => $self->{select2}, + regex => $self->{regex2}, + turn => 'last' + ); +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::LDAP2 - +Data source based on LDAP with two-level search operations + +=head1 DESCRIPTION + +Returns a list of subscribers extracted indirectly from a remote LDAP +Directory using a two-level query + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/DataSource/List.pm b/src/lib/Sympa/DataSource/List.pm new file mode 100644 index 000000000..987381753 --- /dev/null +++ b/src/lib/Sympa/DataSource/List.pm @@ -0,0 +1,254 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::List; + +use strict; +use warnings; + +use Conf; +use Sympa::DatabaseManager; +use Sympa::List; +use Sympa::Log; +use Sympa::Template; +use Sympa::Tools::Data; + +use base qw(Sympa::DataSource); + +my $log = Sympa::Log->instance; + +sub _new { + my $class = shift; + my %options = @_; + + my $self = $class->SUPER::_new(%options); + return undef unless $self; + + my $list = $self->{context}; + if (ref $list eq 'Sympa::List') { + my $inlist = Sympa::List->new($self->{listname}, $list->{'domain'}, + {just_try => 1}); + $self->{listname} = $inlist->get_id if $inlist; + } + + return $self; +} + +sub _open { + my $self = shift; + + # The included list is local or in another local robot. + my $inlist = Sympa::List->new($self->{listname}); + return undef unless $inlist; + + # Check inclusion loop. + my $list = $self->{context}; + if (ref $list eq 'Sympa::List' + and _inclusion_loop( + $list, $self->role, + $inlist, ($self->role eq 'member') ? 'recursive' : 0 + ) + ) { + $log->syslog( + 'err', + 'Loop detection in list inclusion: could not include again %s in list %s', + $self, + $list + ); + return undef; + } + + $self->{_read} = 0; + + return $inlist; +} + +# Checks if adding a include_sympa_list setting will cause inclusion loop. +#FIXME:Isn't there any more efficient way to explore DAG? +# Old name: Sympa::List::_inclusion_loop(). +sub _inclusion_loop { + my $list = shift; + my $role = shift || 'member'; + my $inlist = shift; + my $recursive = shift; + + my $source_id = $inlist->get_id; + my $target_id = $list->get_id; + + unless ($recursive) { + return ($source_id eq $target_id); + } + + my $sdm = Sympa::DatabaseManager->instance; + my $sth; + + my %visited; + my @ancestors = ($source_id); + while (@ancestors) { + # Loop detected. + return 1 + if grep { $target_id eq $_ } @ancestors; + + @visited{@ancestors} = @ancestors; + @ancestors = Sympa::Tools::Data::sort_uniq( + grep { + # Ignore loop by other nodes to prevent infinite processing. + not exists $visited{$_} + } map { + my @parents; + if ($sdm + and $sth = $sdm->do_prepared_query( + q{SELECT source_inclusion + FROM inclusion_table + WHERE target_inclusion = ? AND role_inclusion = ?}, + $_, $role + ) + ) { + @parents = + map { $_->[0] } @{$sth->fetchall_arrayref([0]) || []}; + $sth->finish; + } + @parents + } @ancestors + ); + } + + return 0; +} + +# Old name: (part of) Sympa::List::_include_users_list(). +sub _next { + my $self = shift; + + my $list = $self->{context}; + my $robot = $list->{'domain'}; + my $filter = $self->{filter}; + + if (defined $filter and length $filter) { + $filter =~ s/\A\s+//; + $filter =~ s/\s+\z//; + $filter =~ s{\A((?:USE\s[^;]+;)*)\s*(.+)} + {[% TRY %][% $1 %][%IF $2 %]1[%END%][% CATCH %][% error %][%END%]}; + $log->syslog('debug3', 'Applying filter on data source: %s: %s', + $self, $filter); + } + + my $inlist = $self->__dsh; + while ( + my $user = ( + $self->{_read} + ? $inlist->get_next_list_member + : $inlist->get_first_list_member + ) + ) { + $self->{_read} = 1; + + # Do we need filtering ? + if (defined $filter and length $filter) { + my $variables = {%{$user || {}}}; + + # Rename date to avoid conflicts with date tt2 plugin and make + # name clearer. + $variables->{subscription_date} = $variables->{date}; + delete $variables->{date}; + + # Aliases. + $variables->{ca} = $user->{custom_attributes}; + + # Status filters. + $variables->{isSubscriberOf} = sub { + my $other_list = Sympa::List->new(shift, $robot); + return $other_list + ? $other_list->is_list_member($user->{email}) + : undef; + }; + $variables->{isEditorOf} = sub { + my $other_list = Sympa::List->new(shift, $robot); + return $other_list + ? $other_list->is_admin('actual_editor', $user->{email}) + : undef; + }; + $variables->{isOwnerOf} = sub { + my $other_list = Sympa::List->new(shift, $robot); + return $other_list + ? ($other_list->is_admin('owner', $user->{email}) + || Sympa::is_listmaster($other_list, $user->{email})) + : undef; + }; + + # Run the test. + my $result; + my $template = Sympa::Template->new(undef); + unless ($template->parse($variables, \($filter), \$result)) { + $log->syslog( + 'err', + 'Error while applying filter "%s" : %s, aborting include', + $filter, + $template->{last_error} + ); + return undef; + } + $result =~ s/\s+\z//; + + unless ($result eq '' or $result eq '1') { + # Anything not 1 or empty result is an error. + $log->syslog( + 'debug2', + 'Error while applying filter "%s" : %s, aborting include', + $filter, + $result + ); + return undef; + } + + # Skip user if filter returned false, i.e. empty result. + next unless $result eq '1'; + } + + return [$user->{email}, $user->{gecos}]; + } + + return; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::List - Data source based on a list at local machine + +=head1 DESCRIPTION + +Include a list as subscribers. + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/DataSource/RemoteDump.pm b/src/lib/Sympa/DataSource/RemoteDump.pm new file mode 100644 index 000000000..ad1f1b4f9 --- /dev/null +++ b/src/lib/Sympa/DataSource/RemoteDump.pm @@ -0,0 +1,111 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::RemoteDump; + +use strict; +use warnings; + +use Sympa::Log; +use Sympa::Regexps; + +use base qw(Sympa::DataSource::RemoteFile); # Derived class + +my $log = Sympa::Log->instance; + +use constant required_modules => [qw(LWP::Protocol::https)]; + +# Old name: (part of) Sympa::Fetch::get_https(), Sympa::List::_get_https(). +sub _open { + my $self = shift; + + unless ($self->{url}) { + my $host_re = Sympa::Regexps::host(); + my $host = $self->{host}; + return undef unless $host and $host =~ /\A$host_re\z/; + + my $port = $self->{port} || '443'; + my $path = $self->{path}; + $path = '' unless defined $path; + $path = "/$path" unless 0 == index $path, '/'; + + $self->{url} = sprintf 'https://%s:%s%s', $host, $port, $path; + } + + my $fh = $self->SUPER::_open(use_cert => 1); + #FIXME: Log subject, issuer and cipher of peer. + return $fh; +} + +sub _next { + my $self = shift; + + my $fh = $self->__dsh; + + my %entry; + while (my $line = <$fh>) { + $line =~ s/\s+\z//; + + if ($line eq '') { + last if defined $entry{email} and length $entry{email}; + %entry = (); + } elsif ($line =~ /\A\s*(\w+)(?:\s+(.*))?\z/) { + $entry{$1} = $2; + } else { + $log->syslog( + 'err', + '%s: Illegal line %.128s. Source file probably corrupted. Aborting', + $self, + $line + ); + return; + } + } + + return [@entry{qw(email gecos)}] + if defined $entry{email} and length $entry{email}; + return; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::RemoteDump - +Data source based on a user dump at remote host + +=head1 DESCRIPTION + +Include a remote sympa list as subscribers. + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/DataSource/RemoteFile.pm b/src/lib/Sympa/DataSource/RemoteFile.pm new file mode 100644 index 000000000..59a505dbe --- /dev/null +++ b/src/lib/Sympa/DataSource/RemoteFile.pm @@ -0,0 +1,146 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::RemoteFile; + +use strict; +use warnings; +use English qw(-no_match_vars); +use HTTP::Request; +use LWP::UserAgent; + +use Conf; +use Sympa::Constants; +use Sympa::Log; + +use base qw(Sympa::DataSource::File); # Derived class. + +my $log = Sympa::Log->instance; + +use constant required_modules => [qw(LWP::Protocol::https)]; + +# Old name: (part of) Sympa::List::_include_users_remote_file(). +sub _open { + my $self = shift; + my %options = @_; + + my $list = $self->{context}; + + my $ua = + LWP::UserAgent->new(agent => 'Sympa/' . Sympa::Constants::VERSION); + $ua->protocols_allowed(['http', 'https', 'ftp']); + if ($self->{url} =~ /\Ahttps:/i) { + my $cert_file = Sympa::search_fullpath($list, 'cert.pem'); + my $key_file = Sympa::search_fullpath($list, 'private_key'); + my $key_passwd = $Conf::Conf{'key_passwd'}; + my $ca_file = $Conf::Conf{'cafile'}; + my $ca_path = $Conf::Conf{'capath'}; + + if ($options{use_cert}) { + unless ($cert_file + and -r $cert_file + and $key_file + and -r $key_file) { + $log->syslog('err', + '%s: Unable to open client certificate or private key', + $self); + return undef; + } else { + $ua->ssl_opts(SSL_use_cert => 1); + } + } + + $ua->ssl_opts(SSL_version => $self->{ssl_version}) + if $self->{ssl_version} and $self->{ssl_version} ne 'ssl_any'; + $ua->ssl_opts(SSL_cipher_list => $self->{ssl_ciphers}) + if $self->{ssl_ciphers}; + $ua->ssl_opts(SSL_cert_file => $cert_file) if $cert_file; + $ua->ssl_opts(SSL_key_file => $key_file) if $key_file; + $ua->ssl_opts(SSL_passwd_cb => sub { return ($key_passwd) }) + if $key_passwd; + $ua->ssl_opts( + SSL_verify_mode => ( + {none => 0, optional => 1, required => 3}->$self->{ca_verify} + || 0 + ) + ) if defined $self->{ca_verify}; + $ua->ssl_opts(SSL_ca_file => $ca_file) if $ca_file; + $ua->ssl_opts(SSL_ca_path => $ca_path) if $ca_path; + } + $ua->timeout($self->{timeout}) if $self->{timeout}; + + my $req = HTTP::Request->new(GET => $self->{url}); + if (defined $self->{user} and defined $self->{passwd}) { + $req->authorization_basic($self->{user}, $self->{passwd}); + } + + $self->{_tmpfile} = sprintf '%s/%s_RemoteFile.%s.%s', + $Conf::Conf{'tmpdir'}, + $list->get_id, $PID, (int rand 9999); + my $res = $ua->request($req, $self->{_tmpfile}); + unless ($res->is_success) { + $log->syslog('err', 'Unable to fetch data source %s: %s', + $self, $res->message); + return undef; + } + + my $fh; + unless (open $fh, '<', $self->{_tmpfile}) { + $log->syslog('err', 'Cannot open file %s: %m', $self->{_tmpfile}); + return undef; + } + while (my $line = <$fh>) { + last if $line =~ /\A\r?\n\z/; + } + return $fh; +} + +sub _close { + my $self = shift; + + return undef unless $self->SUPER::_close(); + unlink $self->{_tmpfile}; + return 1; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::RemoteFile - Data source based on a file at remote host + +=head1 DESCRIPTION + +TBD. + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/DataSource/SQL.pm b/src/lib/Sympa/DataSource/SQL.pm new file mode 100644 index 000000000..1b067d091 --- /dev/null +++ b/src/lib/Sympa/DataSource/SQL.pm @@ -0,0 +1,180 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 + +# 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 +# . +# +# 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 . + +package Sympa::DataSource::SQL; + +use strict; +use warnings; +use English qw(-no_match_vars); + +use Conf; +use Sympa::Database; +use Sympa::Log; +use Sympa::Process; +use Sympa::Tools::Data; + +use base qw(Sympa::DataSource); + +my $log = Sympa::Log->instance; + +# Old name: (part of) Sympa::List::_include_users_sql() and +# Sympa::List::_include_sql_ca(). Entirely rewritten. +sub _open { + my $self = shift; + + my $list = $self->{context}; + + my $db = Sympa::Database->new($self->{db_type}, %$self); + return undef unless $db and $db->connect; + + my $fh = Sympa::Process::eval_in_time( + sub { + my $sth = $self->{_db}->do_prepared_query($self->{sql_query}); + unless ($sth) { + $log->syslog('err', + 'Unable to connect to SQL data source %s', $self); + return undef; + } + + #FIXME File::Temp 0.22 or later might be used, but + # those bundled in Perl 5.8.x are older. + my $tmpfile = sprintf '%s/%s_SQL_%s.%s.ds', + $Conf::Conf{'tmpdir'}, $list->get_id, $self->role, $PID; + my $tmpfh; + unless (open $tmpfh, '+>', $tmpfile) { + $log->syslog('err', + 'Couldn\'t open temporary file for data source %s: %m', + $self); + return undef; + } + $self->{_tmpfile} = $tmpfile; + + if ($self->role eq 'custom_attribute') { + while (my $row = $sth->fetchrow_hashref('NAME_lc')) { + next unless $row and %$row; + + my $email = delete $row->{$self->{email_entry}}; + next unless defined $email and length $email; + $email =~ s/[\t\r\n]+/ /g; + + print $tmpfh "%s\t%s\n", $email, + Sympa::Tools::Data::encode_custom_attribute($row); + } + } else { + while (my $row = $sth->fetchrow_arrayref) { + next unless $row and defined $row->[0]; + + my ($email, $value) = @$row; + next unless defined $email and length $email; + $email =~ s/[\t\r\n]+/ /g; + $value =~ s/[\t\r\n]+/ /g if defined $value; + + printf $tmpfh "%s\t%s\n", $email, $value; + } + } + $sth->finish; + + seek $tmpfh, 0, 0; + return $tmpfh; + }, + ($list->{'admin'}{'sql_fetch_timeout'} || 300) + ); + unless ($fh) { + my $tmpfile = delete $self->{_tmpfile}; + unlink $tmpfile if $tmpfile; + } + + unless ($db->disconnect) { + $log->syslog('info', 'Can\'t close data source %s: %s', + $self, $db->error); + } + + return $fh; +} + +sub _next { + my $self = shift; + + my $fh = $self->__dsh; + while (my $line = <$fh>) { + chomp $line; + my ($email, $value) = split /\t/, $line, 2; + next unless length $email; + + return [$email] unless length $value; + return [$email, $value]; + } + + return; +} + +sub _next_ca { + my $self = shift; + + my $fh = $self->__dsh; + while (my $line = <$fh>) { + chomp $line; + my ($email, $value) = split /\t/, $line, 2; + next unless length $email; + + my $ca = Sympa::Tools::Data::decode_custom_attribute($value); + next unless $ca; + + return [$email, $ca]; + } + + return; +} + +sub _close { + my $self = shift; + + my $fh = $self->__dsh; + close $fh if $fh; + my $tmpfile = delete $self->{_tmpfile}; + unlink $tmpfile if $tmpfile; + + return 1; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::DataSource::SQL - Data source based on SQL query + +=head1 DESCRIPTION + +Returns a list of subscribers extracted from an remote Database + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/Database.pm b/src/lib/Sympa/Database.pm index fd27587ef..1aaa79b5f 100644 --- a/src/lib/Sympa/Database.pm +++ b/src/lib/Sympa/Database.pm @@ -8,8 +8,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 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2017, 2018, 2019 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 @@ -568,7 +568,7 @@ Statement handle (L object or such), or C. =head1 SEE ALSO -L, L. +L. =head1 HISTORY diff --git a/src/lib/Sympa/DatabaseDescription.pm b/src/lib/Sympa/DatabaseDescription.pm index 1546eb49b..401e11898 100644 --- a/src/lib/Sympa/DatabaseDescription.pm +++ b/src/lib/Sympa/DatabaseDescription.pm @@ -8,8 +8,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 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2017, 2018, 2019 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 @@ -125,6 +125,23 @@ my %full_db_struct = ( 'the last time when subscription is confirmed by subscriber', 'order' => 12.5, }, + 'inclusion_subscriber' => { + 'struct' => 'int(11)', + 'doc' => + 'the last time when list user is synchronized with data source', + 'order' => 12.6, + }, + 'inclusion_ext_subscriber' => { + 'struct' => 'int(11)', + 'doc' => + 'the last time when list user is synchronized with external data source', + 'order' => 12.7, + }, + 'inclusion_label_subscriber' => { + 'struct' => 'varchar(15)', + 'doc' => 'name of data source', + 'order' => 12.8, + }, 'comment_subscriber' => { 'struct' => 'varchar(150)', 'doc' => 'free form name', @@ -153,18 +170,20 @@ my %full_db_struct = ( 'boolean set to 1 if subscriber comes from ADD or SUB', 'order' => 17, }, - 'included_subscriber' => { - 'struct' => 'int(1)', - 'doc' => - 'boolean, set to 1 is subscriber comes from an external datasource. Note that included_subscriber and subscribed_subscriber can both value 1', - 'order' => 18, - }, - 'include_sources_subscriber' => { - 'struct' => 'varchar(50)', - 'doc' => - 'comma separated list of datasource that contain this subscriber', - 'order' => 19, - }, + # Obsoleted as of 6.2.45b. Use inclusion_subscriber. + #'included_subscriber' => { + # 'struct' => 'int(1)', + # 'doc' => + # 'boolean, set to 1 is subscriber comes from an external datasource. Note that included_subscriber and subscribed_subscriber can both value 1', + # 'order' => 18, + #}, + # Ditto. + #'include_sources_subscriber' => { + # 'struct' => 'varchar(50)', + # 'doc' => + # 'comma separated list of datasource that contain this subscriber', + # 'order' => 19, + #}, 'custom_attribute_subscriber' => { 'struct' => 'text', 'doc' => 'FIXME', @@ -919,6 +938,23 @@ my %full_db_struct = ( 'doc' => 'last update time', 'order' => 7.5, }, + 'inclusion_admin' => { + 'struct' => 'int(11)', + 'doc' => + 'the last time when list user is synchronized with data source', + 'order' => 7.6, + }, + 'inclusion_ext_admin' => { + 'struct' => 'int(11)', + 'doc' => + 'the last time when list user is synchronized with external data source', + 'order' => 7.7, + }, + 'inclusion_label_admin' => { + 'struct' => 'varchar(15)', + 'doc' => 'name of data source', + 'order' => 7.8, + }, 'reception_admin' => { 'struct' => 'varchar(20)', 'doc' => @@ -942,17 +978,19 @@ my %full_db_struct = ( 'set to 1 if user is list admin by definition in list config file', 'order' => 11, }, - 'included_admin' => { - 'struct' => 'int(1)', - 'doc' => - 'set to 1 if user is admin by an external data source. Note that included_admin and subscribed_admin can both value 1', - 'order' => 12, - }, - 'include_sources_admin' => { - 'struct' => 'varchar(50)', - 'doc' => 'name of external datasource', - 'order' => 13, - }, + # Obsoleted as of 6.2.45b. Use inclusion_admin. + #'included_admin' => { + # 'struct' => 'int(1)', + # 'doc' => + # 'set to 1 if user is admin by an external data source. Note that included_admin and subscribed_admin can both value 1', + # 'order' => 12, + #}, + # Ditto. + #'include_sources_admin' => { + # 'struct' => 'varchar(50)', + # 'doc' => 'name of external datasource', + # 'order' => 13, + #}, 'info_admin' => { 'struct' => 'varchar(150)', 'doc' => diff --git a/src/lib/Sympa/DatabaseDriver/LDAP.pm b/src/lib/Sympa/DatabaseDriver/LDAP.pm index d12c03d2c..6e5df8c5f 100644 --- a/src/lib/Sympa/DatabaseDriver/LDAP.pm +++ b/src/lib/Sympa/DatabaseDriver/LDAP.pm @@ -8,8 +8,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 2018 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2018, 2019 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 @@ -31,6 +31,7 @@ use strict; use warnings; use English qw(-no_match_vars); +use Conf; use Sympa::Log; use base qw(Sympa::DatabaseDriver); @@ -41,7 +42,8 @@ use constant required_parameters => [qw(host)]; use constant optional_parameters => [ qw(port bind_dn bind_password use_tls ssl_version ssl_ciphers - ssl_cert ssl_key ca_verify ca_path ca_file) + ssl_cert ssl_key ca_verify ca_path ca_file + timeout) ]; use constant required_modules => [qw(Net::LDAP)]; use constant optional_modules => [qw(IO::Socket::SSL)]; @@ -72,6 +74,18 @@ sub _new { $params{host} = join ',', @hosts; delete $params{port}; + # If CA certificate is required and missing, take it from site config. + if ( not $params{ca_file} + and not $params{ca_path} + and ($params{use_tls} and $params{use_tls} ne 'none' + or grep {m{\Aldaps://}i} @{$params{_hosts} || []}) + ) { + $params{ca_file} = $Conf::Conf{'cafile'} + if $Conf::Conf{'cafile'}; + $params{ca_path} = $Conf::Conf{'capath'} + if $Conf::Conf{'capath'}; + } + return bless {%params} => $class; } diff --git a/src/lib/Sympa/Datasource.pm b/src/lib/Sympa/Datasource.pm deleted file mode 100644 index 16c9e1ccb..000000000 --- a/src/lib/Sympa/Datasource.pm +++ /dev/null @@ -1,134 +0,0 @@ -# -*- 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 -# -# 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 . - -package Sympa::Datasource; - -use strict; -use warnings; -use Digest::MD5 qw(); - -use Sympa::Log; -use Sympa::Regexps; - -my $log = Sympa::Log->instance; - -############################################################ -# constructor -############################################################ -# Create a new datasource object. Handle SQL source only -# at this moment. -# -# IN : -$type (+): the type of datasource to create -# 'SQL' or 'MAIN' for main sympa database -# -$param_ref (+): ref to a Hash of config data -# -# OUT : instance of Datasource -# | undef -# -############################################################## -sub new { - my ($pkg, $param) = @_; - $log->syslog('debug', ''); - my $self = $param; - ## Bless Message object - bless $self, $pkg; - return $self; -} - -# Returns a unique ID for an include datasource -sub _get_datasource_id { - my ($source) = shift; - $log->syslog('debug2', 'Getting datasource id for source "%s"', $source); - # Not in case. - #if (ref($source) eq 'Sympa::Datasource') { - # $source = shift; - #} - - if (ref($source)) { - ## Ordering values so that order of keys in a hash don't mess the - ## value comparison - ## Warning: Only the first level of the hash is ordered. Should a - ## datasource - ## be described with a hash containing more than one level (a hash of - ## hash) we should transform - ## the following algorithm into something that would be recursive. - ## Unlikely it happens. - my @orderedValues = - map { (defined $source->{$_}) ? ($_, $source->{$_}) : () } - sort keys %$source; - return substr(Digest::MD5::md5_hex(join('/', @orderedValues)), -8); - } else { - return substr(Digest::MD5::md5_hex($source), -8); - } - -} - -sub is_allowed_to_sync { - #my $self = shift; - #my $ranges = $self->{'nosync_time_ranges'}; - my $ranges = shift; - - 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; diff --git a/src/lib/Sympa/List.pm b/src/lib/Sympa/List.pm index 460b06fe0..b4bd4fb25 100644 --- a/src/lib/Sympa/List.pm +++ b/src/lib/Sympa/List.pm @@ -31,13 +31,9 @@ use strict; use warnings; use Digest::MD5 qw(); use English qw(-no_match_vars); -use HTTP::Request; use IO::Scalar; -use LWP::UserAgent; use POSIX qw(); use Storable qw(); -BEGIN { eval 'use IO::Socket::SSL'; } -BEGIN { eval 'use Net::LDAP::Util'; } use Sympa; use Conf; @@ -46,16 +42,15 @@ use Sympa::Constants; use Sympa::Database; use Sympa::DatabaseDescription; use Sympa::DatabaseManager; -use Sympa::Datasource; use Sympa::Family; use Sympa::Language; use Sympa::List::Config; use Sympa::ListDef; use Sympa::LockedFile; use Sympa::Log; -use Sympa::Process; use Sympa::Regexps; use Sympa::Robot; +use Sympa::Spindle::ProcessRequest; use Sympa::Spindle::ProcessTemplate; use Sympa::Spool::Auth; use Sympa::Template; @@ -752,6 +747,12 @@ sub dump_users { printf $lock_fh "%s %s\n", $k, $user->{$k}; } } + + # Compat.<=6.2.44 + # This is needed for earlier version of Sympa on e.g. remote host. + print $lock_fh "included 1\n" + if defined $user->{inclusion}; + print $lock_fh "\n"; } } else { @@ -763,6 +764,12 @@ sub dump_users { printf $lock_fh "%s %s\n", $k, $user->{$k} if defined $user->{$k} and length $user->{$k}; } + + # Compat.<=6.2.44 + # This is needed for earlier version of Sympa on e.g. remote host. + print $lock_fh "included 1\n" + if defined $user->{inclusion}; + print $lock_fh "\n"; } } @@ -2105,7 +2112,7 @@ sub delete_list_member { ## Include in exclusion_table only if option is set. if ($exclude) { - ## Insert in exclusion_table if $user->{'included'} eq '1' + # Insert in exclusion_table if $user->{inclusion} defined. $self->insert_delete_exclusion($who, 'insert'); } @@ -2224,12 +2231,12 @@ sub get_reply_to { ## Returns a default user option sub get_default_user_options { - my $self = shift->{'admin'}; + $log->syslog('debug3', '(%s,%s)', @_); + my $self = shift; my $what = shift; - $log->syslog('debug3', '(%s)', $what); if ($self) { - return $self->{'default_user_options'}; + return $self->{'admin'}{'default_user_options'}; } return undef; } @@ -2383,11 +2390,11 @@ sub insert_delete_exclusion { my $r = 1; if ($action eq 'insert') { - ## INSERT only if $user->{'included'} eq '1' + # INSERT only if $user->{inclusion} defined. my $user = $self->get_list_member($email); my $date = time; - if ($user->{'included'} eq '1') { + if (defined $user->{'inclusion'}) { unless ( $sdm and $sdm->do_prepared_query( @@ -2527,6 +2534,56 @@ sub get_exclusion { return $data_exclu; } +sub is_member_excluded { + my $self = shift; + my $email = shift; + + return undef unless defined $email and length $email; + $email = Sympa::Tools::Text::canonic_email($email); + + my $sdm = Sympa::DatabaseManager->instance; + my $sth; + + if (defined $self->{'admin'}{'family_name'} + and length $self->{'admin'}{'family_name'}) { + unless ( + $sdm + and $sth = $sdm->do_prepared_query( + q{SELECT COUNT(*) + FROM exclusion_table + WHERE (list_exclustion = ? OR family_exclusion = ?) AND + robot_exclusion = ? AND + user_exclusion = ?}, + $self->{'name'}, $self->{'admin'}{'family_name'}, + $self->{'domain'}, + $email + ) + ) { + #FIXME: report error + return undef; + } + } else { + unless ( + $sdm + and $sth = $sdm->do_prepared_query( + q{SELECT COUNT(*) + FROM exclusion_table + WHERE list_exclustion = ? AND robot_exclusion = ? AND + user_exclusion = ?}, + $self->{'name'}, $self->{'domain'}, + $email + ) + ) { + #FIXME: report error + return undef; + } + } + my ($count) = $sth->fetchrow_array; + $sth->finish; + + return $count || 0; +} + # Mapping between var and field names. sub _map_list_member_cols { my %map_field = ( @@ -2534,17 +2591,14 @@ sub _map_list_member_cols { update_date => 'update_epoch_subscriber', gecos => 'comment_subscriber', email => 'user_subscriber', - id => 'include_sources_subscriber', startdate => 'suspend_start_date_subscriber', enddate => 'suspend_end_date_subscriber', ); - foreach my $f ( - keys %{ - {Sympa::DatabaseDescription::full_db_struct()} - ->{'subscriber_table'}->{fields} - } - ) { + my $fields = + {Sympa::DatabaseDescription::full_db_struct()}->{'subscriber_table'} + ->{fields}; + foreach my $f (keys %$fields) { next if $f eq 'list_subscriber' or $f eq 'robot_subscriber'; my $k = {reverse %map_field}->{$f}; @@ -2612,6 +2666,7 @@ sub get_list_member { unless $self->is_available_reception_mode($user->{'reception'}); $user->{'visibility'} ||= 'noconceal'; $user->{'update_date'} ||= $user->{'date'}; + $log->syslog( 'debug2', 'Custom_attribute = (%s)', @@ -2623,6 +2678,9 @@ sub get_list_member { $user->{'custom_attribute'}); } + # Compat.<=6.2.44 FIXME: needed? + $user->{'included'} = 1 + if defined $user->{'inclusion'}; } else { my $error = $sth->err; $sth->finish; @@ -2752,6 +2810,10 @@ sub get_first_list_member { Sympa::Tools::Data::decode_custom_attribute( $user->{'custom_attribute'}); } + + # Compat.<=6.2.44 FIXME: needed? + $user->{'included'} = 1 + if defined $user->{'inclusion'}; } else { $sth->finish; $sth = pop @sth_stack; @@ -2808,6 +2870,10 @@ sub get_next_list_member { } $user->{'custom_attribute'} = $custom_attr; } + + # Compat.<=6.2.44 FIXME: needed? + $user->{'included'} = 1 + if defined $user->{'inclusion'}; } else { $sth->finish; $sth = pop @sth_stack; @@ -2823,15 +2889,12 @@ sub _map_list_admin_cols { update_date => 'update_epoch_admin', gecos => 'comment_admin', email => 'user_admin', - id => 'include_sources_admin', ); - foreach my $f ( - keys %{ - {Sympa::DatabaseDescription::full_db_struct()}->{'admin_table'} - ->{fields} - } - ) { + my $fields = + {Sympa::DatabaseDescription::full_db_struct()}->{'admin_table'} + ->{fields}; + foreach my $f (keys %$fields) { next if $f eq 'list_admin' or $f eq 'robot_admin' @@ -3027,6 +3090,10 @@ sub get_current_admins { $user->{'reception'} ||= 'mail'; $user->{'visibility'} ||= 'noconceal'; $user->{'update_date'} ||= $user->{'date'}; + + # Compat.<=6.2.44 FIXME: needed? + $user->{'included'} = 1 + if defined $user->{'inclusion'}; } return $admin_user; @@ -3089,11 +3156,16 @@ sub get_first_bouncing_list_member { $log->syslog('err', 'Warning: Entry with empty email address in list %s', $self->{'name'}) - if (!$user->{'email'}); + unless defined $user->{'email'} and length $user->{'email'}; + + # Compat.<=6.2.44 FIXME: needed? + $user->{'included'} = 1 + if defined $user->{'inclusion'}; } else { $sth->finish; $sth = pop @sth_stack; } + return $user; } @@ -3125,6 +3197,9 @@ sub get_next_bouncing_list_member { $user->{'custom_attribute'}); } + # Compat.<=6.2.44 FIXME: needed? + $user->{'included'} = 1 + if defined $user->{'inclusion'}; } else { $sth->finish; $sth = pop @sth_stack; @@ -3307,6 +3382,10 @@ sub get_members { } $user->{custom_attribute} = $custom_attr; } + + # Compat.<=6.2.44 FIXME: needed? + $user->{included} = 1 + if defined $user->{'inclusion'}; } return wantarray ? @$users : $users; @@ -3644,54 +3723,63 @@ sub update_list_member { ## Sets new values for the given admin user (except gecos) sub update_list_admin { - my ($self, $who, $role, $values) = @_; - $log->syslog('debug2', '(%s, %s)', $role, $who); - $who = Sympa::Tools::Text::canonic_email($who); + $log->syslog('debug2', '(%s, %s, %s, ...)', @_); + my $self = shift; + my $who = Sympa::Tools::Text::canonic_email(shift); + my $role = shift; + my $values = $_[0]; # Compat. + $values = {@_} unless ref $values eq 'HASH'; my ($field, $value, $table); my $name = $self->{'name'}; ## mapping between var and field names my %map_field = ( - reception => 'reception_admin', - visibility => 'visibility_admin', - date => 'date_epoch_admin', - update_date => 'update_epoch_admin', - gecos => 'comment_admin', - password => 'password_user', - email => 'user_admin', - subscribed => 'subscribed_admin', - included => 'included_admin', - id => 'include_sources_admin', - info => 'info_admin', - profile => 'profile_admin', - role => 'role_admin' + reception => 'reception_admin', + visibility => 'visibility_admin', + date => 'date_epoch_admin', + update_date => 'update_epoch_admin', + inclusion => 'inclusion_admin', + inclusion_ext => 'inclusion_ext_admin', + inclusion_label => 'inclusion_label_admin', + gecos => 'comment_admin', + password => 'password_user', + email => 'user_admin', + subscribed => 'subscribed_admin', + info => 'info_admin', + profile => 'profile_admin', + role => 'role_admin' ); ## mapping between var and tables my %map_table = ( - reception => 'admin_table', - visibility => 'admin_table', - date => 'admin_table', - update_date => 'admin_table', - gecos => 'admin_table', - password => 'user_table', - email => 'admin_table', - subscribed => 'admin_table', - included => 'admin_table', - id => 'admin_table', - info => 'admin_table', - profile => 'admin_table', - role => 'admin_table' + reception => 'admin_table', + visibility => 'admin_table', + date => 'admin_table', + update_date => 'admin_table', + inclusion => 'admin_table', + inclusion_ext => 'admin_table', + inclusion_label => 'admin_table', + gecos => 'admin_table', + password => 'user_table', + email => 'admin_table', + subscribed => 'admin_table', + info => 'admin_table', + profile => 'admin_table', + role => 'admin_table' ); -#### ?? + #### ?? ## additional DB fields -# if (defined $Conf::Conf{'db_additional_user_fields'}) { -# foreach my $f (split ',', $Conf::Conf{'db_additional_user_fields'}) { -# $map_table{$f} = 'user_table'; -# $map_field{$f} = $f; -# } -# } + #if (defined $Conf::Conf{'db_additional_user_fields'}) { + # foreach my $f (split ',', $Conf::Conf{'db_additional_user_fields'}) { + # $map_table{$f} = 'user_table'; + # $map_field{$f} = $f; + # } + #} + + # Compat.<=6.2.44 FIXME: is this used? + $values->{inclusion} ||= ($values->{update_date} || time) + if $values->{included}; my $sdm = Sympa::DatabaseManager->instance; return undef unless $sdm; @@ -3876,13 +3964,16 @@ sub add_list_member { $new_user->{'custom_attribute'} ); + # Compat.<=6.2.44 FIXME: needed? + $new_user->{'inclusion'} ||= ($new_user->{'date'} || time) + if $new_user->{'included'}; + ## Either is_included or is_subscribed must be set ## default is is_subscriber for backward compatibility reason - unless ($new_user->{'included'}) { - $new_user->{'subscribed'} = 1; - } + $new_user->{'subscribed'} = 1 unless defined $new_user->{'inclusion'}; + $new_user->{'subscribed'} ||= 0; - unless ($new_user->{'included'}) { + unless (defined $new_user->{'inclusion'}) { ## Is the email in user table? ## Insert in User Table unless ( @@ -3901,9 +3992,6 @@ sub add_list_member { } } - $new_user->{'subscribed'} ||= 0; - $new_user->{'included'} ||= 0; - #Log in stat_table to make staistics $log->add_stat( 'robot' => $self->{'domain'}, @@ -3921,27 +4009,23 @@ sub add_list_member { (user_subscriber, comment_subscriber, list_subscriber, robot_subscriber, date_epoch_subscriber, update_epoch_subscriber, + inclusion_subscriber, inclusion_ext_subscriber, + inclusion_label_subscriber, reception_subscriber, topics_subscriber, visibility_subscriber, subscribed_subscriber, - included_subscriber, include_sources_subscriber, custom_attribute_subscriber, suspend_subscriber, suspend_start_date_subscriber, suspend_end_date_subscriber, number_messages_subscriber) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 0)}, - $who, - $new_user->{'gecos'}, - $name, - $self->{'domain'}, - $new_user->{'date'}, - $new_user->{'update_date'}, - $new_user->{'reception'}, - $new_user->{'topics'}, - $new_user->{'visibility'}, - $new_user->{'subscribed'}, - $new_user->{'included'}, - $new_user->{'id'}, + $who, $new_user->{'gecos'}, + $name, $self->{'domain'}, + $new_user->{'date'}, $new_user->{'update_date'}, + $new_user->{'inclusion'}, $new_user->{'inclusion_ext'}, + $new_user->{'inclusion_label'}, + $new_user->{'reception'}, $new_user->{'topics'}, + $new_user->{'visibility'}, $new_user->{'subscribed'}, $new_user->{'custom_attribute'}, $new_user->{'suspend'}, $new_user->{'startdate'}, @@ -4028,9 +4112,9 @@ sub _add_list_admin { my %options = @_; my $who = Sympa::Tools::Text::canonic_email($user->{'email'}); - return undef unless defined $who; + return undef unless defined $who and length $who; - unless ($user->{'included'}) { + unless (defined $user->{'inclusion'}) { # Is the email in user_table? Insert it. #FIXME: Is it required? unless ( @@ -4046,11 +4130,6 @@ sub _add_list_admin { } } - # Either is_included or is_subscribed must be set. - # Default is is_subscriber for backward compatibility reason. - $user->{'subscribed'} = 1 unless $user->{'included'}; - $user->{'subscribed'} ||= 0; - $user->{'included'} ||= 0; $user->{'reception'} ||= 'mail'; $user->{'visibility'} ||= 'noconceal'; $user->{'profile'} ||= 'normal'; @@ -4058,6 +4137,15 @@ sub _add_list_admin { $user->{'date'} ||= time; $user->{'update_date'} ||= $user->{'date'}; + # Compat.<=6.2.44 FIXME: needed? + $user->{'inclusion'} ||= $user->{'date'} + if $user->{'included'}; + + # Either is_included or is_subscribed must be set. + # Default is is_subscriber for backward compatibility reason. + $user->{'subscribed'} = 1 unless defined $user->{'inclusion'}; + $user->{'subscribed'} ||= 0; + my $sdm = Sympa::DatabaseManager->instance; my $sth; my %map_field = _map_list_admin_cols(); @@ -4343,6 +4431,7 @@ sub restore_users { my $lock_fh = Sympa::LockedFile->new($file, 5, '<') or return; local $RS = ''; + my $time = time; if ($role eq 'member') { my %map_field = _map_list_member_cols(); @@ -4351,6 +4440,7 @@ sub restore_users { map { #FIMXE: Define appropriate schema. if (/^\s*(suspend|subscribed|included)\s+(\S+)\s*$/) { + # Note: "included" is kept for comatibility. ($1 => !!$2); } elsif (/^\s*(custom_attribute)\s+(.+)\s*$/) { my $k = $1; @@ -4358,7 +4448,7 @@ sub restore_users { Sympa::Tools::Data::decode_custom_attribute($2); ($decoded and %$decoded) ? ($k => $decoded) : (); } elsif ( - /^\s*(date|update_date|startdate|enddate|bounce_score|number_messages)\s+(\d+)\s*$/ + /^\s*(date|update_date|inclusion|inclusion_ext|startdate|enddate|bounce_score|number_messages)\s+(\d+)\s*$/ or /^\s*(reception)\s+(mail|digest|nomail|summary|notice|txt|html|urlize|not_me)\s*$/ or /^\s*(visibility)\s+(conceal|noconceal)\s*$/ @@ -4372,23 +4462,32 @@ sub restore_users { }; next unless $user->{email}; + $user->{update_date} = $time; + # Compat. <= 6.2.44 + # This is needed for dump by earlier version of Sympa. + $user->{inclusion} ||= ($user->{update_date} || time) + if $user->{included}; + $self->add_list_member($user); } } else { - my $time = time; my $changed = 0; + my %map_field = _map_list_admin_cols(); while (my $para = <$lock_fh>) { my $user = { map { #FIMXE:Define appropriate schema. if (/^\s*(subscribed|included)\s+(\S+)\s*$/) { + # Note: "included" is kept for comatibility. ($1 => !!$2); } elsif (/^\s*(email|gecos|info|id)\s+(.+)\s*$/ or /^\s*(profile)\s+(normal|privileged)\s*$/ - or /^\s*(date|update_date)\s+(\d+)\s*$/ + or + /^\s*(date|update_date|inclusion|inclusion_ext)\s+(\d+)\s*$/ or /^\s*(reception)\s+(mail|nomail)\s*$/ - or /^\s*(visibility)\s+(conceal|noconceal)\s*$/) { + or /^\s*(visibility)\s+(conceal|noconceal)\s*$/ + or (/^\s*(\w+)\s+(.+)\s*$/ and $map_field{$1})) { ($1 => $2); } else { (); @@ -4396,7 +4495,14 @@ sub restore_users { } split /\n/, $para }; + next unless defined $user->{email} and length $user->{email}; + $user->{update_date} = $time; + # Compat. <= 6.2.44 + # This is needed for dump by earlier version of Sympa. + $user->{inclusion} ||= ($user->{update_date} || time) + if $user->{included}; + $self->_add_list_admin($role, $user, replace => 1) and $changed++; } @@ -4412,8 +4518,9 @@ sub restore_users { WHERE role_admin = ? AND list_admin = ? AND robot_admin = ? AND subscribed_admin = 1 AND - (included_admin IS NULL OR included_admin = 0) AND - (update_epoch_admin IS NULL OR update_epoch_admin < ?)}, + inclusion_admin IS NULL AND + (update_epoch_admin IS NULL OR + update_epoch_admin < ?)}, $role, $self->{'name'}, $self->{'domain'}, $time ) @@ -4429,8 +4536,10 @@ sub restore_users { SET subscribed_admin = 0, update_epoch_admin = ? WHERE role_admin = ? AND list_admin = ? AND robot_admin = ? AND - subscribed_admin = 1 AND included_admin = 1 AND - (update_epoch_admin IS NULL OR update_epoch_admin < ?)}, + subscribed_admin = 1 AND + inclusion_admin IS NOT NULL AND + (update_epoch_admin IS NULL OR + update_epoch_admin < ?)}, $time, $role, $self->{'name'}, $self->{'domain'}, $time @@ -4446,2419 +4555,291 @@ sub restore_users { $lock_fh->close; } -## include a remote sympa list as subscribers. -sub _include_users_remote_sympa_list { - my ($self, $users, $param, $dir, $robot, $default_user_options, $tied) = - @_; +# Moved or deprecated: +#sub _include_users_remote_sympa_list; +# -> Sympa::DataSource::RemoteDump class. +#sub _get_https; +# -> No longer used. +#sub _include_users_list; +# -> Sympa::DataSource::List class. +#sub _include_users_admin; +# -> Never used. +#sub _include_users_file; +# -> Sympa::DataSource::File class. +#sub _include_users_remote_file; +# -> Sympa::DataSource::RemoteFile class. +#sub _include_users_voot_group; +# -> Sympa::DataSource::VOOT class. +#sub _include_users_ldap; +# -> Sympa::DataSource::LDAP class. +#sub _include_users_ldap_2level; +# -> Sympa::DataSource::LDAP2 class. +#sub _include_sql_ca; +# -> Sympa::DataSource::SQL class. +#sub _include_ldap_ca; +# -> Sympa::DataSource::LDAP class. +#sub _include_ldap_2level_ca; +# -> Sympa::DataSource::LDAP2 class. +#sub _include_users_sql; +# -> Sympa::DataSource::SQL class. +#sub _load_list_members_from_include; +# -> Sympa::Request::Handler::include class. +#sub _load_list_admin_from_include; +# -> Sympa::Request::Handler::include class. - my $host = $param->{'host'}; - my $port = $param->{'port'} || '443'; - my $path = $param->{'path'}; - my $cert = $param->{'cert'} || 'list'; - - my $id = Sympa::Datasource::_get_datasource_id($param); - - $log->syslog('debug', '(%s) https://%s:%s/%s using cert %s,', - $self->{'name'}, $host, $port, $path, $cert); +# Load an include admin user file (xx.incl) +#FIXME: Would be merged to _load_list_config_file() which mostly duplicates. +sub _load_include_admin_user_file { + $log->syslog('debug3', '(%s, %s)', @_); + my $self = shift; + my $entry = shift; + + my $output = ''; + my $filename = $entry->{'source'} . '.incl'; + my @data = split ',', $entry->{'source_parameters'} + if defined $entry->{'source_parameters'}; + my $template = Sympa::Template->new($self, subdir => 'data_sources'); + unless ($template->parse({param => [@data]}, $filename, \$output)) { + $log->syslog('err', 'Failed to parse %s', $filename); + return undef; + } + 1 while $output =~ s/(\A|\n)\s+\n/$1\n/g; # Clean empty lines + my @paragraphs = map { [split /\n/, $_] } split /\n\n+/, $output; - my $total = 0; - my $get_total = 0; + my $robot = $self->{'domain'}; - my $cert_file; - my $key_file; + my $pinfo = {}; + # 'include_list' is kept for comatibility with 6.2.15 or earlier. + my @sources = (@sources_providing_listmembers, 'include_list'); + @{$pinfo}{@sources} = + @{Sympa::Robot::list_params($robot) || {}}{@sources}; - $cert_file = $dir . '/cert.pem'; - $key_file = $dir . '/private_key'; - if ($cert eq 'list') { - $cert_file = $dir . '/cert.pem'; - $key_file = $dir . '/private_key'; - } elsif ($cert eq 'robot') { - $cert_file = Sympa::search_fullpath($self, 'cert.pem'); - $key_file = Sympa::search_fullpath($self, 'private_key'); - } - unless ((-r $cert_file) && (-r $key_file)) { - $log->syslog( - 'err', - 'Include remote list https://%s:%s/%s using cert %s, unable to open %s or %s', - $host, - $port, - $path, - $cert, - $cert_file, - $key_file - ); - return undef; - } + my %include; + for my $index (0 .. $#paragraphs) { + my @paragraph = @{$paragraphs[$index]}; - my $getting_headers = 1; + my $pname; - my %user; - my $email; + ## Clean paragraph, keep comments + for my $i (0 .. $#paragraph) { + my $changed = undef; + for my $j (0 .. $#paragraph) { + if ($paragraph[$j] =~ /^\s*\#/) { + chomp($paragraph[$j]); + push @{$include{'comment'}}, $paragraph[$j]; + splice @paragraph, $j, 1; + $changed = 1; + } elsif ($paragraph[$j] =~ /^\s*$/) { + splice @paragraph, $j, 1; + $changed = 1; + } - foreach my $line ( - _get_https( - $host, $port, $path, - $cert_file, - $key_file, - { 'key_passwd' => $Conf::Conf{'key_passwd'}, - 'cafile' => $Conf::Conf{'cafile'}, - 'capath' => $Conf::Conf{'capath'} + last if $changed; } - ) - ) { - chomp $line; - - if ($getting_headers) { # ignore http headers - next - unless ( - $line =~ /^(date|update_date|email|reception|visibility)/); - } - undef $getting_headers; - if ($line =~ /^\s*email\s+(.+)\s*$/o) { - $user{'email'} = $email = $1; - $log->syslog('debug', 'Email found %s', $email); - $get_total++; + last unless $changed; } - $user{'gecos'} = $1 if ($line =~ /^\s*gecos\s+(.+)\s*$/o); - next unless ($line =~ /^$/); + ## Empty paragraph + next unless ($#paragraph > -1); - unless ($user{'email'}) { - $log->syslog('debug', 'Ignoring block without email definition'); + ## Look for first valid line + unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) { + $log->syslog( + 'info', + 'Bad paragraph "%s" in %s', + join("\n", @paragraph), $filename + ); next; } - my %u; - ## Check if user has already been included - if ($users->{$email}) { - $log->syslog('debug3', 'Ignore %s because already member', - $email); - if ($tied) { - %u = split "\n", $users->{$email}; - } else { - %u = %{$users->{$email}}; - } - } else { - $log->syslog('debug3', 'Add new subscriber %s', $email); - %u = %{$default_user_options}; - $total++; - } - $u{'email'} = $user{'email'}; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } - $u{'gecos'} = $user{'gecos'}; - delete $user{'gecos'}; - - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); - - if ($tied) { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - delete $user{$email}; - undef $email; - - } - $log->syslog('info', - '%d included users from list (%d subscribers) https://%s:%s%s', - $total, $get_total, $host, $port, $path); - return $total; -} - -# Requests a document using HTTPS. Returns status and content. -# Old name: Sympa::Fetch::get_https(). -sub _get_https { - $log->syslog('debug2', '(%s, %s, %s, %s, %s, %s)', @_); - my $host = shift; - my $port = shift; - my $path = shift; - my $client_cert = shift; - my $client_key = shift; - my $ssl_data = shift; - - my $key_passwd = $ssl_data->{'key_passwd'}; - my $trusted_ca_file = $ssl_data->{'cafile'}; - my $trusted_ca_path = $ssl_data->{'capath'}; - - unless ($IO::Socket::SSL::VERSION) { - $log->syslog('err', - 'Unable to use SSL library. IO::Socket::SSL required. Install it first' - ); - return undef; - } - - my $ssl_socket = IO::Socket::SSL->new( - SSL_use_cert => 1, - SSL_verify_mode => 0x01, - SSL_cert_file => $client_cert, - SSL_key_file => $client_key, - SSL_passwd_cb => sub { return ($key_passwd) }, - ($trusted_ca_file ? (SSL_ca_file => $trusted_ca_file) : ()), - ($trusted_ca_path ? (SSL_ca_path => $trusted_ca_path) : ()), - PeerAddr => $host, - PeerPort => $port, - Proto => 'tcp', - Timeout => '5' - ); - - unless ($ssl_socket) { - $log->syslog('err', 'Error %s unable to connect https://%s:%s/', - IO::Socket::SSL::errstr(), $host, $port); - return undef; - } - $log->syslog('debug', 'Connected to https://%s:%s/', - IO::Socket::SSL::errstr(), $host, $port); - - if (ref($ssl_socket) eq "IO::Socket::SSL") { - my $subject_name = $ssl_socket->peer_certificate("subject"); - my $issuer_name = $ssl_socket->peer_certificate("issuer"); - my $cipher = $ssl_socket->get_cipher(); - $log->syslog('debug', - 'SSL peer certificate %s issued by %s. Cipher used %s', - $subject_name, $issuer_name, $cipher); - } - - print $ssl_socket "GET $path HTTP/1.0\nHost: $host\n\n"; - $log->syslog('debug', 'Requested GET %s HTTP/1.1', $path); - - $log->syslog('debug', 'Get_https reading answer'); - my @result; - while (my $line = $ssl_socket->getline) { - push @result, $line; - } - - $ssl_socket->close(SSL_no_shutdown => 1); - $log->syslog('debug', 'Disconnected'); - - return (@result); -} - -## include a list as subscribers. -sub _include_users_list { - my $self = shift; - my $users = shift; - my $incl = shift; - my $default_user_options = shift; - my $tied = shift; - - my $robot = $self->{'domain'}; - my $source_id = lc $incl->{listname}; - $source_id = sprintf '%s@%s', $source_id, $self->{'domain'} - unless 0 < index($source_id, '@'); - my $filter = $incl->{filter}; - my $id = Sympa::Datasource::_get_datasource_id($incl); - - my $total = 0; - if (defined $filter and length $filter) { - chomp $filter; - # Build tt2. - $filter =~ - s/^((?:USE\s[^;]+;)*)(.+)/[% TRY %][% $1 %][%IF $2 %]1[%END%][% CATCH %][% error %][%END%]/; - $log->syslog('notice', 'Applying filter on included list %s : %s', - $source_id, $filter); - } - - my $includelist; - - # The included list is local or in another local robot - $includelist = Sympa::List->new($source_id); + $pname = $1; - unless ($includelist) { - $log->syslog('info', 'Included list %s unknown', $source_id); - return undef; - } + # Parameter aliases (compatibility concerns). + my $alias = $pinfo->{$pname}{'obsolete'}; + if ($alias and $pinfo->{$alias}) { + $paragraph[0] =~ s/^\s*$pname/$alias/; + $pname = $alias; + } - for ( - my $user = $includelist->get_first_list_member(); - $user; - $user = $includelist->get_next_list_member() - ) { - # Do we need filtering ? - if (defined $filter and length $filter) { - # Prepare available variables - my $variables = {}; - $variables->{$_} = $user->{$_} foreach (keys %$user); - - # Rename date to avoid conflicts with date tt2 plugin and make name clearer - $variables->{subscription_date} = $variables->{date}; - delete $variables->{date}; - - # Aliases - $variables->{ca} = $user->{custom_attributes}; - - # Status filters - $variables->{isSubscriberOf} = sub { - my $list = Sympa::List->new(shift, $robot); - return defined $list - ? $list->is_list_member($user->{email}) - : undef; - }; - $variables->{isEditorOf} = sub { - my $list = Sympa::List->new(shift, $robot); - return - defined $list - ? $list->is_admin('actual_editor', $user->{email}) - : undef; - }; - $variables->{isOwnerOf} = sub { - my $list = Sympa::List->new(shift, $robot); - return - defined $list - ? ($list->is_admin('owner', $user->{email}) - || Sympa::is_listmaster($list, $user->{email})) - : undef; - }; + unless ($pinfo->{$pname}) { + $log->syslog('info', 'Unknown parameter "%s" in %s', + $pname, $filename); + next; + } - # Run the test - my $result; - my $template = Sympa::Template->new(undef); - unless ($template->parse($variables, \($filter), \$result)) { - $log->syslog( - 'err', - 'Error while applying filter "%s" : %s, aborting include', - $filter, - $template->{last_error} - ); - return undef; + ## Uniqueness + if (defined $include{$pname}) { + unless (($pinfo->{$pname}{'occurrence'} eq '0-n') + or ($pinfo->{$pname}{'occurrence'} eq '1-n')) { + $log->syslog('info', 'Multiple parameter "%s" in %s', + $pname, $filename); } - chomp $result; + } - if ($result !~ /^1?$/) - { # Anything not 1 or empty result is an error + ## Line or Paragraph + if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') { + ## This should be a paragraph + unless ($#paragraph > 0) { $log->syslog( - 'err', - 'Error while applying filter "%s" : %s, aborting include', - $filter, - $result + 'info', + 'Expecting a paragraph for "%s" parameter in %s, ignore it', + $pname, + $filename ); - return undef; + next; } - next - unless ($result =~ /1/) - ; # skip user if filter returned false (= empty result) - } - - my %u; + ## Skipping first line + shift @paragraph; - ## Check if user has already been included - if ($users->{$user->{'email'}}) { - if ($tied) { - %u = split "\n", $users->{$user->{'email'}}; - } else { - %u = %{$users->{$user->{'email'}}}; - } - } else { - %u = %{$default_user_options}; - $total++; - } + my %hash; + for my $i (0 .. $#paragraph) { + next if ($paragraph[$i] =~ /^\s*\#/); - my $email = $u{'email'} = $user->{'email'}; - $u{'gecos'} = $user->{'gecos'}; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } + unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) { + $log->syslog('info', 'Bad line "%s" in %s', + $paragraph[$i], $filename); + } - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); + my $key = $1; - if ($tied) { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - } - $log->syslog('info', "%d included users from list %s", - $total, $includelist); - return $total; -} + # Subparameter aliases (compatibility concerns). + # Note: subparameter alias was introduced by 6.2.15. + my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'}; + if ($alias and $pinfo->{$pname}{'format'}{$alias}) { + $paragraph[$i] =~ s/^\s*$key/$alias/; + $key = $alias; + } -## include a lists owners lists privileged_owners or lists_editors. -sub _include_users_admin { - my ($users, $selection, $role, $default_user_options, $tied) = @_; -# il faut préparer une liste de hash avec le nom de liste, le nom de robot, -# le répertoire de la liset pour appeler -# load_admin_file décommanter le include_admin - my $lists; + unless (defined $pinfo->{$pname}{'file_format'}{$key}) { + $log->syslog('info', + 'Unknown key "%s" in paragraph "%s" in %s', + $key, $pname, $filename); + next; + } - unless ($role eq 'listmaster') { + unless ($paragraph[$i] =~ + /^\s*$key(?:\s+($pinfo->{$pname}{'file_format'}{$key}{'file_format'}))?\s*$/i + ) { + chomp($paragraph[$i]); + $log->syslog('info', + 'Bad entry "%s" for key "%s", paragraph "%s" in %s', + $paragraph[$i], $key, $pname, $filename); + next; + } - if ($selection =~ /^\*\@(\S+)$/) { - $lists = get_lists($1); - my $robot = $1; - } else { - $selection =~ /^(\S+)@(\S+)$/; - $lists->[0] = $1; - } - - foreach my $list (@$lists) { - #my $admin = $list->_load_list_config_file; - } - } -} - -sub _include_users_file { - my ($users, $filename, $default_user_options, $tied) = @_; - $log->syslog('debug2', '(%s)', $filename); - - my $total = 0; - - unless (open(INCLUDE, "$filename")) { - $log->syslog('err', 'Unable to open file "%s"', $filename); - return undef; - } - $log->syslog('debug2', 'Including file %s', $filename); - - my $id = Sympa::Datasource::_get_datasource_id($filename); - my $lines = 0; - my $emails_found = 0; - my $email_regexp = Sympa::Regexps::email(); - - while () { - if ($lines > 49 && $emails_found == 0) { - $log->syslog( - 'err', - 'Too much errors in file %s (%s lines, %s emails found). Source file probably corrupted. Cancelling', - $filename, - $lines, - $emails_found - ); - return undef; - } - - ## Each line is expected to start with a valid email address - ## + an optional gecos - ## Empty lines are skipped - next if /^\s*$/; - next if /^\s*\#/; - - ## Skip badly formed emails - unless (/^\s*($email_regexp)(\s*(\S.*))?\s*$/) { - $log->syslog('err', 'Skip badly formed line: "%s"', $_); - next; - } - - my $email = Sympa::Tools::Text::canonic_email($1); - - unless (Sympa::Tools::Text::valid_email($email)) { - $log->syslog('err', 'Skip badly formed email address: "%s"', - $email); - next; - } - - $lines++; - next unless $email; - my $gecos = $5; - $emails_found++; - - my %u; - ## Check if user has already been included - if ($users->{$email}) { - if ($tied) { - %u = split "\n", $users->{$email}; - } else { - %u = %{$users->{$email}}; - } - } else { - %u = %{$default_user_options}; - $total++; - } - $u{'email'} = $email; - $u{'gecos'} = $gecos; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } - - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); - - if ($tied) { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - } - close INCLUDE; - - $log->syslog('info', '%d included users from file %s', $total, $filename); - return $total; -} - -sub _include_users_remote_file { - my ($users, $param, $default_user_options, $tied) = @_; - - my $url = $param->{'url'}; - - $log->syslog('debug', '(%s)', $url); - - my $total = 0; - my $id = Sympa::Datasource::_get_datasource_id($param); - - my $fetch = - LWP::UserAgent->new(agent => 'Sympa/' . Sympa::Constants::VERSION); - my $req = HTTP::Request->new(GET => $url); - - if (defined $param->{'user'} && defined $param->{'passwd'}) { - $req->authorization_basic($param->{'user'}, $param->{'passwd'}); - } - - my $res = $fetch->request($req); - - # check the outcome - if ($res->is_success) { - my @remote_file = split(/\n/, $res->content); - my $lines = 0; - my $emails_found = 0; - my $email_regexp = Sympa::Regexps::email(); - - # forgot headers (all line before one that contain a email - foreach my $line (@remote_file) { - if ($lines > 49 && $emails_found == 0) { - $log->syslog( - 'err', - 'Too much errors in file %s (%s lines, %s emails found). Source file probably corrupted. Cancelling', - $url, - $lines, - $emails_found - ); - return undef; - } - - ## Each line is expected to start with a valid email address - ## + an optional gecos - ## Empty lines are skipped - next if ($line =~ /^\s*$/); - next if ($line =~ /^\s*\#/); - - ## Skip badly formed emails - unless ($line =~ /^\s*($email_regexp)(\s*(\S.*))?\s*$/) { - $log->syslog('err', 'Skip badly formed line: "%s"', $line); - next; - } - - my $email = Sympa::Tools::Text::canonic_email($1); - - unless (Sympa::Tools::Text::valid_email($email)) { - $log->syslog('err', 'Skip badly formed email address: "%s"', - $line); - next; - } - - $lines++; - next unless $email; - my $gecos = $5; - $emails_found++; - - my %u; - ## Check if user has already been included - if ($users->{$email}) { - if ($tied) { - %u = split "\n", $users->{$email}; - } else { - %u = %{$users->{$email}}; - } - } else { - %u = %{$default_user_options}; - $total++; - } - $u{'email'} = $email; - $u{'gecos'} = $gecos; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } - - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); - - if ($tied) { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - } - } else { - $log->syslog('err', 'Unable to fetch remote file %s: %s', - $url, $res->message()); - return undef; - } - - #FIXME: Reset http credentials - - $log->syslog('info', '%d included users from remote file %s', - $total, $url); - return $total; -} - -## Returns a list of subscribers extracted from a remote LDAP Directory -sub _include_users_ldap { - my ($users, $id, $source, $db, $default_user_options, $tied) = @_; - $log->syslog('debug2', ''); - - my $ldap_suffix = $source->{'suffix'}; - my $ldap_filter = $source->{'filter'}; - my $ldap_attrs = $source->{'attrs'}; - my $ldap_select = $source->{'select'}; - - my @attrs = split /\s*,\s*/, $ldap_attrs; - my ($email_attr, $gecos_attr) = @attrs; - - ## LDAP and query handler - my $mesg; - - ## Connection timeout (default is 120) - #my $timeout = 30; - - unless ($db and $db->connect) { - $log->syslog('err', 'Unable to connect to the LDAP server "%s"', - $source->{'host'}); - return undef; - } - $log->syslog('debug2', - 'Searching on server %s; suffix %s; filter %s; attrs: %s', - $source->{'host'}, $ldap_suffix, $ldap_filter, $ldap_attrs); - $mesg = $db->do_operation( - 'search', - base => "$ldap_suffix", - filter => "$ldap_filter", - attrs => [@attrs], - scope => "$source->{'scope'}" - ); - unless ($mesg) { - $log->syslog( - 'err', - 'LDAP search (single level) failed: %s (searching on server %s; suffix %s; filter %s; attrs: %s)', - $db->error(), - $source->{'host'}, - $ldap_suffix, - $ldap_filter, - $ldap_attrs - ); - return undef; - } - - ## Counters. - my $total = 0; - my @emails; - my %emailsViewed; - - while (my $e = $mesg->shift_entry) { - my $emailentry = $e->get_value($email_attr, asref => 1); - my $gecosentry = $e->get_value($gecos_attr, asref => 1); - $gecosentry = $gecosentry->[0] if ref $gecosentry eq 'ARRAY'; - - unless (defined $emailentry) { - next; - } elsif (ref $emailentry eq 'ARRAY') { - # Multiple values - foreach my $email (@{$emailentry}) { - my $cleanmail = Sympa::Tools::Text::canonic_email($email); - ## Skip badly formed emails - unless (Sympa::Tools::Text::valid_email($email)) { - $log->syslog('err', - 'Skip badly formed email address: "%s"', $email); - next; - } - - next if $emailsViewed{$cleanmail}; - push @emails, [$cleanmail, $gecosentry]; - $emailsViewed{$cleanmail} = 1; - last if $ldap_select eq 'first'; - } - } else { #FIMXE: Probably not reached due to asref. - my $cleanmail = Sympa::Tools::Text::canonic_email($emailentry); - ## Skip badly formed emails - unless (Sympa::Tools::Text::valid_email($emailentry)) { - $log->syslog('err', 'Skip badly formed email address: "%s"', - $emailentry); - next; - } - - next if $emailsViewed{$cleanmail}; - push @emails, [$cleanmail, $gecosentry]; - $emailsViewed{$cleanmail} = 1; - } - } - - unless ($db->disconnect()) { - $log->syslog('notice', 'Can\'t unbind from LDAP server %s', - $source->{'host'}); - return undef; - } - - foreach my $emailgecos (@emails) { - my ($email, $gecos) = @$emailgecos; - next if ($email =~ /^\s*$/); - - $email = Sympa::Tools::Text::canonic_email($email); - my %u; - ## Check if user has already been included - if ($users->{$email}) { - if ($tied) { - %u = split "\n", $users->{$email}; - } else { - %u = %{$users->{$email}}; - } - } else { - %u = %{$default_user_options}; - $total++; - } - - $u{'email'} = $email; - $u{'gecos'} = $gecos if ($gecos); - $u{'date'} = time; - $u{'update_date'} = time; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } - - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); - - if ($tied) { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - } - - $log->syslog('debug2', 'Unbinded from LDAP server %s', $source->{'host'}); - $log->syslog('info', '%d included users from LDAP query', $total); - - return $total; -} - -## Returns a list of subscribers extracted indirectly from a remote LDAP -## Directory using a two-level query -sub _include_users_ldap_2level { - my ($users, $id, $source, $db, $default_user_options, $tied) = @_; - $log->syslog('debug2', ''); - - my $ldap_suffix1 = $source->{'suffix1'}; - my $ldap_filter1 = $source->{'filter1'}; - my $ldap_attrs1 = $source->{'attrs1'}; - my $ldap_select1 = $source->{'select1'}; - my $ldap_scope1 = $source->{'scope1'}; - my $ldap_regex1 = $source->{'regex1'}; - my $ldap_suffix2 = $source->{'suffix2'}; - my $ldap_filter2 = $source->{'filter2'}; - my $ldap_attrs2 = $source->{'attrs2'}; - my $ldap_select2 = $source->{'select2'}; - my $ldap_scope2 = $source->{'scope2'}; - my $ldap_regex2 = $source->{'regex2'}; - my @sync_errors = (); - - my ($email_attr, $gecos_attr) = split(/\s*,\s*/, $ldap_attrs2); - my @ldap_attrs2 = ($email_attr); - push @ldap_attrs2, $gecos_attr if ($gecos_attr); - - ## LDAP and query handler - my $mesg; - - unless ($db and $db->connect()) { - $log->syslog('err', 'Unable to connect to the LDAP server "%s"', - $source->{'host'}); - return undef; - } - - $log->syslog('debug2', - 'Searching on server %s; suffix %s; filter %s; attrs: %s', - $source->{'host'}, $ldap_suffix1, $ldap_filter1, $ldap_attrs1); - $mesg = $db->do_operation( - 'search', - base => "$ldap_suffix1", - filter => "$ldap_filter1", - attrs => ["$ldap_attrs1"], - scope => "$ldap_scope1" - ); - unless ($mesg) { - $log->syslog( - 'err', - 'LDAP search (1st level) failed: %s (searching on server %s; suffix %s; filter %s; attrs: %s)', - $db->error(), - $source->{'host'}, - $ldap_suffix1, - $ldap_filter1, - $ldap_attrs1 - ); - return undef; - } - - ## Counters. - my $total = 0; - - ## returns a reference to a HASH where the keys are the DNs - ## the second level hash's hold the attributes - - my (@attrs, @emails); - - while (my $e = $mesg->shift_entry) { - my $entry = $e->get_value($ldap_attrs1, asref => 1); - - unless (defined $entry) { - next; - } elsif (ref $entry eq 'ARRAY') { - # Multiple values - foreach my $attr (@{$entry}) { - next if $ldap_select1 eq 'regex' and $attr !~ /$ldap_regex1/; - push @attrs, $attr; - last if $ldap_select1 eq 'first'; - } - } else { #FIXME: Probably not reached due to asref - next if $ldap_select1 eq 'regex' and $entry !~ /$ldap_regex1/; - push @attrs, $entry; - } - } - - my %emailsViewed; - - my ($suffix2, $filter2); - foreach my $attr (@attrs) { - my $escaped_attr; - - # Escape LDAP characters occurring in attribute for search base. - if ($ldap_suffix2 =~ /[[]attrs1[]]\z/) { - # [attrs1] should be a DN, because it is search base or its root. - # Note: Don't canonicalize DN, because some LDAP servers e.g. AD - # don't conform to standard on matching rule and canonicalization - # might hurt integrity (cf. GH #474). - unless (defined Net::LDAP::Util::canonical_dn($attr)) { - $log->syslog('err', 'Attribute value is not a DN: %s', $attr); - next; - } - $escaped_attr = $attr; - } else { - # [attrs1] may be an attributevalue in DN. - $escaped_attr = Net::LDAP::Util::escape_dn_value($attr); - } - ($suffix2 = $ldap_suffix2) =~ s/\[attrs1\]/$escaped_attr/g; - - # Escape LDAP characters occurring in attribute for search filter. - $escaped_attr = Net::LDAP::Util::escape_filter_value($attr); - ($filter2 = $ldap_filter2) =~ s/\[attrs1\]/$escaped_attr/g; - - $log->syslog('debug2', - 'Searching on server %s; suffix %s; filter %s; attrs: %s', - $source->{'host'}, $suffix2, $filter2, $ldap_attrs2); - $mesg = $db->do_operation( - 'search', - base => "$suffix2", - filter => "$filter2", - attrs => [@ldap_attrs2], - scope => "$ldap_scope2" - ); - unless ($mesg) { - $log->syslog( - 'err', - 'LDAP search (2nd level) failed: %s. Node: %s (searching on server %s; suffix %s; filter %s; attrs: %s)', - $db->error(), - $attr, - $source->{'host'}, - $suffix2, - $filter2, - $ldap_attrs2 - ); - push @sync_errors, - { - 'error', $db->error(), - 'host', $source->{'host'}, - 'suffix2', $suffix2, - 'fliter2', $filter2, - 'ldap_attrs2', $ldap_attrs2 - }; - next; - } - - ## returns a reference to a HASH where the keys are the DNs - ## the second level hash's hold the attributes - - while (my $e = $mesg->shift_entry) { - my $emailentry = $e->get_value($email_attr, asref => 1); - my $gecosentry = $e->get_value($gecos_attr, asref => 1); - $gecosentry = $gecosentry->[0] if ref $gecosentry eq 'ARRAY'; - - unless (defined $emailentry) { - next; - } elsif (ref $emailentry eq 'ARRAY') { - # Multiple values - foreach my $email (@{$emailentry}) { - my $cleanmail = Sympa::Tools::Text::canonic_email($email); - ## Skip badly formed emails - unless (Sympa::Tools::Text::valid_email($email)) { - $log->syslog('err', - 'Skip badly formed email address: "%s"', $email); - next; - } - - next - if $ldap_select2 eq 'regex' - and $cleanmail !~ /$ldap_regex2/; - next if $emailsViewed{$cleanmail}; - push @emails, [$cleanmail, $gecosentry]; - $emailsViewed{$cleanmail} = 1; - last if $ldap_select2 eq 'first'; - } - } else { #FIXME: Probably not reached due to asref - my $cleanmail = - Sympa::Tools::Text::canonic_email($emailentry); - ## Skip badly formed emails - unless (Sympa::Tools::Text::valid_email($emailentry)) { - $log->syslog('err', - 'Skip badly formed email address: "%s"', $emailentry); - next; - } - - next - if $ldap_select2 eq 'regex' - and $cleanmail !~ /$ldap_regex2/; - next if $emailsViewed{$cleanmail}; - push @emails, [$cleanmail, $gecosentry]; - $emailsViewed{$cleanmail} = 1; - } - } - } - - unless ($db->disconnect()) { - $log->syslog('err', 'Can\'t unbind from LDAP server %s', - $source->{'host'}); - return undef; - } - - foreach my $emailgecos (@emails) { - my ($email, $gecos) = @$emailgecos; - next if ($email =~ /^\s*$/); - - $email = Sympa::Tools::Text::canonic_email($email); - my %u; - ## Check if user has already been included - if ($users->{$email}) { - if ($tied) { - %u = split "\n", $users->{$email}; - } else { - %u = %{$users->{$email}}; - } - } else { - %u = %{$default_user_options}; - $total++; - } - - $u{'email'} = $email; - $u{'gecos'} = $gecos if ($gecos); - $u{'date'} = time; - $u{'update_date'} = time; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } - - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); - - if ($tied) { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - } - - $log->syslog('debug2', 'Unbinded from LDAP server %s', $source->{'host'}); - $log->syslog('info', '%d included users from LDAP query 2level', $total); - - my $result; - $result->{'total'} = $total; - if ($#sync_errors > -1) { $result->{'errors'} = \@sync_errors; } - return $result; -} - -sub _include_sql_ca { - my $source = shift; - my $db = shift; - - return {} unless $db and $db->connect(); - - $log->syslog( - 'debug', - '%s, email_entry = %s', - $source->{'sql_query'}, - $source->{'email_entry'} - ); - - my $sth = $db->do_prepared_query($source->{'sql_query'}); - my $mailkey = $source->{'email_entry'}; - my $ca = $sth->fetchall_hashref($mailkey); - my $result; - foreach my $email (keys %{$ca}) { - foreach my $custom_attribute (keys %{$ca->{$email}}) { - $result->{$email}{$custom_attribute}{'value'} = - $ca->{$email}{$custom_attribute} - unless ($custom_attribute eq $mailkey); - } - } - return $result; -} - -sub _include_ldap_ca { - my $source = shift; - my $db = shift; - - return {} unless $db and $db->connect(); - - $log->syslog('debug', 'Server %s; suffix %s; filter %s; attrs: %s', - $source->{'host'}, $source->{'suffix'}, $source->{'filter'}, - $source->{'attrs'}); - - my @attrs = split(/\s*,\s*/, $source->{'attrs'}); - - my $mesg = $db->do_operation( - 'search', - base => $source->{'suffix'}, - filter => $source->{'filter'}, - attrs => [@attrs], - scope => $source->{'scope'} - ); - unless ($mesg) { - $log->syslog( - 'err', - 'LDAP search (single level) failed: %s (searching on server %s; suffix %s; filter %s; attrs: %s)', - $db->error(), - $source->{'host'}, - $source->{'suffix'}, - $source->{'filter'}, - $source->{'attrs'} - ); - return {}; - } - - my $attributes; - while (my $entry = $mesg->shift_entry) { - my $email = $entry->get_value($source->{'email_entry'}); - next unless ($email); - foreach my $attr (@attrs) { - next if ($attr eq $source->{'email_entry'}); - $attributes->{$email}{$attr}{'value'} = $entry->get_value($attr); - } - } - - return $attributes; -} - -sub _include_ldap_2level_ca { - my $source = shift; - my $db = shift; - - return {} unless $db and $db->connect(); - - return {}; - - $log->syslog('debug', 'Server %s; suffix %s; filter %s; attrs: %s', - $source->{'host'}, $source->{'suffix'}, $source->{'filter'}, - $source->{'attrs'}); - - my @attrs = split(/\s*,\s*/, $source->{'attrs'}); - - my $mesg = $db->do_operation( - 'search', - base => $source->{'suffix'}, - filter => $source->{'filter'}, - attrs => [@attrs], - scope => $source->{'scope'} - ); - unless ($mesg) { - $log->syslog( - 'err', - 'LDAP search (single level) failed: %s (searching on server %s; suffix %s; filter %s; attrs: %s)', - $db->error(), - $source->{'host'}, - $source->{'suffix'}, - $source->{'filter'}, - $source->{'attrs'} - ); - return {}; - } - - my $attributes; - while (my $entry = $mesg->shift_entry) { - my $email = $entry->get_value($source->{'email_entry'}); - next unless ($email); - foreach my $attr (@attrs) { - next if ($attr eq $source->{'email_entry'}); - $attributes->{$email}{$attr}{'value'} = $entry->get_value($attr); - } - } - - return $attributes; -} - -## Returns a list of subscribers extracted from an remote Database -sub _include_users_sql { - my ($users, $id, $source, $db, $default_user_options, $tied, - $fetch_timeout) - = @_; - - my $sth; - unless ($db - and $db->connect() - and $sth = $db->do_prepared_query($source->{'sql_query'})) { - $log->syslog( - 'err', - 'Unable to connect to SQL datasource with parameters host: %s, database: %s', - $source->{'host'}, - $source->{'db_name'} - ); - return undef; - } - ## Counters. - my $total = 0; - - ## Process the SQL results - my $array_of_users = - Sympa::Process::eval_in_time(sub { $sth->fetchall_arrayref }, - $fetch_timeout); - $sth->finish; - - unless (ref $array_of_users eq 'ARRAY') { - $log->syslog('err', 'Failed to include users from %s', - $source->{'name'}); - return undef; - } - - foreach my $row (@{$array_of_users}) { - my $email = $row->[0]; ## only get first field - my $gecos = $row->[1]; ## second field (if it exists) is gecos - ## Empty value - next if ($email =~ /^\s*$/); - - $email = Sympa::Tools::Text::canonic_email($email); - - ## Skip badly formed emails - unless (Sympa::Tools::Text::valid_email($email)) { - $log->syslog('err', 'Skip badly formed email address: "%s"', - $email); - next; - } - - my %u; - ## Check if user has already been included - if ($users->{$email}) { - if ($tied eq 'tied') { - %u = split "\n", $users->{$email}; - } else { - %u = %{$users->{$email}}; - } - } else { - %u = %{$default_user_options}; - $total++; - } - - $u{'email'} = $email; - $u{'gecos'} = $gecos if ($gecos); - $u{'date'} = time; - $u{'update_date'} = time; - if ($u{'id'}) { - $u{'id'} = add_source_id($u{'id'}, $id); - } else { - $u{'id'} = $id; - } - - $u{'visibility'} = $default_user_options->{'visibility'} - if (defined $default_user_options->{'visibility'}); - $u{'reception'} = $default_user_options->{'reception'} - if (defined $default_user_options->{'reception'}); - $u{'profile'} = $default_user_options->{'profile'} - if (defined $default_user_options->{'profile'}); - $u{'info'} = $default_user_options->{'info'} - if (defined $default_user_options->{'info'}); - - if ($tied eq 'tied') { - $users->{$email} = join("\n", %u); - } else { - $users->{$email} = \%u; - } - } - $db->disconnect(); - $log->syslog('info', '%d included users from SQL query', $total); - return $total; -} - -## Loads the list of subscribers from an external include source -sub _load_list_members_from_include { - $log->syslog('debug2', '(%s, %s)', @_); - my $self = shift; - my $old_subs = shift; - - # To prevent overwriting actual list config. - my $sources = { - map { - ($_ => (Sympa::Tools::Data::dup_var($self->{'admin'}{$_}) || [])) - } @sources_providing_listmembers - }; - - my %users; - my @depend_on; - my $total = 0; - my @errors; - my @ex_sources; - - foreach my $entry (@{$self->{'admin'}{'member_include'}}) { - next unless $entry; - - my $include_file = Sympa::search_fullpath( - $self, - $entry->{'source'} . '.incl', - subdir => 'data_sources' - ); - - unless (defined $include_file) { - $log->syslog('err', 'The file %s.incl doesn\'t exist', - $entry->{'source'}); - return undef; - } - - my $include_member; - my %parsing; - - $parsing{'data'} = $entry->{'source_parameters'}; - $parsing{'template'} = "$entry->{'source'}\.incl"; - - my $name = "$entry->{'source'}\.incl"; - - my $include_path = $include_file; - if ($include_path =~ s/$name$//) { - $parsing{'include_path'} = $include_path; - $include_member = - $self->_load_include_admin_user_file($include_path, - \%parsing); - } else { - $log->syslog('err', 'Errors to get path of the the file %s.incl', - $entry->{'source'}); - return undef; - } - - if ($include_member and %$include_member) { - foreach my $type (@sources_providing_listmembers) { - my $defs = $include_member->{$type}; - push @{$sources->{$type}}, @$defs if $defs and @$defs; - } - } - } - - foreach my $type (@sources_providing_listmembers) { - foreach my $tmp_incl (@{$sources->{$type}}) { - # Work with a copy of admin hash branch to avoid including - # temporary variables into the actual admin hash.[bug #3182] - my $incl = Sympa::Tools::Data::dup_var($tmp_incl); - - # As CA certificate is required, take it from site config. - if ( ref $incl eq 'HASH' - and $incl->{use_tls} - and $incl->{use_tls} ne 'none' - and not $incl->{ca_file} - and not $incl->{ca_path}) { - $incl->{ca_file} = $Conf::Conf{'cafile'} - if $Conf::Conf{'cafile'}; - $incl->{ca_path} = $Conf::Conf{'capath'} - if $Conf::Conf{'capath'}; - } - - my $source_id = Sympa::Datasource::_get_datasource_id($tmp_incl); - my $source_is_new = defined $old_subs->{$source_id}; - - # Get the list of users. - # Verify if we can synchronize sources. If it's allowed OR there - # are new sources, we update the list, and can add subscribers. - # If we can't synchronize, we make an array with excluded sources. - - my $included; - if ($type eq 'include_sql_query') { - my $db = Sympa::Database->new( - $incl->{'db_type'}, - %$incl, - db_host => $incl->{'host'}, - db_options => $incl->{'connect_options'}, - db_user => $incl->{'user'}, - db_passwd => $incl->{'passwd'}, - ); - if (Sympa::Datasource::is_allowed_to_sync( - $incl->{'nosync_time_ranges'} - ) - or $source_is_new - ) { - $log->syslog('debug', 'Is_new %d, syncing', - $source_is_new); - $included = _include_users_sql( - \%users, - $source_id, - $incl, - $db, - $self->{'admin'}{'default_user_options'}, - 'untied', - $self->{'admin'}{'sql_fetch_timeout'} - ); - unless (defined $included) { - push @errors, - {'type' => $type, 'name' => $incl->{'name'}}; - } - } else { - my $exclusion_data = { - 'id' => $source_id, - 'name' => $incl->{'name'}, - }; - push @ex_sources, $exclusion_data; - $included = 0; - } - } elsif ($type eq 'include_ldap_query') { - my $db = Sympa::Database->new( - 'LDAP', - %$incl, - bind_dn => $incl->{'user'}, - bind_password => $incl->{'passwd'}, - ); - if (Sympa::Datasource::is_allowed_to_sync( - $incl->{'nosync_time_ranges'} - ) - or $source_is_new - ) { - $included = - _include_users_ldap(\%users, $source_id, $incl, $db, - $self->{'admin'}{'default_user_options'}); - unless (defined $included) { - push @errors, - {'type' => $type, 'name' => $incl->{'name'}}; - } - } else { - my $exclusion_data = { - 'id' => $source_id, - 'name' => $incl->{'name'}, - }; - push @ex_sources, $exclusion_data; - $included = 0; - } - } elsif ($type eq 'include_ldap_2level_query') { - my $db = Sympa::Database->new( - 'LDAP', - %$incl, - bind_dn => $incl->{'user'}, - bind_password => $incl->{'passwd'}, - timeout => $incl->{'timeout1'}, # Note: not "timeout" - ); - if (Sympa::Datasource::is_allowed_to_sync( - $incl->{'nosync_time_ranges'} - ) - or $source_is_new - ) { - my $result = - _include_users_ldap_2level(\%users, $source_id, $incl, - $db, $self->{'admin'}{'default_user_options'}); - if (defined $result) { - $included = $result->{'total'}; - if (defined $result->{'errors'}) { - $log->syslog('err', - 'Errors occurred during the second LDAP passe' - ); - push @errors, - {'type' => $type, 'name' => $incl->{'name'}}; - } - } else { - $included = undef; - push @errors, - {'type' => $type, 'name' => $incl->{'name'}}; - } - } else { - my $exclusion_data = { - 'id' => $source_id, - 'name' => $incl->{'name'}, - }; - push @ex_sources, $exclusion_data; - $included = 0; - } - } elsif ($type eq 'include_remote_sympa_list') { - $included = - $self->_include_users_remote_sympa_list(\%users, $incl, - $self->{'dir'}, $self->{'domain'}, - $self->{'admin'}{'default_user_options'}); - unless (defined $included) { - push @errors, - {'type' => $type, 'name' => $incl->{'name'}}; - } - } elsif ($type eq 'include_sympa_list') { - if ($self->_inclusion_loop('member', $incl, 'recursive')) { - $log->syslog( - 'err', - 'Loop detection in list inclusion: could not include again %s in list %s', - $incl->{name}, - $self - ); - } else { - $included = - $self->_include_users_list(\%users, $incl, - $self->{'admin'}{'default_user_options'}); - unless (defined $included) { - push @errors, - {'type' => $type, 'name' => $incl->{name}}; - } else { - push @depend_on, $incl; - } - } - } elsif ($type eq 'include_file') { - $included = - _include_users_file(\%users, $incl, - $self->{'admin'}{'default_user_options'}); - unless (defined $included) { - push @errors, {'type' => $type, 'name' => $incl}; - } - } elsif ($type eq 'include_remote_file') { - $included = - _include_users_remote_file(\%users, $incl, - $self->{'admin'}{'default_user_options'}); - unless (defined $included) { - push @errors, - {'type' => $type, 'name' => $incl->{'name'}}; - } - } - - unless (defined $included) { - $log->syslog('err', 'Inclusion %s failed in list %s', - $type, $self); - next; - } - $total += $included; - } - } - - ## If an error occurred, return an undef value - my $result = { - users => \%users, - errors => \@errors, - exclusions => \@ex_sources, - depend_on => [ - Sympa::Tools::Data::sort_uniq( - map { - my $source_id = lc $_->{listname}; - $source_id = sprintf '%s@%s', $source_id, - $self->{'domain'} - unless 0 < index($source_id, '@'); - $source_id - } @depend_on - ) - ], - }; - ##use Data::Dumper; - ##if(open OUT, '>/tmp/result') { print OUT Dumper $result; close OUT } - return $result; -} -## Loads the list of admin users from an external include source -sub _load_list_admin_from_include { - my $self = shift; - my $role = shift; - my $name = $self->{'name'}; - - $log->syslog('debug2', '(%s) For list %s', $role, $name); - - my %admin_users; - my @depend_on; - my $total = 0; - my $list_admin = $self->{'admin'}; - my $dir = $self->{'dir'}; - - foreach my $entry (@{$list_admin->{$role . "_include"}}) { - - next unless (defined $entry); - - my %option; - $option{'reception'} = $entry->{'reception'} - if (defined $entry->{'reception'}); - $option{'visibility'} = $entry->{'visibility'} - if (defined $entry->{'visibility'}); - $option{'profile'} = $entry->{'profile'} - if (defined $entry->{'profile'} && ($role eq 'owner')); - - my $include_file = Sympa::search_fullpath( - $self, - $entry->{'source'} . '.incl', - subdir => 'data_sources' - ); - - unless (defined $include_file) { - $log->syslog('err', 'The file %s.incl doesn\'t exist', - $entry->{'source'}); - return undef; - } - - my $include_admin_user; - my %parsing; - - $parsing{'data'} = $entry->{'source_parameters'}; - $parsing{'template'} = "$entry->{'source'}\.incl"; - - my $name = "$entry->{'source'}\.incl"; - - my $include_path = $include_file; - if ($include_path =~ s/$name$//) { - $parsing{'include_path'} = $include_path; - $include_admin_user = - $self->_load_include_admin_user_file($include_path, - \%parsing); - } else { - $log->syslog('err', 'Errors to get path of the the file %s.incl', - $entry->{'source'}); - return undef; - } - - foreach my $type (@sources_providing_listmembers) { - defined $total or last; - - foreach my $tmp_incl (@{$include_admin_user->{$type}}) { - - # Work with a copy of admin hash branch to avoid including - # temporary variables into the actual admin hash. [bug #3182] - my $incl = Sympa::Tools::Data::dup_var($tmp_incl); - - # As CA certificate is required, take it from site config. - if ( ref $incl eq 'HASH' - and $incl->{use_tls} - and $incl->{use_tls} ne 'none' - and not $incl->{ca_file} - and not $incl->{ca_path}) { - $incl->{ca_file} = $Conf::Conf{'cafile'} - if $Conf::Conf{'cafile'}; - $incl->{ca_path} = $Conf::Conf{'capath'} - if $Conf::Conf{'capath'}; - } - - # get the list of admin users - # does it need to define a 'default_admin_user_option'? - my $included; - if ($type eq 'include_sql_query') { - my $db = Sympa::Database->new( - $incl->{'db_type'}, - %$incl, - db_host => $incl->{'host'}, - db_options => $incl->{'connect_options'}, - db_user => $incl->{'user'}, - db_passwd => $incl->{'passwd'}, - ); - $included = _include_users_sql( - \%admin_users, - Sympa::Datasource::_get_datasource_id($incl), - $incl, - $db, - \%option, - 'untied', - $list_admin->{'sql_fetch_timeout'} - ); - } elsif ($type eq 'include_ldap_query') { - my $db = Sympa::Database->new( - 'LDAP', - %$incl, - bind_dn => $incl->{'user'}, - bind_password => $incl->{'passwd'}, - ); - $included = - _include_users_ldap(\%admin_users, - Sympa::Datasource::_get_datasource_id($incl), - $incl, $db, \%option); - } elsif ($type eq 'include_ldap_2level_query') { - my $db = Sympa::Database->new( - 'LDAP', - %$incl, - bind_dn => $incl->{'user'}, - bind_password => $incl->{'passwd'}, - timeout => $incl->{'timeout1'}, # Note: not "timeout" - ); - my $result = - _include_users_ldap_2level(\%admin_users, - Sympa::Datasource::_get_datasource_id($incl), - $incl, $db, \%option); - if (defined $result) { - $included = $result->{'total'}; - if (defined $result->{'errors'}) { - $log->syslog('err', - 'Errors occurred during the second LDAP passe. Please verify your LDAP query.' - ); - } - } else { - $included = undef; - } - } elsif ($type eq 'include_remote_sympa_list') { - $included = - $self->_include_users_remote_sympa_list(\%admin_users, - $incl, $dir, $self->{'domain'}, \%option); - } elsif ($type eq 'include_sympa_list') { - if ($self->_inclusion_loop($role, $incl, 0)) { - #FIXME: Required? - $log->syslog( - 'err', - 'Loop detection in list inclusion: could not include again %s in %s of %s', - $incl->{name}, - $role, - $self - ); - } else { - $included = - $self->_include_users_list(\%admin_users, $incl, - \%option); - unless (defined $included) { - # push @errors, - # {'type' => $type, 'name' => $incl->{name}}; - } else { - push @depend_on, $incl; - } - } - } elsif ($type eq 'include_file') { - $included = - _include_users_file(\%admin_users, $incl, \%option); - } elsif ($type eq 'include_remote_file') { - $included = - _include_users_remote_file(\%admin_users, $incl, - \%option); - } - unless (defined $included) { - $log->syslog('err', 'Inclusion %s %s failed in list %s', - $role, $type, $name); - next; - } - $total += $included; - } - } - - ## If an error occurred, return an undef value - unless (defined $total) { - return undef; - } - } - - return { - users => \%admin_users, - depend_on => [ - Sympa::Tools::Data::sort_uniq( - map { - my $source_id = lc $_->{listname}; - $source_id = sprintf '%s@%s', $source_id, - $self->{'domain'} - unless 0 < index($source_id, '@'); - $source_id - } @depend_on - ) - ], - }; -} - -# Load an include admin user file (xx.incl) -#FIXME: Would be merged to _load_list_config_file() which mostly duplicates. -sub _load_include_admin_user_file { - $log->syslog('debug3', '(%s, %s, %s)', @_); - my $self = shift; - my $file = shift; - my $parsing = shift; - - my $robot = $self->{'domain'}; - - my $pinfo = {}; - # 'include_list' is kept for comatibility with 6.2.15 or earlier. - my @sources = (@sources_providing_listmembers, 'include_list'); - @{$pinfo}{@sources} = - @{Sympa::Robot::list_params($robot) || {}}{@sources}; - - my %include; - my (@paragraphs); - - my @data = split(',', $parsing->{'data'}) if defined $parsing->{'data'}; - my $vars = {'param' => \@data}; - my $output = ''; - - my $template = - Sympa::Template->new(undef, - include_path => [$parsing->{'include_path'}]); - unless ($template->parse($vars, $parsing->{'template'}, \$output)) { - $log->syslog('err', 'Failed to parse %s', $parsing->{'template'}); - return undef; - } - - my @lines = split('\n', $output); - - my $i = 0; - foreach my $line (@lines) { - if ($line =~ /^\s*$/) { - $i++ if $paragraphs[$i]; - } else { - push @{$paragraphs[$i]}, $line; - } - } - - for my $index (0 .. $#paragraphs) { - my @paragraph = @{$paragraphs[$index]}; - - my $pname; - - ## Clean paragraph, keep comments - for my $i (0 .. $#paragraph) { - my $changed = undef; - for my $j (0 .. $#paragraph) { - if ($paragraph[$j] =~ /^\s*\#/) { - chomp($paragraph[$j]); - push @{$include{'comment'}}, $paragraph[$j]; - splice @paragraph, $j, 1; - $changed = 1; - } elsif ($paragraph[$j] =~ /^\s*$/) { - splice @paragraph, $j, 1; - $changed = 1; - } - - last if $changed; - } - - last unless $changed; - } - - ## Empty paragraph - next unless ($#paragraph > -1); - - ## Look for first valid line - unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) { - $log->syslog('info', 'Bad paragraph "%s" in %s', - @paragraph, $file); - next; - } - - $pname = $1; - - # Parameter aliases (compatibility concerns). - my $alias = $pinfo->{$pname}{'obsolete'}; - if ($alias and $pinfo->{$alias}) { - $paragraph[0] =~ s/^\s*$pname/$alias/; - $pname = $alias; - } - - unless ($pinfo->{$pname}) { - $log->syslog('info', 'Unknown parameter "%s" in %s', - $pname, $file); - next; - } - - ## Uniqueness - if (defined $include{$pname}) { - unless (($pinfo->{$pname}{'occurrence'} eq '0-n') - or ($pinfo->{$pname}{'occurrence'} eq '1-n')) { - $log->syslog('info', 'Multiple parameter "%s" in %s', - $pname, $file); - } - } - - ## Line or Paragraph - if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') { - ## This should be a paragraph - unless ($#paragraph > 0) { - $log->syslog( - 'info', - 'Expecting a paragraph for "%s" parameter in %s, ignore it', - $pname, - $file - ); - next; - } - - ## Skipping first line - shift @paragraph; - - my %hash; - for my $i (0 .. $#paragraph) { - next if ($paragraph[$i] =~ /^\s*\#/); - - unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) { - $log->syslog('info', 'Bad line "%s" in %s', - $paragraph[$i], $file); - } - - my $key = $1; - - # Subparameter aliases (compatibility concerns). - # Note: subparameter alias was introduced by 6.2.15. - my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'}; - if ($alias and $pinfo->{$pname}{'format'}{$alias}) { - $paragraph[$i] =~ s/^\s*$key/$alias/; - $key = $alias; - } - - unless (defined $pinfo->{$pname}{'file_format'}{$key}) { - $log->syslog('info', - 'Unknown key "%s" in paragraph "%s" in %s', - $key, $pname, $file); - next; - } - - unless ($paragraph[$i] =~ - /^\s*$key(?:\s+($pinfo->{$pname}{'file_format'}{$key}{'file_format'}))?\s*$/i - ) { - chomp($paragraph[$i]); - $log->syslog('info', - 'Bad entry "%s" for key "%s", paragraph "%s" in %s', - $paragraph[$i], $key, $pname, $file); - next; - } - - $hash{$key} = - $self->_load_list_param($key, $1, - $pinfo->{$pname}{'file_format'}{$key}); - } - - ## Apply defaults & Check required keys - my $missing_required_field; - foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) { - - ## Default value - unless (defined $hash{$k}) { - if (defined $pinfo->{$pname}{'file_format'}{$k}{'default'} - ) { - $hash{$k} = $self->_load_list_param( - $k, - $pinfo->{$pname}{'file_format'}{$k}{'default'}, - $pinfo->{$pname}{'file_format'}{$k} - ); - } - } - ## Required fields - if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1' - and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) { - unless (defined $hash{$k}) { - $log->syslog('info', - 'Missing key "%s" in param "%s" in %s', - $k, $pname, $file); - $missing_required_field++; - } - } - } - - next if $missing_required_field; - - ## Should we store it in an array - if (($pinfo->{$pname}{'occurrence'} =~ /n$/)) { - push @{$include{$pname}}, \%hash; - } else { - $include{$pname} = \%hash; - } - } else { - ## This should be a single line - unless ($#paragraph == 0) { - $log->syslog('info', - 'Expecting a single line for "%s" parameter in %s', - $pname, $file); - } - - unless ($paragraph[0] =~ - /^\s*$pname(?:\s+($pinfo->{$pname}{'file_format'}))?\s*$/i) { - chomp($paragraph[0]); - $log->syslog('info', 'Bad entry "%s" in %s', - $paragraph[0], $file); - next; - } - - my $value = $self->_load_list_param($pname, $1, $pinfo->{$pname}); - - if (($pinfo->{$pname}{'occurrence'} =~ /n$/) - && !(ref($value) =~ /^ARRAY/)) { - push @{$include{$pname}}, $value; - } else { - $include{$pname} = $value; - } - } - } - - _load_include_admin_user_postprocess(\%include); - - return \%include; -} - -## Returns a ref to an array containing the ids (as computed by -## Sympa::Datasource::_get_datasource_id) of the list of memebers given as -## argument. -sub get_list_of_sources_id { - my $self = shift; - my $list_of_subscribers = shift; - - my %old_subs_id; - foreach my $old_sub (keys %{$list_of_subscribers}) { - my $ids = $list_of_subscribers->{$old_sub}{'id'}; - $ids = '' unless defined $ids; - my @tmp_old_tab = split /,/, $ids; - foreach my $raw (@tmp_old_tab) { - $old_subs_id{$raw} = 1; - } - } - return \%old_subs_id; -} - -sub sync_include_ca { - my $self = shift; - my $admin = $self->{'admin'}; - my $purge = shift; - my %users; - my %changed; - - $self->purge_ca() if ($purge); - - $log->syslog('debug', 'Syncing CA'); - - for ( - my $user = $self->get_first_list_member(); - $user; - $user = $self->get_next_list_member() - ) { - $users{$user->{'email'}} = $user->{'custom_attribute'}; - } - - foreach my $type ('include_sql_ca', 'include_ldap_ca', - 'include_ldap_2level_ca') { - foreach my $tmp_incl (@{$admin->{$type}}) { - ## Work with a copy of admin hash branch to avoid including - ## temporary variables into the actual admin hash.[bug #3182] - my $incl = Sympa::Tools::Data::dup_var($tmp_incl); - - # As CA certificate is required, take it from site config. - if ( ref $incl eq 'HASH' - and $incl->{use_tls} - and $incl->{use_tls} ne 'none' - and not $incl->{ca_file} - and not $incl->{ca_path}) { - $incl->{ca_file} = $Conf::Conf{'cafile'} - if $Conf::Conf{'cafile'}; - $incl->{ca_path} = $Conf::Conf{'capath'} - if $Conf::Conf{'capath'}; - } - - my $db; - my $srcca = undef; - if ($type eq 'include_sql_ca') { - $db = Sympa::Database->new( - $incl->{'db_type'}, - %$incl, - db_host => $incl->{'host'}, - db_options => $incl->{'connect_options'}, - db_user => $incl->{'user'}, - db_passwd => $incl->{'passwd'}, - ); - } elsif ($type eq 'include_ldap_ca' - or $type eq 'include_ldap_2level_ca') { - $db = Sympa::Database->new( - 'LDAP', - %$incl, - bind_dn => $incl->{'user'}, - bind_password => $incl->{'passwd'}, - timeout => ($incl->{'timeout'} || $incl->{'timeout1'}), - ); - } - next unless $db; - if (Sympa::Datasource::is_allowed_to_sync( - $incl->{'nosync_time_ranges'} - ) - ) { - my $getter = '_' . $type; - { # Magic inside - no strict "refs"; - $srcca = $getter->($incl, $db); - } - if (defined($srcca)) { - foreach my $email (keys %$srcca) { - $users{$email} = {} unless (defined $users{$email}); - foreach my $key (keys %{$srcca->{$email}}) { - next - if ($users{$email}{$key}{'value'} eq - $srcca->{$email}{$key}{'value'}); - $users{$email}{$key} = $srcca->{$email}{$key}; - $changed{$email} = 1; - } - } - } - } - unless ($db->disconnect()) { - $log->syslog('notice', 'Can\'t unbind from source %s', $type); - return undef; - } - } - } - - foreach my $email (keys %changed) { - if ($self->update_list_member( - $email, custom_attribute => $users{$email} - ) - ) { - $log->syslog('debug', 'Updated user %s', $email); - } else { - $log->syslog('err', 'Could not update user %s', $email); - } - } - - return 1; -} - -### Purge synced custom attributes from user records, only keep user writable -### ones -sub purge_ca { - my $self = shift; - my $admin = $self->{'admin'}; - my %userattributes; - my %users; - - $log->syslog('debug', 'Purge CA'); - - foreach my $attr (@{$admin->{'custom_attribute'}}) { - $userattributes{$attr->{'id'}} = 1; - } - - for ( - my $user = $self->get_first_list_member(); - $user; - $user = $self->get_next_list_member() - ) { - next unless (keys %{$user->{'custom_attribute'}}); - my $attributes; - foreach my $id (keys %{$user->{'custom_attribute'}}) { - next unless (defined $userattributes{$id}); - $attributes->{$id} = $user->{'custom_attribute'}{$id}; - } - $users{$user->{'email'}} = $attributes; - } - - foreach my $email (keys %users) { - if ($self->update_list_member( - $email, custom_attribute => $users{$email} - ) - ) { - $log->syslog('debug', 'Updated user %s', $email); - } else { - $log->syslog('err', 'Could not update user %s', $email); - } - } - - return 1; -} - -sub sync_include { - $log->syslog('debug', '(%s, %s)', @_); - my $self = shift; - my $option = shift; - - my %old_subscribers; - my $total = 0; - my $errors_occurred = 0; - - ## Load a hash with the old subscribers - for ( - my $user = $self->get_first_list_member(); - $user; - $user = $self->get_next_list_member() - ) { - $old_subscribers{lc($user->{'email'})} = $user; - - ## User neither included nor subscribed = > set subscribed to 1 - unless ($old_subscribers{lc($user->{'email'})}{'included'} - || $old_subscribers{lc($user->{'email'})}{'subscribed'}) { - $log->syslog('notice', - 'Update user %s neither included nor subscribed', - $user->{'email'}); - unless ( - $self->update_list_member( - lc($user->{'email'}), - update_date => time, - subscribed => 1 - ) - ) { - $log->syslog( - 'err', '(%s) Failed to update %s', - $self, lc($user->{'email'}) - ); - next; - } - $old_subscribers{lc($user->{'email'})}{'subscribed'} = 1; - } - - $total++; - } - - ## Load a hash with the new subscriber list - my $new_subscribers; - unless ($option and $option eq 'purge') { - my $result = - $self->_load_list_members_from_include( - $self->get_list_of_sources_id(\%old_subscribers)) - || {}; - $new_subscribers = $result->{'users'}; - my @errors = @{$result->{'errors'}}; - my @exclusions = @{$result->{'exclusions'}}; - my @depend_on = @{$result->{depend_on} || []}; - - ## If include sources were not available, do not update subscribers - ## Use DB cache instead and warn the listmaster. - if (@errors) { - $log->syslog( - 'err', - 'Errors occurred while synchronizing datasources for list %s', - $self - ); - $errors_occurred = 1; - Sympa::send_notify_to_listmaster($self, 'sync_include_failed', - {'errors' => \@errors}); - return undef; - } - - # Feed the new_subscribers hash with users previously subscribed - # with data sources not used because we were not in the period of - # time during which synchronization is allowed. This will prevent - # these users from being unsubscribed. - if (@exclusions) { - foreach my $ex_sources (@exclusions) { - my $id = $ex_sources->{'id'}; - foreach my $email (keys %old_subscribers) { - if ($old_subscribers{$email}{'id'} =~ /$id/g) { - $new_subscribers->{$email}{'date'} = - $old_subscribers{$email}{'date'}; - $new_subscribers->{$email}{'update_date'} = - $old_subscribers{$email}{'update_date'}; - $new_subscribers->{$email}{'visibility'} = - $self->get_default_user_options->{'visibility'} - if defined $self->get_default_user_options->{ - 'visibility'}; - $new_subscribers->{$email}{'reception'} = - $self->get_default_user_options->{'reception'} - if defined $self->get_default_user_options->{ - 'reception'}; - $new_subscribers->{$email}{'profile'} = - $self->get_default_user_options->{'profile'} - if defined $self->get_default_user_options->{ - 'profile'}; - $new_subscribers->{$email}{'info'} = - $self->get_default_user_options->{'info'} - if - defined $self->get_default_user_options->{'info'}; - if (defined $new_subscribers->{$email}{'id'} - && $new_subscribers->{$email}{'id'} ne '') { - $new_subscribers->{$email}{'id'} = join(',', - split(',', $new_subscribers->{$email}{'id'}), - $id); - } else { - $new_subscribers->{$email}{'id'} = - $old_subscribers{$email}{'id'}; - } - } - } + $hash{$key} = + $self->_load_list_param($key, $1, + $pinfo->{$pname}{'file_format'}{$key}); } - } - - # Update inclusion dependency (added on 6.2.16). - $self->_update_inclusion_table('member', @depend_on); - } - - my $data_exclu; - my @subscriber_exclusion; - - ## Gathering a list of emails for a the list in 'exclusion_table' - $data_exclu = $self->get_exclusion(); - - my $key = 0; - while ($data_exclu->{'emails'}->[$key]) { - push @subscriber_exclusion, $data_exclu->{'emails'}->[$key]; - $key = $key + 1; - } - - my $users_added = 0; - my $users_updated = 0; - ## Get an Exclusive lock - my $lock_fh = - Sympa::LockedFile->new($self->{'dir'} . '/include', 10 * 60, '+'); - unless ($lock_fh) { - $log->syslog('err', 'Could not create new lock'); - return undef; - } - - ## Go through previous list of users - my $users_removed = 0; - my $user_removed; - my @deltab; - foreach my $email (keys %old_subscribers) { - unless (defined($new_subscribers->{$email})) { - ## User is also subscribed, update DB entry - if ($old_subscribers{$email}{'subscribed'}) { - $log->syslog('debug', 'Updating %s to list %s', $email, - $self); - unless ( - $self->update_list_member( - $email, - update_date => time, - included => 0, - id => '' - ) - ) { - $log->syslog('err', '(%s) Failed to update %s', - $self, $email); - next; - } - - $users_updated++; + ## Apply defaults & Check required keys + my $missing_required_field; + foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) { - ## Tag user for deletion - } else { - $log->syslog('debug3', 'Removing %s from list %s', - $email, $self); - @deltab = ($email); - unless ($user_removed = - $self->delete_list_member('users' => \@deltab)) { - $log->syslog('err', '(%s) Failed to delete %s', - $self, $user_removed); - return undef; + ## Default value + unless (defined $hash{$k}) { + if (defined $pinfo->{$pname}{'file_format'}{$k}{'default'} + ) { + $hash{$k} = $self->_load_list_param( + $k, + $pinfo->{$pname}{'file_format'}{$k}{'default'}, + $pinfo->{$pname}{'file_format'}{$k} + ); + } } - if ($user_removed) { - $users_removed++; - ## Send notification if the list config authorizes it - ## only. - if ($self->{'admin'}{'inclusion_notification_feature'} eq - 'on') { - unless ( - Sympa::send_file($self, 'removed', $email, {})) { - $log->syslog('err', - "Unable to send template 'removed' to $email" - ); - } + ## Required fields + if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1' + and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) { + unless (defined $hash{$k}) { + $log->syslog('info', + 'Missing key "%s" in param "%s" in %s', + $k, $pname, $filename); + $missing_required_field++; } } } - } - } - if ($users_removed > 0) { - $log->syslog('notice', '(%s) %d users removed', $self, - $users_removed); - } - ## Go through new users - my @add_tab; - $users_added = 0; - foreach my $email (keys %{$new_subscribers}) { - my $compare = 0; - foreach my $sub_exclu (@subscriber_exclusion) { - if ($email eq $sub_exclu) { - $compare = 1; - last; - } - } - if ($compare == 1) { - delete $new_subscribers->{$email}; - next; - } - if (defined($old_subscribers{$email})) { - if ($old_subscribers{$email}{'included'}) { - ## If one user attribute has changed, then we should update - ## the user entry - my $succesful_update = 0; - foreach my $attribute ('id', 'gecos') { - unless ( - Sympa::Tools::Data::smart_eq( - $old_subscribers{$email}{$attribute}, - $new_subscribers->{$email}{$attribute} - ) - ) { - $log->syslog('debug', 'Updating %s to list %s', - $email, $self); - my $update_time = - $new_subscribers->{$email}{'update_date'} || time; - unless ( - $self->update_list_member( - $email, - update_date => $update_time, - $attribute => - $new_subscribers->{$email}{$attribute} - ) - ) { - $log->syslog('err', '(%s) Failed to update %s', - $self, $email); - next; - } else { - $succesful_update = 1; - } - } - } - $users_updated++ if ($succesful_update); - ## User was already subscribed, update - ## include_sources_subscriber in DB + next if $missing_required_field; + + ## Should we store it in an array + if (($pinfo->{$pname}{'occurrence'} =~ /n$/)) { + push @{$include{$pname}}, \%hash; } else { - $log->syslog('debug', 'Updating %s to list %s', $email, - $self); - unless ( - $self->update_list_member( - $email, - update_date => time, - included => 1, - id => $new_subscribers->{$email}{id} - ) - ) { - $log->syslog('err', '(%s) Failed to update %s', - $self, $email); - next; - } - $users_updated++; + $include{$pname} = \%hash; } - - ## Add new included user } else { - my $compare = 0; - foreach my $sub_exclu (@subscriber_exclusion) { - unless ($compare eq '1') { - if ($email eq $sub_exclu) { - $compare = 1; - } else { - next; - } - } + ## This should be a single line + unless ($#paragraph == 0) { + $log->syslog('info', + 'Expecting a single line for "%s" parameter in %s', + $pname, $filename); } - if ($compare eq '1') { + + unless ($paragraph[0] =~ + /^\s*$pname(?:\s+($pinfo->{$pname}{'file_format'}))?\s*$/i) { + chomp($paragraph[0]); + $log->syslog('info', 'Bad entry "%s" in %s', + $paragraph[0], $filename); next; } - $log->syslog('debug3', 'Adding %s to list %s', $email, $self); - my $u = $new_subscribers->{$email}; - $u->{'included'} = 1; - $u->{'date'} = time; - @add_tab = ($u); - my $user_added = 0; - unless ($user_added = $self->add_list_member(@add_tab)) { - $log->syslog('err', '(%s) Failed to add new users', $self); - return undef; - } - if ($user_added) { - $users_added++; - ## Send notification if the list config authorizes it only. - if ($self->{'admin'}{'inclusion_notification_feature'} eq - 'on') { - unless ( - $self->send_probe_to_user('welcome', $u->{'email'})) { - $log->syslog('err', - 'Unable to send "welcome" probe to %s', - $u->{'email'}); - } - } + + my $value = $self->_load_list_param($pname, $1, $pinfo->{$pname}); + + if (($pinfo->{$pname}{'occurrence'} =~ /n$/) + && !(ref($value) =~ /^ARRAY/)) { + push @{$include{$pname}}, $value; + } else { + $include{$pname} = $value; } } } - if ($users_added) { - $log->syslog('notice', '(%s) %d users added', $self, $users_added); - } + _load_include_admin_user_postprocess(\%include); + + return \%include; +} - $log->syslog('notice', '(%s) %d users updated', $self, $users_updated); +#sub get_list_of_sources_id; +# -> No longer used. +#sub sync_include_ca; +# -> sync_include(). +#sub purge_ca; +# -> Never used. - ## Release lock - unless ($lock_fh->close()) { - return undef; +sub sync_include { + $log->syslog('debug2', '(%s, %s)', @_); + my $self = shift; + + return 0 unless $self->has_include_data_sources; + + my $spindle = Sympa::Spindle::ProcessRequest->new( + context => $self, + action => 'include', + role => 'member', + scenario_context => {skip => 1}, + ); + unless ($spindle and $spindle->spin) { + Sympa::send_notify_to_listmaster($self, 'sync_include_failed', {}); } # Get and save total of subscribers. $self->_cache_publish_expiry('member'); $self->_cache_publish_expiry('last_sync'); - $self->sync_include_ca($option and $option eq 'purge'); return 1; } -# Update inclusion_table: This feature was added on 6.2.16. -sub _update_inclusion_table { - my $self = shift; - my $role = shift; - my @depend_on = @_; - - my $sdm = Sympa::DatabaseManager->instance; - my $sth; - - my $now = time; - foreach my $list_id (@depend_on) { - unless ( - $sdm - and $sth = $sdm->do_prepared_query( - q{UPDATE inclusion_table - SET update_epoch_inclusion = ? - WHERE target_inclusion = ? AND - role_inclusion = ? AND - source_inclusion = ? AND - (update_epoch_inclusion IS NULL OR - update_epoch_inclusion < ?)}, - $now, $self->get_id, $role, $list_id, $now - ) - and $sth->rows - or $sdm and $sth = $sdm->do_prepared_query( - q{INSERT INTO inclusion_table - (target_inclusion, role_inclusion, source_inclusion, - update_epoch_inclusion) - VALUES (?, ?, ?, ?)}, - $self->get_id, $role, $list_id, $now - ) - and $sth->rows - ) { - $log->syslog('err', 'Unable to update list %s in database', - $self); - return undef; - } - } - $sdm->do_prepared_query( - q{DELETE FROM inclusion_table - WHERE target_inclusion = ? AND role_inclusion = ? AND - update_epoch_inclusion < ?}, - $self->get_id, $role, $now - ); -} - -## The previous function (sync_include) is to be called by the task_manager. -## This one is to be called from anywhere else. This function deletes the -## scheduled -## sync_include task. If this deletion happened in sync_include(), it would -## disturb -## the normal task_manager.pl functionning. +#sub _update_inclusion_table; +# -> _update_inclusion_table() and/or _clean_inclusion_table() in +# Sympa::Request::Handler::include class. +# The function sync_include() is to be called by the task_manager. +# This one is to be called from anywhere else. This function deletes the +# scheduled sync_include task. If this deletion happened in sync_include(), +# it would disturb the normal task_manager.pl functionning. +# # 6.2.4: Returns 0 if synchronization is not needed. sub on_the_fly_sync_include { my $self = shift; @@ -6885,10 +4866,23 @@ sub sync_include_admin { $log->syslog('debug2', '(%s)', @_); my $self = shift; - # don't care about listmaster role. - foreach my $role ('owner', 'editor') { - return undef - unless $self->_sync_include_user($role); + return 0 + unless @{$self->{'admin'}{'owner_include'} || []} + or @{$self->{'admin'}{'editor_include'} || []}; + + my $spindle = Sympa::Spindle::ProcessRequest->new( + context => $self, + action => 'include', + role => [qw(owner editor)], + scenario_context => {skip => 1}, + ); + unless ($spindle and $spindle->spin) { + Sympa::send_notify_to_listmaster($self, 'sync_include_failed', {}); + $log->syslog('err', + 'Could not get uses from an include source for list %s', $self); + Sympa::send_notify_to_listmaster($self, + 'sync_include_admin_failed', {}); + return undef; } $self->_cache_publish_expiry('admin_user'); @@ -6897,242 +4891,12 @@ sub sync_include_admin { return scalar @{$self->get_admins('owner')}; } -sub _sync_include_user { - my $self = shift; - my $role = shift; - - # Load a hash with the new users. - my $result = $self->_load_list_admin_from_include($role) || {}; - my $new_users = $result->{users}; - my @depend_on = @{$result->{depend_on} || []}; - - # If include sources were not available, do not update users. - # Use DB cache instead and warn the listmaster. - unless (defined $new_users) { - $log->syslog('err', - 'Could not get %ss from an include source for list %s', - $role, $self); - Sympa::send_notify_to_listmaster($self, 'sync_include_admin_failed', - {}); - return undef; - } - - # Update inclusion dependency (added on 6.2.16). - $self->_update_inclusion_table($role, @depend_on); - - # Get an Exclusive lock. - my $lock_fh = - Sympa::LockedFile->new($self->{'dir'} . '/include_admin_user', - 20, '+'); - unless ($lock_fh) { - $log->syslog('err', 'Could not create new lock'); - return undef; - } - - my (%users_added, %users_updated, $users_deleted); - my $time = time; - my $sdm = Sympa::DatabaseManager->instance; - my $sth; - - # Go through new admin_users_include - foreach my $user (values %$new_users) { - if ($users_added{$user->{email}} or $users_updated{$user->{email}}) { - next; - } - - unless ( - $sdm - and $sth = $sdm->do_prepared_query( - q{UPDATE admin_table - SET included_admin = 1, include_sources_admin = ?, - update_epoch_admin = ? - WHERE role_admin = ? AND user_admin = ? AND - list_admin = ? AND robot_admin = ?}, - $user->{id}, $time, - $role, $user->{email}, - $self->{'name'}, $self->{'domain'} - ) - and $sth->rows - ) { - unless ( - $sdm - and $sth = $sdm->do_prepared_query( - q{INSERT INTO admin_table - (user_admin, comment_admin, - list_admin, robot_admin, - date_epoch_admin, update_epoch_admin, - reception_admin, visibility_admin, - subscribed_admin, included_admin, - include_sources_admin, - role_admin, info_admin, profile_admin) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, 0, 1, ?, ?, ?, ?)}, - $user->{email}, $user->{gecos}, - $self->{'name'}, $self->{'domain'}, - $time, $time, - $user->{reception}, $user->{visibility}, - $user->{id}, - $role, $user->{info}, $user->{profile} - ) - and $sth->rows - ) { - $log->syslog('err', '(%s) Failed to update %s %s', - $self, $role, $user->{email}); - } else { - $users_added{$user->{email}} = 1; - } - } else { - $users_updated{$user->{email}} = 1; - } - } - - $log->syslog( - 'debug', '(%s) %d %s(s) added, %d %s(s) updated', - $self, scalar keys %users_added, - $role, scalar keys %users_updated, $role - ); - - # Go though old list of admin users. - $users_deleted = 0; - unless ( - $sdm - and $sth = $sdm->do_prepared_query( - q{DELETE FROM admin_table - WHERE role_admin = ? AND list_admin = ? AND robot_admin = ? AND - (subscribed_admin IS NULL OR subscribed_admin = 0) AND - NOT (included_admin IS NULL OR included_admin = 0) AND - (update_epoch_admin IS NULL OR update_epoch_admin < ?)}, - $role, $self->{'name'}, $self->{'domain'}, - $time - ) - ) { - $log->syslog('err', '(%s) Failed to delete %s', $self, $role); - } else { - $users_deleted += $sth->rows; - } - unless ( - $sdm - and $sth = $sdm->do_prepared_query( - q{UPDATE admin_table - SET included_admin = 0, include_sources_admin = NULL, - update_epoch_admin = ? - WHERE role_admin = ? AND list_admin = ? AND robot_admin = ? AND - subscribed_admin = 1 AND - (update_epoch_admin IS NULL OR update_epoch_admin < ?)}, - $time, - $role, $self->{'name'}, $self->{'domain'}, - $time - ) - ) { - $log->syslog('err', '(%s) Failed to delete %s', $self, $role); - } else { - $users_deleted += $sth->rows; - } - - if ($users_deleted) { - $log->syslog('debug', '(%s) %d %s(s) removed', - $self, $users_deleted, $role); - } - - # Release lock. - unless ($lock_fh->close()) { - return undef; - } - - return 1; -} - -## Load param admin users from the config of the list -# No longer used. #sub _load_list_admin_from_config; - -## return true if new_param has changed from old_param -# $new_param is changed to return only entries that need to -# be updated (only deals with admin user parameters, editor or owner) -sub is_update_param { - my $new_param = shift; - my $old_param = shift; - my $resul = {}; - my $update = 0; - - $log->syslog('debug2', ''); - - foreach my $p ( - 'reception', 'visibility', 'gecos', 'info', - 'profile', 'id', 'included', 'subscribed' - ) { - if (defined $new_param->{$p}) { - if (!defined($old_param->{$p}) - or $new_param->{$p} ne $old_param->{$p}) { - $resul->{$p} = $new_param->{$p}; - $update = 1; - } - } else { - if (defined $old_param->{$p} and $old_param->{$p} ne '') { - $resul->{$p} = ''; - $update = 1; - } - } - } - if ($update) { - return $resul; - } else { - return undef; - } -} - -# Checks if adding a include_sympa_list setting will cause inclusion loop. -#FIXME:Isn't there any more efficient way to explore DAG? -sub _inclusion_loop { - my $self = shift; - my $role = shift || 'member'; - my $incl = shift; - my $recursive = shift; - - my $source_id = lc $incl->{listname}; - $source_id = sprintf '%s@%s', $source_id, $self->{'domain'} - unless 0 < index($source_id, '@'); - my $target_id = $self->get_id; - - unless ($recursive) { - return ($source_id eq $target_id); - } - - my $sdm = Sympa::DatabaseManager->instance; - my $sth; - - my %visited; - my @ancestors = ($source_id); - while (@ancestors) { - # Loop detected. - return 1 - if grep { $target_id eq $_ } @ancestors; - - @visited{@ancestors} = @ancestors; - @ancestors = Sympa::Tools::Data::sort_uniq( - grep { - # Ignore loop by other nodes to prevent infinite processing. - not exists $visited{$_} - } map { - my @parents; - if ($sdm - and $sth = $sdm->do_prepared_query( - q{SELECT source_inclusion - FROM inclusion_table - WHERE target_inclusion = ? AND role_inclusion = ?}, - $_, $role - ) - ) { - @parents = - map { $_->[0] } @{$sth->fetchall_arrayref([0]) || []}; - $sth->finish; - } - @parents - } @ancestors - ); - } - - return 0; -} +# -> No longer used. +#sub is_update_param; +# -> Never used. +#sub _inclusion_loop; +# -> Sympa::DataSouce::List::_inclusion_loop(). # Merged into Sympa::List::get_total(). #sub _load_total_db; @@ -8833,75 +6597,12 @@ sub get_next_delivery_date { } } -## Searches the include datasource corresponding to the provided ID -sub search_datasource { - my ($self, $id) = @_; - $log->syslog('debug2', '(%s, %s)', $self->{'name'}, $id); - - ## Go through list parameters - foreach my $p (keys %{$self->{'admin'}}) { - next unless ($p =~ /^include/); - - ## Go through sources - foreach my $s (@{$self->{'admin'}{$p}}) { - if (Sympa::Datasource::_get_datasource_id($s) eq $id) { - return {'type' => $p, 'def' => $s}; - } - } - } - - return undef; -} - -## Return the names of datasources, given a coma-separated list of source ids -# IN : -$class -# -$id : datasource ids (coma-separated) -# OUT : -$name : datasources names (scalar) -sub get_datasource_name { - my ($self, $id) = @_; - $log->syslog('debug2', '(%s, %s)', $self->{'name'}, $id); - my %sources; - - my @ids = split /,/, $id; - foreach my $id (@ids) { - ## User may come twice from the same datasource - unless (defined($sources{$id})) { - my $datasource = $self->search_datasource($id); - if (defined $datasource) { - if (ref($datasource->{'def'})) { - $sources{$id} = $datasource->{'def'}{'name'} - || $datasource->{'def'}{'host'}; - } else { - $sources{$id} = $datasource->{'def'}; - - if ( $datasource->{'type'} eq 'include_list' - and $sources{$id} =~ /^([^\s]+)\s+filter/) { - $sources{$id} = $1 . '>filtered'; - } - } - } - } - } - - return join(', ', values %sources); -} - -## Enforce uniqueness in a comma separated list of user source ID's -sub add_source_id { - my ($idlist, $newid) = @_; - - # make a list of all id's, including the new one - my @ids = split(',', $idlist); - push @ids, $newid; - - # suppress duplicates - my %seen; - my $newidlist = join(',', grep { !$seen{$_}++ } @ids); - - # log and return - $log->syslog('debug', "add source %s => %s", $newid, $newidlist); - return $newidlist; -} +#sub search_datasource; +# -> No longer used. +#sub get_datasource_name; +# -> No longer used. +#sub add_source_id; +# -> No longer used. ## Remove a task in the tasks spool sub remove_task { diff --git a/src/lib/Sympa/ListDef.pm b/src/lib/Sympa/ListDef.pm index d9e67d885..85fca0ef8 100644 --- a/src/lib/Sympa/ListDef.pm +++ b/src/lib/Sympa/ListDef.pm @@ -8,8 +8,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 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2017, 2018, 2019 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 @@ -1059,7 +1059,7 @@ our %pinfo = ( 'default' => {'conf' => 'remind_return_path'} }, - ### Datasources page ### + ### Data sources page ### 'inclusion_notification_feature' => { order => 60.01, @@ -1131,7 +1131,55 @@ our %pinfo = ( 'field_type' => 'password', 'occurrence' => '0-1', 'length' => 10 - } + }, + 'timeout' => { + 'order' => 5, + 'gettext_id' => "idle timeout", + 'gettext_unit' => 'seconds', + 'format' => '\d+', + 'length' => 6, + 'default' => 180, + }, + 'ssl_version' => { + 'order' => 6, + 'gettext_id' => 'SSL version', + 'format' => [ + 'ssl_any', 'sslv2', 'sslv3', 'tlsv1', + 'tlsv1_1', 'tlsv1_2', 'tlsv1_3' + ], + 'synonym' => {'tls' => 'tlsv1'}, + 'occurrence' => '0-1', + 'default' => 'ssl_any', + }, + 'ssl_ciphers' => { + 'order' => 7, + 'gettext_id' => 'SSL ciphers used', + 'format' => '.+', + 'default' => 'ALL' + }, + # ssl_cert # Use cert.pem in list directory + # ssl_key # Use private_key in list directory + + # NOTE: The default of ca_verify is "none" that is different from + # include_ldap_query (required) or include_remote_sympa_list + # (optional). + 'ca_verify' => { + 'order' => 8, + 'gettext_id' => 'Certificate verification', + 'format' => ['none', 'optional', 'required'], + 'synonym' => {'require' => 'required'}, + 'occurrence' => '0-1', + 'default' => 'none', + }, + # ca_path # Not yet implemented + # ca_file # Not yet implemented + + 'nosync_time_ranges' => { + 'order' => 10, + 'gettext_id' => "Time ranges when inclusion is not allowed", + format_s => '$time_ranges', + 'occurrence' => '0-1' + }, }, 'occurrence' => '0-n' }, @@ -1168,6 +1216,12 @@ our %pinfo = ( 'gettext_id' => "filter definition", 'format' => '.*' }, + 'nosync_time_ranges' => { + 'order' => 4, + 'gettext_id' => "Time ranges when inclusion is not allowed", + format_s => '$time_ranges', + 'occurrence' => '0-1' + }, }, 'occurrence' => '0-n' }, @@ -1185,33 +1239,105 @@ our %pinfo = ( 'format' => '.+', 'length' => 15 }, + 'url' => { + 'order' => 2, + 'gettext_id' => "data location URL", + 'format' => '.+', + 'occurrence' => '0-1', # Backward compat. <= 6.2.44 + 'length' => 50 + }, + 'user' => { + 'order' => 3, + 'gettext_id' => "remote user", + 'format' => '.+', + 'occurrence' => '0-1' + }, + 'passwd' => { + 'order' => 4, + 'gettext_id' => "remote password", + 'format' => '.+', + 'field_type' => 'password', + 'occurrence' => '0-1', + 'length' => 10, + }, 'host' => { - 'order' => 1.5, - 'gettext_id' => "remote host", - format_s => '$host', - 'occurrence' => '1' + 'order' => 4.5, + 'gettext_id' => "remote host", + 'gettext_comment' => 'obsoleted. Use "data location URL".', + format_s => '$host', + 'occurrence' => '1' }, 'port' => { - 'order' => 2, - 'gettext_id' => "remote port", - 'format' => '\d+', - 'default' => 443, - 'length' => 4 + 'order' => 4.6, + 'gettext_id' => "remote port", + 'gettext_comment' => 'obsoleted. Use "data location URL".', + 'format' => '\d+', + 'default' => 443, + 'length' => 4 }, 'path' => { - 'order' => 3, - 'gettext_id' => "remote path of sympa list dump", - 'format' => '\S+', - 'occurrence' => '1', - 'length' => 20 + 'order' => 4.7, + 'gettext_id' => "remote path of sympa list dump", + 'gettext_comment' => 'obsoleted. Use "data location URL".', + 'format' => '\S+', + 'occurrence' => '1', + 'length' => 20 }, 'cert' => { - 'order' => 4, + 'order' => 4.8, 'gettext_id' => "certificate for authentication by remote Sympa", - 'format' => ['robot', 'list'], - 'default' => 'list' - } + 'format' => ['robot', 'list'], + 'default' => 'list', + 'obsolete' => 1, + }, + 'timeout' => { + 'order' => 5, + 'gettext_id' => "idle timeout", + 'gettext_unit' => 'seconds', + 'format' => '\d+', + 'length' => 6, + 'default' => 180, + }, + 'ssl_version' => { + 'order' => 6, + 'gettext_id' => 'SSL version', + 'format' => [ + 'ssl_any', 'sslv2', 'sslv3', 'tlsv1', + 'tlsv1_1', 'tlsv1_2', 'tlsv1_3' + ], + 'synonym' => {'tls' => 'tlsv1'}, + 'occurrence' => '0-1', + 'default' => 'ssl_any', + }, + 'ssl_ciphers' => { + 'order' => 7, + 'gettext_id' => 'SSL ciphers used', + 'format' => '.+', + 'default' => 'ALL' + }, + # ssl_cert # Use cert.pem in list directory + # ssl_key # Use private_key in list directory + + # NOTE: The default of ca_verify is "none" that is different from + # include_ldap_query (required) or include_remote_file (none). + 'ca_verify' => { + 'order' => 8, + 'gettext_id' => 'Certificate verification', + 'format' => ['none', 'optional', 'required'], + 'synonym' => {'require' => 'required'}, + 'occurrence' => '0-1', + 'default' => 'optional', + }, + # ca_path # Not yet implemented + # ca_file # Not yet implemented + + 'nosync_time_ranges' => { + 'order' => 10, + 'gettext_id' => "Time ranges when inclusion is not allowed", + format_s => '$time_ranges', + 'occurrence' => '0-1' + }, }, 'occurrence' => '0-n' }, @@ -1295,6 +1421,8 @@ our %pinfo = ( 'format' => '.+', 'default' => 'ALL', }, + # ssl_cert # Not yet implemented + # ssl_key # Not yet implemented 'ca_verify' => { 'order' => 2.8, 'gettext_id' => 'Certificate verification', @@ -1303,18 +1431,22 @@ our %pinfo = ( 'occurrence' => '1', 'default' => 'required', }, - 'user' => { + # ca_path # Not yet implemented + # ca_file # Not yet implemented + 'bind_dn' => { 'order' => 3, 'gettext_id' => "remote user", 'format' => '.+' }, - 'passwd' => { + 'user' => {obsolete => 'bind_dn'}, + 'bind_password' => { 'order' => 3.5, 'gettext_id' => "remote password", 'format' => '.+', 'field_type' => 'password', 'length' => 10 }, + 'passwd' => {obsolete => 'bind_password'}, 'suffix' => { 'order' => 4, 'gettext_id' => "suffix", @@ -1352,12 +1484,19 @@ our %pinfo = ( 'select' => { 'order' => 9, 'gettext_id' => "selection (if multiple)", - 'format' => ['all', 'first'], + 'format' => ['all', 'first', 'regex'], 'occurrence' => '1', 'default' => 'first' }, - 'nosync_time_ranges' => { + 'regex' => { 'order' => 10, + 'gettext_id' => "regular expression", + 'format' => '.+', + 'default' => '', + 'length' => 50 + }, + 'nosync_time_ranges' => { + 'order' => 11, 'gettext_id' => "Time ranges when inclusion is not allowed", format_s => '$time_ranges', 'occurrence' => '0-1' @@ -1424,6 +1563,8 @@ our %pinfo = ( 'format' => '.+', 'default' => 'ALL' }, + # ssl_cert # Not yet implemented + # ssl_key # Not yet implemented 'ca_verify' => { 'order' => 2.8, 'gettext_id' => 'Certificate verification', @@ -1432,18 +1573,22 @@ our %pinfo = ( 'occurrence' => '1', 'default' => 'required', }, - 'user' => { + # ca_path # Not yet implemented + # ca_file # Not yet implemented + 'bind_dn' => { 'order' => 3, 'gettext_id' => "remote user", 'format' => '.+' }, - 'passwd' => { + 'user' => {obsolete => 'bind_dn'}, + 'bind_password' => { 'order' => 3.5, 'gettext_id' => "remote password", 'format' => '.+', 'field_type' => 'password', 'length' => 10 }, + 'passwd' => {obsolete => 'bind_password'}, 'suffix1' => { 'order' => 4, 'gettext_id' => "first-level suffix", @@ -1567,13 +1712,14 @@ our %pinfo = ( 'format' => '\S+', 'occurrence' => '1' }, - 'host' => { + 'db_host' => { 'order' => 2, 'gettext_id' => "remote host", format_s => '$host', # Not required for ODBC # 'occurrence' => '1' }, + 'host' => {obsolete => 'db_host'}, 'db_port' => { 'order' => 3, 'gettext_id' => "database port", @@ -1585,29 +1731,32 @@ our %pinfo = ( 'format' => '\S+', 'occurrence' => '1' }, - 'connect_options' => { + 'db_options' => { 'order' => 4, 'gettext_id' => "connection options", 'format' => '.+' }, - 'db_env' => { + 'connect_options' => {obsolete => 'db_options'}, + 'db_env' => { 'order' => 5, 'gettext_id' => "environment variables for database connection", 'format' => '\w+\=\S+(;\w+\=\S+)*' }, - 'user' => { + 'db_user' => { 'order' => 6, 'gettext_id' => "remote user", 'format' => '\S+', 'occurrence' => '1' }, - 'passwd' => { + 'user' => {obsolete => 'db_user'}, + 'db_passwd' => { 'order' => 7, 'gettext_id' => "remote password", 'format' => '.+', 'field_type' => 'password' }, + 'passwd' => {obsolete => 'db_passwd'}, 'sql_query' => { 'order' => 8, 'gettext_id' => "SQL query", @@ -1710,6 +1859,8 @@ our %pinfo = ( 'format' => '.+', 'default' => 'ALL' }, + # ssl_cert # Not yet implemented + # ssl_key # Not yet implemented 'ca_verify' => { 'order' => 2.8, 'gettext_id' => 'Certificate verification', @@ -1718,18 +1869,22 @@ our %pinfo = ( 'occurrence' => '1', 'default' => 'required', }, - 'user' => { + # ca_path # Not yet implemented + # ca_file # Not yet implemented + 'bind_dn' => { 'order' => 3, 'gettext_id' => "remote user", 'format' => '.+' }, - 'passwd' => { + 'user' => {obsolete => 'bind_dn'}, + 'bind_password' => { 'order' => 3.5, 'gettext_id' => "remote password", 'format' => '.+', 'field_type' => 'password', 'length' => 10 }, + 'passwd' => {obsolete => 'bind_password'}, 'suffix' => { 'order' => 4, 'gettext_id' => "suffix", @@ -1773,12 +1928,19 @@ our %pinfo = ( 'select' => { 'order' => 10, 'gettext_id' => "selection (if multiple)", - 'format' => ['all', 'first'], + 'format' => ['all', 'first', 'regex'], 'occurrence' => '1', 'default' => 'first' }, - 'nosync_time_ranges' => { + 'regex' => { 'order' => 11, + 'gettext_id' => "regular expression", + 'format' => '.+', + 'default' => '', + 'length' => 50 + }, + 'nosync_time_ranges' => { + 'order' => 12, 'gettext_id' => "Time ranges when inclusion is not allowed", format_s => '$time_ranges', 'occurrence' => '0-1' @@ -1843,6 +2005,8 @@ our %pinfo = ( 'format' => '.+', 'default' => 'ALL' }, + # ssl_cert # Not yet implemented + # ssl_key # Not yet implemented 'ca_verify' => { 'order' => 2.8, 'gettext_id' => 'Certificate verification', @@ -1851,18 +2015,22 @@ our %pinfo = ( 'occurrence' => '1', 'default' => 'required', }, - 'user' => { + # ca_path # Not yet implemented + # ca_file # Not yet implemented + 'bind_dn' => { 'order' => 3, 'gettext_id' => "remote user", 'format' => '.+', }, - 'passwd' => { + 'user' => {obsolete => 'bind_dn'}, + 'bind_password' => { 'order' => 3.5, 'gettext_id' => "remote password", 'format' => '.+', 'field_type' => 'password', 'length' => 10 }, + 'passwd' => {obsolete => 'bind_password'}, 'suffix1' => { 'order' => 4, 'gettext_id' => "first-level suffix", @@ -1991,13 +2159,14 @@ our %pinfo = ( 'format' => '\S+', 'occurrence' => '1' }, - 'host' => { + 'db_host' => { 'order' => 2, 'gettext_id' => "remote host", format_s => '$host', # Not required for ODBC and SQLite. Optional for Oracle. #'occurrence' => '1' }, + 'host' => {obsolete => 'db_host'}, 'db_port' => { 'order' => 3, 'gettext_id' => "database port", @@ -2009,29 +2178,32 @@ our %pinfo = ( 'format' => '\S+', 'occurrence' => '1' }, - 'connect_options' => { + 'db_options' => { 'order' => 4.5, 'gettext_id' => "connection options", 'format' => '.+' }, - 'db_env' => { + 'connect_options' => {obsolete => 'db_options'}, + 'db_env' => { 'order' => 5, 'gettext_id' => "environment variables for database connection", 'format' => '\w+\=\S+(;\w+\=\S+)*' }, - 'user' => { + 'db_user' => { 'order' => 6, 'gettext_id' => "remote user", 'format' => '\S+', 'occurrence' => '1' }, - 'passwd' => { + 'user' => {obsolete => 'db_user'}, + 'db_passwd' => { 'order' => 7, 'gettext_id' => "remote password", 'format' => '.+', 'field_type' => 'password' }, + 'passwd' => {options => 'db_passwd'}, 'sql_query' => { 'order' => 8, 'gettext_id' => "SQL query", @@ -2593,7 +2765,8 @@ our %user_info = ( internal => 1, }, included => { - order => 12, + #order => 12, + obsolete => 1, gettext_id => 'included', format => ['0', '1'], occurrence => '1', @@ -2601,7 +2774,8 @@ our %user_info = ( internal => 1, }, id => { - order => 13, + #order => 13, + obsolete => 1, gettext_id => 'name of external datasource', internal => 1, }, @@ -2613,12 +2787,26 @@ our %user_info = ( internal => 1, }, update_date => { - order => 15, + order => 14.5, gettext_id => 'last update time', format => '\d+', field_type => 'unixtime', internal => 1, }, + inclusion => { + order => 14.6, + gettext_id => 'last inclusion time', + format => '\d+', + field_type => 'unixtime', + internal => 1, + }, + inclusion_ext => { + order => 14.7, + gettext_id => 'last inclusion time from external data source', + format => '\d+', + field_type => 'unixtime', + internal => 1, + }, }, occurrence => '1-n' }, @@ -2676,7 +2864,8 @@ our %user_info = ( internal => 1, }, included => { - order => 12, + #order => 12, + obsolete => 1, gettext_id => 'included', format => ['0', '1'], occurrence => '1', @@ -2684,7 +2873,8 @@ our %user_info = ( internal => 1, }, id => { - order => 13, + #order => 13, + obsolete => 1, gettext_id => 'name of external datasource', internal => 1, }, @@ -2696,12 +2886,26 @@ our %user_info = ( internal => 1, }, update_date => { - order => 15, + order => 14.5, gettext_id => 'last update time', format => '\d+', field_type => 'unixtime', internal => 1, }, + inclusion => { + order => 14.6, + gettext_id => 'last inclusion time', + format => '\d+', + field_type => 'unixtime', + internal => 1, + }, + inclusion_ext => { + order => 14.7, + gettext_id => 'last inclusion time from external data source', + format => '\d+', + field_type => 'unixtime', + internal => 1, + }, }, occurrence => '0-n' }, @@ -2746,7 +2950,7 @@ sub cleanup { # Task format $v->{'format'} = Sympa::Regexps::task(); } elsif ($v->{'datasource'}) { - # Datasource format + # Data source format $v->{'format'} = Sympa::Regexps::datasource(); } @@ -2797,7 +3001,7 @@ sub cleanup { # Task format $v->{'format'}{$k}{'format'} = Sympa::Regexps::task(); } elsif ($v->{'format'}{$k}{'datasource'}) { - # Datasource format + # Data source format $v->{'format'}{$k}{'format'} = Sympa::Regexps::datasource(); } } diff --git a/src/lib/Sympa/ListOpt.pm b/src/lib/Sympa/ListOpt.pm index feba15f0f..6c48e6863 100644 --- a/src/lib/Sympa/ListOpt.pm +++ b/src/lib/Sympa/ListOpt.pm @@ -8,8 +8,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 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2017, 2018, 2019 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 @@ -105,6 +105,7 @@ our %list_option = ( #'no' => {'gettext_id' => 'no'}, # include_ldap_2level_query.ssl_version, include_ldap_query.ssl_version + 'ssl_any' => {'gettext_id' => 'any versions'}, 'sslv2' => {'gettext_id' => 'SSL version 2'}, 'sslv3' => {'gettext_id' => 'SSL version 3'}, 'tlsv1' => {'gettext_id' => 'TLS version 1'}, diff --git a/src/lib/Sympa/Request.pm b/src/lib/Sympa/Request.pm index d8e22a325..2395cf1ce 100644 --- a/src/lib/Sympa/Request.pm +++ b/src/lib/Sympa/Request.pm @@ -8,8 +8,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 The Sympa Community. See the AUTHORS.md file at the top-level -# directory of this distribution and at +# Copyright 2017, 2019 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 @@ -233,7 +233,7 @@ sub get_id { } } grep { defined $self->{$_} - } qw(action context current_list listname arc mode email + } qw(action context current_list listname arc mode role email reception visibility request error); } diff --git a/src/lib/Sympa/Request/Handler/include.pm b/src/lib/Sympa/Request/Handler/include.pm new file mode 100644 index 000000000..78c3e5e90 --- /dev/null +++ b/src/lib/Sympa/Request/Handler/include.pm @@ -0,0 +1,685 @@ +# -*- 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 +# . +# +# 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 . + +package Sympa::Request::Handler::include; + +use strict; +use warnings; + +use Sympa; +use Sympa::DatabaseManager; +use Sympa::DataSource; +use Sympa::LockedFile; +use Sympa::Log; + +use base qw(Sympa::Request::Handler); + +my $log = Sympa::Log->instance; + +use constant _action_scenario => undef; +use constant _context_class => 'Sympa::List'; + +my %config_ca_map = ( + 'include_ldap_ca' => 'Sympa::DataSource::LDAP', + 'include_ldap_2level_ca' => 'Sympa::DataSource::LDAP2', + 'include_sql_ca' => 'Sympa::DataSource::SQL', +); + +my %config_user_map = ( + 'include_file' => 'Sympa::DataSource::File', + 'include_remote_file' => 'Sympa::DataSource::RemoteFile', + 'include_list' => 'Sympa::DataSource::List', # Obsoleted + 'include_sympa_list' => 'Sympa::DataSource::List', + 'include_remote_sympa_list' => 'Sympa::DataSource::RemoteDump', + 'include_ldap_query' => 'Sympa::DataSource::LDAP', + 'include_ldap_2level_query' => 'Sympa::DataSource::LDAP2', + 'include_sql_query' => 'Sympa::DataSource::SQL', + 'include_voot_group' => 'Sympa::DataSource::VOOT', +); + +# Internal function. +sub _get_data_sources { + my $list = shift; + my $role = shift; + + my @dss; + + if ($role eq 'custom_attribute') { + foreach my $ptype (sort keys %config_ca_map) { + my @config = grep {$_} @{$list->{'admin'}{$ptype} || []}; + my $type = $config_ca_map{$ptype}; + push @dss, map { + Sympa::DataSource->new($type, $role, context => $list, %$_) + } @config; + } + } elsif ($role eq 'member') { + #FIXME: Use Sympa::Config. + my @config_files = map { $list->_load_include_admin_user_file($_) } + @{$list->{'admin'}{'member_include'} || []}; + + foreach my $ptype (sort keys %config_user_map) { + my @config = grep {$_} ( + @{$list->{'admin'}{$ptype} || []}, + map { @{$_->{$ptype} || []} } @config_files + ); + # Special case: include_file is not paragraph. + if ($ptype eq 'include_file') { + @config = map { + my $name = substr [split m{/}, $_]->[-1], 0, 15; + {name => $name, path => $_}; + } @config; + } + my $type = $config_user_map{$ptype}; + push @dss, map { + Sympa::DataSource->new($type, $role, context => $list, %$_) + } @config; + } + } else { + my $pname = ($role eq 'owner') ? 'owner_include' : 'editor_include'; + #FIXME: Use Sympa::Config. + my @config_files = map { $list->_load_include_admin_user_file($_) } + @{$list->{'admin'}{$pname} || []}; + + foreach my $ptype (sort keys %config_user_map) { + my @config = grep {$_} + map { @{$_->{$ptype} || []} } @config_files; + # Special case: include_file is not paragraph. + if ($ptype eq 'include_file') { + @config = map { + my $name = substr [split m{/}, $_]->[-1], 0, 15; + {name => $name, path => $_}; + } @config; + } + my $type = $config_user_map{$ptype}; + push @dss, map { + Sympa::DataSource->new($type, $role, context => $list, %$_) + } @config; + } + } + + return [@dss]; +} + +sub _twist { + my $self = shift; + my $request = shift; + + my $list = $request->{context}; + my $role = $request->{role}; + + die 'bug in logic. Ask developer' + unless grep { $role and $role eq $_ } qw(member owner editor); + + my $dss = _get_data_sources($list, $role); + return 0 unless $dss and @$dss; + + # Get an Exclusive lock. + my $lock_file = $list->{'dir'} . '/' . $role . '.include'; + my $lock_fh = Sympa::LockedFile->new($lock_file, -1, '+>>'); + unless ($lock_fh) { + $log->syslog('info', '%s: Locked, skip inclusion', $list); + $self->add_stash($request, 'notice', 'include_skip', + {listname => $list->{'name'}}); + return 0; + } + + # I. Start. + + my (%start_times, $last_start_time, $start_time); + seek $lock_fh, 0, 0; + while (my $line = <$lock_fh>) { + next unless $line =~ /\A(\w+)\s+(\d+)/; + my $t = $2 + 0; + $start_times{$1} = $t; + + $last_start_time = $t + if not defined $last_start_time or $t < $last_start_time; + } + $start_time = time; + if (defined $last_start_time and $start_time < $last_start_time) { + # Avoid retrace of clock e.g. by outage of NTP server. + $log->syslog('info', '%s: Clock got behind, skip inclusion', $list); + $self->add_stash($request, 'notice', 'include_skip', + {listname => $list->{'name'}}); + return 0; + } + + my $sdm = Sympa::DatabaseManager->instance; + return undef unless $sdm; + my $sth; + my ($t, $r) = + ($role eq 'member') + ? ('subscriber', '') + : ('admin', sprintf ' AND role_admin = %s', $sdm->quote($role)); + + # II. Include new entries. + + my %result = (added => 0, deleted => 0, updated => 0, kept => 0); + foreach my $ds (@{$dss || []}) { + $lock_fh->extend; + + next unless $ds->is_allowed_to_sync; + my %res = _update_users($ds, $start_time); + next unless %res; + + # Update time of allowed and succeeded data sources. + $start_times{$ds->get_short_id} = $start_time; + + # Special treatment for Sympa::DataSource::List. + _update_inclusion_table($ds, $start_time) + if ref $ds eq 'Sympa::DataSource::List'; + + $log->syslog( + 'info', '%s: %d included, %d deleted, %d updated, %d kept', + $ds, @res{qw(added deleted updated kept)} + ); + $self->add_stash( + $request, 'notice', + 'include', + { listname => $list->{'name'}, + id => $ds->get_short_id, + name => $ds->name, + result => {%res} + } + ); + foreach my $key (keys %res) { + $result{$key} += $res{$key} if exists $result{$key}; + } + } + + # III. Expire outdated entries. + + # Choose most earlier time of succeeding inclusions (if any of + # data sources have not succeeded yet, time is not defined). + $last_start_time = $start_time; + foreach my $id (map { $_->get_short_id } @$dss) { + unless (defined $start_times{$id}) { + undef $last_start_time; + last; + } elsif ($start_times{$id} < $last_start_time) { + $last_start_time = $start_times{$id}; + } + } + + if (defined $last_start_time) { + $lock_fh->extend; + + my %res = _expire_users($list, $role, $last_start_time); + unless (%res) { + $self->add_stash($request, 'intern'); + #FIMXE: Report error. + return undef; + } + foreach my $key (keys %res) { + $result{$key} += $res{$key} if exists $result{$key}; + } + + # Special treatment for Sympa::DataSource::List. + _expire_inclusion_table($list, $role, $last_start_time); + } + + # IV. Update custom attributes. + + if ($role eq 'member') { + foreach + my $ds (@{_get_data_sources($list, 'custom_attribute') || []}) { + next unless $ds->is_allowed_to_sync; + + $lock_fh->extend; + _update_custom_attribute($ds); + } + } + + # V. Finish. + + # Write out updated times of succeeding inclusions. + my $ofh; + unless (open $ofh, '>', $lock_file . '.new') { + $log->syslog('err', 'Can\'t open file %s: %m', $lock_file . '.new'); + $self->add_stash($request, 'intern'); + return undef; + } + foreach my $id (map { $_->get_short_id } @$dss) { + printf $ofh "%s %d\n", $id, $start_times{$id} + if defined $start_times{$id}; + } + close $ofh; + unlink $lock_file . '.old'; + unless ($lock_fh->rename($lock_file . '.old') + and rename($lock_file . '.new', $lock_file)) { + $log->syslog('err', 'Can\'t update file %s: %m', $lock_file); + $self->add_stash($request, 'intern'); + return undef; + } + unlink $lock_file . '.old'; + + $log->syslog( + 'info', '%s: %d included, %d deleted, %d updated', + $request, @result{qw(added deleted updated)} + ); + $self->add_stash($request, 'notice', 'include_performed', + {listname => $list->{'name'}, result => {%result}}); + return 1; +} + +# Internal function. +sub _update_users { + my $ds = shift; + my $start_time = shift; + + return unless $ds->open; + + my %result = (added => 0, deleted => 0, updated => 0, kept => 0); + while (my $entry = $ds->next) { + my ($email, $other_value) = @$entry; + my %res = __update_user($ds, $email, $other_value, $start_time); + + unless (%res) { + $ds->close; + $log->syslog('info', '%s: Aborted inclusion', $ds); + return; + } + foreach my $res (keys %res) { + $result{$res} += $res{$res} if exists $result{$res}; + } + } + + $ds->close; + + return %result; +} + +# Internal function. +sub __update_user { + my $ds = shift; + my $email = shift; + my $gecos = shift; + my $start_time = shift; + + return (none => 0) unless Sympa::Tools::Text::valid_email($email); + $email = Sympa::Tools::Text::canonic_email($email); + + my $list = $ds->{context}; + my $role = $ds->role; + + my $time = time; + # Avoid retrace of clock e.g. by outage of NTP server. + $time = $start_time unless $start_time <= time; + + my $sdm = Sympa::DatabaseManager->instance; + return undef unless $sdm; + my $sth; + my ($t, $r) = + ($role eq 'member') + ? ('subscriber', '') + : ('admin', sprintf ' AND role_admin = %s', $sdm->quote($role)); + my $is_external_ds = not(ref $ds eq 'Sympa::DataSource::List' + and [split /\@/, $ds->{listname}, 2]->[1] eq $list->{'domain'}); + + # 1. If role of the data source is 'member' and the user is excluded: + # Do nothing. + return (none => 0) + if $role eq 'member' and $list->is_member_excluded($email); + + # 2. If user has already been updated by the other data sources: + # Keep user. + if ($is_external_ds) { + return unless $sth = $sdm->do_prepared_query( + qq{SELECT COUNT(*) + FROM ${t}_table + WHERE user_$t = ? AND list_$t = ? AND robot_$t = ?$r AND + inclusion_$t IS NOT NULL AND ? <= inclusion_$t AND + inclusion_ext_$t IS NOT NULL AND ? <= inclusion_ext_$t}, + $email, $list->{'name'}, $list->{'domain'}, + $start_time, + $start_time + ); + } else { + return unless $sth = $sdm->do_prepared_query( + qq{SELECT COUNT(*) + FROM ${t}_table + WHERE user_$t = ? AND list_$t = ? AND robot_$t = ?$r AND + inclusion_$t IS NOT NULL AND ? <= inclusion_$t}, + $email, $list->{'name'}, $list->{'domain'}, + $start_time + ); + } + my ($count) = $sth->fetchrow_array; + $sth->finish; + return (kept => 1) if $count; + + # 3. If user (has not been updated by the other data sources and) exists: + # UPDATE inclusion. + if ($is_external_ds) { + # Already updated by the other non-external data source but not yet + # by any other external ones: + # Update inclusion_ext (and inclusion) field, but not inclusion_label. + return unless $sth = $sdm->do_prepared_query( + qq{UPDATE ${t}_table + SET inclusion_$t = ?, inclusion_ext_$t = ? + WHERE user_$t = ? AND list_$t = ? AND robot_$t = ?$r AND + inclusion_$t IS NOT NULL AND ? <= inclusion_$t}, + $time, $time, + $email, $list->{'name'}, $list->{'domain'}, + $start_time + ); + return (updated => 0) if $sth->rows; + + # Not yet updated by any other data sources: + # Update inclusion_ext (and inclusion), and assign inclusion_label. + return unless $sth = $sdm->do_prepared_query( + qq{UPDATE ${t}_table + SET inclusion_$t = ?, inclusion_ext_$t = ?, + inclusion_label_$t = ?, + WHERE user_$t = ? AND list_$t = ? AND robot_$t = ?$r}, + $time, $time, + $ds->name, + $email, $list->{'name'}, $list->{'domain'} + ); + return (updated => 1) if $sth->rows; + } else { + # Not yet updated by any other data sources: + # Update inclusion, and assign inclusion_label. + return unless $sth = $sdm->do_prepared_query( + qq{UPDATE ${t}_table + SET inclusion_$t = ?, + inclusion_label_$t = ? + WHERE user_$t = ? AND list_$t = ? AND robot_$t = ?$r}, + $time, + $ds->name, + $email, $list->{'name'}, $list->{'domain'} + ); + return (updated => 1) if $sth->rows; + } + + # 4. Otherwise, i.e. a new user: + # INSERT new user with: + # email, gecos, subscribed=0, date, update, inclusion, + # (optional) inclusion_ext, inclusion_label and + # default attributes. + my $user = { + email => $email, + gecos => $gecos, + subscribed => 0, + date => $time, + update_date => $time, + inclusion => $time, + ($is_external_ds ? (inclusion_ext => $time) : ()), + inclusion_label => $ds->name, + }; + my @defkeys = @{$ds->{_defkeys} || []}; + my @defvals = @{$ds->{_defvals} || []}; + @{$user}{@defkeys} = @defvals if @defkeys; + + if ($role eq 'member') { + $list->add_list_member($user); + + # Send notification if the list config authorizes it only. + if ($list->{'admin'}{'inclusion_notification_feature'} eq 'on') { + unless ($list->send_probe_to_user('welcome', $email)) { + $log->syslog('err', + 'Unable to send "welcome" probe to %s', $email); + } + } + } else { + $list->add_list_admin($role, $user); + } + return (added => 1); +} + +sub _expire_users { + my $list = shift; + my $role = shift; + my $last_start_time = shift; + + my $sdm = Sympa::DatabaseManager->instance; + return unless $sdm; + my $sth; + my ($t, $r) = + ($role eq 'member') + ? ('subscriber', '') + : ('admin', sprintf ' AND role_admin = %s', $sdm->quote($role)); + + my $deleted = 0; + # Remove list users not subscribing (only included) and + # not included anymore. + unless ( + $sth = $sdm->do_prepared_query( + qq{SELECT user_$t AS email + FROM ${t}_table + WHERE (subscribed_$t IS NULL OR subscribed_$t <> 1) AND + inclusion_$t IS NOT NULL AND inclusion_$t < ? AND + list_$t = ? AND robot_$t = ?$r}, + $last_start_time, + $list->{'name'}, $list->{'domain'} + ) + ) { + return; + } else { + my @emails = map { $_->[0] } @{$sth->fetchall_arrayref || []}; + $sth->finish; + + foreach my $email (@emails) { + next unless defined $email and length $email; + + if ($role eq 'member') { + $list->delete_list_member(users => [$email]); + + # Send notification if the list config authorizes it only. + if ($list->{'admin'}{'inclusion_notification_feature'} eq + 'on') { + unless (Sympa::send_file($list, 'removed', $email, {})) { + $log->syslog('err', + 'Unable to send template "removed" to %s', + $email); + } + } + } else { + $list->delete_list_admin($role, $email); + } + $deleted += 1; + } + } + + # Cancel inclusion of users subscribing (and also included) and + # not included anymore. + unless ( + $sdm->do_prepared_query( + qq{UPDATE ${t}_table + SET inclusion_$t = NULL, inclusion_ext_$t = NULL, + inclusion_label_$t = NULL + WHERE subscribed_$t = 1 AND + inclusion_$t IS NOT NULL AND inclusion_$t < ? AND + list_$t = ? AND robot_$t = ?$r}, + $last_start_time, + $list->{'name'}, $list->{'domain'} + ) + and $sdm->do_prepared_query( + qq{UPDATE ${t}_table + SET inclusion_ext_$t = NULL + WHERE subscribed_$t = 1 AND + inclusion_ext_$t IS NOT NULL AND inclusion_ext_$t < ? AND + list_$t = ? AND robot_$t = ?$r}, + $last_start_time, + $list->{'name'}, $list->{'domain'} + ) + ) { + #FIXME: report error + } + + return (deleted => $deleted); +} + +# Internal function. +# Update inclusion_table: This feature was added on 6.2.16. +# Related only to Sympa::DataSource::List class. +# Old name: (part of) Sympa::List::_update_inclusion_table(). +sub _update_inclusion_table { + my $ds = shift; + my $start_time = shift; + + my $list = $ds->{context}; + my $role = $ds->role; + my $inlist = Sympa::List->new($ds->{listname}); + + my $time = time; + # Avoid retrace of clock e.g. by outage of NTP server. + $time = $start_time unless $start_time <= $time; + + my $sdm = Sympa::DatabaseManager->instance; + return undef unless $sdm; + my $sth; + + unless ( + $sth = $sdm->do_prepared_query( + q{UPDATE inclusion_table + SET update_epoch_inclusion = ? + WHERE target_inclusion = ? AND + role_inclusion = ? AND + source_inclusion = ? AND + (update_epoch_inclusion IS NULL OR + update_epoch_inclusion < ?)}, + $time, $list->get_id, $role, $inlist->get_id, $time + ) + and $sth->rows + or $sth = $sdm->do_prepared_query( + q{INSERT INTO inclusion_table + (target_inclusion, role_inclusion, source_inclusion, + update_epoch_inclusion) + VALUES (?, ?, ?, ?)}, + $list->get_id, $role, $inlist->get_id, $time + ) + and $sth->rows + ) { + $log->syslog('err', 'Unable to update list %s in database', $list); + return undef; + } + + return 1; +} + +# Internal function. +# Old name: (part of) Sympa::List::_update_inclusion_table(). +# Related only to Sympa::DataSource::List class. +sub _expire_inclusion_table { + my $list = shift; + my $role = shift; + my $last_start_time = shift; + + my $sdm = Sympa::DatabaseManager->instance; + $sdm and $sdm->do_prepared_query( + q{DELETE FROM inclusion_table + WHERE target_inclusion = ? AND role_inclusion = ? AND + update_epoch_inclusion < ?}, + $list->get_id, $role, + $last_start_time + ); +} + +# Internal function. +sub _update_custom_attribute { + my $ds = shift; + + die 'bug in logic. Ask developer' unless $ds->role eq 'custom_attribute'; + + return unless $ds->open; + + my $list = $ds->{context}; + + my $updated = 0; + while (my $entry = $ds->next) { + my ($email, $ca_update) = @$entry; + + my $member = $list->get_list_member($email); + next unless $member; + my $ca = $member->{custom_attribute} || {}; + + my $changed; + foreach my $key (sort keys %{$ca_update || {}}) { + my $cur = $ca->{$key}; + $cur = '' unless defined $cur; + my $new = $ca_update->{$key}; + $new = '' unless defined $new; + next if $cur eq $new; + + $ca->{$key} = $new; + $changed = 1; + } + next unless $changed; + + $list->update_list_member($email, custom_attribute => $ca_update); + $updated++; + } + + $ds->close; + + return (updated => $updated); +} + +# Enforce uniqueness in a comma separated list of user source ID's. +# Old name: (part of) Sympa::List::add_source_id(). +# No longer used. +#sub _add_source_id; + +# Returns a real unique ID for an include datasource. +sub get_id { + shift->{context}; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::Request::Hander::include - include request handler + +=head1 DESCRIPTION + +Includes users from data sources to a list. + +Opens data sources, include or update list users with each of them and closes. +TBD. + +=head1 SEE ALSO + +L, L. + +L<"admin_table"|sympa_database(5)/"admin_table">, +L<"exclusion_table"|sympa_database(5)/"exclusion_table">, +L<"inclusion_table"|sympa_database(5)/"inclusion_table"> and +L<"subscriber_table"|sympa_database(5)/"subscriber_table"> +in L. + +=head1 HISTORY + +The feature to include subscribers from data sources was introduced on +Sympa 3.3.6b.4. +Inclusion of owners and moderators was introduced on Sympa 4.2b.5. + +L module appeared on Sympa 5.3a.9. +Entirely rewritten and renamed L module and +L module appeared on Sympa 6.2.45b. + +=cut diff --git a/src/lib/Sympa/Request/Handler/move_user.pm b/src/lib/Sympa/Request/Handler/move_user.pm index 9a0ddb50d..bc3421571 100644 --- a/src/lib/Sympa/Request/Handler/move_user.pm +++ b/src/lib/Sympa/Request/Handler/move_user.pm @@ -4,8 +4,8 @@ # Sympa - SYsteme de Multi-Postage Automatique # -# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level -# directory of this distribution and at +# Copyright 2017, 2019 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 @@ -66,50 +66,34 @@ sub _twist { foreach my $list (Sympa::List::get_which($current_email, $robot_id, 'member')) { - my $user_entry = $list->get_list_member($current_email); - if ($user_entry->{'included'} == 1) { - # Check the type of data sources. - # If only include_sympa_list of local mailing lists, then no - # problem. Otherwise, notify list owner. - # We could also force a sync_include for local lists. - my $use_external_data_sources; - foreach my $datasource_id (split(/,/, $user_entry->{'id'})) { - my $datasource = $list->search_datasource($datasource_id); - if ( !defined $datasource - or $datasource->{'type'} ne 'include_sympa_list' - or ( $datasource->{'def'} =~ /\@(.+)$/ - and $1 ne $robot_id) - ) { - $use_external_data_sources = 1; - last; + # Check the type of data sources. + # If only include_sympa_list of local mailing lists, then no + # problem. Otherwise, notify list owner. + #FIXME: Consider the case source list is included from external + # data source. + if ($user_entry and defined $user_entry->{'inclusion_ext'}) { + $list->send_notify_to_owner( + 'failed_to_change_included_member', + { 'current_email' => $current_email, + 'new_email' => $email, + 'datasource' => '', } - } - if ($use_external_data_sources) { - # Notify list owner. - $list->send_notify_to_owner( - 'failed_to_change_included_member', - { 'current_email' => $current_email, - 'new_email' => $email, - 'datasource' => - $list->get_datasource_name($user_entry->{'id'}) - } - ); - $self->add_stash( - $request, 'user', - 'change_member_email_failed_included', - {email => $current_email, listname => $list->{'name'}} - ); - $log->syslog( - 'err', - 'Could not change member email %s for list %s to %s because member is included', - $current_email, - $list, - $email - ); - next; - } + ); + $self->add_stash( + $request, 'user', + 'change_member_email_failed_included', + {email => $current_email, listname => $list->{'name'}} + ); + $log->syslog( + 'err', + 'Could not change member email %s for list %s to %s because member is included', + $current_email, + $list, + $email + ); + next; } # Check if user is already member of the list with their new address @@ -148,20 +132,23 @@ sub _twist { foreach my $role ('owner', 'editor') { foreach my $list ( Sympa::List::get_which($current_email, $robot_id, $role)) { - # Check if admin is included via an external datasource. my ($admin_user) = grep { $_->{role} eq $role and $_->{email} eq $current_email } @{$list->get_current_admins || []}; - if ($admin_user and $admin_user->{'included'}) { - # Notify listmaster. + + # Check the type of data sources. + # If only include_sympa_list of local mailing lists, then no + # problem. Otherwise, notify listmaster. + #FIXME: Consider the case source list is included from external + # data source. + if ($admin_user and defined $admin_user->{'inclusion_ext'}) { Sympa::send_notify_to_listmaster( $list, 'failed_to_change_included_admin', { current_email => $current_email, new_email => $email, role => $role, - datasource => - $list->get_datasource_name($admin_user->{'id'}) + datasource => '', } ); $self->add_stash( diff --git a/src/lib/Sympa/Spindle/ProcessTask.pm b/src/lib/Sympa/Spindle/ProcessTask.pm index ec52f5faa..589fdf39f 100644 --- a/src/lib/Sympa/Spindle/ProcessTask.pm +++ b/src/lib/Sympa/Spindle/ProcessTask.pm @@ -4,8 +4,8 @@ # Sympa - SYsteme de Multi-Postage Automatique # -# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2018, 2019 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 @@ -1159,7 +1159,7 @@ sub do_process_bouncers { $user_ref = $list->get_next_bouncing_list_member() ) { # Skip included users (cannot be removed) - next if $user_ref->{'included'}; + next if defined $user_ref->{'inclusion'}; for (my $level = $max_level; ($level >= 1); $level--) { if ($user_ref->{'bounce_score'} >= diff --git a/src/lib/Sympa/Upgrade.pm b/src/lib/Sympa/Upgrade.pm index cddeec7a1..180140155 100644 --- a/src/lib/Sympa/Upgrade.pm +++ b/src/lib/Sympa/Upgrade.pm @@ -8,8 +8,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 The Sympa Community. See the AUTHORS.md file at the -# top-level directory of this distribution and at +# Copyright 2017, 2018, 2019 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 @@ -467,11 +467,11 @@ sub upgrade { my $rows; $sth = $sdm->do_query( q{UPDATE subscriber_table - SET subscribed_subscriber = 1 - WHERE (included_subscriber IS NULL OR - included_subscriber <> 1) AND - (subscribed_subscriber IS NULL OR - subscribed_subscriber <> 1)} + SET subscribed_subscriber = 1 + WHERE (included_subscriber IS NULL OR + included_subscriber <> 1) AND + (subscribed_subscriber IS NULL OR + subscribed_subscriber <> 1)} ); unless ($sth) { $log->syslog('err', 'Unable to execute SQL statement'); @@ -2045,6 +2045,32 @@ sub upgrade { close $ofh; } + # included_* and include_sources_* were deprecated and inclusion_* + # was introduced in subscriber_table and admin_table. + if (lower_version($previous_version, '6.2.45b.1')) { + my $sdm = Sympa::DatabaseManager->instance; + + $log->syslog('notice', 'Upgrading subscriber_table and admin_table.'); + foreach my $role (qw(member owner editor)) { + my ($t, $r) = + ($role eq 'member') + ? ('subscriber', '') + : ('admin', + sprintf ' AND role_admin = %s', $sdm->quote($role)); + unless ( + $sdm and $sdm->do_prepared_query( + qq{UPDATE ${t}_table + SET inclusion_$t = update_epoch_$t + WHERE included_$t = 1 AND inclusion_$t IS NULL$r} + ) + ) { + $log->syslog('err', + 'Can\'t update inclusion_%s field for %s in %s_table', + $t, $role, $t); + } + } + } + return 1; }