List.pm 310 KB
Newer Older
1
2
3
4
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

5
# Sympa - SYsteme de Multi-Postage Automatique
6
7
8
9
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
12
13
# directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
14
15
16
17
18
19
20
21
22
23
24
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
25
26
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
root's avatar
root committed
27

28
package Sympa::List;
root's avatar
root committed
29
30

use strict;
31
use warnings;
32
use Digest::MD5 qw();
33
use English qw(-no_match_vars);
34
use File::Path qw();
35
use HTTP::Request;
36
use IO::Scalar;
37
use LWP::UserAgent;
sikeda's avatar
sikeda committed
38
use POSIX qw();
39
use Storable qw();
40

41
use Sympa;
42
use Conf;
43
use Sympa::ConfDef;
44
use Sympa::Constants;
45
use Sympa::Database;
46
use Sympa::DatabaseDescription;
47
use Sympa::DatabaseManager;
48
49
50
use Sympa::Datasource;
use Sympa::Family;
use Sympa::Fetch;
51
use Sympa::Language;
52
use Sympa::List::Config;
53
use Sympa::ListDef;
54
use Sympa::LockedFile;
55
use Sympa::Log;
56
use Sympa::Process;
57
use Sympa::Regexps;
58
59
use Sympa::Robot;
use Sympa::Scenario;
60
use Sympa::Spindle::ProcessTemplate;
61
use Sympa::Spool::Auth;
62
use Sympa::Task;
63
use Sympa::Template;
64
use Sympa::Ticket;
65
66
use Sympa::Tools::Data;
use Sympa::Tools::File;
67
use Sympa::Tools::Password;
68
use Sympa::Tools::SMIME;
69
use Sympa::Tools::Text;
70
use Sympa::User;
71

72
my @sources_providing_listmembers = qw/
73
74
75
76
77
78
    include_file
    include_ldap_2level_query
    include_ldap_query
    include_remote_file
    include_remote_sympa_list
    include_sql_query
79
    include_sympa_list
80
81
82
    /;

#XXX include_admin
83
my @more_data_sources = qw/
84
85
    editor_include
    owner_include
86
    member_include
87
    /;
88
89

# All non-pluggable sources are in the admin user file
90
# NO LONGER USED.
91
92
my %config_in_admin_user_file = map +($_ => 1),
    @sources_providing_listmembers;
93

94
my $language = Sympa::Language->instance;
95
my $log      = Sympa::Log->instance;
96
97
98

=encoding utf-8

99
100
101
#=head1 NAME
#
#List - Mailing list
102

root's avatar
root committed
103
104
=head1 CONSTRUCTOR

105
106
=over

root's avatar
root committed
107
108
=item new( [PHRASE] )

109
 Sympa::List->new();
root's avatar
root committed
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

Creates a new object which will be used for a list and
eventually loads the list if a name is given. Returns
a List object.

=back

=head1 METHODS

=over 4

=item load ( LIST )

Loads the indicated list into the object.

=item save ( LIST )

Saves the indicated list object to the disk files.

=item savestats ()

Saves updates the statistics file on disk.

=item update_stats( BYTES )

Updates the stats, argument is number of bytes, returns the next
sequence number. Does nothing if no stats.

138
139
This method was DEPRECATED.

140
=item delete_list_member ( ARRAY )
root's avatar
root committed
141
142

Delete the indicated users from the list.
143

144
=item delete_list_admin ( ROLE, ARRAY )
145
146
147

Delete the indicated admin user with the predefined role from the list.

root's avatar
root committed
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
=item get_cookie ()

Returns the cookie for a list, if available.

=item get_max_size ()

Returns the maximum allowed size for a message.

=item get_reply_to ()

Returns an array with the Reply-To values.

=item get_default_user_options ()

Returns a default option of the list for subscription.

164
=item get_total ( [ 'nocache' ] )
root's avatar
root committed
165
166
167

Returns the number of subscribers to the list.

168
=item get_global_user ( USER )
root's avatar
root committed
169

170
Returns a hash with the information regarding the indicated
root's avatar
root committed
171
172
user.

173
=item get_list_member ( USER )
174
175

