Family.pm 79.3 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
# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
12
13
# directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
14
15
16
17
18
19
20
21
22
23
24
25
#
# 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.
#
# You should have received a copy of the GNU General Public License
26
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
27

28
=encoding utf-8
29

30
31
32
#=head1 NAME 
#
#I<Family.pm> - Handles list families
33
34
35
36
37
38
39

=head1 DESCRIPTION 

Sympa allows lists creation and management by sets. These are the families, sets of lists sharing common properties. This module gathers all the family-specific operations.

=cut 

40
package Sympa::Family;
41
42

use strict;
43
use warnings;
44
use English qw(-no_match_vars);
45
use File::Copy qw();
46
use Term::ProgressBar;
47
use XML::LibXML;
48

49
use Sympa;
50
use Sympa::Admin;
51
use Conf;
52
use Sympa::Config_XML;
53
use Sympa::Constants;
54
use Sympa::DatabaseManager;
55
use Sympa::Language;
56
use Sympa::List;
57
use Sympa::Log;
58
use Sympa::Regexps;
59
use Sympa::Scenario;
60
use Sympa::Tools::File;
61

62
my $language = Sympa::Language->instance;
63
my $log      = Sympa::Log->instance;
64

65
my %list_of_families;
66
67
68
69
70
my @uncompellable_param = (
    'msg_topic.keywords',
    'owner_include.source_parameters',
    'editor_include.source_parameters'
);
71

72
73
74
75
76
77
78
79
80
81
82
83
84
85
=pod 

=head1 SUBFUNCTIONS 

This is the description of the subfunctions contained by Family.pm

=cut 

=pod 

=head1 Class methods 

=cut 

86
87
88
## Class methods
################

89
=head2 sub get_families(Robot $robot)
90
91
92
93
94
95
96

Returns the list of existing families in the Sympa installation.

=head3 Arguments 

=over 

97
=item * I<$robot>, the robot the family list of which we want to get.
98
99
100

=back 

101
=head3 Returns
102
103
104

=over 

105
=item * An arrayref containing all the robot's family names.
106
107
108
109
110

=back 

=cut

111
112
sub get_families {
    my $robot_id = shift;
113

114
    my @families;
115

116
    foreach my $dir (
117
        reverse @{Sympa::get_search_path($robot_id, subdir => 'families')}) {
118
        next unless -d $dir;
119
120

        unless (opendir FAMILIES, $dir) {
121
            $log->syslog('err', 'Can\'t open dir %s: %m', $dir);
122
123
124
            next;
        }

125
        # If we can create a Sympa::Family object with what we find in the
126
        # family directory, then it is worth being added to the list.
127
        foreach my $subdir (grep !/^\.\.?$/, readdir FAMILIES) {
128
            next unless -d ("$dir/$subdir");
129
            if (my $family = Sympa::Family->new($subdir, $robot_id)) {
130
                push @families, $family;
131
132
133
134
            }
        }
    }

135
    return \@families;
136
}
137

138
139
140
141
142
143
sub get_available_families {
    my $robot_id = shift;
    my $families;
    my %hash;
    if ($families = get_families($robot_id)) {
        foreach my $family (@$families) {
144
            if (ref $family eq 'Sympa::Family') {
145
146
147
148
149
150
151
152
                $hash{$family->{'name'}} = $family;
            }
        }
        return %hash;
    } else {
        return undef;
    }
}
153
154
155
156
157

=head1 Instance methods 

=cut 

158
159
160
## Instance methods
###################

161
162
163
164
=pod 

=head2 sub new(STRING $name, STRING $robot)

165
Creates a new Sympa::Family object of name $name, belonging to the robot $robot.
166
167
168
169
170

=head3 Arguments 

=over 

171
=item * I<$class>, the class in which we're supposed to create the object (namely "Sympa::Family"),
172
173
174
175
176
177
178
179
180
181
182

=item * I<$name>, a character string containing the family name,

=item * I<$robot>, a character string containing the name of the robot which the family is/will be installed in.

=back 

=head3 Return 

=over 

183
=item * I<$self>, the Sympa::Family object 
184
185
186
187
188

=back 

=cut

