Admin.pm 56.6 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
22
#
# 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
23
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
24

25
26
27
28
29
30
31
32
33
34
35
36
=pod 

=head1 NAME 

I<admin.pm> - This module includes administrative function for the lists.

=head1 DESCRIPTION 

Central module for creating and editing lists.

=cut 

37
package Sympa::Admin;
38
39

use strict;
40
use warnings;
sikeda's avatar
sikeda committed
41
use Encode qw();
42
use English qw(-no_match_vars);
43
use File::Copy qw();
44
use IO::Scalar;
45
46

use Conf;
47
use Sympa::Constants;
48
use Sympa::Language;
49
use Sympa::List;
sikeda's avatar
sikeda committed
50
use Sympa::LockedFile;
51
use Log;
52
use Sympa::Regexps;
53
54
use Sympa::Robot;
use Sympa::Scenario;
sikeda's avatar
sikeda committed
55
use SDM;
56
use tools;
sikeda's avatar
sikeda committed
57
58
use tt2;
use Sympa::User;
59

60
61
my $language = Sympa::Language->instance;

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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
=pod 

=head1 SUBFUNCTIONS 

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

=cut 

=pod 

=head2 sub create_list_old(HASHRef,STRING,STRING)

Creates a list. Used by the create_list() sub in sympa.pl and the do_create_list() sub in wwsympa.fcgi.

=head3 Arguments 

=over 

=item * I<$param>, a ref on a hash containing parameters of the config list. The following keys are mandatory:

=over 4

=item - I<$param-E<gt>{'listname'}>,

=item - I<$param-E<gt>{'subject'}>,

=item - I<$param-E<gt>{'owner'}>, (or owner_include): array of hashes, with key email mandatory

=item - I<$param-E<gt>{'owner_include'}>, array of hashes, with key source mandatory

=back

=item * I<$template>, a string containing the list creation template

=item * I<$robot>, a string containing the name of the robot the list will be hosted by.

=back 

=head3 Return 

=over 

=item * I<undef>, if something prevents the list creation

=item * I<a reference to a hash>, if the list is normally created. This hash contains two keys:

=over 4

=item - I<list>, the list object corresponding to the list just created

=item - I<aliases>, undef if not applicable; 1 (if ok) or $aliases : concatenated string of aliases if they are not installed or 1 (in status open)

=back

=back 

=head3 Calls 

=item * check_owner_defined

=item * check_topics

=item * install_aliases

=item * list_check_smtp

=item * Conf::get_robot_conf

130
=item * Sympa::List::create_shared
131

132
=item * Sympa::List::has_include_data_sources
133

134
=item * Sympa::List::sync_include
135
136

=item * tools::search_fullpath
137
138
139

=item * Log::do_log

140
=item * tools::get_search_path
141
142
143
144
145
146
147

=item * tt2::parse_tt2 

=back 

=cut 