Returns a subscriber of the list.
david.verdin's avatar
david.verdin committed
176

177
=item get_list_admin ( ROLE, USER)
178
179
180

Return an admin user of the list with predefined role

181
182
183
OBSOLETED.
Use get_admins().

184
=item get_first_list_member ()
root's avatar
root committed
185
186
187

Returns a hash to the first user on the list.

188
=item get_first_list_admin ( ROLE )
189

190
191
OBSOLETED.
Use get_admins().
192

193
=item get_next_list_member ()
root's avatar
root committed
194
195
196
197

Returns a hash to the next users, until we reach the end of
the list.

198
=item get_next_list_admin ()
199

200
201
OBSOLETED.
Use get_admins().
202

sikeda's avatar
sikeda committed
203
=item update_list_member ( $email, key =E<gt> value, ... )
root's avatar
root committed
204

sikeda's avatar
sikeda committed
205
206
I<Instance method>.
Sets the new values given in the pairs for the user.
root's avatar
root committed
207

208
=item update_list_admin ( USER, ROLE, HASHPTR )
209
210
211

Sets the new values given in the hash for the admin user.

212
=item add_list_member ( USER, HASHPTR )
root's avatar
root committed
213
214
215
216

Adds a new user to the list. May overwrite existing
entries.

217
218
219
220
221
=item add_admin_user ( USER, ROLE, HASHPTR )

Adds a new admin user to the list. May overwrite existing
entries.

222
=item is_list_member ( USER )
root's avatar
root committed
223
224

Returns true if the indicated user is member of the list.
225

226
=item am_i ( ROLE, USER )
root's avatar
root committed
227

228
DEPRECATED. Use is_admin().
root's avatar
root committed
229
230
231
232
233
234
235

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

236
237
238
B<Note>:
This method was obsoleted.

root's avatar
root committed
239
240
241
242
243
244
245
246
247
248
Chcks is USER may do the ACTION for the list. ACTION can be
one of following : send, review, index, getm add, del,
reconfirm, purge.

=item is_moderated ()

Returns true if the list is moderated.

=item archive_exist ( FILE )

249
DEPRECATED.
root's avatar
root committed
250
251
252
253
Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

254
DEPRECATED.
root's avatar
root committed
255
256
257
258
Send the indicated archive file to the user, if it exists.

=item archive_ls ()

259
DEPRECATED.
root's avatar
root committed
260
261
262
263
Returns the list of available files, if any.

=item archive_msg ( MSG )

264
DEPRECATED.
root's avatar
root committed
265
266
267
268
269
270
271
Archives the Mail::Internet message given as argument.

=item is_archived ()

Returns true is the list is configured to keep archives of
its messages.

272
273
274
275
276
=item is_archiving_enabled ( )

Returns true is the list is configured to keep archives of
its messages, i.e. process_archive parameter is set to "on".

277
278
279
280
=item is_included ( )

Returns true value if the list is included in another list(s).

root's avatar
root committed
281
282
283
284
285
286
287
=item get_stats ( OPTION )

Returns either a formatted printable strings or an array whith
the statistics. OPTION can be 'text' or 'array'.

=item print_info ( FDNAME )

288
Print the list information to the given file descriptor, or the
root's avatar
root committed
289
290
currently selected descriptor.

291
292
=back

root's avatar
root committed
293
294
295
=cut

## Database and SQL statement handlers
296
my ($sth, @sth_stack);
297
298
299

my %list_cache;

sikeda's avatar
sikeda committed
300
301
302
303
304
305
306
307
308
309
310
311
# DB fields with numeric type.
# We should not do quote() for these while inserting data.
my %db_struct = Sympa::DatabaseDescription::full_db_struct();
my %numeric_field;
foreach my $t (qw(subscriber_table admin_table)) {
    foreach my $k (keys %{$db_struct{$t}->{fields}}) {
        if ($db_struct{$t}->{fields}{$k}{struct} =~ /\A(tiny|small|big)?int/)
        {
            $numeric_field{$k} = 1;
        }
    }
}
root's avatar
root committed
312

313
# This is the generic hash which keeps all lists in memory.
314
my %list_of_lists  = ();
salaun's avatar
salaun committed
315
my %list_of_robots = ();
salaun's avatar
salaun committed
316
317
my %edit_list_conf = ();

