List.pm 288 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 HTTP::Request;
35
use IO::Scalar;
36
use LWP::UserAgent;
sikeda's avatar
sikeda committed
37
use POSIX qw();
38
use Storable qw();
39
BEGIN { eval 'use IO::Socket::SSL'; }
40
BEGIN { eval 'use Net::LDAP::Util'; }
41

42
use Sympa;
43
use Conf;
44
use Sympa::ConfDef;
45
use Sympa::Constants;
46
use Sympa::Database;
47
use Sympa::DatabaseDescription;
48
use Sympa::DatabaseManager;
49
50
use Sympa::Datasource;
use Sympa::Family;
51
use Sympa::Language;
52
use Sympa::List::Config;
53
use Sympa::ListDef;
54
use Sympa::LockedFile;
55
use Sympa::Log;
56
use Sympa::Process;
57
use Sympa::Regexps;
58
use Sympa::Robot;
59
use Sympa::Spindle::ProcessTemplate;
60
use Sympa::Spool::Auth;
61
use Sympa::Template;
62
use Sympa::Ticket;
63
use Sympa::Tools::Data;
64
use Sympa::Tools::Domains;
65
use Sympa::Tools::File;
66
use Sympa::Tools::SMIME;
67
use Sympa::Tools::Text;
68
use Sympa::User;
69

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

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

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

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

=encoding utf-8

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

root's avatar
root committed
101
102
=head1 CONSTRUCTOR

103
104
=over

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

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

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

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

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

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

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

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

Delete the indicated users from the list.
141

142
=item delete_list_admin ( ROLE, ARRAY )
143
144

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

147
=item dump_users ( ROLE )
148
149
150

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

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

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

Returns the number of subscribers to the list.

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

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

177
=item get_list_member ( USER )
178
179

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

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

Return an admin user of the list with predefined role

185
186
187
OBSOLETED.
Use get_admins().

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

Returns a hash to the first user on the list.

192
=item get_first_list_admin ( ROLE )
193

194
195
OBSOLETED.
Use get_admins().
196

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

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

202
=item get_next_list_admin ()
203

204
205
OBSOLETED.
Use get_admins().
206

207
=item restore_users ( ROLE )
208
209
210
211

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

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

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

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

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

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

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

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

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

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

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

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

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

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

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

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

=item archive_send ( WHO, FILE )

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

=item archive_ls ()

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

=item archive_msg ( MSG )

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

=item is_archived ()

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

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

286
287
288
289
=item is_included ( )

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

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

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

=item print_info ( FDNAME )

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

299
300
=back

root's avatar
root committed
301
302
303
=cut

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

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

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

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

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

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

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

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

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

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

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

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

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

429
430
431
    return $list;
}

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

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

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

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

    return 0;
453
454
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

738
739
740
741
742
        my $user;
        for (
            $user = $self->get_first_list_member();
            $user;
            $user = $self->get_next_list_member()
Luc Didry's avatar
Luc Didry committed
743
        ) {
744
            foreach my $k (sort keys %map_field) {
745
746
747
748
749
750
751
752
753
                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};
                }
754
755
756
757
            }
            print $lock_fh "\n";
        }
    } else {
IKEDA Soji's avatar
IKEDA Soji committed
758
759
        my %map_field = _map_list_admin_cols();

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

770
771
    $lock_fh->close;

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

    return 1;
root's avatar
root committed
777
778
779
780
781
}

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

784
785
    return undef
        unless ($self);
786
787
788
789

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

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

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

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

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

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

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

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

root's avatar
root committed
840
841
842
843
844
    return 1;
}

## Loads the administrative data for a list
sub load {
845
846
847
848
849
850
851
    $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;
852

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

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

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

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

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

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

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

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

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

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

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

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

        $config_reloaded = 1;
        unless (defined $admin) {
956
            $log->syslog(
957
                'err',
sikeda's avatar
sikeda committed
958
959
                'Impossible to load list config file for list %s set in status error_config',
                $self
960
            );
961
            $self->set_status_error_config('load_admin_file_error');
962
963
964
965
            $lock_fh->close();
            return undef;
        }

966
        $last_time_config = $time_config;
967
        $lock_fh->close();
root's avatar
root committed
968
    }
969

970
971
    ## If config was reloaded...
    if ($admin) {
972
973
974
975
976
977
978
979
        $self->{'admin'} = $admin;

        ## check param_constraint.conf if belongs to a family and the config
        ## has been loaded
        if (defined $admin->{'family_name'}
            && ($admin->{'status'} ne 'error_config')) {
            my $family;
            unless ($family = $self->get_family()) {
980
                $log->syslog(
981
                    'err',
982
                    'Impossible to get list %s family: %s. The list is set in status error_config',
983
                    $self,
984
985
986
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
987
                    $self->{'admin'}{'family_name'});
988
989
990
991
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
992
                $log->syslog(
993
994
995
996
997
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
998
                    $family->{'name'});
999
1000
            }
            if (ref($error) eq 'ARRAY') {
For faster browsing, not all history is shown. View entire blame