List.pm 415 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
10
#
# 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
# Copyright (c) 2011, 2012, 2013, 2014 GIP RENATER
11
12
13
14
15
16
17
18
19
20
21
#
# 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.
#
22
23
# 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
24
25
26
27

package List;

use strict;
28
use warnings;
29
30
use Digest::MD5 qw();
use Encode qw();
sikeda's avatar
sikeda committed
31
use HTML::Entities qw();
32
use HTTP::Request;
33
use IO::Scalar;
34
35
use Mail::Address;
use MIME::Charset;
36
use MIME::Decoder;
37
use MIME::EncWords;
38
use MIME::Entity;
39
use MIME::Parser;
sikeda's avatar
sikeda committed
40
use POSIX qw();
41
use Storable;
sikeda's avatar
sikeda committed
42
use Time::Local qw();
43
use XML::LibXML;
44

45
use Archive;
46
use Auth;
47
48
use Conf;
use Sympa::Constants;
49
use Datasource;
50
use Family;
51
use Fetch;
52
use Sympa::Language;
53
use LDAPSource;
54
use Sympa::ListDef;
55
use Sympa::LockedFile;
56
57
58
59
use Log;
use mail;
use Message;
use PlainDigest;
60
61
62
63
64
65
use Sympa::Regexps;
use Scenario;
use SDM;
use SQLSource;
use Task;
use tools;
66
use tracking;
67
use tt2;
68
69
use Sympa::User;
use WebAgent;
70

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

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

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

91
92
93
94
95
# Language context
my $language = Sympa::Language->instance;

=encoding utf-8

root's avatar
root committed
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
=head1 CONSTRUCTOR

=item new( [PHRASE] )

 List->new();

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

Saves updates the statistics file on disk.

=item update_stats( BYTES )

Updates the stats, argument is number of bytes, returns the next
sequence number. Does nothing if no stats.

=item send_sub_to_owner ( WHO, COMMENT )
Send a message to the list owners telling that someone
wanted to subscribe to the list.

=item send_to_editor ( MSG )
134
    
root's avatar
root committed
135
136
137
138
139
140
141
142
143
144
Send a Mail::Internet type object to the editor (for approval).

=item send_msg ( MSG )

Sends the Mail::Internet message to the list.

=item send_file ( FILE, USER, GECOS )

Sends the file to the USER. FILE may only be welcome for now.

145
=item delete_list_member ( ARRAY )
root's avatar
root committed
146
147
148

Delete the indicated users from the list.
 
149
=item delete_list_admin ( ROLE, ARRAY )
150
151
152

Delete the indicated admin user with the predefined role from the list.

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

=item get_total ()

Returns the number of subscribers to the list.

173

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

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

179
=item get_list_member ( USER )
180
181

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

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

Return an admin user of the list with predefined role

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

Returns a hash to the first user on the list.

191
=item get_first_list_admin ( ROLE )
192

193
Returns a hash to the first admin user with predefined role on the list.
194

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

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

200
=item get_next_list_admin ()
201
202
203
204

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

205
=item update_list_member ( USER, HASHPTR )
root's avatar
root committed
206
207
208

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

209
=item update_list_admin ( USER, ROLE, HASHPTR )
210
211
212

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

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

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

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

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

223
=item is_list_member ( USER )
root's avatar
root committed
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

Returns true if the indicated user is member of the list.
 
=item am_i ( FUNCTION, USER )

Returns true is USER has FUNCTION (owner, editor) on the
list.

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

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 )

Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

Send the indicated archive file to the user, if it exists.

=item archive_ls ()

Returns the list of available files, if any.

=item archive_msg ( MSG )

Archives the Mail::Internet message given as argument.

=item is_archived ()

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

=item get_stats ( OPTION )

Returns either a formatted printable strings or an array whith
the statistics. OPTION can be 'text' or 'array'.

=item print_info ( FDNAME )

274
Print the list information to the given file descriptor, or the
root's avatar
root committed
275
276
277
278
279
currently selected descriptor.

=cut

## Database and SQL statement handlers
280
my ($sth, @sth_stack);
281
282
283

my %list_cache;

284
285
## DB fields with numeric type
## We should not do quote() for these while inserting data
286
287
288
289
290
291
292
293
294
my %numeric_field = (
    'cookie_delay_user'       => 1,
    'bounce_score_subscriber' => 1,
    'subscribed_subscriber'   => 1,
    'included_subscriber'     => 1,
    'subscribed_admin'        => 1,
    'included_admin'          => 1,
    'wrong_login_count'       => 1,
);
root's avatar
root committed
295