root's avatar
root committed
318
319
## Creates an object.
sub new {
320
321
    my ($pkg, $name, $robot, $options) = @_;
    my $list = {};
322
    $log->syslog('debug2', '(%s, %s, %s)', $name, $robot,
323
        join('/', keys %$options));
324

325
    $name = lc($name);
326
327
    ## Allow robot in the name
    if ($name =~ /\@/) {
328
329
330
        my @parts = split /\@/, $name;
        $robot ||= $parts[1];
        $name = $parts[0];
331
    }
root's avatar
root committed
332

333
334
335
336
337
    # Look for the list if no robot was provided.
    if (not $robot or $robot eq '*') {
        #FIXME: Default robot would be used instead of oppotunistic search.
        $robot = search_list_among_robots($name);
    }
338

339
    unless ($robot) {
340
        $log->syslog('err',
341
342
343
344
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
345
346
    }

347
348
    $options = {} unless (defined $options);

root's avatar
root committed
349
    ## Only process the list if the name is valid.
350
    my $listname_regexp = Sympa::Regexps::listname();
351
    unless ($name and ($name =~ /^($listname_regexp)$/io)) {
352
        $log->syslog('err', 'Incorrect listname "%s"', $name)
353
354
            unless ($options->{'just_try'});
        return undef;
root's avatar
root committed
355
356
    }
    ## Lowercase the list name.
357
    $name = $1;
root's avatar
root committed
358
    $name =~ tr/A-Z/a-z/;
359

360
    ## Reject listnames with reserved list suffixes
361
362
363
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($name =~ /^(\S+)-($regx)$/) {
364
            $log->syslog(
365
366
367
368
369
370
                'err',
                'Incorrect name: listname "%s" matches one of service aliases',
                $name
            ) unless ($options->{'just_try'});
            return undef;
        }
371
372
    }

373
    my $status;
374
    ## If list already in memory and not previously purged by another process
375
376
377
378
379
380
381
382
383
384
385
386
387
    if ($list_of_lists{$robot}{$name}
        and -d $list_of_lists{$robot}{$name}{'dir'}) {
        # use the current list in memory and update it
        $list = $list_of_lists{$robot}{$name};

        $status = $list->load($name, $robot, $options);
    } else {
        # create a new object list
        bless $list, $pkg;

        $options->{'first_access'} = 1;
        $status = $list->load($name, $robot, $options);
    }
388
    unless (defined $status) {
389
        return undef;
390
391
392
    }

    ## Config file was loaded or reloaded
393
394
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}
        || $list->{'admin'}{'ttl'};
395
    if ($status
sikeda's avatar
sikeda committed
396
        && ((     !$options->{'skip_sync_admin'}
397
                && $list->{'last_sync_admin_user'} < time - $pertinent_ttl
sikeda's avatar
sikeda committed
398
            )
399
            || $options->{'force_sync_admin'}
sikeda's avatar
sikeda committed
400
        )
401
402
403
        ) {
        ## Update admin_table
        unless (defined $list->sync_include_admin()) {
404
            $log->syslog('err', '')
405
406
                unless ($options->{'just_try'});
        }
407
408
        if (not @{$list->get_admins('owner') || []}
            and $list->{'admin'}{'status'} ne 'error_config') {
409
            $log->syslog('err', 'The list "%s" has got no owner defined',
410
                $list->{'name'});
411
            $list->set_status_error_config('no_owner_defined');
412
        }
root's avatar
root committed
413
414
    }

415
416
417
    return $list;
}

418
419
420
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
421

422
    unless ($listname) {
423
        $log->syslog('err', 'Missing list parameter');
424
        return undef;
425
    }
426

427
    ## Search in default robot
428
429
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
430
    }
431
432
433
434
435
436
437
438

    foreach my $r (keys %{$Conf::Conf{'robots'}}) {
        if (-d $Conf::Conf{'home'} . '/' . $r . '/' . $listname) {
            return $r;
        }
    }

    return 0;
439
440
}

441
442
## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
443
    $log->syslog('debug2', '(%s, %s, ...)', @_);
