List.pm 300 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

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

131
B<Deprecated> on 6.2.23b.
root's avatar
root committed
132

133
Saves updates the statistics file on disk.
root's avatar
root committed
134

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

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

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

281
=item get_stats ( )
root's avatar
root committed
282

283
Returns array of the statistics.
root's avatar
root committed
284
285
286

=item print_info ( FDNAME )

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

290
291
=back

root's avatar
root committed
292
293
294
=cut

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

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

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

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

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

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

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

342
343
    $options = {} unless (defined $options);

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

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

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

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

412
413
414
    return $list;
}

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

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

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

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

    return 0;
436
437
}

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

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

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

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

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

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

480
481
482
# Saves the statistics data to disk.
# Deprecated. Use Sympa::List::update_stats().
#sub savestats;
root's avatar
root committed
483

484
## msg count.
485
486
# Old name: increment_msg_count().
sub _increment_msg_count {
487
    $log->syslog('debug2', '(%s)', @_);
488
    my $self = shift;
489

490
    # Be sure the list has been loaded.
491
    my $file = "$self->{'dir'}/msg_count";
492
493
494
495
496
497
498
499
500

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
501
502
503
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
504
505
506
        $count{$today}++;
    } else {
        $count{$today} = 1;
507
    }
508

509
    unless (open(MSG_COUNT, ">$file.$PID")) {
510
        $log->syslog('err', 'Unable to create "%s.%s": %m', $file, $PID);
511
        return undef;
512
    }
513
514
    foreach my $key (sort { $a <=> $b } keys %count) {
        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
515
    }
516
517
    close MSG_COUNT;

518
    unless (rename("$file.$PID", $file)) {
519
        $log->syslog('err', 'Unable to write "%s": %m', $file);
520
        return undef;
521
522
523
524
    }
    return 1;
}

525
526
# Returns the number of messages sent to the list
sub get_msg_count {
527
    $log->syslog('debug2', '(%s)', @_);
528
529
    my $self = shift;

530
    # Be sure the list has been loaded.
531
    my $file = "$self->{'dir'}/stats";
532
533
534
535
536
537
538
539
540

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
541
542
543
544
    }

    return $count;
}
545
546
## last date of distribution message .
sub get_latest_distribution_date {
547
    $log->syslog('debug2', '(%s)', @_);
548
    my $self = shift;
549

550
    # Be sure the list has been loaded.
551
    my $file = "$self->{'dir'}/msg_count";
552
553

    my $latest_date = 0;
salaun's avatar
salaun committed
554
    unless (open(MSG_COUNT, $file)) {
555
        $log->syslog('debug2', 'Unable to open %s', $file);
556
        return undef;
salaun's avatar
salaun committed
557
    }
558

559
560
561
562
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
563
    }
564
    close MSG_COUNT;
565

566
567
    return undef if ($latest_date == 0);
    return $latest_date;
568
569
}

570
## Update the stats struct
root's avatar
root committed
571
572
## Input  : num of bytes of msg
## Output : num of msgs sent
573
# Old name: List::update_stats().
574
575
# No longer used. Use Sympa::List::update_stats(1);
#sub get_next_sequence;
576

577
578
sub get_stats {
    my $self  = shift;
579

580
581
582
583
584
585
    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;
    }
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
611
612
613
614
615
616
617
618
619
620
621
622
623
    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
624
625
}

626
627
628
629
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

630
    my $stat_file;
631
    if ($type eq 'member') {
632
633
634
        $stat_file = $self->{'dir'} . '/.last_change.member';
    } elsif ($type eq 'last_sync') {
        $stat_file = $self->{'dir'} . '/.last_sync.member';
635
636
637
638
    } 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';
639
640
    } else {
        die 'bug in logic. Ask developer';
641
    }
642
643
644
645

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
646
647
648
649
650
651
652
}

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

    if ($type eq 'member') {
653
654
655
656
657
658
659
660
        # 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');
661
662
663
664
665
666
667
668
669
    } 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');
670
    } elsif ($type eq 'edit_list_conf') {
IKEDA Soji's avatar
Typo.    
IKEDA Soji committed
671
        return [stat Sympa::search_fullpath($self, 'edit_list.conf')]->[9];
672
673
    } else {
        die 'bug in logic. Ask developer';
674
675
676
677
678
679
680
681
682
    }
}

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

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
683
    if ($type eq 'total' or $type eq 'is_list_member') {
684
685
        $mtime = $self->_cache_read_expiry('member');
    } else {
686
        $mtime = $self->_cache_read_expiry($type);
687
688
689
    }
    $self->{_mtime}{$type} = $mtime;

690
691
692
    return undef unless defined $lasttime and defined $mtime;
    return undef if $lasttime < $mtime;
    return $self->{_cached}{$type};
693
694
695
696
697
698
699
700
701
702
}

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

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

703
# Old name: List::extract_verp_rcpt().
704
705
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;
706

root's avatar
root committed
707
708
## Dumps a copy of lists to disk, in text format
sub dump {
709
    my $self = shift;
710
    $log->syslog('debug2', '(%s)', $self->{'name'});
711

712
    unless (defined $self) {
713
        $log->syslog('err', 'Unknown list');
714
        return undef;
715
    }
716

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

719
    unless ($self->_save_list_members_file($user_file_name)) {
720
        $log->syslog('err', 'Failed to save file %s', $user_file_name);
721
        return undef;
root's avatar
root committed
722
    }
723

724
    # Note: "subscribers" file was deprecated. No need to load "stats" file.
725
726
727
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
728
729

    return 1;
root's avatar
root committed
730
731
732
733
734
}

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

