Admin.pm 55.8 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;
57
use Sympa::Tools::File;
sikeda's avatar
sikeda committed
58
59
use tt2;
use Sympa::User;
60

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

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
=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 

=cut 

119
########################################################
120
121
122
# create_list_old
########################################################
# Create a list : used by sympa.pl--create_list and
123
124
#                 wwsympa.fcgi--do_create_list
# without family concept
125
#
126
127
128
129
# IN  : - $param : ref on parameters of the config list
#         with obligatory :
#         $param->{'listname'}
#         $param->{'subject'}
130
#         $param->{'owner'} (or owner_include):
131
132
133
#          array of hash,with key email obligatory
#         $param->{'owner_include'} array of hash :
#              with key source obligatory
134
135
136
#       - $template : the create list template
#       - $robot : the list's robot
#       - $origin : the source of the command : web, soap or command_line
137
#              no longer used
138
139
# OUT : - hash with keys :
#          -list :$list
140
#          -aliases : undef if not applicable; 1 (if ok) or
141
#           $aliases : concated string of alias if they
142
143
#           are not installed or 1(in status open)
#######################################################
144
145
sub create_list_old {
    my ($param, $template, $robot, $origin, $user_mail) = @_;
146
    Log::do_log('debug', '(%s, %s)', $param->{'listname'}, $robot, $origin);
147
148
149
150

    ## obligatory list parameters
    foreach my $arg ('listname', 'subject') {
        unless ($param->{$arg}) {
151
            Log::do_log('err', 'Missing list param %s', $arg);
152
153
            return undef;
        }
154
    }
155
    # owner.email || owner_include.source
156
157
158
    unless (check_owner_defined($param->{'owner'}, $param->{'owner_include'}))
    {
        Log::do_log('err',
159
            'Problem in owner definition in this list creation');
160
        return undef;
161
    }
162
163
164

    # template
    unless ($template) {
165
        Log::do_log('err', 'Missing param "template"', $template);
166
        return undef;
167
    }
168
169
    # robot
    unless ($robot) {
170
        Log::do_log('err', 'Missing param "robot"', $robot);
171
        return undef;
172
    }
173

174
    ## check listname
175
    $param->{'listname'} = lc($param->{'listname'});
176
    my $listname_regexp = Sympa::Regexps::listname();
177

178
179
    unless ($param->{'listname'} =~ /^$listname_regexp$/i
        and length $param->{'listname'} <= Sympa::Constants::LIST_LEN()) {
180
        Log::do_log('err', 'Incorrect listname %s', $param->{'listname'});
181
        return undef;
182
183
    }

184
185
186
    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($param->{'listname'} =~ /^(\S+)-($regx)$/) {
187
188
189
            Log::do_log('err',
                'Incorrect listname %s matches one of service aliases',
                $param->{'listname'});
190
191
192
            return undef;
        }
    }
193

194
195
196
    if (   $param->{'listname'} eq Conf::get_robot_conf($robot, 'email')
        or $param->{'listname'} eq
        Conf::get_robot_conf($robot, 'listmaster_email')) {
197
198
199
        Log::do_log('err',
            'Incorrect listname %s matches one of service aliases',
            $param->{'listname'});
200
        return undef;
201
202
    }

203
    ## Check listname on SMTP server
sikeda's avatar
sikeda committed
204
    my $res = list_check_smtp($param->{'listname'}, $robot);
205
    unless (defined $res) {
206
        Log::do_log('err', 'Can\'t check list %.128s on %s',
207
208
            $param->{'listname'}, $robot);
        return undef;
209
    }
210

211
    ## Check this listname doesn't exist already.
sikeda's avatar
sikeda committed
212
213
214
    if ($res
        || Sympa::List->new($param->{'listname'}, $robot, {'just_try' => 1}))
    {
215
216
217
        Log::do_log('err',
            'Could not create already existing list %s on %s for',
            $param->{'listname'}, $robot);
218
219
220
221
        foreach my $o (@{$param->{'owner'}}) {
            Log::do_log('err', $o->{'email'});
        }
        return undef;
222
223
    }

224
    ## Check the template supposed to be used exist.
225
    my $template_file = tools::search_fullpath($robot, 'config.tt2',
226
        subdir => 'create_list_templates/' . $template);