444
    my ($self, $msg, @param) = @_;
445

446
447
    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
448
449
        $self->{'admin'}{'status'} = 'error_config';

450
451
452
453
        # No more save config in error...
        # $self->save_config(tools::get_address($self->{'domain'},
        #     'listmaster'));
        # $self->savestats();
454
        $log->syslog('err',
455
456
            'The list %s is set in status error_config: %s(%s)',
            $self, $msg, join(', ', @param));
457
        Sympa::send_notify_to_listmaster($self, $msg,
458
            [$self->{'name'}, @param]);
459
460
461
462
463
    }
}

## set the list in status family_closed and send a notify to owners
sub set_status_family_closed {
464
465
466
467
    $log->syslog('debug2', '(%s, %s, %s)', @_);
    my $self    = shift;
    my $message = shift;    # 'close_list', 'purge_list': Currently unused.
    my @param   = @_;       # No longer used.
468
469

    unless ($self->{'admin'}{'status'} eq 'family_closed') {
470
        my $updater = Sympa::get_address($self->{'domain'}, 'listmaster');
471

472
        unless ($self->close_list($updater, 'family_closed')) {
473
            $log->syslog('err',
474
475
476
                'Impossible to set the list %s in status family_closed');
            return undef;
        }
477
        $log->syslog('info', 'The list "%s" is set in status family_closed',
478
            $self->{'name'});
479
        $self->send_notify_to_owner('list_closed_family', {});
480
481
    }
    return 1;
root's avatar
root committed
482
483
484
485
}

## Saves the statistics data to disk.
sub savestats {
486
    $log->syslog('debug2', '(%s)', @_);
root's avatar
root committed
487
    my $self = shift;
488

489
490
491
    # Be sure the list has been loaded.
    my $dir = $self->{'dir'};
    return undef unless $list_of_lists{$self->{'domain'}}{$self->{'name'}};
492
493

    unless (ref($self->{'stats'}) eq 'ARRAY') {
494
        $log->syslog('err', 'Incorrect parameter %s', $self->{'stats'});
495
        return undef;
496
    }
497
498
499
500

    ## Lock file
    my $lock_fh = Sympa::LockedFile->new($dir . '/stats', 2, '>');
    unless ($lock_fh) {
501
        $log->syslog('err', 'Could not create new lock');
502
503
        return undef;
    }
olivier.salaun's avatar
olivier.salaun committed
504

505
506
507
    # Note: 5th and 6th fields (total and last_sync) were deprecated.
    printf $lock_fh "%d %.0f %.0f %.0f 0 0 %d\n",
        @{$self->{'stats'}}, $self->{'last_sync_admin_user'};
508

olivier.salaun's avatar
olivier.salaun committed
509
    ## Release the lock
510
    unless ($lock_fh->close) {
511
        return undef;
olivier.salaun's avatar
olivier.salaun committed
512
513
    }

root's avatar
root committed
514
    ## Changed on disk
515
    $self->{'_mtime'}{'stats'} = time;
root's avatar
root committed
516
517
518
519

    return 1;
}

520
## msg count.
521
522
# Old name: increment_msg_count().
sub _increment_msg_count {
523
    $log->syslog('debug2', '(%s)', @_);
524
    my $self = shift;
525

526
    # Be sure the list has been loaded.
527
    my $file = "$self->{'dir'}/msg_count";
528
529
530
531
532
533
534
535
536

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
537
538
539
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
540
541
542
        $count{$today}++;
    } else {
        $count{$today} = 1;
543
    }
544

545
    unless (open(MSG_COUNT, ">$file.$PID")) {
546
        $log->syslog('err', 'Unable to create "%s.%s": %m', $file, $PID);
547
        return undef;
548
    }
549
550
    foreach my $key (sort { $a <=> $b } keys %count) {
        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
551
    }
552
553
    close MSG_COUNT;

554
    unless (rename("$file.$PID", $file)) {
555
        $log->syslog('err', 'Unable to write "%s": %m', $file);
556
        return undef;
557
558
559
560
    }
    return 1;
}