148
########################################################
149
150
151
# create_list_old
########################################################
# Create a list : used by sympa.pl--create_list and
152
153
#                 wwsympa.fcgi--do_create_list
# without family concept
154
#
155
156
157
158
# IN  : - $param : ref on parameters of the config list
#         with obligatory :
#         $param->{'listname'}
#         $param->{'subject'}
159
#         $param->{'owner'} (or owner_include):
160
161
162
#          array of hash,with key email obligatory
#         $param->{'owner_include'} array of hash :
#              with key source obligatory
163
164
165
#       - $template : the create list template
#       - $robot : the list's robot
#       - $origin : the source of the command : web, soap or command_line
166
#              no longer used
167
168
# OUT : - hash with keys :
#          -list :$list
169
#          -aliases : undef if not applicable; 1 (if ok) or
170
#           $aliases : concated string of alias if they
171
172
#           are not installed or 1(in status open)
#######################################################
173
174
sub create_list_old {
    my ($param, $template, $robot, $origin, $user_mail) = @_;
175
    Log::do_log('debug', '(%s, %s)', $param->{'listname'}, $robot, $origin);
176
177
178
179

    ## obligatory list parameters
    foreach my $arg ('listname', 'subject') {
        unless ($param->{$arg}) {
180
            Log::do_log('err', 'Missing list param %s', $arg);
181
182
            return undef;
        }
183
    }
184
    # owner.email || owner_include.source
185
186
187
    unless (check_owner_defined($param->{'owner'}, $param->{'owner_include'}))
    {
        Log::do_log('err',
188
            'Problem in owner definition in this list creation');
189
        return undef;
190
    }
191
192
193

    # template
    unless ($template) {
194
        Log::do_log('err', 'Missing param "template"', $template);
195
        return undef;
196
    }
197
198
    # robot
    unless ($robot) {
199
        Log::do_log('err', 'Missing param "robot"', $robot);
200
        return undef;
201
    }
202

203
    ## check listname
204
    $param->{'listname'} = lc($param->{'listname'});
205
    my $listname_regexp = Sympa::Regexps::listname();
206

207
    unless ($param->{'listname'} =~ /^$listname_regexp$/i) {
208
        Log::do_log('err', 'Incorrect listname %s', $param->{'listname'});
209
        return undef;
210
211
    }

212
213
214
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($param->{'listname'} =~ /^(\S+)-($regx)$/) {
215
216
217
            Log::do_log('err',
                'Incorrect listname %s matches one of service aliases',
                $param->{'listname'});
218
219
220
            return undef;
        }
    }
221

222
    if ($param->{'listname'} eq Conf::get_robot_conf($robot, 'email')) {
223
224
225
        Log::do_log('err',
            'Incorrect listname %s matches one of service aliases',
            $param->{'listname'});
226
        return undef;
227
228
    }

229
    ## Check listname on SMTP server
sikeda's avatar
sikeda committed
230
    my $res = list_check_smtp($param->{'listname'}, $robot);
231
    unless (defined $res) {
232
        Log::do_log('err', 'Can\'t check list %.128s on %s',
233
234
            $param->{'listname'}, $robot);
        return undef;
235
    }
236

237
    ## Check this listname doesn't exist already.
sikeda's avatar
sikeda committed
238
239
240
    if ($res
        || Sympa::List->new($param->{'listname'}, $robot, {'just_try' => 1}))
    {
241
242
243
        Log::do_log('err',
            'Could not create already existing list %s on %s for',
            $param->{'listname'}, $robot);
244
245
246
247
        foreach my $o (@{$param->{'owner'}}) {
            Log::do_log('err', $o->{'email'});
        }
        return undef;
248
249
    }

250
    ## Check the template supposed to be used exist.
251
252
    my $template_file = tools::search_fullpath($robot, 'config.tt2',
        subidr => 'create_list_templates/' . $template);
253
    unless (defined $template_file) {
254
        Log::do_log('err', 'No template %s found', $template);
255
256
257
258
259
260
261
262
263
264
        return undef;
    }

    ## Create the list directory
    my $list_dir;

    # a virtual robot
    if (-d "$Conf::Conf{'home'}/$robot") {
        unless (-d $Conf::Conf{'home'} . '/' . $robot) {
            unless (mkdir($Conf::Conf{'home'} . '/' . $robot, 0777)) {
265
                Log::do_log('err', 'Unable to create %s/%s: %s',
266
267
268
269
270
271
272
273
274
                    $Conf::Conf{'home'}, $robot, $?);
                return undef;
            }
        }
        $list_dir =
            $Conf::Conf{'home'} . '/' . $robot . '/' . $param->{'listname'};
    } else {
        $list_dir = $Conf::Conf{'home'} . '/' . $param->{'listname'};
    }
275

276
    ## Check the privileges on the list directory
277
    unless (mkdir($list_dir, 0777)) {
278
279
        Log::do_log('err', 'Unable to create %s: %s', $list_dir,
            $CHILD_ERROR);
280
281
282
        return undef;
    }

283
    ## Check topics
284
285
    if ($param->{'topics'}) {
        unless (check_topics($param->{'topics'}, $robot)) {
286
287
            Log::do_log('err', 'Topics param %s not defined in topics.conf',
                $param->{'topics'});
288
        }
289
    }