227
    unless (defined $template_file) {
228
        Log::do_log('err', 'No template %s found', $template);
229
230
231
232
233
234
235
236
237
238
        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)) {
239
                Log::do_log('err', 'Unable to create %s/%s: %s',
240
241
242
243
244
245
246
247
248
                    $Conf::Conf{'home'}, $robot, $?);
                return undef;
            }
        }
        $list_dir =
            $Conf::Conf{'home'} . '/' . $robot . '/' . $param->{'listname'};
    } else {
        $list_dir = $Conf::Conf{'home'} . '/' . $param->{'listname'};
    }
249

250
    ## Check the privileges on the list directory
251
    unless (mkdir($list_dir, 0777)) {
252
253
        Log::do_log('err', 'Unable to create %s: %s', $list_dir,
            $CHILD_ERROR);
254
255
256
        return undef;
    }

257
    ## Check topics
258
259
    if ($param->{'topics'}) {
        unless (check_topics($param->{'topics'}, $robot)) {
260
261
            Log::do_log('err', 'Topics param %s not defined in topics.conf',
                $param->{'topics'});
262
        }
263
    }
264

265
    ## Creation of the config file
sikeda's avatar
sikeda committed
266
    my $host = Conf::get_robot_conf($robot, 'host');
267
268
    ##FIXME:should be unneccessary
    $param->{'creation'}{'date'} =
269
        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
270
    $param->{'creation'}{'date_epoch'} = time;
271
272
273
274
275
276
    $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);
277

278
    ## Lock config before openning the config file
279
280
    my $lock_fh = Sympa::LockedFile->new($list_dir . '/config', 5, '>');
    unless ($lock_fh) {
281
        Log::do_log('err', 'Impossible to create %s/config: %m', $list_dir);
282
        return undef;
283
    }
284
285
    ## Use an intermediate handler to encode to filesystem_encoding
    my $config = '';
286
    my $fd     = IO::Scalar->new(\$config);
287
    #FIXME: Check parse error
sikeda's avatar
sikeda committed
288
    tt2::parse_tt2($param, 'config.tt2', $fd, $tt2_include_path);
289
#    Encode::from_to($config, 'utf8', $Conf::Conf{'filesystem_encoding'});
290
    print $lock_fh $config;
291

292
    ## Unlock config file
293
    $lock_fh->close;
294

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

300
301
    ## info file creation.
    unless (open INFO, '>', "$list_dir/info") {
302
        Log::do_log('err', 'Impossible to create %s/info: %m', $list_dir);
303
    }
304
    if (defined $param->{'description'}) {
305
306
307
        Encode::from_to($param->{'description'},
            'utf8', $Conf::Conf{'filesystem_encoding'});
        print INFO $param->{'description'};
308
    }
309
    close INFO;
310

311
312
    ## Create list object
    my $list;
313
    unless ($list = Sympa::List->new($param->{'listname'}, $robot)) {
314
        Log::do_log('err', 'Unable to create list %s', $param->{'listname'});
315
        return undef;
316
317
318
319
    }

    ## Create shared if required
    if (defined $list->{'admin'}{'shared_doc'}) {
320
        $list->create_shared();
321
322
    }

323
324
    #log in stat_table to make statistics

325
326
327
328
329
330
331
332
333
334
335
    if ($origin eq "web") {
        Log::db_stat_log(
            {   'robot'     => $robot,
                'list'      => $param->{'listname'},
                'operation' => 'create list',
                'parameter' => '',
                'mail'      => $user_mail,
                'client'    => '',
                'daemon'    => 'wwsympa.fcgi'
            }
        );
336
337
    }

338
339
340
    my $return = {};
    $return->{'list'} = $list;

341
    if ($list->{'admin'}{'status'} eq 'open') {
342
        $return->{'aliases'} = install_aliases($list);
343
344
    } else {
        $return->{'aliases'} = 1;
345
    }
346

347
    ## Synchronize list members if required
348
    if ($list->has_include_data_sources()) {
349
350
        Log::do_log('notice', "Synchronizing list members...");
        $list->sync_include();
351
    }
352

353
    $list->save_config($param->{'creation_email'});
354
    return $return;
355
356
357
}