296
297
298
299
300
301
302
303
304
305
306
307
308
309
## List parameter values except for parameters below.
my %list_option = (

    # reply_to_header.apply
    'forced'  => {'gettext_id' => 'overwrite Reply-To: header field'},
    'respect' => {'gettext_id' => 'preserve existing header field'},

    # reply_to_header.value
    'sender' => {'gettext_id' => 'sender'},

    # reply_to_header.value, include_remote_sympa_list.cert
    'list' => {'gettext_id' => 'list'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1,
310
    # include_ldap_query.select, reply_to_header.value, dmarc_protection.mode
311
312
313
314
315
316
317
318
319
320
321
322
    'all' => {'gettext_id' => 'all'},

    # reply_to_header.value
    'other_email' => {'gettext_id' => 'other email address'},

    # msg_topic_keywords_apply_on
    'subject'          => {'gettext_id' => 'subject field'},
    'body'             => {'gettext_id' => 'message body'},
    'subject_and_body' => {'gettext_id' => 'subject and body'},

    # bouncers_level2.notification, bouncers_level2.action,
    # bouncers_level1.notification, bouncers_level1.action,
323
324
    # spam_protection, dkim_signature_apply_on, web_archive_spam_protection,
    # dmarc_protection.mode
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
    'none' => {'gettext_id' => 'do nothing'},

    # bouncers_level2.notification, bouncers_level1.notification,
    # welcome_return_path, remind_return_path, rfc2369_header_fields,
    # archive.access
    'owner' => {'gettext_id' => 'owner'},

    # bouncers_level2.notification, bouncers_level1.notification
    'listmaster' => {'gettext_id' => 'listmaster'},

    # bouncers_level2.action, bouncers_level1.action
    'remove_bouncers' => {'gettext_id' => 'remove bouncing users'},
    'notify_bouncers' => {'gettext_id' => 'send notify to bouncing users'},

    # pictures_feature, dkim_feature, merge_feature,
340
341
    # inclusion_notification_feature, tracking.delivery_status_notification,
    # tracking.message_delivery_notification
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
    'on'  => {'gettext_id' => 'enabled'},
    'off' => {'gettext_id' => 'disabled'},

    # include_remote_sympa_list.cert
    'robot' => {'gettext_id' => 'robot'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1,
    # include_ldap_query.select
    'first' => {'gettext_id' => 'first entry'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1
    'regex' => {'gettext_id' => 'entries matching regular expression'},

    # include_ldap_2level_query.scope2, include_ldap_2level_query.scope1,
    # include_ldap_query.scope
    'base' => {'gettext_id' => 'base'},
    'one'  => {'gettext_id' => 'one level'},
    'sub'  => {'gettext_id' => 'subtree'},

    # include_ldap_2level_query.use_ssl, include_ldap_query.use_ssl
    'yes' => {'gettext_id' => 'yes'},
    'no'  => {'gettext_id' => 'no'},

    # include_ldap_2level_query.ssl_version, include_ldap_query.ssl_version
    'sslv2' => {'gettext_id' => 'SSL version 2'},
    'sslv3' => {'gettext_id' => 'SSL version 3'},
    'tls'   => {'gettext_id' => 'TLS'},

    # editor.reception, owner_include.reception, owner.reception,
    # editor_include.reception
    'mail'   => {'gettext_id' => 'receive notification email'},
    'nomail' => {'gettext_id' => 'no notifications'},

    # editor.visibility, owner_include.visibility, owner.visibility,
    # editor_include.visibility
    'conceal'   => {'gettext_id' => 'concealed from list menu'},
    'noconceal' => {'gettext_id' => 'listed on the list menu'},

    # welcome_return_path, remind_return_path
    'unique' => {'gettext_id' => 'bounce management'},

    # owner_include.profile, owner.profile
    'privileged' => {'gettext_id' => 'privileged owner'},
    'normal'     => {'gettext_id' => 'normal owner'},

    # priority
    '0' => {'gettext_id' => '0 - highest priority'},
    '9' => {'gettext_id' => '9 - lowest priority'},
    'z' => {'gettext_id' => 'queue messages only'},

    # spam_protection, web_archive_spam_protection
    'at'         => {'gettext_id' => 'replace @ characters'},
    'javascript' => {'gettext_id' => 'use JavaScript'},

    # msg_topic_tagging
    'required_sender' => {'gettext_id' => 'required to post message'},
    'required_moderator' =>
399
        {'gettext_id' => 'required to distribute message'},
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437

    # msg_topic_tagging, custom_attribute.optional
    'optional' => {'gettext_id' => 'optional'},

    # custom_attribute.optional
    'required' => {'gettext_id' => 'required'},

    # custom_attribute.type
    'string'  => {'gettext_id' => 'string'},
    'text'    => {'gettext_id' => 'multi-line text'},
    'integer' => {'gettext_id' => 'number'},
    'enum'    => {'gettext_id' => 'set of keywords'},

    # footer_type
    'mime'   => {'gettext_id' => 'add a new MIME part'},
    'append' => {'gettext_id' => 'append to message body'},

    # archive.access
    'open'    => {'gettext_id' => 'open'},
    'closed'  => {'gettext_id' => 'closed'},
    'private' => {'gettext_id' => 'subscribers only'},
    'public'  => {'gettext_id' => 'public'},

##    ## user_data_source
##    'database' => {'gettext_id' => 'RDBMS'},
##    'file'     => {'gettext_id' => 'include from local file'},
##    'include'  => {'gettext_id' => 'include from external source'},
##    'include2' => {'gettext_id' => 'general datasource'},

    # rfc2369_header_fields
    'help'        => {'gettext_id' => 'help'},
    'subscribe'   => {'gettext_id' => 'subscription'},
    'unsubscribe' => {'gettext_id' => 'unsubscription'},
    'post'        => {'gettext_id' => 'posting address'},
    'archive'     => {'gettext_id' => 'list archive'},

    # dkim_signature_apply_on
    'md5_authenticated_messages' =>
438
        {'gettext_id' => 'authenticated by password'},
439
    'smime_authenticated_messages' =>
440
        {'gettext_id' => 'authenticated by S/MIME signature'},
441
    'dkim_authenticated_messages' =>
442
        {'gettext_id' => 'authenticated by DKIM signature'},
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    'editor_validated_messages' => {'gettext_id' => 'approved by editor'},
    'any'                       => {'gettext_id' => 'any messages'},

    # archive.period
    'day'     => {'gettext_id' => 'daily'},
    'week'    => {'gettext_id' => 'weekly'},
    'month'   => {'gettext_id' => 'monthly'},
    'quarter' => {'gettext_id' => 'quarterly'},
    'year'    => {'gettext_id' => 'yearly'},

    # web_archive_spam_protection
    'cookie' => {'gettext_id' => 'use HTTP cookie'},

    # verp_rate
    '100%' => {'gettext_id' => '100% - always'},
    '0%'   => {'gettext_id' => '0% - never'},

    # archive_crypted_msg
    'original'  => {'gettext_id' => 'original messages'},
    'decrypted' => {'gettext_id' => 'decrypted messages'},
463
464
465

    # tracking.message_delivery_notification
    'on_demand' => {'gettext_id' => 'on demand'},
466
467
468

    # dmarc_protection.mode
    'dkim_signature' => {'gettext_id' => 'DKIM signature exists'},
469
    'dmarc_any'      => {'gettext_id' => 'DMARC policy exists'},
470
    'dmarc_reject'   => {'gettext_id' => 'DMARC policy suggests rejection'},
471
472
473
    'dmarc_quarantine' =>
        {'gettext_id' => 'DMARC policy suggests quarantine'},
    'domain_regex' => {'gettext_id' => 'domain matching regular expression'},
474
475

    # dmarc_protection.phrase
476
477
478
    'display_name'        => {'gettext_id' => 'display name'},
    'name_and_email'      => {'gettext_id' => 'display name and e-mail'},
    'name_via_list'       => {'gettext_id' => 'name "via Mailing List"'},
479
    'name_email_via_list' => {'gettext_id' => 'e-mail "via Mailing List"'},
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
);

## Values for subscriber reception mode.
my %reception_mode = (
    'mail'        => {'gettext_id' => 'standard (direct reception)'},
    'digest'      => {'gettext_id' => 'digest MIME format'},
    'digestplain' => {'gettext_id' => 'digest plain text format'},
    'summary'     => {'gettext_id' => 'summary mode'},
    'notice'      => {'gettext_id' => 'notice mode'},
    'txt'         => {'gettext_id' => 'text-only mode'},
    'html'        => {'gettext_id' => 'html-only mode'},
    'urlize'      => {'gettext_id' => 'urlize mode'},
    'nomail'      => {'gettext_id' => 'no mail'},
    'not_me'      => {'gettext_id' => 'you do not receive your own posts'}
);

## Values for subscriber visibility mode.
my %visibility_mode = (
    'noconceal' => {'gettext_id' => 'listed in the list review page'},
    'conceal'   => {'gettext_id' => 'concealed'}
);

## Values for list status.
my %list_status = (
    'open'          => {'gettext_id' => 'in operation'},
    'pending'       => {'gettext_id' => 'list not yet activated'},
    'error_config'  => {'gettext_id' => 'erroneous configuration'},
    'family_closed' => {'gettext_id' => 'closed family instance'},
    'closed'        => {'gettext_id' => 'closed list'},
);

root's avatar
root committed
511
## This is the generic hash which keeps all lists in memory.
512
my %list_of_lists  = ();
salaun's avatar
salaun committed
513
my %list_of_robots = ();
514
our %list_of_topics = ();
salaun's avatar
salaun committed
515
516
517
518
my %edit_list_conf = ();

## Last modification times
my %mtime;
root's avatar
root committed
519
520

use DB_File;
521
$DB_BTREE->{compare} = \&_compare_addresses;
root's avatar
root committed
522

523
524
our %listmaster_messages_stack;

root's avatar
root committed
525
526
## Creates an object.
sub new {
527
528
    my ($pkg, $name, $robot, $options) = @_;
    my $list = {};
529
530
    Log::do_log('debug2', '(%s, %s, %s)', $name, $robot,
        join('/', keys %$options));
531

532
533
    ## Allow robot in the name
    if ($name =~ /\@/) {
534
535
536
        my @parts = split /\@/, $name;
        $robot ||= $parts[1];
        $name = $parts[0];
537
    }
root's avatar
root committed
538

539
    ## Look for the list if no robot was provided
sikeda's avatar
sikeda committed
540
    $robot ||= search_list_among_robots($name);
541

542
    unless ($robot) {
543
544
545
546
547
        Log::do_log('err',
            'Missing robot parameter, cannot create list object for %s',
            $name)
            unless ($options->{'just_try'});
        return undef;
548
549
    }

550
551
    $options = {} unless (defined $options);

root's avatar
root committed
552
    ## Only process the list if the name is valid.
553
    my $listname_regexp = Sympa::Regexps::listname();
554
555
556
557
    unless ($name and ($name =~ /^($listname_regexp)$/io)) {
        Log::do_log('err', 'Incorrect listname "%s"', $name)
            unless ($options->{'just_try'});
        return undef;
root's avatar
root committed
558
559
    }
    ## Lowercase the list name.
560
    $name = $1;
root's avatar
root committed
561
    $name =~ tr/A-Z/a-z/;
562

563
    ## Reject listnames with reserved list suffixes
564
565
566
567
568
569
570
571
572
573
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($name =~ /^(\S+)-($regx)$/) {
            Log::do_log(
                'err',
                'Incorrect name: listname "%s" matches one of service aliases',
                $name
            ) unless ($options->{'just_try'});
            return undef;
        }
574
575
    }

576
    my $status;
577
    ## If list already in memory and not previously purged by another process
578
579
580
581
582
583
584
585
586
587
588
589
590
    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);
    }
591
    unless (defined $status) {
592
        return undef;
593
594
595
    }

    ## Config file was loaded or reloaded
596
597
598
599
600
601
602
603
604
605
606
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}
        || $list->{'admin'}{'ttl'};
    if ($status == 1
        && (!$options->{'skip_sync_admin'}
            || (   $options->{'optional_sync_admin'}
                && $list->{'last_sync'} < time - $pertinent_ttl)
            || $options->{'force_sync_admin'}
        )
        ) {
        ## Update admin_table
        unless (defined $list->sync_include_admin()) {
607
            Log::do_log('err', '')
608
609
610
611
612
613
614
615
616
                unless ($options->{'just_try'});
        }
        if (   $list->get_nb_owners() < 1
            && $list->{'admin'}{'status'} ne 'error_config') {
            Log::do_log('err', 'The list "%s" has got no owner defined',
                $list->{'name'});
            $list->set_status_error_config('no_owner_defined',
                $list->{'name'});
        }
root's avatar
root committed
617
618
    }

