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

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

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

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

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

=encoding utf-8

92
93
94
#=head1 NAME
#
#List - Mailing list
95

root's avatar
root committed
96
97
=head1 CONSTRUCTOR

98
99
=over

root's avatar
root committed
100
101
=item new( [PHRASE] )

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

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

124
B<Deprecated> on 6.2.23b.
root's avatar
root committed
125

126
Saves updates the statistics file on disk.
root's avatar
root committed
127

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

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

133
=item delete_list_member ( ARRAY )
root's avatar
root committed
134
135

Delete the indicated users from the list.
136

137
=item delete_list_admin ( ROLE, ARRAY )
138
139

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

142
=item dump_users ( ROLE )
143
144
145

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

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

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

Returns the number of subscribers to the list.

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

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

172
=item get_list_member ( USER )
173
174

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

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

Return an admin user of the list with predefined role

180
181
182
OBSOLETED.
Use get_admins().

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

Returns a hash to the first user on the list.

187
=item get_first_list_admin ( ROLE )
188

189
190
OBSOLETED.
Use get_admins().
191

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

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

197
=item get_next_list_admin ()
198

199
200
OBSOLETED.
Use get_admins().
201

202
=item restore_users ( ROLE )
203
204
205
206

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

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

212
=item update_list_admin ( USER, ROLE, HASHPTR )
213
214
215

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

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

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

221
222
223
224
225
=item add_admin_user ( USER, ROLE, HASHPTR )

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

226
=item is_list_member ( USER )
root's avatar
root committed
227
228

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

230
=item am_i ( ROLE, USER )
root's avatar
root committed
231

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

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

240
241
242
B<Note>:
This method was obsoleted.

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

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

=item archive_send ( WHO, FILE )

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

=item archive_ls ()

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

=item archive_msg ( MSG )

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

=item is_archived ()

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

276
277
278
279
280
=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".

281
282
283
284
=item is_included ( )

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

285
=item get_stats ( )
root's avatar
root committed
286

287
Returns array of the statistics.
root's avatar
root committed
288
289
290

=item print_info ( FDNAME )

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

294
295
=back

root's avatar
root committed
296
297
298
=cut

## Database and SQL statement handlers
299
my ($sth, @sth_stack);
300

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

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

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

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

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

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

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

352
353
    $options = {} unless (defined $options);

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

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

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

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

424
425
426
    return $list;
}

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

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

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

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

    return 0;
448
449
}

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

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

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

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

476
477
478
479
## 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;

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
sub get_stats {
Luc Didry's avatar
Luc Didry committed
578
    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
    utime undef, undef, $stat_file;    # required for such as NFS.
647
648
649
650
651
652
653
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

752
            # Compat.<=6.2.44
753
754
755
756
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

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

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

769
            # Compat.<=6.2.44
770
771
772
773
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

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

778
779
    $lock_fh->close;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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