290

291
    ## Creation of the config file
sikeda's avatar
sikeda committed
292
    my $host = Conf::get_robot_conf($robot, 'host');
293
294
    ##FIXME:should be unneccessary
    $param->{'creation'}{'date'} =
295
        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
296
    $param->{'creation'}{'date_epoch'} = time;
297
298
299
300
301
302
    $param->{'creation_email'} = "listmaster\@$host"
        unless ($param->{'creation_email'});
    $param->{'status'} = 'open' unless ($param->{'status'});

    my $tt2_include_path = tools::get_search_path($robot,
        subdir => 'create_list_templates/' . $template);
303

304
    ## Lock config before openning the config file
305
306
    my $lock_fh = Sympa::LockedFile->new($list_dir . '/config', 5, '>');
    unless ($lock_fh) {
307
        Log::do_log('err', 'Impossible to create %s/config: %m', $list_dir);
308
        return undef;
309
    }
310
311
    ## Use an intermediate handler to encode to filesystem_encoding
    my $config = '';
312
    my $fd     = IO::Scalar->new(\$config);
313
    #FIXME: Check parse error
sikeda's avatar
sikeda committed
314
    tt2::parse_tt2($param, 'config.tt2', $fd, $tt2_include_path);
315
#    Encode::from_to($config, 'utf8', $Conf::Conf{'filesystem_encoding'});
316
    print $lock_fh $config;
317

318
    ## Unlock config file
319
    $lock_fh->close;
320

321
322
323
    ## Creation of the info file
    # remove DOS linefeeds (^M) that cause problems with Outlook 98, AOL, and
    # EIMS:
324
    $param->{'description'} =~ s/\r\n|\r/\n/g;
325

326
327
    ## info file creation.
    unless (open INFO, '>', "$list_dir/info") {
328
        Log::do_log('err', 'Impossible to create %s/info: %m', $list_dir);
329
    }
330
    if (defined $param->{'description'}) {
331
332
333
        Encode::from_to($param->{'description'},
            'utf8', $Conf::Conf{'filesystem_encoding'});
        print INFO $param->{'description'};
334
    }
335
    close INFO;
336

337
338
    ## Create list object
    my $list;
339
    unless ($list = Sympa::List->new($param->{'listname'}, $robot)) {
340
        Log::do_log('err', 'Unable to create list %s', $param->{'listname'});
341
        return undef;
342
343
344
345
    }

    ## Create shared if required
    if (defined $list->{'admin'}{'shared_doc'}) {
346
        $list->create_shared();
347
348
    }

349
350
    #log in stat_table to make statistics

351
352
353
354
355
356
357
358
359
360
361
    if ($origin eq "web") {
        Log::db_stat_log(
            {   'robot'     => $robot,
                'list'      => $param->{'listname'},
                'operation' => 'create list',
                'parameter' => '',
                'mail'      => $user_mail,
                'client'    => '',
                'daemon'    => 'wwsympa.fcgi'
            }
        );
362
363
    }

364
365
366
    my $return = {};
    $return->{'list'} = $list;

367
    if ($list->{'admin'}{'status'} eq 'open') {
368
        $return->{'aliases'} = install_aliases($list);
369
370
    } else {
        $return->{'aliases'} = 1;
371
    }
372

373
    ## Synchronize list members if required
374
    if ($list->has_include_data_sources()) {
375
376
        Log::do_log('notice', "Synchronizing list members...");
        $list->sync_include();
377
    }
378

379
    $list->save_config($param->{'creation_email'});
380
    return $return;
381
382
383
}