619
620
621
    return $list;
}

622
623
624
## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
625

626
    unless ($listname) {
627
        Log::do_log('err', 'Missing list parameter');
628
        return undef;
629
    }
630

631
    ## Search in default robot
632
633
    if (-d $Conf::Conf{'home'} . '/' . $listname) {
        return $Conf::Conf{'domain'};
634
    }
635
636
637
638
639
640
641
642

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

    return 0;
643
644
}

645
646
647
## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
    my ($self, $message, @param) = @_;
648
    Log::do_log('debug3', '');
649

650
651
652
653
654
655
656
657
658
    unless ($self->{'admin'}{'status'} eq 'error_config') {
        $self->{'admin'}{'status'} = 'error_config';

        #my $host = Conf::get_robot_conf($self->{'domain'}, 'host');
        ## No more save config in error...
        #$self->save_config("listmaster\@$host");
        #$self->savestats();
        Log::do_log('err', 'The list "%s" is set in status error_config',
            $self->{'name'});
659
        List::send_notify_to_listmaster($message, $self->{'domain'}, \@param);
660
661
662
663
664
665
    }
}

## set the list in status family_closed and send a notify to owners
sub set_status_family_closed {
    my ($self, $message, @param) = @_;
666
    Log::do_log('debug2', '');
667
668
669
670
671
672
673
674
675
676
677
678

    unless ($self->{'admin'}{'status'} eq 'family_closed') {

        my $host = Conf::get_robot_conf($self->{'domain'}, 'host');

        unless ($self->close_list("listmaster\@$host", 'family_closed')) {
            Log::do_log('err',
                'Impossible to set the list %s in status family_closed');
            return undef;
        }
        Log::do_log('info', 'The list "%s" is set in status family_closed',
            $self->{'name'});
679
680
        $self->send_notify_to_owner($message, \@param);
        # messages : close_list
681
682
    }
    return 1;
root's avatar
root committed
683
684
685
686
687
}

