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, 2020 The Sympa Community. See the AUTHORS.md
# file at the top-level directory of this distribution and at
13
# <https://github.com/sympa-community/sympa.git>.
14
15
16
17
18
19
20
21
22
23
24
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
25
26
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
root's avatar
root committed
27

28
package Sympa::List;
root's avatar
root committed
29
30

use strict;
31
use warnings;
32
use Digest::MD5 qw();
33
use English qw(-no_match_vars);
34
use IO::Scalar;
sikeda's avatar
sikeda committed
35
use POSIX qw();
36
use Storable qw();
37

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

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

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

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

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

=encoding utf-8

87
88
89
#=head1 NAME
#
#List - Mailing list
90

root's avatar
root committed
91
92
=head1 CONSTRUCTOR

93
94
=over

root's avatar
root committed
95
96
=item new( [PHRASE] )

97
 Sympa::List->new();
root's avatar
root committed
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118

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

119
B<Deprecated> on 6.2.23b.
root's avatar
root committed
120

121
Saves updates the statistics file on disk.
root's avatar
root committed
122

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

125
126
Updates the stats, argument is number of bytes, returns list fo the updated
values.  Returns zeroes if failed.
127

128
=item delete_list_member ( ARRAY )
root's avatar
root committed
129
130

Delete the indicated users from the list.
131

132
=item delete_list_admin ( ROLE, ARRAY )
133
134

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

137
=item dump_users ( ROLE )
138
139
140

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

root's avatar
root committed
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
=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.

158
=item get_total ( [ 'nocache' ] )
root's avatar
root committed
159
160
161

Returns the number of subscribers to the list.

162
=item get_global_user ( USER )
root's avatar
root committed
163

164
Returns a hash with the information regarding the indicated
root's avatar
root committed
165
166
user.

167
=item get_list_member ( USER )
168
169

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

171
=item get_list_admin ( ROLE, USER)
172
173
174

Return an admin user of the list with predefined role

175
176
177
OBSOLETED.
Use get_admins().

178
=item get_first_list_member ()
root's avatar
root committed
179
180
181

Returns a hash to the first user on the list.

182
=item get_first_list_admin ( ROLE )
183

184
185
OBSOLETED.
Use get_admins().
186

187
=item get_next_list_member ()
root's avatar
root committed
188
189
190
191

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

192
=item get_next_list_admin ()
193

194
195
OBSOLETED.
Use get_admins().
196

197
=item restore_users ( ROLE )
198
199
200
201

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

sikeda's avatar
sikeda committed
204
205
I<Instance method>.
Sets the new values given in the pairs for the user.
root's avatar
root committed
206

207
=item update_list_admin ( USER, ROLE, HASHPTR )
208
209
210

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

211
=item add_list_member ( USER, HASHPTR )
root's avatar
root committed
212
213
214
215

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

216
217
218
219
220
=item add_admin_user ( USER, ROLE, HASHPTR )

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

221
=item is_list_member ( USER )
root's avatar
root committed
222
223

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

225
=item am_i ( ROLE, USER )
root's avatar
root committed
226

227
DEPRECATED. Use is_admin().
root's avatar
root committed
228
229
230
231
232
233
234

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

235
236
237
B<Note>:
This method was obsoleted.

root's avatar
root committed
238
239
240
241
242
243
244
245
246
247
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 )

248
DEPRECATED.
root's avatar
root committed
249
250
251
252
Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

253
DEPRECATED.
root's avatar
root committed
254
255
256
257
Send the indicated archive file to the user, if it exists.

=item archive_ls ()

258
DEPRECATED.
root's avatar
root committed
259
260
261
262
Returns the list of available files, if any.

=item archive_msg ( MSG )

263
DEPRECATED.
root's avatar
root committed
264
265
266
267
268
269
270
Archives the Mail::Internet message given as argument.

=item is_archived ()

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

271
272
273
274
275
=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".

276
277
278
279
=item is_included ( )

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

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

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

=item print_info ( FDNAME )

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

289
290
=back

root's avatar
root committed
291
292
293
=cut

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

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

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

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

IKEDA Soji's avatar
IKEDA Soji committed
319
320
321
322
323
    # Lowercase list name.
    $name = lc $name;
    # In case the variable was multiple. FIXME:required?
    $name = $1 if $name =~ /^(\S+)\0/;

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

331
332
333
334
    # 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);
335
336
    } else {
        $robot = lc $robot;    #FIXME: More canonicalization.
337
    }
338

339
    unless ($robot) {
340
        $log->syslog('err',
341
342
343
344
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
345
346
    }

347
348
    $options = {} unless (defined $options);

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

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

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

    ## Config file was loaded or reloaded
394
395
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}
        || $list->{'admin'}{'ttl'};