########################################################
384
385
386
# create_list
########################################################
# Create a list : used by sympa.pl--instantiate_family
387
# with family concept
388
#
389
390
391
392
# IN  : - $param : ref on parameters of the config list
#         with obligatory :
#         $param->{'listname'}
#         $param->{'subject'}
393
#         $param->{'owner'} (or owner_include):
394
395
396
#          array of hash,with key email obligatory
#         $param->{'owner_include'} array of hash :
#              with key source obligatory
397
#       - $family : the family object
398
#       - $robot : the list's robot  ** No longer used.
399
400
401
#       - $abort_on_error : won't create the list directory on
#          tt2 process error (usefull for dynamic lists that
#          throw exceptions)
402
403
# OUT : - hash with keys :
#          -list :$list
404
#          -aliases : undef if not applicable; 1 (if ok) or
405
#           $aliases : concated string of alias if they
406
407
#           are not installed or 1(in status open)
#######################################################
408
sub create_list {
sikeda's avatar
sikeda committed
409
    my ($param, $family, $dummy, $abort_on_error) = @_;
410
411
    Log::do_log('info', '(%s, %s, %s)', $param->{'listname'},
        $family->{'name'}, $param->{'subject'});
412

413
    ## mandatory list parameters
414
    foreach my $arg ('listname') {
415
        unless ($param->{$arg}) {
416
            Log::do_log('err', 'Missing list param %s', $arg);
417
418
            return undef;
        }
419
    }
420
421

    unless ($family) {
422
        Log::do_log('err', 'Missing param "family"');
423
        return undef;
424
    }
425
426

    #robot
427
    my $robot = $family->{'robot'};
428
    unless ($robot) {
429
        Log::do_log('err', 'Missing param "robot"');
430
        return undef;
431
    }
432

433
    ## check listname
434
    $param->{'listname'} = lc($param->{'listname'});
435
    my $listname_regexp = Sympa::Regexps::listname();
436

437
    unless ($param->{'listname'} =~ /^$listname_regexp$/i) {
438
        Log::do_log('err', 'Incorrect listname %s', $param->{'listname'});
439
440
441
442
443
444
        return undef;
    }

    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($param->{'listname'} =~ /^(\S+)-($regx)$/) {
445
446
447
            Log::do_log('err',
                'Incorrect listname %s matches one of service aliases',
                $param->{'listname'});
448
449
450
451
            return undef;
        }
    }
    if ($param->{'listname'} eq Conf::get_robot_conf($robot, 'email')) {
452
453
454
        Log::do_log('err',
            'Incorrect listname %s matches one of service aliases',
            $param->{'listname'});
455
        return undef;
456
    }
457
458

    ## Check listname on SMTP server
sikeda's avatar
sikeda committed
459
    my $res = list_check_smtp($param->{'listname'}, $robot);
460
    unless (defined $res) {
461
        Log::do_log('err', 'Can\'t check list %.128s on %s',
462
463
            $param->{'listname'}, $robot);
        return undef;
464
465
466
    }

    if ($res) {
467
468
469
        Log::do_log('err',
            'Could not create already existing list %s on %s for',
            $param->{'listname'}, $robot);
470
471
472
473
        foreach my $o (@{$param->{'owner'}}) {
            Log::do_log('err', $o->{'email'});
        }
        return undef;
474
475
476
    }

    ## template file
477
    my $template_file = tools::search_fullpath($family, 'config.tt2');
478
    unless (defined $template_file) {
479
        Log::do_log('err', 'No config template from family %s@%s',
480
481
            $family->{'name'}, $robot);
        return undef;
482
483
    }

484
485
    my $family_config =
        Conf::get_robot_conf($robot, 'automatic_list_families');
486
    $param->{'family_config'} = $family_config->{$family->{'name'}};
487
    my $conf;
488
489
    my $tt_result =
        tt2::parse_tt2($param, 'config.tt2', \$conf, [$family->{'dir'}]);
490
    unless (defined $tt_result || !$abort_on_error) {
491
492
        Log::do_log('err', 'Abort on tt2 error. List %s from family %s@%s',
            $param->{'listname'}, $family->{'name'}, $robot);
493
        return undef;
494
    }
495

496
497
    ## Create the list directory
    my $list_dir;
498

