List.pm 294 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 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 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
use Sympa::Tools::Data;
64
use Sympa::Tools::Domains;
65
use Sympa::Tools::File;
66
use Sympa::Tools::Password;
67
use Sympa::Tools::SMIME;
68
use Sympa::Tools::Text;
69
use Sympa::User;
70

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

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

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

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

=encoding utf-8

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

root's avatar
root committed
102
103
=head1 CONSTRUCTOR

104
105
=over

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

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

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

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

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

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

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

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

Delete the indicated users from the list.
142

143
=item delete_list_admin ( ROLE, ARRAY )
144
145

Delete the indicated admin user with the predefined role from the list.
146
147
ROLE may be C<'owner'> or C<'editor'>.

148
=item dump_users ( ROLE )
149
150
151

Dump user information in user store into file C<I<$role>.dump> under
list directory. ROLE may be C<'member'>, C<'owner'> or C<'editor'>.
152

root's avatar
root committed
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
=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.

169
=item get_total ( [ 'nocache' ] )
root's avatar
root committed
170
171
172

Returns the number of subscribers to the list.

173
=item get_global_user ( USER )
root's avatar
root committed
174

175
Returns a hash with the information regarding the indicated
root's avatar
root committed
176
177
user.

178
=item get_list_member ( USER )
179
180

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

182
=item get_list_admin ( ROLE, USER)
183
184
185

Return an admin user of the list with predefined role

186
187
188
OBSOLETED.
Use get_admins().

189
=item get_first_list_member ()
root's avatar
root committed
190
191
192

Returns a hash to the first user on the list.

193
=item get_first_list_admin ( ROLE )
194

195
196
OBSOLETED.
Use get_admins().
197

198
=item get_next_list_member ()
root's avatar
root committed
199
200
201
202

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

203
=item get_next_list_admin ()
204

205
206
OBSOLETED.
Use get_admins().
207

208
=item restore_users ( ROLE )
209
210
211
212

Import user information into user store from file C<I<$role>.dump> under
list directory. ROLE may be C<'member'>, C<'owner'> or C<'editor'>.

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

sikeda's avatar
sikeda committed
215
216
I<Instance method>.
Sets the new values given in the pairs for the user.
root's avatar
root committed
217

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

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

222
=item add_list_member ( USER, HASHPTR )
root's avatar
root committed
223
224
225
226

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

227
228
229
230
231
=item add_admin_user ( USER, ROLE, HASHPTR )

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

232
=item is_list_member ( USER )
root's avatar
root committed
233
234

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

236
=item am_i ( ROLE, USER )
root's avatar
root committed
237

238
DEPRECATED. Use is_admin().
root's avatar
root committed
239
240
241
242
243
244
245

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

246
247
248
B<Note>:
This method was obsoleted.

root's avatar
root committed
249
250
251
252
253
254
255
256
257
258
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 )

259
DEPRECATED.
root's avatar
root committed
260
261
262
263
Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

264
DEPRECATED.
root's avatar
root committed
265
266
267
268
Send the indicated archive file to the user, if it exists.

=item archive_ls ()

269
DEPRECATED.
root's avatar
root committed
270
271
272
273
Returns the list of available files, if any.

=item archive_msg ( MSG )

274
DEPRECATED.
root's avatar
root committed
275
276
277
278
279
280
281
Archives the Mail::Internet message given as argument.

=item is_archived ()

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

282
283
284
285
286
=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".

287
288
289
290
=item is_included ( )

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

291
=item get_stats ( )
root's avatar
root committed
292

293
Returns array of the statistics.
root's avatar
root committed
294
295
296

=item print_info ( FDNAME )

297
Print the list information to the given file descriptor, or the
root's avatar
root committed
298
299
currently selected descriptor.

300
301
=back

root's avatar
root committed
302
303
304
=cut

## Database and SQL statement handlers
305
my ($sth, @sth_stack);
306

sikeda's avatar
sikeda committed
307
308
309
310
311
312
313
314
315
316
317
318
# 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
319

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

root's avatar
root committed
323
324
## Creates an object.
sub new {
325
326
    my ($pkg, $name, $robot, $options) = @_;
    my $list = {};
327
    $log->syslog('debug2', '(%s, %s, %s)', $name, $robot,
328
        join('/', keys %$options));
329

IKEDA Soji's avatar
IKEDA Soji committed
330
331
332
333
334
    # Lowercase list name.
    $name = lc $name;
    # In case the variable was multiple. FIXME:required?
    $name = $1 if $name =~ /^(\S+)\0/;

335
336
    ## Allow robot in the name
    if ($name =~ /\@/) {
337
338
339
        my @parts = split /\@/, $name;
        $robot ||= $parts[1];
        $name = $parts[0];
340
    }
root's avatar
root committed
341

342
343
344
345
    # 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);
346
347
    } else {
        $robot = lc $robot;    #FIXME: More canonicalization.
348
    }