Luc Didry's avatar
Luc Didry committed
396
397
    if (    $status
        and grep { $list->{'admin'}{'status'} eq $_ } qw(open pending)
398
399
400
401
        and (
            (   not $options->{'skip_sync_admin'}
                and $list->_cache_read_expiry('last_sync_admin_user') <
                time - $pertinent_ttl
sikeda's avatar
sikeda committed
402
            )
403
            or $options->{'force_sync_admin'}
sikeda's avatar
sikeda committed
404
        )
Luc Didry's avatar
Luc Didry committed
405
    ) {
406
407
408
409
        # Update admin_table.
        $list->sync_include('owner');
        $list->sync_include('editor');

410
411
        if (not @{$list->get_admins('owner') || []}
            and $list->{'admin'}{'status'} ne 'error_config') {
412
            $log->syslog('err', 'The list "%s" has got no owner defined',
413
                $list->{'name'});
414
            $list->set_status_error_config('no_owner_defined');
415
        }
root's avatar
root committed
416
417
    }

418
419
420
    return $list;
}

421
422
423
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
424

425
    unless ($listname) {
426
        $log->syslog('err', 'Missing list parameter');
427
        return undef;
428
    }
429

430
    ## Search in default robot
431
432
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
433
    }
434
435
436
437
438
439
440
441

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

    return 0;
442
443
}

444
445
## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
446
    $log->syslog('debug2', '(%s, %s, ...)', @_);
447
    my ($self, $msg, @param) = @_;
448

449
450
    unless ($self->{'admin'}
        and $self->{'admin'}{'status'} eq 'error_config') {
451
452
        $self->{'admin'}{'status'} = 'error_config';

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

464
465
466
467
# Destroy multiton instance. FIXME
sub destroy_multiton {
    my $self = shift;
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
root's avatar
root committed
468
469
}

470
471
472
473
## 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;

474
475
476
# Saves the statistics data to disk.
# Deprecated. Use Sympa::List::update_stats().
#sub savestats;
root's avatar
root committed
477

478
## msg count.
479
480
# Old name: increment_msg_count().
sub _increment_msg_count {
481
    $log->syslog('debug2', '(%s)', @_);
482
    my $self = shift;
483

484
    # Be sure the list has been loaded.
485
    my $file = "$self->{'dir'}/msg_count";
486
487
488
489
490
491
492
493
494

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
495
496
497
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
498
499
500
        $count{$today}++;
    } else {
        $count{$today} = 1;
501
    }
502

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

512
    unless (rename("$file.$PID", $file)) {
513
        $log->syslog('err', 'Unable to write "%s": %m', $file);
514
        return undef;
515
516
517
518
    }
    return 1;
}

519
520
# Returns the number of messages sent to the list
sub get_msg_count {
521
    $log->syslog('debug2', '(%s)', @_);
522
523
    my $self = shift;

524
    # Be sure the list has been loaded.
525
    my $file = "$self->{'dir'}/stats";
526
527
528
529
530
531
532
533
534

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
535
536
537
538
    }

    return $count;
}
539
540
## last date of distribution message .
sub get_latest_distribution_date {
541
    $log->syslog('debug2', '(%s)', @_);
542
    my $self = shift;
543

544
    # Be sure the list has been loaded.
545
    my $file = "$self->{'dir'}/msg_count";
546
547

    my $latest_date = 0;
salaun's avatar
salaun committed
548
    unless (open(MSG_COUNT, $file)) {
549
        $log->syslog('debug2', 'Unable to open %s', $file);
550
        return undef;
salaun's avatar
salaun committed
551
    }
552

553
554
555
556
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
557
    }
558
    close MSG_COUNT;
559

560
561
    return undef if ($latest_date == 0);
    return $latest_date;
562
563
}

564
## Update the stats struct
root's avatar
root committed
565
566
## Input  : num of bytes of msg
## Output : num of msgs sent
567
# Old name: List::update_stats().
568
569
# No longer used. Use Sympa::List::update_stats(1);
#sub get_next_sequence;
570

571
sub get_stats {
Luc Didry's avatar
Luc Didry committed
572
    my $self = shift;
573

574
575
576
577
578
579
    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;
    }
580

581
582
583
584
585
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
    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
618
619
}

620
621
622
623
sub _cache_publish_expiry {
    my $self = shift;
    my $type = shift;

624
    my $stat_file;
625
    if ($type eq 'member') {
626
627
628
        $stat_file = $self->{'dir'} . '/.last_change.member';
    } elsif ($type eq 'last_sync') {
        $stat_file = $self->{'dir'} . '/.last_sync.member';
629
630
631
632
    } 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';
633
634
    } else {
        die 'bug in logic. Ask developer';
635
    }
636
637
638
639

    # Touch status file.
    my $fh;
    open $fh, '>', $stat_file and close $fh;
640
    utime undef, undef, $stat_file;    # required for such as NFS.
641
642
643
644
645
646
647
}

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

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