561
562
# Returns the number of messages sent to the list
sub get_msg_count {
563
    $log->syslog('debug2', '(%s)', @_);
564
565
    my $self = shift;

566
    # Be sure the list has been loaded.
567
    my $file = "$self->{'dir'}/stats";
568
569
570
571
572
573
574
575
576

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
577
578
579
580
    }

    return $count;
}
581
582
## last date of distribution message .
sub get_latest_distribution_date {
583
    $log->syslog('debug2', '(%s)', @_);
584
    my $self = shift;
585

586
    # Be sure the list has been loaded.
587
    my $file = "$self->{'dir'}/msg_count";
588
589

    my $latest_date = 0;
salaun's avatar
salaun committed
590
    unless (open(MSG_COUNT, $file)) {
591
        $log->syslog('debug2', 'Unable to open %s', $file);
592
        return undef;
salaun's avatar
salaun committed
593
    }
594

595
596
597
598
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
599
    }
600
    close MSG_COUNT;
601

602
603
    return undef if ($latest_date == 0);
    return $latest_date;
604
605
}

606
## Update the stats struct
root's avatar
root committed
607
608
## Input  : num of bytes of msg
## Output : num of msgs sent
609
610
# Old name: List::update_stats().
sub get_next_sequence {
611
612
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
613

root's avatar
root committed
614
615
    my $stats = $self->{'stats'};
    $stats->[0]++;
616
617

    ## Update 'msg_count' file, used for bounces management
618
    $self->_increment_msg_count();
619

root's avatar
root committed
620
621
622
    return $stats->[0];
}

623
624
625
626
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

627
    my $stat_file;
628
    if ($type eq 'member') {
629
630
631
632
633
        $stat_file = $self->{'dir'} . '/.last_change.member';
    } elsif ($type eq 'last_sync') {
        $stat_file = $self->{'dir'} . '/.last_sync.member';
    } else {
        die 'bug in logic. Ask developer';
634
    }
635
636
637
638

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
639
640
641
642
643
644
645
}

sub _cache_read_expiry {
    my $self = shift;
    my $type = shift;

    if ($type eq 'member') {
646
647
648
649
650
651
652
653
654
655
        # If changes have never been done, just now is assumed.
        my $stat_file = $self->{'dir'} . '/.last_change.member';
        $self->_cache_publish_expiry('member') unless -e $stat_file;
        return [stat $stat_file]->[9];
    } elsif ($type eq 'last_sync') {
        # If syncs have never been done, earliest time is assumed.
        return Sympa::Tools::File::get_mtime(
            $self->{'dir'} . '/.last_sync.member');
    } else {
        die 'bug in logic. Ask developer';
656
657
658
659
660
661
662
663
664
    }
}

sub _cache_get {
    my $self   = shift;
    my $type   = shift;

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
665
    if ($type eq 'total' or $type eq 'is_list_member') {
666
667
        $mtime = $self->_cache_read_expiry('member');
    } else {
668
        $mtime = $self->_cache_read_expiry($type);
669
670
671
    }
    $self->{_mtime}{$type} = $mtime;

672
673
674
    return undef unless defined $lasttime and defined $mtime;
    return undef if $lasttime < $mtime;
    return $self->{_cached}{$type};
675
676
677
678
679
680
681
682
683
684
}

sub _cache_put {
    my $self  = shift;
    my $type  = shift;
    my $value = shift;

    return $self->{_cached}{$type} = $value;
}

685
# Old name: List::extract_verp_rcpt().
686
687
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;
688

root's avatar
root committed
689
690
## Dumps a copy of lists to disk, in text format
sub dump {
691
    my $self = shift;
692
    $log->syslog('debug2', '(%s)', $self->{'name'});
693

694
    unless (defined $self) {
695
        $log->syslog('err', 'Unknown list');
696
        return undef;
697
    }
698

699
    my $user_file_name = "$self->{'dir'}/subscribers.db.dump";
700

701
    unless ($self->_save_list_members_file($user_file_name)) {
702
        $log->syslog('err', 'Failed to save file %s', $user_file_name);
703
        return undef;
root's avatar
root committed
704
    }
705

706
    # Note: "subscribers" file was deprecated.
707
708
709
710
711
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
    $self->{'_mtime'}{'stats'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/stats');
712
713

    return 1;
root's avatar
root committed
714
715
716
717
718
}

## Saves the configuration file to disk
sub save_config {
    my ($self, $email) = @_;
719
    $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $email);
root's avatar
root committed
720

721
722
    return undef
        unless ($self);
723
724
725
726

    my $config_file_name = "$self->{'dir'}/config";

    ## Lock file
727
728
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
729
        $log->syslog('err', 'Could not create new lock');
730
        return undef;
731
732
    }