349

350
    unless ($robot) {
351
        $log->syslog('err',
352
353
354
355
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
356
357
    }

358
359
    $options = {} unless (defined $options);

root's avatar
root committed
360
    ## Only process the list if the name is valid.
361
    #FIXME: Existing lists may be checked with looser rule.
362
    my $listname_regexp = Sympa::Regexps::listname();
363
    unless ($name and ($name =~ /^($listname_regexp)$/io)) {
364
        $log->syslog('err', 'Incorrect listname "%s"', $name)
365
366
            unless ($options->{'just_try'});
        return undef;
root's avatar
root committed
367
368
    }
    ## Lowercase the list name.
369
    $name = $1;
root's avatar
root committed
370
    $name =~ tr/A-Z/a-z/;
371

372
    ## Reject listnames with reserved list suffixes
373
374
375
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($name =~ /^(\S+)-($regx)$/) {
376
            $log->syslog(
377
378
379
380
381
382
                'err',
                'Incorrect name: listname "%s" matches one of service aliases',
                $name
            ) unless ($options->{'just_try'});
            return undef;
        }
383
384
    }

385
    my $status;
386
    ## If list already in memory and not previously purged by another process
387
388
389
390
391
392
393
394
395
396
397
398
399
    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);
    }
400
    unless (defined $status) {
401
        return undef;
402
403
404
    }

    ## Config file was loaded or reloaded
405
406
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}
        || $list->{'admin'}{'ttl'};
Luc Didry's avatar
Luc Didry committed
407
408
    if (    $status
        and grep { $list->{'admin'}{'status'} eq $_ } qw(open pending)
409
410
411
412
        and (
            (   not $options->{'skip_sync_admin'}
                and $list->_cache_read_expiry('last_sync_admin_user') <
                time - $pertinent_ttl
sikeda's avatar
sikeda committed
413
            )
414
            or $options->{'force_sync_admin'}
sikeda's avatar
sikeda committed
415
        )
Luc Didry's avatar
Luc Didry committed
416
    ) {
417
418
        ## Update admin_table
        unless (defined $list->sync_include_admin()) {
419
            $log->syslog('err', '')
420
421
                unless ($options->{'just_try'});
        }
422
423
        if (not @{$list->get_admins('owner') || []}
            and $list->{'admin'}{'status'} ne 'error_config') {
424
            $log->syslog('err', 'The list "%s" has got no owner defined',
425
                $list->{'name'});
426
            $list->set_status_error_config('no_owner_defined');
427
        }
root's avatar
root committed
428
429
    }

430
431
432
    return $list;
}

433
434
435
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
436

437
    unless ($listname) {
438
        $log->syslog('err', 'Missing list parameter');
439
        return undef;
440
    }
441

442
    ## Search in default robot
443
444
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
445
    }
446
447
448
449
450
451
452
453

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

    return 0;
454
455
}

456
457
## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
458
    $log->syslog('debug2', '(%s, %s, ...)', @_);
459
    my ($self, $msg, @param) = @_;
460

461
462
    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
463
464
        $self->{'admin'}{'status'} = 'error_config';

465
466
467
        # No more save config in error...
        # $self->save_config(tools::get_address($self->{'domain'},
        #     'listmaster'));
468
        $log->syslog('err',
469
470
            'The list %s is set in status error_config: %s(%s)',
            $self, $msg, join(', ', @param));
471
        Sympa::send_notify_to_listmaster($self, $msg,
472
            [$self->{'name'}, @param]);
473
474
475
    }
}

476
477
478
479
# Destroy multiton instance. FIXME
sub destroy_multiton {
    my $self = shift;
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
root's avatar
root committed
480
481
}

482
483
484
485
## 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;

486
487
488
# Saves the statistics data to disk.
# Deprecated. Use Sympa::List::update_stats().
#sub savestats;
root's avatar
root committed
489

490
## msg count.
491
492
# Old name: increment_msg_count().
sub _increment_msg_count {
493
    $log->syslog('debug2', '(%s)', @_);
494
    my $self = shift;
495

496
    # Be sure the list has been loaded.
497
    my $file = "$self->{'dir'}/msg_count";
498
499
500
501
502
503
504
505
506

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
507
508
509
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
510
511
512
        $count{$today}++;
    } else {
        $count{$today} = 1;
513
    }