## Saves the statistics data to disk.
sub savestats {
    my $self = shift;
688
    Log::do_log('debug2', '');
689

root's avatar
root committed
690
691
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
692
    my $dir  = $self->{'dir'};
693
    return undef unless ($list_of_lists{$self->{'domain'}}{$name});
694
695

    unless (ref($self->{'stats'}) eq 'ARRAY') {
696
        Log::do_log('err', 'Incorrect parameter');
697
        return undef;
698
    }
699
700
701
702

    ## Lock file
    my $lock_fh = Sympa::LockedFile->new($dir . '/stats', 2, '>');
    unless ($lock_fh) {
703
704
705
        Log::do_log('err', 'Could not create new lock');
        return undef;
    }
olivier.salaun's avatar
olivier.salaun committed
706

707
    printf $lock_fh "%d %.0f %.0f %.0f %d %d %d\n",
708
709
        @{$self->{'stats'}}, $self->{'total'}, $self->{'last_sync'},
        $self->{'last_sync_admin_user'};
710

olivier.salaun's avatar
olivier.salaun committed
711
    ## Release the lock
712
    unless ($lock_fh->close) {
713
        return undef;
olivier.salaun's avatar
olivier.salaun committed
714
715
    }

root's avatar
root committed
716
717
718
719
720
721
    ## Changed on disk
    $self->{'mtime'}[2] = time;

    return 1;
}

