List.pm 214 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 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
53
use Sympa::Robot;
use Sympa::Scenario;
IKEDA Soji's avatar
IKEDA Soji committed
54
use Sympa::Spindle::ProcessRequest;
55
use Sympa::Spindle::ProcessTemplate;
56
use Sympa::Spool::Auth;
57
use Sympa::Template;
58
use Sympa::Ticket;
59
use Sympa::Tools::Data;
60
use Sympa::Tools::Domains;
61
use Sympa::Tools::File;
62
use Sympa::Tools::Password;
63
use Sympa::Tools::SMIME;
64
use Sympa::Tools::Text;
65
use Sympa::User;
66

67
my @sources_providing_listmembers = qw/
68
69
70
71
72
73
    include_file
    include_ldap_2level_query
    include_ldap_query
    include_remote_file
    include_remote_sympa_list
    include_sql_query
74
    include_sympa_list
75
76
77
    /;

#XXX include_admin
78
my @more_data_sources = qw/
79
80
    editor_include
    owner_include
81
    member_include
82
    /;
83
84

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

89
my $language = Sympa::Language->instance;
90
my $log      = Sympa::Log->instance;
91
92
93

=encoding utf-8

94
95
96
#=head1 NAME
#
#List - Mailing list
97

root's avatar
root committed
98
99
=head1 CONSTRUCTOR

100
101
=over

root's avatar
root committed
102
103
=item new( [PHRASE] )

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

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

126
B<Deprecated> on 6.2.23b.
root's avatar
root committed
127

128
Saves updates the statistics file on disk.
root's avatar
root committed
129

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

132
133
Updates the stats, argument is number of bytes, returns list fo the updated
values.  Returns zeroes if failed.
134

135
=item delete_list_member ( ARRAY )
root's avatar
root committed
136
137

Delete the indicated users from the list.
138

139
=item delete_list_admin ( ROLE, ARRAY )
140
141

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

144
=item dump_users ( ROLE )
145
146
147

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'>.
148

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

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

Returns the number of subscribers to the list.

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

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

174
=item get_list_member ( USER )
175
176

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

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

Return an admin user of the list with predefined role

182
183
184
OBSOLETED.
Use get_admins().

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

Returns a hash to the first user on the list.

189
=item get_first_list_admin ( ROLE )
190

191
192
OBSOLETED.
Use get_admins().
193

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

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

199
=item get_next_list_admin ()
200

201
202
OBSOLETED.
Use get_admins().
203

204
=item restore_users ( ROLE )
205
206
207
208

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
209
=item update_list_member ( $email, key =E<gt> value, ... )
root's avatar
root committed
210

sikeda's avatar
sikeda committed
211
212
I<Instance method>.
Sets the new values given in the pairs for the user.
root's avatar
root committed
213

214
=item update_list_admin ( USER, ROLE, HASHPTR )
215
216
217

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

218
=item add_list_member ( USER, HASHPTR )
root's avatar
root committed
219
220
221
222

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

223
224
225
226
227
=item add_admin_user ( USER, ROLE, HASHPTR )

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

228
=item is_list_member ( USER )
root's avatar
root committed
229
230

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

232
=item am_i ( ROLE, USER )
root's avatar
root committed
233

234
DEPRECATED. Use is_admin().
root's avatar
root committed
235
236
237
238
239
240
241

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

242
243
244
B<Note>:
This method was obsoleted.

root's avatar
root committed
245
246
247
248
249
250
251
252
253
254
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 )

255
DEPRECATED.
root's avatar
root committed
256
257
258
259
Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

260
DEPRECATED.
root's avatar
root committed
261
262
263
264
Send the indicated archive file to the user, if it exists.

=item archive_ls ()

265
DEPRECATED.
root's avatar
root committed
266
267
268
269
Returns the list of available files, if any.

=item archive_msg ( MSG )

270
DEPRECATED.
root's avatar
root committed
271
272
273
274
275
276
277
Archives the Mail::Internet message given as argument.

=item is_archived ()

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

278
279
280
281
282
=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".

283
284
285
286
=item is_included ( )

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

287
=item get_stats ( )
root's avatar
root committed
288

289
Returns array of the statistics.
root's avatar
root committed
290
291
292

=item print_info ( FDNAME )

293
Print the list information to the given file descriptor, or the
root's avatar
root committed
294
295
currently selected descriptor.

296
297
=back

root's avatar
root committed
298
299
300
=cut

## Database and SQL statement handlers
301
my ($sth, @sth_stack);
302

sikeda's avatar
sikeda committed
303
304
305
306
307
308
309
310
311
312
313
314
# 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
315

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

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

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

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

338
339
340
341
    # 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);
342
343
    } else {
        $robot = lc $robot;    #FIXME: More canonicalization.
344
    }
345

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

354
355
    $options = {} unless (defined $options);

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

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

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

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

426
427
428
    return $list;
}

429
430
431
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
432

433
    unless ($listname) {
434
        $log->syslog('err', 'Missing list parameter');
435
        return undef;
436
    }
437

438
    ## Search in default robot
439
440
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
441
    }
442
443
444
445
446
447
448
449

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

    return 0;
450
451
}

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