189
#########################################
190
# new
191
#########################################
192
# constructor of the class Sympa::Family :
193
194
195
#   check family existence (required files
#   and directory)
#
196
# IN : -$class
197
198
199
200
201
202
#      -$name : family name
#      -robot : family robot
# OUT : -$self
#########################################
sub new {
    my $class = shift;
203
    my $name  = shift;
204
    my $robot = shift;
205
    $log->syslog('debug2', '(%s, %s)', $name, $robot);
206

207
208
    my $self = {};

209
    if ($list_of_families{$robot}{$name}) {
210
        # use the current family in memory and update it
211
        $self = $list_of_families{$robot}{$name};
212
###########
213
214
215
216
217
218
        # the robot can be different from latest new ...
        if ($robot eq $self->{'robot'}) {
            return $self;
        } else {
            $self = {};
        }
219
    }
220
221
222
    # create a new object family
    bless $self, $class;
    $list_of_families{$robot}{$name} = $self;
223

224
    my $family_name_regexp = Sympa::Regexps::family_name();
225

226
    ## family name
227
    unless ($name && ($name =~ /^$family_name_regexp$/io)) {
228
        $log->syslog('err', 'Incorrect family name "%s"', $name);
229
        return undef;
230
231
232
233
234
235
236
237
    }

    ## Lowercase the family name.
    $name =~ tr/A-Z/a-z/;
    $self->{'name'} = $name;

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

238
    ## Adding configuration related to automatic lists.
239
240
    my $all_families_config =
        Conf::get_robot_conf($robot, 'automatic_list_families');
241
242
    my $family_config = $all_families_config->{$name};
    foreach my $key (keys %{$family_config}) {
243
        $self->{$key} = $family_config->{$key};
244
245
    }

246
247
248
    ## family directory
    $self->{'dir'} = $self->_get_directory();
    unless (defined $self->{'dir'}) {
249
        $log->syslog('err', '(%s, %s) The family directory does not exist',
250
251
            $name, $robot);
        return undef;
252
253
254
    }

    ## family files
255
    if (my $file_names = $self->_check_mandatory_files()) {
256
257
        $log->syslog('err',
            '(%s, %s) Definition family files are missing: %s',
258
259
            $name, $robot, $file_names);
        return undef;
260
261
262
    }

    ## file mtime
263
    $self->{'mtime'}{'param_constraint_conf'} = undef;
264

265
266
267
    ## hash of parameters constraint
    $self->{'param_constraint_conf'} = undef;

268
269
    ## state of the family for the use of check_param_constraint : 'no_check'
    ## or 'normal'
270
    ## check_param_constraint  only works in state "normal"
271
    $self->{'state'} = 'normal';
272
273
    return $self;
}
274

275
276
277
278
279
280
281
282
283
284
=pod 

=head2 sub add_list(FILE_HANDLE $data, BOOLEAN $abort_on_error)

Adds a list to the family. List description can be passed either through a hash of data or through a file handle.

=head3 Arguments 

=over 

285
=item * I<$self>, the Sympa::Family object,
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

=item * I<$data>, a file handle on an XML B<list> description file or a hash of data,

=item * I<$abort_on_error>: if true, the function won't create lists in status error_config.

=back 

=head3 Return 

=over 

=item * I<$return>, a hash containing the execution state of the method. If everything went well, the "ok" key must be associated to the value "1".

=back 

=cut