sub _cache_get {
Luc Didry's avatar
Luc Didry committed
673
674
    my $self = shift;
    my $type = shift;
675
676
677

    my $lasttime = $self->{_mtime}{$type};
    my $mtime;
678
    if ($type eq 'total' or $type eq 'is_list_member') {
679
680
        $mtime = $self->_cache_read_expiry('member');
    } else {
681
        $mtime = $self->_cache_read_expiry($type);
682
683
684
    }
    $self->{_mtime}{$type} = $mtime;

685
    return undef unless defined $lasttime and defined $mtime;
686
    return undef if $lasttime <= $mtime;
687
    return $self->{_cached}{$type};
688
689
690
691
692
693
694
695
696
697
}

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

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

698
# Old name: List::extract_verp_rcpt().
699
700
# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
#sub _extract_verp_rcpt;
701

702
703
# Dumps a copy of list users to disk, in text format.
# Old name: Sympa::List::dump() which dumped only members.
704
sub dump_users {
705
    $log->syslog('debug2', '(%s, %s)', @_);
706
    my $self = shift;
707
    my $role = shift;
708

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

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

714
715
716
717
    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
718
719
720
721
        $log->syslog(
            'err', 'Failed to save file %s.new: %s',
            $file, Sympa::LockedFile->last_error
        );
722
        return undef;
723
    }
724

725
    if ($role eq 'member') {
726
        my %map_field = _map_list_member_cols();
727

728
729
730
731
732
        my $user;
        for (
            $user = $self->get_first_list_member();
            $user;
            $user = $self->get_next_list_member()
Luc Didry's avatar
Luc Didry committed
733
        ) {
734
            foreach my $k (sort keys %map_field) {
735
736
737
738
739
740
741
742
743
                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};
                }
744
            }
745

746
            # Compat.<=6.2.44
747
748
749
750
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

751
752
753
            print $lock_fh "\n";
        }
    } else {
IKEDA Soji's avatar
IKEDA Soji committed
754
755
        my %map_field = _map_list_admin_cols();

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

763
            # Compat.<=6.2.44
764
765
766
767
            # This is needed for earlier version of Sympa on e.g. remote host.
            print $lock_fh "included 1\n"
                if defined $user->{inclusion};

768
769
            print $lock_fh "\n";
        }
root's avatar
root committed
770
    }
771

772
773
    $lock_fh->close;

774
775
776
    # FIXME:Are these lines required?
    $self->{'_mtime'}{'config'} =
        Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
777
778

    return 1;
root's avatar
root committed
779
780
781
782
783
}

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

786
787
    return undef
        unless ($self);
788
789
790
791

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

    ## Lock file
792
793
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
794
        $log->syslog('err', 'Could not create new lock');
795
        return undef;
796
797
    }

798
799
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
800
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
801
802
803

    ## Update management info
    $self->{'admin'}{'serial'}++;
804
    $self->{'admin'}{'update'} = {
805
806
        'email'      => $email,
        'date_epoch' => time,
807
    };
808

809
810
811
812
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
Luc Didry's avatar
Luc Didry committed
813
    ) {
814
        $log->syslog('info', 'Unable to save config file %s',
815
816
817
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
818
    }
819

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

833
    ## Release the lock
834
    unless ($lock_fh->close()) {
835
        return undef;
836
837
    }

838
    unless ($self->_update_list_db) {
839
        $log->syslog('err', "Unable to update list_table");
840
841
    }

root's avatar
root committed
842
843
844
845
846
    return 1;
}

## Loads the administrative data for a list
sub load {
847
    $log->syslog('debug3', '(%s, %s, %s, ...)', @_);
848
849
850
851
852
853
    my $self    = shift;
    my $name    = shift;
    my $robot   = shift;
    my $options = shift;

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

855
856
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {
857
858
859
860
861
862
863
        # 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;
864
        }
865

866
867
868
869
870
        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 {
871
            $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
872
873
874
875
876
877
                unless ($options->{'just_try'});
            return undef;
        }

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

878
879
        # default list host is robot domain: Deprecated.
        #XXX$self->{'admin'}{'host'} ||= $self->{'domain'};
880
        $self->{'name'} = $name;
881
    }
882

883
    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
884
        $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
885
886
887
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
888
    }
salaun's avatar
salaun committed
889

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

895
896
897
898
899
900
    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);
901
    my $config_reloaded = 0;
root's avatar
root committed
902
    my $admin;
903
904

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

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

929
930
        $config_reloaded  = 1;
        $last_time_config = $time_config_bin;
931
        $lock_fh->close();
932
    } elsif ($self->{'name'} ne $name
933
        or $time_config > $last_time_config
934
        or $options->{'reload_config'}) {
935
        $admin = $self->_load_list_config_file;
936
937
938
939
940

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
        unless ($lock_fh) {
941
            $log->syslog('err', 'Could not create new lock');
942
943
944
945
946
947
            return undef;
        }

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
948
            eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
949
            if ($@) {