499
    if (-d "$Conf::Conf{'home'}/$robot") {
500
501
        unless (-d $Conf::Conf{'home'} . '/' . $robot) {
            unless (mkdir($Conf::Conf{'home'} . '/' . $robot, 0777)) {
502
                Log::do_log('err', 'Unable to create %s/%s: %s',
503
504
505
506
507
508
509
510
511
512
513
                    $Conf::Conf{'home'}, $robot, $?);
                return undef;
            }
        }
        $list_dir =
            $Conf::Conf{'home'} . '/' . $robot . '/' . $param->{'listname'};
    } else {
        $list_dir = $Conf::Conf{'home'} . '/' . $param->{'listname'};
    }

    unless (-r $list_dir || mkdir($list_dir, 0777)) {
514
515
        Log::do_log('err', 'Unable to create %s: %s', $list_dir,
            $CHILD_ERROR);
516
517
518
        return undef;
    }

519
    ## Check topics
520
521
    if (defined $param->{'topics'}) {
        unless (check_topics($param->{'topics'}, $robot)) {
522
523
            Log::do_log('err', 'Topics param %s not defined in topics.conf',
                $param->{'topics'});
524
        }
525
    }
526

527
    ## Lock config before openning the config file
528
529
    my $lock_fh = Sympa::LockedFile->new($list_dir . '/config', 5, '>');
    unless ($lock_fh) {
530
        Log::do_log('err', 'Impossible to create %s/config: %m', $list_dir);
531
        return undef;
532
    }
sikeda's avatar
sikeda committed
533
    #tt2::parse_tt2($param, 'config.tt2', $lock_fh, [$family->{'dir'}]);
534
535
    print $lock_fh $conf;

536
    ## Unlock config file
537
    $lock_fh->close;
538

539
540
541
    ## Creation of the info file
    # remove DOS linefeeds (^M) that cause problems with Outlook 98, AOL, and
    # EIMS:
542
543
544
    $param->{'description'} =~ s/\r\n|\r/\n/g;

    unless (open INFO, '>', "$list_dir/info") {
545
        Log::do_log('err', 'Impossible to create %s/info: %m', $list_dir);
546
547
    }
    if (defined $param->{'description'}) {
548
        print INFO $param->{'description'};
549
    }
550
    close INFO;
551
552

    ## Create associated files if a template was given.
553
    my @files_to_parse;
554
555
556
557
    foreach my $file (split ',',
        Conf::get_robot_conf($robot, 'parsed_family_files')) {
        $file =~ s{\s}{}g;
        push @files_to_parse, $file;
558
559
    }
    for my $file (@files_to_parse) {
560
561
562
563
564
565
        my $template_file = tools::search_fullpath($family, $file . ".tt2");
        if (defined $template_file) {
            my $file_content;
            my $tt_result = tt2::parse_tt2($param, $file . ".tt2",
                \$file_content, [$family->{'dir'}]);
            unless (defined $tt_result) {
566
567
568
                Log::do_log('err',
                    'Tt2 error. List %s from family %s@%s, file %s',
                    $param->{'listname'}, $family->{'name'}, $robot, $file);
569
570
            }
            unless (open FILE, '>', "$list_dir/$file") {
571
572
                Log::do_log('err', 'Impossible to create %s/%s: %m',
                    $list_dir, $file);
573
574
575
576
            }
            print FILE $file_content;
            close FILE;
        }
577
578
    }

579
580
    ## Create list object
    my $list;
581
    unless ($list = Sympa::List->new($param->{'listname'}, $robot)) {
582
        Log::do_log('err', 'Unable to create list %s', $param->{'listname'});
583
        return undef;
584
585
586
587
    }

    ## Create shared if required
    if (defined $list->{'admin'}{'shared_doc'}) {
588
589
590
        $list->create_shared();
    }

591
592
    ##FIXME:should be unneccessary
    $list->{'admin'}{'creation'}{'date'} =
593
        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
594
    $list->{'admin'}{'creation'}{'date_epoch'} = time;
595
    if ($param->{'creation_email'}) {
596
        $list->{'admin'}{'creation'}{'email'} = $param->{'creation_email'};
597
    } else {
598
599
        my $host = Conf::get_robot_conf($robot, 'host');
        $list->{'admin'}{'creation'}{'email'} = "listmaster\@$host";
600
    }