303
#########################################
304
# add_list
305
306
307
#########################################
# add a list to the family under to current robot:
# (list described by the xml file)
308
#
309
# IN : -$self
310
311
#      -$data : file handle on an xml file or hash of data
#      -$abort_on_error : if true won't create list in status error_config
312
# OUT : -$return->{'ok'} = 1(pas d'erreur fatale) or undef(erreur fatale)
313
#       -$return->{'string'} : string of results
314
315
#########################################
sub add_list {
316
317
    my ($self, $data, $abort_on_error) = @_;

318
    $log->syslog('info', '(%s)', $self->{'name'});
319
320
321

    $self->{'state'} = 'no_check';
    my $return;
322
323
324
    $return->{'ok'}           = undef;
    $return->{'string_info'}  = undef;    ## info and simple errors
    $return->{'string_error'} = undef;    ## fatal errors
325

326
    my $hash_list;
327

328
    if (ref($data) eq "HASH") {
329
        $hash_list = {config => $data};
330
    } else {
331
        #copy the xml file in another file
332
        unless (open FIC, '>', $self->{'dir'} . '/_new_list.xml') {
333
            $log->syslog('err',
334
335
                'Impossible to create the temp file %s/_new_list.xml: %m',
                $self->{'dir'});
336
337
338
339
340
341
342
        }
        while (<$data>) {
            print FIC ($_);
        }
        close FIC;

        # get list data
343
        open(FIC, '<:raw', $self->{'dir'} . '/_new_list.xml');
344
        my $config = Sympa::Config_XML->new(\*FIC);
345
346
347
348
349
350
351
352
353
354
        close FIC;
        unless (defined $config->createHash()) {
            push @{$return->{'string_error'}},
                "Error in representation data with these xml data";
            return $return;
        }

        $hash_list = $config->getHash();
    }

355
356
357
    # Check length
    if (Sympa::Constants::LIST_LEN() <
        length($hash_list->{'config'}{'listname'})) {
358
        $log->syslog('err', 'Too long value of param "listname"');
359
360
361
362
        push @{$return->{'string_error'}}, 'Too long list name';
        return $return;
    }

363
    #list creation
364
    my $result = Sympa::Admin::create_list($hash_list->{'config'},
365
        $self, $self->{'robot'}, $abort_on_error);
366
    unless (defined $result) {
367
        push @{$return->{'string_error'}},
368
            "Error during list creation, see logs for more information";
369
        return $return;
370
371
    }
    unless (defined $result->{'list'}) {
372
        push @{$return->{'string_error'}},
373
            "Errors : no created list, see logs for more information";
374
        return $return;
375
376
    }
    my $list = $result->{'list'};
377

378
379
    ## aliases
    if ($result->{'aliases'} == 1) {
380
381
382
383
384
        push @{$return->{'string_info'}},
            "List $list->{'name'} has been created in $self->{'name'} family";
    } else {
        push @{$return->{'string_info'}},
            "List $list->{'name'} has been created in $self->{'name'} family, required aliases : $result->{'aliases'} ";
385
    }
386

387
    # config_changes
388
    unless (open FILE, '>', "$list->{'dir'}/config_changes") {
389
        $list->set_status_error_config('error_copy_file', $self->{'name'});
390
        push @{$return->{'string_info'}},
391
392
            'Impossible to create file %s/config_changes : %s, the list is set in status error_config',
            $list->{'dir'}, $ERRNO;
393
394
    }
    close FILE;
395

396
    # info parameters
397
398
    $list->{'admin'}{'latest_instantiation'}{'email'} =
        Sympa::get_address($self, 'listmaster');
399
    $list->{'admin'}{'latest_instantiation'}{'date_epoch'} = time;
400
    $list->save_config(Sympa::get_address($self, 'listmaster'));
401
    $list->{'family'} = $self;
402
403

    ## check param_constraint.conf
404
405
406
    $self->{'state'} = 'normal';
    my $error = $self->check_param_constraint($list);
    $self->{'state'} = 'no_check';
407

408
    unless (defined $error) {
409
        $list->set_status_error_config('no_check_rules_family',
410
            $self->{'name'});
411
        push @{$return->{'string_error'}},
412
            "Impossible to check parameters constraint, see logs for more information. The list is set in status error_config";
413
        return $return;
414
    }
415

416
    if (ref($error) eq 'ARRAY') {
417
        $list->set_status_error_config('no_respect_rules_family',
418
            $self->{'name'});
419
420
421
        push @{$return->{'string_info'}},
            "The list does not respect the family rules : "
            . join(", ", @{$error});
422
    }
423

424
    ## copy files in the list directory : xml file
425
426
    unless (ref($data) eq "HASH") {
        unless ($self->_copy_files($list->{'dir'}, "_new_list.xml")) {
427
            $list->set_status_error_config('error_copy_file',
428
429
430
431
                $self->{'name'});
            push @{$return->{'string_info'}},
                "Impossible to copy the xml file in the list directory, the list is set in status error_config.";
        }
432
    }
433

434
435
    ## Synchronize list members if required
    if ($list->has_include_data_sources()) {
436
        $log->syslog('notice', "Synchronizing list members...");
437
        $list->sync_include();
438
439
    }

440
441
    ## END
    $self->{'state'} = 'normal';
442
    $return->{'ok'}  = 1;
443

444
445
446
    return $return;
}

447
448
449
450
451
452
453
454
455
456
=pod 

=head2 sub modify_list(FILE_HANDLE $fh)

Adds a list to the family.

=head3 Arguments 

=over 

457
=item * I<$self>, the Sympa::Family object,
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472

