List.pm 206 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
12
# Copyright 2017, 2018, 2019, 2020, 2021 The Sympa Community. See the
# AUTHORS.md file at the top-level directory of this distribution and at
13
# <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 IO::Scalar;
sikeda's avatar
sikeda committed
35
use POSIX qw();
36
use Storable qw();
37

38
use Sympa;
39
use Conf;
40
use Sympa::ConfDef;
41
use Sympa::Constants;
42
use Sympa::Database;
43
use Sympa::DatabaseDescription;
44
use Sympa::DatabaseManager;
45
use Sympa::Family;
46
use Sympa::Language;
47
use Sympa::List::Config;
48
use Sympa::ListDef;
49
use Sympa::LockedFile;
50
use Sympa::Log;
51
use Sympa::Regexps;
52
use Sympa::Robot;
IKEDA Soji's avatar
IKEDA Soji committed
53
use Sympa::Spindle::ProcessRequest;
54
use Sympa::Spindle::ProcessTemplate;
55
use Sympa::Spool::Auth;
56
use Sympa::Template;
57
use Sympa::Tools::Data;
58
use Sympa::Tools::Domains;
59
use Sympa::Tools::File;
60
use Sympa::Tools::SMIME;
61
use Sympa::Tools::Text;
62
use Sympa::User;
63

64
my @sources_providing_listmembers = qw/
65
66
67
68
69
70
    include_file
    include_ldap_2level_query
    include_ldap_query
    include_remote_file
    include_remote_sympa_list
    include_sql_query
71
    include_sympa_list
72
73
    /;

74
75
# No longer used.
#my @more_data_sources;
76
77

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

82
my $language = Sympa::Language->instance;
83
my $log      = Sympa::Log->instance;
84

root's avatar
root committed
85
## Database and SQL statement handlers
86
my ($sth, @sth_stack);
87

sikeda's avatar
sikeda committed
88
89
90
91
92
93
94
95
96
97
98
99
# 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
100

101
# This is the generic hash which keeps all lists in memory.
Luc Didry's avatar
Luc Didry committed
102
my %list_of_lists = ();
salaun's avatar
salaun committed
103

root's avatar
root committed
104
105
## Creates an object.
sub new {
106
107
    my ($pkg, $name, $robot, $options) = @_;
    my $list = {};
108
    $log->syslog('debug3', '(%s, %s, %s)', $name, $robot,
109
        join('/', keys %$options));
110

IKEDA Soji's avatar
IKEDA Soji committed
111
112
113
114
115
    # Lowercase list name.
    $name = lc $name;
    # In case the variable was multiple. FIXME:required?
    $name = $1 if $name =~ /^(\S+)\0/;

116
117
    ## Allow robot in the name
    if ($name =~ /\@/) {
118
119
120
        my @parts = split /\@/, $name;
        $robot ||= $parts[1];
        $name = $parts[0];
121
    }
root's avatar
root committed
122

123
124
125
126
    # 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);
127
128
    } else {
        $robot = lc $robot;    #FIXME: More canonicalization.
129
    }
130

131
    unless ($robot) {
132
        $log->syslog('err',
133
134
135
136
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
137
138
    }

139
140
    $options = {} unless (defined $options);

root's avatar
root committed
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
147
            unless ($options->{'just_try'});
        return undef;
root's avatar
root committed
148
149
    }
    ## Lowercase the list name.
150
    $name = $1;
root's avatar
root committed
151
    $name =~ tr/A-Z/a-z/;
152

153
    ## Reject listnames with reserved list suffixes
154
155
156
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($name =~ /^(\S+)-($regx)$/) {
157
            $log->syslog(
158
159
160
161
162
163
                'err',
                'Incorrect name: listname "%s" matches one of service aliases',
                $name
            ) unless ($options->{'just_try'});
            return undef;
        }
164
165
    }

166
    my $status;
167
    ## If list already in memory and not previously purged by another process
168
169
170
171
172
173
174
175
176
177
178
179
180
    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);
    }
181
    unless (defined $status) {
182
        return undef;
183
184
    }

185
186
187
    $list->_load_edit_list_conf(
        reload_config => ($options->{reload_config} || $status));

188
189
190
    return $list;
}

191
192
193
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    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
202
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
203
    }
204
205
206
207
208
209
210
211

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

    return 0;
212
213
}

214
215
## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
216
    $log->syslog('debug2', '(%s, %s, ...)', @_);
217
    my ($self, $msg, @param) = @_;
218

219
220
    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
221
222
        $self->{'admin'}{'status'} = 'error_config';

