~ubuntu-branches/debian/squeeze/sympa/squeeze

« back to all changes in this revision

Viewing changes to src/sympa.pl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Perrier
  • Date: 2007-01-20 18:09:28 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070120180928-0e42mbwg87mlo44y
Tags: 5.2.3-1.2
* Non-maintainer upload to re-fix l10n issues
* As debconf-updatepo was not run in previous versions, the French
  translation was outdated. Hence fix it.
* Remove several duplicate spaces in the debconf templates

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
#! --PERL--
2
 
 
3
2
# sympa.pl - This script is the main one ; it runs as a daemon and does
4
3
# the messages/commands processing
5
 
# RCS Identication ; $Revision: 1.128.2.2 $ ; $Date: 2004/04/19 13:23:52 $ 
 
4
# RCS Identication ; $Revision: 1.193.2.4 $ ; $Date: 2006/10/09 12:33:36 $ 
6
5
#
7
6
# Sympa - SYsteme de Multi-Postage Automatique
8
7
# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des Universites
36
35
use Language;
37
36
use Log;
38
37
use Version;
39
 
use smtp;
 
38
use mail;
40
39
use MIME::QuotedPrint;
41
40
use List;
42
41
use Message;
 
42
use admin;
 
43
use Config_XML;
 
44
use Family;
 
45
use report;
 
46
use File::Copy;
43
47
 
44
48
require 'tools.pl';
45
 
require 'msg.pl';
 
49
require 'tt2.pl';
46
50
require 'parser.pl';
47
51
 
48
 
 
49
52
# durty global variables
50
53
my $is_signed = {}; 
51
54
my $is_crypted ;
53
56
 
54
57
 
55
58
## Internal tuning
56
 
# delay between each read of the expirequeue
57
 
my $expiresleep = 50 ; 
58
 
 
59
59
# delay between each read of the digestqueue
60
60
my $digestsleep = 5; 
61
61
 
70
70
Options:
71
71
   -d, --debug                           : sets Sympa in debug mode 
72
72
   -f, --config=FILE                     : uses an alternative configuration file
73
 
   --import=list                         : import subscribers (read from STDIN)
 
73
   --import=list\@dom                    : import subscribers (read from STDIN)
74
74
   -k, --keepcopy=dir                    : keep a copy of incoming message
75
75
   -l, --lang=LANG                       : use a language catalog for Sympa
76
76
   -m, --mail                            : log calls to sendmail
77
77
   --prepare_db                          : prepares database
78
 
   --dump=list|ALL                       : dumps subscribers 
 
78
   --service=process_command|process_message  : process dedicated to messages distribution or to commands (default both)
 
79
   --dump=list\@dom|ALL                  : dumps subscribers 
 
80
   --make_alias_file                     : create file in /tmp with all aliases (usefull when aliases.tpl is changed)
79
81
   --lowercase                           : lowercase email addresses in database
80
 
   --close_list=LISTNAME[\@ROBOT]         : close a list
 
82
   --create_list --robot=robot_name --input_file=/path/to/file.xml 
 
83
                                         : create a list with the xml file under robot_name
 
84
   --instantiate_family=family_name  --robot=robot_name --input_file=/path/to/file.xml       
 
85
                                         : instantiate family_name lists described in the file.xml under robot_name,
 
86
                                           the family directory must exist
 
87
  --add_list=family_name --robot=robot_name --input_file=/path/to/file.xml
 
88
                                         : add the list described by the file.xml under robot_name, to the family
 
89
                                           family_name.
 
90
   --modify_list=family_name --robot=robot_name --input_file=/path/to/file.xml
 
91
                                         : modify the existing list installed under the robot_name robot and that 
 
92
                                           belongs to family_name family. The new description is in the file.xml
 
93
   --close_family=family_name --robot=robot_name 
 
94
                                         : close lists of family_name family under robot_name.      
 
95
 
 
96
   --close_list=listname\@robot          : close a list
 
97
   --sync_include=listname\@robot        : trigger the list members update
 
98
   --reload_list_config --list=mylist\@mydom  : recreates all config.bin files. You should run this command if you edit 
 
99
                                                authorization scenarios. The list parameter is optional.
 
100
   --upgrade --from=X --to=Y             : runs Sympa maintenance script to upgrade from version X to version Y
81
101
   --log_level=LEVEL                     : sets Sympa log level
82
102
 
83
103
   -h, --help                            : print this help
91
111
 
92
112
## Check --dump option
93
113
my %options;
94
 
&GetOptions(\%main::options, 'dump=s', 'debug|d', ,'log_level=s','foreground', 'config|f=s', 
95
 
            'lang|l=s', 'mail|m', 'keepcopy|k=s', 'help', 'version', 'import=s','make_alias_file','lowercase','prepare_db',
96
 
            'close_list=s');
97
 
 
 
114
unless (&GetOptions(\%main::options, 'dump=s', 'debug|d', ,'log_level=s','foreground', 'service=s','config|f=s', 
 
115
                    'lang|l=s', 'mail|m', 'keepcopy|k=s', 'help', 'version', 'import=s','make_alias_file','lowercase','prepare_db',
 
116
                    'close_list=s','create_list','instantiate_family=s','robot=s','add_list=s','modify_list=s','close_family=s',
 
117
                    'input_file=s','sync_include=s','upgrade','from=s','to=s','reload_list_config','list=s')) {
 
118
    &fatal_err("Unknown options.");
 
119
}
98
120
 
99
121
if ($main::options{'debug'}) {
100
122
    $main::options{'log_level'} = 2 unless ($main::options{'log_level'});
101
123
}
102
 
# Some option force foreground mode
103
 
$main::options{'foreground'} = 1 if ($main::options{'debug'} ||
104
 
                                     $main::options{'version'} || 
105
 
                                     $main::options{'import'} ||
106
 
                                     $main::options{'help'} || 
107
 
                                     $main::options{'make_alias_file'} || 
108
 
                                     $main::options{'lowercase'} || 
109
 
                                     $main::options{'dump'} ||
110
 
                                     $main::options{'close_list'} ||
111
 
                                     $main::options{'prepare_db'});
112
 
 
113
124
## Batch mode, ie NOT daemon
114
 
 $main::options{'batch'} = 1 if ($main::options{'dump'} || 
 
125
$main::options{'batch'} = 1 if ($main::options{'dump'} || 
115
126
                                 $main::options{'help'} ||
116
127
                                 $main::options{'version'} || 
117
128
                                 $main::options{'import'} || 
118
129
                                 $main::options{'make_alias_file'} ||
119
130
                                 $main::options{'lowercase'} ||
120
131
                                 $main::options{'close_list'} ||
121
 
                                 $main::options{'prepare_db'});
 
132
                                 $main::options{'prepare_db'} ||
 
133
                                 $main::options{'create_list'} ||
 
134
                                 $main::options{'instantiate_family'} ||
 
135
                                 $main::options{'add_list'} ||
 
136
                                 $main::options{'modify_list'} ||
 
137
                                 $main::options{'close_family'} ||
 
138
                                 $main::options{'sync_include'} ||
 
139
                                 $main::options{'upgrade'} ||
 
140
                                 $main::options{'reload_list_config'}
 
141
                                 );
 
142
 
 
143
# Some option force foreground mode
 
144
$main::options{'foreground'} = 1 if ($main::options{'debug'} || $main::options{'batch'});
 
145
 
 
146
$main::options{'log_to_stderr'} = 1 unless ($main::options{'batch'});
 
147
$main::options{'log_to_stderr'} = 1 if ($main::options{'upgrade'} || $main::options{'reload_list_config'});
122
148
 
123
149
$log_level = $main::options{'log_level'} if ($main::options{'log_level'}); 
124
150
 
129
155
# this loop is run foreach HUP signal received
130
156
my $signal = 0;
131
157
 
 
158
local $main::daemon_usage; 
 
159
 