601
    if ($param->{'status'}) {
602
        $list->{'admin'}{'status'} = $param->{'status'};
603
    } else {
604
        $list->{'admin'}{'status'} = 'open';
605
606
607
608
609
610
611
    }
    $list->{'admin'}{'family_name'} = $family->{'name'};

    my $return = {};
    $return->{'list'} = $list;

    if ($list->{'admin'}{'status'} eq 'open') {
612
        $return->{'aliases'} = install_aliases($list);
613
614
    } else {
        $return->{'aliases'} = 1;
615
    }
616
617
618

    ## Synchronize list members if required
    if ($list->has_include_data_sources()) {
619
620
        Log::do_log('notice', "Synchronizing list members...");
        $list->sync_include();
621
622
    }

623
624
625
626
    return $return;
}

########################################################
627
628
629
# update_list
########################################################
# update a list : used by sympa.pl--instantiate_family
630
# with family concept when the list already exists
631
#
632
# IN  : - $list : the list to update
633
#       - $param : ref on parameters of the new
634
635
636
#          config list with obligatory :
#         $param->{'listname'}
#         $param->{'subject'}
637
#         $param->{'owner'} (or owner_include):
638
639
640
#          array of hash,with key email obligatory
#         $param->{'owner_include'} array of hash :
#              with key source obligatory
641
642
#       - $family : the family object
#       - $robot : the list's robot
643
644
645
#
# OUT : - $list : the updated list or undef
#######################################################
646
647
sub update_list {
    my ($list, $param, $family, $robot) = @_;
648
649
    Log::do_log('info', '(%s, %s, %s)', $param->{'listname'},
        $family->{'name'}, $param->{'subject'});
650

651
652
    ## mandatory list parameters
    foreach my $arg ('listname') {
653
        unless ($param->{$arg}) {
654
            Log::do_log('err', 'Missing list param %s', $arg);
655
656
            return undef;
        }
657
    }
658

659
    ## template file
660
    my $template_file = tools::search_fullpath($family, 'config.tt2');
661
    unless (defined $template_file) {
662
        Log::do_log('err', 'No config template from family %s@%s',
663
664
            $family->{'name'}, $robot);
        return undef;
665
666
667
    }

    ## Check topics
668
669
    if (defined $param->{'topics'}) {
        unless (check_topics($param->{'topics'}, $robot)) {
670
671
            Log::do_log('err', 'Topics param %s not defined in topics.conf',
                $param->{'topics'});
672
        }
673
674
    }

675
    ## Lock config before openning the config file
676
677
    my $lock_fh = Sympa::LockedFile->new($list->{'dir'} . '/config', 5, '>');
    unless ($lock_fh) {
678
        Log::do_log('err', 'Impossible to create %s/config: %s',
679
680
            $list->{'dir'}, $!);
        return undef;
681
    }
682
    #FIXME: Check parse error
sikeda's avatar
sikeda committed
683
    tt2::parse_tt2($param, 'config.tt2', $lock_fh, [$family->{'dir'}]);
684
    ## Unlock config file
685
    $lock_fh->close;
686

687
    ## Create list object
688
    unless ($list = Sympa::List->new($param->{'listname'}, $robot)) {
689
        Log::do_log('err', 'Unable to create list %s', $param->{'listname'});
690
        return undef;
691
    }
692
693
694

    ##FIXME:should be unneccessary
    $list->{'admin'}{'creation'}{'date'} =
695
        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
696
    $list->{'admin'}{'creation'}{'date_epoch'} = time;
697
    if ($param->{'creation_email'}) {
698
        $list->{'admin'}{'creation'}{'email'} = $param->{'creation_email'};
699
    } else {
700
701
        my $host = Conf::get_robot_conf($robot, 'host');
        $list->{'admin'}{'creation'}{'email'} = "listmaster\@$host";
702
703
    }

704
    if ($param->{'status'}) {
705
        $list->{'admin'}{'status'} = $param->{'status'};
706
    } else {
707
        $list->{'admin'}{'status'} = 'open';
708
709
710
    }
    $list->{'admin'}{'family_name'} = $family->{'name'};

711
    ## Create associated files if a template was given.
712
    my @files_to_parse;
713
714
715
716
    foreach my $file (split ',',
        Conf::get_robot_conf($robot, 'parsed_family_files')) {
        $file =~ s{\s}{}g;
        push @files_to_parse, $file;
717
718
    }
    for my $file (@files_to_parse) {
719
720
721
722
723
724
        my $template_file = tools::search_fullpath($family, $file . ".tt2");
        if (defined $template_file) {
            my $file_content;
            my $tt_result = tt2::parse_tt2($param, $file . ".tt2",
                \$file_content, [$family->{'dir'}]);
            unless (defined $tt_result) {
725
726
727
                Log::do_log('err',
                    'Tt2 error. List %s from family %s@%s, file %s',
                    $param->{'listname'}, $family->{'name'}, $robot, $file);
728
729
            }
            unless (open FILE, '>', "$list->{'dir'}/$file") {
730
                Log::do_log('err', 'Impossible to create %s/%s: %s',
731
732
733
734
735
                    $list->{'dir'}, $file, $!);
            }
            print FILE $file_content;
            close FILE;
        }
736
737
    }

738
739
    ## Synchronize list members if required
    if ($list->has_include_data_sources()) {
740
741
        Log::do_log('notice', "Synchronizing list members...");
        $list->sync_include();
742
743
    }

744
745
746
    return $list;
}