223
224
225
        # No more save config in error...
        # $self->save_config(tools::get_address($self->{'domain'},
        #     'listmaster'));
226
        $log->syslog('err',
227
228
            'The list %s is set in status error_config: %s(%s)',
            $self, $msg, join(', ', @param));
229
        Sympa::send_notify_to_listmaster($self, $msg,
230
            [$self->{'name'}, @param]);
231
232
233
    }
}

234
235
236
237
# Destroy multiton instance. FIXME
sub destroy_multiton {
    my $self = shift;
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
root's avatar
root committed
238
239
}

240
241
242
243
## 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;

244
245
246
# Saves the statistics data to disk.
# Deprecated. Use Sympa::List::update_stats().
#sub savestats;
root's avatar
root committed
247

248
## msg count.
249
250
# Old name: increment_msg_count().
sub _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
258
259
260
261
262
263
264

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
265
266
267
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
268
269
270
        $count{$today}++;
    } else {
        $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
278
    foreach my $key (sort { $a <=> $b } keys %count) {
        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
279
    }
280
281
    close MSG_COUNT;

282
    unless (rename("$file.$PID", $file)) {
283
        $log->syslog('err', 'Unable to write "%s": %m', $file);
284
        return undef;
285
286
287
288
    }
    return 1;
}

289
290
# Returns the number of messages sent to the list
sub get_msg_count {
291
    $log->syslog('debug2', '(%s)', @_);
292
293
    my $self = shift;

294
    # Be sure the list has been loaded.
295
    my $file = "$self->{'dir'}/stats";
296
297
298
299
300
301
302
303
304

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
305
306
307
308
    }

    return $count;
}
309
310
## last date of distribution message .
sub 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;
salaun's avatar
salaun committed
318
    unless (open(MSG_COUNT, $file)) {
319
        $log->syslog('debug2', 'Unable to open %s', $file);
320
        return undef;
salaun's avatar
salaun committed
321
    }
322

323
324
325
326
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
327
    }
328
    close MSG_COUNT;
329

330
331
    return undef if ($latest_date == 0);
    return $latest_date;
332
333
}

334
## Update the stats struct
root's avatar
root committed
335
336
## Input  : num of bytes of msg
## Output : num of msgs sent
337
# Old name: List::update_stats().
338
339
# No longer used. Use Sympa::List::update_stats(1);
#sub get_next_sequence;
340

341
sub get_stats {
Luc Didry's avatar
Luc Didry committed
342
    my $self = shift;
343

344
345
346
347
348
349
    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;
    }
350

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
    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
388
389
}

390
391
392
393
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

394
    my $stat_file;
395
    if ($type eq 'member') {
396
        $stat_file = $self->{'dir'} . '/.last_change.member';
397
398
    } elsif ($type eq 'admin_user') {
        $stat_file = $self->{'dir'} . '/.last_change.admin';
399
400
    } else {
        die 'bug in logic. Ask developer';
401
    }
402
403
404
405

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
406
    utime undef, undef, $stat_file;    # required for such as NFS.
407
408
409
410
411
412
413
}

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

    if ($type eq 'member') {
414
415
416
417
        # 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];
418
419
420
421
422
    } 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];
423
424
    } else {
        die 'bug in logic. Ask developer';
425
426
427
428
    }
}

sub _cache_get {
Luc Didry's avatar
Luc Didry committed
429
430
    my $self = shift;
    my $type = shift;
431
432
433

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
434
    if ($type eq 'total' or $type eq 'is_list_member') {
435
436
        $mtime = $self->_cache_read_expiry('member');
    } else {
437
        $mtime = $self->_cache_read_expiry($type);
438
439
440
    }
    $self->{_mtime}{$type} = $mtime;

441
    return undef unless defined $lasttime and defined $mtime;
442
    return undef if $lasttime <= $mtime;
443
    return $self->{_cached}{$type};
444
445
446
447
448
449
450
451
452
453
}

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

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

454
# Old name: List::extract_verp_rcpt().
455
456
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;
457