########################################################
358
359
360
# create_list
########################################################
# Create a list : used by sympa.pl--instantiate_family
361
# with family concept
362
#
363
364
365
366
# IN  : - $param : ref on parameters of the config list
#         with obligatory :
#         $param->{'listname'}
#         $param->{'subject'}
367
#         $param->{'owner'} (or owner_include):
368
369
370
#          array of hash,with key email obligatory
#         $param->{'owner_include'} array of hash :
#              with key source obligatory
371
#       - $family : the family object
372
#       - $robot : the list's robot  ** No longer used.
373
374
375
#       - $abort_on_error : won't create the list directory on
#          tt2 process error (usefull for dynamic lists that
#          throw exceptions)
376
377
# OUT : - hash with keys :
#          -list :$list
378
#          -aliases : undef if not applicable; 1 (if ok) or
379
#           $aliases : concated string of alias if they
380
381
#           are not installed or 1(in status open)
#######################################################
382
sub create_list {
sikeda's avatar
sikeda committed
383
    my ($param, $family, $dummy, $abort_on_error) = @_;
384
385
    Log::do_log('info', '(%s, %s, %s)', $param->{'listname'},
        $family->{'name'}, $param->{'subject'});
386

387
    ## mandatory list parameters
388
    foreach my $arg ('listname') {
389
        unless ($param->{$arg}) {
390
            Log::do_log('err', 'Missing list param %s', $arg);
391
392
            return undef;
        }
393
    }
394
395

    unless ($family) {
396
        Log::do_log('err', 'Missing param "family"');
397
        return undef;
398
    }
399
400

    #robot
401
    my $robot = $family->{'robot'};
402
    unless ($robot) {
403
        Log::do_log('err', 'Missing param "robot"');
404
        return undef;
405
    }
406

407
    ## check listname
408
    $param->{'listname'} = lc($param->{'listname'});
409
    my $listname_regexp = Sympa::Regexps::listname();
410

411
412
    unless ($param->{'listname'} =~ /^$listname_regexp$/i
        and length $param->{'listname'} <= Sympa::Constants::LIST_LEN()) {
413
        Log::do_log('err', 'Incorrect listname %s', $param->{'listname'});
414
415
416
417
418
419
        return undef;
    }

    my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
    if ($regx) {
        if ($param->{'listname'} =~ /^(\S+)-($regx)$/) {
420
421
422
            Log::do_log('err',
                'Incorrect listname %s matches one of service aliases',
                $param->{'listname'});
423
424
425
            return undef;
        }
    }
426
427
428
    if (   $param->{'listname'} eq Conf::get_robot_conf($robot, 'email')
        or $param->{'listname'} eq
        Conf::get_robot_conf($robot, 'listmaster_email')) {
429
430
431
        Log::do_log('err',
            'Incorrect listname %s matches one of service aliases',
            $param->{'listname'});
432
        return undef;
433
    }
434
435

    ## Check listname on SMTP server
sikeda's avatar
sikeda committed
436
    my $res = list_check_smtp($param->{'listname'}, $robot);
437
    unless (defined $res) {
438
        Log::do_log('err', 'Can\'t check list %.128s on %s',
439
440
            $param->{'listname'}, $robot);
        return undef;
441
442
443
    }

    if ($res) {
444
445
446
        Log::do_log('err',
            'Could not create already existing list %s on %s for',
            $param->{'listname'}, $robot);
447
448
449
450
        foreach my $o (@{$param->{'owner'}}) {
            Log::do_log('err', $o->{'email'});
        }
        return undef;
451
452
453
    }

    ## template file
454
    my $template_file = tools::search_fullpath($family, 'config.tt2');
455
    unless (defined $template_file) {
456
        Log::do_log('err', 'No config template from family %s@%s',
457
458
            $family->{'name'}, $robot);
        return undef;
459
460
    }

461
462
    my $family_config =
        Conf::get_robot_conf($robot, 'automatic_list_families');
463
    $param->{'family_config'} = $family_config->{$family->{'name'}};
464
    my $conf;
465
466
    my $tt_result =
        tt2::parse_tt2($param, 'config.tt2', \$conf, [$family->{'dir'}]);
467
    unless (defined $tt_result || !$abort_on_error) {
468
469
470
471
472
473
474
475
        Log::do_log(
            'err',
            'Abort on tt2 error. List %s from family %s@%s, file config.tt2 : %s',
            $param->{'listname'},
            $family->{'name'},
            $robot,
            tt2::get_error()->info()
        );
476
        return undef;
477
    }
478

479
480
    ## Create the list directory
    my $list_dir;
481

482
    if (-d "$Conf::Conf{'home'}/$robot") {
483
484
        unless (-d $Conf::Conf{'home'} . '/' . $robot) {
            unless (mkdir($Conf::Conf{'home'} . '/' . $robot, 0777)) {
485
                Log::do_log('err', 'Unable to create %s/%s: %s',
486
487
488
489
490
491
492
493
494
495
496
                    $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)) {
497
498
        Log::do_log('err', 'Unable to create %s: %s', $list_dir,
            $CHILD_ERROR);
499
500
501
        return undef;
    }

502
    ## Check topics
503
504
    if (defined $param->{'topics'}) {
        unless (check_topics($param->{'topics'}, $robot)) {
505
506
            Log::do_log('err', 'Topics param %s not defined in topics.conf',
                $param->{'topics'});
507
        }
508
    }
509

510
    ## Lock config before openning the config file
511
512
    my $lock_fh = Sympa::LockedFile->new($list_dir . '/config', 5, '>');
    unless ($lock_fh) {
513
        Log::do_log('err', 'Impossible to create %s/config: %m', $list_dir);
514
        return undef;
515
    }
sikeda's avatar
sikeda committed
516
    #tt2::parse_tt2($param, 'config.tt2', $lock_fh, [$family->{'dir'}]);
517
518
    print $lock_fh $conf;

519
    ## Unlock config file
520
    $lock_fh->close;
521

522
523
524
    ## Creation of the info file
    # remove DOS linefeeds (^M) that cause problems with Outlook 98, AOL, and
    # EIMS:
525
526
527
    $param->{'description'} =~ s/\r\n|\r/\n/g;

    unless (open INFO, '>', "$list_dir/info") {
528
        Log::do_log('err', 'Impossible to create %s/info: %m', $list_dir);
529
530
    }
    if (defined $param->{'description'}) {
531
        print INFO $param->{'description'};
532
    }
533
    close INFO;
534
535

    ## Create associated files if a template was given.
536
    my @files_to_parse;
537
538
539
540
    foreach my $file (split ',',
        Conf::get_robot_conf($robot, 'parsed_family_files')) {
        $file =~ s{\s}{}g;
        push @files_to_parse, $file;
541
542
    }
    for my $file (@files_to_parse) {
543
544
545
546
547
548
        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) {
549
550
                Log::do_log(
                    'err',
551
                    'Tt2 error. List %s from family %s@%s, file %s : %s',
552
553
554
555
556
557
                    $param->{'listname'},
                    $family->{'name'},
                    $robot,
                    $file,
                    tt2::get_error()->info()
                );
558
559
            }
            unless (open FILE, '>', "$list_dir/$file") {
560
561
                Log::do_log('err', 'Impossible to create %s/%s: %m',
                    $list_dir, $file);
562
563
564
565
            }
            print FILE $file_content;
            close FILE;
        }
566
567
    }

568
569
    ## Create list object
    my $list;
570
    unless ($list = Sympa::List->new($param->{'listname'}, $robot)) {
571
        Log::do_log('err', 'Unable to create list %s', $param->{'listname'});
572
        return undef;
573
574
575
576
    }

    ## Create shared if required
    if (defined $list->{'admin'}{'shared_doc'}) {
577
578
579
        $list->create_shared();
    }

580
581
    ##FIXME:should be unneccessary
    $list->{'admin'}{'creation'}{'date'} =
582
        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
583
    $list->{'admin'}{'creation'}{'date_epoch'} = time;
584
    if ($param->{'creation_email'}) {
585
        $list->{'admin'}{'creation'}{'email'} = $param->{'creation_email'};
586
    } else {
587
588
        my $host = Conf::get_robot_conf($robot, 'host');
        $list->{'admin'}{'creation'}{'email'} = "listmaster\@$host";
589
    }
590
    if ($param->{'status'}) {
591
        $list->{'admin'}{'status'} = $param->{'status'};
592
    } else {
593
        $list->{'admin'}{'status'} = 'open';
594
595
596
597
598
599
600
    }
    $list->{'admin'}{'family_name'} = $family->{'name'};

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

    if ($list->{'admin'}{'status'} eq 'open') {
601
        $return->{'aliases'} = install_aliases($list);
602
603
    } else {
        $return->{'aliases'} = 1;
604
    }
605
606
607

    ## Synchronize list members if required
    if ($list->has_include_data_sources()) {
608
609
        Log::do_log('notice', "Synchronizing list members...");
        $list->sync_include();
610
611
    }

612
613
614
615
    return $return;
}