733
734
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
735
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
736
737
738

    ## Update management info
    $self->{'admin'}{'serial'}++;
739
    $self->{'admin'}{'update'} = {
740
741
        'email'      => $email,
        'date_epoch' => time,
742
    };
743

744
745
746
747
748
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
        ) {
749
        $log->syslog('info', 'Unable to save config file %s',
750
751
752
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
753
    }
754

755
    ## Also update the binary version of the data structure
756
757
758
    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
        'binary_file') {
        eval {
759
            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
760
761
        };
        if ($@) {
762
            $log->syslog('err',
763
764
765
                'Failed to save the binary config %s. error: %s',
                "$self->{'dir'}/config.bin", $@);
        }
766
767
    }

768
    ## Release the lock
769
    unless ($lock_fh->close()) {
770
        return undef;
771
772
    }

773
    unless ($self->_update_list_db) {
774
        $log->syslog('err', "Unable to update list_table");
775
776
    }

root's avatar
root committed
777
778
779
780
781
    return 1;
}

## Loads the administrative data for a list
sub load {
782
783
784
785
786
787
788
    $log->syslog('debug2', '(%s, %s, %s, ...)', @_);
    my $self    = shift;
    my $name    = shift;
    my $robot   = shift;
    my $options = shift;

    die 'bug in logic. Ask developer' unless $robot;
789

790
791
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
792
793
794
795
796
        if ($robot && (-d "$Conf::Conf{'home'}/$robot")) {
            $self->{'dir'} = "$Conf::Conf{'home'}/$robot/$name";
        } elsif (lc($robot) eq lc($Conf::Conf{'domain'})) {
            $self->{'dir'} = "$Conf::Conf{'home'}/$name";
        } else {
797
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
798
799
800
801
802
803
804
805
806
                unless ($options->{'just_try'});
            return undef;
        }

        $self->{'domain'} = $robot;

        # default list host is robot domain
        $self->{'admin'}{'host'} ||= $self->{'domain'};
        $self->{'name'} = $name;
807
    }
808

809
    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
810
        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
811
812
813
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
814
    }
salaun's avatar
salaun committed
815

816
817
818
    # Last modification of list config ($last_time_config) and stats
    # ($last_time_stats) on memory cache.
    # Note: "subscribers" file was deprecated.
819
820
821
822
    my $last_time_config = $self->{'_mtime'}{'config'};
    my $last_time_stats  = $self->{'_mtime'}{'stats'};
    $last_time_config = POSIX::INT_MIN() unless defined $last_time_config;
    $last_time_stats  = POSIX::INT_MIN() unless defined $last_time_stats;
823

824
825
826
827
828
829
830
    my $time_config = Sympa::Tools::File::get_mtime("$self->{'dir'}/config");
    my $time_config_bin =
        Sympa::Tools::File::get_mtime("$self->{'dir'}/config.bin");
    my $time_stats = Sympa::Tools::File::get_mtime("$self->{'dir'}/stats");
    my $main_config_time =
        Sympa::Tools::File::get_mtime(Sympa::Constants::CONFIG);
    # my $web_config_time  = Sympa::Tools::File::get_mtime(Sympa::Constants::WWSCONFIG);
831
    my $config_reloaded = 0;
root's avatar
root committed
832
    my $admin;
833
834

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
835
836
            'binary_file'
        and !$options->{'reload_config'}
837
        and $time_config_bin > $last_time_config