722
723
724
## msg count.
sub increment_msg_count {
    my $self = shift;
725
    Log::do_log('debug2', '(%s)', $self->{'name'});
726

727
728
729
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/msg_count";
730
731
732
733
734
735
736
737
738

    my %count;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s(\d+)$/) {
                $count{$1} = $2;
            }
        }
        close MSG_COUNT;
739
740
741
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
742
743
744
        $count{$today}++;
    } else {
        $count{$today} = 1;
745
    }
746

747
    unless (open(MSG_COUNT, ">$file.$$")) {
748
        Log::do_log('err', 'Unable to create "%s.%s": %s', $file, $$, $!);
749
        return undef;
750
    }
751
752
    foreach my $key (sort { $a <=> $b } keys %count) {
        printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
753
    }
754
755
    close MSG_COUNT;

756
    unless (rename("$file.$$", $file)) {
757
        Log::do_log('err', 'Unable to write "%s": %s', $file, $!);
758
        return undef;
759
760
761
762
    }
    return 1;
}

763
764
765
# Returns the number of messages sent to the list
sub get_msg_count {
    my $self = shift;
766
767
    Log::do_log('debug3', "Getting the number of messages for list %s",
        $self->{'name'});
768
769
770
771

    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/stats";
772
773
774
775
776
777
778
779
780

    my $count = 0;
    if (open(MSG_COUNT, $file)) {
        while (<MSG_COUNT>) {
            if ($_ =~ /^(\d+)\s+(.*)$/) {
                $count = $1;
            }
        }
        close MSG_COUNT;
781
782
783
784
785
    }

    return $count;

}
786
787
788
## last date of distribution message .
sub get_latest_distribution_date {
    my $self = shift;
789
    Log::do_log('debug3', '(%s)', $self->{'name'});
790

791
792
793
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/msg_count";
794
795
796

    my %count;
    my $latest_date = 0;
salaun's avatar
salaun committed
797
    unless (open(MSG_COUNT, $file)) {
798
        Log::do_log('debug2', 'Unable to open %s', $file);
799
        return undef;
salaun's avatar
salaun committed
800
    }
801

802
803
804
805
    while (<MSG_COUNT>) {
        if ($_ =~ /^(\d+)\s(\d+)$/) {
            $latest_date = $1 if ($1 > $latest_date);
        }
806
    }
807
    close MSG_COUNT;
808

809
810
    return undef if ($latest_date == 0);
    return $latest_date;
811
812
}

813
## Update the stats struct
root's avatar
root committed
814
815
816
## Input  : num of bytes of msg
## Output : num of msgs sent
sub update_stats {
817
    my ($self, $bytes) = @_;
818
    Log::do_log('debug2', '(%d)', $bytes);
root's avatar
root committed
819
820
821
822
823
824

    my $stats = $self->{'stats'};
    $stats->[0]++;
    $stats->[1] += $self->{'total'};
    $stats->[2] += $bytes;
    $stats->[3] += $bytes * $self->{'total'};
825
826
827
828

    ## Update 'msg_count' file, used for bounces management
    $self->increment_msg_count();

root's avatar
root committed
829
830
831
    return $stats->[0];
}