132
160
while ($signal ne 'term') { #as long as a SIGTERM is not received }
133
161
 
134
162
my $config_file = $main::options{'config'} || '--CONFIG--';
172
200
## Set locale configuration
173
201
$main::options{'lang'} =~ s/\.cat$//; ## Compatibility with version < 2.3.3
174
202
$Language::default_lang = $main::options{'lang'} || $Conf{'lang'};
175
 
&Language::LoadLang($Conf{'msgcat'});
176
 
 
177
 
## Check locale version
178
 
#if (Msg(1, 102, $Version) ne $Version){
179
 
#    &do_log('info', 'NLS message file version %s different from src version %s', Msg(1, 102,""), $Version);
180
 
#} 
181
203
 
182
204
## Main program
183
205
if (!chdir($Conf{'home'})) {
184
206
   fatal_err("Can't chdir to %s: %m", $Conf{'home'});
185
207
   ## Function never returns.
186
208
}
187
 
 
188
 
if ($signal ne 'hup' ) {
 
209
if ($main::options{'service'} eq 'process_message') {
 
210
    $main::daemon_usage = 'message';
 
211
}elsif ($main::options{'service'} eq 'process_command') {
 
212
    $main::daemon_usage = 'command';
 
213
}else{
 
214
    $main::daemon_usage = 'command_and_message'; # default is to run one sympa.pl server for both commands and message 
 
215
}
 
216
 
 
217
## Check for several files.
 
218
unless (&Conf::checkfiles_as_root()) {
 
219
   fatal_err("Missing files. Aborting.");
 
220
   ## No return.
 
221
}
 
222
 
 
223
if ($signal ne 'hup') {
189
224
    ## Put ourselves in background if we're not in debug mode. That method
190
225
    ## works on many systems, although, it seems that Unix conceptors have
191
226
    ## decided that there won't be a single and easy way to detach a process
200
235
        open(STDERR, ">> /dev/null");
201
236
        open(STDOUT, ">> /dev/null");
202
237
        setpgrp(0, 0);
203
 
        if ((my $child_pid = fork) != 0) {
204
 
            do_log('debug', "Starting server, pid $child_pid");
 
238
        # start the main sympa.pl daemon
205
239
 
206
 
            exit(0);
 
240
        if (($Conf{'distribution_mode'} eq 'single') || ($main::daemon_usage ne 'command_and_message')){ 
 
241
            printf STDERR "Starting server for $main::daemon_usage\n";
 
242
            do_log('debug', "Starting server for $main::daemon_usage");
 
243
            if ((my $child_pid = fork) != 0) {
 
244
                do_log('info', "Server started, pid $child_pid");
 
245
                do_log('debug', "Server for $main::daemon_usage started, pid $child_pid, exiting from initial process");
 
246
                exit(0);
 
247
            }
 
248
        }else{
 
249
            $main::daemon_usage = 'command'; # fork sympa.pl dedicated to commands
 
250
            do_log('debug', "Starting server for commands");
 
251
            if ((my $child_pid = fork) != 0) {
 
252
                do_log('info', "Server for commands started, pid $child_pid");
 
253
                $main::daemon_usage = 'message'; # main process continue in order to fork
 
254
                do_log('debug', "Starting server for messages");            
 
255
                if ((my $child_pid = fork) != 0) {
 
256
                    do_log('debug', "Server for messages started, pid $child_pid, exiting from initial process");
 
257
                    exit(0);    # exit from main process        
 
258
                }       
 
259
            }
207
260
        }
208
261
    }
209
 
    
 
262
 
 
263
    my $service = 'sympa';
 
264
    $service .= '(message)' if ($main::daemon_usage eq 'message');
 
265
    $service .= '(command)' if ($main::daemon_usage eq 'command');
 
266
    do_openlog($Conf{'syslog'}, $Conf{'log_socket_type'}, $service);
 
267
 
 
268
    do_log('debug', "Running server $$ with main::daemon_usage = $main::daemon_usage ");
210
269
    unless ($main::options{'batch'} ) {
211
270
        ## Create and write the pidfile
212
 
        &tools::write_pid($Conf{'pidfile'}, $$);
 
271
        my $file = $Conf{'pidfile'};
 
272
        $file = $Conf{'pidfile_distribute'} if ($main::daemon_usage eq 'message') ;
 
273
        &tools::write_pid($file, $$);
213
274
    }   
214
275
 
215
 
    do_openlog($Conf{'syslog'}, $Conf{'log_socket_type'}, 'sympa');
216
276
 
217
277
    # Set the UserID & GroupID for the process
218
278
    $( = $) = (getgrnam('--GROUP--'))[2];
241
301
## Daemon called for dumping subscribers list
242
302
if ($main::options{'dump'}) {
243
303
    
244
 
    my @listnames;
 
304
    my ($all_lists, $list);
245
305
    if ($main::options{'dump'} eq 'ALL') {
246
 
        @listnames = &List::get_lists('*');
247
 
    }else {
248
 
        @listnames = ($main::options{'dump'});
 
306
        $all_lists = &List::get_lists('*');
 
307
    }else {     
 
308
 
 
309
        ## The parameter can be a list address
 
310
        unless ($main::options{'dump'} =~ /\@/) {
 
311
            &do_log('err','Incorrect list address %s', $main::options{'dump'});
 
312
            exit;
 
313
        } 
 
314
 
 
315
        my $list = new List ($main::options{'dump'});
 
316
        unless (defined $list) {
 
317
            &do_log('err','Unknown list %s', $main::options{'dump'});
 
318
            exit;
 
319
        }
 
320
        push @$all_lists, $list;
249
321
    }
250
322
 
251
 
    unless (&List::dump(@listnames)) {
252
 
        printf STDERR "Could not dump list(s) %s\n", join(',',@listnames);
253
 
        exit -1;
 
323
    foreach my $list (@$all_lists) {
 
324
        unless ($list->dump()) {
 
325
            printf STDERR "Could not dump list(s)\n";
 
326
        }
254
327
    }
255
328
 
256
329
    exit 0;
258
331
    print $usage_string;
259
332
    exit 0;
260
333
}elsif ($main::options{'make_alias_file'}) {
261
 
    my @listnames = &List::get_lists('*');
 
334
    my $all_lists = &List::get_lists('*');
262
335
    unless (open TMP, ">/tmp/sympa_aliases.$$") {
263
336
        printf STDERR "Unable to create tmp/sympa_aliases.$$, exiting\n";
264
337
        exit;
265
338
    }
266
 
    printf TMP "#\n#\tAliases for all Sympa lists (but not for robots)\n#\n";
 
339
    printf TMP "#\n#\tAliases for all Sympa lists open (but not for robots)\n#\n";
267
340
    close TMP;
268
 
    foreach my $listname (@listnames) {
269
 
        if (my $list = new List ($listname)) {
270
 
 
271
 
            system ("--SBINDIR--/alias_manager.pl add $list->{'name'} $list->{'domain'} /tmp/sympa_aliases.$$") ;
272
 
        }       
 
341
    foreach my $list (@$all_lists) {
 
342
        system ("--SBINDIR--/alias_manager.pl add $list->{'name'} $list->{'domain'} /tmp/sympa_aliases.$$") if ($list->{'admin'}{'status'} eq 'open');
273
343
    }
274
344
    printf ("Sympa aliases file is /tmp/sympa_aliases.$$ file made, you probably need to installed it in your SMTP engine\n");
275
345
    
280
350
    exit 0;
281
351
}elsif ($main::options{'import'}) {
282
352
    my ($list, $total);
 
353
 
 
354
    ## The parameter should be a list address
 
355
    unless ($main::options{'import'} =~ /\@/) {
 
356
        &do_log('err','Incorrect list address %s', $main::options{'import'});
 
357
        exit;
 
358
    } 
 
359
 
 
360
 
283
361
    unless ($list = new List ($main::options{'import'})) {
284
362
        fatal_err('Unknown list name %s', $main::options{'import'});
285
363
    }
342
420
        exit 1;
343
421
    }
344
422
 
345
 
    unless ($list->close()) {
346
 
        print STDERR "Could not close list $main::options{'close_list'}\n";
347
 
        exit 1; 
 
423
    if ($list->{'admin'}{'family_name'}) {
 
424
        unless($list->set_status_family_closed('close_list',$list->{'name'})) {
 
425
            print STDERR "Could not close list $main::options{'close_list'}\n";
 
426
            exit 1;     
 
427
        }
 
428
    } else {
 
429
        unless ($list->close()) {
 
430
            print STDERR "Could not close list $main::options{'close_list'}\n";
 
431
            exit 1;     
 
432
        }
348
433
    }
349
434
 
350
435
    printf STDOUT "List %s has been closed, aliases have been removed\n", $list->{'name'};
351
436
    
352
437
    exit 0;
353
 
}
 
438
}elsif ($main::options{'create_list'}) {
 
439
    
 
440
    my $robot = $main::options{'robot'} || $Conf{'host'};
 
441
    
 
442
    unless ($main::options{'input_file'}) {
 
443
        print STDERR "Error : missing 'input_file' parameter\n";
 
444
        exit 1;
 
445
    }
 
446
 
 
447
    unless (open INFILE, $main::options{'input_file'}) {
 
448
        print STDERR "Unable to open $main::options{'input_file'}) file";
 
449
        exit 1; 
 
450
    }
 
451
    
 
452
    my $config = new Config_XML(\*INFILE);
 
453
    unless (defined $config->createHash()) {
 
454
        print STDERR "Error in representation data with these xml data\n";
 
455
        exit 1;
 
456
    } 
 
457
    
 
458
    my $hash = $config->getHash();
 
459
    
 
460
    close INFILE;
 
461
 
 
462
    my $resul = &admin::create_list_old($hash->{'config'},$hash->{'type'},$robot);
 
463
    unless (defined $resul) {
 
464
        print STDERR "Could not create list with these xml data\n";
 
465
        exit 1;
 
466
    }
 
467
    
 
468
    if ($resul->{'aliases'} == 1) {
 
469
        printf STDOUT "List has been created \n";
 
470
        exit 0;
 
471
    }else {
 
472
        printf STDOUT "List has been created, required aliases :\n $resul->{'aliases'} \n";
 
473
        exit 0;
 
474
    }
 
475
}elsif ($main::options{'instantiate_family'}) {
 
476
    
 
477
    my $robot = $main::options{'robot'} || $Conf{'host'};
 
478
 
 
479
    my $family_name;
 
480
    unless ($family_name = $main::options{'instantiate_family'}) {
 
481
        print STDERR "Error : missing family parameter\n";
 
482
        exit 1;
 
483
    }
 
484
    my $family;
 
485
    unless ($family = new Family($family_name,$robot)) {
 
486
        print STDERR "The family $family_name does not exist, impossible instantiation\n";
 
487
        exit 1;
 
488
    }
 
489
 
 
490
    unless ($main::options{'input_file'}) {
 
491
        print STDERR "Error : missing input_file parameter\n";
 
492
        exit 1;
 
493
    }
 
494
 
 
495
    unless (-r $main::options{'input_file'}) {
 
496
        print STDERR "Unable to read $main::options{'input_file'}) file";
 
497
        exit 1; 
 
498
    }
 
499
 
 
500
    unless ($family->instantiate($main::options{'input_file'})) {
 
501
        print STDERR "\nImpossible family instantiation : action stopped \n";
 
502
        exit 1;
 
503
    } 
 
504
        
 
505
    my $string = $family->get_instantiation_results();
 
506
    close INFILE;
 
507
    print STDERR $string;
 
508
    
 
509
    exit 0;
 
510
}elsif ($main::options{'add_list'}) {
 
511
     
 
512
    my $robot = $main::options{'robot'} || $Conf{'host'};
 
513
 
 
514
    my $family_name;
 
515
    unless ($family_name = $main::options{'add_list'}) {
 
516
        print STDERR "Error : missing family parameter\n";
 
517
        exit 1;
 
518
    }
 
519
    
 
520
    print STDOUT "\n************************************************************\n";
 
521
    
 
522
    my $family;
 
523
    unless ($family = new Family($family_name,$robot)) {
 
524
        print STDERR "The family $family_name does not exist, impossible to add a list\n";
 
525
        exit 1;
 
526
    }
 
527
    
 
528
    unless ($main::options{'input_file'}) {
 
529
        print STDERR "Error : missing 'input_file' parameter\n";
 
530
        exit 1;
 
531
    }
 
532
 
 
533
    unless (open INFILE, $main::options{'input_file'}) {
 
534
        print STDERR "\n Impossible to open input file  : $! \n";
 
535
        exit 1; 
 
536
    }
 
537
 
 
538
    my $result;
 
539
    unless ($result = $family->add_list(\*INFILE)) {
 
540
        print STDERR "\nImpossible to add a list to the family : action stopped \n";
 
541
        exit 1;
 
542
    } 
 
543
    
 
544
    print STDOUT "\n************************************************************\n";
 
545
    
 
546
    unless (defined $result->{'ok'}) {
 
547
        print STDERR "$result->{'string_info'}";
 
548
        print STDERR "\n The action has been stopped because of error :\n";
 
549
        print STDERR "$result->{'string_error'}";
 
550
        exit 1;
 
551
    }
 
552
    
 
553
    close INFILE;
 
554
 
 
555
    print STDOUT $result->{'string_info'};
 
556
    exit 0;
 
557
}elsif ($main::options{'sync_include'}) {
 
558
 
 
559
    my $list = new List ($main::options{'sync_include'});
 
560
 
 
561
    unless (defined $list) {
 
562
        print STDERR "Incorrect list name $main::options{'sync_include'}\n";
 
563
        exit 1;
 
564
    }
 
565
 
 
566
    unless (defined $list->sync_include()) {
 
567
        print STDERR "Failed to synchronize list members\n";
 
568
        exit 1;
 
569
    }
 
570
 
 
571
    printf "Members of list %s have been successfully update.\n", $list->get_list_address();
 
572
    exit 0;
 
573
## Migration from one version to another
 
574
}elsif ($main::options{'upgrade'}) {
 
575
 
 
576
    unless ($main::options{'from'}) {
 
577
        print STDERR "Error : missing 'from' parameter\n";
 
578
        exit 1;
 
579
    }
 
580
 
 
581
    unless ($main::options{'to'}) {
 
582
        print STDERR "Error : missing 'to' parameter\n";
 
583
        exit 1;
 
584
    }
 
585
 
 
586
    unless (&List::upgrade($main::options{'from'}, $main::options{'to'})) {
 
587
        printf STDERR "Migration from %s to %s failed\n", $main::options{'from'}, $main::options{'to'};
 
588
        exit 1;
 
589
    }
 
590
 
 
591
    exit 0;
 
592
 
 
593
## Reload binary list config files
 
594
}elsif ($main::options{'reload_list_config'}) {
 
595
 
 
596
    if ($main::options{'list'}) {
 
597
 
 
598
        &do_log('notice', "Loading list $main::options{'list'}...");
 
599
        my $list = new List ($main::options{'list'}, '', {'reload_config' => 1});
 
600
        unless (defined $list) {
 
601
            print STDERR "Error : incorrect list name '$main::options{'list'}'\n";
 
602
            exit 1;
 
603
        }
 
604
    }else {
 
605
        &do_log('notice', "Loading ALL lists...");
 
606
        my $all_lists = &List::get_lists('*',{'reload_config' => 1});
 
607
    }
 
608
 
 
609
    exit 0;
 
610
}
 
611
 
 
612
##########################################
 
613
elsif ($main::options{'modify_list'}) {
 
614
    
 
615
    my $robot = $main::options{'robot'} || $Conf{'host'};
 
616
 
 
617
    my $family_name;
 
618
    unless ($family_name = $main::options{'modify_list'}) {
 
619
        print STDERR "Error : missing family parameter\n";
 
620
        exit 1;
 
621
    }
 
622
    
 
623
    print STDOUT "\n************************************************************\n";
 
624
    
 
625
    my $family;
 
626
    unless ($family = new Family($family_name,$robot)) {
 
627
        print STDERR "The family $family_name does not exist, impossible to modify the list.\n";
 
628
        exit 1;
 
629
    }
 
630
    
 
631
    unless ($main::options{'input_file'}) {
 
632
        print STDERR "Error : missing input_file parameter\n";
 
633
        exit 1;
 
634
    }
 
635
 
 
636
    unless (open INFILE, $main::options{'input_file'}) {
 
637
        print STDERR "Unable to open $main::options{'input_file'}) file";
 
638
        exit 1; 
 
639
    }
 
640
 
 
641
    my $result;
 
642
    unless ($result = $family->modify_list(\*INFILE)) {
 
643
        print STDERR "\nImpossible to modify the family list : action stopped. \n";
 
644
        exit 1;
 
645
    } 
 
646
    
 
647
    print STDOUT "\n************************************************************\n";
 
648
    
 
649
    unless (defined $result->{'ok'}) {
 
650
        print STDERR "$result->{'string_info'}";
 
651
        print STDERR "\nThe action has been stopped because of error :\n";
 
652
        print STDERR "$result->{'string_error'}";
 
653
        exit 1;
 
654
    }
 
655
 
 
656
    close INFILE;
 
657
    
 
658
    print STDOUT $result->{'string_info'};
 
659
    exit 0;
 
660
}
 
661
 
 
662
##########################################
 
663
elsif ($main::options{'close_family'}) {
 
664
    
 
665
    my $robot = $main::options{'robot'} || $Conf{'host'};
 
666
 
 
667
    my $family_name;
 
668
    unless ($family_name = $main::options{'close_family'}) {
 
669
        print STDERR $usage_string;
 
670
        exit 1;
 
671
    }
 
672
    my $family;
 
673
    unless ($family = new Family($family_name,$robot)) {
 
674
        print STDERR "The family $family_name does not exist, impossible family closure\n";
 
675
        exit 1;
 
676
    }
 
677
    
 
678
    my $string;
 
679
    unless ($string = $family->close()) {
 
680
        print STDERR "\nImpossible family closure : action stopped \n";
 
681
        exit 1;
 
682
    } 
 
683
    
 
684
    print STDOUT $string;
 
685
    exit 0;
 
686
}
 
687
 
 
688
 
 
689
## Maintenance
 
690
## Update DB structure or content if required
 
691
&List::maintenance();
354
692
 
355
693
## Do we have right access in the directory
356
694
if ($main::options{'keepcopy'}) {
366
704
## Catch SIGTERM, in order to exit cleanly, whenever possible.
367
705
$SIG{'TERM'} = 'sigterm';
368
706
$SIG{'HUP'} = 'sighup';
 
707
$SIG{'PIPE'} = 'IGNORE'; ## Ignore SIGPIPE ; prevents sympa.pl from dying
369
708
 
370
709
my $index_queuedigest = 0; # verify the digest queue
371
 
my $index_queueexpire = 0; # verify the expire queue
372
710
my $index_cleanqueue = 0; 
373
711
my @qfile;
374
712
 
 
713
my $spool = $Conf{'queue'};
 
714
# if daemon is dedicated to message change the current spool
 
715
$spool = $Conf{'queuedistribute'} if ($main::daemon_usage eq 'message');
 
716
 
375
717
## This is the main loop : look after files in the directory, handles
376
718
## them, sleeps a while and continues the good job.
377
719
while (!$signal) {
387
729
 
388
730
    &List::init_list_cache();
389
731
 
390
 
    if (!opendir(DIR, $Conf{'queue'})) {
391
 
        fatal_err("Can't open dir %s: %m", $Conf{'queue'}); ## No return.
 
732
    if (!opendir(DIR, $spool)) {
 
733
        fatal_err("Can't open dir %s: %m", $spool); ## No return.
392
734
    }
393
735
    @qfile = sort grep (!/^\./,readdir(DIR));
394
736
    closedir(DIR);
 
737
 
 
738
    unless ($main::daemon_usage eq 'command')  { # process digest only in distribution mode
 
739
        ## Scan queuedigest
 
740
        if ($index_queuedigest++ >=$digestsleep){
 
741
            $index_queuedigest=0;
 
742
            &SendDigest();
 
743
        }
 
744
    }
 
745
    unless ($main::daemon_usage eq 'message') { # process expire and bads only in command mode 
395
746
    
396
 
    ## Scan queuedigest
397
 
    if ($index_queuedigest++ >=$digestsleep){
398
 
        $index_queuedigest=0;
399
 
        &SendDigest();
400
 
    }
401
 
    ## Scan the queueexpire
402
 
    if ($index_queueexpire++ >=$expiresleep){
403
 
        $index_queueexpire=0;
404
 
        &ProcessExpire();
405
 
    }
406
 
 
407
 
    ## Clean queue (bad)
408
 
    if ($index_cleanqueue++ >= 100){
409
 
        $index_cleanqueue=0;
410
 
        &CleanSpool("$Conf{'queue'}/bad", $Conf{'clean_delay_queue'});
411
 
        &CleanSpool($Conf{'queuemod'}, $Conf{'clean_delay_queuemod'});
412
 
        &CleanSpool($Conf{'queueauth'}, $Conf{'clean_delay_queueauth'});
413
 
    }
414
 
 
 
747
        ## Clean queue (bad)
 
748
        if ($index_cleanqueue++ >= 100){
 
749
            $index_cleanqueue=0;
 
750
            &CleanSpool("$spool/bad", $Conf{'clean_delay_queue'});
 
751
            &CleanSpool($Conf{'queuemod'}, $Conf{'clean_delay_queuemod'});
 
752
            &CleanSpool($Conf{'queueauth'}, $Conf{'clean_delay_queueauth'});
 
753
            &CleanSpool($Conf{'queuetopic'}, $Conf{'clean_delay_queuetopic'});
 
754
            &CleanSpool($Conf{'tmpdir'}, 7);
 
755
            &CleanSpool($Conf{'queuesubscribe'}, $Conf{'clean_delay_queuesubscribe'});
 
756
        }
 
757
    }
415
758
    my $filename;
416
759
    my $listname;
417
760
    my $robot;
431
774
 
432
775
        ## test ever if it is an old bad file
433
776
        if ($t_filename =~ /^BAD\-/i){
434
 
            if ((stat "$Conf{'queue'}/$t_filename")[9] < (time - $Conf{'clean_delay_queue'}*86400) ){
435
 
                unlink ("$Conf{'queue'}/$t_filename") ;
436
 
                do_log('notice',"Deleting bad message %s because too old", $t_filename);
 
777
            if ((stat "$spool/$t_filename")[9] < (time - &Conf::get_robot_conf($robot, 'clean_delay_queue')*86400) ){
 
778
                unlink ("$spool/$t_filename") ;
 
779
                &do_log('notice',"Deleting bad message %s because too old", $t_filename);
437
780
            };
438
781
            next;
439
782
        }
451
794
        if ($t_robot) {
452
795
            $t_robot=lc($t_robot);
453
796
        }else{
454
 
            $t_robot = lc($Conf{'host'});
 
797
            $t_robot = lc(&Conf::get_robot_conf($robot, 'host'));
455
798
        }
456
799
 
457
800
        my $list_check_regexp = &Conf::get_robot_conf($robot,'list_check_regexp');
461
804
        }
462
805
 
463
806
        # (sa) le terme "(\@$Conf{'host'})?" est inutile
464
 
        #unless ($t_listname =~ /^(sympa|listmaster|$Conf{'email'})(\@$Conf{'host'})?$/i) {
 
807
        #unless ($t_listname =~ /^(sympa|$Conf{'listmaster_email'}|$Conf{'email'})(\@$Conf{'host'})?$/i) {
465
808
        #    $list = new List ($t_listname);
466
809
        #}
467
 
        
468
 
        if ($t_listname eq 'listmaster') {
 
810
 
 
811
        my $email = &Conf::get_robot_conf($robot, 'email');     
 
812
 
 
813
        if ($t_listname eq $Conf{'listmaster_email'}) {
469
814
            ## highest priority
470
815
            $priority = 0;
471
816
        }elsif ($type eq 'request') {
472
 
            $priority = $Conf{'request_priority'};
 
817
            $priority = &Conf::get_robot_conf($robot, 'request_priority');
473
818
        }elsif ($type eq 'owner') {
474
 
            $priority = $Conf{'owner_priority'};
475
 
        }elsif ($t_listname =~ /^(sympa|$Conf{'email'})(\@$Conf{'host'})?$/i) { 
476
 
            $priority = $Conf{'sympa_priority'};
 
819
            $priority = &Conf::get_robot_conf($robot, 'owner_priority');
 
820
        }elsif ($t_listname =~ /^(sympa|$email)(\@$Conf{'host'})?$/i) { 
 
821
            $priority = &Conf::get_robot_conf($robot,'sympa_priority');
477
822
        }else {
478
 
            my $list =  new List ($t_listname);
 
823
            my $list =  new List ($t_listname, $t_robot, {'just_try' => 1});
479
824
            if ($list) {
480
825
                $priority = $list->{'admin'}{'priority'};
481
826
            }else {
482
 
                $priority = $Conf{'default_list_priority'};
 
827
                $priority = &Conf::get_robot_conf($robot, 'default_list_priority');
483
828
            }
484
829
        }
485
830
        
489
834
        }
490
835
    } ## END of spool lookup
491
836
 
492
 
    &smtp::reaper;
 
837
    &mail::reaper;
493
838
 
494
839
    unless ($filename) {
495
 
        sleep($Conf{'sleep'});
 
840
        sleep(&Conf::get_robot_conf($robot, 'sleep'));
496
841
        next;
497
842
    }
498
843
 
499
 
    do_log('debug', "Processing %s with priority %s", "$Conf{'queue'}/$filename", $highest_priority) ;
 
844
    &do_log('debug', "Processing %s/%s with priority %s", &Conf::get_robot_conf($robot, 'queue'),$filename, $highest_priority) ;
500
845
    
501
846
    if ($main::options{'mail'} != 1) {
502
 
        $main::options{'mail'} = $robot if ($Conf{'robots'}{$robot}{'log_smtp'});
503
 
        $main::options{'mail'} = $robot if ($Conf{'log_smtp'});
 
847
        $main::options{'mail'} = $robot if (&Conf::get_robot_conf($robot, 'log_smtp'));
504
848
    }
505
849
 
506
850
    ## Set NLS default lang for current message
507
851
    $Language::default_lang = $main::options{'lang'} || &Conf::get_robot_conf($robot, 'lang');
508
852
 
509
 
    my $status = &DoFile("$Conf{'queue'}/$filename");
 
853
    my $status = &DoFile("$spool/$filename");
510
854
    
511
855
    if (defined($status)) {
512
 
        do_log('debug', "Finished %s", "$Conf{'queue'}/$filename") ;
 
856
        &do_log('debug', "Finished %s", "$spool/$filename") ;
513
857
 
514
858
        if ($main::options{'keepcopy'}) {
515
 
            unless (rename "$Conf{'queue'}/$filename", $main::options{'keepcopy'}."/$filename") {
516
 
                do_log('notice', 'Could not rename %s to %s: %s', "$Conf{'queue'}/$filename", $main::options{'keepcopy'}."/$filename", $!);
517
 
                unlink("$Conf{'queue'}/$filename");
 
859
            unless (&File::Copy::copy($spool.'/'.$filename, $main::options{'keepcopy'}.'/'.$filename) ) {
 
860
                &do_log('notice', 'Could not rename %s to %s: %s', "$spool/$filename", $main::options{'keepcopy'}."/$filename", $!);
518
861
            }
519
 
        }else {
520
 
            unlink("$Conf{'queue'}/$filename");
521
862
        }
 
863
        unlink("$spool/$filename");
522
864
    }else {
523
 
        my $bad_dir = "$Conf{'queue'}/bad";
524
 
 
 
865
        my $bad_dir = "$spool/bad";
 
866
        
525
867
        if (-d $bad_dir) {
526
 
            unless (rename("$Conf{'queue'}/$filename", "$bad_dir/$filename")){
 
868
            unless (rename("$spool/$filename", "$bad_dir/$filename")){
527
869
                &fatal_err("Exiting, unable to rename bad file $filename to $bad_dir/$filename (check directory permission)");
528
870
            }
529
871
            do_log('notice', "Moving bad file %s to bad/", $filename);
530
872
        }else{
531
873
            do_log('notice', "Missing directory '%s'", $bad_dir);
532
 
            unless (rename("$Conf{'queue'}/$filename", "$Conf{'queue'}/BAD-$filename")) {
 
874
            unless (rename("$spool/$filename", "$spool/BAD-$filename")) {
533
875
                &fatal_err("Exiting, unable to rename bad file $filename to BAD-$filename");
534
876
            }
535
877
            do_log('notice', "Renaming bad file %s to BAD-%s", $filename, $filename);
536
 
        }
537
 
        
 
878
        }       
538
879
    }
539
880
 
540
881
} ## END of infinite loop
554
895
}
555
896
exit(0);
556
897
 
557
 
## When we catch SIGTERM, just change the value of the loop
558
 
## variable.
 
898
 
 
899
############################################################
 
900
# sigterm
 
901
############################################################
 
902
#  When we catch SIGTERM, just changes the value of the $signal 
 
903
#  loop variable.
 
904
#  
 
905
# IN : -
 
906
#      
 
907
# OUT : -
 
908
#
 
909
############################################################
559
910
sub sigterm {
560
 
    do_log('notice', 'signal TERM received, still processing current task');
 
911
    &do_log('notice', 'signal TERM received, still processing current task');
561
912
    $signal = 'term';
562
913
}
563
914
 
564
 
## When we catch SIGHUP, just change the value of the loop
565
 
## variable.
 
915
 
 
916
############################################################
 
917
# sighup
 
918
############################################################
 
919
#  When we catch SIGHUP, changes the value of the $signal 
 
920
#  loop variable and puts the "-mail" logging option
 
921
#  
 
922
# IN : -
 
923
#      
 
924
# OUT : -
 
925
#
 
926
###########################################################
566
927
sub sighup {
567
928
    if ($main::options{'mail'}) {
568
 
        do_log('notice', 'signal HUP received, switch of the "-mail" logging option and continue current task');
 
929
        &do_log('notice', 'signal HUP received, switch of the "-mail" logging option and continue current task');
569
930
        undef $main::options{'mail'};
570
931
    }else{
571
 
        do_log('notice', 'signal HUP received, switch on the "-mail" logging option and continue current task');
 
932
        &do_log('notice', 'signal HUP received, switch on the "-mail" logging option and continue current task');
572
933
        $main::options{'mail'} = 1;
573
934
    }
574
935
    $signal = 'hup';
575
936
}
576
937
 
577
 
## Handles a file received and files in the queue directory. This will
578
 
## read the file, separate the header and the body of the message and
579
 
## call the adequate function wether we have received a command or a
580
 
## message to be redistributed to a list.
 
938
 
 
939
############################################################
 
940
#  DoFile
 
941
############################################################
 
942
#  Handles a file received and files in the queue directory. 
 
943
#  This will read the file, separate the header and the body 
 
944
#  of the message and call the adequate function wether we 
 
945
#  have received a command or a message to be redistributed 
 
946
#  to a list.
 
947
#  
 
948
# IN : -$file (+): the file to handle
 
949
#      
 
950
# OUT : $status
 
951
#     | undef
 
952
#
 
953
##############################################################
581
954
sub DoFile {
582
955
    my ($file) = @_;
583
956
    &do_log('debug', 'DoFile(%s)', $file);
 
957
 
584
958
    
585
959
    my ($listname, $robot);
586
960
    my $status;
587
 
 
 
961
    
588
962
    my $message = new Message($file);
589
963
    unless (defined $message) {
590
 
        do_log('err', 'Unable to create Message object %s', $file);
 
964
        &do_log('err', 'Unable to create Message object %s', $file);
591
965
        return undef;
592
966
    }
593
967
    
594
 
#    open TMP, ">/tmp/dump";
595
 
#    $message->dump(\*TMP);
596
 
#    close TMP;
597
 
 
598
968
    my $msg = $message->{'msg'};
599
969
    my $hdr = $msg->head;
600
970
    my $rcpt = $message->{'rcpt'};
601
971
    
602
 
    # message prepared by wwsympa and distributed by sympa
603
 
    if ( $hdr->get('X-Sympa-Checksum')) {
604
 
        return (&DoSendMessage ($msg)) ;
605
 
    }
 
972
    &do_log('notice', 'Processing %s ; sender: %s ; message-id: %s', $file, $hdr->get('From'), $hdr->get('Message-ID'));
606
973
 
607
974
    ## get listname & robot
608
975
    ($listname, $robot) = split(/\@/,$rcpt);
609
 
 
 
976
    
610
977
    $robot = lc($robot);
611
978
    $listname = lc($listname);
612
 
    $robot ||= $Conf{'host'};
 
979
    $robot ||= &Conf::get_robot_conf($robot,'host');
613
980
    
614
981
    my $type;
615
982
    my $list_check_regexp = &Conf::get_robot_conf($robot,'list_check_regexp');
617
984
        ($listname, $type) = ($1, $2);
618
985
    }
619
986
 
 
987
    # message prepared by wwsympa and distributed by sympa # dual
 
988
    if ( $hdr->get('X-Sympa-Checksum')) {
 
989
        return (&DoSendMessage ($msg,$robot)) ;
 
990
    }
 
991
    
620
992
    # setting log_level using conf unless it is set by calling option
621
993
    unless ($main::options{'log_level'}) {
622
 
        $log_level = $Conf{'robots'}{$robot}{'log_level'};
623
 
        do_log('debug', "Setting log level with $robot configuration (or sympa.conf) : $log_level"); 
 
994
        $log_level =  &Conf::get_robot_conf($robot,'log_level');
 
995
        &do_log('debug', "Setting log level with $robot configuration (or sympa.conf) : $log_level"); 
624
996
    }
625
 
 
 
997
    
626
998
    ## Ignoring messages with no sender
627
999
    my $sender = $message->{'sender'};
628
1000
    unless ($sender) {
629
 
        do_log('err', 'No From found in message, skipping.');
 
1001
        &do_log('err', 'No From found in message, skipping.');
630
1002
        return undef;
631
1003
    }
632
1004
 
633
1005
    ## Strip of the initial X-Sympa-To field
634
1006
    $hdr->delete('X-Sympa-To');
635
1007
    
636
 
    ## Loop prevention
 
1008
    ## Initialize command report
 
1009
    &report::init_report_cmd();
 
1010
        
 
1011
    my $list_address;
637
1012
    my $conf_email = &Conf::get_robot_conf($robot, 'email');
638
1013
    my $conf_host = &Conf::get_robot_conf($robot, 'host');
639
 
    if ($sender =~ /^(mailer-daemon|sympa|listserv|mailman|majordomo|smartlist|$conf_email)(\@|$)/mio) {
640
 
        do_log('notice','Ignoring message which would cause a loop, sent by %s', $sender);
641
 
        return undef;
642
 
    }
643
 
        
644
 
    ## Initialize command report
645
 
    undef @msg::report;  
646
 
    
647
 
    ## Q- and B-decode subject
648
 
    my $subject_field = &MIME::Words::decode_mimewords($hdr->get('Subject'));
649
 
    chomp $subject_field;
650
 
#    $hdr->replace('Subject', $subject_field);
651
 
        
 
1014
 
652
1015
    my ($list, $host, $name);   
653
 
    if ($listname =~ /^(sympa|listmaster|$conf_email)(\@$conf_host)?$/i) {
 
1016
    if ($listname =~ /^(sympa|$Conf{'listmaster_email'}|$conf_email)(\@$conf_host)?$/i) {
654
1017
        $host = $conf_host;
655
1018
        $name = $listname;
 
1019
        $list_address = $name.'@'.$host;
656
1020
    }else {
657
 
        $list = new List ($listname);
 
1021
        $list = new List ($listname, $robot);
 
1022
        unless (defined $list) {
 
1023
            &do_log('err', 'sympa::DoFile() : list %s does not exist',$listname);
 
1024
            &report::reject_report_msg('user','list_unknown',$sender,{'listname' => $listname},$robot,$message->{'msg_as_string'},'');
 
1025
            return undef;
 
1026
        }
658
1027
        $host = $list->{'admin'}{'host'};
659
1028
        $name = $list->{'name'};
 
1029
        $list_address = $list->get_list_address();
660
1030
        # setting log_level using list config unless it is set by calling option
661
1031
        unless ($main::options{'log_level'}) {
662
1032
            $log_level = $list->{'log_level'};
663
 
            do_log('debug', "Setting log level with list configuration : $log_level"); 
 
1033
            &do_log('debug', "Setting log level with list configuration : $log_level"); 
664
1034
        }
665
1035
    }
666
1036
    
667
1037
    ## Loop prevention
 
1038
   my $conf_loop_prevention_regex;
 
1039
    $conf_loop_prevention_regex = $list->{'admin'}{'loop_prevention_regex'};
 
1040
    $conf_loop_prevention_regex ||= &Conf::get_robot_conf($robot, 'loop_prevention_regex');
 
1041
    if ($sender =~ /^($conf_loop_prevention_regex)(\@|$)/mio) {
 
1042
        &do_log('notice','Ignoring message which would cause a loop, sent by %s', $sender);
 
1043
        return undef;
 
1044
    }
 
1045
        
 
1046
    ## Q- and B-decode subject
 
1047
    my $subject_field = $message->{'decoded_subject'};
 
1048
 
 
1049
    ## Loop prevention
668
1050
    my $loop;
669
1051
    foreach $loop ($hdr->get('X-Loop')) {
670
1052
        chomp $loop;
671
1053
        &do_log('debug2','X-Loop: %s', $loop);
672
1054
        #foreach my $l (split(/[\s,]+/, lc($loop))) {
673
 
            if ($loop eq lc("$name\@$host")) {
 
1055
            if ($loop eq lc($list_address)) {
674
1056
                do_log('notice', "Ignoring message which would cause a loop (X-Loop: $loop)");
675
1057
                return undef;
676
1058
            }
701
1083
    }else {
702
1084
        undef $is_signed;
703
1085
    }
704
 
 
705
 
   #  anti-virus
706
 
    if (my $rc= &tools::virus_infected($message->{'msg'}, $message->{'filename'})) {
707
 
        if ($Conf{'antivirus_notify'} eq 'sender') {
708
 
            #printf "do message, virus= $rc \n";
709
 
            &List::send_global_file('your_infected_msg', $sender, $robot, {'virus_name' => $rc,
710
 
                                                                           'recipient' => $name.'@'.$host,
711
 
                                                                           'lang' => $Language::default_lang});
 
1086
        
 
1087
    #  anti-virus
 
1088
    my $rc= &tools::virus_infected($message->{'msg'}, $message->{'filename'});
 
1089
    if ($rc) {
 
1090
        if ( &Conf::get_robot_conf($robot,'antivirus_notify') eq 'sender') {
 
1091
            unless (&List::send_global_file('your_infected_msg', $sender, $robot, {'virus_name' => $rc,
 
1092
                                                                                   'recipient' => $list_address,
 
1093
                                                                                   'lang' => $Language::default_lang})) {
 
1094
                &do_log('notice',"Unable to send template 'your infected_msg' to $sender");
 
1095
            }
712
1096
        }
713
 
        &do_log('notice', "Message for %s\@%s from %s ignored, virus %s found", $name, $host, $sender, $rc);
714
 
        return undef;
715
 
    }
716
 
   #  
717
 
 
 
1097
        &do_log('notice', "Message for %s from %s ignored, virus %s found", $list_address, $sender, $rc);
 
1098
        return undef;
 
1099
 
 
1100
    }elsif (! defined($rc)) {
 
1101
        unless (&List::send_notify_to_listmaster('antivirus_failed',$robot,["Could not scan $file; The message has been saved as BAD."])) {
 
1102
            &do_log('notice',"Unable to send notify 'antivirus_failed' to listmaster");
 
1103
        }
 
1104
 
 
1105
        return undef;
 
1106
    }
 
1107
  
 
1108
    if ($main::daemon_usage eq 'message') {
 
1109
        if (($rcpt =~ /^$Conf{'listmaster_email'}(\@(\S+))?$/) || ($rcpt =~ /^(sympa|$conf_email)(\@\S+)?$/i) || ($type =~ /^(subscribe|unsubscribe)$/o) || ($type =~ /^(request|owner|editor)$/o)) {
 
1110
            &do_log('err','internal serveur error : distribution daemon should never proceed with command');
 
1111
            &report::global_report_cmd('intern','Distribution daemon proceed with command',{},$sender,$robot,1);
 
1112
            return undef;
 
1113
        } 
 
1114
    }
718
1115
    if ($rcpt =~ /^listmaster(\@(\S+))?$/) {
719
 
        $status = &DoForward('sympa', 'listmaster', $robot, $msg, $file, $sender);
 
1116
        $status = &DoForward('sympa', 'listmaster', $robot, $msg);
720
1117
 
721
1118
        ## Mail adressed to the robot and mail 
722
1119
        ## to <list>-subscribe or <list>-unsubscribe are commands
723
1120
    }elsif (($rcpt =~ /^(sympa|$conf_email)(\@\S+)?$/i) || ($type =~ /^(subscribe|unsubscribe)$/o)) {
724
 
        $status = &DoCommand($rcpt, $robot, $msg, $file);
 
1121
        $status = &DoCommand($rcpt, $robot, $message);
725
1122
        
726
1123
        ## forward mails to <list>-request <list>-owner etc
727
1124
    }elsif ($type =~ /^(request|owner|editor)$/o) {
730
1127
        if (($type eq 'request') and ($subject_field =~ /^\s*(subscribe|unsubscribe)(\s*$listname)?\s*$/i) ) {
731
1128
            my $command = $1;
732
1129
            
733
 
            $status = &DoCommand("$listname-$command", $robot, $msg, $file);
 
1130
            $status = &DoCommand("$listname-$command", $robot, $message);
734
1131
        }else {
735
 
            $status = &DoForward($listname, $type, $robot, $msg, $file, $sender);
736
 
        }       
737
 
    }else {
 
1132
            $status = &DoForward($listname, $type, $robot, $msg);
 
1133
        }         
 
1134
    }else {     
738
1135
        $status =  &DoMessage($rcpt, $message, $robot);
739
1136
    }
740
1137
    
741
1138
 
742
1139
    ## Mail back the result.
743
 
    if (@msg::report) {
 
1140
    if (&report::is_there_any_report_cmd()) {
744
1141
 
745
1142
        ## Loop prevention
746
1143
 
748
1145
        $loop_info{$sender}{'count'}++;
749
1146
        
750
1147
        ## Sampling delay 
751
 
        if ((time - $loop_info{$sender}{'date_init'}) < $Conf{'loop_command_sampling_delay'}) {
 
1148
        if ((time - $loop_info{$sender}{'date_init'}) < &Conf::get_robot_conf($robot, 'loop_command_sampling_delay')) {
752
1149
 
753
1150
            ## Notify listmaster of first rejection
754
 
            if ($loop_info{$sender}{'count'} == $Conf{'loop_command_max'}) {
 
1151
            if ($loop_info{$sender}{'count'} ==  &Conf::get_robot_conf($robot, 'loop_command_max')) {
755
1152
                ## Notify listmaster
756
 
                &List::send_notify_to_listmaster('loop_command', $Conf{'domain'}, $file);
 
1153
                unless (&List::send_notify_to_listmaster('loop_command',  &Conf::get_robot_conf($robot, 'domain'),
 
1154
                                                         {'msg' => $file})) {
 
1155
                    &do_log('notice',"Unable to send notify 'loop_command' to listmaster");
 
1156
                }
757
1157
            }
758
1158
            
759
1159
            ## Too many reports sent => message skipped !!
760
 
            if ($loop_info{$sender}{'count'} >= $Conf{'loop_command_max'}) {
 
1160
            if ($loop_info{$sender}{'count'} >=  &Conf::get_robot_conf($robot, 'loop_command_max')) {
761
1161
                &do_log('notice', 'Ignoring message which would cause a loop, %d messages sent to %s', $loop_info{$sender}{'count'}, $sender);
762
1162
                
763
1163
                return undef;
767
1167
            $loop_info{$sender}{'date_init'} = time;
768
1168
 
769
1169
            ## We apply Decrease factor if a loop occured
770
 
            $loop_info{$sender}{'count'} *= $Conf{'loop_command_decrease_factor'};
771
 
        }
772
 
 
773
 
        ## Prepare the reply message
774
 
        my $reply_hdr = new Mail::Header;
775
 
#       $reply_hdr->add('From', sprintf Msg(12, 4, 'SYMPA <%s>'), $Conf{'sympa'});
776
 
        $reply_hdr->add('From', sprintf Msg(12, 4, 'SYMPA <%s>'), &Conf::get_robot_conf($robot, 'sympa'));
777
 
        $reply_hdr->add('To', $sender);
778
 
        $reply_hdr->add('Subject', Msg(4, 17, 'Output of your commands'));
779
 
        $reply_hdr->add('X-Loop', &Conf::get_robot_conf($robot, 'sympa'));
780
 
        $reply_hdr->add('MIME-Version', Msg(12, 1, '1.0'));
781
 
        $reply_hdr->add('Content-type', sprintf 'text/plain; charset=%s', 
782
 
                        Msg(12, 2, 'us-ascii'));
783
 
        $reply_hdr->add('Content-Transfer-Encoding', Msg(12, 3, '7bit'));
784
 
        
785
 
        ## Open the SMTP process for the response to the command.
786
 
        *FH = &smtp::smtpto(&Conf::get_robot_conf($robot, 'request'), \$sender);
787
 
        $reply_hdr->print(\*FH);
788
 
        
789
 
        foreach (@msg::report) {
790
 
            print FH;
791
 
        }
792
 
        
793
 
        print FH "\n";
794
 
 
795
 
        close(FH);
 
1170
            $loop_info{$sender}{'count'} *=  &Conf::get_robot_conf($robot,'loop_command_decrease_factor');
 
1171
        }
 
1172
 
 
1173
        ## Send the reply message
 
1174
        &report::send_report_cmd($sender,$robot);
 
1175
 
796
1176
    }
797
1177
    
798
1178
    return $status;
799
1179
}
800
1180
 
801
 
## send a message as prepared by wwsympa
 
1181
############################################################
 
1182
#  DoSendMessage
 
1183
############################################################
 
1184
#  Send a message pushed in spool by another process. 
 
1185
#  
 
1186
# IN : -$msg (+): ref(MIME::Entity)
 
1187
#      -$robot (+) :robot
 
1188
#      
 
1189
# OUT : 1 
 
1190
#     | undef
 
1191
#
 
1192
############################################################## 
802
1193
sub DoSendMessage {
803
1194
    my $msg = shift;
 
1195
    my $robot = shift;
804
1196
    &do_log('debug', 'DoSendMessage()');
805
1197
 
806
1198
    my $hdr = $msg->head;
809
1201
    chomp $rcpt; chomp $chksum; chomp $from;
810
1202
 
811
1203
    do_log('info', "Processing web message for %s", $rcpt);
 
1204
    
 
1205
    my $string = $msg->as_string;
 
1206
    my $msg_id = $hdr->get('Message-ID');
 
1207
    my $sender = $hdr->get('From');
812
1208
 
813
1209
    unless ($chksum eq &tools::sympa_checksum($rcpt)) {
814
 
        &do_log('notice', 'Message ignored because incorrect checksum');
 
1210
        &do_log('err', 'sympa::DoSendMessage(): message ignored because incorrect checksum');
 
1211
        &report::reject_report_msg('intern','Message ignored because incorrect checksum',$sender,
 
1212
                          {'msg_id' => $msg_id},
 
1213
                          $robot,$string,'');
815
1214
        return undef ;
816
1215
    }
817
1216
 
821
1220
    
822
1221
    ## Multiple recepients
823
1222
    my @rcpts = split /,/,$rcpt;
824
 
    
825
 
    *MSG = &smtp::smtpto($from,\@rcpts); 
826
 
    $msg->print(\*MSG);
827
 
    close (MSG);
 
1223
   
 
1224
    unless (&mail::mail_forward($msg,$from,\@rcpts,$robot)) {
 
1225
        &do_log('err',"sympa::DoSendMessage(): Impossible to forward mail from $from");
 
1226
        &report::reject_report_msg('intern','Impossible to forward a message pushed in spool by another process than sympa.pl.',$sender,
 
1227
                          {'msg_id' => $msg_id},$robot,$string,'');
 
1228
        return undef;
 
1229
    }
828
1230
 
829
 
    do_log('info', "Message for %s sent", $rcpt);
 
1231
    &do_log('info', "Message for %s sent", $rcpt);
830
1232
 
831
1233
    return 1;
832
1234
}
833
1235
 
834
 
## Handles a message sent to [list]-editor, [list]-owner or [list]-request
 
1236
############################################################
 
1237
#  DoForward                             
 
1238
############################################################
 
1239
#  Handles a message sent to [list]-editor : the list editor, 
 
1240
#  [list]-request : the list owner or the listmaster. 
 
1241
#  Message is forwarded according to $function
 
1242
#  
 
1243
# IN : -$name : list name (+) if ($function <> 'listmaster')
 
1244
#      -$function (+): 'listmaster'|'request'|'editor'
 
1245
#      -$robot (+): robot
 
1246
#      -$msg (+): ref(MIME::Entity)
 
1247
#
 
1248
# OUT : 1 
 
1249
#     | undef
 
1250
#
 
1251
############################################################
835
1252
sub DoForward {
836
 
    my($name, $function, $robot, $msg, $file, $sender) = @_;
837
 
    &do_log('debug', 'DoForward(%s, %s, %s, %s)', $name, $function, $file, $sender);
 
1253
    my($name, $function, $robot, $msg) = @_;
 
1254
    &do_log('debug', 'DoForward(%s, %s, %s, %s)', $name, $function);
838
1255
 
839
1256
    my $hdr = $msg->head;
840
1257
    my $messageid = $hdr->get('Message-Id');
841
 
 
 
1258
    my $msg_string = $msg->as_string;
842
1259
    ##  Search for the list
843
1260
    my ($list, $admin, $host, $recepient, $priority);
844
1261
 
845
1262
    if ($function eq 'listmaster') {
846
 
        $recepient="$function";
 
1263
        $recepient=$Conf{'listmaster_email'};
847
1264
        $host = &Conf::get_robot_conf($robot, 'host');
848
1265
        $priority = 0;
849
1266
    }else {
850
 
        unless ($list = new List ($name)) {
851
 
            do_log('notice', "Message for %s-%s ignored, unknown list %s",$name, $function, $name );
 
1267
        unless ($list = new List ($name, $robot)) {
 
1268
            &do_log('notice', "Message for %s-%s ignored, unknown list %s",$name, $function, $name );
 
1269
            my $sender = $hdr->get('From');
 
1270
            chomp $sender;
 
1271
            my $sympa_email = &Conf::get_robot_conf($robot, 'sympa');
 
1272
            unless (&List::send_global_file('list_unknown', $sender, $robot,
 
1273
                                            {'list' => $name,
 
1274
                                             'date' => &POSIX::strftime("%d %b %Y  %H:%M", localtime(time)),
 
1275
                                             'boundary' => $sympa_email.time,
 
1276
                                             'header' => $hdr->as_string()
 
1277
                                             })) {
 
1278
                &do_log('notice',"Unable to send template 'list_unknown' to $sender");
 
1279
            }
852
1280
            return undef;
853
1281
        }
854
1282
        
860
1288
 
861
1289
    my @rcpt;
862
1290
    
863
 
    do_log('info', "Processing message for %s with priority %s, %s", $recepient, $priority, $messageid );
 
1291
    &do_log('info', "Processing message for %s with priority %s, %s", $recepient, $priority, $messageid );
864
1292
    
865
1293
    $hdr->add('X-Loop', "$name-$function\@$host");
866
1294
    $hdr->delete('X-Sympa-To:');
868
1296
    if ($function eq "listmaster") {
869
1297
        my $listmasters = &Conf::get_robot_conf($robot, 'listmasters');
870
1298
        @rcpt = @{$listmasters};
871
 
        do_log('notice', 'Warning : no listmaster defined in sympa.conf') 
 
1299
        &do_log('notice', 'Warning : no listmaster defined in sympa.conf') 
872
1300
            unless (@rcpt);
873
1301
        
874
1302
    }elsif ($function eq "request") {
875
1303
        @rcpt = $list->get_owners_email();
876
1304
 
877
 
        do_log('notice', 'Warning : no owner defined or all of them use nomail option in list %s', $name ) 
 
1305
        &do_log('notice', 'Warning : no owner defined or all of them use nomail option in list %s', $name ) 
878
1306
            unless (@rcpt);
879
1307
 
880
1308
    }elsif ($function eq "editor") {
881
 
        foreach my $i (@{$admin->{'editor'}}) {
882
 
            next if ($i->{'reception'} eq 'nomail');
883
 
            push(@rcpt, $i->{'email'}) if ($i->{'email'});
884
 
        }
885
 
        unless (@rcpt) {
886
 
            do_log('notice', 'No editor defined in list %s (unless they use NOMAIL), use owners', $name ) ;
887
 
            @rcpt = $list->get_owners_email();
888
 
        }
 
1309
        @rcpt = $list->get_editors_email();
 
1310
 
 
1311
        &do_log('notice', 'Warning : no owner and editor defined or all of them use nomail option in list %s', $name ) 
 
1312
            unless (@rcpt);
889
1313
    }
890
1314
    
891
1315
    if ($#rcpt < 0) {
892
 
        do_log('notice', "Message for %s-%s ignored, %s undefined in list %s", $name, $function, $function, $name);
 
1316
        &do_log('err', "sympa::DoForward(): Message for %s-%s ignored, %s undefined in list %s", $name, $function, $function, $name);
 
1317
        my $string = sprintf 'Impossible to forward a message to %s-%s : undefined in this list',$name,$function;
 
1318
        my $sender = $hdr->get('From');
 
1319
        &report::reject_report_msg('intern',$string,$sender,
 
1320
                          {'msg_id' => $messageid,
 
1321
                           'entry' => 'forward',
 
1322
                           'function' => $function}
 
1323
                          ,$robot,$msg_string,$list);
893
1324
        return undef;
894
 
    }
 
1325
   }
895
1326
   
896
1327
    my $rc;
897
1328
    my $msg_copy = $msg->dup;
898
1329
 
899
 
#    if ($rc = &tools::virus_infected($msg_copy, $file)) {
900
 
#       if ($Conf{'antivirus_notify'} eq 'sender') {
901
 
#           if ($list) {
902
 
#               $list->send_file('your_infected_msg', $sender, $robot, 
903
 
#                                {'virus_name' => $rc,
904
 
#                                 'recipient' => $recepient.'@'.$host,
905
 
#                                 'lang' => $list->{'admin'}{'lang'}});
906
 
#           }
907
 
#           else {
908
 
#               my %context;
909
 
#               $context{'virus_name'} = $rc ;
910
 
#               $context{'recipient'} = $recepient.'@'.$host;
911
 
#               $context{'lang'} = &Conf::get_robot_conf($robot, 'lang');
912
 
#               &List::send_global_file('your_infected_msg', $sender, $robot, \%context );
913
 
#           }    
914
 
#       }
915
 
#       &do_log('notice', "Message for %s\@%s from %s ignored, virus %s found", $recepient, $host, $sender, $rc);
916
 
#
917
 
#       return undef;
918
 
#    }else{
919
 
 
920
 
        *SIZ = smtp::smtpto(&Conf::get_robot_conf($robot, 'request'), \@rcpt);
921
 
        $msg->print(\*SIZ);
922
 
        close(SIZ);
923
 
        
924
 
        do_log('info',"Message for %s forwarded", $recepient);
925
 
#   }
 
1330
    unless (&mail::mail_forward($msg,&Conf::get_robot_conf($robot, 'request'),\@rcpt,$robot)) {
 
1331
        &do_log('err',"Impossible to forward mail for $name-$function  ");
 
1332
        my $string = sprintf 'Impossible to forward a message for %s-%s',$name,$function;
 
1333
        my $sender = $hdr->get('From');
 
1334
        &report::reject_report_msg('intern',$string,$sender,
 
1335
                          {'msg_id' => $messageid,
 
1336
                           'entry' => 'forward',
 
1337
                           'function' => $function}
 
1338
                          ,$robot,$msg_string,$list);
 
1339
        return undef;
 
1340
    }
 
1341
 
926
1342
    return 1;
927
1343
}
928
1344
 
929
 
 
930
 
## Handles a message sent to a list.
 
1345
####################################################
 
1346
#  DoMessage                             
 
1347
####################################################
 
1348
#  Handles a message sent to a list. (Those that can 
 
1349
#  make loop and those containing a command are 
 
1350
#  rejected)
 
1351
#  
 
1352
# IN : -$which (+): 'listname@hostname' - concerned list
 
1353
#      -$message (+): ref(Message) - sent message
 
1354
#      -$robot (+): robot
 
1355
#
 
1356
# OUT : 1 if ok (in order to remove the file from the queue)
 
1357
#     | undef
 
1358
#
 
1359
####################################################
931
1360
sub DoMessage{
932
1361
    my($which, $message, $robot) = @_;
933
1362
    &do_log('debug', 'DoMessage(%s, %s, %s, msg from %s, %s, %s,%s)', $which, $message->{'msg'}, $robot, $message->{'sender'}, $message->{'size'}, $message->{'msg_as_string'}, $message->{'smime_crypted'});
934
1363
    
935
1364
    ## List and host.
936
1365
    my($listname, $host) = split(/[@\s]+/, $which);
937
 
 
 
1366
    
938
1367
    my $hdr = $message->{'msg'}->head;
939
1368
    
940
 
    my $from_field = $hdr->get('From');
941
1369
    my $messageid = $hdr->get('Message-Id');
942
 
 
943
 
    my @sender_hdr = Mail::Address->parse($from_field);
944
 
 
945
 
    my $sender = $sender_hdr[0]->address || '';
946
 
 
 
1370
    my $msg_string = $message->{'msg'}->as_string;
 
1371
    
 
1372
    my $sender = $message->{'sender'};
 
1373
    
947
1374
    ## Search for the list
948
 
    my $list = new List ($listname);
949
 
 
 
1375
    my $list = new List ($listname, $robot);
 
1376
    
950
1377
    ## List unknown
951
1378
    unless ($list) {
952
1379
        &do_log('notice', 'Unknown list %s', $listname);
953
 
        &List::send_global_file('list_unknown', $sender, $robot,
954
 
                                {'list' => $which,
955
 
                                 'date' => &POSIX::strftime("%d %b %Y  %H:%M", localtime(time)),
956
 
                                 'boundary' => &Conf::get_robot_conf($robot, 'sympa').time,
957
 
                                 'header' => $hdr->as_string()
958
 
                                });
 
1380
        my $sympa_email = &Conf::get_robot_conf($robot, 'sympa');
 
1381
        
 
1382
        unless (&List::send_global_file('list_unknown', $sender, $robot,
 
1383
                                        {'list' => $which,
 
1384
                                         'date' => &POSIX::strftime("%d %b %Y  %H:%M", localtime(time)),
 
1385
                                         'boundary' => $sympa_email.time,
 
1386
                                         'header' => $hdr->as_string()
 
1387
                                         })) {
 
1388
            &do_log('notice',"Unable to send template 'list_unknown' to $sender");
 
1389
        }
959
1390
        return undef;
960
1391
    }
961
1392
    
962
1393
    ($listname, $host) = ($list->{'name'}, $list->{'admin'}{'host'});
963
 
 
 
1394
    
964
1395
    my $start_time = time;
965
1396
    
966
1397
    &Language::SetLang($list->{'admin'}{'lang'});
967
 
 
 
1398
    
968
1399
    ## Now check if the sender is an authorized address.
969
 
 
970
 
    do_log('info', "Processing message for %s with priority %s, %s", $listname,$list->{'admin'}{'priority'}, $messageid );
 
1400
    
 
1401
    &do_log('info', "Processing message for %s with priority %s, %s", $listname,$list->{'admin'}{'priority'}, $messageid );
971
1402
    
972
1403
    my $conf_email = &Conf::get_robot_conf($robot, 'sympa');
973
 
    if ($sender =~ /^(mailer-daemon|sympa|listserv|majordomo|smartlist|mailman|$conf_email)(\@|$)/mio) {
 
1404
    my $conf_loop_prevention_regex = $list->{'admin'}{'loop_prevention_regex'};
 
1405
    if ($sender =~ /^($conf_loop_prevention_regex)(\@|$)/mio) {
974
1406
        do_log('notice', 'Ignoring message which would cause a loop');
975
1407
        return undef;
976
1408
    }
977
 
 
978
 
    if ($msgid_table{$listname}{$messageid}) {
979
 
        do_log('notice', 'Found known Message-ID, ignoring message which would cause a loop');
 
1409
        
 
1410
    if ($msgid_table{$list->get_list_id()}{$messageid}) {
 
1411
        &do_log('notice', 'Found known Message-ID, ignoring message which would cause a loop');
980
1412
        return undef;
981
1413
    }
982
 
    
 
1414
        
983
1415
    # Reject messages with commands
984
 
    if ($Conf{'misaddressed_commands'} =~ /reject/i) {
 
1416
    if ( &Conf::get_robot_conf($robot,'misaddressed_commands') =~ /reject/i) {
985
1417
        ## Check the message for commands and catch them.
986
 
        if (tools::checkcommand($message->{'msg'}, $sender, $robot)) {
987
 
            &do_log('notice', 'Found command in message, ignoring message');
988
 
            
 
1418
        if (&tools::checkcommand($message->{'msg'}, $sender, $robot)) {
 
1419
            &do_log('info', 'sympa::DoMessage(): Found command in message, ignoring message');
 
1420
            &report::reject_report_msg('user','routing_error',$sender,{},$robot,$msg_string,$list);
989
1421
            return undef;
990
1422
        }
991
1423
    }
992
 
 
 
1424
        
993
1425
    my $admin = $list->{'admin'};
994
 
    return undef unless $admin;
 
1426
    unless ($admin) {
 
1427
        &do_log('err', 'sympa::DoMessage(): list config is undefined');
 
1428
        &report::reject_report_msg('intern','',$sender,{'msg'=>$messageid},$robot,$msg_string,$list);
 
1429
        return undef;
 
1430
  }
995
1431
    
996
1432
    my $customheader = $admin->{'custom_header'};
997
1433
#    $host = $admin->{'host'} if ($admin->{'host'});
998
1434
 
999
1435
    ## Check if the message is a return receipt
1000
1436
    if ($hdr->get('multipart/report')) {
1001
 
        do_log('notice', 'Message for %s from %s ignored because it is a report', $listname, $sender);
 
1437
        &do_log('notice', 'Message for %s from %s ignored because it is a report', $listname, $sender);
1002
1438
        return undef;
1003
1439
    }
1004
1440
    
1005
1441
    ## Check if the message is too large
1006
 
    my $max_size = $list->get_max_size() || $Conf{'max_size'};
 
1442
    # my $max_size = $list->get_max_size() ||  &Conf::get_robot_conf($robot,'max_size');
 
1443
    my $max_size = $list->get_max_size();
 
1444
 
1007
1445
    if ($max_size && $message->{'size'} > $max_size) {
1008
 
        do_log('notice', 'Message for %s from %s rejected because too large (%d > %d)', $listname, $sender, $message->{'size'}, $max_size);
1009
 
        *SIZ  = smtp::smtpto(&Conf::get_robot_conf($robot, 'request'), \$sender);
1010
 
        print SIZ "From: " . sprintf (Msg(12, 4, 'SYMPA <%s>'), &Conf::get_robot_conf($robot, 'request')) . "\n";
1011
 
        printf SIZ "To: %s\n", $sender;
1012
 
        printf SIZ "Subject: " . Msg(4, 11, "Your message for list %s has been rejected") . "\n", $listname;
1013
 
        printf SIZ "MIME-Version: %s\n", Msg(12, 1, '1.0');
1014
 
        printf SIZ "Content-Type: text/plain; charset=%s\n", Msg(12, 2, 'us-ascii');
1015
 
        printf SIZ "Content-Transfer-Encoding: %s\n\n", Msg(12, 3, '7bit');
1016
 
        print SIZ Msg(4, 12, $msg::msg_too_large);
1017
 
        $message->{'msg'}->print(\*SIZ);
1018
 
        close(SIZ);
 
1446
        &do_log('info', 'sympa::DoMessage(): Message for %s from %s rejected because too large (%d > %d)', $listname, $sender, $message->{'size'}, $max_size);
 
1447
        &report::reject_report_msg('user','message_too_large',$sender,{},$robot,$msg_string,$list);
1019
1448
        return undef;
 
1449
   }
 
1450
    
 
1451
    my $rc;
 
1452
        
 
1453
    my $context =  {'sender' => $sender,
 
1454
                    'message' => $message };
 
1455
        
 
1456
    ## list msg topic   
 
1457
    if ($list->is_there_msg_topic()) {
 
1458
 
 
1459
        my $info_msg_topic = $list->load_msg_topic_file($messageid,$robot);
 
1460
 
 
1461
        # is msg already tagged ?       
 
1462
        if (ref($info_msg_topic) eq "HASH") { 
 
1463
            if ($info_msg_topic->{'method'} eq "sender") {
 
1464
                $context->{'topic_sender'} =  $info_msg_topic->{'topic'};
 
1465
                
 
1466
            }elsif ($info_msg_topic->{'method'} eq "editor") {
 
1467
                $context->{'topic_editor'} =  $info_msg_topic->{'topic'};
 
1468
            
 
1469
            }elsif ($info_msg_topic->{'method'} eq "auto") {
 
1470
                $context->{'topic_auto'} =  $info_msg_topic->{'topic'};
 
1471
            }
 
1472
 
 
1473
        # not already tagged   
 
1474
        } else {
 
1475
            $context->{'topic_auto'} = $list->automatic_tag($message->{'msg'},$robot);
 
1476
        }
 
1477
 
 
1478
        $context->{'topic'} = $context->{'topic_auto'} || $context->{'topic_sender'} || $context->{'topic_editor'};
 
1479
        $context->{'topic_needed'} = (!$context->{'topic'} && $list->is_msg_topic_tagging_required());
1020
1480
    }
1021
 
    
1022
 
    my $rc;
1023
 
   
1024
 
#    if ($rc= &tools::virus_infected($message->{'msg'}, $message->{'filename'})) {
1025
 
#       if ($Conf{'antivirus_notify'} eq 'sender') {
1026
 
#           #printf "do message, virus= $rc \n";
1027
 
#           $list->send_file('your_infected_msg', $sender, $robot, {'virus_name' => $rc,
1028
 
#                                                                   'recipient' => $listname.'@'.$host,
1029
 
#                                                                   'lang' => $list->{'admin'}{'lang'}});
1030
 
#       }
1031
 
#       &do_log('notice', "Message for %s\@%s from %s ignored, virus %s found", $listname, $host, $sender, $rc);
1032
 
#       return undef;
1033
 
#    }
1034
 
    
 
1481
        
1035
1482
    ## Call scenarii : auth_method MD5 do not have any sense in send
1036
1483
    ## scenarii because auth is perfom by distribute or reject command.
1037
1484
    
1038
 
    my $action ;
 
1485
    my $action;
 
1486
    my $result; 
1039
1487
    if ($is_signed->{'body'}) {
1040
 
        $action = &List::request_action ('send', 'smime',$robot,
1041
 
                                         {'listname' => $listname,
1042
 
                                          'sender' => $sender,
1043
 
                                          'message' => $message });
 
1488
        $result = $list->check_list_authz('send', 'smime',$context);
 
1489
        $action = $result->{'action'} if (ref($result) eq 'HASH');
1044
1490
    }else{
1045
 
        $action = &List::request_action ('send', 'smtp',$robot,
1046
 
                                         {'listname' => $listname,
1047
 
                                          'sender' => $sender,
1048
 
                                          'message' => $message });
1049
 
    }
1050
 
 
1051
 
    return undef
1052
 
        unless (defined $action);
1053
 
 
1054
 
    if ($action =~ /^do_it/) {
1055
 
        
1056
 
        my $numsmtp = $list->distribute_msg($message);
1057
 
 
1058
 
        ## Keep track of known message IDs...if any
1059
 
        $msgid_table{$listname}{$messageid}++
1060
 
            if ($messageid);
1061
 
        
1062
 
        unless (defined($numsmtp)) {
1063
 
            do_log('info','Unable to send message to list %s', $listname);
1064
 
            return undef;
 
1491
        $result = $list->check_list_authz('send', 'smtp',$context);
 
1492
        $action = $result->{'action'} if (ref($result) eq 'HASH');
 
1493
    } 
 
1494
 
 
1495
    unless (defined $action) {
 
1496
        &do_log('err', 'sympa::DoMessage(): message (%s) ignored because unable to evaluate scenario "send" for list %s',$messageid,$listname);
 
1497
        &report::reject_report_msg('intern','Message ignored because scenario "send" cannot be evaluated',$sender,
 
1498
                          {'msg_id' => $messageid},
 
1499
                          $robot,$msg_string,$list);
 
1500
        return undef ;
 
1501
    }
 
1502
        
 
1503
 
 
1504
    ## message topic context    
 
1505
    if (($action =~ /^do_it/) && ($context->{'topic_needed'})) {
 
1506
        $action = "editorkey";
 
1507
    }
 
1508
 
 
1509
    if (($action =~ /^do_it/) || ($main::daemon_usage eq 'message')) {
 
1510
 
 
1511
 
 
1512
        if (($main::daemon_usage eq  'message') || ($main::daemon_usage eq  'command_and_message')) {
 
1513
            my $numsmtp = $list->distribute_msg($message);
 
1514
            
 
1515
            ## Keep track of known message IDs...if any
 
1516
            $msgid_table{$list->get_list_id()}{$messageid}++ if ($messageid);
 
1517
            
 
1518
            unless (defined($numsmtp)) {
 
1519
                &do_log('err','sympa::DoMessage(): Unable to send message to list %s', $listname);
 
1520
                &report::reject_report_msg('intern','',$sender,{'msg_id' => $messageid},$robot,$msg_string,$list);
 
1521
                return undef;
 
1522
            }
 
1523
            &do_log('info', 'Message for %s from %s accepted (%d seconds, %d sessions, %d subscribers), message-id=%s, size=%d', $listname, $sender,  time - $start_time, $numsmtp, $list->get_total(),$messageid, $message->{'size'});
 
1524
            return 1;
 
1525
 
 
1526
        }else{   
 
1527
            # this message is to be distributed but this daemon is dedicated to commands -> move it to distribution spool
 
1528
            unless ($list->move_message($message->{'filename'})) {
 
1529
                &do_log('err','sympa::DoMessage(): Unable to move in spool for distribution message to list %s (daemon_usage = command)', $listname);
 
1530
                &report::reject_report_msg('intern','',$sender,{'msg_id' => $messageid},$robot,$msg_string,$list);
 
1531
                return undef;
 
1532
            }
 
1533
            &do_log('info', 'Message for %s from %s moved in spool %s for distribution message-id=%s', $listname, $sender, $Conf{'queuedistribute'},$messageid);
 
1534
            return 1;
1065
1535
        }
1066
 
 
1067
 
        do_log('info', 'Message for %s from %s accepted (%d seconds, %d sessions), size=%d', $listname, $sender, time - $start_time, $numsmtp, $message->{'size'});
1068
1536
        
1069
 
        ## Everything went fine, return TRUE in order to remove the file from
1070
 
        ## the queue.
1071
 
        return 1;
1072
1537
    }elsif($action =~ /^request_auth/){
1073
1538
        my $key = $list->send_auth($message);
1074
 
        do_log('notice', 'Message for %s from %s kept for authentication with key %s', $listname, $sender, $key);
 
1539
 
 
1540
        unless (defined $key) {
 
1541
            &do_log('err','sympa::DoMessage(): Calling to send_auth function failed for user %s in list %s', $sender, $list->{'name'});
 
1542
            &report::reject_report_msg('intern','The request authentication sending failed',$sender,{'msg_id' => $messageid},$robot,$msg_string,$list);
 
1543
            return undef
 
1544
        }
 
1545
        &do_log('notice', 'Message for %s from %s kept for authentication with key %s', $listname, $sender, $key);
1075
1546
        return 1;
1076
1547
    }elsif($action =~ /^editorkey(\s?,\s?(quiet))?/){
1077
1548
        my $key = $list->send_to_editor('md5',$message);
1078
 
        do_log('info', 'Key %s for list %s from %s sent to editors, %s', $key, $listname, $sender, $message->{'filename'});
1079
 
        $list->notify_sender($sender) unless ($2 eq 'quiet');
 
1549
 
 
1550
        unless (defined $key) {
 
1551
            &do_log('err','sympa::DoMessage(): Calling to send_to_editor() function failed for user %s in list %s', $sender, $list->{'name'});
 
1552
            &report::reject_report_msg('intern','The request moderation sending to moderator failed.',$sender,{'msg_id' => $messageid},$robot,$msg_string,$list);
 
1553
            return undef
 
1554
        }
 
1555
 
 
1556
        &do_log('info', 'Key %s for list %s from %s sent to editors, %s', $key, $listname, $sender, $message->{'filename'});
 
1557
        
 
1558
        unless ($2 eq 'quiet') {
 
1559
            unless (&report::notice_report_msg('moderating_message',$sender,{},$robot,$list)) {
 
1560
                &do_log('notice',"sympa::DoMessage(): Unable to send template 'message_report', entry 'moderating_message' to $sender");
 
1561
            }
 
1562
        }
1080
1563
        return 1;
1081
1564
    }elsif($action =~ /^editor(\s?,\s?(quiet))?/){
1082
1565
        my $key = $list->send_to_editor('smtp', $message);
1083
 
        do_log('info', 'Message for %s from %s sent to editors', $listname, $sender);
1084
 
        $list->notify_sender($sender) unless ($2 eq 'quiet');
 
1566
 
 
1567
        unless (defined $key) {
 
1568
            &do_log('err','sympa::DoMessage(): Calling to send_to_editor() function failed for user %s in list %s', $sender, $list->{'name'});
 
1569
            &report::reject_report_msg('intern','The request moderation sending to moderator failed.',$sender,{'msg_id' => $messageid},$robot,$msg_string,$list);
 
1570
            return undef
 
1571
        }
 
1572
 
 
1573
        &do_log('info', 'Message for %s from %s sent to editors', $listname, $sender);
 
1574
        
 
1575
        unless ($2 eq 'quiet') {
 
1576
            unless (&report::notice_report_msg('moderating_message',$sender,{},$robot,$list)) {
 
1577
                &do_log('notice',"sympa::DoMessage(): Unable to send template 'message_report', type 'success', entry 'moderating_message' to $sender");
 
1578
            }
 
1579
        }
1085
1580
        return 1;
1086
 
    }elsif($action =~ /^reject(\(\'?(\w+)\'?\))?(\s?,\s?(quiet))?/) {
1087
 
        my $tpl = $2;
1088
 
        do_log('notice', 'Message for %s from %s rejected(%s) because sender not allowed', $listname, $sender, $tpl);
1089
 
        unless ($4 eq 'quiet') {
1090
 
            if ($tpl) {
1091
 
                $list->send_file($tpl, $sender, $robot, {});
 
1581
    }elsif($action =~ /^reject(,(quiet))?/) {
 
1582
 
 
1583
        &do_log('notice', 'Message for %s from %s rejected(%s) because sender not allowed', $listname, $sender, $result->{'tt2'});
 
1584
        unless ($2 eq 'quiet') {
 
1585
            if (defined $result->{'tt2'}) {
 
1586
                unless ($list->send_file($result->{'tt2'}, $sender, $robot, {})) {
 
1587
                    &do_log('notice',"sympa::DoMessage(): Unable to send template '$result->{'tt2'}' to $sender");
 
1588
                }
1092
1589
            }else {
1093
 
                *SIZ  = smtp::smtpto(&Conf::get_robot_conf($robot, 'request'), \$sender);
1094
 
                print SIZ "From: " . sprintf (Msg(12, 4, 'SYMPA <%s>'), &Conf::get_robot_conf($robot, 'request')) . "\n";
1095
 
                printf SIZ "To: %s\n", $sender;
1096
 
                printf SIZ "Subject: " . Msg(4, 11, "Your message for list %s has been rejected")."\n", $listname ;
1097
 
                printf SIZ "MIME-Version: %s\n", Msg(12, 1, '1.0');
1098
 
                printf SIZ "Content-Type: text/plain; charset=%s\n", Msg(12, 2, 'us-ascii');
1099
 
                printf SIZ "Content-Transfer-Encoding: %s\n\n", Msg(12, 3, '7bit');
1100
 
                printf SIZ Msg(4, 15, $msg::list_is_private), $listname;
1101
 
                $message->{'msg'}->print(\*SIZ);
1102
 
                close(SIZ);
 
1590
                unless (&report::reject_report_msg('auth',$result->{'reason'},$sender,{},$robot,$msg_string,$list)) {
 
1591
                    &do_log('notice',"sympa::DoMessage(): Unable to send template 'message_report', type 'auth' to $sender");
 
1592
                }
1103
1593
            }
1104
1594
        }
1105
1595
        return undef;
1106
1596
    }else {
1107
 
        &do_log('err','Unknown action %s returned by the scenario', $action);
 
1597
        &do_log('err','sympa::DoMessage(): unknown action %s returned by the scenario "send"', $action);
 
1598
        &report::reject_report_msg('intern','Unknown action returned by the scenario "send"',$sender,{'msg_id' => $messageid},$robot,$msg_string,$list);
1108
1599
        return undef;
1109
1600
    }
1110
1601
}
1111
1602
 
1112
 
## Handles a message sent to a list.
1113
 
 
1114
 
## Handles a command sent to the list manager.
 
1603
############################################################
 
1604
#  DoCommand
 
1605
############################################################
 
1606
#  Handles a command sent to the list manager.
 
1607
#  
 
1608
# IN : -$rcpt : recepient | <listname>-<subscribe|unsubscribe> 
 
1609
#      -$robot (+): robot
 
1610
#      -$message : ref(Message) with :
 
1611
#        ->msg (+): ref(MIME::Entity) : message containing command
 
1612
#        ->filename (+): file containing message
 
1613
#      
 
1614
# OUT : $success
 
1615
#     | undef
 
1616
#
 
1617
############################################################## 
1115
1618
sub DoCommand {
1116
 
    my($rcpt, $robot, $msg, $file) = @_;
 
1619
    my($rcpt, $robot, $message) = @_;
 
1620
    my $msg = $message->{'msg'};
 
1621
    my $file = $message->{'filename'};
1117
1622
    &do_log('debug', 'DoCommand(%s %s %s %s) ', $rcpt, $robot, $msg, $file);
1118
 
 
 
1623
    
 
1624
    ## boolean
 
1625
    my $cmd_found = 0;
 
1626
    
1119
1627
    ## Now check if the sender is an authorized address.
1120
1628
    my $hdr = $msg->head;
1121
1629
    
1122
1630
    ## Decode headers
1123
1631
    #$hdr->decode();
1124
1632
    
1125
 
    my $from_field = $hdr->get('From');
1126
1633
    my $messageid = $hdr->get('Message-Id');
1127
1634
    my ($success, $status);
1128
1635
    
1129
 
    do_log('debug', "Processing command with priority %s, %s", $Conf{'sympa_priority'}, $messageid );
 
1636
    &do_log('debug', "Processing command with priority %s, %s", $Conf{'sympa_priority'}, $messageid );
1130
1637
    
1131
 
    my @sender_hdr = Mail::Address->parse($from_field);
1132
 
    my $sender = $sender_hdr[0]->address;
 
1638
    my $sender = $message->{'sender'};
1133
1639
 
1134
1640
    ## Detect loops
1135
 
    if ($msgid_table{$robot}{$messageid}) {
1136
 
        do_log('notice', 'Found known Message-ID, ignoring command which would cause a loop');
 
1641
    if ($msgid_table{'sympa@'.$robot}{$messageid}) {
 
1642
        &do_log('notice', 'Found known Message-ID, ignoring command which would cause a loop');
1137
1643
        return undef;
1138
 
    }
 
1644
    }## Clean old files from spool
1139
1645
    
1140
1646
    ## Keep track of known message IDs...if any
1141
 
    $msgid_table{$robot}{$messageid}++
 
1647
    $msgid_table{'sympa@'.$robot}{$messageid}++
1142
1648
        if ($messageid);
1143
1649
 
1144
1650
    ## If X-Sympa-To = <listname>-<subscribe|unsubscribe> parse as a unique command
1145
1651
    if ($rcpt =~ /^(\S+)-(subscribe|unsubscribe)(\@(\S+))?$/o) {
1146
 
        do_log('debug',"processing message for $1-$2");
 
1652
        &do_log('debug',"processing message for $1-$2");
1147
1653
        &Commands::parse($sender,$robot,"$2 $1");
1148
1654
        return 1; 
1149
1655
    }
1150
1656
    
1151
1657
    ## Process the Subject of the message
1152
1658
    ## Search and process a command in the Subject field
1153
 
    my $subject_field = &MIME::Words::decode_mimewords($hdr->get('Subject'));
1154
 
    chomp $subject_field;
 
1659
    my $subject_field = $message->{'decoded_subject'};
1155
1660
    $subject_field =~ s/\n//mg; ## multiline subjects
1156
1661
    $subject_field =~ s/^\s*(Re:)?\s*(.*)\s*$/$2/i;
1157
1662
 
1158
1663
    $success ||= &Commands::parse($sender, $robot, $subject_field, $is_signed->{'subject'}) ;
1159
1664
 
 
1665
    unless ($success eq 'unknown_cmd') {
 
1666
        $cmd_found = 1;
 
1667
    }
 
1668
 
1160
1669
    ## Make multipart singlepart
1161
 
    my $loops;
1162
 
    while ($msg->is_multipart()) {
1163
 
        $loops++;
1164
 
        if (&tools::as_singlepart($msg, 'text/plain')) {
1165
 
            do_log('notice', 'Multipart message changed to singlepart');
1166
 
        }
1167
 
        if ($loops > 2) {
1168
 
            do_log('notice', 'Could not change multipart to singlepart');
 
1670
    if ($msg->is_multipart()) {
 
1671
        my $status = &tools::as_singlepart($msg, 'text/plain');
 
1672
 
 
1673
        unless (defined $status) {
 
1674
            &do_log('err', 'Could not change multipart to singlepart');
 
1675
            &report::global_report_cmd('user','error_content_type',{});
1169
1676
            return undef;
1170
1677
        }
1171
 
    }
1172
 
 
1173
 
    ## check Content-type
1174
 
    my $mime = $hdr->get('Mime-Version') ;
1175
 
    my $content_type = $hdr->get('Content-type');
1176
 
    my $transfert_encoding = $hdr->get('Content-transfer-encoding');
1177
 
    
1178
 
    unless (($content_type =~ /text/i and !$mime)
1179
 
            or !($content_type) 
1180
 
            or ($content_type =~ /text\/plain/i)) {
1181
 
        do_log('notice', "Ignoring message body not in text/plain, Content-type: %s", $content_type);
1182
 
        print Msg(4, 37, "Ignoring message body not in text/plain, please use text/plain only \n(or put your command in the subject).\n");
1183
 
        
1184
 
        return $success;
1185
 
    }
1186
 
        
1187
 
    my @msgexpire;
1188
 
    my ($expire, $i);
 
1678
 
 
1679
        if ($status) {
 
1680
            &do_log('notice', 'Multipart message changed to singlepart');
 
1681
        }
 
1682
    }
 
1683
 
 
1684
    my $i;
1189
1685
    my $size;
1190
1686
 
1191
1687
    ## Process the body of the message
1192
1688
    ## unless subject contained commands or message has no body
1193
 
    unless (defined($success) || (! defined $msg->bodyhandle)) { 
1194
 
#       foreach $i (@{$msg->body}) {
 
1689
    if ( (!$cmd_found) && (defined $msg->bodyhandle)) { 
 
1690
 
 
1691
        ## check Content-type
 
1692
        my $mime = $hdr->get('Mime-Version') ;
 
1693
        my $content_type = $hdr->get('Content-type');
 
1694
        my $transfert_encoding = $hdr->get('Content-transfer-encoding');
 
1695
        unless (($content_type =~ /text/i and !$mime)
 
1696
                or !($content_type) 
 
1697
                or ($content_type =~ /text\/plain/i)) {
 
1698
            &do_log('notice', "Ignoring message body not in text/plain, Content-type: %s", $content_type);
 
1699
            &report::global_report_cmd('user','error_content_type',{});
 
1700
            return $success; 
 
1701
        }
 
1702
        
1195
1703
        my @body = $msg->bodyhandle->as_lines();
1196
1704
        foreach $i (@body) {
1197
1705
            if ($transfert_encoding =~ /quoted-printable/i) {
1198
1706
                $i = MIME::QuotedPrint::decode($i);
1199
1707
            }
1200
 
            if ($expire){
1201
 
                if ($i =~ /^(quit|end|stop)/io){
1202
 
                    last;
1203
 
                }
1204
 
                # store the expire message in @msgexpire
1205
 
                push(@msgexpire, $i);
1206
 
                next;
1207
 
            }
 
1708
            
1208
1709
            $i =~ s/^\s*>?\s*(.*)\s*$/$1/g;
1209
1710
            next if ($i =~ /^$/); ## skip empty lines
1210
1711
            next if ($i =~ /^\s*\#/) ;
1211
 
    
1212
 
            # exception in the case of command expire
1213
 
            if ($i =~ /^exp(ire)?\s/i){
1214
 
                $expire = $i;
1215
 
                print "> $i\n\n";
1216
 
                next;
1217
 
            }
1218
 
            
1219
 
            push @msg::report, "> $i\n\n";
1220
 
            $size = $#msg::report;
1221
 
            
1222
 
 
1223
 
            if ($i =~ /^(quit|end|stop|--)/io) {
1224
 
                last;
1225
 
            }
 
1712
            
1226
1713
            &do_log('debug2',"is_signed->body $is_signed->{'body'}");
1227
 
 
1228
 
            unless ($status = Commands::parse($sender, $robot, $i, $is_signed->{'body'})) {
1229
 
                push @msg::report, sprintf Msg(4, 19, "Command not understood: ignoring end of message.\n");
 
1714
            
 
1715
            $status = &Commands::parse($sender, $robot, $i, $is_signed->{'body'});
 
1716
            $cmd_found = 1; # if problem no_cmd_understood is sent here
 
1717
            if ($status eq 'unknown_cmd') {
 
1718
                &do_log('notice', "Unknown command found :%s", $i);
 
1719
                &report::reject_report_cmd('user','not_understood',{},$i);
1230
1720
                last;
1231
1721
            }
1232
 
 
1233
 
            if ($#msg::report > $size) {
1234
 
                ## There is a command report
1235
 
                push @msg::report, "\n";
1236
 
            }else {
1237
 
                ## No command report
1238
 
                pop @msg::report;
1239
 
            }
 
1722
            
 
1723
#           if ($i =~ /^(qui|quit|end|stop|-)/io) {
 
1724
#               last;
 
1725
#           }
1240
1726
            
1241
1727
            $success ||= $status;
1242
1728
        }
1243
 
        pop @msg::report unless ($#msg::report > $size);
1244
1729
    }
1245
1730
 
1246
1731
    ## No command found
1247
 
    unless ($success == 1) {
1248
 
        ## No status => no command
1249
 
        unless (defined $success) {
1250
 
            do_log('info', "No command found in message");
1251
 
            push @msg::report, sprintf Msg(4, 39, "No command found in message");
1252
 
        }
 
1732
    unless ($cmd_found == 1) {
 
1733
        &do_log('info', "No command found in message");
 
1734
        &report::global_report_cmd('user','no_cmd_found',{});
1253
1735
        return undef;
1254
1736
    }
1255
1737
    
1256
 
    # processing the expire function
1257
 
    if ($expire){
1258
 
        print STDERR "expire\n";
1259
 
        unless (&Commands::parse($sender, $robot, $expire, @msgexpire)) {
1260
 
            print Msg(4, 19, "Command not understood: ignoring end of message.\n");
1261
 
        }
1262
 
    }
1263
 
 
1264
1738
    return $success;
1265
1739
}
1266
1740
 
1267
 
## Read the queue and send old digests to the subscribers with the digest option.
 
1741
############################################################
 
1742
#  SendDigest
 
1743
############################################################
 
1744
#  Read the queuedigest and send old digests to the subscribers 
 
1745
#  with the digest option.
 
1746
#  
 
1747
# IN : -
 
1748
#      
 
1749
# OUT : -
 
1750
#     | undef
 
1751
#
 
1752
############################################################## 
1268
1753
sub SendDigest{
1269
1754
    &do_log('debug', 'SendDigest()');
1270
1755
 
1271
1756
    if (!opendir(DIR, $Conf{'queuedigest'})) {
1272
 
        fatal_err(Msg(3, 1, "Can't open dir %s: %m"), $Conf{'queuedigest'}); ## No return.
 
1757
        fatal_err(gettext("Unable to access directory %s : %m"), $Conf{'queuedigest'}); ## No return.
1273
1758
    }
1274
1759
    my @dfile =( sort grep (!/^\./,readdir(DIR)));
1275
1760
    closedir(DIR);
1276
1761
 
1277
1762
 
1278
 
    foreach my $listname (@dfile){
1279
 
 
1280
 
        my $filename = $Conf{'queuedigest'}.'/'.$listname;
1281
 
 
1282
 
        my $list = new List ($listname);
 
1763
    foreach my $listaddress (@dfile){
 
1764
 
 
1765
        my $filename = $Conf{'queuedigest'}.'/'.$listaddress;
 
1766
        
 
1767
        my ($listname, $listrobot) = split /\@/, $listaddress;
 
1768
        my $list = new List ($listname, $listrobot);
1283
1769
        unless ($list) {
1284
1770
            &do_log('info', 'Unknown list, deleting digest file %s', $filename);
1285
1771
            unlink $filename;
1290
1776
 
1291
1777
        if ($list->get_nextdigest()){
1292
1778
            ## Blindly send the message to all users.
1293
 
            do_log('info', "Sending digest to list %s", $listname);
 
1779
            do_log('info', "Sending digest to list %s", $listaddress);
1294
1780
            my $start_time = time;
1295
1781
            $list->send_msg_digest();
1296
1782
 
1301
1787
}
1302
1788
 
1303
1789
 
1304
 
## Read the EXPIRE queue and check if a process has ended
1305
 
sub ProcessExpire{
1306
 
    &do_log('debug', 'ProcessExpire()');
1307
 
 
1308
 
    my $edir = $Conf{'queueexpire'};
1309
 
    if (!opendir(DIR, $edir)) {
1310
 
        fatal_err("Can't open dir %s: %m", $edir); ## No return.
1311
 
    }
1312
 
    my @dfile =( sort grep (!/^\./,readdir(DIR)));
1313
 
    closedir(DIR);
1314
 
    my ($d1, $d2, $proprio, $user);
1315
 
 
1316
 
    foreach my $expire (@dfile) {
1317
 
#   while ($expire=<@dfile>){   
1318
 
        ## Parse the expire configuration file
1319
 
        if (!open(IN, "$edir/$expire")) {
1320
 
            next;
1321
 
        }
1322
 
        if (<IN> =~ /^(\d+)\s+(\d+)$/) {
1323
 
            $d1=$1;
1324
 
            $d2=$2;
1325
 
        }       
1326
 
 
1327
 
        if (<IN>=~/^(.*)$/){
1328
 
            $proprio=$1; 
1329
 
        }
1330
 
        close(IN);
1331
 
 
1332
 
        ## Is the EXPIRE process finished ?
1333
 
        if ($d2 <= time){
1334
 
            my $list = new List ($expire);
1335
 
            my $listname = $list->{'name'};
1336
 
            unless ($list){
1337
 
                unlink("$edir/$expire");
1338
 
                next;
1339
 
            };
1340
 
        
1341
 
            ## Prepare the reply message
1342
 
            my $reply_hdr = new Mail::Header;
1343
 
            $reply_hdr->add('From', sprintf Msg(12, 4, 'SYMPA <%s>'), $Conf{'sympa'});
1344
 
            $reply_hdr->add('To', $proprio);
1345
 
            $reply_hdr->add('Subject',sprintf( Msg(4, 24, 'End of your command EXPIRE on list %s'),$expire));
1346
 
 
1347
 
            $reply_hdr->add('MIME-Version', Msg(12, 1, '1.0'));
1348
 
            my $content_type = 'text/plain; charset='.Msg(12, 2, 'us-ascii');
1349
 
            $reply_hdr->add('Content-type', $content_type);
1350
 
            $reply_hdr->add('Content-Transfer-Encoding', Msg(12, 3, '7bit'));
1351
 
 
1352
 
            ## Open the SMTP process for the response to the command.
1353
 
            *FH = &smtp::smtpto($Conf{'request'}, \$proprio);
1354
 
            $reply_hdr->print(\*FH);
1355
 
            my $fh = select(FH);
1356
 
            my $limitday=$d1;
1357
 
            #converting dates.....
1358
 
            $d1= int((time-$d1)/86400);
1359
 
            #$d2= int(($d2-time)/86400);
1360
 
        
1361
 
            my $cpt_badboys;
1362
 
            ## Amount of unconfirmed subscription
1363
 
 
1364
 
            unless ($user = $list->get_first_user()) {
1365
 
                return undef;
1366
 
}
1367
 
 
1368
 
            while ($user = $list->get_next_user()) {
1369
 
                $cpt_badboys++ if ($user->{'update_date'} < $limitday);
1370
 
            }
1371
 
 
1372
 
            ## Message to the owner who launched the expire command
1373
 
            printf Msg(4, 28, "Among the subscribers of list %s for %d days, %d did not confirm their subscription.\n"), $listname, $d1, $cpt_badboys;
1374
 
            print "\n";
1375
 
            printf Msg(4, 26, "Subscribers who do not have confirm their subscription:\n");     
1376
 
            print "\n";
1377
 
        
1378
 
            my $temp=0;
1379
 
 
1380
 
            unless ($user = $list->get_first_user()) {
1381
 
                return undef;
1382
 
            }
1383
 
 
1384
 
            if ($user->{'update_date'} < $limitday){print " $user->{'email'} ";$temp=1;}
1385
 
 
1386
 
            while ($user = $list->get_next_user()) {
1387
 
                next unless ($user->{'update_date'} < $limitday);
1388
 
                print "," if ($temp == 1);
1389
 
                print " $user->{'email'} ";
1390
 
                $temp=1 if ($temp == 0);
1391
 
            }
1392
 
            print "\n\n";
1393
 
            printf Msg(4, 27, "You must delete these subscribers from this list with the following commands :\n");
1394
 
            print "\n";
1395
 
 
1396
 
            unless ($user = $list->get_first_user()) {
1397
 
                return undef;
1398
 
            }
1399
 
 
1400
 
            if ($user->{'update_date'} < $limitday){print "DEL $listname $user->{'email'}\n";}
1401
 
            
1402
 
            while ($user = $list->get_next_user()) {
1403
 
                next unless ($user->{'update_date'} < $limitday);
1404
 
                print "DEL   $listname   $user->{'email'}\n";
1405
 
            }
1406
 
            ## Mail back the result.
1407
 
            select($fh);
1408
 
            close(FH);
1409
 
            unlink("$edir/$expire");
1410
 
            next;
1411
 
        }
1412
 
    }
1413
 
}
1414
 
 
1415
 
## Clean old files from spool
 
1790
############################################################
 
1791
#  CleanSpool
 
1792
############################################################
 
1793
#  Cleans files older than $clean_delay from spool $spool_dir
 
1794
#  
 
1795
# IN : -$spool_dir (+): the spool directory
 
1796
#      -$clean_delay (+): delay in days 
 
1797
#
 
1798
# OUT : 1
 
1799
#
 
1800
############################################################## 
1416
1801
sub CleanSpool {
1417
1802
    my ($spool_dir, $clean_delay) = @_;
1418
1803
    &do_log('debug', 'CleanSpool(%s,%s)', $spool_dir, $clean_delay);
1419
1804
 
1420
1805
    unless (opendir(DIR, $spool_dir)) {
1421
 
        do_log('err', "Unable to open '%s' spool : %s", $spool_dir, $!);
 
1806
        &do_log('err', "Unable to open '%s' spool : %s", $spool_dir, $!);
1422
1807
        return undef;
1423
1808
    }
1424
1809
 
1431
1816
        if ((stat "$spool_dir/$f")[9] < (time - $clean_delay * 60 * 60 * 24)) {
1432
1817
            if (-f "$spool_dir/$f") {
1433
1818
                unlink ("$spool_dir/$f") ;
1434
 
                do_log('notice', 'Deleting old file %s', "$spool_dir/$f");
 
1819
                &do_log('notice', 'Deleting old file %s', "$spool_dir/$f");
1435
1820
            }elsif (-d "$spool_dir/$f") {
1436
 
                unless (opendir(DIR, "$spool_dir/$f")) {
1437
 
                    &do_log('err', 'Cannot open directory %s : %s', "$spool_dir/$f", $!);
 
1821
                unless (&tools::remove_dir("$spool_dir/$f")) {
 
1822
                    &do_log('err', 'Cannot remove old directory %s : %s', "$spool_dir/$f", $!);
1438
1823
                    next;
1439
1824
                }
1440
 
                my @files = sort grep (!/^\./,readdir(DIR));
1441
 
                foreach my $file (@files) {
1442
 
                    unlink ("$spool_dir/$f/$file");
1443
 
                }       
1444
 
                closedir DIR;
1445
 
                
1446
 
                rmdir ("$spool_dir/$f") ;
1447
 
                do_log('notice', 'Deleting old directory %s', "$spool_dir/$f");
 
1825
                &do_log('notice', 'Deleting old directory %s', "$spool_dir/$f");
1448
1826
            }
1449
1827
        }
1450
1828
    }
1452
1830
    return 1;
1453
1831
}
1454
1832
 
 
1833
 
 
1834
 
 
1835
 
 
1836
 
 
1837
 
 
1838
 
 
1839
 
 
1840
 
 
1841
 
 
1842
 
 
1843
 
1455
1844
1;
1456
1845
 
1457
1846