########################################################
616
617
618
# update_list
########################################################
# update a list : used by sympa.pl--instantiate_family
619
# with family concept when the list already exists
620
#
621
# IN  : - $list : the list to update
622
#       - $param : ref on parameters of the new
623
624
625
#          config list with obligatory :
#         $param->{'listname'}
#         $param->{'subject'}
626
#         $param->{'owner'} (or owner_include):
627
628
629
#          array of hash,with key email obligatory
#         $param->{'owner_include'} array of hash :
#              with key source obligatory
630
631
#       - $family : the family object
#       - $robot : the list's robot
632
633
634
#
# OUT : - $list : the updated list or undef
#######################################################
635
636
sub update_list {
    my ($list, $param, $family, $robot) = @_;
637
638
    Log::do_log('info', '(%s, %s, %s)', $param->{'listname'},
        $family->{'name'}, $param->{'subject'});
639

640
641
    ## mandatory list parameters
    foreach my $arg ('listname') {
642
        unless ($param->{$arg}) {
643
            Log::do_log('err', 'Missing list param %s', $arg);
644
645
            return undef;
        }
646
    }
647

648
    ## template file
649
    my $template_file = tools::search_fullpath($family, 'config.tt2');
650
    unless (defined $template_file) {
651
        Log::do_log('err', 'No config template from family %s@%s',
652
653
            $family->{'name'}, $robot);
        return undef;
654
655
656
    }

    ## Check topics
657
658
    if (defined $param->{'topics'}) {
        unless (check_topics($param->{'topics'}, $robot)) {
659
660
            Log::do_log('err', 'Topics param %s not defined in topics.conf',
                $param->{'topics'});
661
        }
662
663
    }

664
    ## Lock config before openning the config file
665
666
    my $lock_fh = Sympa::LockedFile->new($list->{'dir'} . '/config', 5, '>');
    unless ($lock_fh) {
667
        Log::do_log('err', 'Impossible to create %s/config: %s',
668
669
            $list->{'dir'}, $!);
        return undef;
670
    }
671
    #FIXME: Check parse error
sikeda's avatar
sikeda committed
672
    tt2::parse_tt2($param, 'config.tt2', $lock_fh, [$family->{'dir'}]);
673
    ## Unlock config file
674
    $lock_fh->close;
675

676
    ## Create list object
677
    unless ($list = Sympa::List->new($param->{'listname'}, $robot)) {
678
        Log::do_log('err', 'Unable to create list %s', $param->{'listname'});
679
        return undef;
680
    }
681
682
683

    ##FIXME:should be unneccessary
    $list->{'admin'}{'creation'}{'date'} =
684
        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
685
    $list->{'admin'}{'creation'}{'date_epoch'} = time;
686
    if ($param->{'creation_email'}) {
687
        $list->{'admin'}{'creation'}{'email'} = $param->{'creation_email'};
688
    } else {
689
690
        my $host = Conf::get_robot_conf($robot, 'host');
        $list->{'admin'}{'creation'}{'email'} = "listmaster\@$host";
691
692
    }

693
    if ($param->{'status'}) {
694
        $list->{'admin'}{'status'} = $param->{'status'};
695
    } else {
696
        $list->{'admin'}{'status'} = 'open';
697
698
699
    }
    $list->{'admin'}{'family_name'} = $family->{'name'};

700
    ## Create associated files if a template was given.
701
    my @files_to_parse;
702
703
704
705
    foreach my $file (split ',',
        Conf::get_robot_conf($robot, 'parsed_family_files')) {
        $file =~ s{\s}{}g;
        push @files_to_parse, $file;
706
707
    }
    for my $file (@files_to_parse) {
708
709
710
711
712
713
        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) {
714
715
716
                Log::do_log('err',
                    'Tt2 error. List %s from family %s@%s, file %s',
                    $param->{'listname'}, $family->{'name'}, $robot, $file);
717
718
            }
            unless (open FILE, '>', "$list->{'dir'}/$file") {
719
                Log::do_log('err', 'Impossible to create %s/%s: %s',
720
721
722
723
724
                    $list->{'dir'}, $file, $!);
            }
            print FILE $file_content;
            close FILE;
        }