737
738
    return undef
        unless ($self);
739
740
741
742

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

    ## Lock file
743
744
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
745
        $log->syslog('err', 'Could not create new lock');
746
        return undef;
747
748
    }

749
750
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
751
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
752
753
754

    ## Update management info
    $self->{'admin'}{'serial'}++;
755
    $self->{'admin'}{'update'} = {
756
757
        'email'      => $email,
        'date_epoch' => time,
758
    };
759

760
761
762
763
764
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
        ) {
765
        $log->syslog('info', 'Unable to save config file %s',
766
767
768
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
769
    }
770

771
    ## Also update the binary version of the data structure
772
773
774
    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
        'binary_file') {
        eval {
775
            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
776
777
        };
        if ($@) {
778
            $log->syslog('err',
779
780
781
                'Failed to save the binary config %s. error: %s',
                "$self->{'dir'}/config.bin", $@);
        }
782
783
    }

784
    ## Release the lock
785
    unless ($lock_fh->close()) {
786
        return undef;
787
788
    }

789
    unless ($self->_update_list_db) {
790
        $log->syslog('err', "Unable to update list_table");
791
792
    }

root's avatar
root committed
793
794
795
796
797
    return 1;
}

## Loads the administrative data for a list
sub load {
798
799
800
801
802
803
804
    $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;
805

806
807
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
808
809
810
811
812
        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 {
813
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
814
815
816
817
818
819
820
821
822
                unless ($options->{'just_try'});
            return undef;
        }

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

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

825
    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
826
        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
827
828
829
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
830
    }
salaun's avatar
salaun committed
831

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

837
838
839
840
841
842
    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);
843
    my $config_reloaded = 0;
root's avatar
root committed
844
    my $admin;
845
846

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
847
848
            'binary_file'
        and !$options->{'reload_config'}
849
        and $time_config_bin > $last_time_config
850
851
        and $time_config_bin >= $time_config
        and $time_config_bin >= $main_config_time) {
852
853
854
855
        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
856
            $log->syslog('err', 'Could not create new lock');
857
858
859
860
861
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
862
        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
863
        if ($@) {
864
            $log->syslog('err',
865
866
867
868
869
870
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

871
872
        $config_reloaded  = 1;
        $last_time_config = $time_config_bin;
873
        $lock_fh->close();
874
    } elsif ($self->{'name'} ne $name
875
        or $time_config > $last_time_config
876
        or $options->{'reload_config'}) {
877
        $admin = $self->_load_list_config_file;
878
879
880
881
882

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {
883
            $log->syslog('err', 'Could not create new lock');
884
885
886
887
888
889
            return undef;
        }

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
890
            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
891
            if ($@) {
892
                $log->syslog('err',
893
894
895
896
897
898
899
                    'Failed to save the binary config %s. error: %s',
                    "$self->{'dir'}/config.bin", $@);
            }
        }

        $config_reloaded = 1;
        unless (defined $admin) {
900
            $log->syslog(
901
                'err',
sikeda's avatar
sikeda committed
902
903
                'Impossible to load list config file for list %s set in status error_config',
                $self
904
            );
905
            $self->set_status_error_config('load_admin_file_error');
906
907
908
909
            $lock_fh->close();
            return undef;
        }

910
        $last_time_config = $time_config;
911
        $lock_fh->close();
root's avatar
root committed
912
    }
913

914
915
    ## If config was reloaded...
    if ($admin) {
916
917
918
919
920
921
922
923
        $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()) {
924
                $log->syslog(
925
                    'err',
926
                    'Impossible to get list %s family: %s. The list is set in status error_config',
927
                    $self,
928
929
930
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
931
                    $self->{'admin'}{'family_name'});
932
933
934
935
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
936
                $log->syslog(
937
938
939
940
941
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
942
                    $family->{'name'});
943
944
            }
            if (ref($error) eq 'ARRAY') {
945
                $log->syslog(
946
947
948
949
950
951
                    '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',
952
                    $family->{'name'});
953
954
955
956
957
958
959
960
            }
        }
    }

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

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

963
    $list_of_lists{$self->{'domain'}}{$name} = $self;
964
    return $config_reloaded;
root's avatar
root committed
965
966
}

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

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

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

983
    return scalar @{$self->get_admins('owner')};
984
985
}

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

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

998
## Returns an array of owners' email addresses
999
1000
#OBSOLETED: Use get_admins_email('receptive_owner') or
#           get_admins_email('owner').
salaun's avatar
salaun committed
1001
sub get_owners_email {
1002
1003
1004
    $log->syslog('debug3', '(%s, %s)', @_);
    my $self  = shift;
    my $param = shift;
1005

1006
    my @rcpt;
1007

1008
    if ($param->{'ignore_nomail'}) {
1009
        @rcpt = map { $_->{'email'} } $self->get_admins('owner');
1010
    } else {
1011
        @rcpt = map { $_->{'email'} } $self->get_admins('receptive_owner');
1012
1013
    }
    unless (@rcpt) {
1014
        $log->syslog('notice', 'Warning: No owner found for list %s', $self);
1015
    }