458
459
# Dumps a copy of list users to disk, in text format.
# Old name: Sympa::List::dump() which dumped only members.
460
sub dump_users {
461
    $log->syslog('debug2', '(%s, %s)', @_);
462
    my $self = shift;
463
    my $role = shift;
464

465
    die 'bug in logic. Ask developer'
Luc Didry's avatar
Luc Didry committed
466
        unless grep { $role eq $_ } qw(member owner editor);
467

468
    my $file = $self->{'dir'} . '/' . $role . '.dump';
469

470
471
472
473
    unlink $file . '.old' if -e $file . '.old';
    rename $file, $file . '.old' if -e $file;
    my $lock_fh = Sympa::LockedFile->new($file, 5, '>');
    unless ($lock_fh) {
Luc Didry's avatar
Luc Didry committed
474
475
476
477
        $log->syslog(
            'err', 'Failed to save file %s.new: %s',
            $file, Sympa::LockedFile->last_error
        );
478
        return undef;
479
    }
480

481
    if ($role eq 'member') {
482
        my %map_field = _map_list_member_cols();
483

484
485
486
487
488
        my $user;
        for (
            $user = $self->get_first_list_member();
            $user;
            $user = $self->get_next_list_member()
Luc Didry's avatar
Luc Didry committed
489
        ) {
490
            foreach my $k (sort keys %map_field) {
491
492
493
494
495
496
497
498
499
                if ($k eq 'custom_attribute') {
                    next unless ref $user->{$k} eq 'HASH' and %{$user->{$k}};
                    my $encoded = Sympa::Tools::Data::encode_custom_attribute(
                        $user->{$k});
                    printf $lock_fh "%s %s\n", $k, $encoded;
                } else {
                    next unless defined $user->{$k} and length $user->{$k};
                    printf $lock_fh "%s %s\n", $k, $user->{$k};
                }
500
            }
501

502
            # Compat.<=6.2.44
503
504
505
506
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

507
508
509
            print $lock_fh "\n";
        }
    } else {
IKEDA Soji's avatar
IKEDA Soji committed
510
511
        my %map_field = _map_list_admin_cols();

512
        foreach my $user (@{$self->get_current_admins || []}) {
513
            next unless $user->{role} eq $role;
IKEDA Soji's avatar
IKEDA Soji committed
514
            foreach my $k (sort keys %map_field) {
515
516
517
                printf $lock_fh "%s %s\n", $k, $user->{$k}
                    if defined $user->{$k} and length $user->{$k};
            }
518

519
            # Compat.<=6.2.44
520
521
522
523
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

524
525
            print $lock_fh "\n";
        }
root's avatar
root committed
526
    }
527

528
529
    $lock_fh->close;

530
531
532
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
533
534

    return 1;
root's avatar
root committed
535
536
537
538
539
}

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

542
543
    return undef
        unless ($self);
544
545
546
547

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

    ## Lock file
548
549
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
550
        $log->syslog('err', 'Could not create new lock');
551
        return undef;
552
553
    }

554
555
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
556
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
557
558
559

    ## Update management info
    $self->{'admin'}{'serial'}++;
560
    $self->{'admin'}{'update'} = {
561
562
        'email'      => $email,
        'date_epoch' => time,
563
    };
564

565
566
567
568
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
Luc Didry's avatar
Luc Didry committed
569
    ) {
570
        $log->syslog('info', 'Unable to save config file %s',
571
572
573
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
574
    }
575

576
    ## Also update the binary version of the data structure
577
578
579
    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
        'binary_file') {
        eval {
580
            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
581
582
        };
        if ($@) {
583
            $log->syslog('err',
584
585
586
                'Failed to save the binary config %s. error: %s',
                "$self->{'dir'}/config.bin", $@);
        }
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
    }

root's avatar
root committed
598
599
600
601
602
    return 1;
}

## Loads the administrative data for a list
sub load {
603
    $log->syslog('debug3', '(%s, %s, %s, ...)', @_);
604
605
606
607
608
609
    my $self    = shift;
    my $name    = shift;
    my $robot   = shift;
    my $options = shift;

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

611
612
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
613
614
615
616
617
618
619
        # Create parent of list directory if not exist yet e.g. when list to
        # be created manually.
        # Note: For compatibility, directory with primary domain is omitted.
        if (    $robot
            and $robot ne $Conf::Conf{'domain'}
            and not -d "$Conf::Conf{'home'}/$robot") {
            mkdir "$Conf::Conf{'home'}/$robot", 0775;
620
        }
621

622
623
624
625
626
        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 {
627
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
628
629
630
631
632
633
                unless ($options->{'just_try'});
            return undef;
        }

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

634
635
        # default list host is robot domain: Deprecated.
        #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
642
643
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
644
    }
salaun's avatar
salaun committed
645

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

651
652
653
654
655
656
    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);
657
    my $config_reloaded = 0;
root's avatar
root committed
658
    my $admin;
659
660

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
661
662
            'binary_file'
        and !$options->{'reload_config'}
663
        and $time_config_bin > $last_time_config
