List.pm 298 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 HTTP::Request;
35
use IO::Scalar;
36
use LWP::UserAgent;
sikeda's avatar
sikeda committed
37
use POSIX qw();
38
use Storable qw();
39
BEGIN { eval 'use IO::Socket::SSL'; }
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
use Sympa::Datasource;
use Sympa::Family;
50
use Sympa::Language;
51
use Sympa::List::Config;
52
use Sympa::ListDef;
53
use Sympa::LockedFile;
54
use Sympa::Log;
55
use Sympa::Process;
56
use Sympa::Regexps;
57
58
use Sympa::Robot;
use Sympa::Scenario;
59
use Sympa::Spindle::ProcessTemplate;
60
use Sympa::Spool::Auth;
61
use Sympa::Template;
62
use Sympa::Ticket;
63
64
use Sympa::Tools::Data;
use Sympa::Tools::File;
65
use Sympa::Tools::Password;
66
use Sympa::Tools::SMIME;
67
use Sympa::Tools::Text;
68
use Sympa::User;
69

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

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

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

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

=encoding utf-8

97
98
99
#=head1 NAME
#
#List - Mailing list
100

root's avatar
root committed
101
102
=head1 CONSTRUCTOR

103
104
=over

root's avatar
root committed
105
106
=item new( [PHRASE] )

107
 Sympa::List->new();
root's avatar
root committed
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

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 ()

129
B<Deprecated> on 6.2.23b.
root's avatar
root committed
130

131
Saves updates the statistics file on disk.
root's avatar
root committed
132

133
=item update_stats( count, [ sent, bytes, sent_by_bytes ] )
root's avatar
root committed
134

135
136
Updates the stats, argument is number of bytes, returns list fo the updated
values.  Returns zeroes if failed.
137

138
=item delete_list_member ( ARRAY )
root's avatar
root committed
139
140

Delete the indicated users from the list.
141

142
=item delete_list_admin ( ROLE, ARRAY )
143
144
145

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

root's avatar
root committed
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
=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.

162
=item get_total ( [ 'nocache' ] )
root's avatar
root committed
163
164
165

Returns the number of subscribers to the list.

166
=item get_global_user ( USER )
root's avatar
root committed
167

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

171
=item get_list_member ( USER )
172
173

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

175
=item get_list_admin ( ROLE, USER)
176
177
178

Return an admin user of the list with predefined role

179
180
181
OBSOLETED.
Use get_admins().

182
=item get_first_list_member ()
root's avatar
root committed
183
184
185

Returns a hash to the first user on the list.

186
=item get_first_list_admin ( ROLE )
187

188
189
OBSOLETED.
Use get_admins().
190

191
=item get_next_list_member ()
root's avatar
root committed
192
193
194
195

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

196
=item get_next_list_admin ()
197

198
199
OBSOLETED.
Use get_admins().
200

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

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

206
=item update_list_admin ( USER, ROLE, HASHPTR )
207
208
209

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

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

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

215
216
217
218
219
=item add_admin_user ( USER, ROLE, HASHPTR )

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

220
=item is_list_member ( USER )
root's avatar
root committed
221
222

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

224
=item am_i ( ROLE, USER )
root's avatar
root committed
225

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

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

234
235
236
B<Note>:
This method was obsoleted.

root's avatar
root committed
237
238
239
240
241
242
243
244
245
246
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 )

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

=item archive_send ( WHO, FILE )

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

=item archive_ls ()

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

=item archive_msg ( MSG )

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

=item is_archived ()

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

270
271
272
273
274
=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".

275
276
277
278
=item is_included ( )

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

279
=item get_stats ( )
root's avatar
root committed
280

281
Returns array of the statistics.
root's avatar
root committed
282
283
284

=item print_info ( FDNAME )

285
Print the list information to the given file descriptor, or the
root's avatar
root committed
286
287
currently selected descriptor.

288
289
=back

root's avatar
root committed
290
291
292
=cut

## Database and SQL statement handlers
293
my ($sth, @sth_stack);
294

sikeda's avatar
sikeda committed
295
296
297
298
299
300
301
302
303
304
305
306
# 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
307