514

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

524
    unless (rename("$file.$PID", $file)) {
525
        $log->syslog('err', 'Unable to write "%s": %m', $file);
526
        return undef;
527
528
529
530
    }
    return 1;
}

531
532
# Returns the number of messages sent to the list
sub get_msg_count {
533
    $log->syslog('debug2', '(%s)', @_);
534
535
    my $self = shift;

536
    # Be sure the list has been loaded.
537
    my $file = "$self->{'dir'}/stats";
538
539
540
541
542
543
544
545
546

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
547
548
549
550
    }

    return $count;
}
551
552
## last date of distribution message .
sub get_latest_distribution_date {
553
    $log->syslog('debug2', '(%s)', @_);
554
    my $self = shift;
555

556
    # Be sure the list has been loaded.
557
    my $file = "$self->{'dir'}/msg_count";
558
559

    my $latest_date = 0;
salaun's avatar
salaun committed
560
    unless (open(MSG_COUNT, $file)) {
561
        $log->syslog('debug2', 'Unable to open %s', $file);
562
        return undef;
salaun's avatar
salaun committed
563
    }
564

565
566
567
568
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
569
    }
570
    close MSG_COUNT;
571

572
573
    return undef if ($latest_date == 0);
    return $latest_date;
574
575
}

576
## Update the stats struct
root's avatar
root committed
577
578
## Input  : num of bytes of msg
## Output : num of msgs sent
579
# Old name: List::update_stats().
580
581
# No longer used. Use Sympa::List::update_stats(1);
#sub get_next_sequence;
582

583
sub get_stats {
Luc Didry's avatar
Luc Didry committed
584
    my $self = shift;
585

586
587
588
589
590
591
    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;
    }
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
624
625
626
627
628
629
    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
630
631
}

632
633
634
635
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

636
    my $stat_file;
637
    if ($type eq 'member') {
638
639
640
        $stat_file = $self->{'dir'} . '/.last_change.member';
    } elsif ($type eq 'last_sync') {
        $stat_file = $self->{'dir'} . '/.last_sync.member';
641
642
643
644
    } 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';
645
646
    } else {
        die 'bug in logic. Ask developer';
647
    }
648
649
650
651

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
652
653
654
655
656
657
658
}

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

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

sub _cache_get {
Luc Didry's avatar
Luc Didry committed
684
685
    my $self = shift;
    my $type = shift;
686
687
688

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
689
    if ($type eq 'total' or $type eq 'is_list_member') {
690
691
        $mtime = $self->_cache_read_expiry('member');
    } else {
692
        $mtime = $self->_cache_read_expiry($type);
693
694
695
    }
    $self->{_mtime}{$type} = $mtime;

696
697
698
    return undef unless defined $lasttime and defined $mtime;
    return undef if $lasttime < $mtime;
    return $self->{_cached}{$type};
699
700
701
702
703
704
705
706
707
708
}

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

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

709
# Old name: List::extract_verp_rcpt().
710
711
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;
712

713
714
# Dumps a copy of list users to disk, in text format.
# Old name: Sympa::List::dump() which dumped only members.
715
sub dump_users {
716
    $log->syslog('debug2', '(%s, %s)', @_);
717
    my $self = shift;
718
    my $role = shift;
719

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

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

725
726
727
728
    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
729
730
731
732
        $log->syslog(
            'err', 'Failed to save file %s.new: %s',
            $file, Sympa::LockedFile->last_error
        );
733
        return undef;
734
    }
735

736
    if ($role eq 'member') {
737
        my %map_field = _map_list_member_cols();
738

739
740
741
742
743
        my $user;
        for (
            $user = $self->get_first_list_member();
            $user;
            $user = $self->get_next_list_member()
Luc Didry's avatar
Luc Didry committed
744
        ) {
745
            foreach my $k (sort keys %map_field) {
746
747
748
749
750
751
                printf $lock_fh "%s %s\n", $k, $user->{$k}
                    if defined $user->{$k} and length $user->{$k};
            }
            print $lock_fh "\n";
        }
    } else {
IKEDA Soji's avatar
IKEDA Soji committed
752
753
        my %map_field = _map_list_admin_cols();

754
        foreach my $user (@{$self->get_current_admins || []}) {
755
            next unless $user->{role} eq $role;
IKEDA Soji's avatar
IKEDA Soji committed
756
            foreach my $k (sort keys %map_field) {
757
758
759
760
761
                printf $lock_fh "%s %s\n", $k, $user->{$k}
                    if defined $user->{$k} and length $user->{$k};
            }
            print $lock_fh "\n";
        }
root's avatar
root committed
762
    }