747
########################################################
748
749
# rename_list
########################################################
750
# Rename a list or move a list to another virtual host
751
#
752
753
754
# IN  : - list
#       - new_listname
#       - new_robot
755
#       - mode  : 'copy'
756
757
758
759
760
#       - auth_method
#       - user_email
#       - remote_host
#       - remote_addr
#       - options : 'skip_authz' to skip authorization scenarios eval
761
#
762
763
764
765
766
767
768
769
770
# OUT via reference :
#       - aliases
#       - status : 'pending'
#
# OUT : - scalar
#           undef  : error
#           1      : success
#           string : error code
#######################################################
771
sub rename_list {
772
    my (%param) = @_;
sikeda's avatar
sikeda committed
773
    Log::do_log('info', '',);
774

775
776
    my $list         = $param{'list'};
    my $robot        = $list->{'domain'};
777
778
779
    my $old_listname = $list->{'name'};

    # check new listname syntax
780
    my $new_listname    = lc($param{'new_listname'});
781
    my $listname_regexp = Sympa::Regexps::listname();
782

783
    unless ($new_listname =~ /^$listname_regexp$/i) {
784
        Log::do_log('err', 'Incorrect listname %s', $new_listname);
785
        return 'incorrect_listname';
786
    }
787

788
    ## Evaluate authorization scenario unless run as listmaster (sympa.pl)
789
    my ($result, $r_action, $reason);
790
    unless ($param{'options'}{'skip_authz'}) {
791
        $result = Sympa::Scenario::request_action(
792
            $param{'new_robot'},
793
794
795
796
797
798
799
800
801
802
803
804
805
806
            'create_list',
            $param{'auth_method'},
            {   'sender'      => $param{'user_email'},
                'remote_host' => $param{'remote_host'},
                'remote_addr' => $param{'remote_addr'}
            }
        );

        if (ref($result) eq 'HASH') {
            $r_action = $result->{'action'};
            $reason   = $result->{'reason'};
        }

        unless ($r_action =~ /do_it|listmaster/) {
807
            Log::do_log('err', 'Authorization error');
808
809
            return 'authorization';
        }
810
811
812
813
    }

    ## Check listname on SMTP server
    my $res = list_check_smtp($param{'new_listname'}, $param{'new_robot'});
814
    unless (defined($res)) {
815
        Log::do_log('err', 'Can\'t check list %.128s on %.128s',
816
817
818
819
820
821
822
            $param{'new_listname'}, $param{'new_robot'});
        return 'internal';
    }

    if ($res
        || ($list->{'name'} ne $param{'new_listname'})
        &&    ## Do not test if listname did not change
823
        (   Sympa::List->new(
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
                $param{'new_listname'}, $param{'new_robot'},
                {'just_try' => 1}
            )
        )
        ) {
        Log::do_log(
            'err',
            'Could not rename list %s on %s: new list %s on %s already existing list',
            $list->{'name'},
            $robot,
            $param{'new_listname'},
            $param{'new_robot'}
        );
        return 'list_already_exists';
    }

    my $regx = Conf::get_robot_conf($param{'new_robot'}, 'list_check_regexp');
    if ($regx) {
        if ($param{'new_listname'} =~ /^(\S+)-($regx)$/) {
            Log::do_log('err',
                'Incorrect listname %s matches one of service aliases',
                $param{'new_listname'});
            return 'incorrect_listname';
        }
    }

    unless ($param{'mode'} eq 'copy') {
        $list->savestats();

        ## Dump subscribers
        $list->_save_list_members_file(
            "$list->{'dir'}/subscribers.closed.dump");

        $param{'aliases'} = remove_aliases($list, $list->{'domain'});
    }

    ## Rename or create this list directory itself
    my $new_dir;
    ## Default robot
    if (-d "$Conf::Conf{'home'}/$param{'new_robot'}") {
        $new_dir =
              $Conf::Conf{'home'} . '/'
            . $param{'new_robot'} . '/'
            . $param{'new_listname'};
    } elsif ($param{'new_robot'} eq $Conf::Conf{'domain'}) {
        $new_dir = $Conf::Conf{'home'} . '/' . $param{'new_listname'};
    } else {
871
        Log::do_log('err', 'Unknown robot %s', $param{'new_robot'});
872
873
        return 'unknown_robot';
    }
874
875

    ## If we are in 'copy' mode, create en new list
876
877
    if ($param{'mode'} eq 'copy') {
        unless (
878
            $list = clone_list_as_empty(
879
880
881
882
883
                $list->{'name'},        $list->{'domain'},
                $param{'new_listname'}, $param{'new_robot'},
                $param{'user_email'}
            )
            ) {
884
885
            Log::do_log('err', 'Unable to load %s while renaming',
                $param{'new_listname'});
886
887
888
            return 'internal';
        }
    }
889
890
891

    # set list status to pending if creation list is moderated
    if ($r_action =~ /listmaster/) {
892
        $list->{'admin'}{'status'} = 'pending';
893
894
        tools::send_notify_to_listmaster(
            $list,
895
            'request_list_renaming',
896
            {   'new_listname' => $param{'new_listname'},
897
898
899
900
901
902
903
904
                'old_listname' => $old_listname,
                'email'        => $param{'user_email'},
                'mode'         => $param{'mode'}
            }
        );
        $param{'status'} = 'pending';
    }

905
906
    ## Save config file for the new() later to reload it
    $list->save_config($param{'user_email'});
907

908
    ## This code should be in Sympa::List::rename()
909
    unless ($param{'mode'} eq 'copy') {
910
        unless (File::Copy::move($list->{'dir'}, $new_dir)) {
911
912
            Log::do_log('err', 'Unable to rename %s to %s: %m',
                $list->{'dir'}, $new_dir);
913
914
915
916
917
918
919
920
921
922
923
924
            return 'internal';
        }

        ## Rename archive
        my $arc_dir =
            Conf::get_robot_conf($robot, 'arc_path') . '/'
            . $list->get_list_id();
        my $new_arc_dir =
              Conf::get_robot_conf($param{'new_robot'}, 'arc_path') . '/'
            . $param{'new_listname'} . '@'
            . $param{'new_robot'};
        if (-d $arc_dir && $arc_dir ne $new_arc_dir) {
925
            unless (File::Copy::move($arc_dir, $new_arc_dir)) {
926
                Log::do_log('err', 'Unable to rename archive %s', $arc_dir);
927
928
929
930
931
932
933
934
935
936
937
938
                # continue even if there is some troubles with archives
                # return undef;
            }
        }

        ## Rename bounces
        my $bounce_dir = $list->get_bounce_dir();
        my $new_bounce_dir =
              Conf::get_robot_conf($param{'new_robot'}, 'bounce_path') . '/'