308
# This is the generic hash which keeps all lists in memory.
309
my %list_of_lists  = ();
salaun's avatar
salaun committed
310

root's avatar
root committed
311
312
## Creates an object.
sub new {
313
314
    my ($pkg, $name, $robot, $options) = @_;
    my $list = {};
315
    $log->syslog('debug2', '(%s, %s, %s)', $name, $robot,
316
        join('/', keys %$options));
317

318
    $name = lc($name);
319
320
    ## Allow robot in the name
    if ($name =~ /\@/) {
321
322
323
        my @parts = split /\@/, $name;
        $robot ||= $parts[1];
        $name = $parts[0];
324
    }
root's avatar
root committed
325

326
327
328
329
330
    # 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);
    }
331

332
    unless ($robot) {
333
        $log->syslog('err',
334
335
336
337
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
338
339
    }

340
341
    $options = {} unless (defined $options);

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

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

366
    my $status;
367
    ## If list already in memory and not previously purged by another process
368
369
370
371
372
373
374
375
376
377
378
379
380
    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);
    }
381
    unless (defined $status) {
382
        return undef;
383
384
385
    }

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

411
412
413
    return $list;
}

414
415
416
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
417

418
    unless ($listname) {
419
        $log->syslog('err', 'Missing list parameter');
420
        return undef;
421
    }
422

423
    ## Search in default robot
424
425
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
426
    }
427
428
429
430
431
432
433
434

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

    return 0;
435
436
}

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

442
443
    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
444
445
        $self->{'admin'}{'status'} = 'error_config';

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

457
458
459
460
# Destroy multiton instance. FIXME
sub destroy_multiton {
    my $self = shift;
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
root's avatar
root committed
461
462
}

463
464
465
466
## set the list in status family_closed and send a notify to owners
# Deprecated.  Use Sympa::Request::Handler::close_list handler.
#sub set_status_family_closed;

467
468
469
# Saves the statistics data to disk.
# Deprecated. Use Sympa::List::update_stats().
#sub savestats;
root's avatar
root committed
470

471
## msg count.
472
473
# Old name: increment_msg_count().
sub _increment_msg_count {
474
    $log->syslog('debug2', '(%s)', @_);
475
    my $self = shift;
476

477
    # Be sure the list has been loaded.
478
    my $file = "$self->{'dir'}/msg_count";
479
480
481
482
483
484
485
486
487

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
488
489
490
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
491
492
493
        $count{$today}++;
    } else {
        $count{$today} = 1;
494
    }
495

496
    unless (open(MSG_COUNT, ">$file.$PID")) {
497
        $log->syslog('err', 'Unable to create "%s.%s": %m', $file, $PID);
498
        return undef;
499
    }
500
501
    foreach my $key (sort { $a <=> $b } keys %count) {
        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
502
    }
503
504
    close MSG_COUNT;

505
    unless (rename("$file.$PID", $file)) {
506
        $log->syslog('err', 'Unable to write "%s": %m', $file);
507
        return undef;
508
509
510
511
    }
    return 1;
}

512
513
# Returns the number of messages sent to the list
sub get_msg_count {
514
    $log->syslog('debug2', '(%s)', @_);
515
516
    my $self = shift;

517
    # Be sure the list has been loaded.
518
    my $file = "$self->{'dir'}/stats";
519
520
521
522
523
524
525
526
527

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
528
529
530
531
    }

    return $count;
}
532
533
## last date of distribution message .
sub get_latest_distribution_date {
534
    $log->syslog('debug2', '(%s)', @_);
535
    my $self = shift;
536

537
    # Be sure the list has been loaded.
538
    my $file = "$self->{'dir'}/msg_count";
539
540

    my $latest_date = 0;
salaun's avatar
salaun committed
541
    unless (open(MSG_COUNT, $file)) {
542
        $log->syslog('debug2', 'Unable to open %s', $file);
543
        return undef;
salaun's avatar
salaun committed
544
    }
545

546
547
548
549
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
550
    }
551
    close MSG_COUNT;
552

553
554
    return undef if ($latest_date == 0);
    return $latest_date;
555
556
}