763

764
765
    $lock_fh->close;

766
767
768
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
769
770

    return 1;
root's avatar
root committed
771
772
773
774
775
}

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

778
779
    return undef
        unless ($self);
780
781
782
783

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

    ## Lock file
784
785
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
786
        $log->syslog('err', 'Could not create new lock');
787
        return undef;
788
789
    }

790
791
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
792
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
793
794
795

    ## Update management info
    $self->{'admin'}{'serial'}++;
796
    $self->{'admin'}{'update'} = {
797
798
        'email'      => $email,
        'date_epoch' => time,
799
    };
800

801
802
803
804
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
Luc Didry's avatar
Luc Didry committed
805
    ) {
806
        $log->syslog('info', 'Unable to save config file %s',
807
808
809
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
810
    }
811

812
    ## Also update the binary version of the data structure
813
814
815
    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
        'binary_file') {
        eval {
816
            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
817
818
        };
        if ($@) {
819
            $log->syslog('err',
820
821
822
                'Failed to save the binary config %s. error: %s',
                "$self->{'dir'}/config.bin", $@);
        }
823
824
    }

825
    ## Release the lock
826
    unless ($lock_fh->close()) {
827
        return undef;
828
829
    }

830
    unless ($self->_update_list_db) {
831
        $log->syslog('err', "Unable to update list_table");
832
833
    }

root's avatar
root committed
834
835
836
837
838
    return 1;
}

## Loads the administrative data for a list
sub load {
839
840
841
842
843
844
845
    $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;
846

847
848
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
849
850
851
852
853
854
855
        # 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;
856
        }
857

858
859
860
861
862
        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 {
863
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
864
865
866
867
868
869
                unless ($options->{'just_try'});
            return undef;
        }

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

870
871
        # default list host is robot domain: Deprecated.
        #XXX$self->{'admin'}{'host'} ||= $self->{'domain'};
872
        $self->{'name'} = $name;
873
    }
874

875
    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
876
        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
877
878
879
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
880
    }
salaun's avatar
salaun committed
881

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

887
888
889
890
891
892
    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);
893
    my $config_reloaded = 0;
root's avatar
root committed
894
    my $admin;
895
896

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
897
898
            'binary_file'
        and !$options->{'reload_config'}
899
        and $time_config_bin > $last_time_config
900
901
        and $time_config_bin >= $time_config
        and $time_config_bin >= $main_config_time) {
902
903
904
905
        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
906
            $log->syslog('err', 'Could not create new lock');
907
908
909
910
911
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
912
        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
913
        if ($@) {
914
            $log->syslog('err',
915
916
917
918
919
920
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

921
922
        $config_reloaded  = 1;
        $last_time_config = $time_config_bin;
923
        $lock_fh->close();
924
    } elsif ($self->{'name'} ne $name
925
        or $time_config > $last_time_config
926
        or $options->{'reload_config'}) {
927
        $admin = $self->_load_list_config_file;
928
929
930
931
932

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {
933
            $log->syslog('err', 'Could not create new lock');
934
935
936
937
938
939
            return undef;
        }

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
940
            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
941
            if ($@) {
942
                $log->syslog('err',
943
944
945
946
947
948
949
                    'Failed to save the binary config %s. error: %s',
                    "$self->{'dir'}/config.bin", $@);
            }
        }

        $config_reloaded = 1;
        unless (defined $admin) {
950
            $log->syslog(
951
                'err',
sikeda's avatar
sikeda committed
952
953
                'Impossible to load list config file for list %s set in status error_config',
                $self
954
            );
955
            $self->set_status_error_config('load_admin_file_error');
956
957
958
959
            $lock_fh->close();
            return undef;
        }

960
        $last_time_config = $time_config;
961
        $lock_fh->close();
root's avatar
root committed
962
    }
963

964
965
    ## If config was reloaded...
    if ($admin) {
966
967
968
969
970
971
972
973
        $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()) {
974
                $log->syslog(
975
                    'err',
976
                    'Impossible to get list %s family: %s. The list is set in status error_config',
977
                    $self,
978
979
980
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
981
                    $self->{'admin'}{'family_name'});
982
983
984
985
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
986
                $log->syslog(
987
988
989
990
991
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
992
                    $family->{'name'});
993
994
            }
            if (ref($error) eq 'ARRAY') {
995
                $log->syslog(
996
997
998
999
1000
                    'err',
                    'The list "%s" does not respect the rules from its family %s',
                    $self->{'name'},
                    $family->{'name'}
                );
For faster browsing, not all history is shown. View entire blame