457
458
    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
459
460
        $self->{'admin'}{'status'} = 'error_config';

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

472
473
474
475
# Destroy multiton instance. FIXME
sub destroy_multiton {
    my $self = shift;
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
root's avatar
root committed
476
477
}

478
479
480
481
## 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;

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

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

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

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

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

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

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

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

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

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

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

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

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

568
569
    return undef if ($latest_date == 0);
    return $latest_date;
570
571
}

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

579
sub get_stats {
Luc Didry's avatar
Luc Didry committed
580
    my $self = shift;
581

582
583
584
585
586
587
    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;
    }
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
624
625
    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
626
627
}

628
629
630
631
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

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

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

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

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

sub _cache_get {
Luc Didry's avatar
Luc Didry committed
680
681
    my $self = shift;
    my $type = shift;
682
683
684

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

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

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

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

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

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

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

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

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

732
    if ($role eq 'member') {
733
        my %map_field = _map_list_member_cols();
734

735
736
737
738
739
        my $user;
        for (
            $user = $self->get_first_list_member();
            $user;
            $user = $self->get_next_list_member()
Luc Didry's avatar
Luc Didry committed
740
        ) {
741
            foreach my $k (sort keys %map_field) {
742
743
744
745
746
747
748
749
750
                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};
                }
751
            }
752

IKEDA Soji's avatar
IKEDA Soji committed
753
            # Compat.<=6.2.40
754
755
756
757
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

758
759
760
            print $lock_fh "\n";
        }
    } else {
IKEDA Soji's avatar
IKEDA Soji committed
761
762
        my %map_field = _map_list_admin_cols();

763
        foreach my $user (@{$self->get_current_admins || []}) {
764
            next unless $user->{role} eq $role;
IKEDA Soji's avatar
IKEDA Soji committed
765
            foreach my $k (sort keys %map_field) {
766
767
768
                printf $lock_fh "%s %s\n", $k, $user->{$k}
                    if defined $user->{$k} and length $user->{$k};
            }
769

IKEDA Soji's avatar
IKEDA Soji committed
770
            # Compat.<=6.2.40
771
772
773
774
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

775
776
            print $lock_fh "\n";
        }
root's avatar
root committed
777
    }
778

779
780
    $lock_fh->close;

781
782
783
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
784
785

    return 1;
root's avatar
root committed
786
787
788
789
790
}

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

793
794
    return undef
        unless ($self);
795
796
797
798

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

    ## Lock file
799
800
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
801
        $log->syslog('err', 'Could not create new lock');
802
        return undef;
803
804
    }

805
806
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
807
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
808
809
810

    ## Update management info
    $self->{'admin'}{'serial'}++;
811
    $self->{'admin'}{'update'} = {
812
813
        'email'      => $email,
        'date_epoch' => time,
814
    };
815

816
817
818
819
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
Luc Didry's avatar
Luc Didry committed
820
    ) {
821
        $log->syslog('info', 'Unable to save config file %s',
822
823
824
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
825
    }
826

827
    ## Also update the binary version of the data structure
828
829
830
    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
        'binary_file') {
        eval {
831
            Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
832
833
        };
        if ($@) {
834
            $log->syslog('err',
835
836
837
                'Failed to save the binary config %s. error: %s',
                "$self->{'dir'}/config.bin", $@);
        }
838
839
    }

840
    ## Release the lock
841
    unless ($lock_fh->close()) {
842
        return undef;
843
844
    }

845
    unless ($self->_update_list_db) {
846
        $log->syslog('err', "Unable to update list_table");
847
848
    }

root's avatar
root committed
849
850
851
852
853
    return 1;
}

## Loads the administrative data for a list
sub load {
854
855
856
857
858
859
860
    $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;
861

862
863
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
864
865
866
867
868
869
870
        # 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;
871
        }
872

873
874
875
876
877
        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 {
878
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
879
880
881
882
883
884
                unless ($options->{'just_try'});
            return undef;
        }

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

885
886
        # default list host is robot domain: Deprecated.
        #XXX$self->{'admin'}{'host'} ||= $self->{'domain'};
887
        $self->{'name'} = $name;
888
    }
889

890
    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
891
        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
892
893
894
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
895
    }
salaun's avatar
salaun committed
896

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

902
903
904
905
906
907
    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);
908
    my $config_reloaded = 0;
root's avatar
root committed
909
    my $admin;
910
911

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
912
913
            'binary_file'
        and !$options->{'reload_config'}
914
        and $time_config_bin > $last_time_config
915
916
        and $time_config_bin >= $time_config
        and $time_config_bin >= $main_config_time) {
917
918
919
920
        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
921
            $log->syslog('err', 'Could not create new lock');
922
923
924
925
926
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
927
        eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
928
        if ($@) {
929
            $log->syslog('err',
930
931
932
933
934
935
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

936
937
        $config_reloaded  = 1;
        $last_time_config = $time_config_bin;
938
        $lock_fh->close();
939
    } elsif ($self->{'name'} ne $name
940
        or $time_config > $last_time_config
941
        or $options->{'reload_config'}) {
942
        $admin = $self->_load_list_config_file;
943
944
945
946
947

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {