1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11# Copyright 2017, 2018, 2019, 2020, 2021 The Sympa Community. See the
12# AUTHORS.md file at the top-level directory of this distribution and at
13# <https://github.com/sympa-community/sympa.git>.
14#
15# This program is free software; you can redistribute it and/or modify
16# it under the terms of the GNU General Public License as published by
17# the Free Software Foundation; either version 2 of the License, or
18# (at your option) any later version.
19#
20# This program is distributed in the hope that it will be useful,
21# but WITHOUT ANY WARRANTY; without even the implied warranty of
22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23# GNU General Public License for more details.
24#
25# You should have received a copy of the GNU General Public License
26# along with this program.  If not, see <http://www.gnu.org/licenses/>.
27
28package Sympa::List;
29
30use strict;
31use warnings;
32use Digest::MD5 qw();
33use English qw(-no_match_vars);
34use IO::Scalar;
35use POSIX qw();
36use Storable qw();
37
38use Sympa;
39use Conf;
40use Sympa::ConfDef;
41use Sympa::Constants;
42use Sympa::Database;
43use Sympa::DatabaseDescription;
44use Sympa::DatabaseManager;
45use Sympa::Family;
46use Sympa::Language;
47use Sympa::List::Config;
48use Sympa::ListDef;
49use Sympa::LockedFile;
50use Sympa::Log;
51use Sympa::Regexps;
52use Sympa::Robot;
53use Sympa::Spindle::ProcessRequest;
54use Sympa::Spindle::ProcessTemplate;
55use Sympa::Spool::Auth;
56use Sympa::Template;
57use Sympa::Tools::Data;
58use Sympa::Tools::Domains;
59use Sympa::Tools::File;
60use Sympa::Tools::SMIME;
61use Sympa::Tools::Text;
62use Sympa::User;
63
64my @sources_providing_listmembers = qw/
65    include_file
66    include_ldap_2level_query
67    include_ldap_query
68    include_remote_file
69    include_remote_sympa_list
70    include_sql_query
71    include_sympa_list
72    /;
73
74# No longer used.
75#my @more_data_sources;
76
77# All non-pluggable sources are in the admin user file
78# NO LONGER USED.
79my %config_in_admin_user_file = map +($_ => 1),
80    @sources_providing_listmembers;
81
82my $language = Sympa::Language->instance;
83my $log      = Sympa::Log->instance;
84
85## Database and SQL statement handlers
86my ($sth, @sth_stack);
87
88# DB fields with numeric type.
89# We should not do quote() for these while inserting data.
90my %db_struct = Sympa::DatabaseDescription::full_db_struct();
91my %numeric_field;
92foreach my $t (qw(subscriber_table admin_table)) {
93    foreach my $k (keys %{$db_struct{$t}->{fields}}) {
94        if ($db_struct{$t}->{fields}{$k}{struct} =~ /\A(tiny|small|big)?int/)
95        {
96            $numeric_field{$k} = 1;
97        }
98    }
99}
100
101# This is the generic hash which keeps all lists in memory.
102my %list_of_lists = ();
103
104## Creates an object.
105sub new {
106    my ($pkg, $name, $robot, $options) = @_;
107    my $list = {};
108    $log->syslog('debug3', '(%s, %s, %s)', $name, $robot,
109        join('/', keys %$options));
110
111    # Lowercase list name.
112    $name = lc $name;
113    # In case the variable was multiple. FIXME:required?
114    $name = $1 if $name =~ /^(\S+)\0/;
115
116    ## Allow robot in the name
117    if ($name =~ /\@/) {
118        my @parts = split /\@/, $name;
119        $robot ||= $parts[1];
120        $name = $parts[0];
121    }
122
123    # Look for the list if no robot was provided.
124    if (not $robot or $robot eq '*') {
125        #FIXME: Default robot would be used instead of oppotunistic search.
126        $robot = search_list_among_robots($name);
127    } else {
128        $robot = lc $robot;    #FIXME: More canonicalization.
129    }
130
131    unless ($robot) {
132        $log->syslog('err',
133            'Missing robot parameter, cannot create list object for %s',
134            $name)
135            unless ($options->{'just_try'});
136        return undef;
137    }
138
139    $options = {} unless (defined $options);
140
141    ## Only process the list if the name is valid.
142    #FIXME: Existing lists may be checked with looser rule.
143    my $listname_regexp = Sympa::Regexps::listname();
144    unless ($name and ($name =~ /^($listname_regexp)$/io)) {
145        $log->syslog('err', 'Incorrect listname "%s"', $name)
146            unless ($options->{'just_try'});
147        return undef;
148    }
149    ## Lowercase the list name.
150    $name = $1;
151    $name =~ tr/A-Z/a-z/;
152
153    ## Reject listnames with reserved list suffixes
154    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
155    if ($regx) {
156        if ($name =~ /^(\S+)-($regx)$/) {
157            $log->syslog(
158                'err',
159                'Incorrect name: listname "%s" matches one of service aliases',
160                $name
161            ) unless ($options->{'just_try'});
162            return undef;
163        }
164    }
165
166    my $status;
167    ## If list already in memory and not previously purged by another process
168    if ($list_of_lists{$robot}{$name}
169        and -d $list_of_lists{$robot}{$name}{'dir'}) {
170        # use the current list in memory and update it
171        $list = $list_of_lists{$robot}{$name};
172
173        $status = $list->load($name, $robot, $options);
174    } else {
175        # create a new object list
176        bless $list, $pkg;
177
178        $options->{'first_access'} = 1;
179        $status = $list->load($name, $robot, $options);
180    }
181    unless (defined $status) {
182        return undef;
183    }
184
185    $list->_load_edit_list_conf(
186        reload_config => ($options->{reload_config} || $status));
187
188    return $list;
189}
190
191## When no robot is specified, look for a list among robots
192sub search_list_among_robots {
193    my $listname = shift;
194
195    unless ($listname) {
196        $log->syslog('err', 'Missing list parameter');
197        return undef;
198    }
199
200    ## Search in default robot
201    if (-d $Conf::Conf{'home'} . '/' . $listname) {
202        return $Conf::Conf{'domain'};
203    }
204
205    foreach my $r (keys %{$Conf::Conf{'robots'}}) {
206        if (-d $Conf::Conf{'home'} . '/' . $r . '/' . $listname) {
207            return $r;
208        }
209    }
210
211    return 0;
212}
213
214## set the list in status error_config and send a notify to listmaster
215sub set_status_error_config {
216    $log->syslog('debug2', '(%s, %s, ...)', @_);
217    my ($self, $msg, @param) = @_;
218
219    unless ($self->{'admin'}
220        and $self->{'admin'}{'status'} eq 'error_config') {
221        $self->{'admin'}{'status'} = 'error_config';
222
223        # No more save config in error...
224        # $self->save_config(tools::get_address($self->{'domain'},
225        #     'listmaster'));
226        $log->syslog('err',
227            'The list %s is set in status error_config: %s(%s)',
228            $self, $msg, join(', ', @param));
229        Sympa::send_notify_to_listmaster($self, $msg,
230            [$self->{'name'}, @param]);
231    }
232}
233
234# Destroy multiton instance. FIXME
235sub destroy_multiton {
236    my $self = shift;
237    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
238}
239
240## set the list in status family_closed and send a notify to owners
241# Deprecated.  Use Sympa::Request::Handler::close_list handler.
242#sub set_status_family_closed;
243
244# Saves the statistics data to disk.
245# Deprecated. Use Sympa::List::update_stats().
246#sub savestats;
247
248## msg count.
249# Old name: increment_msg_count().
250sub _increment_msg_count {
251    $log->syslog('debug2', '(%s)', @_);
252    my $self = shift;
253
254    # Be sure the list has been loaded.
255    my $file = "$self->{'dir'}/msg_count";
256
257    my %count;
258    if (open(MSG_COUNT, $file)) {
259        while (<MSG_COUNT>) {
260            if ($_ =~ /^(\d+)\s(\d+)$/) {
261                $count{$1} = $2;
262            }
263        }
264        close MSG_COUNT;
265    }
266    my $today = int(time / 86400);
267    if ($count{$today}) {
268        $count{$today}++;
269    } else {
270        $count{$today} = 1;
271    }
272
273    unless (open(MSG_COUNT, ">$file.$PID")) {
274        $log->syslog('err', 'Unable to create "%s.%s": %m', $file, $PID);
275        return undef;
276    }
277    foreach my $key (sort { $a <=> $b } keys %count) {
278        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
279    }
280    close MSG_COUNT;
281
282    unless (rename("$file.$PID", $file)) {
283        $log->syslog('err', 'Unable to write "%s": %m', $file);
284        return undef;
285    }
286    return 1;
287}
288
289# Returns the number of messages sent to the list
290sub get_msg_count {
291    $log->syslog('debug2', '(%s)', @_);
292    my $self = shift;
293
294    # Be sure the list has been loaded.
295    my $file = "$self->{'dir'}/stats";
296
297    my $count = 0;
298    if (open(MSG_COUNT, $file)) {
299        while (<MSG_COUNT>) {
300            if ($_ =~ /^(\d+)\s+(.*)$/) {
301                $count = $1;
302            }
303        }
304        close MSG_COUNT;
305    }
306
307    return $count;
308}
309## last date of distribution message .
310sub get_latest_distribution_date {
311    $log->syslog('debug2', '(%s)', @_);
312    my $self = shift;
313
314    # Be sure the list has been loaded.
315    my $file = "$self->{'dir'}/msg_count";
316
317    my $latest_date = 0;
318    unless (open(MSG_COUNT, $file)) {
319        $log->syslog('debug2', 'Unable to open %s', $file);
320        return undef;
321    }
322
323    while (<MSG_COUNT>) {
324        if ($_ =~ /^(\d+)\s(\d+)$/) {
325            $latest_date = $1 if ($1 > $latest_date);
326        }
327    }
328    close MSG_COUNT;
329
330    return undef if ($latest_date == 0);
331    return $latest_date;
332}
333
334## Update the stats struct
335## Input  : num of bytes of msg
336## Output : num of msgs sent
337# Old name: List::update_stats().
338# No longer used. Use Sympa::List::update_stats(1);
339#sub get_next_sequence;
340
341sub get_stats {
342    my $self = shift;
343
344    my @stats;
345    my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '<');
346    if ($lock_fh) {
347        @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
348        $lock_fh->close;
349    }
350
351    foreach my $i ((0 .. 3)) {
352        $stats[$i] = 0 unless $stats[$i];
353    }
354    return @stats[0 .. 3];
355}
356
357sub update_stats {
358    $log->syslog('debug2', '(%s, %s, %s, %s, %s)', @_);
359    my $self  = shift;
360    my @diffs = @_;
361
362    my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '+>>');
363    unless ($lock_fh) {
364        $log->syslog('err', 'Could not create new lock');
365        return;
366    }
367
368    # Update stats file.
369    # Note: The last three fields total, last_sync and last_sync_admin_user
370    # were deprecated.
371    seek $lock_fh, 0, 0;
372    my @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
373    foreach my $i ((0 .. 3)) {
374        $stats[$i] ||= 0;
375        $stats[$i] += $diffs[$i] if $diffs[$i];
376    }
377    seek $lock_fh, 0, 0;
378    truncate $lock_fh, 0;
379    printf $lock_fh "%d %.0f %.0f %.0f\n", @stats;
380
381    return unless $lock_fh->close;
382
383    if ($diffs[0]) {
384        $self->_increment_msg_count;
385    }
386
387    return @stats;
388}
389
390sub _cache_publish_expiry {
391    my $self = shift;
392    my $type = shift;
393
394    my $stat_file;
395    if ($type eq 'member') {
396        $stat_file = $self->{'dir'} . '/.last_change.member';
397    } elsif ($type eq 'admin_user') {
398        $stat_file = $self->{'dir'} . '/.last_change.admin';
399    } else {
400        die 'bug in logic. Ask developer';
401    }
402
403    # Touch status file.
404    my $fh;
405    open $fh, '>', $stat_file and close $fh;
406    utime undef, undef, $stat_file;    # required for such as NFS.
407}
408
409sub _cache_read_expiry {
410    my $self = shift;
411    my $type = shift;
412
413    if ($type eq 'member') {
414        # If changes have never been done, just now is assumed.
415        my $stat_file = $self->{'dir'} . '/.last_change.member';
416        $self->_cache_publish_expiry('member') unless -e $stat_file;
417        return [stat $stat_file]->[9];
418    } elsif ($type eq 'admin_user') {
419        # If changes have never been done, just now is assumed.
420        my $stat_file = $self->{'dir'} . '/.last_change.admin';
421        $self->_cache_publish_expiry('admin_user') unless -e $stat_file;
422        return [stat $stat_file]->[9];
423    } else {
424        die 'bug in logic. Ask developer';
425    }
426}
427
428sub _cache_get {
429    my $self = shift;
430    my $type = shift;
431
432    my $lasttime = $self->{_mtime}{$type};
433    my $mtime;
434    if ($type eq 'total' or $type eq 'is_list_member') {
435        $mtime = $self->_cache_read_expiry('member');
436    } else {
437        $mtime = $self->_cache_read_expiry($type);
438    }
439    $self->{_mtime}{$type} = $mtime;
440
441    return undef unless defined $lasttime and defined $mtime;
442    return undef if $lasttime <= $mtime;
443    return $self->{_cached}{$type};
444}
445
446sub _cache_put {
447    my $self  = shift;
448    my $type  = shift;
449    my $value = shift;
450
451    return $self->{_cached}{$type} = $value;
452}
453
454# Old name: List::extract_verp_rcpt().
455# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
456#sub _extract_verp_rcpt;
457
458# Dumps a copy of list users to disk, in text format.
459# Old name: Sympa::List::dump() which dumped only members.
460sub dump_users {
461    $log->syslog('debug2', '(%s, %s)', @_);
462    my $self = shift;
463    my $role = shift;
464
465    die 'bug in logic. Ask developer'
466        unless grep { $role eq $_ } qw(member owner editor);
467
468    my $file = $self->{'dir'} . '/' . $role . '.dump';
469
470    unlink $file . '.old' if -e $file . '.old';
471    rename $file, $file . '.old' if -e $file;
472    my $lock_fh = Sympa::LockedFile->new($file, 5, '>');
473    unless ($lock_fh) {
474        $log->syslog(
475            'err', 'Failed to save file %s.new: %s',
476            $file, Sympa::LockedFile->last_error
477        );
478        return undef;
479    }
480
481    if ($role eq 'member') {
482        my %map_field = _map_list_member_cols();
483
484        my $user;
485        for (
486            $user = $self->get_first_list_member();
487            $user;
488            $user = $self->get_next_list_member()
489        ) {
490            foreach my $k (sort keys %map_field) {
491                if ($k eq 'custom_attribute') {
492                    next unless ref $user->{$k} eq 'HASH' and %{$user->{$k}};
493                    my $encoded = Sympa::Tools::Data::encode_custom_attribute(
494                        $user->{$k});
495                    printf $lock_fh "%s %s\n", $k, $encoded;
496                } else {
497                    next unless defined $user->{$k} and length $user->{$k};
498                    printf $lock_fh "%s %s\n", $k, $user->{$k};
499                }
500            }
501
502            # Compat.<=6.2.44
503            # This is needed for earlier version of Sympa on e.g. remote host.
504            print $lock_fh "included 1\n"
505                if defined $user->{inclusion};
506
507            print $lock_fh "\n";
508        }
509    } else {
510        my %map_field = _map_list_admin_cols();
511
512        foreach my $user (@{$self->get_current_admins || []}) {
513            next unless $user->{role} eq $role;
514            foreach my $k (sort keys %map_field) {
515                printf $lock_fh "%s %s\n", $k, $user->{$k}
516                    if defined $user->{$k} and length $user->{$k};
517            }
518
519            # Compat.<=6.2.44
520            # This is needed for earlier version of Sympa on e.g. remote host.
521            print $lock_fh "included 1\n"
522                if defined $user->{inclusion};
523
524            print $lock_fh "\n";
525        }
526    }
527
528    $lock_fh->close;
529
530    # FIXME:Are these lines required?
531    $self->{'_mtime'}{'config'} =
532        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
533
534    return 1;
535}
536
537## Saves the configuration file to disk
538sub save_config {
539    my ($self, $email) = @_;
540    $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $email);
541
542    return undef
543        unless ($self);
544
545    my $config_file_name = "$self->{'dir'}/config";
546
547    ## Lock file
548    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
549    unless ($lock_fh) {
550        $log->syslog('err', 'Could not create new lock');
551        return undef;
552    }
553
554    my $name                 = $self->{'name'};
555    my $old_serial           = $self->{'admin'}{'serial'};
556    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
557
558    ## Update management info
559    $self->{'admin'}{'serial'}++;
560    $self->{'admin'}{'update'} = {
561        'email'      => $email,
562        'date_epoch' => time,
563    };
564
565    unless (
566        $self->_save_list_config_file(
567            $config_file_name, $old_config_file_name
568        )
569    ) {
570        $log->syslog('info', 'Unable to save config file %s',
571            $config_file_name);
572        $lock_fh->close();
573        return undef;
574    }
575
576    ## Also update the binary version of the data structure
577    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
578        'binary_file') {
579        eval {
580            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
581        };
582        if ($@) {
583            $log->syslog('err',
584                'Failed to save the binary config %s. error: %s',
585                "$self->{'dir'}/config.bin", $@);
586        }
587    }
588
589    ## Release the lock
590    unless ($lock_fh->close()) {
591        return undef;
592    }
593
594    unless ($self->_update_list_db) {
595        $log->syslog('err', "Unable to update list_table");
596    }
597
598    return 1;
599}
600
601## Loads the administrative data for a list
602sub load {
603    $log->syslog('debug3', '(%s, %s, %s, ...)', @_);
604    my $self    = shift;
605    my $name    = shift;
606    my $robot   = shift;
607    my $options = shift;
608
609    die 'bug in logic. Ask developer' unless $robot;
610
611    ## Set of initializations ; only performed when the config is first loaded
612    if ($options->{'first_access'}) {
613        # Create parent of list directory if not exist yet e.g. when list to
614        # be created manually.
615        # Note: For compatibility, directory with primary domain is omitted.
616        if (    $robot
617            and $robot ne $Conf::Conf{'domain'}
618            and not -d "$Conf::Conf{'home'}/$robot") {
619            mkdir "$Conf::Conf{'home'}/$robot", 0775;
620        }
621
622        if ($robot && (-d "$Conf::Conf{'home'}/$robot")) {
623            $self->{'dir'} = "$Conf::Conf{'home'}/$robot/$name";
624        } elsif (lc($robot) eq lc($Conf::Conf{'domain'})) {
625            $self->{'dir'} = "$Conf::Conf{'home'}/$name";
626        } else {
627            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
628                unless ($options->{'just_try'});
629            return undef;
630        }
631
632        $self->{'domain'} = $robot;
633
634        # default list host is robot domain: Deprecated.
635        #XXX$self->{'admin'}{'host'} ||= $self->{'domain'};
636        $self->{'name'} = $name;
637    }
638
639    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
640        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
641            $self->{'dir'}, $name)
642            unless ($options->{'just_try'});
643        return undef;
644    }
645
646    # Last modification of list config ($last_time_config) on memory cache.
647    # Note: "subscribers" file was deprecated. No need to load "stats" file.
648    my $last_time_config = $self->{'_mtime'}{'config'};
649    $last_time_config = POSIX::INT_MIN() unless defined $last_time_config;
650
651    my $time_config = Sympa::Tools::File::get_mtime("$self->{'dir'}/config");
652    my $time_config_bin =
653        Sympa::Tools::File::get_mtime("$self->{'dir'}/config.bin");
654    my $main_config_time =
655        Sympa::Tools::File::get_mtime(Sympa::Constants::CONFIG);
656    # my $web_config_time  = Sympa::Tools::File::get_mtime(Sympa::Constants::WWSCONFIG);
657    my $config_reloaded = 0;
658    my $admin;
659
660    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
661            'binary_file'
662        and !$options->{'reload_config'}
663        and $time_config_bin > $last_time_config
664        and $time_config_bin >= $time_config
665        and $time_config_bin >= $main_config_time) {
666        ## Get a shared lock on config file first
667        my $lock_fh =
668            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
669        unless ($lock_fh) {
670            $log->syslog('err', 'Could not create new lock');
671            return undef;
672        }
673
674        ## Load a binary version of the data structure
675        ## unless config is more recent than config.bin
676        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
677        if ($@) {
678            $log->syslog('err',
679                'Failed to load the binary config %s, error: %s',
680                "$self->{'dir'}/config.bin", $@);
681            $lock_fh->close();
682            return undef;
683        }
684
685        $config_reloaded  = 1;
686        $last_time_config = $time_config_bin;
687        $lock_fh->close();
688    } elsif ($self->{'name'} ne $name
689        or $time_config > $last_time_config
690        or $options->{'reload_config'}) {
691        $admin = $self->_load_list_config_file;
692
693        ## Get a shared lock on config file first
694        my $lock_fh =
695            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
696        unless ($lock_fh) {
697            $log->syslog('err', 'Could not create new lock');
698            return undef;
699        }
700
701        ## update the binary version of the data structure
702        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
703            'binary_file') {
704            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
705            if ($@) {
706                $log->syslog('err',
707                    'Failed to save the binary config %s. error: %s',
708                    "$self->{'dir'}/config.bin", $@);
709            }
710        }
711
712        $config_reloaded = 1;
713        unless (defined $admin) {
714            $log->syslog(
715                'err',
716                'Impossible to load list config file for list %s set in status error_config',
717                $self
718            );
719            $self->set_status_error_config('load_admin_file_error');
720            $lock_fh->close();
721            return undef;
722        }
723
724        $last_time_config = $time_config;
725        $lock_fh->close();
726    }
727
728    ## If config was reloaded...
729    if ($admin) {
730        $self->{'admin'} = $admin;
731
732        ## check param_constraint.conf if belongs to a family and the config
733        ## has been loaded
734        if (    not $options->{'no_check_family'}
735            and defined $admin->{'family_name'}
736            and $admin->{'status'} ne 'error_config') {
737            my $family;
738            unless ($family = $self->get_family()) {
739                $log->syslog(
740                    'err',
741                    'Impossible to get list %s family: %s. The list is set in status error_config',
742                    $self,
743                    $self->{'admin'}{'family_name'}
744                );
745                $self->set_status_error_config('no_list_family',
746                    $self->{'admin'}{'family_name'});
747                return undef;
748            }
749        }
750    }
751
752    $self->{'as_x509_cert'} = 1
753        if ((-r "$self->{'dir'}/cert.pem")
754        || (-r "$self->{'dir'}/cert.pem.enc"));
755
756    $self->{'_mtime'}{'config'} = $last_time_config;
757
758    $list_of_lists{$self->{'domain'}}{$name} = $self;
759    return $config_reloaded;
760}
761
762## Return a list of hash's owners and their param
763#OBSOLETED.  Use get_admins().
764#sub get_owners;
765
766# OBSOLETED: No longer used.
767#sub get_nb_owners;
768
769## Return a hash of list's editors and their param(empty if there isn't any
770## editor)
771#OBSOLETED. Use get_admins().
772#sub get_editors;
773
774## Returns an array of owners' email addresses
775#OBSOLETED: Use get_admins_email('receptive_owner') or
776#           get_admins_email('owner').
777#sub get_owners_email;
778
779## Returns an array of editors' email addresses
780#  or owners if there isn't any editors' email addresses
781#OBSOLETED: Use get_admins_email('receptive_editor') or
782#           get_admins_email('actual_editor').
783#sub get_editors_email;
784
785## Returns an object Sympa::Family if the list belongs to a family or undef
786sub get_family {
787    my $self = shift;
788
789    if (ref $self->{'family'} eq 'Sympa::Family') {
790        return $self->{'family'};
791    } elsif ($self->{'admin'}{'family_name'}) {
792        return $self->{'family'} =
793            Sympa::Family->new($self->{'admin'}{'family_name'},
794            $self->{'domain'});
795    } else {
796        return undef;
797    }
798}
799
800## return the config_changes hash
801## Used ONLY with lists belonging to a family.
802sub get_config_changes {
803    my $self = shift;
804    $log->syslog('debug3', '(%s)', $self->{'name'});
805
806    unless ($self->{'admin'}{'family_name'}) {
807        $log->syslog('err',
808            '(%s) Is called but there is no family_name for this list',
809            $self->{'name'});
810        return undef;
811    }
812
813    ## load config_changes
814    my $time_file =
815        Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
816    unless (defined $self->{'config_changes'}
817        && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
818        unless ($self->{'config_changes'} =
819            $self->_load_config_changes_file()) {
820            $log->syslog('err',
821                'Impossible to load file config_changes from list %s',
822                $self->{'name'});
823            return undef;
824        }
825    }
826    return $self->{'config_changes'};
827}
828
829## update file config_changes if the list belongs to a family by
830#  writing the $what(file or param) name
831sub update_config_changes {
832    my $self = shift;
833    my $what = shift;
834    # one param or a ref on array of param
835    my $name = shift;
836    $log->syslog('debug2', '(%s, %s)', $self->{'name'}, $what);
837
838    unless ($self->{'admin'}{'family_name'}) {
839        $log->syslog(
840            'err',
841            '(%s, %s, %s) Is called but there is no family_name for this list',
842            $self->{'name'},
843            $what
844        );
845        return undef;
846    }
847    unless (($what eq 'file') || ($what eq 'param')) {
848        $log->syslog('err', '(%s, %s) %s is wrong: must be "file" or "param"',
849            $self->{'name'}, $what);
850        return undef;
851    }
852
853    # status parameter isn't updating set in config_changes
854    if (($what eq 'param') && ($name eq 'status')) {
855        return 1;
856    }
857
858    ## load config_changes
859    my $time_file =
860        Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
861    unless (defined $self->{'config_changes'}
862        && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
863        unless ($self->{'config_changes'} =
864            $self->_load_config_changes_file()) {
865            $log->syslog('err',
866                'Impossible to load file config_changes from list %s',
867                $self->{'name'});
868            return undef;
869        }
870    }
871
872    if (ref($name) eq 'ARRAY') {
873        foreach my $n (@{$name}) {
874            $self->{'config_changes'}{$what}{$n} = 1;
875        }
876    } else {
877        $self->{'config_changes'}{$what}{$name} = 1;
878    }
879
880    $self->_save_config_changes_file();
881
882    return 1;
883}
884
885## return a hash of config_changes file
886sub _load_config_changes_file {
887    my $self = shift;
888    $log->syslog('debug3', '(%s)', $self->{'name'});
889
890    my $config_changes = {};
891
892    unless (-e "$self->{'dir'}/config_changes") {
893        $log->syslog('err', 'No file %s/config_changes. Assuming no changes',
894            $self->{'dir'});
895        return $config_changes;
896    }
897
898    unless (open(FILE, "$self->{'dir'}/config_changes")) {
899        $log->syslog('err',
900            'File %s/config_changes exists, but unable to open it: %m',
901            $self->{'dir'});
902        return undef;
903    }
904
905    while (<FILE>) {
906
907        next if /^\s*(\#.*|\s*)$/;
908
909        if (/^param\s+(.+)\s*$/) {
910            $config_changes->{'param'}{$1} = 1;
911
912        } elsif (/^file\s+(.+)\s*$/) {
913            $config_changes->{'file'}{$1} = 1;
914
915        } else {
916            $log->syslog('err', '(%s) Bad line: %s', $self->{'name'}, $_);
917            next;
918        }
919    }
920    close FILE;
921
922    $config_changes->{'mtime'} =
923        Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
924
925    return $config_changes;
926}
927
928## save config_changes file in the list directory
929sub _save_config_changes_file {
930    my $self = shift;
931    $log->syslog('debug3', '(%s)', $self->{'name'});
932
933    unless ($self->{'admin'}{'family_name'}) {
934        $log->syslog('err',
935            '(%s) Is called but there is no family_name for this list',
936            $self->{'name'});
937        return undef;
938    }
939    unless (open FILE, '>', $self->{'dir'} . '/config_changes') {
940        $log->syslog('err', 'Unable to create file %s/config_changes: %m',
941            $self->{'dir'});
942        return undef;
943    }
944
945    foreach my $what ('param', 'file') {
946        foreach my $name (keys %{$self->{'config_changes'}{$what}}) {
947            print FILE "$what $name\n";
948        }
949    }
950    close FILE;
951
952    return 1;
953}
954
955## Returns the list parameter value from $list->{'admin'}
956#  the parameter is simple ($param) or composed ($param & $minor_param)
957#  the value is a scalar or a ref on an array of scalar
958# (for parameter digest : only for days)
959sub get_param_value {
960    $log->syslog('debug3', '(%s, %s, %s)', @_);
961    my $self        = shift;
962    my $param       = shift;
963    my $as_arrayref = shift || 0;
964    my $pinfo       = Sympa::Robot::list_params($self->{'domain'});
965    my $minor_param;
966    my $value;
967
968    if ($param =~ /^([\w-]+)\.([\w-]+)$/) {
969        $param       = $1;
970        $minor_param = $2;
971    }
972    # Resolve aliases.
973    if ($pinfo->{$param}) {
974        my $alias = $pinfo->{$param}{'obsolete'};
975        if ($alias and $pinfo->{$alias}) {
976            $param = $alias;
977        }
978    }
979    if (    $minor_param
980        and ref $pinfo->{$param}{'format'} eq 'HASH'
981        and $pinfo->{$param}{'format'}{$minor_param}) {
982        my $alias = $pinfo->{$param}{'format'}{$minor_param}{'obsolete'};
983        if ($alias and $pinfo->{$param}{'format'}{$alias}) {
984            $minor_param = $alias;
985        }
986    }
987
988    ## Multiple parameter (owner, custom_header, ...)
989    if (ref($self->{'admin'}{$param}) eq 'ARRAY'
990        and !$pinfo->{$param}{'split_char'}) {
991        my @values;
992        foreach my $elt (@{$self->{'admin'}{$param}}) {
993            my $val =
994                _get_single_param_value($pinfo, $elt, $param, $minor_param);
995            push @values, $val if defined $val;
996        }
997        $value = \@values;
998    } else {
999        $value = _get_single_param_value($pinfo, $self->{'admin'}{$param},
1000            $param, $minor_param);
1001        if ($as_arrayref) {
1002            return [$value] if defined $value;
1003            return [];
1004        }
1005    }
1006    return $value;
1007}
1008
1009## Returns the single list parameter value from struct $p, with $key entrie,
1010#  $k is optionnal
1011#  the single value can be a ref on a list when the parameter value is a list
1012sub _get_single_param_value {
1013    my ($pinfo, $p, $key, $k) = @_;
1014    $log->syslog('debug3', '(%s %s)', $key, $k);
1015
1016    if (   defined($pinfo->{$key}{'scenario'})
1017        || defined($pinfo->{$key}{'task'})) {
1018        return $p->{'name'};
1019
1020    } elsif (ref($pinfo->{$key}{'file_format'})) {
1021
1022        if (defined($pinfo->{$key}{'file_format'}{$k}{'scenario'})) {
1023            return $p->{$k}{'name'};
1024
1025        } elsif (($pinfo->{$key}{'file_format'}{$k}{'occurrence'} =~ /n$/)
1026            && $pinfo->{$key}{'file_format'}{$k}{'split_char'}) {
1027            return $p->{$k};    # ref on an array
1028        } else {
1029            return $p->{$k};
1030        }
1031
1032    } else {
1033        if (($pinfo->{$key}{'occurrence'} =~ /n$/)
1034            && $pinfo->{$key}{'split_char'}) {
1035            return $p;          # ref on an array
1036        } elsif ($key eq 'digest') {
1037            return $p->{'days'};    # ref on an array
1038        } else {
1039            return $p;
1040        }
1041    }
1042}
1043
1044##############################################################################
1045#                       FUNCTIONS FOR MESSAGE SENDING
1046#                       #
1047##############################################################################
1048#
1049#  -list distribution
1050#  -template sending
1051#  #
1052#  -service messages
1053#  -notification sending(listmaster, owner, editor, user)
1054#  #
1055#                                                                 #
1056
1057###   LIST DISTRIBUTION  ###
1058
1059# Moved (split) to:
1060# Sympa::Spindle::TransformIncoming::_twist(),
1061# Sympa::Spindle::ToArchive::_twist(),
1062# Sympa::Spindle::TransformOutgoing::_twist(),
1063# Sympa::Spindle::ToDigest::_twist(), Sympa::Spindle::ToList::_send_msg().
1064#sub distribute_msg;
1065
1066# Moved to: Sympa::Spindle::DecodateOutgoing::_twist().
1067#sub post_archive;
1068
1069# Old name: Sympa::Mail::mail_message()
1070# Moved To: Sympa::Spindle::ToList::_mail_message().
1071#sub _mail_message;
1072
1073# Old name: List::send_msg_digest().
1074# Moved to Sympa::Spindle::ProcessDigest::_distribute_digest().
1075#sub distribute_digest;
1076
1077sub get_digest_recipients_per_mode {
1078    my $self = shift;
1079
1080    my @tabrcpt_digest;
1081    my @tabrcpt_summary;
1082    my @tabrcpt_digestplain;
1083
1084    ## Create the list of subscribers in various digest modes
1085    for (
1086        my $user = $self->get_first_list_member();
1087        $user;
1088        $user = $self->get_next_list_member()
1089    ) {
1090        # Test to know if the rcpt suspended her subscription for this list.
1091        # If yes, don't send the message.
1092        if ($user and $user->{'suspend'}) {
1093            if (    (not $user->{'startdate'} or $user->{'startdate'} <= time)
1094                and (not $user->{'enddate'} or time <= $user->{'enddate'})) {
1095                next;
1096            } elsif ($user->{'enddate'} and $user->{'enddate'} < time) {
1097                # If end date is < time, update subscriber by deleting the
1098                # suspension setting.
1099                $self->restore_suspended_subscription($user->{'email'});
1100            }
1101        }
1102        if ($user->{'reception'} eq "digest") {
1103            push @tabrcpt_digest, $user->{'email'};
1104
1105        } elsif ($user->{'reception'} eq "summary") {
1106            ## Create the list of subscribers in summary mode
1107            push @tabrcpt_summary, $user->{'email'};
1108
1109        } elsif ($user->{'reception'} eq "digestplain") {
1110            push @tabrcpt_digestplain, $user->{'email'};
1111        }
1112    }
1113
1114    return 0
1115        unless @tabrcpt_summary
1116        or @tabrcpt_digest
1117        or @tabrcpt_digestplain;
1118
1119    my $available_recipients;
1120    $available_recipients->{'summary'} = \@tabrcpt_summary
1121        if @tabrcpt_summary;
1122    $available_recipients->{'digest'} = \@tabrcpt_digest if @tabrcpt_digest;
1123    $available_recipients->{'digestplain'} = \@tabrcpt_digestplain
1124        if @tabrcpt_digestplain;
1125
1126    return $available_recipients;
1127}
1128
1129###   TEMPLATE SENDING  ###
1130
1131# MOVED to Sympa::send_dsn().
1132#sub send_dsn;
1133
1134#MOVED: Use Sympa::send_file() or Sympa::List::send_probe_to_user().
1135# sub send_file($self, $tpl, $who, $robot, $context);
1136
1137#DEPRECATED: Merged to List::distribute_msg(), then moved to
1138# Sympa::Spindle::ToList::_send_msg().
1139# sub send_msg($message);
1140
1141sub get_recipients_per_mode {
1142    my $self    = shift;
1143    my $message = shift;
1144    my %options = @_;
1145
1146    my $robot = $self->{'domain'};
1147
1148    my (@tabrcpt_mail,        @tabrcpt_mail_verp,
1149        @tabrcpt_notice,      @tabrcpt_notice_verp,
1150        @tabrcpt_txt,         @tabrcpt_txt_verp,
1151        @tabrcpt_urlize,      @tabrcpt_urlize_verp,
1152        @tabrcpt_digestplain, @tabrcpt_digestplain_verp,
1153        @tabrcpt_digest,      @tabrcpt_digest_verp,
1154        @tabrcpt_summary,     @tabrcpt_summary_verp,
1155        @tabrcpt_nomail,      @tabrcpt_nomail_verp,
1156    );
1157
1158    for (
1159        my $user = $self->get_first_list_member();
1160        $user;
1161        $user = $self->get_next_list_member()
1162    ) {
1163        unless ($user->{'email'}) {
1164            $log->syslog('err',
1165                'Skipping user with no email address in list %s', $self);
1166            next;
1167        }
1168        # Test to know if the rcpt suspended her subscription for this list.
1169        # if yes, don't send the message.
1170        if ($user and $user->{'suspend'}) {
1171            if (    (not $user->{'startdate'} or $user->{'startdate'} <= time)
1172                and (not $user->{'enddate'} or time <= $user->{'enddate'})) {
1173                push @tabrcpt_nomail_verp, $user->{'email'};
1174                next;
1175            } elsif ($user->{'enddate'} and $user->{'enddate'} < time) {
1176                # If end date is < time, update subscriber by deleting the
1177                # suspension setting.
1178                $self->restore_suspended_subscription($user->{'email'});
1179            }
1180        }
1181
1182        # Check if "not_me" reception mode is set.
1183        next
1184            if $user->{'reception'} eq 'not_me'
1185            and $message->{sender} eq $user->{'email'};
1186
1187        # Recipients who won't receive encrypted messages.
1188        # The digest, digestplain, nomail and summary reception option are
1189        # initialized for tracking feature only.
1190        if ($user->{'reception'} eq 'digestplain') {
1191            push @tabrcpt_digestplain_verp, $user->{'email'};
1192            next;
1193        } elsif ($user->{'reception'} eq 'digest') {
1194            push @tabrcpt_digest_verp, $user->{'email'};
1195            next;
1196        } elsif ($user->{'reception'} eq 'summary') {
1197            push @tabrcpt_summary_verp, $user->{'email'};
1198            next;
1199        } elsif ($user->{'reception'} eq 'nomail') {
1200            push @tabrcpt_nomail_verp, $user->{'email'};
1201            next;
1202        } elsif ($user->{'reception'} eq 'notice') {
1203            if ($user->{'bounce_address'}) {
1204                push @tabrcpt_notice_verp, $user->{'email'};
1205            } else {
1206                push @tabrcpt_notice, $user->{'email'};
1207            }
1208            next;
1209        }
1210
1211        #XXX Following will be done by ProcessOutgoing spindle.
1212        # # Message should be re-encrypted, however, user certificate is
1213        # # missing.
1214        # if ($message->{'smime_crypted'}
1215        #     and not -r $Conf::Conf{'ssl_cert_dir'} . '/'
1216        #     . Sympa::Tools::Text::escape_chars($user->{'email'})
1217        #     and not -r $Conf::Conf{'ssl_cert_dir'} . '/'
1218        #     . Sympa::Tools::Text::escape_chars($user->{'email'} . '@enc')) {
1219        #     my $subject = $message->{'decoded_subject'};
1220        #     my $sender  = $message->{'sender'};
1221        #     unless (
1222        #         Sympa::send_file(
1223        #             $self,
1224        #             'x509-user-cert-missing',
1225        #             $user->{'email'},
1226        #             {   'mail' =>
1227        #                     {'subject' => $subject, 'sender' => $sender},
1228        #                 'auto_submitted' => 'auto-generated'
1229        #             }
1230        #         )
1231        #         ) {
1232        #         $log->syslog(
1233        #             'notice',
1234        #             'Unable to send template "x509-user-cert-missing" to %s',
1235        #             $user->{'email'}
1236        #         );
1237        #     }
1238        #     next;
1239        # }
1240        # # Otherwise it may be shelved encryption.
1241
1242        if ($user->{'reception'} eq 'txt') {
1243            if ($user->{'bounce_address'}) {
1244                push @tabrcpt_txt_verp, $user->{'email'};
1245            } else {
1246                push @tabrcpt_txt, $user->{'email'};
1247            }
1248        } elsif ($user->{'reception'} eq 'urlize') {
1249            if ($user->{'bounce_address'}) {
1250                push @tabrcpt_urlize_verp, $user->{'email'};
1251            } else {
1252                push @tabrcpt_urlize, $user->{'email'};
1253            }
1254        } else {
1255            if ($user->{'bounce_score'}) {
1256                push @tabrcpt_mail_verp, $user->{'email'};
1257            } else {
1258                push @tabrcpt_mail, $user->{'email'};
1259            }
1260        }
1261    }
1262
1263    return 0
1264        unless @tabrcpt_mail
1265        or @tabrcpt_notice
1266        or @tabrcpt_txt
1267        or @tabrcpt_urlize
1268        or @tabrcpt_mail_verp
1269        or @tabrcpt_notice_verp
1270        or @tabrcpt_txt_verp
1271        or @tabrcpt_urlize_verp;
1272
1273    my $available_recipients;
1274
1275    $available_recipients->{'mail'}{'noverp'} = \@tabrcpt_mail
1276        if @tabrcpt_mail;
1277    $available_recipients->{'mail'}{'verp'} = \@tabrcpt_mail_verp
1278        if @tabrcpt_mail_verp;
1279    $available_recipients->{'notice'}{'noverp'} = \@tabrcpt_notice
1280        if @tabrcpt_notice;
1281    $available_recipients->{'notice'}{'verp'} = \@tabrcpt_notice_verp
1282        if @tabrcpt_notice_verp;
1283    $available_recipients->{'txt'}{'noverp'} = \@tabrcpt_txt if @tabrcpt_txt;
1284    $available_recipients->{'txt'}{'verp'} = \@tabrcpt_txt_verp
1285        if @tabrcpt_txt_verp;
1286    $available_recipients->{'urlize'}{'noverp'} = \@tabrcpt_urlize
1287        if @tabrcpt_urlize;
1288    $available_recipients->{'urlize'}{'verp'} = \@tabrcpt_urlize_verp
1289        if @tabrcpt_urlize_verp;
1290    $available_recipients->{'digestplain'}{'noverp'} = \@tabrcpt_digestplain
1291        if @tabrcpt_digestplain;
1292    $available_recipients->{'digestplain'}{'verp'} =
1293        \@tabrcpt_digestplain_verp
1294        if @tabrcpt_digestplain_verp;
1295    $available_recipients->{'digest'}{'noverp'} = \@tabrcpt_digest
1296        if @tabrcpt_digest;
1297    $available_recipients->{'digest'}{'verp'} = \@tabrcpt_digest_verp
1298        if @tabrcpt_digest_verp;
1299    $available_recipients->{'summary'}{'noverp'} = \@tabrcpt_summary
1300        if @tabrcpt_summary;
1301    $available_recipients->{'summary'}{'verp'} = \@tabrcpt_summary_verp
1302        if @tabrcpt_summary_verp;
1303    $available_recipients->{'nomail'}{'noverp'} = \@tabrcpt_nomail
1304        if @tabrcpt_nomail;
1305    $available_recipients->{'nomail'}{'verp'} = \@tabrcpt_nomail_verp
1306        if @tabrcpt_nomail_verp;
1307
1308    return $available_recipients;
1309}
1310
1311###   SERVICE MESSAGES   ###
1312
1313# Old name: List::send_to_editor().
1314# Moved to: Sympa::Spindle::ToEditor & Sympa::Spindle::ToModeration.
1315#sub send_confirm_to_editor;
1316
1317# Old name: List::send_auth().
1318# Moved to Sympa::Spindle::ToHeld::_send_confirm_to_sender().
1319#sub send_confirm_to_sender;
1320
1321#MOVED: Use Sympa::request_auth().
1322#sub request_auth;
1323
1324# Merged into Sympa::Commands::getfile().
1325#sub archive_send;
1326
1327# Merged into Sympa::Commands::last().
1328#sub archive_send_last;
1329
1330###   NOTIFICATION SENDING  ###
1331
1332####################################################
1333# send_notify_to_owner
1334####################################################
1335# Sends a notice to list owner(s) by parsing
1336# listowner_notification.tt2 template
1337#
1338# IN : -$self (+): ref(List)
1339#      -$operation (+): notification type
1340#      -$param(+) : ref(HASH) | ref(ARRAY)
1341#       values for template parsing
1342#
1343# OUT : 1 | undef
1344#
1345######################################################
1346sub send_notify_to_owner {
1347    $log->syslog('debug2', '(%s, %s, %s)', @_);
1348    my $self      = shift;
1349    my $operation = shift;
1350    my $param     = shift;
1351
1352    die 'bug in logic. Ask developer' unless defined $operation;
1353
1354    my @rcpt = $self->get_admins_email('receptive_owner');
1355    @rcpt = $self->get_admins_email('owner') unless @rcpt;
1356    unless (@rcpt) {
1357        $log->syslog(
1358            'notice',
1359            'No owner defined at all in list %s; notification is sent to listmasters',
1360            $self
1361        );
1362        @rcpt = Sympa::get_listmasters_email($self);
1363    }
1364
1365    if (ref $param eq 'HASH') {
1366        $param->{'auto_submitted'} = 'auto-generated';
1367        $param->{'to'}             = join(',', @rcpt);
1368        $param->{'type'}           = $operation;
1369
1370        if ($operation eq 'sigrequest' or $operation eq 'subrequest') {
1371            # Sends notifications by each so that auth links with owners'
1372            # addresses will be included.
1373            foreach my $owner (@rcpt) {
1374                unless (
1375                    Sympa::send_file(
1376                        $self, 'listowner_notification', $owner, $param
1377                    )
1378                ) {
1379                    $log->syslog(
1380                        'notice',
1381                        'Unable to send template "listowner_notification" to %s list owner %s',
1382                        $self,
1383                        $owner
1384                    );
1385                }
1386            }
1387        } else {
1388            if ($operation eq 'bounce_rate') {
1389                $param->{'rate'} = int($param->{'rate'} * 10) / 10;
1390            }
1391            unless (
1392                Sympa::send_file(
1393                    $self, 'listowner_notification', [@rcpt], $param
1394                )
1395            ) {
1396                $log->syslog(
1397                    'notice',
1398                    'Unable to send template "listowner_notification" to %s list owner',
1399                    $self
1400                );
1401                return undef;
1402            }
1403        }
1404    } elsif (ref $param eq 'ARRAY') {
1405
1406        my $data = {
1407            'to'   => join(',', @rcpt),
1408            'type' => $operation
1409        };
1410
1411        for my $i (0 .. $#{$param}) {
1412            $data->{"param$i"} = $param->[$i];
1413        }
1414        unless (
1415            Sympa::send_file($self, 'listowner_notification', \@rcpt, $data))
1416        {
1417            $log->syslog(
1418                'notice',
1419                'Unable to send template "listowner_notification" to %s list owner',
1420                $self
1421            );
1422            return undef;
1423        }
1424
1425    } else {
1426        $log->syslog(
1427            'err',
1428            '(%s, %s) Error on incoming parameter "$param", it must be a ref on HASH or a ref on ARRAY',
1429            $self,
1430            $operation
1431        );
1432        return undef;
1433    }
1434    return 1;
1435}
1436
1437# FIXME:This might be moved to Sympa::WWW namespace.
1438sub get_picture_path {
1439    my $self = shift;
1440    return join '/', $Conf::Conf{'pictures_path'}, $self->get_id, @_;
1441}
1442
1443# No longer used.  Use Sympa::List::find_picture_url().
1444#sub get_picture_url;
1445
1446# Old name: tools::pictures_filename()
1447# FIXME:This might be moved to Sympa::WWW namespace.
1448sub find_picture_filenames {
1449    my $self  = shift;
1450    my $email = shift;
1451
1452    my @ret = ();
1453    if ($email) {
1454        my $login = Digest::MD5::md5_hex($email);
1455        foreach my $ext (qw{gif jpg jpeg png}) {
1456            if (-f $self->get_picture_path($login . '.' . $ext)) {
1457                push @ret, $login . '.' . $ext;
1458            }
1459        }
1460    }
1461    return @ret;
1462}
1463
1464# FIXME:This might be moved to Sympa::WWW namespace.
1465sub find_picture_paths {
1466    my $self  = shift;
1467    my $email = shift;
1468
1469    return
1470        map { $self->get_picture_path($_) }
1471        $self->find_picture_filenames($email);
1472}
1473
1474# Old name: tools::make_pictures_url().
1475# FIXME:This might be moved to Sympa::WWW namespace.
1476sub find_picture_url {
1477    my $self  = shift;
1478    my $email = shift;
1479
1480    my ($filename) = $self->find_picture_filenames($email);
1481    return undef unless $filename;
1482
1483    return Sympa::Tools::Text::weburl($Conf::Conf{'pictures_url'},
1484        [$self->get_id, $filename]);
1485}
1486
1487# FIXME:This might be moved to Sympa::WWW namespace.
1488sub delete_list_member_picture {
1489    $log->syslog('debug2', '(%s, %s)', @_);
1490    my $self  = shift;
1491    my $email = shift;
1492
1493    my $ret = 1;
1494    foreach my $path ($self->find_picture_paths($email)) {
1495        unless (unlink $path) {
1496            $log->syslog('err', 'Failed to delete %s', $path);
1497            $ret = undef;
1498        } else {
1499            $log->syslog('debug3', 'File deleted successfully: %s', $path);
1500        }
1501    }
1502
1503    return $ret;
1504}
1505
1506#No longer used.
1507#sub send_notify_to_editor;
1508
1509# Moved to Sympa::send_notify_to_user().
1510#sub send_notify_to_user;
1511
1512sub send_probe_to_user {
1513    my $self = shift;
1514    my $type = shift;
1515    my $who  = shift;
1516
1517    # Shelve VERP for welcome or remind message if necessary
1518    my $tracking;
1519    if (    $self->{'admin'}{'welcome_return_path'} eq 'unique'
1520        and $type eq 'welcome') {
1521        $tracking = 'w';
1522    } elsif ($self->{'admin'}{'remind_return_path'} eq 'unique'
1523        and $type eq 'remind') {
1524        $tracking = 'r';
1525    } else {
1526        #FIXME? Return-Path for '*_return_path' parameter with 'owner'
1527        # value is LIST-owner address.  It might be LIST-request address.
1528    }
1529
1530    my $spindle = Sympa::Spindle::ProcessTemplate->new(
1531        context  => $self,
1532        template => $type,
1533        rcpt     => $who,
1534        data     => {},
1535        tracking => $tracking,
1536        #FIXME: Why overwrite priority?
1537        priority => Conf::get_robot_conf($self->{'domain'}, 'sympa_priority'),
1538    );
1539    unless ($spindle and $spindle->spin and $spindle->{finish} eq 'success') {
1540        $log->syslog('err', 'Could not send template %s to %s', $type, $who);
1541        return undef;
1542    }
1543
1544    return 1;
1545}
1546
1547### END functions for sending messages ###
1548
1549#MOVED: Use Sympa::compute_auth().
1550#sub compute_auth;
1551
1552# DEPRECATED: Moved to Sympa::Message::_decorate_parts().
1553#sub add_parts;
1554
1555## Delete a user in the user_table
1556##sub delete_global_user
1557## DEPRECATED: Use Sympa::User::delete_global_user() or $user->expire();
1558
1559## Delete the indicate list member
1560## IN : - ref to array
1561##      - option exclude
1562##
1563## $list->delete_list_member('users' => \@u, 'exclude' => 1)
1564## $list->delete_list_member('users' => [$email], 'exclude' => 1)
1565sub delete_list_member {
1566    my $self    = shift;
1567    my %param   = @_;
1568    my @u       = @{$param{'users'}};
1569    my $exclude = $param{'exclude'};
1570
1571    # Case of deleting: "auto_del" (bounce management), "signoff" (manual
1572    # signoff) or "del" (deleted by admin)?
1573    my $operation = $param{'operation'};
1574
1575    $log->syslog('debug2', '');
1576
1577    my $name  = $self->{'name'};
1578    my $total = 0;
1579
1580    my $sdm = Sympa::DatabaseManager->instance;
1581
1582    foreach my $who (@u) {
1583        $who = Sympa::Tools::Text::canonic_email($who);
1584
1585        ## Include in exclusion_table only if option is set.
1586        if ($exclude) {
1587            # Insert in exclusion_table if $user->{inclusion} defined.
1588            $self->insert_delete_exclusion($who, 'insert');
1589        }
1590
1591        # Delete record in subscriber_table.
1592        unless (
1593            $sdm
1594            and $sdm->do_prepared_query(
1595                q{DELETE FROM subscriber_table
1596                  WHERE user_subscriber = ? AND
1597                        list_subscriber = ? AND robot_subscriber = ?},
1598                $who, $name, $self->{'domain'}
1599            )
1600        ) {
1601            $log->syslog('err', 'Unable to remove list member %s', $who);
1602            next;
1603        }
1604
1605        # Delete signoff requests if any.
1606        my $spool_req = Sympa::Spool::Auth->new(
1607            context => $self,
1608            action  => 'del',
1609            email   => $who,
1610        );
1611        while (1) {
1612            my ($request, $handle) = $spool_req->next;
1613            last unless $handle;
1614            next unless $request;
1615
1616            $spool_req->remove($handle);
1617        }
1618
1619        #log in stat_table to make statistics
1620        if ($operation) {
1621            $log->add_stat(
1622                'robot'     => $self->{'domain'},
1623                'list'      => $name,
1624                'operation' => $operation,
1625                'mail'      => $who
1626            );
1627        }
1628
1629        $total--;
1630    }
1631
1632    $self->_cache_publish_expiry('member');
1633    delete_list_member_picture($self, shift(@u));
1634    return (-1 * $total);
1635
1636}
1637
1638## Delete the indicated admin users from the list.
1639sub delete_list_admin {
1640    my ($self, $role, @u) = @_;
1641    $log->syslog('debug2', '', $role);
1642
1643    my $name  = $self->{'name'};
1644    my $total = 0;
1645
1646    foreach my $who (@u) {
1647        $who = Sympa::Tools::Text::canonic_email($who);
1648        my $statement;
1649
1650        my $sdm = Sympa::DatabaseManager->instance;
1651
1652        # Delete record in ADMIN
1653        unless (
1654            $sdm
1655            and $sdm->do_prepared_query(
1656                q{DELETE FROM admin_table
1657                  WHERE user_admin = ? AND list_admin = ? AND
1658                        robot_admin = ? AND role_admin = ?},
1659                $who,              $self->{'name'},
1660                $self->{'domain'}, $role
1661            )
1662        ) {
1663            $log->syslog('err', 'Unable to remove admin %s of list %s',
1664                $who, $self);
1665            next;
1666        }
1667
1668        $total--;
1669    }
1670
1671    $self->_cache_publish_expiry('admin_user');
1672
1673    return (-1 * $total);
1674}
1675
1676# Delete all admin_table entries.
1677# OBSOLETED: No longer used.
1678#sub delete_all_list_admin;
1679
1680# OBSOLETED: This may no longer be used.
1681#sub get_cookie;
1682
1683# OBSOLETED: No longer used.
1684# Returns the maximum size allowed for a message to the list.
1685sub get_max_size {
1686    return shift->{'admin'}{'max_size'};
1687}
1688
1689## Returns an array with the Reply-To data
1690sub get_reply_to {
1691    my $admin = shift->{'admin'};
1692
1693    my $value = $admin->{'reply_to_header'}{'value'};
1694
1695    $value = $admin->{'reply_to_header'}{'other_email'}
1696        if ($value eq 'other_email');
1697
1698    return $value;
1699}
1700
1701## Returns a default user option
1702sub get_default_user_options {
1703    $log->syslog('debug3', '(%s,%s)', @_);
1704    my $self = shift;
1705    my $what = shift;
1706
1707    if ($self) {
1708        return $self->{'admin'}{'default_user_options'};
1709    }
1710    return undef;
1711}
1712
1713# Returns the number of subscribers of a list.
1714sub get_total {
1715    my $self   = shift;
1716    my $option = shift;
1717
1718    my $total = $self->_cache_get('total');
1719    if (defined $total and not($option and $option eq 'nocache')) {
1720        return $total;
1721    }
1722
1723    my $sdm = Sympa::DatabaseManager->instance;
1724    my $sth;
1725
1726    unless (
1727        $sdm
1728        and $sth = $sdm->do_prepared_query(
1729            q{SELECT COUNT(*)
1730              FROM subscriber_table
1731              WHERE list_subscriber = ? AND robot_subscriber = ?},
1732            $self->{'name'}, $self->{'domain'}
1733        )
1734    ) {
1735        $log->syslog('err', 'Unable to get subscriber count for list %s',
1736            $self);
1737        return $total;    # Return cache probably outdated.
1738    }
1739    $total = $self->_cache_put('total', $sth->fetchrow);
1740    $sth->finish;
1741
1742    return $total;
1743}
1744
1745## Returns a hash for a given user
1746##sub get_global_user {
1747## DEPRECATED: Use Sympa::User::get_global_user() or Sympa::User->new().
1748
1749## Returns an array of all users in User table hash for a given user
1750##sub get_all_global_user {
1751## DEPRECATED: Use Sympa::User::get_all_global_user() or
1752## Sympa::User::get_users().
1753
1754######################################################################
1755###  suspend_subscription                                            #
1756## Suspend an user from list(s)                                      #
1757######################################################################
1758# IN:                                                                #
1759#   - email : the subscriber email                                   #
1760#   - list : the name of the list                                    #
1761#   - data : start_date and end_date                                 #
1762#   - robot : domain                                                 #
1763# OUT:                                                               #
1764#   - undef if something went wrong.                                 #
1765#   - 1 if user is suspended from the list                           #
1766######################################################################
1767sub suspend_subscription {
1768
1769    my $email = shift;
1770    my $list  = shift;
1771    my $data  = shift;
1772    my $robot = shift;
1773    $log->syslog('debug2', '("%s", "%s", "%s")', $email, $list, $data);
1774
1775    my $sdm = Sympa::DatabaseManager->instance;
1776    unless (
1777        $sdm
1778        and $sdm->do_prepared_query(
1779            q{UPDATE subscriber_table
1780              SET suspend_subscriber = 1,
1781                  suspend_start_date_subscriber = ?,
1782                  suspend_end_date_subscriber = ?
1783              WHERE user_subscriber = ? AND
1784                    list_subscriber = ? AND robot_subscriber = ?},
1785            $data->{'startdate'}, $data->{'enddate'},
1786            $email, $list, $robot
1787        )
1788    ) {
1789        $log->syslog('err',
1790            'Unable to suspend subscription of user %s to list %s@%s',
1791            $email, $list, $robot);
1792        return undef;
1793    }
1794
1795    return 1;
1796}
1797
1798######################################################################
1799###  restore_suspended_subscription                                  #
1800## Restore the subscription of an user from list(s)                  #
1801######################################################################
1802# IN:                                                                #
1803#   - email : the subscriber email                                   #
1804# OUT:                                                               #
1805#   - undef if something went wrong.                                 #
1806#   - 1 if their subscription is restored                          #
1807######################################################################
1808sub restore_suspended_subscription {
1809    $log->syslog('debug2', '(%s)', @_);
1810    my $self  = shift;
1811    my $email = shift;
1812
1813    my $sdm = Sympa::DatabaseManager->instance;
1814    unless (
1815        $sdm
1816        and $sdm->do_prepared_query(
1817            q{UPDATE subscriber_table
1818              SET suspend_subscriber = 0,
1819                  suspend_start_date_subscriber  = NULL,
1820                  suspend_end_date_subscriber = NULL
1821              WHERE user_subscriber = ? AND list_subscriber = ? AND
1822                    robot_subscriber = ?},
1823            $email, $self->{'name'}, $self->{'domain'}
1824        )
1825    ) {
1826        $log->syslog('err',
1827            'Unable to restore subscription of user %s to list %s',
1828            $email, $self);
1829        return undef;
1830    }
1831
1832    return 1;
1833}
1834
1835######################################################################
1836# insert_delete_exclusion                                            #
1837# Update the exclusion_table                                         #
1838######################################################################
1839# IN:                                                                #
1840#   - email : the subscriber email                                   #
1841#   - action : insert or delete                                      #
1842# OUT:                                                               #
1843#   - undef if something went wrong.                                 #
1844#   - 1                                                              #
1845######################################################################
1846sub insert_delete_exclusion {
1847    $log->syslog('debug2', '(%s, %s, %s)', @_);
1848    my $self   = shift;
1849    my $email  = shift;
1850    my $action = shift;
1851
1852    die sprintf 'Invalid parameter: %s', $self
1853        unless ref $self;    #prototype changed (6.2b)
1854
1855    my $name     = $self->{'name'};
1856    my $robot_id = $self->{'domain'};
1857    my $sdm      = Sympa::DatabaseManager->instance;
1858
1859    my $r = 1;
1860
1861    if ($action eq 'insert') {
1862        # INSERT only if $user->{inclusion} defined.
1863        my $user = $self->get_list_member($email);
1864        my $date = time;
1865
1866        if (defined $user->{'inclusion'}) {
1867            unless (
1868                $sdm
1869                and $sdm->do_prepared_query(
1870                    q{INSERT INTO exclusion_table
1871                      (list_exclusion, family_exclusion, robot_exclusion,
1872                       user_exclusion, date_exclusion)
1873                      VALUES (?, ?, ?, ?, ?)},
1874                    $name, '', $robot_id, $email, $date
1875                )
1876            ) {
1877                $log->syslog('err', 'Unable to exclude user %s from list %s',
1878                    $email, $self);
1879                return undef;
1880            }
1881        }
1882    } elsif ($action eq 'delete') {
1883        ## If $email is in exclusion_table, delete it.
1884        my $data_excluded = $self->get_exclusion();
1885        my @users_excluded;
1886
1887        my $key = 0;
1888        while ($data_excluded->{'emails'}->[$key]) {
1889            push @users_excluded, $data_excluded->{'emails'}->[$key];
1890            $key = $key + 1;
1891        }
1892
1893        $r = 0;
1894        my $sth;
1895        foreach my $users (@users_excluded) {
1896            if ($email eq $users) {
1897                ## Delete : list, user and date
1898                unless (
1899                    $sdm
1900                    and $sth = $sdm->do_prepared_query(
1901                        q{DELETE FROM exclusion_table
1902                          WHERE list_exclusion = ? AND robot_exclusion = ? AND
1903                                user_exclusion = ?},
1904                        $name, $robot_id, $email
1905                    )
1906                ) {
1907                    $log->syslog(
1908                        'err',
1909                        'Unable to remove entry %s for list %s from table exclusion_table',
1910                        $email,
1911                        $self
1912                    );
1913                }
1914                $r = $sth->rows;
1915            }
1916        }
1917    } else {
1918        $log->syslog('err', 'Unknown action %s', $action);
1919        return undef;
1920    }
1921
1922    return $r;
1923}
1924
1925######################################################################
1926# get_exclusion                                                      #
1927# Returns a hash with those excluded from the list and the date.     #
1928#                                                                    #
1929# IN:  - name : the name of the list                                 #
1930# OUT: - data_exclu : * %data_exclu->{'emails'}->[]                  #
1931#                     * %data_exclu->{'date'}->[]                    #
1932######################################################################
1933sub get_exclusion {
1934    $log->syslog('debug2', '(%s)', @_);
1935    my $self = shift;
1936
1937    die sprintf 'Invalid parameter: %s', $self
1938        unless ref $self;    #prototype changed (6.2b)
1939
1940    my $name     = $self->{'name'};
1941    my $robot_id = $self->{'domain'};
1942
1943    push @sth_stack, $sth;
1944    my $sdm = Sympa::DatabaseManager->instance;
1945
1946    if (defined $self->{'admin'}{'family_name'}
1947        and length $self->{'admin'}{'family_name'}) {
1948        unless (
1949            $sdm
1950            and $sth = $sdm->do_prepared_query(
1951                q{SELECT user_exclusion AS email, date_exclusion AS "date"
1952                  FROM exclusion_table
1953                  WHERE (list_exclusion = ? OR family_exclusion = ?) AND
1954                         robot_exclusion = ?},
1955                $name, $self->{'admin'}{'family_name'}, $robot_id
1956            )
1957        ) {
1958            $log->syslog('err',
1959                'Unable to retrieve excluded users for list %s', $self);
1960            $sth = pop @sth_stack;
1961            return undef;
1962        }
1963    } else {
1964        unless (
1965            $sdm
1966            and $sth = $sdm->do_prepared_query(
1967                q{SELECT user_exclusion AS email, date_exclusion AS "date"
1968                  FROM exclusion_table
1969                  WHERE list_exclusion = ? AND robot_exclusion = ?},
1970                $name, $robot_id
1971            )
1972        ) {
1973            $log->syslog('err',
1974                'Unable to retrieve excluded users for list %s', $self);
1975            $sth = pop @sth_stack;
1976            return undef;
1977        }
1978    }
1979
1980    my @users;
1981    my @date;
1982    my $data;
1983    while ($data = $sth->fetchrow_hashref) {
1984        push @users, $data->{'email'};
1985        push @date,  $data->{'date'};
1986    }
1987    # In order to use the data, we add the emails and dates in different
1988    # array
1989    my $data_exclu = {
1990        "emails" => \@users,
1991        "date"   => \@date
1992    };
1993    $sth->finish();
1994
1995    $sth = pop @sth_stack;
1996
1997    unless ($data_exclu) {
1998        $log->syslog('err',
1999            'Unable to retrieve information from database for list %s',
2000            $self);
2001        return undef;
2002    }
2003    return $data_exclu;
2004}
2005
2006sub is_member_excluded {
2007    my $self  = shift;
2008    my $email = shift;
2009
2010    return undef unless defined $email and length $email;
2011    $email = Sympa::Tools::Text::canonic_email($email);
2012
2013    my $sdm = Sympa::DatabaseManager->instance;
2014    my $sth;
2015
2016    if (defined $self->{'admin'}{'family_name'}
2017        and length $self->{'admin'}{'family_name'}) {
2018        unless (
2019            $sdm
2020            and $sth = $sdm->do_prepared_query(
2021                q{SELECT COUNT(*)
2022                  FROM exclusion_table
2023                  WHERE (list_exclusion = ? OR family_exclusion = ?) AND
2024                        robot_exclusion = ? AND
2025                        user_exclusion = ?},
2026                $self->{'name'}, $self->{'admin'}{'family_name'},
2027                $self->{'domain'},
2028                $email
2029            )
2030        ) {
2031            #FIXME: report error
2032            return undef;
2033        }
2034    } else {
2035        unless (
2036            $sdm
2037            and $sth = $sdm->do_prepared_query(
2038                q{SELECT COUNT(*)
2039                  FROM exclusion_table
2040                  WHERE list_exclusion = ? AND robot_exclusion = ? AND
2041                        user_exclusion = ?},
2042                $self->{'name'}, $self->{'domain'},
2043                $email
2044            )
2045        ) {
2046            #FIXME: report error
2047            return undef;
2048        }
2049    }
2050    my ($count) = $sth->fetchrow_array;
2051    $sth->finish;
2052
2053    return $count || 0;
2054}
2055
2056# Mapping between var and field names.
2057sub _map_list_member_cols {
2058    my %map_field = (
2059        date        => 'date_epoch_subscriber',
2060        update_date => 'update_epoch_subscriber',
2061        gecos       => 'comment_subscriber',
2062        email       => 'user_subscriber',
2063        startdate   => 'suspend_start_date_subscriber',
2064        enddate     => 'suspend_end_date_subscriber',
2065    );
2066
2067    my $fields =
2068        {Sympa::DatabaseDescription::full_db_struct()}->{'subscriber_table'}
2069        ->{fields};
2070    foreach my $f (keys %$fields) {
2071        next if $f eq 'list_subscriber' or $f eq 'robot_subscriber';
2072
2073        my $k = {reverse %map_field}->{$f};
2074        unless ($k) {
2075            $k = $f;
2076            $k =~ s/_subscriber\z//;
2077            $map_field{$k} = $f;
2078        }
2079    }
2080    # Additional DB fields.
2081    if ($Conf::Conf{'db_additional_subscriber_fields'}) {
2082        foreach my $f (split /\s*,\s*/,
2083            $Conf::Conf{'db_additional_subscriber_fields'}) {
2084            $map_field{$f} = $f;
2085        }
2086    }
2087
2088    return %map_field;
2089}
2090
2091sub _list_member_cols {
2092    my $sdm = shift;
2093
2094    my %map_field = _map_list_member_cols();
2095    return join ', ', map {
2096        my $col = $map_field{$_};
2097        ($col eq $_) ? $col : sprintf('%s AS "%s"', $col, $_);
2098    } sort keys %map_field;
2099}
2100
2101sub get_list_member {
2102    $log->syslog('debug2', '(%s, %s)', @_);
2103    my $self  = shift;
2104    my $email = Sympa::Tools::Text::canonic_email(shift);
2105
2106    my $sdm = Sympa::DatabaseManager->instance;
2107    my $sth;
2108
2109    unless (
2110        $sdm
2111        and $sth = $sdm->do_prepared_query(
2112            sprintf(
2113                q{SELECT %s
2114                  FROM subscriber_table
2115                  WHERE user_subscriber = ? AND
2116                        list_subscriber = ? AND robot_subscriber = ?},
2117                _list_member_cols($sdm)
2118            ),
2119            $email,
2120            $self->{'name'},
2121            $self->{'domain'}
2122        )
2123    ) {
2124        $log->syslog('err', 'Unable to gather information for user: %s',
2125            $email, $self);
2126        return undef;
2127    }
2128    my $user = $sth->fetchrow_hashref('NAME_lc');
2129    if (defined $user) {
2130        $sth->finish;
2131
2132        $user->{'reception'} ||= 'mail';
2133        $user->{'reception'} =
2134            $self->{'admin'}{'default_user_options'}{'reception'}
2135            unless $self->is_available_reception_mode($user->{'reception'});
2136        $user->{'visibility'}  ||= 'noconceal';
2137        $user->{'update_date'} ||= $user->{'date'};
2138
2139        $log->syslog(
2140            'debug2',
2141            'Custom_attribute = (%s)',
2142            $user->{custom_attribute}
2143        );
2144        if (defined $user->{custom_attribute}) {
2145            $user->{'custom_attribute'} =
2146                Sympa::Tools::Data::decode_custom_attribute(
2147                $user->{'custom_attribute'});
2148        }
2149
2150        # Compat.<=6.2.44 FIXME: needed?
2151        $user->{'included'} = 1
2152            if defined $user->{'inclusion'};
2153    } else {
2154        my $error = $sth->err;
2155        $sth->finish;
2156
2157        if ($error) {
2158            $log->syslog(
2159                'err',
2160                'An error occurred while fetching the data from the database: %s',
2161                $sth->errstr
2162            );
2163            return undef;
2164        } else {
2165            $log->syslog('debug',
2166                'User %s was not found in the subscribers of list %s',
2167                $email, $self);
2168            return undef;
2169        }
2170    }
2171
2172    return $user;
2173}
2174
2175# Deprecated. Merged into get_list_member(),
2176#sub get_list_member_no_object;
2177
2178## Returns an admin user of the list.
2179# OBSOLETED.  Use get_admins().
2180sub get_list_admin {
2181    $log->syslog('debug2', '(%s, %s, %s)', @_);
2182    my $self  = shift;
2183    my $role  = shift;
2184    my $email = shift;
2185
2186    my ($admin_user) =
2187        @{$self->get_admins($role, filter => [email => $email])};
2188
2189    return $admin_user;
2190}
2191
2192## Returns the first user for the list.
2193
2194sub get_first_list_member {
2195    my ($self, $data) = @_;
2196
2197    my ($sortby, $offset, $sql_regexp);
2198    $sortby = $data->{'sortby'};
2199    ## Sort may be domain, email, date
2200    $sortby ||= 'email';
2201    $offset     = $data->{'offset'};
2202    $sql_regexp = $data->{'sql_regexp'};
2203
2204    $log->syslog('debug2', '(%s, %s, %s)', $self, $sortby, $offset);
2205
2206    my $statement;
2207
2208    my $sdm = Sympa::DatabaseManager->instance;
2209    push @sth_stack, $sth;
2210
2211    ## SQL regexp
2212    my $selection;
2213    if ($sql_regexp) {
2214        $selection =
2215            sprintf
2216            " AND (user_subscriber LIKE %s OR comment_subscriber LIKE %s)",
2217            $sdm->quote($sql_regexp), $sdm->quote($sql_regexp);
2218    }
2219
2220    $statement = sprintf q{SELECT %s
2221          FROM subscriber_table
2222          WHERE list_subscriber = %s AND robot_subscriber = %s %s},
2223        _list_member_cols($sdm),
2224        $sdm->quote($self->{'name'}),
2225        $sdm->quote($self->{'domain'}),
2226        ($selection || '');
2227
2228    ## SORT BY
2229    $statement .= ' ORDER BY '
2230        . (
2231        {   email => 'user_subscriber',
2232            date  => 'date_epoch_subscriber DESC',
2233            sources =>
2234                'subscribed_subscriber DESC, inclusion_label_subscriber ASC',
2235            name => 'comment_subscriber',
2236        }->{$sortby}
2237            || 'user_subscriber'
2238        );
2239    push @sth_stack, $sth;
2240
2241    unless ($sdm and $sth = $sdm->do_query($statement)) {
2242        $log->syslog('err', 'Unable to get members of list %s', $self);
2243        return undef;
2244    }
2245
2246    # Offset
2247    # Note: Several RDBMSs don't support nonstandard OFFSET clause, OTOH
2248    # some others don't support standard ROW_NUMBER function.
2249    # Instead, fetch unneccessary rows and discard them.
2250    if (defined $offset) {
2251        my $remainder = $offset;
2252        while (1000 < $remainder) {
2253            $remainder -= 1000;
2254            my $rows = $sth->fetchall_arrayref([qw(email)], 1000);
2255            last unless $rows and @$rows;
2256        }
2257        if (0 < $remainder) {
2258            $sth->fetchall_arrayref([qw(email)], $remainder);
2259        }
2260    }
2261
2262    my $user = $sth->fetchrow_hashref('NAME_lc');
2263    if (defined $user) {
2264        $log->syslog('err',
2265            'Warning: Entry with empty email address in list %s', $self)
2266            unless $user->{'email'};
2267        $user->{'reception'} ||= 'mail';
2268        $user->{'reception'} =
2269            $self->{'admin'}{'default_user_options'}{'reception'}
2270            unless $self->is_available_reception_mode($user->{'reception'});
2271        $user->{'visibility'}  ||= 'noconceal';
2272        $user->{'update_date'} ||= $user->{'date'};
2273
2274        if (defined $user->{custom_attribute}) {
2275            $user->{'custom_attribute'} =
2276                Sympa::Tools::Data::decode_custom_attribute(
2277                $user->{'custom_attribute'});
2278        }
2279
2280        # Compat.<=6.2.44 FIXME: needed?
2281        $user->{'included'} = 1
2282            if defined $user->{'inclusion'};
2283    } else {
2284        $sth->finish;
2285        $sth = pop @sth_stack;
2286    }
2287
2288    return $user;
2289}
2290
2291# Moved to Sympa::Tools::Data::decode_custom_attribute().
2292#sub parseCustomAttribute;
2293
2294# Moved to Sympa::Tools::Data::encode_custom_attribute().
2295#sub createXMLCustomAttribute;
2296
2297## Returns the first admin_user with $role for the list.
2298#DEPRECATED: Merged into _get_basic_admins().  Use get_admins() instead.
2299#sub get_first_list_admin;
2300
2301## Loop for all subsequent users.
2302sub get_next_list_member {
2303    my $self = shift;
2304    $log->syslog('debug2', '');
2305
2306    unless (defined $sth) {
2307        $log->syslog('err',
2308            'No handle defined, get_first_list_member(%s) was not run',
2309            $self);
2310        return undef;
2311    }
2312
2313    my $user = $sth->fetchrow_hashref('NAME_lc');
2314
2315    if (defined $user) {
2316        $log->syslog('err',
2317            'Warning: Entry with empty email address in list %s', $self)
2318            unless $user->{'email'};
2319        $user->{'reception'} ||= 'mail';
2320        $user->{'reception'} =
2321            $self->{'admin'}{'default_user_options'}{'reception'}
2322            unless $self->is_available_reception_mode($user->{'reception'});
2323        $user->{'visibility'}  ||= 'noconceal';
2324        $user->{'update_date'} ||= $user->{'date'};
2325
2326        if (defined $user->{custom_attribute}) {
2327            my $custom_attr = Sympa::Tools::Data::decode_custom_attribute(
2328                $user->{'custom_attribute'});
2329            unless (defined $custom_attr) {
2330                $log->syslog(
2331                    'err',
2332                    "Failed to parse custom attributes for user %s, list %s",
2333                    $user->{'email'},
2334                    $self
2335                );
2336            }
2337            $user->{'custom_attribute'} = $custom_attr;
2338        }
2339
2340        # Compat.<=6.2.44 FIXME: needed?
2341        $user->{'included'} = 1
2342            if defined $user->{'inclusion'};
2343    } else {
2344        $sth->finish;
2345        $sth = pop @sth_stack;
2346    }
2347
2348    return $user;
2349}
2350
2351# Mapping between var and field names.
2352sub _map_list_admin_cols {
2353    my %map_field = (
2354        date        => 'date_epoch_admin',
2355        update_date => 'update_epoch_admin',
2356        gecos       => 'comment_admin',
2357        email       => 'user_admin',
2358    );
2359
2360    my $fields =
2361        {Sympa::DatabaseDescription::full_db_struct()}->{'admin_table'}
2362        ->{fields};
2363    foreach my $f (keys %$fields) {
2364        next
2365            if $f eq 'list_admin'
2366            or $f eq 'robot_admin'
2367            or $f eq 'role_admin';
2368
2369        my $k = {reverse %map_field}->{$f};
2370        unless ($k) {
2371            $k = $f;
2372            $k =~ s/_admin\z//;
2373            $map_field{$k} = $f;
2374        }
2375    }
2376
2377    return %map_field;
2378}
2379
2380sub _list_admin_cols {
2381    my $sdm = shift;
2382
2383    my %map_field = _map_list_admin_cols();
2384    return join ', ', map {
2385        my $col = $map_field{$_};
2386        ($col eq $_) ? $col : sprintf('%s AS "%s"', $col, $_);
2387    } sort keys %map_field;
2388}
2389
2390## Loop for all subsequent admin users with the role defined in
2391## get_first_list_admin.
2392#DEPRECATED: Merged into _get_basic_admins().  Use get_admins() instead.
2393#sub get_next_list_admin;
2394
2395sub get_admins {
2396    $log->syslog('debug2', '(%s, %s, %s => %s)', @_);
2397    my $self    = shift;
2398    my $role    = lc(shift || '');
2399    my %options = @_;
2400
2401    my $admin_user = $self->_cache_get('admin_user');
2402    unless ($admin_user and @{$admin_user || []}) {
2403        # Get recent admins from database.
2404        $admin_user = $self->get_current_admins;
2405        if ($admin_user) {
2406            $self->_cache_put('admin_user', $admin_user);
2407        } else {
2408            # If failed, reuse cache probably outdated.
2409            $admin_user = $self->{_cached}{admin_user};
2410        }
2411    }
2412    return unless $admin_user;    # Returns void.
2413
2414    my %query = @{$options{filter} || []};
2415    $query{email} = Sympa::Tools::Text::canonic_email($query{email})
2416        if defined $query{email};
2417
2418    my @users;
2419    if ($role eq 'editor') {
2420        @users =
2421            grep { $_ and $_->{role} eq 'editor' } @{$admin_user || []};
2422    } elsif ($role eq 'owner') {
2423        @users =
2424            grep { $_ and $_->{role} eq 'owner' } @{$admin_user || []};
2425    } elsif ($role eq 'actual_editor') {
2426        @users =
2427            grep { $_ and $_->{role} eq 'editor' } @{$admin_user || []};
2428        @users = grep { $_ and $_->{role} eq 'owner' } @{$admin_user || []}
2429            unless @users;
2430    } elsif ($role eq 'privileged_owner') {
2431        @users = grep {
2432                    $_
2433                and $_->{role} eq 'owner'
2434                and $_->{profile}
2435                and $_->{profile} eq 'privileged'
2436        } @{$admin_user || []};
2437    } elsif ($role eq 'receptive_editor') {
2438        @users = grep {
2439                    $_
2440                and $_->{role} eq 'editor'
2441                and ($_->{reception} || 'mail') ne 'nomail'
2442        } @{$admin_user || []};
2443        @users = grep {
2444                    $_
2445                and $_->{role} eq 'owner'
2446                and ($_->{reception} || 'mail') ne 'nomail'
2447        } @{$admin_user || []}
2448            unless @users;
2449    } elsif ($role eq 'receptive_owner') {
2450        @users = grep {
2451                    $_
2452                and $_->{role} eq 'owner'
2453                and ($_->{reception} || 'mail') ne 'nomail'
2454        } @{$admin_user || []};
2455    } else {
2456        die sprintf 'Unknown role "%s"', $role;
2457    }
2458
2459    if (defined $query{email}) {
2460        @users = grep { ($_->{email} || '') eq $query{email} } @users;
2461    }
2462
2463    return wantarray ? @users : [@users];
2464}
2465
2466# Get all admins passing cache.
2467# Note: Use with care. This increases database load.
2468sub get_current_admins {
2469    my $self = shift;
2470
2471    my $sdm = Sympa::DatabaseManager->instance;
2472    my $sth;
2473
2474    unless (
2475        $sdm and $sth = $sdm->do_prepared_query(
2476            sprintf(
2477                q{SELECT %s, role_admin AS "role"
2478                  FROM admin_table
2479                  WHERE list_admin = ? AND robot_admin = ?
2480                  ORDER BY user_admin},
2481                _list_admin_cols($sdm)
2482            ),
2483            $self->{'name'},
2484            $self->{'domain'}
2485        )
2486    ) {
2487        $log->syslog('err', 'Unable to get admins for list %s', $self);
2488        return undef;
2489    }
2490    my $admin_user = $sth->fetchall_arrayref({}) || [];
2491    $sth->finish;
2492
2493    foreach my $user (@$admin_user) {
2494        $user->{'email'} = Sympa::Tools::Text::canonic_email($user->{'email'})
2495            if defined $user->{'email'};
2496        $log->syslog('err',
2497            'Warning: Entry with empty email address in list %s', $self)
2498            unless defined $user->{'email'};
2499        $user->{'reception'}   ||= 'mail';
2500        $user->{'visibility'}  ||= 'noconceal';
2501        $user->{'update_date'} ||= $user->{'date'};
2502
2503        # Compat.<=6.2.44 FIXME: needed?
2504        $user->{'included'} = 1
2505            if defined $user->{'inclusion'};
2506    }
2507
2508    return $admin_user;
2509}
2510
2511sub get_admins_email {
2512    my $self = shift;
2513    my $role = lc(shift || '');
2514
2515    return unless $role;    # Returns void.
2516
2517    return map { $_->{email} } @{$self->get_admins($role) || []};
2518}
2519
2520## Returns the first bouncing user
2521
2522sub get_first_bouncing_list_member {
2523    my $self = shift;
2524    $log->syslog('debug2', '');
2525
2526    my $name = $self->{'name'};
2527
2528    my $sdm = Sympa::DatabaseManager->instance;
2529    push @sth_stack, $sth;
2530
2531    unless (
2532        $sdm
2533        and $sth = $sdm->do_prepared_query(
2534            sprintf(
2535                q{SELECT %s
2536                FROM subscriber_table
2537                WHERE list_subscriber = ? AND robot_subscriber = ? AND
2538                      bounce_subscriber IS NOT NULL},
2539                _list_member_cols($sdm)
2540            ),
2541            $self->{'name'},
2542            $self->{'domain'}
2543        )
2544    ) {
2545        $log->syslog('err', 'Unable to get bouncing users %s@%s',
2546            $name, $self->{'domain'});
2547        return undef;
2548    }
2549
2550    my $user = $sth->fetchrow_hashref('NAME_lc');
2551
2552    if (defined $user) {
2553        $log->syslog('err',
2554            'Warning: Entry with empty email address in list %s',
2555            $self->{'name'})
2556            unless defined $user->{'email'} and length $user->{'email'};
2557
2558        # Compat.<=6.2.44 FIXME: needed?
2559        $user->{'included'} = 1
2560            if defined $user->{'inclusion'};
2561    } else {
2562        $sth->finish;
2563        $sth = pop @sth_stack;
2564    }
2565
2566    return $user;
2567}
2568
2569## Loop for all subsequent bouncing users.
2570sub get_next_bouncing_list_member {
2571    my $self = shift;
2572    $log->syslog('debug2', '');
2573
2574    unless (defined $sth) {
2575        $log->syslog(
2576            'err',
2577            'No handle defined, get_first_bouncing_list_member(%s) was not run',
2578            $self->{'name'}
2579        );
2580        return undef;
2581    }
2582
2583    my $user = $sth->fetchrow_hashref('NAME_lc');
2584
2585    if (defined $user) {
2586        $log->syslog('err',
2587            'Warning: Entry with empty email address in list %s',
2588            $self->{'name'})
2589            if (!$user->{'email'});
2590
2591        if (defined $user->{custom_attribute}) {
2592            $user->{'custom_attribute'} =
2593                Sympa::Tools::Data::decode_custom_attribute(
2594                $user->{'custom_attribute'});
2595        }
2596
2597        # Compat.<=6.2.44 FIXME: needed?
2598        $user->{'included'} = 1
2599            if defined $user->{'inclusion'};
2600    } else {
2601        $sth->finish;
2602        $sth = pop @sth_stack;
2603    }
2604
2605    return $user;
2606}
2607
2608sub parse_list_member_bounce {
2609    my ($self, $user) = @_;
2610    if ($user->{bounce}) {
2611        $user->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
2612        $user->{'first_bounce'} = $1;
2613        $user->{'last_bounce'}  = $2;
2614        $user->{'bounce_count'} = $3;
2615        if ($5 =~ /^(\d+)\.\d+\.\d+$/) {
2616            $user->{'bounce_class'} = $1;
2617        }
2618
2619        ## Define color in function of bounce_score
2620        if ($user->{'bounce_score'} <=
2621            $self->{'admin'}{'bouncers_level1'}{'rate'}) {
2622            $user->{'bounce_level'} = 0;
2623        } elsif ($user->{'bounce_score'} <=
2624            $self->{'admin'}{'bouncers_level2'}{'rate'}) {
2625            $user->{'bounce_level'} = 1;
2626        } else {
2627            $user->{'bounce_level'} = 2;
2628        }
2629    }
2630}
2631
2632# Old names: get_first_list_member() and get_next_list_member().
2633sub get_members {
2634    $log->syslog('debug2', '(%s, %s, %s => %s, %s => %s, %s => %s)', @_);
2635    my $self    = shift;
2636    my $role    = shift;
2637    my %options = @_;
2638
2639    my $limit  = $options{limit};
2640    my $offset = $options{offset};
2641    my $order  = $options{order};
2642    my $cond   = $options{othercondition};
2643
2644    my $sdm = Sympa::DatabaseManager->instance;
2645    my $sth;
2646
2647    # Filters
2648    my $filter = '';
2649    if ($role eq 'member') {
2650        $filter = '';
2651    } elsif ($role eq 'unconcealed_member') {
2652        $filter = " AND visibility_subscriber <> 'conceal'";
2653    } else {
2654        die sprintf 'Unknown role "%s"', $role;
2655    }
2656
2657    if ($cond) {
2658        $filter .= " AND ($cond)";
2659    }
2660
2661    # SORT BY
2662    my $order_by = '';
2663    if ($order) {
2664        $order_by = 'ORDER BY '
2665            . (
2666            {   email => 'user_subscriber',
2667                date  => 'date_epoch_subscriber DESC',
2668                sources =>
2669                    'subscribed_subscriber DESC, inclusion_label_subscriber ASC',
2670                name => 'comment_subscriber',
2671            }->{$order}
2672                || 'user_subscriber'
2673            );
2674    }
2675
2676    unless (
2677        $sdm
2678        and $sth = $sdm->do_prepared_query(
2679            sprintf(
2680                q{SELECT %s
2681                  FROM subscriber_table
2682                  WHERE list_subscriber = ? AND robot_subscriber = ?%s
2683                  %s},
2684                _list_member_cols($sdm), $filter, $order_by
2685            ),
2686            $self->{'name'},
2687            $self->{'domain'}
2688        )
2689    ) {
2690        $log->syslog('err', 'Unable to get members of list %s', $self);
2691        return;    # Returns void.
2692    }
2693
2694    # Offset
2695    # Note: Several RDBMSs don't support nonstandard OFFSET clause, OTOH
2696    # some others don't support standard ROW_NUMBER function.
2697    # Instead, fetch unneccessary rows and discard them.
2698    if (defined $offset) {
2699        my $remainder = $offset;
2700        while (1000 < $remainder) {
2701            $remainder -= 1000;
2702            my $rows = $sth->fetchall_arrayref([qw(email)], 1000);
2703            last unless $rows and @$rows;
2704        }
2705        if (0 < $remainder) {
2706            $sth->fetchall_arrayref([qw(email)], $remainder);
2707        }
2708    }
2709
2710    my $users = $sth->fetchall_arrayref({}, ($limit || undef));
2711    $sth->finish;
2712
2713    foreach my $user (@{$users || []}) {
2714        $log->syslog('err',
2715            'Warning: Entry with empty email address in list %s',
2716            $self->{'name'})
2717            unless $user->{email};
2718
2719        $user->{reception} ||= 'mail';
2720        $user->{reception} =
2721            $self->{'admin'}{'default_user_options'}{'reception'}
2722            unless $self->is_available_reception_mode($user->{reception});
2723        $user->{visibility}  ||= 'noconceal';
2724        $user->{update_date} ||= $user->{date};
2725
2726        if (defined $user->{custom_attribute}) {
2727            my $custom_attr = Sympa::Tools::Data::decode_custom_attribute(
2728                $user->{custom_attribute});
2729            unless (defined $custom_attr) {
2730                $log->syslog(
2731                    'err',
2732                    "Failed to parse custom attributes for user %s, list %s",
2733                    $user->{email},
2734                    $self
2735                );
2736            }
2737            $user->{custom_attribute} = $custom_attr;
2738        }
2739
2740        # Compat.<=6.2.44 FIXME: needed?
2741        $user->{included} = 1
2742            if defined $user->{'inclusion'};
2743    }
2744
2745    return wantarray ? @$users : $users;
2746}
2747
2748# Old name: get_resembling_list_members_no_object().
2749# Note that the name of this function in 6.2a.32 or earlier is
2750# "get_ressembling_list_members_no_object" (look at doubled "s").
2751sub get_resembling_members {
2752    $log->syslog('debug2', '(%s, %s)', @_);
2753    my $self      = shift;
2754    my $role      = shift;
2755    my $searchkey = Sympa::Tools::Text::canonic_email(shift);
2756
2757    return unless defined $searchkey;
2758    $searchkey =~ s/(['%_\\])/\\$1/g;
2759
2760    my ($local, $domain) = split /\@/, $searchkey;
2761    return unless $local and $domain;
2762    my ($account, $ext)  = ($local =~ /\A(.*)[+](.*)\z/);
2763    my ($first,   $name) = ($local =~ /\A(.*)[.](.*)\z/);
2764    my $initial = $1 if defined $first and $first =~ /\A([a-z])/;
2765    $initial .= $1
2766        if defined $initial
2767        and defined $name
2768        and $name =~ /\A([a-z])/;
2769    my ($top, $upperdomain) = split /[.]/, $domain, 2;
2770
2771    my @cond;
2772    ##### plused
2773    # is subscriber a plused email ?
2774    push @cond, $account . '@' . $domain if defined $ext;
2775    # is some subscriber ressembling with a plused email ?
2776    push @cond, $local . '+%@' . $domain;
2777    # ressembling local part
2778    # try to compare firstname.name@domain with name@domain
2779    push @cond, '%' . $local . '@' . $domain;
2780    push @cond, $name . '@' . $domain if defined $name;
2781    #### Same local_part and ressembling domain
2782    # compare host.domain.tld with domain.tld
2783    # remove first token if there is still at least 2 tokens try to
2784    # find a subscriber with that domain
2785    push @cond, $local . '@' . $upperdomain if defined $upperdomain;
2786    push @cond, $local . '@%' . $domain;
2787    # looking for initial
2788    push @cond, $initial . '@' . $domain if defined $initial;
2789    #XXX#### users in the same local part in any other domain
2790    #XXXpush @cond, $local . '@%';
2791    my $cond = join ' OR ', map {"user_subscriber LIKE '$_'"} @cond;
2792    return unless $cond;
2793
2794    my $users = [$self->get_members($role, othercondition => $cond)];
2795    return wantarray ? @$users : $users;
2796}
2797
2798#DEPRECATED.  Merged into get_resembling_members().
2799#sub find_list_member_by_pattern_no_object;
2800
2801sub get_info {
2802    my $self = shift;
2803
2804    my $info;
2805
2806    unless (open INFO, "$self->{'dir'}/info") {
2807        $log->syslog('err', 'Could not open %s: %m',
2808            $self->{'dir'} . '/info');
2809        return undef;
2810    }
2811
2812    while (<INFO>) {
2813        $info .= $_;
2814    }
2815    close INFO;
2816
2817    return $info;
2818}
2819
2820## Total bouncing subscribers
2821sub get_total_bouncing {
2822    my $self = shift;
2823    $log->syslog('debug2', '');
2824
2825    my $name = $self->{'name'};
2826
2827    push @sth_stack, $sth;
2828    my $sdm = Sympa::DatabaseManager->instance;
2829
2830    ## Query the Database
2831    unless (
2832        $sdm
2833        and $sth = $sdm->do_prepared_query(
2834            q{SELECT count(*)
2835              FROM subscriber_table
2836              WHERE list_subscriber = ? AND robot_subscriber = ? AND
2837                    bounce_subscriber IS NOT NULL},
2838            $name, $self->{'domain'}
2839        )
2840    ) {
2841        $log->syslog('err',
2842            'Unable to gather bouncing subscribers count for list %s@%s',
2843            $name, $self->{'domain'});
2844        return undef;
2845    }
2846
2847    my $total = $sth->fetchrow;
2848
2849    $sth->finish();
2850
2851    $sth = pop @sth_stack;
2852
2853    return $total;
2854}
2855
2856## Does the user have a particular function in the list?
2857# Old name: [<=6.2.3] am_i().
2858sub is_admin {
2859    $log->syslog('debug2', '(%s, %s, %s, %s)', @_);
2860    my $self = shift;
2861    my $role = lc(shift || '');
2862    my $who  = shift;
2863
2864    return undef unless defined $who and length $who;
2865
2866    if (@{$self->get_admins($role, filter => [email => $who])}) {
2867        return 1;
2868    } else {
2869        return undef;
2870    }
2871}
2872
2873## Is the person in user table (db only)
2874##sub is_global_user {
2875## DEPRECATED: Use Sympa::User::is_global_user().
2876
2877## Is the indicated person a subscriber to the list?
2878sub is_list_member {
2879    $log->syslog('debug2', '(%s, %s)', @_);
2880    my ($self, $who) = @_;
2881    $who = Sympa::Tools::Text::canonic_email($who);
2882
2883    return undef unless $who;
2884
2885    my $is_list_member = $self->_cache_get('is_list_member');
2886    if (defined $is_list_member and defined $is_list_member->{$who}) {
2887        return $is_list_member->{$who};
2888    }
2889    $is_list_member ||= {};
2890
2891    my $sdm = Sympa::DatabaseManager->instance;
2892    my $sth;
2893
2894    unless (
2895        $sdm
2896        and $sth = $sdm->do_prepared_query(
2897            q{SELECT count(*)
2898              FROM subscriber_table
2899              WHERE list_subscriber = ? AND robot_subscriber = ? AND
2900                    user_subscriber = ?},
2901            $self->{'name'}, $self->{'domain'}, $who
2902        )
2903    ) {
2904        $log->syslog('err',
2905            'Unable to check chether user %s is subscribed to list %s',
2906            $who, $self);
2907        return undef;
2908    }
2909    $is_list_member->{$who} = $sth->fetchrow;
2910    $self->_cache_put('is_list_member', $is_list_member);
2911    $sth->finish;
2912
2913    return $is_list_member->{$who};
2914}
2915
2916## Sets new values for the given user (except gecos)
2917sub update_list_member {
2918    my $self   = shift;
2919    my $who    = Sympa::Tools::Text::canonic_email(shift);
2920    my $values = $_[0];                                      # Compat.
2921    $values = {@_} unless ref $values eq 'HASH';
2922
2923    my ($field, $value, $table);
2924
2925    # Mapping between var and field names.
2926    my %map_field = _map_list_member_cols();
2927
2928    my $sdm = Sympa::DatabaseManager->instance;
2929    return undef unless $sdm;
2930
2931    my @set_list;
2932    my @val_list;
2933    while (($field, $value) = each %{$values}) {
2934        die sprintf 'Unknown database field %s', $field
2935            unless $map_field{$field};
2936
2937        if ($field eq 'custom_attribute') {
2938            push @set_list, sprintf('%s = ?', $map_field{$field});
2939            push @val_list,
2940                Sympa::Tools::Data::encode_custom_attribute($value);
2941        } elsif ($numeric_field{$map_field{$field}}) {
2942            push @set_list, sprintf('%s = ?', $map_field{$field});
2943            # FIXME: Can't have a null value?
2944            push @val_list, ($value || 0);
2945        } else {
2946            push @set_list, sprintf('%s = ?', $map_field{$field});
2947            push @val_list, $value;
2948        }
2949    }
2950    return 0 unless @set_list;
2951
2952    # Update field
2953    if ($who eq '*') {
2954        unless (
2955            $sdm->do_prepared_query(
2956                sprintf(
2957                    q{UPDATE subscriber_table
2958                      SET %s
2959                      WHERE list_subscriber = ? AND robot_subscriber = ?},
2960                    join(', ', @set_list)
2961                ),
2962                @val_list,
2963                $self->{'name'},
2964                $self->{'domain'}
2965            )
2966        ) {
2967            $log->syslog(
2968                'err',
2969                'Could not update information for subscriber %s in database for list %s',
2970                $who,
2971                $self
2972            );
2973            return undef;
2974        }
2975    } else {
2976        unless (
2977            $sdm->do_prepared_query(
2978                sprintf(
2979                    q{UPDATE subscriber_table
2980                      SET %s
2981                      WHERE user_subscriber = ? AND
2982                            list_subscriber = ? AND robot_subscriber = ?},
2983                    join(',', @set_list)
2984                ),
2985                @val_list,
2986                $who,
2987                $self->{'name'},
2988                $self->{'domain'}
2989            )
2990        ) {
2991            $log->syslog(
2992                'err',
2993                'Could not update information for subscriber %s in database for list %s',
2994                $who,
2995                $self
2996            );
2997            return undef;
2998        }
2999    }
3000
3001    # Delete subscription / signoff requests no longer used.
3002    my $new_email;
3003    if (    $who ne '*'
3004        and $values->{'email'}
3005        and $new_email = Sympa::Tools::Text::canonic_email($values->{'email'})
3006        and $who ne $new_email) {
3007        my $spool_req;
3008
3009        # Delete signoff requests if any.
3010        $spool_req = Sympa::Spool::Auth->new(
3011            context => $self,
3012            action  => 'del',
3013            email   => $who,
3014        );
3015        while (1) {
3016            my ($request, $handle) = $spool_req->next;
3017            last unless $handle;
3018            next unless $request;
3019
3020            $spool_req->remove($handle);
3021        }
3022
3023        # Delete subscription requests if any.
3024        $spool_req = Sympa::Spool::Auth->new(
3025            context => $self,
3026            action  => 'add',
3027            email   => $new_email,
3028        );
3029        while (1) {
3030            my ($request, $handle) = $spool_req->next;
3031            last unless $handle;
3032            next unless $request;
3033
3034            $spool_req->remove($handle);
3035        }
3036    }
3037
3038    # Rename picture on disk if user email changed.
3039    if ($values->{'email'}) {
3040        foreach my $path ($self->find_picture_paths($who)) {
3041            my $extension = [reverse split /\./, $path]->[0];
3042            my $new_path = $self->get_picture_path(
3043                Digest::MD5::md5_hex($values->{'email'}) . '.' . $extension);
3044            unless (rename $path, $new_path) {
3045                $log->syslog('err', 'Failed to rename %s to %s : %m',
3046                    $path, $new_path);
3047                last;
3048            }
3049        }
3050    }
3051
3052    return 1;
3053}
3054
3055## Sets new values for the given admin user (except gecos)
3056sub update_list_admin {
3057    $log->syslog('debug2', '(%s, %s, %s, ...)', @_);
3058    my $self   = shift;
3059    my $who    = Sympa::Tools::Text::canonic_email(shift);
3060    my $role   = shift;
3061    my $values = $_[0];                                      # Compat.
3062    $values = {@_} unless ref $values eq 'HASH';
3063
3064    my ($field, $value, $table);
3065    my $name = $self->{'name'};
3066
3067    ## mapping between var and field names
3068    my %map_field = (
3069        reception       => 'reception_admin',
3070        visibility      => 'visibility_admin',
3071        date            => 'date_epoch_admin',
3072        update_date     => 'update_epoch_admin',
3073        inclusion       => 'inclusion_admin',
3074        inclusion_ext   => 'inclusion_ext_admin',
3075        inclusion_label => 'inclusion_label_admin',
3076        gecos           => 'comment_admin',
3077        password        => 'password_user',
3078        email           => 'user_admin',
3079        subscribed      => 'subscribed_admin',
3080        info            => 'info_admin',
3081        profile         => 'profile_admin',
3082        role            => 'role_admin'
3083    );
3084
3085    ## mapping between var and tables
3086    my %map_table = (
3087        reception       => 'admin_table',
3088        visibility      => 'admin_table',
3089        date            => 'admin_table',
3090        update_date     => 'admin_table',
3091        inclusion       => 'admin_table',
3092        inclusion_ext   => 'admin_table',
3093        inclusion_label => 'admin_table',
3094        gecos           => 'admin_table',
3095        password        => 'user_table',
3096        email           => 'admin_table',
3097        subscribed      => 'admin_table',
3098        info            => 'admin_table',
3099        profile         => 'admin_table',
3100        role            => 'admin_table'
3101    );
3102    #### ??
3103    ## additional DB fields
3104    #if (defined $Conf::Conf{'db_additional_user_fields'}) {
3105    #    foreach my $f (split ',', $Conf::Conf{'db_additional_user_fields'}) {
3106    #        $map_table{$f} = 'user_table';
3107    #        $map_field{$f} = $f;
3108    #    }
3109    #}
3110
3111    # Compat.<=6.2.44 FIXME: is this used?
3112    $values->{inclusion} ||= ($values->{update_date} || time)
3113        if $values->{included};
3114
3115    my $sdm = Sympa::DatabaseManager->instance;
3116    return undef unless $sdm;
3117
3118    ## Update each table
3119    foreach $table ('user_table', 'admin_table') {
3120
3121        my @set_list;
3122        while (($field, $value) = each %{$values}) {
3123
3124            unless ($map_field{$field} and $map_table{$field}) {
3125                $log->syslog('err', 'Unknown database field %s', $field);
3126                next;
3127            }
3128
3129            if ($map_table{$field} eq $table) {
3130                if ($value and $value eq 'NULL') {    #FIXME:get_null_value?
3131                    if ($Conf::Conf{'db_type'} eq 'mysql') {
3132                        $value = '\N';
3133                    }
3134                } elsif ($numeric_field{$map_field{$field}}) {
3135                    $value ||= 0;    #FIXME:Can't have a null value
3136                } else {
3137                    $value = $sdm->quote($value);
3138                }
3139                my $set = sprintf "%s=%s", $map_field{$field}, $value;
3140
3141                push @set_list, $set;
3142            }
3143        }
3144        next unless @set_list;
3145
3146        ## Update field
3147        if ($table eq 'user_table') {
3148            unless (
3149                $sth = $sdm->do_query(
3150                    q{UPDATE %s SET %s WHERE email_user = %s},
3151                    $table, join(',', @set_list),
3152                    $sdm->quote($who)
3153                )
3154            ) {
3155                $log->syslog('err',
3156                    'Could not update information for admin %s in table %s',
3157                    $who, $table);
3158                return undef;
3159            }
3160
3161        } elsif ($table eq 'admin_table') {
3162            if ($who eq '*') {
3163                unless (
3164                    $sth = $sdm->do_query(
3165                        q{UPDATE %s
3166                          SET %s
3167                          WHERE list_admin = %s AND robot_admin = %s AND
3168                                role_admin = %s},
3169                        $table,
3170                        join(',', @set_list),
3171                        $sdm->quote($name),
3172                        $sdm->quote($self->{'domain'}),
3173                        $sdm->quote($role)
3174                    )
3175                ) {
3176                    $log->syslog(
3177                        'err',
3178                        'Could not update information for admin %s in table %s for list %s@%s',
3179                        $who,
3180                        $table,
3181                        $name,
3182                        $self->{'domain'}
3183                    );
3184                    return undef;
3185                }
3186            } else {
3187                unless (
3188                    $sth = $sdm->do_query(
3189                        q{UPDATE %s
3190                          SET %s
3191                          WHERE user_admin = %s AND
3192                          list_admin = %s AND robot_admin = %s AND
3193                          role_admin = %s},
3194                        $table,
3195                        join(',', @set_list),
3196                        $sdm->quote($who),
3197                        $sdm->quote($name),
3198                        $sdm->quote($self->{'domain'}),
3199                        $sdm->quote($role)
3200                    )
3201                ) {
3202                    $log->syslog(
3203                        'err',
3204                        'Could not update information for admin %s in table %s for list %s@%s',
3205                        $who,
3206                        $table,
3207                        $name,
3208                        $self->{'domain'}
3209                    );
3210                    return undef;
3211                }
3212            }
3213        }
3214    }
3215
3216    # Reset session cache.
3217    $self->_cache_publish_expiry('admin_user');
3218
3219    return 1;
3220}
3221
3222## Sets new values for the given user in the Database
3223##sub update_global_user {
3224## DEPRECATED: Use Sympa::User::update_global_user() or $user->save().
3225
3226## Adds a user to the user_table
3227##sub add_global_user {
3228## DEPRECATED: Use Sympa::User::add_global_user() or $user->save().
3229
3230## Adds a list member ; no overwrite.
3231sub add_list_member {
3232    $log->syslog('debug2', '%s, ...', @_);
3233    my $self      = shift;
3234    my @new_users = @_;
3235
3236    my $name = $self->{'name'};
3237
3238    $self->{'add_outcome'}                                   = undef;
3239    $self->{'add_outcome'}{'added_members'}                  = 0;
3240    $self->{'add_outcome'}{'expected_number_of_added_users'} = $#new_users;
3241    $self->{'add_outcome'}{'remaining_members_to_add'} =
3242        $self->{'add_outcome'}{'expected_number_of_added_users'};
3243
3244    my $current_list_members_count = 0;
3245    if ($self->{'admin'}{'max_list_members'} > 0) {
3246        $current_list_members_count = $self->get_total;  # FIXME: high db load
3247    }
3248
3249    my $sdm = Sympa::DatabaseManager->instance;
3250
3251    foreach my $new_user (@new_users) {
3252        my $who = Sympa::Tools::Text::canonic_email($new_user->{'email'});
3253        unless (defined $who) {
3254            $log->syslog('err', 'Ignoring %s which is not a valid email',
3255                $new_user->{'email'});
3256            next;
3257        }
3258        if (Sympa::Tools::Domains::is_blocklisted($who)) {
3259            $log->syslog('err', 'Ignoring %s which uses a blocklisted domain',
3260                $new_user->{'email'});
3261            next;
3262        }
3263        unless (
3264            $current_list_members_count < $self->{'admin'}{'max_list_members'}
3265            || $self->{'admin'}{'max_list_members'} == 0) {
3266            $self->{'add_outcome'}{'errors'}{'max_list_members_exceeded'} = 1;
3267            $log->syslog(
3268                'notice',
3269                'Subscription of user %s failed: max number of subscribers (%s) reached',
3270                $new_user->{'email'},
3271                $self->{'admin'}{'max_list_members'}
3272            );
3273            last;
3274        }
3275
3276        # Delete from exclusion_table and force a sync_include if new_user was
3277        # excluded
3278        if ($self->insert_delete_exclusion($who, 'delete')) {
3279            $self->sync_include('member');
3280            if ($self->is_list_member($who)) {
3281                $self->{'add_outcome'}{'added_members'}++;
3282                next;
3283            }
3284        }
3285
3286        $new_user->{'date'} ||= time;
3287        $new_user->{'update_date'} ||= $new_user->{'date'};
3288
3289        my $custom_attribute;
3290        if (ref $new_user->{'custom_attribute'} eq 'HASH') {
3291            $new_user->{'custom_attribute'} =
3292                Sympa::Tools::Data::encode_custom_attribute(
3293                $new_user->{'custom_attribute'});
3294        }
3295        $log->syslog(
3296            'debug3',
3297            'Custom_attribute = %s',
3298            $new_user->{'custom_attribute'}
3299        );
3300
3301        # Compat.<=6.2.44 FIXME: needed?
3302        $new_user->{'inclusion'} ||= ($new_user->{'date'} || time)
3303            if $new_user->{'included'};
3304
3305        ## Either is_included or is_subscribed must be set
3306        ## default is is_subscriber for backward compatibility reason
3307        $new_user->{'subscribed'} = 1 unless defined $new_user->{'inclusion'};
3308        $new_user->{'subscribed'} ||= 0;
3309
3310        unless (defined $new_user->{'inclusion'}) {
3311            ## Is the email in user table?
3312            ## Insert in User Table
3313            unless (
3314                Sympa::User->new(
3315                    $who,
3316                    'gecos'    => $new_user->{'gecos'},
3317                    'lang'     => $new_user->{'lang'},
3318                    'password' => $new_user->{'password'}
3319                )
3320            ) {
3321                $log->syslog('err', 'Unable to add user %s to user_table',
3322                    $who);
3323                $self->{'add_outcome'}{'errors'}{'unable_to_add_to_database'}
3324                    = 1;
3325                next;
3326            }
3327        }
3328
3329        #Log in stat_table to make staistics
3330        $log->add_stat(
3331            'robot'     => $self->{'domain'},
3332            'list'      => $self->{'name'},
3333            'operation' => 'add_or_subscribe',
3334            'parameter' => '',
3335            'mail'      => $new_user->{'email'}
3336        );
3337
3338        ## Update Subscriber Table
3339        unless (
3340            $sdm
3341            and $sdm->do_prepared_query(
3342                q{INSERT INTO subscriber_table
3343                  (user_subscriber, comment_subscriber,
3344                   list_subscriber, robot_subscriber,
3345                   date_epoch_subscriber, update_epoch_subscriber,
3346                   inclusion_subscriber, inclusion_ext_subscriber,
3347                   inclusion_label_subscriber,
3348                   reception_subscriber, topics_subscriber,
3349                   visibility_subscriber, subscribed_subscriber,
3350                   custom_attribute_subscriber,
3351                   suspend_subscriber,
3352                   suspend_start_date_subscriber,
3353                   suspend_end_date_subscriber,
3354                   number_messages_subscriber)
3355                  VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 0)},
3356                $who,                     $new_user->{'gecos'},
3357                $name,                    $self->{'domain'},
3358                $new_user->{'date'},      $new_user->{'update_date'},
3359                $new_user->{'inclusion'}, $new_user->{'inclusion_ext'},
3360                $new_user->{'inclusion_label'},
3361                $new_user->{'reception'},  $new_user->{'topics'},
3362                $new_user->{'visibility'}, $new_user->{'subscribed'},
3363                $new_user->{'custom_attribute'},
3364                $new_user->{'suspend'},
3365                $new_user->{'startdate'},
3366                $new_user->{'enddate'}
3367            )
3368        ) {
3369            $log->syslog(
3370                'err',
3371                'Unable to add subscriber %s to table subscriber_table for list %s@%s %s',
3372                $who,
3373                $name,
3374                $self->{'domain'}
3375            );
3376            next;
3377        }
3378
3379        # Delete subscription requests if any.
3380        my $spool_req = Sympa::Spool::Auth->new(
3381            context => $self,
3382            action  => 'add',
3383            email   => $who,
3384        );
3385        while (1) {
3386            my ($request, $handle) = $spool_req->next;
3387            last unless $handle;
3388            next unless $request;
3389
3390            $spool_req->remove($handle);
3391        }
3392
3393        $self->{'add_outcome'}{'added_members'}++;
3394        $self->{'add_outcome'}{'remaining_member_to_add'}--;
3395        $current_list_members_count++;
3396    }
3397
3398    $self->_cache_publish_expiry('member');
3399    $self->_create_add_error_string() if ($self->{'add_outcome'}{'errors'});
3400    return 1;
3401}
3402
3403sub _create_add_error_string {
3404    my $self = shift;
3405    $self->{'add_outcome'}{'errors'}{'error_message'} = '';
3406    if ($self->{'add_outcome'}{'errors'}{'max_list_members_exceeded'}) {
3407        $self->{'add_outcome'}{'errors'}{'error_message'} .=
3408            $language->gettext_sprintf(
3409            'Attempt to exceed the max number of members (%s) for this list.',
3410            $self->{'admin'}{'max_list_members'}
3411            );
3412    }
3413    if ($self->{'add_outcome'}{'errors'}{'unable_to_add_to_database'}) {
3414        $self->{'add_outcome'}{'error_message'} .= ' '
3415            . $language->gettext(
3416            'Attempts to add some users in database failed.');
3417    }
3418    $self->{'add_outcome'}{'errors'}{'error_message'} .= ' '
3419        . $language->gettext_sprintf(
3420        'Added %s users out of %s required.',
3421        $self->{'add_outcome'}{'added_members'},
3422        $self->{'add_outcome'}{'expected_number_of_added_users'}
3423        );
3424}
3425
3426## Adds a new list admin user, no overwrite.
3427sub add_list_admin {
3428    $log->syslog('debug2', '(%s, %s, ...)', @_);
3429    my $self  = shift;
3430    my $role  = shift;
3431    my @users = @_;
3432
3433    my $total = 0;
3434    foreach my $user (@users) {
3435        $total++ if $self->_add_list_admin($role, $user);
3436    }
3437
3438    $self->_cache_publish_expiry('admin_user') if $total;
3439    return $total;
3440}
3441
3442sub _add_list_admin {
3443    my $self    = shift;
3444    my $role    = shift;
3445    my $user    = shift;
3446    my %options = @_;
3447
3448    my $who = Sympa::Tools::Text::canonic_email($user->{'email'});
3449    return undef unless defined $who and length $who;
3450
3451    unless (defined $user->{'inclusion'}) {
3452        # Is the email in user_table? Insert it.
3453        #FIXME: Is it required?
3454        unless (
3455            Sympa::User->new(
3456                $who,
3457                'gecos'    => $user->{'gecos'},
3458                'lang'     => $user->{'lang'},
3459                'password' => $user->{'password'},
3460            )
3461        ) {
3462            $log->syslog('err', 'Unable to add admin %s to user_table', $who);
3463            return undef;
3464        }
3465    }
3466
3467    $user->{'reception'}  ||= 'mail';
3468    $user->{'visibility'} ||= 'noconceal';
3469    $user->{'profile'}    ||= 'normal';
3470
3471    $user->{'date'} ||= time;
3472    $user->{'update_date'} ||= $user->{'date'};
3473
3474    # Compat.<=6.2.44 FIXME: needed?
3475    $user->{'inclusion'} ||= $user->{'date'}
3476        if $user->{'included'};
3477
3478    # Either is_included or is_subscribed must be set.
3479    # Default is is_subscriber for backward compatibility reason.
3480    $user->{'subscribed'} = 1 unless defined $user->{'inclusion'};
3481    $user->{'subscribed'} ||= 0;
3482
3483    my $sdm = Sympa::DatabaseManager->instance;
3484    my $sth;
3485    my %map_field = _map_list_admin_cols();
3486    my @key_list =
3487        grep { $_ ne 'email' and $_ ne 'role' } sort keys %map_field;
3488    my (@set_list, @val_list);
3489
3490    # Update Admin Table
3491    @set_list =
3492        @map_field{grep { $_ ne 'date' and exists $user->{$_} } @key_list};
3493    @val_list =
3494        @{$user}{grep { $_ ne 'date' and exists $user->{$_} } @key_list};
3495    if (    $options{replace}
3496        and @set_list
3497        and $sdm
3498        and $sth = $sdm->do_prepared_query(
3499            sprintf(
3500                q{UPDATE admin_table
3501                  SET %s
3502                  WHERE role_admin = ? AND user_admin = ? AND
3503                        list_admin = ? AND robot_admin = ?},
3504                join(', ', map { sprintf '%s = ?', $_ } @set_list)
3505            ),
3506            @val_list,
3507            $role,
3508            $user->{email},
3509            $self->{'name'},
3510            $self->{'domain'}
3511        )
3512        and $sth->rows    # If no affected rows, then insert a new row
3513    ) {
3514        return 1;
3515    }
3516    @set_list = @map_field{@key_list};
3517    @val_list = @{$user}{@key_list};
3518    if (    @set_list
3519        and $sdm
3520        and $sdm->do_prepared_query(
3521            sprintf(
3522                q{INSERT INTO admin_table
3523                  (%s, role_admin, user_admin, list_admin, robot_admin)
3524                  VALUES (%s, ?, ?, ?, ?)},
3525                join(', ', @set_list),
3526                join(', ', map {'?'} @set_list)
3527            ),
3528            @val_list,
3529            $role,
3530            $who,
3531            $self->{'name'},
3532            $self->{'domain'}
3533        )
3534    ) {
3535        return 1;
3536    }
3537
3538    $log->syslog('err',
3539        'Unable to add %s %s to table admin_table for list %s',
3540        $role, $who, $self);
3541    return undef;
3542}
3543
3544# Moved to: (part of) Sympa::Request::Handler::move_list::_move().
3545#sub rename_list_db;
3546
3547## Check list authorizations
3548## Higher level sub for request_action
3549# DEPRECATED; Use Sympa::Scenario::request_action();
3550#sub check_list_authz;
3551
3552## Initialize internal list cache
3553# Deprecated. No longer used.
3554#sub init_list_cache;
3555
3556## May the indicated user edit the indicated list parameter or not?
3557sub may_edit {
3558    $log->syslog('debug3', '(%s, %s, %s)', @_);
3559    my $self      = shift;
3560    my $parameter = shift;
3561    my $who       = shift;
3562    my %options   = @_;
3563
3564    # Special case for file edition.
3565    if ($options{file}) {
3566        $parameter = 'info.file' if $parameter eq 'info';
3567    }
3568
3569    my $edit_list_conf = $self->{_edit_list};
3570
3571    my $role;
3572
3573    ## What privilege?
3574    if (Sympa::is_listmaster($self, $who)) {
3575        $role = 'listmaster';
3576    } elsif ($self->is_admin('privileged_owner', $who)) {
3577        $role = 'privileged_owner';
3578    } elsif ($self->is_admin('owner', $who)) {
3579        $role = 'owner';
3580    } elsif ($self->is_admin('editor', $who)) {
3581        $role = 'editor';
3582#    }elsif ( $self->is_admin('subscriber',$who) ) {
3583#	$role = 'subscriber';
3584    } else {
3585        return ('user', 'hidden');
3586    }
3587
3588    ## What privilege does he/she has?
3589    my ($what, @order);
3590
3591    if (    $parameter =~ /^(\w+)\.(\w+)$/
3592        and $parameter !~ /\.tt2$/
3593        and $parameter ne 'message_header.mime'
3594        and $parameter ne 'message_footer.mime'
3595        and $parameter ne 'message_global_footer.mime') {
3596        my $main_parameter = $1;
3597        @order = (
3598            $edit_list_conf->{$parameter}{$role},
3599            $edit_list_conf->{$main_parameter}{$role},
3600            $edit_list_conf->{'default'}{$role},
3601            $edit_list_conf->{'default'}{'default'}
3602        );
3603    } else {
3604        @order = (
3605            $edit_list_conf->{$parameter}{$role},
3606            $edit_list_conf->{'default'}{$role},
3607            $edit_list_conf->{'default'}{'default'}
3608        );
3609    }
3610
3611    foreach $what (@order) {
3612        if (defined $what) {
3613            return ($role, $what);
3614        }
3615    }
3616
3617    return ('user', 'hidden');
3618}
3619
3620# Never used.
3621#sub may_create_parameter;
3622
3623# OBSOLETED: No longer used.
3624#sub may_do;
3625
3626## Does the list support digest mode
3627sub is_digest {
3628    return (shift->{'admin'}{'digest'});
3629}
3630
3631## Does the file exist?
3632# DEPRECATED.  No longer used.
3633#sub archive_exist;
3634
3635## List the archived files
3636# DEPRECATED.  Use Sympa::Archive::get_archives().
3637#sub archive_ls;
3638
3639# Merged into distribute_msg().
3640#sub archive_msg;
3641
3642## Is the list moderated?
3643sub is_moderated {
3644
3645    return 1 if (defined shift->{'admin'}{'editor'});
3646
3647    return 0;
3648}
3649
3650## Is the list archived?
3651#FIXME: Broken. Use scenario or is_archiving_enabled().
3652sub is_archived {
3653    $log->syslog('debug', '');
3654    if (shift->{'admin'}{'archive'}{'web_access'}) {
3655        $log->syslog('debug', '1');
3656        return 1;
3657    }
3658    $log->syslog('debug', 'Undef');
3659    return undef;
3660}
3661
3662## Is the list web archived?
3663#FIXME: Broken. Use scenario or is_archiving_enabled().
3664sub is_web_archived {
3665    my $self = shift;
3666    return 1
3667        if ref $self->{'admin'}{'archive'} eq 'HASH'
3668        and $self->{'admin'}{'archive'}{'web_access'};
3669    return undef;
3670}
3671
3672sub is_archiving_enabled {
3673    return Sympa::Tools::Data::smart_eq(shift->{'admin'}{'process_archive'},
3674        'on');
3675}
3676
3677sub is_included {
3678    my $self = shift;
3679
3680    my $sdm = Sympa::DatabaseManager->instance;
3681    my $sth;
3682
3683    unless (
3684        $sdm
3685        and $sth = $sdm->do_prepared_query(
3686            q{SELECT COUNT(*)
3687              FROM inclusion_table
3688              WHERE source_inclusion = ?},
3689            $self->get_id
3690        )
3691    ) {
3692        $log->syslog('err', 'Failed to get inclusion information on list %s',
3693            $self);
3694        return 1;    # Fake positive result.
3695    }
3696    my ($num) = $sth->fetchrow_array;
3697    $sth->finish;
3698
3699    return $num;
3700}
3701
3702# Old name: Sympa::List::get_nextdigest().
3703# Moved to Sympa::Spindle::ProcessDigest::_may_distribute_digest().
3704#sub may_distribute_digest;
3705
3706# Moved: Use Sympa::Scenario::get_scenarios().
3707#sub load_scenario_list;
3708
3709# Deprecated: Use Sympa::Task::get_tasks().
3710#sub load_task_list;
3711
3712# No longer used.
3713#sub _load_task_title;
3714
3715## Loads all data sources
3716sub load_data_sources_list {
3717    my ($self, $robot) = @_;
3718    $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $robot);
3719
3720    my %list_of_data_sources;
3721
3722    foreach
3723        my $dir (@{Sympa::get_search_path($self, subdir => 'data_sources')}) {
3724        next unless -d $dir;
3725
3726        while (my $file = <$dir/*.incl>) {
3727            next unless $file =~ m{(?<=/)([^./][^/]*)\.incl\z};
3728            my $name = $1;    # FIXME: Escape or omit hostile characters.
3729
3730            next if defined $list_of_data_sources{$name};
3731
3732            open my $fh, '<', $file or next;
3733            my ($title) = grep {s/\A\s*name\s+(.+)/$1/} <$fh>;
3734            close $fh;
3735            $list_of_data_sources{$name}{'title'} = $title || $name;
3736
3737            $list_of_data_sources{$name}{'name'} = $name;
3738        }
3739    }
3740
3741    return \%list_of_data_sources;
3742}
3743
3744## Loads the statistics information
3745# No longer used.
3746#sub _load_stats_file;
3747
3748## Loads the list of users.
3749# Old name:: Sympa::List::_load_list_members_file($file) which loaded members.
3750sub restore_users {
3751    $log->syslog('debug2', '(%s, %s)', @_);
3752    my $self = shift;
3753    my $role = shift;
3754
3755    die 'bug in logic. Ask developer'
3756        unless grep { $role eq $_ } qw(member owner editor);
3757
3758    # Open the file and switch to paragraph mode.
3759    my $file = $self->{'dir'} . '/' . $role . '.dump';
3760    my $lock_fh = Sympa::LockedFile->new($file, 5, '<') or return;
3761    local $RS = '';
3762
3763    my $time = time;
3764    if ($role eq 'member') {
3765        my %map_field = _map_list_member_cols();
3766
3767        while (my $para = <$lock_fh>) {
3768            my $user = {
3769                map {
3770                    #FIMXE: Define appropriate schema.
3771                    if (/^\s*(suspend|subscribed|included)\s+(\S+)\s*$/) {
3772                        # Note: "included" is kept for comatibility.
3773                        ($1 => !!$2);
3774                    } elsif (/^\s*(custom_attribute)\s+(.+)\s*$/) {
3775                        my $k = $1;
3776                        my $decoded =
3777                            Sympa::Tools::Data::decode_custom_attribute($2);
3778                        ($decoded and %$decoded) ? ($k => $decoded) : ();
3779                    } elsif (
3780                        /^\s*(date|update_date|inclusion|inclusion_ext|startdate|enddate|bounce_score|number_messages)\s+(\d+)\s*$/
3781                        or
3782                        /^\s*(reception)\s+(mail|digest|nomail|summary|notice|txt|html|urlize|not_me)\s*$/
3783                        or /^\s*(visibility)\s+(conceal|noconceal)\s*$/
3784                        or (/^\s*(\w+)\s+(.+)\s*$/ and $map_field{$1})) {
3785                        ($1 => $2);
3786                    } else {
3787                        ();
3788                    }
3789                } split /\n/,
3790                $para
3791            };
3792            next unless $user->{email};
3793
3794            $user->{update_date} = $time;
3795            # Compat. <= 6.2.44
3796            # This is needed for dump by earlier version of Sympa.
3797            $user->{inclusion} ||= ($user->{update_date} || time)
3798                if $user->{included};
3799
3800            $self->add_list_member($user);
3801        }
3802    } else {
3803        my $changed   = 0;
3804        my %map_field = _map_list_admin_cols();
3805
3806        while (my $para = <$lock_fh>) {
3807            my $user = {
3808                map {
3809                    #FIMXE:Define appropriate schema.
3810                    if (/^\s*(subscribed|included)\s+(\S+)\s*$/) {
3811                        # Note: "included" is kept for comatibility.
3812                        ($1 => !!$2);
3813                    } elsif (/^\s*(email|gecos|info|id)\s+(.+)\s*$/
3814                        or /^\s*(profile)\s+(normal|privileged)\s*$/
3815                        or
3816                        /^\s*(date|update_date|inclusion|inclusion_ext)\s+(\d+)\s*$/
3817                        or /^\s*(reception)\s+(mail|nomail)\s*$/
3818                        or /^\s*(visibility)\s+(conceal|noconceal)\s*$/
3819                        or (/^\s*(\w+)\s+(.+)\s*$/ and $map_field{$1})) {
3820                        ($1 => $2);
3821                    } else {
3822                        ();
3823                    }
3824                } split /\n/,
3825                $para
3826            };
3827            next unless defined $user->{email} and length $user->{email};
3828
3829            $user->{update_date} = $time;
3830            # Compat. <= 6.2.44
3831            # This is needed for dump by earlier version of Sympa.
3832            $user->{inclusion} ||= ($user->{update_date} || time)
3833                if $user->{included};
3834
3835            $self->_add_list_admin($role, $user, replace => 1)
3836                and $changed++;
3837        }
3838
3839        # Remove outdated permanent users.
3840        # Included users will be cleared in the next time of sync.
3841        my $sdm = Sympa::DatabaseManager->instance;
3842        my $sth;
3843        unless (
3844            $sdm
3845            and $sth = $sdm->do_prepared_query(
3846                q{DELETE FROM admin_table
3847                  WHERE role_admin = ? AND
3848                        list_admin = ? AND robot_admin = ? AND
3849                        subscribed_admin = 1 AND
3850                        inclusion_admin IS NULL AND
3851                        (update_epoch_admin IS NULL OR
3852                         update_epoch_admin < ?)},
3853                $role, $self->{'name'}, $self->{'domain'},
3854                $time
3855            )
3856        ) {
3857            $log->syslog('err', '(%s) Failed to delete %s %s(s)',
3858                $self, $role);
3859        }
3860        $changed++ if $sth and $sth->rows;
3861        unless (
3862            $sdm
3863            and $sth = $sdm->do_prepared_query(
3864                q{UPDATE admin_table
3865                  SET subscribed_admin = 0, update_epoch_admin = ?
3866                  WHERE role_admin = ? AND
3867                        list_admin = ? AND robot_admin = ? AND
3868                        subscribed_admin = 1 AND
3869                        inclusion_admin IS NOT NULL AND
3870                        (update_epoch_admin IS NULL OR
3871                         update_epoch_admin < ?)},
3872                $time,
3873                $role, $self->{'name'}, $self->{'domain'},
3874                $time
3875            )
3876        ) {
3877            $log->syslog('err', '(%s) Failed to delete %s', $self, $role);
3878        }
3879        $changed++ if $sth and $sth->rows;
3880
3881        $self->_cache_publish_expiry('admin_user') if $changed;
3882    }
3883
3884    $lock_fh->close;
3885}
3886
3887# Moved or deprecated:
3888#sub _include_users_remote_sympa_list;
3889# -> Sympa::DataSource::RemoteDump class.
3890#sub _get_https;
3891# -> No longer used.
3892#sub _include_users_list;
3893# -> Sympa::DataSource::List class.
3894#sub _include_users_admin;
3895# -> Never used.
3896#sub _include_users_file;
3897# -> Sympa::DataSource::File class.
3898#sub _include_users_remote_file;
3899# -> Sympa::DataSource::RemoteFile class.
3900#sub _include_users_ldap;
3901# -> Sympa::DataSource::LDAP class.
3902#sub _include_users_ldap_2level;
3903# -> Sympa::DataSource::LDAP2 class.
3904#sub _include_sql_ca;
3905# -> Sympa::DataSource::SQL class.
3906#sub _include_ldap_ca;
3907# -> Sympa::DataSource::LDAP class.
3908#sub _include_ldap_2level_ca;
3909# -> Sympa::DataSource::LDAP2 class.
3910#sub _include_users_sql;
3911# -> Sympa::DataSource::SQL class.
3912#sub _load_list_members_from_include;
3913# -> Sympa::Request::Handler::include class.
3914#sub _load_list_admin_from_include;
3915# -> Sympa::Request::Handler::include class.
3916
3917# Load an include admin user file (xx.incl)
3918#FIXME: Would be merged to _load_list_config_file() which mostly duplicates.
3919sub _load_include_admin_user_file {
3920    $log->syslog('debug3', '(%s, %s)', @_);
3921    my $self  = shift;
3922    my $entry = shift;
3923
3924    my $output   = '';
3925    my $filename = $entry->{'source'} . '.incl';
3926    my @data     = split ',', $entry->{'source_parameters'}
3927        if defined $entry->{'source_parameters'};
3928    my $template = Sympa::Template->new($self, subdir => 'data_sources');
3929    unless ($template->parse({param => [@data]}, $filename, \$output)) {
3930        $log->syslog('err', 'Failed to parse %s', $filename);
3931        return undef;
3932    }
3933    1 while $output =~ s/(\A|\n)\s+\n/$1\n/g;    # Clean empty lines
3934    my @paragraphs = map { [split /\n/, $_] } split /\n\n+/, $output;
3935
3936    my $robot = $self->{'domain'};
3937
3938    my $pinfo = {};
3939    # 'include_list' is kept for comatibility with 6.2.15 or earlier.
3940    my @sources = (@sources_providing_listmembers, 'include_list');
3941    @{$pinfo}{@sources} =
3942        @{Sympa::Robot::list_params($robot) || {}}{@sources};
3943
3944    my %include;
3945    for my $index (0 .. $#paragraphs) {
3946        my @paragraph = @{$paragraphs[$index]};
3947
3948        my $pname;
3949
3950        ## Clean paragraph, keep comments
3951        for my $i (0 .. $#paragraph) {
3952            my $changed = undef;
3953            for my $j (0 .. $#paragraph) {
3954                if ($paragraph[$j] =~ /^\s*\#/) {
3955                    chomp($paragraph[$j]);
3956                    push @{$include{'comment'}}, $paragraph[$j];
3957                    splice @paragraph, $j, 1;
3958                    $changed = 1;
3959                } elsif ($paragraph[$j] =~ /^\s*$/) {
3960                    splice @paragraph, $j, 1;
3961                    $changed = 1;
3962                }
3963
3964                last if $changed;
3965            }
3966
3967            last unless $changed;
3968        }
3969
3970        ## Empty paragraph
3971        next unless ($#paragraph > -1);
3972
3973        ## Look for first valid line
3974        unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) {
3975            $log->syslog(
3976                'info',
3977                'Bad paragraph "%s" in %s',
3978                join("\n", @paragraph), $filename
3979            );
3980            next;
3981        }
3982
3983        $pname = $1;
3984
3985        # Parameter aliases (compatibility concerns).
3986        my $alias = $pinfo->{$pname}{'obsolete'};
3987        if ($alias and $pinfo->{$alias}) {
3988            $paragraph[0] =~ s/^\s*$pname/$alias/;
3989            $pname = $alias;
3990        }
3991
3992        unless ($pinfo->{$pname}) {
3993            $log->syslog('info', 'Unknown parameter "%s" in %s',
3994                $pname, $filename);
3995            next;
3996        }
3997
3998        ## Uniqueness
3999        if (defined $include{$pname}) {
4000            unless (($pinfo->{$pname}{'occurrence'} eq '0-n')
4001                or ($pinfo->{$pname}{'occurrence'} eq '1-n')) {
4002                $log->syslog('info', 'Multiple parameter "%s" in %s',
4003                    $pname, $filename);
4004            }
4005        }
4006
4007        ## Line or Paragraph
4008        if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') {
4009            ## This should be a paragraph
4010            unless ($#paragraph > 0) {
4011                $log->syslog(
4012                    'info',
4013                    'Expecting a paragraph for "%s" parameter in %s, ignore it',
4014                    $pname,
4015                    $filename
4016                );
4017                next;
4018            }
4019
4020            ## Skipping first line
4021            shift @paragraph;
4022
4023            my %hash;
4024            for my $i (0 .. $#paragraph) {
4025                next if ($paragraph[$i] =~ /^\s*\#/);
4026
4027                unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) {
4028                    $log->syslog('info', 'Bad line "%s" in %s',
4029                        $paragraph[$i], $filename);
4030                }
4031
4032                my $key = $1;
4033
4034                # Subparameter aliases (compatibility concerns).
4035                # Note: subparameter alias was introduced by 6.2.15.
4036                my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'};
4037                if ($alias and $pinfo->{$pname}{'format'}{$alias}) {
4038                    $paragraph[$i] =~ s/^\s*$key/$alias/;
4039                    $key = $alias;
4040                }
4041
4042                unless (defined $pinfo->{$pname}{'file_format'}{$key}) {
4043                    $log->syslog('info',
4044                        'Unknown key "%s" in paragraph "%s" in %s',
4045                        $key, $pname, $filename);
4046                    next;
4047                }
4048
4049                unless ($paragraph[$i] =~
4050                    /^\s*$key(?:\s+($pinfo->{$pname}{'file_format'}{$key}{'file_format'}))?\s*$/i
4051                ) {
4052                    chomp($paragraph[$i]);
4053                    $log->syslog('info',
4054                        'Bad entry "%s" for key "%s", paragraph "%s" in %s',
4055                        $paragraph[$i], $key, $pname, $filename);
4056                    next;
4057                }
4058
4059                $hash{$key} =
4060                    $self->_load_list_param($key, $1,
4061                    $pinfo->{$pname}{'file_format'}{$key});
4062            }
4063
4064            ## Apply defaults & Check required keys
4065            my $missing_required_field;
4066            foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) {
4067
4068                ## Default value
4069                unless (defined $hash{$k}) {
4070                    if (defined $pinfo->{$pname}{'file_format'}{$k}{'default'}
4071                    ) {
4072                        $hash{$k} = $self->_load_list_param(
4073                            $k,
4074                            $pinfo->{$pname}{'file_format'}{$k}{'default'},
4075                            $pinfo->{$pname}{'file_format'}{$k}
4076                        );
4077                    }
4078                }
4079                ## Required fields
4080                if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1'
4081                    and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) {
4082                    unless (defined $hash{$k}) {
4083                        $log->syslog('info',
4084                            'Missing key "%s" in param "%s" in %s',
4085                            $k, $pname, $filename);
4086                        $missing_required_field++;
4087                    }
4088                }
4089            }
4090
4091            next if $missing_required_field;
4092
4093            ## Should we store it in an array
4094            if (($pinfo->{$pname}{'occurrence'} =~ /n$/)) {
4095                push @{$include{$pname}}, \%hash;
4096            } else {
4097                $include{$pname} = \%hash;
4098            }
4099        } else {
4100            ## This should be a single line
4101            unless ($#paragraph == 0) {
4102                $log->syslog('info',
4103                    'Expecting a single line for "%s" parameter in %s',
4104                    $pname, $filename);
4105            }
4106
4107            unless ($paragraph[0] =~
4108                /^\s*$pname(?:\s+($pinfo->{$pname}{'file_format'}))?\s*$/i) {
4109                chomp($paragraph[0]);
4110                $log->syslog('info', 'Bad entry "%s" in %s',
4111                    $paragraph[0], $filename);
4112                next;
4113            }
4114
4115            my $value = $self->_load_list_param($pname, $1, $pinfo->{$pname});
4116
4117            if (($pinfo->{$pname}{'occurrence'} =~ /n$/)
4118                && !(ref($value) =~ /^ARRAY/)) {
4119                push @{$include{$pname}}, $value;
4120            } else {
4121                $include{$pname} = $value;
4122            }
4123        }
4124    }
4125
4126    _load_include_admin_user_postprocess(\%include);
4127
4128    delete $include{defaults};
4129    foreach my $cfgs (values %include) {
4130        foreach my $cfg (@{$cfgs || []}) {
4131            next unless ref $cfg;    # include_file doesn't have parameters
4132            foreach my $k (keys %$entry) {
4133                next if $k eq 'source';
4134                next if $k eq 'source_parameters';
4135                next unless defined $entry->{$k};
4136                $cfg->{$k} = $entry->{$k};
4137            }
4138        }
4139    }
4140
4141    return \%include;
4142}
4143
4144#sub get_list_of_sources_id;
4145# -> No longer used.
4146#sub sync_include_ca;
4147# -> sync_include('member').
4148#sub purge_ca;
4149# -> Never used.
4150
4151# FIXME: Use Sympa::Request::Handler::include handler.
4152sub sync_include {
4153    $log->syslog('debug2', '(%s, %s)', @_);
4154    my $self    = shift;
4155    my $role    = shift;
4156    my %options = @_;
4157
4158    $role ||= 'member';    # Compat.<=6.2.54
4159
4160    return 0
4161        unless $self->has_data_sources($role)
4162        or $self->has_included_users($role);
4163
4164    my $spindle = Sympa::Spindle::ProcessRequest->new(
4165        context          => $self,
4166        action           => 'include',
4167        role             => $role,
4168        delay            => $options{delay},
4169        scenario_context => {skip => 1},
4170    );
4171    unless ($spindle and $spindle->spin) {
4172        $log->syslog('err',
4173            'Could not get users (%s) from an data source for list %s',
4174            $role, $self);
4175        if ($role eq 'member') {
4176            Sympa::send_notify_to_listmaster($self,
4177                'sync_include_failed', {});
4178        } else {
4179            Sympa::send_notify_to_listmaster($self,
4180                'sync_include_admin_failed', {});
4181        }
4182        return undef;
4183    }
4184
4185    return 1;
4186}
4187
4188#sub _update_inclusion_table;
4189# -> _update_inclusion_table() and/or _clean_inclusion_table() in
4190#    Sympa::Request::Handler::include class.
4191
4192# The function sync_include('member') is to be called by the task_manager.
4193# This one is to be called from anywhere else. This function deletes the
4194# scheduled sync_include task. If this deletion happened in sync_include(),
4195# it would disturb the normal task_manager.pl functionning.
4196# 6.2.4: Returns 0 if synchronization is not needed.
4197# No longer used. Use sync_include('member', delay => ...);
4198#sub on_the_fly_sync_include;
4199
4200# DEPRECATED. Use sync_include('owner') & sync_include('editor').
4201#sub sync_include_admin;
4202
4203#sub _load_list_admin_from_config;
4204# -> No longer used.
4205#sub is_update_param;
4206# -> Never used.
4207#sub _inclusion_loop;
4208# -> Sympa::DataSouce::List::_inclusion_loop().
4209
4210# Merged into Sympa::List::get_total().
4211#sub _load_total_db;
4212
4213## Writes the user list to disk
4214# Depreceted.  Use Sympa::List::dump_users().
4215#sub _save_list_members_file;
4216
4217## Does the real job : stores the message given as an argument into
4218## the digest of the list.
4219# Moved to Sympa::Spool::Digest::store().
4220#sub store_digest;
4221
4222sub get_including_lists {
4223    my $self = shift;
4224    my $role = shift || 'member';
4225
4226    my $sdm = Sympa::DatabaseManager->instance;
4227    my $sth;
4228
4229    unless (
4230        $sdm
4231        and $sth = $sdm->do_prepared_query(
4232            q{SELECT target_inclusion AS "target"
4233              FROM inclusion_table
4234              WHERE source_inclusion = ? AND role_inclusion = ?},
4235            $self->get_id, $role
4236        )
4237    ) {
4238        $log->syslog('err', 'Cannot get lists including %s', $self);
4239        return undef;
4240    }
4241
4242    my @lists;
4243    while (my $r = $sth->fetchrow_hashref('NAME_lc')) {
4244        next unless $r and $r->{target};
4245        my $l = __PACKAGE__->new($r->{target});
4246        next unless $l;
4247
4248        push @lists, $l;
4249    }
4250    $sth->finish;
4251
4252    return [@lists];
4253}
4254
4255sub get_lists {
4256    $log->syslog('debug2', '(%s, %s)', @_);
4257    my $that = shift || '*';
4258    my %options = @_;
4259
4260    # Set signal handler so that long call can be aborted by signal.
4261    my $signalled;
4262    my %sighandler = (HUP => $SIG{HUP}, INT => $SIG{INT}, TERM => $SIG{TERM});
4263    local $SIG{HUP} = sub { $sighandler{HUP}->(@_); $signalled = 1; }
4264        if ref $SIG{HUP} eq 'CODE';
4265    local $SIG{INT} = sub { $sighandler{INT}->(@_); $signalled = 1; }
4266        if ref $SIG{INT} eq 'CODE';
4267    local $SIG{TERM} = sub { $sighandler{TERM}->(@_); $signalled = 1; }
4268        if ref $SIG{TERM} eq 'CODE';
4269
4270    my $sdm = Sympa::DatabaseManager->instance;
4271
4272    my (@lists, @robot_ids, $family_name);
4273
4274    if (ref $that and ref $that eq 'Sympa::Family') {
4275        @robot_ids   = ($that->{'domain'});
4276        $family_name = $that->{'name'};
4277    } elsif (!ref $that and $that and $that ne '*') {
4278        @robot_ids = ($that);
4279    } elsif (!$that or $that eq '*') {
4280        @robot_ids = get_robots();
4281    } else {
4282        die 'bug in logic.  Ask developer';
4283    }
4284
4285    # Build query: Perl expression for files and SQL expression for
4286    # list_table.
4287    my $cond_perl   = undef;
4288    my $cond_sql    = undef;
4289    my $which_role  = undef;
4290    my $which_user  = undef;
4291    my @query       = @{$options{'filter'} || []};
4292    my @clause_perl = ();
4293    my @clause_sql  = ();
4294
4295    ## get family lists
4296    if ($family_name) {
4297        push @clause_perl,
4298            sprintf(
4299            '$list->{"admin"}{"family_name"} and $list->{"admin"}{"family_name"} eq "%s"',
4300            quotemeta $family_name);
4301        push @clause_sql, sprintf(q{family_list LIKE '%s'}, $family_name);
4302    }
4303
4304    while (1 < scalar @query) {
4305        my @expr_perl = ();
4306        my @expr_sql  = ();
4307
4308        my $keys = shift @query;
4309        next unless defined $keys and $keys =~ /\S/;
4310        $keys =~ s/^(!?)\s*//;
4311        my $negate = $1;
4312        my @keys = split /[|]/, $keys;
4313
4314        my $vals = shift @query;
4315        next unless defined $vals and length $vals;    # spaces are allowed
4316        my @vals = split /[|]/, $vals;
4317
4318        foreach my $k (@keys) {
4319            next unless $k =~ /\S/;
4320
4321            my $cmpl = undef;
4322            my ($prfx, $sffx) = ('', '');
4323            $prfx = $1 if $k =~ s/^(%)//;
4324            $sffx = $1 if $k =~ s/(%)$//;
4325            if ($prfx or $sffx) {
4326                unless ($sffx) {
4327                    $cmpl = '%s eq "%s"';
4328                } elsif ($prfx) {
4329                    $cmpl = 'index(%s, "%s") >= 0';
4330                } else {
4331                    $cmpl = 'index(%s, "%s") == 0';
4332                }
4333            } elsif ($k =~ s/\s*([<>])\s*$//) {
4334                $cmpl = '%s ' . $1 . ' %s';
4335            }
4336
4337            ## query with single key and single value
4338
4339            if ($k =~ /^(member|owner|editor)$/) {
4340                if (defined $which_role) {
4341                    $log->syslog('err', 'bug in logic. Ask developer: $k=%s',
4342                        $k);
4343                    return undef;
4344                }
4345                $which_role = $k;
4346                $which_user = $vals;
4347                next;
4348            }
4349
4350            ## query with single value
4351
4352            if ($k eq 'name' or $k eq 'subject') {
4353                my ($vl, $ve, $key_perl, $key_sql);
4354                if ($k eq 'name') {
4355                    $key_perl = '$list->{"name"}';
4356                    $key_sql  = 'name_list';
4357                    $vl       = lc $vals;
4358                } else {
4359                    $key_perl =
4360                        'Sympa::Tools::Text::foldcase($list->{"admin"}{"subject"})';
4361                    $key_sql = 'searchkey_list';
4362                    $vl      = Sympa::Tools::Text::foldcase($vals);
4363                }
4364
4365                ## Perl expression
4366                $ve = $vl;
4367                $ve =~ s/([^ \w\x80-\xFF])/\\$1/g;
4368                push @expr_perl,
4369                    sprintf(($cmpl ? $cmpl : '%s eq "%s"'), $key_perl, $ve);
4370
4371                ## SQL expression
4372                if ($sffx or $prfx) {
4373                    $ve = $sdm->quote($vl);
4374                    $ve =~ s/^["'](.*)['"]$/$1/;
4375                    $ve =~ s/([%_])/\\$1/g;
4376                    push @expr_sql,
4377                        sprintf("%s LIKE '%s'", $key_sql, "$prfx$ve$sffx");
4378                } else {
4379                    push @expr_sql,
4380                        sprintf('%s = %s', $key_sql, $sdm->quote($vl));
4381                }
4382
4383                next;
4384            }
4385
4386            foreach my $v (@vals) {
4387                ## Perl expressions
4388                if ($k eq 'creation' or $k eq 'update') {
4389                    push @expr_perl,
4390                        sprintf(
4391                        ($cmpl ? $cmpl : '%s == %s'),
4392                        sprintf('$list->{"admin"}{"%s"}->{"date_epoch"}', $k),
4393                        $v
4394                        );
4395#                 } elsif ($k eq 'web_archive') {
4396#                     push @expr_perl,
4397#                         sprintf('%s$list->is_web_archived',
4398#                         ($v+0 ? '' : '! '));
4399                } elsif ($k eq 'status') {
4400                    my $ve = lc $v;
4401                    $ve =~ s/([^ \w\x80-\xFF])/\\$1/g;
4402                    push @expr_perl,
4403                        sprintf('$list->{"admin"}{"status"} eq "%s"', $ve);
4404                } elsif ($k eq 'topics') {
4405                    my $ve = lc $v;
4406                    if ($ve eq 'others' or $ve eq 'topicsless') {
4407                        push @expr_perl,
4408                            '! scalar(grep { $_ ne "others" } @{$list->{"admin"}{"topics"} || []})';
4409                    } else {
4410                        $ve =~ s/([^ \w\x80-\xFF])/\\$1/g;
4411                        push @expr_perl,
4412                            sprintf(
4413                            'scalar(grep { $_ eq "%s" or index($_, "%s/") == 0 } @{$list->{"admin"}{"topics"} || []})',
4414                            $ve, $ve);
4415                    }
4416                } else {
4417                    $log->syslog('err', 'bug in logic. Ask developer: $k=%s',
4418                        $k);
4419                    return undef;
4420                }
4421
4422                ## SQL expressions
4423                if ($k eq 'creation' or $k eq 'update') {
4424                    push @expr_sql,
4425                        sprintf('%s_epoch_list %s %s',
4426                        $k, ($cmpl ? $cmpl : '='), $v);
4427#                 } elsif ($k eq 'web_archive') {
4428#                     push @expr_sql,
4429#                         sprintf('web_archive_list = %d', ($v+0 ? 1 : 0));
4430                } elsif ($k eq 'status') {
4431                    push @expr_sql,
4432                        sprintf('%s_list = %s', $k, $sdm->quote($v));
4433                } elsif ($k eq 'topics') {
4434                    my $ve = lc $v;
4435                    if ($ve eq 'others' or $ve eq 'topicsless') {
4436                        push @expr_sql, "topics_list = ''";
4437                    } else {
4438                        $ve = $sdm->quote($ve);
4439                        $ve =~ s/^["'](.*)['"]$/$1/;
4440                        $ve =~ s/([%_])/\\$1/g;
4441                        push @expr_sql,
4442                            sprintf(
4443                            "topics_list LIKE '%%,%s,%%' OR topics_list LIKE '%%,%s/%%'",
4444                            $ve, $ve);
4445                    }
4446                }
4447            }
4448        }
4449        if (scalar @expr_perl) {
4450            push @clause_perl,
4451                ($negate ? '! ' : '') . '(' . join(' || ', @expr_perl) . ')';
4452            push @clause_sql,
4453                ($negate ? 'NOT ' : '') . '(' . join(' OR ', @expr_sql) . ')';
4454        }
4455    }
4456
4457    if (scalar @clause_perl) {
4458        $cond_perl = join ' && ',  @clause_perl;
4459        $cond_sql  = join ' AND ', @clause_sql;
4460    } else {
4461        $cond_perl = undef;
4462        $cond_sql  = undef;
4463    }
4464    $log->syslog('debug3', 'filter %s; %s', $cond_perl, $cond_sql);
4465
4466    ## Sort order
4467    my $order_perl;
4468    my $order_sql;
4469    my $keys      = $options{'order'} || [];
4470    my @keys_perl = ();
4471    my @keys_sql  = ();
4472    foreach my $key (@{$keys}) {
4473        my $desc = ($key =~ s/^\s*-\s*//i);
4474
4475        if ($key eq 'creation' or $key eq 'update') {
4476            if ($desc) {
4477                push @keys_perl,
4478                    sprintf
4479                    '$b->{"admin"}{"%s"}->{"date_epoch"} <=> $a->{"admin"}{"%s"}->{"date_epoch"}',
4480                    $key,
4481                    $key;
4482            } else {
4483                push @keys_perl,
4484                    sprintf
4485                    '$a->{"admin"}{"%s"}->{"date_epoch"} <=> $b->{"admin"}{"%s"}->{"date_epoch"}',
4486                    $key,
4487                    $key;
4488            }
4489        } elsif ($key eq 'name') {
4490            if ($desc) {
4491                push @keys_perl, '$b->{"name"} cmp $a->{"name"}';
4492            } else {
4493                push @keys_perl, '$a->{"name"} cmp $b->{"name"}';
4494            }
4495        } elsif ($key eq 'total') {
4496            if ($desc) {
4497                push @keys_perl, '$b->get_total <=> $a->get_total';
4498            } else {
4499                push @keys_perl, '$a->get_total <=> $b->get_total';
4500            }
4501        } else {
4502            $log->syslog('err', 'bug in logic.  Ask developer: $key=%s',
4503                $key);
4504            return undef;
4505        }
4506
4507        if ($key eq 'creation' or $key eq 'update') {
4508            push @keys_sql,
4509                sprintf '%s_epoch_list%s', $key, ($desc ? ' DESC' : '');
4510        } else {
4511            push @keys_sql, sprintf '%s_list%s', $key, ($desc ? ' DESC' : '');
4512        }
4513    }
4514    $order_perl = join(' or ', @keys_perl) || undef;
4515    push @keys_sql, 'name_list'
4516        unless scalar grep { $_ =~ /name_list/ } @keys_sql;
4517    $order_sql = join(', ', @keys_sql);
4518    $log->syslog('debug3', 'order %s; %s', $order_perl, $order_sql);
4519
4520    ## limit number of result
4521    my $limit = $options{'limit'} || undef;
4522    my $count = 0;
4523
4524    # Check signal at first.
4525    return undef if $signalled;
4526
4527    foreach my $robot_id (@robot_ids) {
4528        if (!Sympa::Tools::Data::smart_eq($Conf::Conf{'db_list_cache'}, 'on')
4529            or $options{'reload_config'}) {
4530            # Files are used instead of list_table DB cache.
4531            my @requested_lists = ();
4532
4533            # filter by role
4534            if (defined $which_role) {
4535                my %r = ();
4536
4537                push @sth_stack, $sth;
4538
4539                if ($which_role eq 'member') {
4540                    $sth = $sdm->do_prepared_query(
4541                        q{SELECT list_subscriber
4542                          FROM subscriber_table
4543                          WHERE robot_subscriber = ? AND user_subscriber = ?},
4544                        $robot_id, $which_user
4545                    );
4546                } else {
4547                    $sth = $sdm->do_prepared_query(
4548                        q{SELECT list_admin
4549                          FROM admin_table
4550                          WHERE robot_admin = ? AND user_admin = ? AND
4551                                role_admin = ?},
4552                        $robot_id, $which_user, $which_role
4553                    );
4554                }
4555                unless ($sth) {
4556                    $log->syslog(
4557                        'err',
4558                        'failed to get lists with user %s as %s from database: %s',
4559                        $which_user,
4560                        $which_role,
4561                        $EVAL_ERROR
4562                    );
4563                    $sth = pop @sth_stack;
4564                    return undef;
4565                }
4566                my @row;
4567                while (@row = $sth->fetchrow_array) {
4568                    my $listname = $row[0];
4569                    $r{$listname} = 1;
4570                }
4571                $sth->finish;
4572
4573                $sth = pop @sth_stack;
4574
4575                # none found
4576                next unless %r;    # foreach my $robot_id
4577                @requested_lists = keys %r;
4578            } else {
4579                # check existence of robot directory
4580                my $robot_dir = $Conf::Conf{'home'} . '/' . $robot_id;
4581                $robot_dir = $Conf::Conf{'home'}
4582                    if !-d $robot_dir and $robot_id eq $Conf::Conf{'domain'};
4583                next unless -d $robot_dir;
4584
4585                unless (opendir(DIR, $robot_dir)) {
4586                    $log->syslog('err', 'Unable to open %s', $robot_dir);
4587                    return undef;
4588                }
4589                @requested_lists =
4590                    grep { !/^\.+$/ and -f "$robot_dir/$_/config" }
4591                    readdir DIR;
4592                closedir DIR;
4593            }
4594
4595            my @l = ();
4596            foreach my $listname (sort @requested_lists) {
4597                return undef if $signalled;
4598
4599                ## create object
4600                my $list = __PACKAGE__->new(
4601                    $listname,
4602                    $robot_id,
4603                    {   %options,
4604                        skip_name_check => 1,    #ToDo: implement it.
4605                    }
4606                );
4607                next unless defined $list;
4608
4609                ## filter by condition
4610                if (defined $cond_perl) {
4611                    next unless eval $cond_perl;
4612                }
4613
4614                push @l, $list;
4615                last if $limit and $limit <= ++$count;
4616            }
4617
4618            ## sort
4619            if ($order_perl) {
4620                eval 'use sort "stable"';
4621                push @lists, sort { eval $order_perl } @l;
4622                eval 'use sort "defaults"';
4623            } else {
4624                push @lists, @l;
4625            }
4626        } else {
4627            # Use list_table DB cache.
4628            my @requested_lists;
4629
4630            my $table;
4631            my $cond;
4632            if (!defined $which_role) {
4633                $table = 'list_table';
4634                $cond  = '';
4635            } elsif ($which_role eq 'member') {
4636                $table = 'list_table, subscriber_table';
4637                $cond  = sprintf q{robot_list = robot_subscriber AND
4638                  name_list = list_subscriber AND
4639                  user_subscriber = %s}, $sdm->quote($which_user);
4640            } else {
4641                $table = 'list_table, admin_table';
4642                $cond  = sprintf q{robot_list = robot_admin AND
4643                  name_list = list_admin AND
4644                  role_admin = %s AND
4645                  user_admin = %s}, $sdm->quote($which_role),
4646                    $sdm->quote($which_user);
4647            }
4648
4649            push @sth_stack, $sth;
4650
4651            $sth = $sdm->do_query(
4652                q{SELECT name_list AS name
4653                  FROM %s
4654                  WHERE %s
4655                  ORDER BY %s},
4656                $table,
4657                join(
4658                    ' AND ',
4659                    grep {$_} (
4660                        $cond_sql,                 $cond,
4661                        sprintf 'robot_list = %s', $sdm->quote($robot_id)
4662                    )
4663                ),
4664                $order_sql
4665            );
4666            unless ($sth) {
4667                $log->syslog('err', 'Failed to get lists from %s', $table);
4668                $sth = pop @sth_stack;
4669                return undef;
4670            }
4671
4672            @requested_lists =
4673                map { ref $_ ? $_->[0] : $_ }
4674                @{$sth->fetchall_arrayref([0], ($limit || undef))};
4675            $sth->finish;
4676
4677            $sth = pop @sth_stack;
4678
4679            foreach my $listname (@requested_lists) {
4680                return undef if $signalled;
4681
4682                my $list = __PACKAGE__->new(
4683                    $listname,
4684                    $robot_id,
4685                    {   %options,
4686                        skip_name_check => 1,    #ToDo: implement it.
4687                    }
4688                );
4689                next unless $list;
4690
4691                push @lists, $list;
4692                last if $limit and $limit <= ++$count;
4693            }
4694
4695        }
4696        last if $limit and $limit <= $count;
4697    }    # foreach my $robot_id
4698
4699    return \@lists;
4700}
4701
4702## List of robots hosted by Sympa
4703sub get_robots {
4704
4705    my (@robots, $r);
4706    $log->syslog('debug2', '');
4707
4708    unless (opendir(DIR, $Conf::Conf{'etc'})) {
4709        $log->syslog('err', 'Unable to open %s', $Conf::Conf{'etc'});
4710        return undef;
4711    }
4712    my $use_default_robot = 1;
4713    foreach $r (sort readdir(DIR)) {
4714        next
4715            unless (($r !~ /^\./o)
4716            && (-r "$Conf::Conf{'etc'}/$r/robot.conf"));
4717        push @robots, $r;
4718        undef $use_default_robot if ($r eq $Conf::Conf{'domain'});
4719    }
4720    closedir DIR;
4721
4722    push @robots, $Conf::Conf{'domain'} if ($use_default_robot);
4723    return @robots;
4724}
4725
4726sub get_which {
4727    $log->syslog('debug2', '(%s, %s, %s)', @_);
4728    my $email    = Sympa::Tools::Text::canonic_email(shift);
4729    my $robot_id = shift;
4730    my $role     = shift;
4731
4732    unless ($role eq 'member' or $role eq 'owner' or $role eq 'editor') {
4733        $log->syslog('err',
4734            'Internal error, unknown or undefined parameter "%s"', $role);
4735        return undef;
4736    }
4737
4738    my $all_lists =
4739        get_lists($robot_id,
4740        'filter' => [$role => $email, '! status' => 'closed|family_closed']);
4741
4742    return @{$all_lists || []};
4743}
4744
4745## return total of messages awaiting moderation
4746# DEPRECATED: Use Sympa::Spool::Moderation::size().
4747# sub get_mod_spool_size;
4748
4749### moderation for shared
4750
4751# DEPRECATED: Use {status} attribute of Sympa::WWW::SharedDocument instance.
4752#sub get_shared_status;
4753
4754# DEPRECATED: Use Sympa::WWW::SharedDocument::get_moderated_descendants().
4755#sub get_shared_moderated;
4756
4757# DEPRECATED: Subroutine of get_shared_moderated().
4758#sub sort_dir_to_get_mod;
4759
4760## Get the type of a DB field
4761#OBSOLETED: No longer used. This is specific to MySQL: Use $sdm->get_fields()
4762# instead.
4763sub get_db_field_type {
4764    my ($table, $field) = @_;
4765
4766    my $sdm = Sympa::DatabaseManager->instance;
4767    unless ($sdm and $sth = $sdm->do_query('SHOW FIELDS FROM %s', $table)) {
4768        $log->syslog('err', 'Get the list of fields for table %s', $table);
4769        return undef;
4770    }
4771
4772    while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
4773        next unless ($ref->{'Field'} eq $field);
4774
4775        return $ref->{'Type'};
4776    }
4777
4778    return undef;
4779}
4780
4781# Moved to _lowercase_field() in sympa.pl.
4782#sub lowercase_field;
4783
4784############ THIS IS RELATED TO NEW LOAD_ADMIN_FILE #############
4785
4786## Sort function for writing config files
4787sub _by_order {
4788    (($Sympa::ListDef::pinfo{$a || ''}{'order'} || 0)
4789        <=> ($Sympa::ListDef::pinfo{$b || ''}{'order'} || 0))
4790        || (($a || '') cmp($b || ''));
4791}
4792
4793## Apply defaults to parameters definition (%Sympa::ListDef::pinfo)
4794## DEPRECATED: use Sympa::Robot::list_params($robot).
4795##sub _apply_defaults {
4796
4797## Save a parameter
4798sub _save_list_param {
4799    my ($robot_id, $key, $p, $defaults, $fd) = @_;
4800
4801    ## Ignore default value
4802    return 1 if $defaults;
4803    return 1 unless (defined($p));
4804
4805    my $pinfo = Sympa::Robot::list_params($robot_id);
4806    if (   defined($pinfo->{$key}{'scenario'})
4807        || defined($pinfo->{$key}{'task'})) {
4808        return 1 if ($p->{'name'} eq 'default');
4809
4810        $fd->print(sprintf "%s %s\n", $key, $p->{'name'});
4811        $fd->print("\n");
4812
4813    } elsif (ref($pinfo->{$key}{'file_format'}) eq 'HASH') {
4814        $fd->print(sprintf "%s\n", $key);
4815        foreach my $k (keys %{$p}) {
4816
4817            if (defined($pinfo->{$key}{'file_format'}{$k}{'scenario'})) {
4818                ## Skip if empty value
4819                next
4820                    unless defined $p->{$k}{'name'}
4821                    and $p->{$k}{'name'} =~ /\S/;
4822
4823                $fd->print(sprintf "%s %s\n", $k, $p->{$k}{'name'});
4824
4825            } elsif (($pinfo->{$key}{'file_format'}{$k}{'occurrence'} =~ /n$/)
4826                && $pinfo->{$key}{'file_format'}{$k}{'split_char'}) {
4827                next unless $p->{$k} and @{$p->{$k}};
4828
4829                $fd->print(
4830                    sprintf "%s %s\n",
4831                    $k,
4832                    join(
4833                        $pinfo->{$key}{'file_format'}{$k}{'split_char'},
4834                        @{$p->{$k}}
4835                    )
4836                );
4837            } else {
4838                ## Skip if empty value
4839                next unless defined $p->{$k} and $p->{$k} =~ /\S/;
4840
4841                $fd->print(sprintf "%s %s\n", $k, $p->{$k});
4842            }
4843        }
4844        $fd->print("\n");
4845
4846    } else {
4847        if (($pinfo->{$key}{'occurrence'} =~ /n$/)
4848            && $pinfo->{$key}{'split_char'}) {
4849            ### " avant de debugger do_edit_list qui crée des nouvelles
4850            ### entrées vides
4851            my $string = join($pinfo->{$key}{'split_char'}, @{$p});
4852            $string =~ s/\,\s*$//;
4853
4854            $fd->print(sprintf "%s %s\n\n", $key, $string);
4855        } elsif ($key eq 'digest') {
4856            my $value = sprintf '%s %d:%d', join(',', @{$p->{'days'}}),
4857                $p->{'hour'}, $p->{'minute'};
4858            $fd->print(sprintf "%s %s\n\n", $key, $value);
4859        } else {
4860            $fd->print(sprintf "%s %s\n\n", $key, $p);
4861        }
4862    }
4863
4864    return 1;
4865}
4866
4867## Load a single line
4868sub _load_list_param {
4869    $log->syslog('debug3', '(%s, %s, %s, %s)', @_);
4870    my $self  = shift;
4871    my $key   = shift;
4872    my $value = shift;
4873    my $p     = shift;
4874
4875    my $robot = $self->{'domain'};
4876
4877    # Empty value.
4878    unless (defined $value and $value =~ /\S/) {
4879        return undef;    #FIXME
4880    }
4881
4882    # For compatibility to <= 6.2.40: Special name "default" stands for
4883    # the default scenario.
4884    if ($p->{'scenario'} and $value eq 'default') {
4885        $value = $p->{'default'};
4886    }
4887
4888    ## Search configuration file
4889    if (    ref $value
4890        and $value->{'conf'}
4891        and grep { $_->{'name'} and $_->{'name'} eq $value->{'conf'} }
4892        @Sympa::ConfDef::params) {
4893        my $param = $value->{'conf'};
4894        $value = Conf::get_robot_conf($robot, $param);
4895    }
4896
4897    ## Synonyms
4898    if (defined $value and defined $p->{'synonym'}{$value}) {
4899        $value = $p->{'synonym'}{$value};
4900    }
4901
4902    ## Scenario
4903    if ($p->{'scenario'}) {
4904        $value =~ y/,/_/;    # Compat. eg "add owner,notify"
4905        #FIXME: Check existence of scenario file.
4906        $value = {'name' => $value};
4907    } elsif ($p->{'task'}) {
4908        $value = {'name' => $value};
4909    }
4910
4911    ## Do we need to split param if it is not already an array
4912    if (    exists $p->{'occurrence'}
4913        and $p->{'occurrence'} =~ /n$/
4914        and $p->{'split_char'}
4915        and defined $value
4916        and ref $value ne 'ARRAY') {
4917        $value =~ s/^\s*(.+)\s*$/$1/;
4918        return [split /\s*$p->{'split_char'}\s*/, $value];
4919    } else {
4920        return $value;
4921    }
4922}
4923
4924BEGIN { eval 'use Crypt::OpenSSL::X509'; }
4925
4926# Load the certificate file.
4927sub get_cert {
4928    $log->syslog('debug2', '(%s)', @_);
4929    my $self   = shift;
4930    my $format = shift;
4931
4932    ## Default format is PEM (can be DER)
4933    $format ||= 'pem';
4934
4935    # we only send the encryption certificate: this is what the user
4936    # needs to send mail to the list; if they ever get anything signed,
4937    # it will have the respective cert attached anyways.
4938    # (the problem is that netscape, opera and IE can't only
4939    # read the first cert in a file)
4940    my ($certs, $keys) = Sympa::Tools::SMIME::find_keys($self, 'encrypt');
4941
4942    my @cert;
4943    if ($format eq 'pem') {
4944        unless (open(CERT, $certs)) {
4945            $log->syslog('err', 'Unable to open %s: %m', $certs);
4946            return undef;
4947        }
4948
4949        my $state;
4950        while (<CERT>) {
4951            chomp;
4952            if ($state) {
4953                # convert to CRLF for windows clients
4954                push(@cert, "$_\r\n");
4955                if (/^-+END/) {
4956                    pop @cert;
4957                    last;
4958                }
4959            } elsif (/^-+BEGIN/) {
4960                $state = 1;
4961            }
4962        }
4963        close CERT;
4964    } elsif ($format eq 'der' and $Crypt::OpenSSL::X509::VERSION) {
4965        my $x509 = eval { Crypt::OpenSSL::X509->new_from_file($certs) };
4966        unless ($x509) {
4967            $log->syslog('err', 'Unable to open certificate %s: %m', $certs);
4968            return undef;
4969        }
4970        @cert = ($x509->as_string(Crypt::OpenSSL::X509::FORMAT_ASN1()));
4971    } else {
4972        $log->syslog('err', 'Unknown "%s" certificate format', $format);
4973        return undef;
4974    }
4975
4976    return join '', @cert;
4977}
4978
4979## Load a config file of a list
4980#FIXME: Would merge _load_include_admin_user_file() which mostly duplicates.
4981sub _load_list_config_file {
4982    $log->syslog('debug3', '(%s)', @_);
4983    my $self = shift;
4984
4985    my $robot = $self->{'domain'};
4986
4987    my $pinfo       = Sympa::Robot::list_params($robot);
4988    my $config_file = $self->{'dir'} . '/config';
4989
4990    my %admin;
4991    my (@paragraphs);
4992
4993    ## Just in case...
4994    local $RS = "\n";
4995
4996    ## Set defaults to 1
4997    foreach my $pname (keys %$pinfo) {
4998        $admin{'defaults'}{$pname} = 1
4999            unless ($pinfo->{$pname}{'internal'});
5000    }
5001
5002    ## Lock file
5003    my $lock_fh = Sympa::LockedFile->new($config_file, 5, '<');
5004    unless ($lock_fh) {
5005        $log->syslog('err', 'Could not create new lock on %s', $config_file);
5006        return undef;
5007    }
5008
5009    ## Split in paragraphs
5010    my $i = 0;
5011    while (<$lock_fh>) {
5012        if (/^\s*$/) {
5013            $i++ if $paragraphs[$i];
5014        } else {
5015            push @{$paragraphs[$i]}, $_;
5016        }
5017    }
5018
5019    for my $index (0 .. $#paragraphs) {
5020        my @paragraph = @{$paragraphs[$index]};
5021
5022        my $pname;
5023
5024        ## Clean paragraph, keep comments
5025        for my $i (0 .. $#paragraph) {
5026            my $changed = undef;
5027            for my $j (0 .. $#paragraph) {
5028                if ($paragraph[$j] =~ /^\s*\#/) {
5029                    chomp($paragraph[$j]);
5030                    push @{$admin{'comment'}}, $paragraph[$j];
5031                    splice @paragraph, $j, 1;
5032                    $changed = 1;
5033                } elsif ($paragraph[$j] =~ /^\s*$/) {
5034                    splice @paragraph, $j, 1;
5035                    $changed = 1;
5036                }
5037
5038                last if $changed;
5039            }
5040
5041            last unless $changed;
5042        }
5043
5044        ## Empty paragraph
5045        next unless ($#paragraph > -1);
5046
5047        ## Look for first valid line
5048        unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) {
5049            $log->syslog('err', 'Bad paragraph "%s" in %s, ignore it',
5050                @paragraph, $config_file);
5051            next;
5052        }
5053
5054        $pname = $1;
5055
5056        # Parameter aliases (compatibility concerns).
5057        my $alias = $pinfo->{$pname}{'obsolete'};
5058        if ($alias and $pinfo->{$alias}) {
5059            $paragraph[0] =~ s/^\s*$pname/$alias/;
5060            $pname = $alias;
5061        }
5062
5063        unless (defined $pinfo->{$pname}) {
5064            $log->syslog('err', 'Unknown parameter "%s" in %s, ignore it',
5065                $pname, $config_file);
5066            next;
5067        }
5068
5069        ## Uniqueness
5070        if (defined $admin{$pname}) {
5071            unless (($pinfo->{$pname}{'occurrence'} eq '0-n')
5072                or ($pinfo->{$pname}{'occurrence'} eq '1-n')) {
5073                $log->syslog('err',
5074                    'Multiple occurrences of a unique parameter "%s" in %s',
5075                    $pname, $config_file);
5076            }
5077        }
5078
5079        ## Line or Paragraph
5080        if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') {
5081            ## This should be a paragraph
5082            unless ($#paragraph > 0) {
5083                $log->syslog(
5084                    'err',
5085                    'Expecting a paragraph for "%s" parameter in %s, ignore it',
5086                    $pname,
5087                    $config_file
5088                );
5089                next;
5090            }
5091
5092            ## Skipping first line
5093            shift @paragraph;
5094
5095            my %hash;
5096            for my $i (0 .. $#paragraph) {
5097                next if ($paragraph[$i] =~ /^\s*\#/);
5098
5099                unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) {
5100                    $log->syslog('err', 'Bad line "%s" in %s',
5101                        $paragraph[$i], $config_file);
5102                }
5103
5104                my $key = $1;
5105
5106                # Subparameter aliases (compatibility concerns).
5107                # Note: subparameter alias was introduced by 6.2.15.
5108                my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'};
5109                if ($alias and $pinfo->{$pname}{'format'}{$alias}) {
5110                    $paragraph[$i] =~ s/^\s*$key/$alias/;
5111                    $key = $alias;
5112                }
5113
5114                unless (defined $pinfo->{$pname}{'file_format'}{$key}) {
5115                    $log->syslog('err',
5116                        'Unknown key "%s" in paragraph "%s" in %s',
5117                        $key, $pname, $config_file);
5118                    next;
5119                }
5120
5121                unless ($paragraph[$i] =~
5122                    /^\s*$key(?:\s+($pinfo->{$pname}{'file_format'}{$key}{'file_format'}))?\s*$/i
5123                ) {
5124                    chomp($paragraph[$i]);
5125                    $log->syslog(
5126                        'err',
5127                        'Bad entry "%s" for key "%s", paragraph "%s" in file "%s"',
5128                        $paragraph[$i],
5129                        $key,
5130                        $pname,
5131                        $config_file
5132                    );
5133                    next;
5134                }
5135
5136                $hash{$key} =
5137                    $self->_load_list_param($key, $1,
5138                    $pinfo->{$pname}{'file_format'}{$key});
5139            }
5140
5141            ## Apply defaults & Check required keys
5142            my $missing_required_field;
5143            foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) {
5144
5145                ## Default value
5146                unless (defined $hash{$k}) {
5147                    if (defined $pinfo->{$pname}{'file_format'}{$k}{'default'}
5148                    ) {
5149                        $hash{$k} = $self->_load_list_param(
5150                            $k,
5151                            $pinfo->{$pname}{'file_format'}{$k}{'default'},
5152                            $pinfo->{$pname}{'file_format'}{$k}
5153                        );
5154                    }
5155                }
5156
5157                ## Required fields
5158                if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1'
5159                    and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) {
5160                    unless (defined $hash{$k}) {
5161                        $log->syslog('info',
5162                            'Missing key "%s" in param "%s" in %s',
5163                            $k, $pname, $config_file);
5164                        $missing_required_field++;
5165                    }
5166                }
5167            }
5168
5169            next if $missing_required_field;
5170
5171            delete $admin{'defaults'}{$pname};
5172
5173            ## Should we store it in an array
5174            if (($pinfo->{$pname}{'occurrence'} =~ /n$/)) {
5175                push @{$admin{$pname}}, \%hash;
5176            } else {
5177                $admin{$pname} = \%hash;
5178            }
5179        } else {
5180            ## This should be a single line
5181            unless ($#paragraph == 0) {
5182                $log->syslog('info',
5183                    'Expecting a single line for "%s" parameter in %s',
5184                    $pname, $config_file);
5185            }
5186
5187            unless ($paragraph[0] =~
5188                /^\s*$pname(?:\s+($pinfo->{$pname}{'file_format'}))?\s*$/i) {
5189                chomp($paragraph[0]);
5190                $log->syslog('info', 'Bad entry "%s" in %s',
5191                    $paragraph[0], $config_file);
5192                next;
5193            }
5194
5195            my $value = $self->_load_list_param($pname, $1, $pinfo->{$pname});
5196
5197            delete $admin{'defaults'}{$pname};
5198
5199            if (($pinfo->{$pname}{'occurrence'} =~ /n$/)
5200                && !(ref($value) =~ /^ARRAY/)) {
5201                push @{$admin{$pname}}, $value;
5202            } else {
5203                $admin{$pname} = $value;
5204            }
5205        }
5206    }
5207
5208    ## Release the lock
5209    unless ($lock_fh->close) {
5210        $log->syslog('err', 'Could not remove the read lock on file %s',
5211            $config_file);
5212        return undef;
5213    }
5214
5215    ## Apply defaults & check required parameters
5216    foreach my $p (keys %$pinfo) {
5217
5218        ## Defaults
5219        unless (defined $admin{$p}) {
5220
5221            ## Simple (versus structured) parameter case
5222            if (defined $pinfo->{$p}{'default'}) {
5223                $admin{$p} =
5224                    $self->_load_list_param($p, $pinfo->{$p}{'default'},
5225                    $pinfo->{$p});
5226
5227                ## Sructured parameters case : the default values are defined
5228                ## at the next level
5229            } elsif ((ref $pinfo->{$p}{'format'} eq 'HASH')
5230                && ($pinfo->{$p}{'occurrence'} =~ /1$/)) {
5231                ## If the paragraph is not defined, try to apply defaults
5232                my $hash;
5233
5234                foreach my $key (keys %{$pinfo->{$p}{'format'}}) {
5235
5236                    ## Skip keys without default value.
5237                    unless (defined $pinfo->{$p}{'format'}{$key}{'default'}) {
5238                        next;
5239                    }
5240
5241                    $hash->{$key} = $self->_load_list_param(
5242                        $key,
5243                        $pinfo->{$p}{'format'}{$key}{'default'},
5244                        $pinfo->{$p}{'format'}{$key}
5245                    );
5246                }
5247
5248                $admin{$p} = $hash if (defined $hash);
5249
5250            }
5251
5252#	    $admin{'defaults'}{$p} = 1;
5253        }
5254
5255        ## Required fields
5256        if (    $pinfo->{$p}{'occurrence'}
5257            and $pinfo->{$p}{'occurrence'} =~ /^1(-n)?$/
5258            and not $pinfo->{$p}{'obsolete'}) {
5259            unless (defined $admin{$p}) {
5260                $log->syslog('info', 'Missing parameter "%s" in %s',
5261                    $p, $config_file);
5262            }
5263        }
5264    }
5265
5266    $self->_load_list_config_postprocess(\%admin);
5267    _load_include_admin_user_postprocess(\%admin);
5268
5269    return \%admin;
5270}
5271
5272# Proprocessing particular parameters.
5273sub _load_list_config_postprocess {
5274    my $self        = shift;
5275    my $config_hash = shift;
5276
5277    ## "Original" parameters
5278    if (defined($config_hash->{'digest'})) {
5279        if ($config_hash->{'digest'} =~ /^(.+)\s+(\d+):(\d+)$/) {
5280            my $digest = {};
5281            $digest->{'hour'}   = $2;
5282            $digest->{'minute'} = $3;
5283            my $days = $1;
5284            $days =~ s/\s//g;
5285            @{$digest->{'days'}} = split /,/, $days;
5286
5287            $config_hash->{'digest'} = $digest;
5288        }
5289    }
5290
5291    # The 'host' parameter is ignored if the list is stored on a
5292    # virtual robot directory.
5293    # $config_hash->{'host'} = $self{'domain'} if ($self{'dir'} ne '.');
5294
5295    if (defined($config_hash->{'custom_subject'})) {
5296        if ($config_hash->{'custom_subject'} =~ /^\s*\[\s*(\w+)\s*\]\s*$/) {
5297            $config_hash->{'custom_subject'} = $1;
5298        }
5299    }
5300
5301    ## Format changed for reply_to parameter
5302    ## New reply_to_header parameter
5303    if ((   $config_hash->{'forced_reply_to'}
5304            && !$config_hash->{'defaults'}{'forced_reply_to'}
5305        )
5306        || ($config_hash->{'reply_to'}
5307            && !$config_hash->{'defaults'}{'reply_to'})
5308    ) {
5309        my ($value, $apply, $other_email);
5310        $value = $config_hash->{'forced_reply_to'}
5311            || $config_hash->{'reply_to'};
5312        $apply = 'forced' if ($config_hash->{'forced_reply_to'});
5313        if ($value =~ /\@/) {
5314            $other_email = $value;
5315            $value       = 'other_email';
5316        }
5317
5318        $config_hash->{'reply_to_header'} = {
5319            'value'       => $value,
5320            'other_email' => $other_email,
5321            'apply'       => $apply
5322        };
5323
5324        ## delete old entries
5325        $config_hash->{'reply_to'}        = undef;
5326        $config_hash->{'forced_reply_to'} = undef;
5327    }
5328
5329    # lang
5330    # canonicalize language
5331    unless ($config_hash->{'lang'} =
5332        Sympa::Language::canonic_lang($config_hash->{'lang'})) {
5333        $config_hash->{'lang'} =
5334            Conf::get_robot_conf($self->{'domain'}, 'lang');
5335    }
5336
5337    ############################################
5338    ## Below are constraints between parameters
5339    ############################################
5340
5341    ## This default setting MUST BE THE LAST ONE PERFORMED
5342    #if ($config_hash->{'status'} ne 'open') {
5343    #    # requested and closed list are just list hidden using visibility
5344    #    # parameter and with send parameter set to closed.
5345    #    $config_hash->{'send'} =
5346    #        $self->_load_list_param('send', 'closed', $pinfo->{'send'});
5347    #    $config_hash->{'visibility'} =
5348    #        $self->_load_list_param('visibility', 'conceal',
5349    #            $pinfo->{'visibility'});
5350    #}
5351
5352    ## reception of default_user_options must be one of reception of
5353    ## available_user_options. If none, warning and put reception of
5354    ## default_user_options in reception of available_user_options
5355    if (!grep (/^$config_hash->{'default_user_options'}{'reception'}$/,
5356            @{$config_hash->{'available_user_options'}{'reception'}})
5357    ) {
5358        push @{$config_hash->{'available_user_options'}{'reception'}},
5359            $config_hash->{'default_user_options'}{'reception'};
5360        $log->syslog(
5361            'info',
5362            'Reception is not compatible between default_user_options and available_user_options in configuration of %s',
5363            $self
5364        );
5365    }
5366}
5367
5368# Proprocessing particular parameters specific to datasources.
5369sub _load_include_admin_user_postprocess {
5370    my $config_hash = shift;
5371
5372    # The include_list was obsoleted by include_sympa_list on 6.2.16.
5373    #FIXME: Existing lists may be checked with looser rule.
5374    if ($config_hash->{'include_list'}) {
5375        my $listname_regex =
5376              Sympa::Regexps::listname() . '(?:\@'
5377            . Sympa::Regexps::host() . ')?';
5378        my $filter_regex = '(' . $listname_regex . ')\s+filter\s+(.+)';
5379
5380        $config_hash->{'include_sympa_list'} ||= [];
5381        foreach my $incl (@{$config_hash->{'include_list'} || []}) {
5382            next unless defined $incl and $incl =~ /\S/;
5383
5384            my ($listname, $filter);
5385            if ($incl =~ /\A$filter_regex/) {
5386                ($listname, $filter) = (lc $1, $2);
5387                undef $filter unless $filter =~ /\S/;
5388            } elsif ($incl =~ /\A$listname_regex\z/) {
5389                $listname = lc $incl;
5390            } else {
5391                $log->syslog(
5392                    'err',
5393                    'Malformed value "%s" in include_list parameter. Skipped',
5394                    $incl
5395                );
5396                next;
5397            }
5398
5399            push @{$config_hash->{'include_sympa_list'}},
5400                {
5401                name     => sprintf('include_list %s', $incl),
5402                listname => $listname,
5403                filter   => $filter,
5404                };
5405        }
5406        delete $config_hash->{'include_list'};
5407        delete $config_hash->{'defaults'}{'include_list'}
5408            if $config_hash->{'defaults'};
5409    }
5410}
5411
5412## Save a config file
5413sub _save_list_config_file {
5414    $log->syslog('debug3', '(%s, %s, %s)', @_);
5415    my $self = shift;
5416    my ($config_file, $old_config_file) = @_;
5417
5418    my $pinfo = Sympa::Robot::list_params($self->{'domain'});
5419
5420    unless (rename $config_file, $old_config_file) {
5421        $log->syslog(
5422            'notice',     'Cannot rename %s to %s',
5423            $config_file, $old_config_file
5424        );
5425        return undef;
5426    }
5427
5428    my $fh_config;
5429    unless (open $fh_config, '>', $config_file) {
5430        $log->syslog('info', 'Cannot open %s', $config_file);
5431        return undef;
5432    }
5433    my $config = '';
5434    my $fd     = IO::Scalar->new(\$config);
5435
5436    foreach my $c (@{$self->{'admin'}{'comment'}}) {
5437        $fd->print(sprintf "%s\n", $c);
5438    }
5439    $fd->print("\n");
5440
5441    foreach my $key (sort _by_order keys %{$self->{'admin'}}) {
5442
5443        next if ($key =~ /^(comment|defaults)$/);
5444        next unless (defined $self->{'admin'}{$key});
5445
5446        ## Multiple parameter (owner, custom_header,...)
5447        if ((ref($self->{'admin'}{$key}) eq 'ARRAY')
5448            && !$pinfo->{$key}{'split_char'}) {
5449            foreach my $elt (@{$self->{'admin'}{$key}}) {
5450                _save_list_param($self->{'domain'}, $key, $elt,
5451                    $self->{'admin'}{'defaults'}{$key}, $fd);
5452            }
5453        } else {
5454            _save_list_param(
5455                $self->{'domain'}, $key,
5456                $self->{'admin'}{$key},
5457                $self->{'admin'}{'defaults'}{$key}, $fd
5458            );
5459        }
5460    }
5461    print $fh_config $config;
5462    close $fh_config;
5463
5464    return 1;
5465}
5466
5467# Is a reception mode in the parameter reception of the available_user_options
5468# section?
5469sub is_available_reception_mode {
5470    my ($self, $mode) = @_;
5471    $mode =~ y/[A-Z]/[a-z]/;
5472
5473    return undef unless ($self && $mode);
5474
5475    my @available_mode =
5476        @{$self->{'admin'}{'available_user_options'}{'reception'}};
5477
5478    foreach my $m (@available_mode) {
5479        if ($m eq $mode) {
5480            return $mode;
5481        }
5482    }
5483
5484    return undef;
5485}
5486
5487# List the parameter reception of the available_user_options section
5488# Note: Since Sympa 6.1.18, this returns an array under array context.
5489sub available_reception_mode {
5490    my $self = shift;
5491    return @{$self->{'admin'}{'available_user_options'}{'reception'} || []}
5492        if wantarray;
5493    return join(' ',
5494        @{$self->{'admin'}{'available_user_options'}{'reception'} || []});
5495}
5496
5497##############################################################################
5498#                       FUNCTIONS FOR MESSAGE TOPICS
5499#                       #
5500##############################################################################
5501#
5502#
5503
5504####################################################
5505# is_there_msg_topic
5506####################################################
5507#  Test if some msg_topic are defined
5508#
5509# IN : -$self (+): ref(List)
5510#
5511# OUT : 1 - some are defined | 0 - not defined
5512####################################################
5513sub is_there_msg_topic {
5514    my ($self) = shift;
5515
5516    if (defined $self->{'admin'}{'msg_topic'}) {
5517        if (ref($self->{'admin'}{'msg_topic'}) eq "ARRAY") {
5518            if ($#{$self->{'admin'}{'msg_topic'}} >= 0) {
5519                return 1;
5520            }
5521        }
5522    }
5523    return 0;
5524}
5525
5526####################################################
5527# is_available_msg_topic
5528####################################################
5529#  Checks for a topic if it is available in the list
5530# (look foreach list parameter msg_topic.name)
5531#
5532# IN : -$self (+): ref(List)
5533#      -$topic (+): string
5534# OUT : -$topic if it is available  | undef
5535####################################################
5536sub is_available_msg_topic {
5537    my ($self, $topic) = @_;
5538
5539    my @available_msg_topic;
5540    foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
5541        return $topic
5542            if ($msg_topic->{'name'} eq $topic);
5543    }
5544
5545    return undef;
5546}
5547
5548####################################################
5549# get_available_msg_topic
5550####################################################
5551#  Return an array of available msg topics (msg_topic.name)
5552#
5553# IN : -$self (+): ref(List)
5554#
5555# OUT : -\@topics : ref(ARRAY)
5556####################################################
5557sub get_available_msg_topic {
5558    my ($self) = @_;
5559
5560    my @topics;
5561    foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
5562        if ($msg_topic->{'name'}) {
5563            push @topics, $msg_topic->{'name'};
5564        }
5565    }
5566
5567    return \@topics;
5568}
5569
5570####################################################
5571# is_msg_topic_tagging_required
5572####################################################
5573# Checks for the list parameter msg_topic_tagging
5574# if it is set to 'required'
5575#
5576# IN : -$self (+): ref(List)
5577#
5578# OUT : 1 - the msg must must be tagged
5579#       | 0 - the msg can be no tagged
5580####################################################
5581sub is_msg_topic_tagging_required {
5582    my ($self) = @_;
5583
5584    if ($self->{'admin'}{'msg_topic_tagging'} =~ /required/) {
5585        return 1;
5586    } else {
5587        return 0;
5588    }
5589}
5590
5591# DEPRECATED.
5592# Use Sympa::Message::compute_topic() and Sympa::Spool::Topic::store() instead.
5593#sub automatic_tag;
5594
5595# Moved to Sympa::Message::compute_topic().
5596#sub compute_topic;
5597
5598# DEPRECATED.  Use Sympa::Spool::Topic::store() instead.
5599#sub tag_topic;
5600
5601# DEPRECATED.  Use Sympa::Spool::Topic::load() instead.
5602#sub load_msg_topic_file;
5603
5604# Moved to _notify_deleted_topic() in wwsympa.fcgi.
5605#sub modifying_msg_topic_for_list_members;
5606
5607####################################################
5608# select_list_members_for_topic
5609####################################################
5610# Select users subscribed to a topic that is in
5611# the topic list incoming when reception mode is 'mail', 'notice', 'not_me',
5612# 'txt' or 'urlize', and the other
5613# subscribers (recpetion mode different from 'mail'), 'mail' and no topic
5614# subscription.
5615# Note: 'html' mode was deprecated as of 6.2.23b.2.
5616#
5617# IN : -$self(+) : ref(List)
5618#      -$string_topic(+) : string splitted by ','
5619#                          topic list
5620#      -$subscribers(+) : ref(ARRAY) - list of subscribers(emails)
5621#
5622# OUT : @selected_users
5623#
5624#
5625####################################################
5626sub select_list_members_for_topic {
5627    my ($self, $string_topic, $subscribers) = @_;
5628    $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $string_topic);
5629
5630    my @selected_users;
5631    my $msg_topics;
5632
5633    if ($string_topic) {
5634        $msg_topics =
5635            Sympa::Tools::Data::get_array_from_splitted_string($string_topic);
5636    }
5637
5638    foreach my $user (@$subscribers) {
5639
5640        # user topic
5641        my $info_user = $self->get_list_member($user);
5642
5643        if ($info_user->{'reception'} !~
5644            /^(mail|notice|not_me|txt|html|urlize)$/i) {
5645            push @selected_users, $user;
5646            next;
5647        }
5648        unless ($info_user->{'topics'}) {
5649            push @selected_users, $user;
5650            next;
5651        }
5652        my $user_topics = Sympa::Tools::Data::get_array_from_splitted_string(
5653            $info_user->{'topics'});
5654
5655        if ($string_topic) {
5656            my $result =
5657                Sympa::Tools::Data::diff_on_arrays($msg_topics, $user_topics);
5658            if ($#{$result->{'intersection'}} >= 0) {
5659                push @selected_users, $user;
5660            }
5661        } else {
5662            my $result =
5663                Sympa::Tools::Data::diff_on_arrays(['other'], $user_topics);
5664            if ($#{$result->{'intersection'}} >= 0) {
5665                push @selected_users, $user;
5666            }
5667        }
5668    }
5669    return @selected_users;
5670}
5671
5672#
5673#
5674#
5675### END - functions for message topics ###
5676
5677# DEPRECATED.  Use Sympa::Spool::Auth::store().
5678#sub store_subscription_request;
5679
5680# DEPRECATED.  Use Sympa::Spool::Auth::next().
5681#sub get_subscription_requests;
5682
5683# DEPRECATED.  Use Sympa::Spool::Auth::size().
5684#sub get_subscription_request_count;
5685
5686# DEPRECATED.  Use Sympa::Spool::Auth::remove().
5687#sub delete_subscription_request;
5688
5689# OBSOLETED: Use Sympa::WWW::SharedDocument::get_size().
5690#sub get_shared_size;
5691
5692# OBSOLETED: Use Sympa::Archive::get_size().
5693#sub get_arc_size;
5694
5695# return the date epoch for next delivery planified for a list
5696# Note: As of 6.2a.41, returns undef if parameter is not set or invalid.
5697#       Previously it returned current time.
5698sub get_next_delivery_date {
5699    my $self = shift;
5700
5701    my $dtime = $self->{'admin'}{'delivery_time'};
5702    return undef unless $dtime;
5703    my ($h, $m) = split /:/, $dtime, 2;
5704    return undef unless $h == 24 and $m == 0 or $h <= 23 and $m <= 60;
5705
5706    my $date = time();
5707    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
5708        localtime($date);
5709
5710    my $plannified_time = (($h * 60) + $m) * 60;    # plannified time in sec
5711    my $now_time =
5712        ((($hour * 60) + $min) * 60) + $sec;    # Now #sec since to day 00:00
5713
5714    my $result = $date - $now_time + $plannified_time;
5715    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
5716        localtime($result);
5717
5718    if ($now_time <= $plannified_time) {
5719        return ($date - $now_time + $plannified_time);
5720    } else {
5721        # plannified time is past so report to tomorrow
5722        return ($date - $now_time + $plannified_time + (24 * 3600));
5723    }
5724}
5725
5726#sub search_datasource;
5727# -> No longer used.
5728#sub get_datasource_name;
5729# -> No longer used.
5730#sub add_source_id;
5731# -> No longer used.
5732
5733## Remove a task in the tasks spool
5734# No longer used.
5735#sub remove_task;
5736
5737# Deprecated. Use Sympa::Request::Handler::close_list handler.
5738#sub close_list;
5739
5740## Remove the list
5741# Deprecated. Use Sympa::Request::Handler::close_list handler.
5742#sub purge;
5743
5744## Remove list aliases
5745# Deprecated. Use Sympa::Aliases::del().
5746#sub remove_aliases;
5747
5748# Moved: use Sympa::Spindle::ProcessTask::_remove_bouncers().
5749#sub remove_bouncers;
5750
5751# Moved: Use Sympa::Spindle::ProcessTask::_notify_bouncers().
5752#sub notify_bouncers;
5753
5754# DDEPRECATED: Use Sympa::WWW::SharedDocument::create().
5755#sub create_shared;
5756
5757# Check if a list has data sources
5758# Old name: Sympa::List::has_include_data_sources(), without $role parameter.
5759sub has_data_sources {
5760    my $self = shift;
5761    my $role = shift;
5762
5763    my @parameters;
5764    if (not $role or $role eq 'member') {
5765        push @parameters, @sources_providing_listmembers, 'member_include';
5766    }
5767    if (not $role or $role eq 'owner') {
5768        push @parameters, 'owner_include';
5769    }
5770    if (not $role or $role eq 'editor') {
5771        push @parameters, 'editor_include';
5772    }
5773
5774    foreach my $type (@parameters) {
5775        my $resource = $self->{'admin'}{$type} || [];
5776        return 1 if ref $resource eq 'ARRAY' and @$resource;
5777    }
5778
5779    return 0;
5780}
5781
5782sub has_included_users {
5783    my $self = shift;
5784    my $role = shift;
5785
5786    my $sdm = Sympa::DatabaseManager->instance;
5787    my $sth;
5788    if (not $role or $role eq 'member') {
5789        unless (
5790            $sdm and $sth = $sdm->do_prepared_query(
5791                q{SELECT COUNT(*)
5792                  FROM subscriber_table
5793                  WHERE list_subscriber = ? AND robot_subscriber = ? AND
5794                        inclusion_subscriber IS NOT NULL},
5795                $self->{'name'}, $self->{'domain'}
5796            )
5797        ) {
5798            return undef;
5799        }
5800        my ($count) = $sth->fetchrow_array;
5801        return 1 if $count;
5802    }
5803    if (not $role or $role ne 'member') {
5804        unless (
5805            $sdm and $sth = $sdm->do_prepared_query(
5806                q{SELECT COUNT(*)
5807                  FROM admin_table
5808                  WHERE list_admin = ? AND robot_admin = ? AND
5809                        inclusion_admin IS NOT NULL AND
5810                        (role_admin = ? OR role_admin = ?)},
5811                $self->{'name'}, $self->{'domain'},
5812                ($role || 'owner'), ($role || 'editor')
5813            )
5814        ) {
5815            return undef;
5816        }
5817        my ($count) = $sth->fetchrow_array;
5818        return 1 if $count;
5819    }
5820
5821    return 0;
5822}
5823
5824# move a message to a queue or distribute spool
5825#DEPRECATED: No longer used.
5826# Use Sympa::Spool::XXX::store() (and Sympa::Spool::XXX::remove()).
5827sub move_message {
5828    my ($self, $file, $queue) = @_;
5829    $log->syslog('debug2', '(%s, %s, %s)', $file, $self->{'name'}, $queue);
5830
5831    my $dir = $queue || (Sympa::Constants::SPOOLDIR() . '/distribute');
5832    my $filename = $self->get_id . '.' . time . '.' . (int rand 999);
5833
5834    unless (open OUT, ">$dir/T.$filename") {
5835        $log->syslog('err', 'Cannot create file %s', "$dir/T.$filename");
5836        return undef;
5837    }
5838
5839    unless (open IN, $file) {
5840        $log->syslog('err', 'Cannot open file %s', $file);
5841        return undef;
5842    }
5843
5844    print OUT <IN>;
5845    close IN;
5846    close OUT;
5847    unless (rename "$dir/T.$filename", "$dir/$filename") {
5848        $log->syslog(
5849            'err',              'Cannot rename file %s into %s',
5850            "$dir/T.$filename", "$dir/$filename"
5851        );
5852        return undef;
5853    }
5854    return 1;
5855}
5856
5857# New in 6.2.13.
5858sub get_archive_dir {
5859    my $self = shift;
5860
5861    my $arc_dir = Conf::get_robot_conf($self->{'domain'}, 'arc_path');
5862    die sprintf
5863        'Robot %s has no archives directory. Check arc_path parameter in this robot.conf and in sympa.conf',
5864        $self->{'domain'}
5865        unless $arc_dir;
5866    return $arc_dir . '/' . $self->get_id;
5867}
5868
5869# Return the path to the list bounce directory, where bounces are stored.
5870sub get_bounce_dir {
5871    my $self = shift;
5872
5873    my $root_dir = Conf::get_robot_conf($self->{'domain'}, 'bounce_path');
5874    return $root_dir . '/' . $self->get_id;
5875}
5876
5877# New in 6.2.13.
5878sub get_digest_spool_dir {
5879    my $self = shift;
5880
5881    my $spool_dir = $Conf::Conf{'queuedigest'};
5882    return $spool_dir . '/' . $self->get_id;
5883}
5884
5885# OBSOLETED. Merged into Sympa::get_address().
5886sub get_list_address {
5887    goto &Sympa::get_address;    # "&" is required.
5888}
5889
5890sub get_bounce_address {
5891    my $self = shift;
5892    my $who  = shift;
5893    my @opts = @_;
5894
5895    my $escwho = $who;
5896    $escwho =~ s/\@/==a==/;
5897
5898    return sprintf('%s+%s@%s',
5899        $Conf::Conf{'bounce_email_prefix'},
5900        join('==', $escwho, $self->{'name'}, @opts),
5901        $self->{'domain'});
5902}
5903
5904sub get_id {
5905    my $self = shift;
5906
5907    return '' unless $self->{'name'} and $self->{'domain'};
5908    return $self->{'name'} . '@' . $self->{'domain'};
5909}
5910
5911# OBSOLETED: use get_id()
5912sub get_list_id { shift->get_id }
5913
5914sub add_list_header {
5915    my $self    = shift;
5916    my $message = shift;
5917    my $field   = shift;
5918    my %options = @_;
5919
5920    my $robot = $self->{'domain'};
5921
5922    if ($field eq 'id') {
5923        $message->add_header('List-Id',
5924            sprintf('<%s.%s>', $self->{'name'}, $self->{'domain'}));
5925    } elsif ($field eq 'help') {
5926        $message->add_header(
5927            'List-Help',
5928            sprintf(
5929                '<%s>',
5930                Sympa::Tools::Text::mailtourl(
5931                    Sympa::get_address($self, 'sympa'),
5932                    query => {subject => 'help'}
5933                )
5934            )
5935        );
5936    } elsif ($field eq 'unsubscribe') {
5937        $message->add_header(
5938            'List-Unsubscribe',
5939            sprintf(
5940                '<%s>',
5941                Sympa::Tools::Text::mailtourl(
5942                    Sympa::get_address($self, 'sympa'),
5943                    query => {
5944                        subject => sprintf('unsubscribe %s', $self->{'name'})
5945                    }
5946                )
5947            )
5948        );
5949    } elsif ($field eq 'subscribe') {
5950        $message->add_header(
5951            'List-Subscribe',
5952            sprintf(
5953                '<%s>',
5954                Sympa::Tools::Text::mailtourl(
5955                    Sympa::get_address($self, 'sympa'),
5956                    query =>
5957                        {subject => sprintf('subscribe %s', $self->{'name'})}
5958                )
5959            )
5960        );
5961    } elsif ($field eq 'post') {
5962        $message->add_header(
5963            'List-Post',
5964            sprintf('<%s>',
5965                Sympa::Tools::Text::mailtourl(Sympa::get_address($self)))
5966        );
5967    } elsif ($field eq 'owner') {
5968        $message->add_header(
5969            'List-Owner',
5970            sprintf(
5971                '<%s>',
5972                Sympa::Tools::Text::mailtourl(
5973                    Sympa::get_address($self, 'owner')
5974                )
5975            )
5976        );
5977    } elsif ($field eq 'archive') {
5978        if (Conf::get_robot_conf($robot, 'wwsympa_url')
5979            and $self->is_web_archived()) {
5980            $message->add_header('List-Archive',
5981                sprintf('<%s>', Sympa::get_url($self, 'arc')));
5982        } else {
5983            return 0;
5984        }
5985    } elsif ($field eq 'archived_at') {
5986        if (Conf::get_robot_conf($robot, 'wwsympa_url')
5987            and $self->is_web_archived()) {
5988            # Use possiblly anonymized Message-Id: field instead of
5989            # {message_id} attribute.
5990            my $message_id = Sympa::Tools::Text::canonic_message_id(
5991                $message->get_header('Message-Id'));
5992
5993            my $arc;
5994            if (defined $options{arc} and length $options{arc}) {
5995                $arc = $options{arc};
5996            } else {
5997                my @now = localtime time;
5998                $arc = sprintf '%04d-%02d', 1900 + $now[5], $now[4] + 1;
5999            }
6000            $message->add_header(
6001                'Archived-At',
6002                sprintf(
6003                    '<%s>',
6004                    Sympa::get_url(
6005                        $self, 'arcsearch_id',
6006                        paths => [$arc, $message_id]
6007                    )
6008                )
6009            );
6010        } else {
6011            return 0;
6012        }
6013    } else {
6014        die sprintf 'Unknown field "%s".  Ask developer', $field;
6015    }
6016
6017    return 1;
6018}
6019
6020# connect to stat_counter_table and extract data.
6021# DEPRECATED: No longer used.
6022#sub get_data;
6023
6024sub _update_list_db {
6025    my ($self) = shift;
6026    my @admins;
6027    my $i;
6028    my $adm_txt;
6029    my $ed_txt;
6030
6031    my $name = $self->{'name'};
6032    my $searchkey =
6033        Sympa::Tools::Text::clip(
6034        Sympa::Tools::Text::foldcase($self->{'admin'}{'subject'} // ''), 255);
6035    my $status = $self->{'admin'}{'status'};
6036    my $robot  = $self->{'domain'};
6037
6038    my $family = $self->{'admin'}{'family_name'};
6039    $family = undef unless defined $family and length $family;
6040
6041    my $web_archive = $self->is_web_archived ? 1 : 0;
6042    my $topics = join ',',
6043        grep { defined $_ and length $_ and $_ ne 'others' }
6044        @{$self->{'admin'}{'topics'} || []};
6045    $topics = ",$topics," if length $topics;
6046
6047    my $creation_epoch = $self->{'admin'}{'creation'}->{'date_epoch'};
6048    my $creation_email = $self->{'admin'}{'creation'}->{'email'};
6049    my $update_epoch   = $self->{'admin'}{'update'}->{'date_epoch'};
6050    my $update_email   = $self->{'admin'}{'update'}->{'email'};
6051# This may be added too.
6052#     my $latest_instantiation_epoch =
6053#         $self->{'admin'}{'latest_instantiation'}->{'date_epoch'};
6054#     my $latest_instantiation_email =
6055#         $self->{'admin'}{'latest_instantiation'}->{'email'};
6056
6057# Not yet implemented.
6058#     eval { $config = Storable::nfreeze($self->{'admin'}); };
6059#     if ($@) {
6060#         $log->syslog('err',
6061#             'Failed to save the config to database. error: %s', $@);
6062#         return undef;
6063#     }
6064
6065    push @sth_stack, $sth;
6066    my $sdm = Sympa::DatabaseManager->instance;
6067
6068    # update database cache
6069    # try INSERT then UPDATE
6070    unless (
6071        $sdm
6072        and $sth = $sdm->do_prepared_query(
6073            q{UPDATE list_table
6074              SET status_list = ?, name_list = ?, robot_list = ?,
6075                  family_list = ?,
6076                  creation_epoch_list = ?, creation_email_list = ?,
6077                  update_epoch_list = ?, update_email_list = ?,
6078                  searchkey_list = ?, web_archive_list = ?, topics_list = ?
6079              WHERE robot_list = ? AND name_list = ?},
6080            $status, $name, $robot,
6081            $family,
6082            $creation_epoch, $creation_email,
6083            $update_epoch,   $update_email,
6084            $searchkey, $web_archive, $topics,
6085            $robot,     $name
6086        )
6087        and $sth->rows
6088        or $sth = $sdm->do_prepared_query(
6089            q{INSERT INTO list_table
6090              (status_list, name_list, robot_list, family_list,
6091               creation_epoch_list, creation_email_list,
6092               update_epoch_list, update_email_list,
6093               searchkey_list, web_archive_list, topics_list)
6094              VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)},
6095            $status,         $name, $robot, $family,
6096            $creation_epoch, $creation_email,
6097            $update_epoch,   $update_email,
6098            $searchkey, $web_archive, $topics
6099        )
6100        and $sth->rows
6101    ) {
6102        $log->syslog('err', 'Unable to update list %s in database', $self);
6103        $sth = pop @sth_stack;
6104        return undef;
6105    }
6106
6107    # If inclusion settings do no longer exist, inclusion_table won't be
6108    # sync'ed anymore.  Rows left behind should be removed.
6109    foreach my $role (qw(member owner editor)) {
6110        unless ($self->has_data_sources($role)) {
6111            $sdm and $sdm->do_prepared_query(
6112                q{DELETE FROM inclusion_table
6113                  WHERE target_inclusion = ? AND role_inclusion = ?},
6114                $self->get_id, $role
6115            );
6116        }
6117    }
6118
6119    $sth = pop @sth_stack;
6120
6121    return 1;
6122}
6123
6124sub _flush_list_db {
6125    my $listname = shift;
6126
6127    my $sth;
6128    my $sdm = Sympa::DatabaseManager->instance;
6129    unless ($listname) {
6130        # Do DELETE because SQLite does not have TRUNCATE TABLE.
6131        $sth = $sdm->do_prepared_query('DELETE FROM list_table');
6132    } else {
6133        $sth = $sdm->do_prepared_query(
6134            q{DELETE FROM list_table
6135              WHERE name_list = ?}, $listname
6136        );
6137    }
6138
6139    unless ($sth) {
6140        $log->syslog('err', 'Unable to flush lists table');
6141        return undef;
6142    }
6143}
6144
6145# Moved to Sympa::ListOpt::get_title().
6146#sub get_option_title;
6147
6148# Return a hash from the edit_list_conf file.
6149# Old name: tools::load_edit_list_conf().
6150sub _load_edit_list_conf {
6151    $log->syslog('debug2', '(%s, %s => %s)', @_);
6152    my $self    = shift;
6153    my %options = @_;
6154
6155    my $robot = $self->{'domain'};
6156
6157    my $pinfo = {
6158        %{Sympa::Robot::list_params($self->{'domain'})},
6159        %Sympa::ListDef::user_info
6160    };
6161
6162    # Load edit_list.conf: Track by file, not domain (file may come from
6163    # server, robot, family or list context).
6164    my $last_path_config  = $self->{_path}{edit_list} // '';
6165    my $path_config       = Sympa::search_fullpath($self, 'edit_list.conf');
6166    my $last_mtime_config = $self->{_mtime}{edit_list} // POSIX::INT_MIN();
6167    my $mtime_config      = Sympa::Tools::File::get_mtime($path_config);
6168    return
6169           unless $options{reload_config}
6170        or not $self->{_edit_list}
6171        or $last_path_config ne $path_config
6172        or $last_mtime_config < $mtime_config;
6173
6174    my $fh;
6175    unless (open $fh, '<', $path_config) {
6176        $log->syslog('err', 'Unable to open config file %s: %m',
6177            $path_config);
6178        $self->{_edit_list} = {};
6179        return;
6180    }
6181
6182    my $conf;
6183    my $error_in_conf;
6184    my $role_re =
6185        qr'(?:listmaster|privileged_owner|owner|editor|subscriber|default)'i;
6186    my $priv_re = qr'(?:read|write|hidden)'i;
6187    my $line_re =
6188        qr/\A\s*(\S+)\s+($role_re(?:\s*,\s*$role_re)*)\s+($priv_re)\s*\z/i;
6189    foreach my $line (<$fh>) {
6190        next unless $line =~ /\S/;
6191        next if $line =~ /\A\s*#/;
6192        chomp $line;
6193
6194        if ($line =~ /$line_re/) {
6195            my ($param, $role, $priv) = ($1, $2, $3);
6196
6197            # Resolve alias.
6198            my $key;
6199            ($param, $key) = split /[.]/, $param, 2;
6200            if ($pinfo->{$param}) {
6201                my $alias = $pinfo->{$param}{obsolete};
6202                if ($alias and $pinfo->{$alias}) {
6203                    $param = $alias;
6204                }
6205                if (    $key
6206                    and ref $pinfo->{$param}{'format'} eq 'HASH'
6207                    and $pinfo->{$param}{'format'}{$key}) {
6208                    my $alias = $pinfo->{$param}{'format'}{$key}{obsolete};
6209                    if ($alias and $pinfo->{$param}{'format'}{$alias}) {
6210                        $key = $alias;
6211                    }
6212                }
6213            }
6214            $param = $param . '.' . $key if $key;
6215
6216            my @roles = split /\s*,\s*/, $role;
6217            foreach my $r (@roles) {
6218                $r =~ s/^\s*(\S+)\s*$/$1/;
6219                if ($r eq 'default') {
6220                    $error_in_conf = 1;
6221                    $log->syslog('notice', '"default" is no more recognised');
6222                    foreach my $set (qw(owner privileged_owner listmaster)) {
6223                        $conf->{$param}{$set} = $priv;
6224                    }
6225                    next;
6226                }
6227                $conf->{$param}{$r} = $priv;
6228            }
6229        } else {
6230            $log->syslog('info', 'Unknown parameter in %s (Ignored): %s',
6231                $path_config, $line);
6232            next;
6233        }
6234    }
6235
6236    if ($error_in_conf) {
6237        Sympa::send_notify_to_listmaster($robot, 'edit_list_error',
6238            [$path_config]);
6239    }
6240
6241    close $fh;
6242
6243    $self->{_path}{edit_list}  = $path_config;
6244    $self->{_mtime}{edit_list} = $mtime_config;
6245    $self->{_edit_list}        = $conf;
6246}
6247
6248###### END of the List package ######
6249
62501;
6251
6252__END__
6253
6254=encoding utf-8
6255
6256=head1 NAME
6257
6258Sympa::List - Mailing list
6259
6260=head1 DESCRIPTION
6261
6262L<Sympa::List> represents the mailing list on Sympa.
6263
6264=head2 Methods
6265
6266=over
6267
6268=item new( $name, [ $domain [ {options...} ] ] )
6269
6270I<Constructor>.
6271Creates a new object which will be used for a list and
6272eventually loads the list if a name is given. Returns
6273a List object.
6274
6275Parameters
6276
6277FIXME @todo doc
6278
6279=item add_list_admin ( ROLE, USERS, ... )
6280
6281Adds a new admin user to the list. May overwrite existing
6282entries.
6283
6284=item add_list_header ( $message, $field_type )
6285
6286FIXME @todo doc
6287
6288=item add_list_member ( USER, HASHPTR )
6289
6290Adds a new user to the list. May overwrite existing
6291entries.
6292
6293=item available_reception_mode ( )
6294
6295I<Instance method>.
6296FIXME @todo doc
6297
6298Note: Since Sympa 6.1.18, this returns an array under array context.
6299
6300=item delete_list_admin ( ROLE, ARRAY )
6301
6302Delete the indicated admin user with the predefined role from the list.
6303ROLE may be C<'owner'> or C<'editor'>.
6304
6305=item delete_list_member ( ARRAY )
6306
6307Delete the indicated users from the list.
6308
6309=item delete_list_member_picture ( $email )
6310
6311Deletes a member's picture file.
6312
6313=item destroy_multiton ( )
6314I<Instance method>.
6315Destroy multiton instance. FIXME
6316
6317=item dump_users ( ROLE )
6318
6319Dump user information in user store into file C<I<$role>.dump> under
6320list directory. ROLE may be C<'member'>, C<'owner'> or C<'editor'>.
6321
6322=item find_picture_filenames ( $email )
6323
6324Returns the type of a pictures according to the user.
6325
6326=item find_picture_paths ( )
6327
6328I<Instance method>.
6329FIXME @todo doc
6330
6331=item find_picture_url ( $email )
6332
6333Find pictures URL
6334
6335=item get_admins ( $role, [ filter =E<gt> \@filters ] )
6336
6337I<Instance method>.
6338Gets users of the list with one of following roles.
6339
6340=over
6341
6342=item C<actual_editor>
6343
6344Editors belonging to the list.
6345If there are no such users, owners of the list.
6346
6347=item C<editor>
6348
6349Editors belonging to the list.
6350
6351=item C<owner>
6352
6353Owners of the list.
6354
6355=item C<privileged_owner>
6356
6357Owners whose C<profile> attribute is C<privileged>.
6358
6359=item C<receptive_editor>
6360
6361Editors belonging to the list and whose reception mode is C<mail>.
6362If there are no such users, owners whose reception mode is C<mail>.
6363
6364=item C<receptive_owner>
6365
6366Owners whose reception mode is C<mail>.
6367
6368=back
6369
6370Optional filter may be:
6371
6372=over
6373
6374=item [email =E<gt> $email]
6375
6376Limit result to the user with their e-mail $email.
6377
6378=back
6379
6380Returns:
6381
6382In array context, returns (possiblly empty or single-item) array of users.
6383In scalar context, returns reference to it.
6384In case of database error, returns empty array or undefined value.
6385
6386=item get_admins_email ( $role )
6387
6388I<Instance method>.
6389Gets an array of emails of list admins with role
6390C<receptive_editor>, C<actual_editor>, C<receptive_owner> or C<owner>.
6391
6392=item get_archive_dir ( )
6393
6394I<Instance method>.
6395FIXME @todo doc
6396
6397=item get_available_msg_topic ( )
6398
6399I<Instance method>.
6400FIXME @todo doc
6401
6402=item get_bounce_address ( WHO, [ OPTS, ... ] )
6403
6404Return the VERP address of the list for the user WHO.
6405
6406FIXME: VERP addresses have the name of originating robot, not mail host.
6407
6408=item get_bounce_dir ( )
6409
6410I<Instance method>.
6411FIXME @todo doc
6412
6413=item get_cert ( )
6414
6415I<Instance method>.
6416FIXME @todo doc
6417
6418=item get_config_changes ( )
6419
6420I<Instance method>.
6421FIXME @todo doc
6422
6423=item get_cookie ()
6424
6425Returns the cookie for a list, if available.
6426
6427=item get_current_admins ( ... )
6428
6429I<Instance method>.
6430FIXME @todo doc
6431
6432=item get_default_user_options ()
6433
6434Returns a default option of the list for subscription.
6435
6436=item get_first_list_member ()
6437
6438Returns a hash to the first user on the list.
6439
6440=item get_id ( )
6441
6442Return the list ID, different from the list address (uses the robot name)
6443
6444=item get_including_lists ( $role )
6445
6446I<Instance method>.
6447List of lists including specified list and hosted by a whole site.
6448
6449Parameter:
6450
6451=over
6452
6453=item $role
6454
6455Role of included users.
6456C<'member'>, C<'owner'> or C<'editor'>.
6457
6458=back
6459
6460Returns:
6461
6462Arrayref of <Sympa::List> instances.
6463Return C<undef> on failure.
6464
6465=item get_list_member ( USER )
6466
6467Returns a subscriber of the list.
6468
6469=item get_max_size ()
6470
6471Returns the maximum allowed size for a message.
6472
6473=item get_members ( $role, [ offset => $offset ], [ order => $order ],
6474[ limit => $limit ])
6475
6476I<Instance method>.
6477Gets users of the list with one of following roles.
6478
6479=over
6480
6481=item C<member>
6482
6483Members of the list, either subscribed or included.
6484
6485=item C<unconcealed_member>
6486
6487Members whose C<visibility> property is not C<conceal>.
6488
6489=back
6490
6491Optional parameters:
6492
6493=over
6494
6495=item limit => $limit
6496
6497=item offset => $offset
6498
6499=item order => $order
6500
6501TBD.
6502
6503=back
6504
6505Returns:
6506
6507In array context, returns (possiblly empty or single-item) array of users.
6508In scalar context, returns reference to it.
6509In case of database error, returns empty array or undefined value.
6510
6511=item get_msg_count ( )
6512
6513I<Instance method>.
6514Returns the number of messages sent to the list.
6515FIXME
6516
6517=item get_next_bouncing_list_member ( )
6518
6519I<Instance method>.
6520Loop for all subsequent bouncing users.
6521FIXME
6522
6523=item get_next_delivery_date ( )
6524
6525I<Instance method>.
6526Returns the date epoch for next delivery planned for a list.
6527
6528Note: As of 6.2a.41, returns C<undef> if parameter is not set or invalid.
6529Previously it returned current time.
6530
6531=item get_next_list_member ()
6532
6533Returns a hash to the next users, until we reach the end of
6534the list.
6535
6536=item get_param_value ( $param, [ $as_arrayref ] )
6537
6538I<instance method>.
6539Returns the list parameter value.
6540the parameter is simple (I<name>) or composed (I<name>C<.>I<minor>)
6541the value is a scalar or a ref on an array of scalar
6542(for parameter digest : only for days).
6543
6544=item get_picture_path ( )
6545
6546I<Instance method>.
6547FIXME
6548
6549=item get_recipients_per_mode ( )
6550
6551I<Instance method>.
6552FIXME @todo doc
6553
6554=item get_reply_to ()
6555
6556Returns an array with the Reply-To values.
6557
6558=item get_resembling_members ( $role, $searchkey )
6559
6560I<instance method>.
6561TBD.
6562
6563=item get_stats ( )
6564
6565Returns array of the statistics.
6566
6567=item get_total ( [ 'nocache' ] )
6568
6569Returns the number of subscribers to the list.
6570
6571=item get_total_bouncing ( )
6572
6573I<Instance method>.
6574Gets total number of bouncing subscribers.
6575
6576=item has_data_sources ( )
6577
6578I<Instance method>.
6579Checks if a list has data sources.
6580
6581=item has_included_users ( $role )
6582
6583I<Instance method>.
6584FIXME @todo doc
6585
6586=item insert_delete_exclusion ( $email, C<"insert">|C<"delete"> )
6587
6588I<Instance method>.
6589Update the exclusion table.
6590FIXME @todo doc
6591
6592=item is_admin ( $role, $user )
6593
6594I<Instance method>.
6595Returns true if $user has $role
6596(C<privileged_owner>, C<owner>, C<actual_editor> or C<editor>) on the list.
6597
6598=item is_archived ()
6599
6600Returns true is the list is configured to keep archives of
6601its messages.
6602
6603=item is_archiving_enabled ( )
6604
6605Returns true is the list is configured to keep archives of
6606its messages, i.e. process_archive parameter is set to "on".
6607
6608=item is_available_msg_topic ( $topic )
6609
6610I<Instance method>.
6611Checks for a topic if it is available in the list
6612(look for each list parameter C<msg_topic.name>).
6613
6614=item is_available_reception_mode ( $mode )
6615
6616I<Instance method>.
6617Is a reception mode in the parameter reception of the available_user_options
6618section?
6619
6620=item is_digest ( )
6621
6622I<Instance method>.
6623Does the list support digest mode?
6624
6625=item is_included ( )
6626
6627Returns true value if the list is included in another list(s).
6628
6629=item is_list_member ( USER )
6630
6631Returns true if the indicated user is member of the list.
6632
6633=item is_member_excluded ( $email )
6634
6635I<Instance method>.
6636FIXME @todo doc
6637
6638=item is_moderated ()
6639
6640Returns true if the list is moderated.
6641FIXME this may not be useful.
6642
6643=item is_msg_topic_tagging_required ( )
6644
6645I<Instance method>.
6646Checks for the list parameter msg_topic_tagging
6647if it is set to 'required'.
6648
6649=item is_there_msg_topic ( )
6650
6651I<Instance method>.
6652Tests if some msg_topic are defined.
6653
6654=item is_web_archived ( )
6655
6656I<Instance method>.
6657Is the list web archived?
6658
6659FIXME: Broken. Use scenario or is_archiving_enabled().
6660
6661=item load ( )
6662
6663Loads the indicated list into the object.
6664
6665=item load_data_sources_list ( $robot )
6666
6667I<Instance method>.
6668Loads all data sources.
6669FIXME: Used only in wwsympa.fcgi.
6670
6671=item may_edit ( $param, $who, [ options, ... ] )
6672
6673I<Instance method>.
6674May the indicated user edit the indicated list parameter or not?
6675FIXME @todo doc
6676
6677=item parse_list_member_bounce ( $user )
6678
6679I<Instance method>.
6680FIXME @todo doc
6681
6682=item restore_suspended_subscription ( $email )
6683
6684I<Instance method>.
6685FIXME @todo doc
6686
6687=item restore_users ( ROLE )
6688
6689Import user information into user store from file C<I<$role>.dump> under
6690list directory. ROLE may be C<'member'>, C<'owner'> or C<'editor'>.
6691
6692=item save_config ( LIST )
6693
6694Saves the indicated list object to the disk files.
6695
6696=item search_list_among_robots ( $listname )
6697
6698I<Instance method>.
6699FIXME @todo doc
6700
6701=item select_list_members_for_topic ( $topic, \@emails )
6702
6703I<Instance method>.
6704FIXME @todo doc
6705
6706=item send_notify_to_owner ( $operation, $params )
6707
6708I<Instance method>.
6709FIXME @todo doc
6710
6711=item send_probe_to_user ( $type, $who )
6712
6713I<Instance method>.
6714FIXME @todo doc
6715
6716=item set_status_error_config ( $msg, parameters, ... )
6717
6718I<Instance method>.
6719FIXME @todo doc
6720
6721=item suspend_subscription ( $email, $list, $data, $robot )
6722
6723I<Function>.
6724FIXME This should be a instance method.
6725FIXME @todo doc
6726
6727=item sync_include ( $role, options... )
6728
6729I<Instance method>.
6730FIXME would be obsoleted.
6731FIXME @todo doc
6732
6733=item update_config_changes ( )
6734
6735I<Instance method>.
6736FIXME @todo doc
6737
6738=item update_list_admin ( USER, ROLE, HASHPTR )
6739
6740Sets the new values given in the hash for the admin user.
6741
6742=item update_list_member ( $email, key =E<gt> value, ... )
6743
6744I<Instance method>.
6745Sets the new values given in the pairs for the user.
6746
6747=item update_stats ( count, [ sent, bytes, sent_by_bytes ] )
6748
6749Updates the stats, argument is number of bytes, returns list fo the updated
6750values.  Returns zeroes if failed.
6751
6752=back
6753
6754=head2 Functions
6755
6756=over
6757
6758=item get_lists ( [ $that, [ options, ... ] ] )
6759
6760I<Function>.
6761List of lists hosted by a family, a robot or whole site.
6762
6763=over 4
6764
6765=item $that
6766
6767Robot, Sympa::Family object or site (default).
6768
6769=item options, ...
6770
6771Hash including options passed to Sympa::List->new() (see load()) and any of
6772following pairs:
6773
6774=over 4
6775
6776=item C<'filter' =E<gt> [ KEYS =E<gt> VALS, ... ]>
6777
6778Filter with list profiles.  When any of items specified by KEYS
6779(separated by C<"|">) have any of values specified by VALS,
6780condition by that pair is satisfied.
6781KEYS prefixed by C<"!"> mean negated condition.
6782Only lists satisfying all conditions of query are returned.
6783Currently available keys and values are:
6784
6785=over 4
6786
6787=item 'creation' => TIME
6788
6789=item 'creation<' => TIME
6790
6791=item 'creation>' => TIME
6792
6793Creation date is equal to, earlier than or later than the date (UNIX time).
6794
6795=item 'member' => EMAIL
6796
6797=item 'owner' => EMAIL
6798
6799=item 'editor' => EMAIL
6800
6801Specified user is a subscriber, owner or editor of the list.
6802
6803=item 'name' => STRING
6804
6805=item 'name%' => STRING
6806
6807=item '%name%' => STRING
6808
6809Exact, prefixed or substring match against list name,
6810case-insensitive.
6811
6812=item 'status' => "STATUS|..."
6813
6814Status of list.  One of 'open', 'closed', 'pending',
6815'error_config' and 'family_closed'.
6816
6817=item 'subject' => STRING
6818
6819=item 'subject%' => STRING
6820
6821=item '%subject%' => STRING
6822
6823Exact, prefixed or substring match against list subject,
6824case-insensitive (case folding is Unicode-aware).
6825
6826=item 'topics' => "TOPIC|..."
6827
6828Exact match against any of list topics.
6829'others' or 'topicsless' means no topics.
6830
6831=item 'update' => TIME
6832
6833=item 'update<' => TIME
6834
6835=item 'update>' => TIME
6836
6837Date of last update is equal to, earlier than or later than the date (UNIX time).
6838
6839=begin comment
6840
6841=item 'web_archive' => ( 1 | 0 )
6842
6843Whether Web archive of the list is available.  1 or 0.
6844
6845=end comment
6846
6847=back
6848
6849=item C<'limit' =E<gt> NUMBER >
6850
6851Limit the number of results.
6852C<0> means no limit (default).
6853Note that this option may be applied prior to C<'order'> option.
6854
6855=item C<'order' =E<gt> [ KEY, ... ]>
6856
6857Subordinate sort key(s).  The results are sorted primarily by robot names
6858then by other key(s).  Keys prefixed by C<"-"> mean descendent ordering.
6859Available keys are:
6860
6861=over 4
6862
6863=item C<'creation'>
6864
6865Creation date.
6866
6867=item C<'name'>
6868
6869List name, case-insensitive.  It is the default.
6870
6871=item C<'total'>
6872
6873Estimated number of subscribers.
6874
6875=item C<'update'>
6876
6877Date of last update.
6878
6879=back
6880
6881=back
6882
6883=begin comment
6884
6885##=item REQUESTED_LISTS
6886##
6887##Arrayref to name of requested lists, if any.
6888
6889=end comment
6890
6891=back
6892
6893Returns a ref to an array of List objects.
6894
6895=item get_robots ( )
6896
6897I<Function>.
6898List of robots hosted by Sympa.
6899
6900=item get_which ( EMAIL, ROBOT, ROLE )
6901
6902I<Function>.
6903Get a list of lists where EMAIL assumes this ROLE (owner, editor or member) of
6904function to any list in ROBOT.
6905
6906=back
6907
6908=head2 Obsoleted methods
6909
6910=over
6911
6912=item add_admin_user ( USER, ROLE, HASHPTR )
6913
6914DEPRECATED.
6915Use add_list_admin().
6916
6917=item am_i ( ROLE, USER )
6918
6919DEPRECATED. Use is_admin().
6920
6921=item archive_exist ( FILE )
6922
6923DEPRECATED.
6924Returns true if the indicated file exists.
6925
6926=item archive_ls ()
6927
6928DEPRECATED.
6929Returns the list of available files, if any.
6930
6931=item archive_msg ( MSG )
6932
6933DEPRECATED.
6934Archives the Mail::Internet message given as argument.
6935
6936=item archive_send ( WHO, FILE )
6937
6938DEPRECATED.
6939Send the indicated archive file to the user, if it exists.
6940
6941=item get_db_field_type ( ... )
6942
6943I<Instance method>.
6944Obsoleted.
6945
6946=item get_first_list_admin ( ROLE )
6947
6948OBSOLETED.
6949Use get_admins().
6950
6951=item get_global_user ( USER )
6952
6953DEPRECATED.
6954Returns a hash with the information regarding the indicated
6955user.
6956
6957=item get_latest_distribution_date ( )
6958
6959I<Instance method>.
6960Gets last date of distribution message .
6961
6962=item get_list_address ( [ TYPE ] )
6963
6964OBSOLETED.
6965Use L<Sympa/"get_address">.
6966
6967Return the list email address of type TYPE: posting address (default),
6968"owner", "editor" or (non-VERP) "return_path".
6969
6970=item get_list_admin ( ROLE, USER)
6971
6972Return an admin user of the list with predefined role
6973
6974OBSOLETED.
6975Use get_admins().
6976
6977=item get_list_id ( )
6978
6979OBSOLETED.
6980Use get_id().
6981
6982=item get_next_list_admin ()
6983
6984OBSOLETED.
6985Use get_admins().
6986
6987=item get_state ( FLAG )
6988
6989Deprecated.
6990Returns the value for a flag : sig or sub.
6991
6992=item may_do ( ACTION, USER )
6993
6994B<Note>:
6995This method was obsoleted.
6996
6997Chcks is USER may do the ACTION for the list. ACTION can be
6998one of following : send, review, index, getm add, del,
6999reconfirm, purge.
7000
7001=item move_message ( $file, $queue )
7002
7003DEPRECATED.
7004No longer used.
7005
7006=item print_info ( FDNAME )
7007
7008DEPRECATED.
7009Print the list information to the given file descriptor, or the
7010currently selected descriptor.
7011
7012=item savestats ()
7013
7014B<Deprecated> on 6.2.23b.
7015
7016Saves updates the statistics file on disk.
7017
7018=item send_confirm_to_editor ( $message, $method )
7019
7020This method was DEPRECATED.
7021
7022Send a L<Sympa::Message> object to the editor (for approval).
7023
7024Sends a message to the list editor to ask them for moderation
7025(in moderation context : editor or editorkey). The message
7026to moderate is set in moderation spool with name containing
7027a key (reference send to editor for moderation).
7028In context of msg_topic defined the editor must tag it
7029for the moderation (on Web interface).
7030
7031Parameters:
7032
7033=over
7034
7035=item $message
7036
7037Sympa::Message instance - the message to moderate.
7038
7039=item $method
7040
7041'md5' - for "editorkey", 'smtp' - for "editor".
7042
7043=back
7044
7045Returns:
7046
7047The moderation key for naming message waiting for moderation in moderation spool, or C<undef>.
7048
7049=item send_confirm_to_sender ( $message )
7050
7051This method was DEPRECATED.
7052
7053Sends an authentication request for a sent message to distribute.
7054The message for distribution is copied in the auth
7055spool in order to wait for confirmation by its sender.
7056This message is named with a key.
7057In context of msg_topic defined, the sender must tag it
7058for the confirmation
7059
7060Parameter:
7061
7062=over
7063
7064=item $message
7065
7066L<Sympa::Message> instance.
7067
7068=back
7069
7070Returns:
7071
7072The key for naming message waiting for confirmation (or tagging) in auth spool, or C<undef>.
7073
7074=back
7075
7076=head2 Attributes
7077
7078FIXME @todo doc
7079
7080=head1 SEE ALSO
7081
7082L<Sympa>.
7083
7084=head1 HISTORY
7085
7086L<List> module was renamed to L<Sympa::List> module on Sympa 6.2.
7087
7088=cut
7089