=item * I<$fh>, a file handle on the XML B<list> configuration file.

=back 

=head3 Return 

=over 

=item * I<$return>, a ref to a hash containing the execution state of the method. If everything went well, the "ok" key must be associated to the value "1".

=back 

=cut

473
#########################################
474
# modify_list
475
476
477
#########################################
# modify a list that belongs to the family
#  under to current robot:
478
# (the list modifications are described by the xml file)
479
#
480
481
482
# IN : -$self
#      -$fh : file handle on the xml file
# OUT : -$return->{'ok'} = 1(pas d'erreur fatale) or undef(erreur fatale)
483
#       -$return->{'string'} : string of results
484
485
486
#########################################
sub modify_list {
    my $self = shift;
487
    my $fh   = shift;
488
    $log->syslog('info', '(%s)', $self->{'name'});
489
490
491

    $self->{'state'} = 'no_check';
    my $return;
492
493
494
    $return->{'ok'}           = undef;
    $return->{'string_info'}  = undef;    ## info and simple errors
    $return->{'string_error'} = undef;    ## fatal errors
495
496

    #copy the xml file in another file
497
    unless (open FIC, '>', $self->{'dir'} . '/_mod_list.xml') {
498
        $log->syslog('err',
499
500
            'Impossible to create the temp file %s/_mod_list.xml: %m',
            $self->{'dir'});
501
502
    }
    while (<$fh>) {
503
        print FIC ($_);
504
505
506
507
    }
    close FIC;

    # get list data
508
    open(FIC, '<:raw', $self->{'dir'} . '/_mod_list.xml');
509
    my $config = Sympa::Config_XML->new(\*FIC);
510
511
    close FIC;
    unless (defined $config->createHash()) {
512
513
514
515
        push @{$return->{'string_error'}},
            "Error in representation data with these xml data";
        return $return;
    }
516
517
518
519
520

    my $hash_list = $config->getHash();

    #getting list
    my $list;
sikeda's avatar
sikeda committed
521
522
523
524
525
    unless (
        $list = Sympa::List->new(
            $hash_list->{'config'}{'listname'}, $self->{'robot'}
        )
        ) {
526
527
528
        push @{$return->{'string_error'}},
            "The list $hash_list->{'config'}{'listname'} does not exist.";
        return $return;
529
    }
530

531
532
    ## check family name
    if (defined $list->{'admin'}{'family_name'}) {
533
534
535
536
537
        unless ($list->{'admin'}{'family_name'} eq $self->{'name'}) {
            push @{$return->{'string_error'}},
                "The list $list->{'name'} already belongs to family $list->{'admin'}{'family_name'}.";
            return $return;
        }
538
    } else {
539
540
541
        push @{$return->{'string_error'}},
            "The orphan list $list->{'name'} already exists.";
        return $return;
542
543
544
545
546
    }

    ## get allowed and forbidden list customizing
    my $custom = $self->_get_customizing($list);
    unless (defined $custom) {
547
        $log->syslog('err', 'Impossible to get list %s customizing',
548
549
550
            $list->{'name'});
        push @{$return->{'string_error'}},
            "Error during updating list $list->{'name'}, the list is set in status error_config.";
551
        $list->set_status_error_config('modify_list_family', $self->{'name'});
552
        return $return;
553
    }
554
555
    my $config_changes = $custom->{'config_changes'};
    my $old_status     = $list->{'admin'}{'status'};
556
557

    ## list config family updating
558
    my $result = Sympa::Admin::update_list($list, $hash_list->{'config'},
559
        $self, $self->{'robot'});
560
    unless (defined $result) {
561
        $log->syslog('err', 'No object list resulting from updating list %s',
562
563
564
            $list->{'name'});
        push @{$return->{'string_error'}},
            "Error during updating list $list->{'name'}, the list is set in status error_config.";
565
        $list->set_status_error_config('modify_list_family', $self->{'name'});
566
        return $return;
567
568
    }
    $list = $result;
569

570
571
    ## set list customizing
    foreach my $p (keys %{$custom->{'allowed'}}) {
572
573
        $list->{'admin'}{$p} = $custom->{'allowed'}{$p};
        delete $list->{'admin'}{'defaults'}{$p};
574
        $log->syslog('info', 'Customizing: Keeping values for parameter %s',
575
            $p);
576
577
578
579
    }

    ## info file
    unless ($config_changes->{'file'}{'info'}) {
580
581
582
583
        $hash_list->{'config'}{'description'} =~ s/\r\n|\r/\n/g;

        unless (open INFO, '>', "$list->{'dir'}/info") {
            push @{$return->{'string_info'}},
584
585
                sprintf('Impossible to create new %s/info file: %s',
                $list->{'dir'}, $ERRNO);
586
587
588
        }
        print INFO $hash_list->{'config'}{'description'};
        close INFO;
589
590
591
    }

    foreach my $f (keys %{$config_changes->{'file'}}) {
592
        $log->syslog('info', 'Customizing: This file has been changed: %s',
593
            $f);
594
    }
595

596
    ## rename forbidden files
597
598
599
600
601
602
603
604
605
606
607
608
609
610
    #foreach my $f (@{$custom->{'forbidden'}{'file'}}) {
    #    unless (rename "$list->{'dir'}"."/"."info",
    #        "$list->{'dir'}"."/"."info.orig") {
    #        ###############
    #    }
    #    if ($f eq 'info') {
    #        $hash_list->{'config'}{'description'} =~ s/\r\n|\r/\n/g;
    #        unless (open INFO, '>', "$list_dir/info") {
    #            ###############
    #        }
    #        print INFO $hash_list->{'config'}{'description'};
    #        close INFO;
    #    }
    #}
611
612

    ## notify owner for forbidden customizing
613
614
615
    if (    #(scalar $custom->{'forbidden'}{'file'}) ||
        (scalar @{$custom->{'forbidden'}{'param'}})
        ) {
616
        #my $forbidden_files = join(',',@{$custom->{'forbidden'}{'file'}});
617
        my $forbidden_param = join(',', @{$custom->{'forbidden'}{'param'}});
618
        $log->syslog('notice',
619
620
621
            "These parameters aren't allowed in the new family definition, they are erased by a new instantiation family : \n $forbidden_param"
        );

622
623
        $list->send_notify_to_owner('erase_customizing',
            [$self->{'name'}, $forbidden_param]);
624
625
626
    }

    ## status
627
    $result = $self->_set_status_changes($list, $old_status);
628
629

    if ($result->{'aliases'} == 1) {
630
631
632
633
634
635
636
637
638
639
640
        push @{$return->{'string_info'}},
            "The $list->{'name'} list has been modified.";

    } elsif ($result->{'install_remove'} eq 'install') {
        push @{$return->{'string_info'}},
            "List $list->{'name'} has been modified, required aliases :\n $result->{'aliases'} ";

    } else {
        push @{$return->{'string_info'}},
            "List $list->{'name'} has been modified, aliases need to be removed : \n $result->{'aliases'}";

641
642
643
644
645
    }

    ## config_changes
    foreach my $p (@{$custom->{'forbidden'}{'param'}}) {

646
647
648
        if (defined $config_changes->{'param'}{$p}) {
            delete $config_changes->{'param'}{$p};
        }
649
650
651

    }

652
    unless (open FILE, '>', "$list->{'dir'}/config_changes") {
653
        $list->set_status_error_config('error_copy_file', $self->{'name'});
654
        push @{$return->{'string_info'}},
655
656
657
            sprintf
            'Impossible to create file %s/config_changes : %s, the list is set in status error_config.',
            $list->{'dir'}, $ERRNO;
658
659
660
661
    }
    close FILE;

    my @kept_param = keys %{$config_changes->{'param'}};
662
    $list->update_config_changes('param', \@kept_param);
663
    my @kept_files = keys %{$config_changes->{'file'}};
664
    $list->update_config_changes('file', \@kept_files);
665

666
667
    $list->{'admin'}{'latest_instantiation'}{'email'} =
        Sympa::get_address($self, 'listmaster');
668
    $list->{'admin'}{'latest_instantiation'}{'date_epoch'} = time;
669
    $list->save_config(Sympa::get_address($self, 'listmaster'));
670
    $list->{'family'} = $self;
671
672

    ## check param_constraint.conf
673
674
675
    $self->{'state'} = 'normal';
    my $error = $self->check_param_constraint($list);
    $self->{'state'} = 'no_check';
676

677
    unless (defined $error) {
678
        $list->set_status_error_config('no_check_rules_family',
679
            $self->{'name'});
680
        push @{$return->{'string_error'}},
681
            "Impossible to check parameters constraint, see logs for more information. The list is set in status error_config";
682
        return $return;
683
    }
684

685
    if (ref($error) eq 'ARRAY') {
686
        $list->set_status_error_config('no_respect_rules_family',
687
            $self->{'name'});
688
689
690
        push @{$return->{'string_info'}},
            "The list does not respect the family rules : "
            . join(", ", @{$error});
691
    }
692

693
694
    ## copy files in the list directory : xml file

695
    unless ($self->_copy_files($list->{'dir'}, "_mod_list.xml")) {
696
        $list->set_status_error_config('error_copy_file', $self->{'name'});
697
698
        push @{$return->{'string_info'}},
            "Impossible to copy the xml file in the list directory, the list is set in status error_config.";
699
700
    }

701
702
    ## Synchronize list members if required
    if ($list->has_include_data_sources()) {
703
        $log->syslog('notice', "Synchronizing list members...");
704
        $list->sync_include();
705
706
    }

707
708
    ## END
    $self->{'state'} = 'normal';
709
    $return->{'ok'}  = 1;
710
711
712
713

    return $return;
}