557
## Update the stats struct
root's avatar
root committed
558
559
## Input  : num of bytes of msg
## Output : num of msgs sent
560
# Old name: List::update_stats().
561
562
# No longer used. Use Sympa::List::update_stats(1);
#sub get_next_sequence;
563

564
565
sub get_stats {
    my $self  = shift;
566

567
568
569
570
571
572
    my @stats;
    my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '<');
    if ($lock_fh) {
        @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
        $lock_fh->close;
    }
573

574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
    foreach my $i ((0 .. 3)) {
        $stats[$i] = 0 unless $stats[$i];
    }
    return @stats[0 .. 3];
}

sub update_stats {
    $log->syslog('debug2', '(%s, %s, %s, %s, %s)', @_);
    my $self  = shift;
    my @diffs = @_;

    my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '+>>');
    unless ($lock_fh) {
        $log->syslog('err', 'Could not create new lock');
        return;
    }

    # Update stats file.
    # Note: The last three fields total, last_sync and last_sync_admin_user
    # were deprecated.
    seek $lock_fh, 0, 0;
    my @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
    foreach my $i ((0 .. 3)) {
        $stats[$i] ||= 0;
        $stats[$i] += $diffs[$i] if $diffs[$i];
    }
    seek $lock_fh, 0, 0;
    truncate $lock_fh, 0;
    printf $lock_fh "%d %.0f %.0f %.0f\n", @stats;

    return unless $lock_fh->close;

    if ($diffs[0]) {
        $self->_increment_msg_count;
    }

    return @stats;
root's avatar
root committed
611
612
}

613
614
615
616
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

617
    my $stat_file;
618
    if ($type eq 'member') {
619
620
621
        $stat_file = $self->{'dir'} . '/.last_change.member';
    } elsif ($type eq 'last_sync') {
        $stat_file = $self->{'dir'} . '/.last_sync.member';
622
623
624
625
    } elsif ($type eq 'admin_user') {
        $stat_file = $self->{'dir'} . '/.last_change.admin';
    } elsif ($type eq 'last_sync_admin_user') {
        $stat_file = $self->{'dir'} . '/.last_sync.admin';
626
627
    } else {
        die 'bug in logic. Ask developer';
628
    }
629
630
631
632

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
633
634
635
636
637
638
639
}

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

    if ($type eq 'member') {
640
641
642
643
644
645
646
647
        # 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');
648
649
650
651
652
653
654
655
656
    } elsif ($type eq 'admin_user') {
        # If changes have never been done, just now is assumed.
        my $stat_file = $self->{'dir'} . '/.last_change.admin';
        $self->_cache_publish_expiry('admin_user') unless -e $stat_file;
        return [stat $stat_file]->[9];
    } elsif ($type eq 'last_sync_admin_user') {
        # If syncs have never been done, earliest time is assumed.
        return Sympa::Tools::File::get_mtime(
            $self->{'dir'} . '/.last_sync.admin');
657
    } elsif ($type eq 'edit_list_conf') {
IKEDA Soji's avatar
Typo.    
IKEDA Soji committed
658
        return [stat Sympa::search_fullpath($self, 'edit_list.conf')]->[9];
659
660
    } else {
        die 'bug in logic. Ask developer';
661
662
663
664
665
666
667
668
669
    }
}

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

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
670
    if ($type eq 'total' or $type eq 'is_list_member') {
671
672
        $mtime = $self->_cache_read_expiry('member');
    } else {
673
        $mtime = $self->_cache_read_expiry($type);
674
675
676
    }
    $self->{_mtime}{$type} = $mtime;

677
678
679
    return undef unless defined $lasttime and defined $mtime;
    return undef if $lasttime < $mtime;
    return $self->{_cached}{$type};
680
681
682
683
684
685
686
687
688
689
}

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

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

690
# Old name: List::extract_verp_rcpt().
691
692
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;
693