832
## Extract a set of rcpt for which verp must be use from a rcpt_tab.
833
834
## Input  :  percent : the rate of subscribers that must be threaded using
## verp
835
836
##           xseq    : the message sequence number
##           @rcpt   : a tab of emails
837
838
839
840
## return :  a tab of rcpt for which rcpt must be use depending on the message
## sequence number, this way every subscriber is "verped" from time to time
##           input table @rcpt is spliced : rcpt for which verp must be used
##           are extracted from this table
841
sub extract_verp_rcpt {
842
843
844
    my $percent     = shift;
    my $xseq        = shift;
    my $refrcpt     = shift;
845
846
    my $refrcptverp = shift;

847
848
    Log::do_log('debug', '(%s, %s, %s, %s)',
        $percent, $xseq, $refrcpt, $refrcptverp);
849

850
    my @result;
851

852
    if ($percent ne '0%') {
853
854
855
856
857
858
        my $nbpart;
        if ($percent =~ /^(\d+)\%/) {
            $nbpart = 100 / $1;
        } else {
            Log::do_log(
                'err',
859
                'Wrong format for parameter extract_verp: %s. Can\'t process VERP',
860
861
862
863
864
865
866
867
868
                $percent
            );
            return undef;
        }

        my $modulo = $xseq % $nbpart;
        my $lenght = int(($#{$refrcpt} + 1) / $nbpart) + 1;

        @result = splice @$refrcpt, $lenght * $modulo, $lenght;
869
    }
870
    foreach my $verprcpt (@$refrcptverp) {
871
        push @result, $verprcpt;
872
    }
873
    return (@result);
874
875
}

root's avatar
root committed
876
877
## Dumps a copy of lists to disk, in text format
sub dump {
878
    my $self = shift;
879
    Log::do_log('debug2', '(%s)', $self->{'name'});
880

881
    unless (defined $self) {
882
883
        Log::do_log('err', 'Unknown list');
        return undef;
884
    }
885

886
    my $user_file_name = "$self->{'dir'}/subscribers.db.dump";
887

888
    unless ($self->_save_list_members_file($user_file_name)) {
889
890
        Log::do_log('err', 'Failed to save file %s', $user_file_name);
        return undef;
root's avatar
root committed
891
    }
892
893
894
895
896
897

    $self->{'mtime'} = [
        (stat("$self->{'dir'}/config"))[9],
        (stat("$self->{'dir'}/subscribers"))[9],
        (stat("$self->{'dir'}/stats"))[9]
    ];
898
899

    return 1;
root's avatar
root committed
900
901
902
903
904
}

## Saves the configuration file to disk
sub save_config {
    my ($self, $email) = @_;
905
    Log::do_log('debug3', '(%s, %s)', $self->{'name'}, $email);
root's avatar
root committed
906

907
908
    return undef
        unless ($self);
909
910
911
912

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

    ## Lock file
913
914
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
915
916
        Log::do_log('err', 'Could not create new lock');
        return undef;
917
918
    }

919
920
    my $name                 = $self->{'name'};
    my $old_serial           = $self->{'admin'}{'serial'};
salaun's avatar
salaun committed
921
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
root's avatar
root committed
922
923
924

    ## Update management info
    $self->{'admin'}{'serial'}++;
925
    $self->{'admin'}{'update'} = {
926
927
928
929
930
931
        'email'      => $email,
        'date_epoch' => time,
        'date'       => $language->gettext_strftime(
            "%d %b %Y at %H:%M:%S",
            localtime time
        ),
932
    };
933

934
935
936
937
938
    unless (
        $self->_save_list_config_file(
            $config_file_name, $old_config_file_name
        )
        ) {
939
        Log::do_log('info', 'Unable to save config file %s',
940
941
942
            $config_file_name);
        $lock_fh->close();
        return undef;
root's avatar
root committed
943
    }
944

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

salaun's avatar
salaun committed
958
#    $self->{'mtime'}[0] = (stat("$list->{'dir'}/config"))[9];
959

960
    ## Release the lock
961
    unless ($lock_fh->close()) {
962
        return undef;
963
964
    }

965
    if ($SDM::use_db) {
sikeda's avatar
sikeda committed
966
967
        unless (_update_list_db()) {
            Log::do_log('err', "Unable to update list_table");
968
969
970
        }
    }

root's avatar
root committed
971
972
973
974
975
    return 1;
}

## Loads the administrative data for a list
sub load {
976
    my ($self, $name, $robot, $options) = @_;
977
978
    Log::do_log('debug2', '(%s, %s, %s)', $name, $robot,
        join('/', keys %$options));
979

salaun's avatar
salaun committed
980
    my $users;
981

982
983
984
    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {

985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
        ## Search robot if none was provided
        unless ($robot) {
            foreach my $r (keys %{$Conf::Conf{'robots'}}) {
                if (-d "$Conf::Conf{'home'}/$r/$name") {
                    $robot = $r;
                    last;
                }
            }

            ## Try default robot
            unless ($robot) {
                if (-d "$Conf::Conf{'home'}/$name") {
                    $robot = $Conf::Conf{'domain'};
                }
            }
        }

        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 {
            Log::do_log('err', 'No such robot (virtual domain) %s', $robot)
                unless ($options->{'just_try'});
            return undef;
        }

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

        # default list host is robot domain
        $self->{'admin'}{'host'} ||= $self->{'domain'};
        $self->{'name'} = $name;
1017
    }
1018

1019
    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
1020
1021
1022
1023
        Log::do_log('debug2', 'Missing directory (%s) or config file for %s',
            $self->{'dir'}, $name)
            unless ($options->{'just_try'});
        return undef;
1024
    }
salaun's avatar
salaun committed
1025

1026
1027
    my ($m1, $m2, $m3) = (0, 0, 0);
    ($m1, $m2, $m3) = @{$self->{'mtime'}} if (defined $self->{'mtime'});
1028

1029
    my $time_config     = (stat("$self->{'dir'}/config"))[9];
1030
    my $time_config_bin = (stat("$self->{'dir'}/config.bin"))[9];
1031
    my $time_subscribers;
1032
    my $time_stats       = (stat("$self->{'dir'}/stats"))[9];
1033
    my $main_config_time = (stat(Sympa::Constants::CONFIG))[9];
1034
1035
    my $web_config_time  = (stat(Sympa::Constants::WWSCONFIG))[9];
    my $config_reloaded  = 0;
root's avatar
root committed
1036
    my $admin;
1037
1038
1039
1040

    if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
           'binary_file'
        && !$options->{'reload_config'}
1041
        && $time_config_bin > $self->{'mtime'}->[0]
1042
        && $time_config_bin >= $time_config
1043
        && $time_config_bin >= $main_config_time
1044
        && $time_config_bin >= $web_config_time) {
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067

        ## Get a shared lock on config file first
        my $lock_fh =
            Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
        unless ($lock_fh) {
            Log::do_log('err', 'Could not create new lock');
            return undef;
        }

        ## Load a binary version of the data structure
        ## unless config is more recent than config.bin
        eval { $admin = &Storable::retrieve("$self->{'dir'}/config.bin") };
        if ($@) {
            Log::do_log('err',
                'Failed to load the binary config %s, error: %s',
                "$self->{'dir'}/config.bin", $@);
            $lock_fh->close();
            return undef;
        }

        $config_reloaded = 1;
        $m1              = $time_config_bin;
        $lock_fh->close();
1068
    } elsif ($self->{'name'} ne $name
1069
        || $time_config > $self->{'mtime'}->[0]
1070
1071
        || $options->{'reload_config'}) {
        $admin =
sikeda's avatar
sikeda committed
1072
1073
            _load_list_config_file($self->{'dir'}, $self->{'domain'},
            'config');
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108

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

        ## update the binary version of the data structure
        if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
            'binary_file') {
            eval { &Storable::store($admin, "$self->{'dir'}/config.bin") };
            if ($@) {
                Log::do_log('err',
                    'Failed to save the binary config %s. error: %s',
                    "$self->{'dir'}/config.bin", $@);
            }
        }

        $config_reloaded = 1;
        unless (defined $admin) {
            Log::do_log(
                'err',
                'Impossible to load list config file for list % set in status error_config',
                $self->{'name'}
            );
            $self->set_status_error_config('load_admin_file_error',
                $self->{'name'});
            $lock_fh->close();
            return undef;
        }

        $m1 = $time_config;
        $lock_fh->close();