714
715
=pod 

716
=head2 sub close_family()
717
718
719
720
721
722
723

Closes every list family.

=head3 Arguments 

=over 

724
=item * I<$self>, the Sympa::Family object
725
726
727
728
729
730
731
732
733
734
735
736
737

=back 

=head3 Return 

=over 

=item * I<$string>, a character string containing a message to display describing the results of the sub.

=back 

=cut

738
#########################################
739
# close_family
740
741
742
#########################################
# closure family action :
#  - close every list family
743
#
744
745
746
# IN : -$self
# OUT : -$string
#########################################
747
sub close_family {
748
    my $self = shift;
749
    $log->syslog('info', '(%s)', $self->{'name'});
750

751
    my $family_lists = Sympa::List::get_lists($self);
752
753
754
    my @impossible_close;
    my @close_ok;

755
    foreach my $list (@{$family_lists}) {
756
757
758
        my $listname = $list->{'name'};

        unless (defined $list) {
759
            $log->syslog(
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
                'err',
                'The %s list belongs to %s family but the list does not exist',
                $listname,
                $self->{'name'}
            );
            next;
        }

        unless (
            $list->set_status_family_closed('close_list', $self->{'name'})) {
            push(@impossible_close, $list->{'name'});
            next;
        }
        push(@close_ok, $list->{'name'});
    }
    my $string =
        "\n\n******************************************************************************\n";
    $string .=
        "\n******************** CLOSURE of $self->{'name'} FAMILY ********************\n";
    $string .=
        "\n******************************************************************************\n\n";

    unless ($#impossible_close < 0) {
        $string .= "\nImpossible list closure for : \n  "
            . join(", ", @impossible_close) . "\n";
    }

    $string .= "\n****************************************\n";

    unless ($#close_ok < 0) {
        $string .=
            "\nThese lists are closed : \n  " . join(", ", @close_ok) . "\n";
    }
793

794
795
    $string .=
        "\n******************************************************************************\n";
796

797
798
    return $string;
}
799