664
665
        and $time_config_bin >= $time_config
        and $time_config_bin >= $main_config_time) {
666
667
668
669
        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
670
            $log->syslog('err', 'Could not create new lock');
671
672
673
674
675
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
676
        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
677
        if ($@) {
678
            $log->syslog('err',
679
680
681
682
683
684
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

685
686
        $config_reloaded  = 1;
        $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
694
695
696

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {
697
            $log->syslog('err', 'Could not create new lock');
698
699
700
701
702
703
            return undef;
        }

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
704
            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
705
            if ($@) {
706
                $log->syslog('err',
707
708
709
710
711
712
713
                    'Failed to save the binary config %s. error: %s',
                    "$self->{'dir'}/config.bin", $@);
            }
        }

        $config_reloaded = 1;
        unless (defined $admin) {
714
            $log->syslog(
715
                'err',
sikeda's avatar
sikeda committed
716
717
                'Impossible to load list config file for list %s set in status error_config',
                $self
718
            );
719
            $self->set_status_error_config('load_admin_file_error');
720
721
722
723
            $lock_fh->close();
            return undef;
        }

724
        $last_time_config = $time_config;
725
        $lock_fh->close();
root's avatar
root committed
726
    }
727

728
729
    ## If config was reloaded...
    if ($admin) {
730
731
732
733
        $self->{'admin'} = $admin;

        ## check param_constraint.conf if belongs to a family and the config
        ## has been loaded
734
735
736
        if (    not $options->{'no_check_family'}
            and defined $admin->{'family_name'}
            and $admin->{'status'} ne 'error_config') {
737
738
            my $family;
            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
744
745
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
746
                    $self->{'admin'}{'family_name'});
747
748
749
750
751
752
753
754
755
                return undef;
            }
        }
    }

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

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

758
    $list_of_lists{$self->{'domain'}}{$name} = $self;
759
    return $config_reloaded;
root's avatar
root committed
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
770
## Return a hash of list's editors and their param(empty if there isn't any
## editor)
771
#OBSOLETED. Use get_admins().
772
#sub get_editors;
773

774
## Returns an array of owners' email addresses
775
776
#OBSOLETED: Use get_admins_email('receptive_owner') or
#           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
782
#OBSOLETED: Use get_admins_email('receptive_editor') or
#           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
786
787
sub get_family {
    my $self = shift;
788

789
    if (ref $self->{'family'} eq 'Sympa::Family') {
790
        return $self->{'family'};
791
792
    } elsif ($self->{'admin'}{'family_name'}) {
        return $self->{'family'} =
793
794
            Sympa::Family->new($self->{'admin'}{'family_name'},
            $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.
802
803
sub get_config_changes {
    my $self = shift;
804
    $log->syslog('debug3', '(%s)', $self->{'name'});
805

806
    unless ($self->{'admin'}{'family_name'}) {
807
        $log->syslog('err',
808
809
            '(%s) Is called but there is no family_name for this list',
            $self->{'name'});
810
        return undef;
811
    }
812

813
    ## load config_changes
814
815
    my $time_file =
        Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
816
817
818
819
    unless (defined $self->{'config_changes'}
        && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
        unless ($self->{'config_changes'} =
            $self->_load_config_changes_file()) {
820
            $log->syslog('err',
821
822
823
824
                'Impossible to load file config_changes from list %s',
                $self->{'name'});
            return undef;
        }
825
826
827
828
829
    }
    return $self->{'config_changes'};
}

## update file config_changes if the list belongs to a family by
830
#  writing the $what(file or param) name
831
832
833
834
835
sub update_config_changes {
    my $self = shift;
    my $what = shift;
    # one param or a ref on array of param
    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
843
844
845
            $self->{'name'},
            $what
        );
        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
851
852
        return undef;
    }

853
854
    # status parameter isn't updating set in config_changes
    if (($what eq 'param') && ($name eq 'status')) {
855
        return 1;
856
857
858
    }

    ## load config_changes
859
860
    my $time_file =
        Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
861
862
863
864
    unless (defined $self->{'config_changes'}
        && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
        unless ($self->{'config_changes'} =
            $self->_load_config_changes_file()) {
865
            $log->syslog('err',
866
867
868
869
                'Impossible to load file config_changes from list %s',
                $self->{'name'});
            return undef;
        }
870
    }
871
872
873
874
875

    if (ref($name) eq 'ARRAY') {
        foreach my $n (@{$name}) {
            $self->{'config_changes'}{$what}{$n} = 1;
        }
876
    } else {
877
        $self->{'config_changes'}{$what}{$name} = 1;
878
    }