root's avatar
root committed
1109
    }
1110

1111
1112
    ## If config was reloaded...
    if ($admin) {
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
        $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()) {
                Log::do_log(
                    'err',
1123
                    'Impossible to get list %s family: %s. The list is set in status error_config',
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
                    $self->{'name'},
                    $self->{'admin'}{'family_name'}
                );
                $self->set_status_error_config('no_list_family',
                    $self->{'name'}, $admin->{'family_name'});
                return undef;
            }
            my $error = $family->check_param_constraint($self);
            unless ($error) {
                Log::do_log(
                    'err',
                    'Impossible to check parameters constraint for list % set in status error_config',
                    $self->{'name'}
                );
                $self->set_status_error_config('no_check_rules_family',
                    $self->{'name'}, $family->{'name'});
            }
            if (ref($error) eq 'ARRAY') {
                Log::do_log(
                    'err',
                    'The list "%s" does not respect the rules from its family %s',
                    $self->{'name'},
                    $family->{'name'}
                );
                $self->set_status_error_config('no_respect_rules_family',
                    $self->{'name'}, $family->{'name'});
            }
        }
    }

    $self->{'as_x509_cert'} = 1
        if ((-r "$self->{'dir'}/cert.pem")
        || (-r "$self->{'dir'}/cert.pem.enc"));

    ## Load stats file if first new() or stats file changed
1159
    my ($stats, $total);
1160
1161
1162
1163
1164
    if (!$self->{'mtime'}[2] || ($time_stats > $self->{'mtime'}[2])) {
        (   $stats, $total, $self->{'last_sync'},
            $self->{'last_sync_admin_user'}
        ) = _load_stats_file("$self->{'dir'}/stats");
        $m3 = $time_stats;
1165

1166
1167
        $self->{'stats'} = $stats if (defined $stats);
        $self->{'total'} = $total if (defined $total);
1168
    }
1169

root's avatar
root committed
1170
    $self->{'users'} = $users->{'users'} if ($users);
1171
1172
    $self->{'ref'}   = $users->{'ref'}   if ($users);

1173
    if ($users && defined($users->{'total'})) {
1174
        $self->{'total'} = $users->{'total'};
1175
    }