800
801
=pod 

802
803
=head2 sub instantiate(FILEHANDLE $fh,
[ close_unknown =E<gt> 1 ], [ quiet =E<gt> 1 ] )
804
805
806
807
808
809
810

Creates family lists or updates them if they exist already.

=head3 Arguments 

=over 

811
=item * I<$self>, the Sympa::Family object corresponding to the family to create / update
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828

=back 

=head3 Return 

=over 

=item * I<$string>, a character string containing a message to display describing the results of the sub,

=item * I<$fh>, a file handle on the B<family> XML file,

=item * I<$close_unknown>: if true, the function will close old lists undefined in the new instantiation.

=back 

=cut

829
#########################################
830
# instantiate
831
832
833
834
#########################################
# instantiate family action :
#  - create family lists if they are not
#  - update family lists if they already exist
835
#
836
837
# IN : -$self
#      -$xml_fh : file handle on the xml file
838
839
840
841
#      -%options
#        - close_unknown : true if must close old lists undefined in new
#                          instantiation
#        - quiet         :
842
843
844
# OUT : -1 or undef
#########################################
sub instantiate {
845
846
847
848
    $log->syslog('debug2', '(%s, %s, ...)', @_);
    my $self     = shift;
    my $xml_file = shift;
    my %options  = @_;
849

850
    ## all the description variables are emptied.
851
    $self->_initialize_instantiation();
852

853
    ## set impossible checking (used by list->load)
854
    $self->{'state'} = 'no_check';
855

856
    ## get the currently existing lists in the family
857
    my $previous_family_lists =
858
        {(map { $_->{name} => $_ } @{Sympa::List::get_lists($self) || []})};
859

860
861
    ## Splits the family description XML file into a set of list description
    ## xml files
862
    ## and collects lists to be created in $self->{'list_to_generate'}.
863
    unless ($self->_split_xml_file($xml_file)) {
864
        $log->syslog('err', 'Errors during the parsing of family xml file');
865
866
867
        return undef;
    }

868
    my $created = 0;
869
870
871
    my $total;
    my $progress;
    unless ($self->{'list_to_generate'}) {
872
873
874
875
876
        $log->syslog('err', 'No list found in XML file %s.', $xml_file);
        $self->{'list_to_generate'} = [];
        $total = 0;
    } else {
        $total    = scalar @{$self->{'list_to_generate'}};
877
878
879
880
881
882
883
        $progress = Term::ProgressBar->new(
            {   name  => 'Creating lists',
                count => $total,
                ETA   => 'linear'
            }
        );
        $progress->max_update_rate(1);
884
    }
885
886
    my $next_update = 0;
    my $aliasmanager_output_file =
887
        $Conf::Conf{'tmpdir'} . '/aliasmanager.stdout.' . $PID;
888
    my $output_file =
889
        $Conf::Conf{'tmpdir'} . '/instantiate_family.stdout.' . $PID;
890
891
    my $output = '';

892
893
894
    ## EACH FAMILY LIST
    foreach my $listname (@{$self->{'list_to_generate'}}) {

895
        my $list = Sympa::List->new($listname, $self->{'robot'});
896
897

        ## get data from list XML file. Stored into $config (class
898
        ## Sympa::Config_XML).
899
        my $xml_fh;
900
        open $xml_fh, '<:raw', $self->{'dir'} . "/" . $listname . ".xml";
901
        my $config = Sympa::Config_XML->new($xml_fh);
902
903
904
905
906
907
908
909
        close $xml_fh;
        unless (defined $config->createHash()) {
            push(
                @{$self->{'errors'}{'create_hash'}},
                "$self->{'dir'}/$listname.xml"
            );
            if ($list) {
                $list->set_status_error_config('instantiation_family',
910
                    $self->{'name'});
911
912
913
914
915
916
917
918
            }
            next;
        }

        ## stores the list config into the hash referenced by $hash_list.
        my $hash_list = $config->getHash();

        if ($list) {
919
            ## LIST ALREADY EXISTING
920
921
922
923
924
925
926
927
928
929

            delete $previous_family_lists->{$list->{'name'}};

            ## check family name
            if (defined $list->{'admin'}{'family_name'}) {
                unless ($list->{'admin'}{'family_name'} eq $self->{'name'}) {
                    push(
                        @{$self->{'errors'}{'listname_already_used'}},
                        $list->{'name'}
                    );
930
                    $log->syslog('err',
931
932
933
934
935
936
937
938
939
                        'The list %s already belongs to family %s',
                        $list->{'name'}, $list->{'admin'}{'family_name'});
                    next;
                }
            } else {
                push(
                    @{$self->{'errors'}{'listname_already_used'}},
                    $list->{'name'}
                );
940
                $log->syslog('err', 'The orphan list %s already exists',
941
942
943
944
945
946
947
948
949
                    $list->{'name'});
                next;
            }

            ## Update list config
            my $result = $self->_update_existing_list($list, $hash_list);
            unless (defined $result) {
                push(@{$self->{'errors'}{'update_list'}}, $list->{'name'});
                $list->set_status_error_config('instantiation_family',
950
                    $self->{'name'});
951
952
953
954
                next;
            }
            $list = $result;
        } else {
955
956
957
958
959
            # FIRST LIST CREATION

            # Check length
            if (Sympa::Constants::LIST_LEN() <
                length($hash_list->{'config'}{'listname'})) {
960
                $log->syslog('err', 'Too long value of param "listname"');
961
962
963
964
                push @{$self->{'errors'}{'create_list'}},
                    $hash_list->{'config'}{'listname'};
                next;
            }
965
966

            ## Create the list
967
            my $result = Sympa::Admin::create_list($hash_list->{'config'},