725
726
    }

727
728
    ## Synchronize list members if required
    if ($list->has_include_data_sources()) {
729
730
        Log::do_log('notice', "Synchronizing list members...");
        $list->sync_include();
731
732
    }

733
734
735
    return $list;
}

736
########################################################
737
738
# rename_list
########################################################
739
# Rename a list or move a list to another virtual host
740
#
741
742
743
# IN  : - list
#       - new_listname
#       - new_robot
744
#       - mode  : 'copy'
745
746
747
748
749
#       - auth_method
#       - user_email
#       - remote_host
#       - remote_addr
#       - options : 'skip_authz' to skip authorization scenarios eval
750
#
751
752
753
754
755
756
757
758
759
# OUT via reference :
#       - aliases
#       - status : 'pending'
#
# OUT : - scalar
#           undef  : error
#           1      : success
#           string : error code
#######################################################
760
sub rename_list {
761
    my (%param) = @_;
sikeda's avatar
sikeda committed
762
    Log::do_log('info', '',);
763

764
765
    my $list         = $param{'list'};
    my $robot        = $list->{'domain'};
766
767
768
    my $old_listname = $list->{'name'};

    # check new listname syntax
769
    my $new_listname    = lc($param{'new_listname'});
770
    my $listname_regexp = Sympa::Regexps::listname();
771

772
773
    unless ($new_listname =~ /^$listname_regexp$/i
        and length $new_listname <= Sympa::Constants::LIST_LEN()) {
774
        Log::do_log('err', 'Incorrect listname %s', $new_listname);
775
        return 'incorrect_listname';
776
    }
777

778
    ## Evaluate authorization scenario unless run as listmaster (sympa.pl)
779
    my ($result, $r_action, $reason);
780
    unless ($param{'options'}{'skip_authz'}) {
781
        $result = Sympa::Scenario::request_action(
782
            $param{'new_robot'},
783
784
785
786
787
788
789
790
791
792
793
794
795
796
            '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/) {
797
            Log::do_log('err', 'Authorization error');
798
799
            return 'authorization';
        }
800
801
802
803
    }

    ## Check listname on SMTP server
    my $res = list_check_smtp($param{'new_listname'}, $param{'new_robot'});
804
    unless (defined($res)) {
805
        Log::do_log('err', 'Can\'t check list %.128s on %.128s',
806
807
808
809
810
811
812
            $param{'new_listname'}, $param{'new_robot'});
        return 'internal';
    }

    if ($res
        || ($list->{'name'} ne $param{'new_listname'})
        &&    ## Do not test if listname did not change
813
        (   Sympa::List->new(
814
815
816
817
818
819
820
821
822
823
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
                $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 {
861
        Log::do_log('err', 'Unknown robot %s', $param{'new_robot'});
862
863
        return 'unknown_robot';
    }
864
865

    ## If we are in 'copy' mode, create en new list
866
867
    if ($param{'mode'} eq 'copy') {
        unless (
868
            $list = clone_list_as_empty(
869
870
871
872
873
                $list->{'name'},        $list->{'domain'},
                $param{'new_listname'}, $param{'new_robot'},
                $param{'user_email'}
            )
            ) {
874
875
            Log::do_log('err', 'Unable to load %s while renaming',
                $param{'new_listname'});
876
877
878
            return 'internal';
        }
    }
879
880
881

    # set list status to pending if creation list is moderated
    if ($r_action =~ /listmaster/) {
882
        $list->{'admin'}{'status'} = 'pending';
883
884
        tools::send_notify_to_listmaster(
            $list,
885
            'request_list_renaming',
886
            {   'new_listname' => $param{'new_listname'},
887
888
889
890
891
892
893
894
                'old_listname' => $old_listname,
                'email'        => $param{'user_email'},
                'mode'         => $param{'mode'}
            }
        );
        $param{'status'} = 'pending';
    }

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

898
    ## This code should be in Sympa::List::rename()
899
    unless ($param{'mode'} eq 'copy') {
900
        unless (File::Copy::move($list->{'dir'}, $new_dir)) {
901
902
            Log::do_log('err', 'Unable to rename %s to %s: %m',
                $list->{'dir'}, $new_dir);
903
904
905
906
907
908
909
910
911
912
913
914
            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) {
915
            unless (File::Copy::move($arc_dir, $new_arc_dir)) {
916
                Log::do_log('err', 'Unable to rename archive %s', $arc_dir);
917
918
919
920
921
922
923
924
925
926
927
928
                # 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') . '/'
            . $param{'new_listname'} . '@'
            . $param{'new_robot'};
        if (-d $bounce_dir && $bounce_dir ne $new_bounce_dir) {
929
            unless (File::Copy::move($bounce_dir, $new_bounce_dir)) {
930
931
932
933
934
935
936
                Log::do_log('err',
                    "Unable to rename bounces from $bounce_dir to $new_bounce_dir"
                );
            }
        }