1176

1177
    ## We have updated %users, Total may have changed
1178
    if ($m2 > ($self->{'mtime'}[1] || 0)) {
1179
        $self->savestats();
1180
1181
    }

1182
    $self->{'mtime'} = [$m1, $m2, $m3];
root's avatar
root committed
1183

1184
    $list_of_lists{$self->{'domain'}}{$name} = $self;
1185
    return $config_reloaded;
root's avatar
root committed
1186
1187
}

1188
## Return a list of hash's owners and their param
1189
sub get_owners {
1190
    my ($self) = @_;
1191
    Log::do_log('debug3', '(%s)', $self->{'name'});
1192

1193
1194
    my $owners = ();

1195
1196
1197
1198
1199
1200
1201
1202
1203
    # owners are in the admin_table ; they might come from an include data
    # source
    for (
        my $owner = $self->get_first_list_admin('owner');
        $owner;
        $owner = $self->get_next_list_admin()
        ) {
        push(@{$owners}, $owner);
    }
1204
1205
1206
1207
1208

    return $owners;
}

sub get_nb_owners {
1209
    my ($self) = @_;
1210
    Log::do_log('debug3', '(%s)', $self->{'name'});
1211
1212

    my $resul  = 0;
1213
1214
1215
    my $owners = $self->get_owners;

    if (defined $owners) {
1216
        $resul = $#{$owners} + 1;
1217
1218
1219
1220
    }
    return $resul;
}

1221
1222
## Return a hash of list's editors and their param(empty if there isn't any
## editor)
1223
sub get_editors {
1224
    my ($self) = @_;
1225
    Log::do_log('debug3', '(%s)', $self->{'name'});
1226

1227
1228
    my $editors = ();

1229
1230
1231
1232
1233
1234
1235
1236
1237
    # editors are in the admin_table ; they might come from an include data
    # source
    for (
        my $editor = $self->get_first_list_admin('editor');
        $editor;
        $editor = $self->get_next_list_admin()
        ) {
        push(@{$editors}, $editor);
    }
1238
1239
1240
1241

    return $editors;
}

1242
## Returns an array of owners' email addresses
salaun's avatar
salaun committed
1243
sub get_owners_email {
1244
    my ($self, $param) = @_;
1245
1246
    Log::do_log('debug3', '(%s, %s)', $self->{'name'},
        $param->{'ignore_nomail'});
1247

1248
1249
    my @rcpt;
    my $owners = ();
salaun's avatar
salaun committed
1250

1251
    $owners = $self->get_owners();
1252

1253
1254
1255
1256
1257
1258
1259
1260
1261
    if ($param->{'ignore_nomail'}) {
        foreach my $o (@{$owners}) {
            push(@rcpt, lc($o->{'email'}));
        }
    } else {
        foreach my $o (@{$owners}) {
            next if ($o->{'reception'} eq 'nomail');
            push(@rcpt, lc($o->{'email'}));
        }
1262
1263
    }
    unless (@rcpt) {
1264
        Log::do_log('notice', 'Warning: No owner found for list %s',
1265
            $self->{'name'});
1266
    }
1267
1268
1269
    return @rcpt;
}

1270
## Returns an array of editors' email addresses
1271
#  or owners if there isn't any editors' email addresses
1272
sub get_editors_email {
1273
    my ($self, $param) = @_;
1274
1275
    Log::do_log('debug3', '(%s, %s)', $self->{'name'},
        $param->{'ignore_nomail'});
1276

1277
1278
    my @rcpt;
    my $editors = ();
1279

1280
    $editors = $self->get_editors();
1281

1282
1283
1284
1285
1286
1287
1288
1289
1290
    if ($param->{'ignore_nomail'}) {
        foreach my $e (@{$editors}) {
            push(@rcpt, lc($e->{'email'}));
        }
    } else {
        foreach my $e (@{$editors}) {
            next if ($e->{'reception'} eq 'nomail');
            push(@rcpt, lc($e->{'email'}));
        }
1291
    }
1292
    unless (@rcpt) {
1293
1294
        Log::do_log('debug3', 'No editors found for list %s, getting owners',
            $self);
1295
        @rcpt = $self->get_owners_email($param);
1296
1297
1298
1299
    }
    return @rcpt;
}

1300
## Returns an object Family if the list belongs to a family or undef
1301
1302
sub get_family {
    my $self = shift;
1303

1304
    if (ref $self->{'family'} eq 'Family') {
1305
        return $self->{'family'};
1306
1307
1308
1309
    } elsif ($self->{'admin'}{'family_name'}) {
        return $self->{'family'} =
            Family->new($self->{'admin'}{'family_name'}, $self->{'domain'});
    } else {
1310
        return undef;
1311
1312
1313
1314
    }
}

## return the config_changes hash
1315
## Used ONLY with lists belonging to a family.
1316
1317
sub get_config_changes {
    my $self = shift;
1318
    Log::do_log('debug3', '(%s)', $self->{'name'});