838
839
        and $time_config_bin >= $time_config
        and $time_config_bin >= $main_config_time) {
840
841
842
843
        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
844
            $log->syslog('err', 'Could not create new lock');
845
846
847
848
849
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
850
        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
851
        if ($@) {
852
            $log->syslog('err',
853
854
855
856
857
858
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

859
860
        $config_reloaded  = 1;
        $last_time_config = $time_config_bin;
861
        $lock_fh->close();
862
    } elsif ($self->{'name'} ne $name
863
        or $time_config > $last_time_config
864
        or $options->{'reload_config'}) {
865
        $admin = $self->_load_list_config_file;
866
867
868
869
870

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {
871
            $log->syslog('err', 'Could not create new lock');
872
873
874
875
876
877
            return undef;
        }

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
878
            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
879
            if ($@) {
880
                $log->syslog('err',
881
882
883
884
885
886
887
                    'Failed to save the binary config %s. error: %s',
                    "$self->{'dir'}/config.bin", $@);
            }
        }

        $config_reloaded = 1;
        unless (defined $admin) {
888
            $log->syslog(
889
                'err',
sikeda's avatar
sikeda committed
890
891
                'Impossible to load list config file for list %s set in status error_config',
                $self
892
            );
893
            $self->set_status_error_config('load_admin_file_error');
894
895
896
897
            $lock_fh->close();
            return undef;
        }

898
        $last_time_config = $time_config;
899
        $lock_fh->close();
root's avatar
root committed
900
    }
901

902
903
    ## If config was reloaded...
    if ($admin) {
904
905
906
907
908
909
910
911
        $self->{'admin'} = $admin;

        ## check param_constraint.conf if belongs to a family and the config
        ## has been loaded
        if (defined $admin->{'family_name'}
            && ($admin->{'status'} ne 'error_config')) {
            my $family;
            unless ($family = $self->get_family()) {
912
                $log->syslog(
913
                    'err',
914
                    'Impossible to get list %s family: %s. The list is set in status error_config',
915
                    $self,
916
917
918
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
919
                    $self->{'admin'}{'family_name'});
920
921
922
923
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
924
                $log->syslog(
925
926
927
928
929
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
930
                    $family->{'name'});
931
932
            }
            if (ref($error) eq 'ARRAY') {
933
                $log->syslog(
934
935
936
937
938
939
                    'err',
                    'The list "%s" does not respect the rules from its family %s',
                    $self->{'name'},
                    $family->{'name'}
                );
                $self->set_status_error_config('no_respect_rules_family',
940
                    $family->{'name'});
941
942
943
944
945
946
947
948
            }
        }
    }

    $self->{'as_x509_cert'} = 1
        if ((-r "$self->{'dir'}/cert.pem")
        || (-r "$self->{'dir'}/cert.pem.enc"));

949
    # Load stats file if first new() or stats file changed.
950
951
    my $stats_file = $self->{'dir'} . '/stats';
    if (!-e $stats_file or $time_stats > $last_time_stats) {
952
        ($self->{'stats'}, $self->{'last_sync_admin_user'}) =
953
            _load_stats_file($stats_file);
954
        $last_time_stats = $time_stats;
955
    }
956

957
958
    $self->{'_mtime'}{'config'} = $last_time_config;
    $self->{'_mtime'}{'stats'}  = $last_time_stats;
root's avatar
root committed
959

960
    $list_of_lists{$self->{'domain'}}{$name} = $self;
961
    return $config_reloaded;
root's avatar
root committed
962
963
}

964
## Return a list of hash's owners and their param
965
#OBSOLETED.  Use get_admins().
966
sub get_owners {
967
968
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
969

970
971
    # owners are in the admin_table ; they might come from an include data
    # source
972
    return [$self->get_admins('owner')];
973
974
}

975
# OBSOLETED: No longer used.
976
sub get_nb_owners {
977
978
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
979

980
    return scalar @{$self->get_admins('owner')};
981
982
}

983
984
## Return a hash of list's editors and their param(empty if there isn't any
## editor)
985
#OBSOLETED. Use get_admins().
986
sub get_editors {
987
988
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
989

990
991
    # editors are in the admin_table ; they might come from an include data
    # source
992
    return [$self->get_admins('editor')];
993
994
}

995
## Returns an array of owners' email addresses
996
997
#OBSOLETED: Use get_admins_email('receptive_owner') or
#           get_admins_email('owner').
salaun's avatar
salaun committed
998
sub get_owners_email {