root's avatar
root committed
694
695
## Dumps a copy of lists to disk, in text format
sub dump {
696
    my $self = shift;
697
    $log->syslog('debug2', '(%s)', $self->{'name'});
698

699
    unless (defined $self) {
700
        $log->syslog('err', 'Unknown list');
701
        return undef;
702
    }
703

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

706
    unless ($self->_save_list_members_file($user_file_name)) {
707
        $log->syslog('err', 'Failed to save file %s', $user_file_name);
708
        return undef;
root's avatar
root committed
709
    }
710

711
    # Note: "subscribers" file was deprecated. No need to load "stats" file.
712
713
714
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
715
716

    return 1;
root's avatar
root committed
717
718
719
720
721
}

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

724
725
    return undef
        unless ($self);
726
727
728
729

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

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

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

    ## Update management info
    $self->{'admin'}{'serial'}++;
742
    $self->{'admin'}{'update'} = {
743
744
        'email'      => $email,
        'date_epoch' => time,
745
    };
746

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

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

771
    ## Release the lock
772
    unless ($lock_fh->close()) {
773
        return undef;
774
775
    }

776
    unless ($self->_update_list_db) {
777
        $log->syslog('err', "Unable to update list_table");
778
779
    }

root's avatar
root committed
780
781
782
783
784
    return 1;
}

## Loads the administrative data for a list
sub load {
785
786
787
788
789
790
791
    $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;
792

793
794
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
795
796
797
798
799
        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 {
800
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
801
802
803
804
805
806
807
808
809
                unless ($options->{'just_try'});
            return undef;
        }

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

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

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

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

824
825
826
827
828
829
    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 $main_config_time =
        Sympa::Tools::File::get_mtime(Sympa::Constants::CONFIG);
    # my $web_config_time  = Sympa::Tools::File::get_mtime(Sympa::Constants::WWSCONFIG);
830
    my $config_reloaded = 0;
root's avatar
root committed
831
    my $admin;
832
833

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

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

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

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

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

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

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

901
902
    ## If config was reloaded...
    if ($admin) {
903
904
905
906
907
908
909
910
        $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()) {
911
                $log->syslog(
912
                    'err',
913
                    'Impossible to get list %s family: %s. The list is set in status error_config',
914
                    $self,
915
916
917
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
918
                    $self->{'admin'}{'family_name'});
919
920
921
922
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
923
                $log->syslog(
924
925
926
927
928
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
929
                    $family->{'name'});
930
931
            }
            if (ref($error) eq 'ARRAY') {
932
                $log->syslog(
933
934
935
936
937
938
                    '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',
939
                    $family->{'name'});
940
941
942
943
944
945
946
947
            }
        }
    }

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

948
    $self->{'_mtime'}{'config'} = $last_time_config;
root's avatar
root committed
949

950
    $list_of_lists{$self->{'domain'}}{$name} = $self;
951
    return $config_reloaded;
root's avatar
root committed
952
953
}

954
## Return a list of hash's owners and their param
955
#OBSOLETED.  Use get_admins().
956
sub get_owners {
957
958
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
959

960
961
    # owners are in the admin_table ; they might come from an include data
    # source
962
    return [$self->get_admins('owner')];
963
964
}

965
# OBSOLETED: No longer used.
966
sub get_nb_owners {
967
968
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
969

970
    return scalar @{$self->get_admins('owner')};
971
972
}

973
974
## Return a hash of list's editors and their param(empty if there isn't any
## editor)
975
#OBSOLETED. Use get_admins().
976
sub get_editors {
977
978
    $log->syslog('debug3', '(%s)', @_);
    my $self = shift;
979

980
981
    # editors are in the admin_table ; they might come from an include data
    # source
982
    return [$self->get_admins('editor')];
983
984
}

985
## Returns an array of owners' email addresses
986
987
#OBSOLETED: Use get_admins_email('receptive_owner') or
#           get_admins_email('owner').
salaun's avatar
salaun committed
988
sub get_owners_email {
989
990
991
    $log->syslog('debug3', '(%s, %s)', @_);
    my $self  = shift;
    my $param = shift;
992

993
    my @rcpt;
994

995
    if ($param->{'ignore_nomail'}) {
996
        @rcpt = map { $_->{'email'} } $self->get_admins('owner');
997
    } else {
998
        @rcpt = map { $_->{'email'} } $self->get_admins('receptive_owner');
999
1000
    }
    unless (@rcpt) {