← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:09 2021

Filename/usr/local/libexec/sympa/Sympa/Spindle/ProcessTask.pm
StatementsExecuted 920 statements in 1.76ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
230211.90ms4.24msSympa::Spindle::ProcessTask::::_initSympa::Spindle::ProcessTask::_init
2212µs2µsSympa::Spindle::ProcessTask::::_distaffSympa::Spindle::ProcessTask::_distaff (xsub)
0000s0sSympa::Spindle::ProcessTask::::BEGIN@173Sympa::Spindle::ProcessTask::BEGIN@173
0000s0sSympa::Spindle::ProcessTask::::BEGIN@26Sympa::Spindle::ProcessTask::BEGIN@26
0000s0sSympa::Spindle::ProcessTask::::BEGIN@27Sympa::Spindle::ProcessTask::BEGIN@27
0000s0sSympa::Spindle::ProcessTask::::BEGIN@28Sympa::Spindle::ProcessTask::BEGIN@28
0000s0sSympa::Spindle::ProcessTask::::BEGIN@30Sympa::Spindle::ProcessTask::BEGIN@30
0000s0sSympa::Spindle::ProcessTask::::BEGIN@31Sympa::Spindle::ProcessTask::BEGIN@31
0000s0sSympa::Spindle::ProcessTask::::BEGIN@32Sympa::Spindle::ProcessTask::BEGIN@32
0000s0sSympa::Spindle::ProcessTask::::BEGIN@33Sympa::Spindle::ProcessTask::BEGIN@33
0000s0sSympa::Spindle::ProcessTask::::BEGIN@34Sympa::Spindle::ProcessTask::BEGIN@34
0000s0sSympa::Spindle::ProcessTask::::BEGIN@35Sympa::Spindle::ProcessTask::BEGIN@35
0000s0sSympa::Spindle::ProcessTask::::BEGIN@36Sympa::Spindle::ProcessTask::BEGIN@36
0000s0sSympa::Spindle::ProcessTask::::BEGIN@37Sympa::Spindle::ProcessTask::BEGIN@37
0000s0sSympa::Spindle::ProcessTask::::BEGIN@38Sympa::Spindle::ProcessTask::BEGIN@38
0000s0sSympa::Spindle::ProcessTask::::BEGIN@39Sympa::Spindle::ProcessTask::BEGIN@39
0000s0sSympa::Spindle::ProcessTask::::BEGIN@40Sympa::Spindle::ProcessTask::BEGIN@40
0000s0sSympa::Spindle::ProcessTask::::BEGIN@41Sympa::Spindle::ProcessTask::BEGIN@41
0000s0sSympa::Spindle::ProcessTask::::BEGIN@42Sympa::Spindle::ProcessTask::BEGIN@42
0000s0sSympa::Spindle::ProcessTask::::BEGIN@43Sympa::Spindle::ProcessTask::BEGIN@43
0000s0sSympa::Spindle::ProcessTask::::BEGIN@44Sympa::Spindle::ProcessTask::BEGIN@44
0000s0sSympa::Spindle::ProcessTask::::BEGIN@46Sympa::Spindle::ProcessTask::BEGIN@46
0000s0sSympa::Spindle::ProcessTask::::BEGIN@50Sympa::Spindle::ProcessTask::BEGIN@50
0000s0sSympa::Spindle::ProcessTask::::__ANON__Sympa::Spindle::ProcessTask::__ANON__ (xsub)
0000s0sSympa::Spindle::ProcessTask::::__ANON__[:1145]Sympa::Spindle::ProcessTask::__ANON__[:1145]
0000s0sSympa::Spindle::ProcessTask::::_clean_spoolSympa::Spindle::ProcessTask::_clean_spool
0000s0sSympa::Spindle::ProcessTask::::_cmd_processSympa::Spindle::ProcessTask::_cmd_process
0000s0sSympa::Spindle::ProcessTask::::_db_log_delSympa::Spindle::ProcessTask::_db_log_del
0000s0sSympa::Spindle::ProcessTask::::_errorSympa::Spindle::ProcessTask::_error
0000s0sSympa::Spindle::ProcessTask::::_executeSympa::Spindle::ProcessTask::_execute
0000s0sSympa::Spindle::ProcessTask::::_get_scoreSympa::Spindle::ProcessTask::_get_score
0000s0sSympa::Spindle::ProcessTask::::_notify_bouncersSympa::Spindle::ProcessTask::_notify_bouncers
0000s0sSympa::Spindle::ProcessTask::::_remove_bouncersSympa::Spindle::ProcessTask::_remove_bouncers
0000s0sSympa::Spindle::ProcessTask::::_twistSympa::Spindle::ProcessTask::_twist
0000s0sSympa::Spindle::ProcessTask::::do_createSympa::Spindle::ProcessTask::do_create
0000s0sSympa::Spindle::ProcessTask::::do_delete_subsSympa::Spindle::ProcessTask::do_delete_subs
0000s0sSympa::Spindle::ProcessTask::::do_eval_bouncersSympa::Spindle::ProcessTask::do_eval_bouncers
0000s0sSympa::Spindle::ProcessTask::::do_execSympa::Spindle::ProcessTask::do_exec
0000s0sSympa::Spindle::ProcessTask::::do_expire_bounceSympa::Spindle::ProcessTask::do_expire_bounce
0000s0sSympa::Spindle::ProcessTask::::do_nextSympa::Spindle::ProcessTask::do_next
0000s0sSympa::Spindle::ProcessTask::::do_process_bouncersSympa::Spindle::ProcessTask::do_process_bouncers
0000s0sSympa::Spindle::ProcessTask::::do_purge_logs_tableSympa::Spindle::ProcessTask::do_purge_logs_table
0000s0sSympa::Spindle::ProcessTask::::do_purge_one_time_ticket_tableSympa::Spindle::ProcessTask::do_purge_one_time_ticket_table
0000s0sSympa::Spindle::ProcessTask::::do_purge_orphan_bouncesSympa::Spindle::ProcessTask::do_purge_orphan_bounces
0000s0sSympa::Spindle::ProcessTask::::do_purge_session_tableSympa::Spindle::ProcessTask::do_purge_session_table
0000s0sSympa::Spindle::ProcessTask::::do_purge_spoolsSympa::Spindle::ProcessTask::do_purge_spools
0000s0sSympa::Spindle::ProcessTask::::do_purge_tablesSympa::Spindle::ProcessTask::do_purge_tables
0000s0sSympa::Spindle::ProcessTask::::do_purge_user_tableSympa::Spindle::ProcessTask::do_purge_user_table
0000s0sSympa::Spindle::ProcessTask::::do_rm_fileSympa::Spindle::ProcessTask::do_rm_file
0000s0sSympa::Spindle::ProcessTask::::do_select_subsSympa::Spindle::ProcessTask::do_select_subs
0000s0sSympa::Spindle::ProcessTask::::do_send_msgSympa::Spindle::ProcessTask::do_send_msg
0000s0sSympa::Spindle::ProcessTask::::do_stopSympa::Spindle::ProcessTask::do_stop
0000s0sSympa::Spindle::ProcessTask::::do_sync_includeSympa::Spindle::ProcessTask::do_sync_include
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright 2018, 2019, 2020 The Sympa Community. See the AUTHORS.md
8# file at the top-level directory of this distribution and at
9# <https://github.com/sympa-community/sympa.git>.
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program. If not, see <http://www.gnu.org/licenses/>.
23
24package Sympa::Spindle::ProcessTask;
25
26use strict;
27use warnings;
28use English qw(-no_match_vars);
29
30use Sympa;
31use Conf;
32use Sympa::DatabaseManager;
33use Sympa::List;
34use Sympa::Log;
35use Sympa::Scenario;
36use Sympa::Spool;
37use Sympa::Spool::Listmaster;
38use Sympa::Task;
39use Sympa::Ticket;
40use Sympa::Tools::File;
41use Sympa::Tools::Time;
42use Sympa::Tools::Text;
43use Sympa::Tracking;
44use Sympa::User;
45
46use base qw(Sympa::Spindle);
47
48my $log = Sympa::Log->instance;
49
50use constant _distaff => 'Sympa::Spool::Task';
51
52
# spent 4.24ms (1.90+2.34) within Sympa::Spindle::ProcessTask::_init which was called 230 times, avg 18µs/call: # 229 times (1.90ms+2.34ms) by Sympa::Spindle::spin at line 77 of /usr/local/libexec/sympa/Sympa/Spindle.pm, avg 19µs/call # once (6µs+0s) by Sympa::Spindle::new at line 59 of /usr/local/libexec/sympa/Sympa/Spindle.pm
sub _init {
5323069µs my $self = shift;
5423070µs my $state = shift;
55
562301.17ms4582.34ms if ($state == 1) {
# spent 1.81ms making 229 calls to Sympa::Spool::Listmaster::flush, avg 8µs/call # spent 525µs making 229 calls to Class::Singleton::instance, avg 2µs/call
57 # Process grouped notifications.
58 Sympa::Spool::Listmaster->instance->flush;
59 }
60
61230446µs 1;
62}
63
64sub _twist {
65 my $self = shift;
66 my $task = shift;
67
68 my $that = $task->{context};
69 if (ref $that eq 'Sympa::List' and $that->{'admin'}{'status'} ne 'open') {
70 # Skip closed lists: Remove task.
71 return 1;
72 }
73
74 return _execute($self, $task);
75}
76
77### TASK EXECUTION SUBROUTINES ###
78
79my %comm = (
80 stop => 'do_stop',
81 next => 'do_next',
82 create => 'do_create',
83 exec => 'do_exec',
84 expire_bounce => 'do_expire_bounce',
85 purge_user_table => 'do_purge_user_table',
86 purge_logs_table => 'do_purge_logs_table',
87 purge_session_table => 'do_purge_session_table',
88 purge_spools => 'do_purge_spools',
89 purge_tables => 'do_purge_tables',
90 purge_one_time_ticket_table => 'do_purge_one_time_ticket_table',
91 sync_include => 'do_sync_include',
92 purge_orphan_bounces => 'do_purge_orphan_bounces',
93 eval_bouncers => 'do_eval_bouncers',
94 process_bouncers => 'do_process_bouncers',
95
96 # commands which use a variable
97 send_msg => 'do_send_msg',
98 rm_file => 'do_rm_file',
99
100 # commands which return a variable
101 select_subs => 'do_select_subs',
102
103 # commands which return and use a variable
104 delete_subs => 'do_delete_subs',
105);
106
107# Old name: execute() in task_manager.pl.
108sub _execute {
109 my $self = shift;
110 my $task = shift;
111
112 $log->syslog('notice', 'Running task %s', $task);
113
114 die 'bug in logic. Ask developer' unless $task->{_parsed};
115
116 my %vars; # list of task vars
117 my @lines = $task->lines;
118
119 my $label = $task->{label};
120 return undef if $label eq 'ERROR';
121
122 if (defined $label and length $label) {
123 my $line;
124 while ($line = shift @lines) {
125 next unless defined $line->{label};
126 last if $line->{label} eq $label;
127 }
128 }
129
130 # Execution.
131 my $status;
132 foreach my $line (@lines) {
133 if ($line->{nature} eq 'assignment') {
134 # Processing of the assignments.
135 $status = $vars{$line->{var}} =
136 _cmd_process($self, $task, $line, \%vars);
137 last if not defined $status;
138 } elsif ($line->{nature} eq 'command') {
139 # Processing of the commands.
140 $status = _cmd_process($self, $task, $line, \%vars);
141 last if not defined $status or $status < 0;
142 }
143 }
144
145 if (not defined $status) {
146 $log->syslog('err', 'Error while processing task %s', $task);
147 # Remove task.
148 return undef;
149 } elsif ($status < 0) {
150 $log->syslog('notice', 'The task %s is now useless. Removing it',
151 $task);
152 # Remove task.
153 return 1;
154 } else {
155 # Keep task.
156 return 0;
157 }
158}
159
160# Old name: cmd_process() in task_manager.pl.
161sub _cmd_process {
162 $log->syslog('debug2', '(%s, %s, %s, %s, %s, %s)', @_);
163 my $self = shift;
164 my $task = shift;
165 my $line = shift;
166 my $Rvars = shift; # variable list of the task
167
168 my $command = $line->{command}; # command name
169
170 unless (defined $comm{$command}) {
171 return undef;
172 } else {
173 no strict 'refs';
174 return $comm{$command}->($self, $task, $line, $Rvars);
175 }
176}
177
178### command subroutines ###
179
180# remove files whose name is given in the key 'file' of the hash
181# Old name: rm_file() in task_manager.pl.
182sub do_rm_file {
183 my $self = shift;
184 my $task = shift;
185 my $line = shift;
186 my $Rvars = shift;
187
188 my @tab = @{$line->{Rarguments} || []};
189 my $var = $tab[0];
190
191 foreach my $key (keys %{$Rvars->{$var}}) {
192 my $file = $Rvars->{$var}{$key}{'file'};
193 next unless $file;
194 unless (unlink $file) {
195 _error($task,
196 "error in rm_file command : unable to remove $file");
197 return undef;
198 }
199 }
200
201 return 1;
202}
203
204# Old name: stop() in task_manager.pl.
205sub do_stop {
206 my $self = shift;
207 my $task = shift;
208 my $line = shift;
209
210 $log->syslog('notice', '%s: stop %s', $line->{line}, $task);
211 return -1; # Remove task.
212}
213
214# Old name: send_msg() in task_manager.pl.
215sub do_send_msg {
216 my $self = shift;
217 my $task = shift;
218 my $line = shift;
219 my $Rvars = shift;
220
221 my @tab = @{$line->{Rarguments} || []};
222 my $template = $tab[1];
223 my $var = $tab[0];
224
225 $log->syslog('notice', 'Line %s: send_msg (%s)',
226 $line->{line}, join(',', @tab));
227
228 foreach my $email (keys %{$Rvars->{$var}}) {
229 $log->syslog('notice', '--> message sent to %s', $email);
230 unless (
231 Sympa::send_file(
232 $task->{context}, $template,
233 $email, $Rvars->{$var}{$email}
234 )
235 ) {
236 $log->syslog('notice', 'Unable to send template %s to %s',
237 $template, $email);
238 }
239 }
240
241 return 1;
242}
243
244# Old name: next_cmd() in task_manager.pl.
245sub do_next {
246 my $self = shift;
247 my $task = shift;
248 my $line = shift;
249
250 my @tab = @{$line->{Rarguments} || []};
251 # conversion of the date argument into epoch format
252 my $date = Sympa::Tools::Time::epoch_conv($tab[0]);
253 my $label = $tab[1];
254
255 $log->syslog('notice', 'line %s of %s: next(%s, %s)',
256 $line->{line}, $task->{model}, $date, $label);
257
258 my $new_task = Sympa::Task->new(
259 context => $task->{context},
260 date => $date,
261 label => $label,
262 model => $task->{model},
263 );
264 unless ($new_task and $self->{distaff}->store($new_task)) {
265 _error($task,
266 "error in create command : creation subroutine failure");
267 return undef;
268 }
269
270 $log->syslog('notice', '--> new task %s', $new_task);
271
272 return -1; # Remove older task.
273}
274
275# Old name: select_subs() in task_manager.pl.
276sub do_select_subs {
277 my $self = shift;
278 my $task = shift;
279 my $line = shift;
280
281 my @tab = @{$line->{Rarguments} || []};
282 my $condition = $tab[0];
283 $log->syslog('debug2', 'Line %s: select_subs (%s)',
284 $line->{line}, $condition);
285
286 my ($func, $date);
287 if ($condition =~ /(older|newer)[(]([^\)]*)[)]/) {
288 ($func, $date) = ($1, $2);
289 # Conversion of the date argument into epoch format.
290 $date = Sympa::Tools::Time::epoch_conv($date);
291 } else {
292 $log->syslog('err', 'Illegal condition %s', $condition);
293 return {};
294 }
295
296 my %selection;
297 my $list = $task->{context};
298 unless (ref $list eq 'Sympa::List') {
299 $log->syslog('err', 'No list');
300 return {};
301 }
302
303 for (
304 my $user = $list->get_first_list_member();
305 $user;
306 $user = $list->get_next_list_member()
307 ) {
308 if ( $func eq 'newer' and $date < $user->{update_date}
309 or $func eq 'older' and $user->{update_date} < $date) {
310 $selection{$user->{'email'}} = undef;
311 $log->syslog('info', '--> user %s has been selected',
312 $user->{'email'});
313 }
314 }
315
316 return \%selection;
317}
318
319# Old name: delete_subs_cmd() in task_manager.pl.
320# Not yet used.
321sub do_delete_subs {
322 my $self = shift;
323 my $task = shift;
324 my $line = shift;
325 my $Rvars = shift;
326
327 my @tab = @{$line->{Rarguments} || []};
328 my $var = $tab[0];
329
330 $log->syslog('notice', 'Line %s: delete_subs (%s)', $line->{line}, $var);
331
332 my $list = $task->{context};
333 unless (ref $list eq 'Sympa::List') {
334 $log->syslog('err', 'No list');
335 return {};
336 }
337
338 my %selection; # hash of subscriber emails who are successfully deleted
339
340 foreach my $email (keys %{$Rvars->{$var}}) {
341 $log->syslog('notice', '%s', $email);
342 my $result = Sympa::Scenario->new($list, 'del')->authz(
343 'smime',
344 { 'sender' => $Conf::Conf{'listmaster'}, #FIXME
345 'email' => $email,
346 }
347 );
348 my $action;
349 $action = $result->{'action'} if (ref($result) eq 'HASH');
350 if ($action =~ /reject/i) {
351 #FIXME
352 _error($task,
353 "error in delete_subs command : deletion of $email not allowed"
354 );
355 } else {
356 my $u = $list->delete_list_member(
357 users => [$email],
358 operation => 'auto_del'
359 );
360 $log->syslog('notice', '--> %s deleted', $email);
361 $selection{$email} = {};
362 }
363 }
364
365 return \%selection;
366}
367
368my $subarg_regexp = '(\w+)(|\((.*)\))';
369
370# Old name: create_cmd() in task_manager.pl.
371sub do_create {
372 my $self = shift;
373 my $task = shift;
374 my $line = shift;
375
376 my @tab = @{$line->{Rarguments} || []};
377 my $arg = $tab[0];
378 my $model = $tab[1];
379 my $model_choice = $tab[2];
380
381 $log->syslog('notice', 'line %s: create(%s, %s, %s)',
382 $line->{line}, $arg, $model, $model_choice);
383
384 # recovery of the object type and object
385 my $that;
386 if ($arg =~ /$subarg_regexp/) {
387 my $type = $1;
388 my $object = $3;
389
390 if ($type eq 'list') {
391 my ($name, $robot) = split /\@/, $object, 2;
392 $that = Sympa::List->new($name, $robot, {just_try => 1});
393 } else {
394 $that = '*';
395 }
396 }
397 unless ($that) {
398 _error($task,
399 "error in create command : don't know how to create $arg");
400 return undef;
401 }
402
403 my $new_task = Sympa::Task->new(
404 context => $that,
405 date => $task->{date},
406 model => $model
407 );
408 unless ($new_task and $self->{distaff}->store($new_task)) {
409 _error($task,
410 "error in create command : creation subroutine failure");
411 return undef;
412 }
413
414 return 1;
415}
416
417# Old name: exec_cmd() in task_manager.pl.
418sub do_exec {
419 my $self = shift;
420 my $task = shift;
421 my $line = shift;
422
423 my @tab = @{$line->{Rarguments} || []};
424 my $file = $tab[0];
425
426 $log->syslog('notice', 'Line %s: exec (%s)', $line->{line}, $file);
427 system($file);
428
429 return 1;
430}
431
432# Old name: purge_logs_table() in task_manager.pl.
433sub do_purge_logs_table {
434 my $self = shift;
435 my $task = shift;
436 my $line = shift;
437
438 unless (_db_log_del()) {
439 $log->syslog('err', 'Failed to delete logs');
440 return undef;
441 }
442
443 $log->syslog('notice', 'Logs purged');
444
445 if ($log->aggregate_stat) {
446 $log->syslog('notice', 'Stats aggregated');
447 }
448
449 return 1;
450}
451
452# Deletes logs in RDBMS.
453# If a log is older than $list->get_latest_distribution_date() - $delay
454# expire the log.
455# Old name: _db_log_del() in task_manager.pl.
456sub _db_log_del {
457 my ($exp, $date);
458
459 my $sdm = Sympa::DatabaseManager->instance;
460
461 $exp = Conf::get_robot_conf('*', 'logs_expiration_period');
462 $date = time - ($exp * 31 * 24 * 60 * 60);
463 unless (
464 $sdm
465 and $sdm->do_prepared_query(
466 q{DELETE FROM logs_table
467 WHERE date_logs <= ?},
468 $date
469 )
470 ) {
471 $log->syslog('err',
472 'Unable to delete db_log entry from the database');
473 return undef;
474 }
475
476 $exp = Conf::get_robot_conf('*', 'stats_expiration_period');
477 $date = time - ($exp * 31 * 24 * 60 * 60);
478 unless (
479 $sdm->do_prepared_query(
480 q{DELETE FROM stat_table
481 WHERE date_stat <= ?},
482 $date
483 )
484 ) {
485 $log->syslog('err',
486 'Unable to delete db_log entry from the database');
487 return undef;
488 }
489 unless (
490 $sdm->do_prepared_query(
491 q{DELETE FROM stat_counter_table
492 WHERE end_date_counter <= ?},
493 $date
494 )
495 ) {
496 $log->syslog('err',
497 'Unable to delete db_log entry from the database');
498 return undef;
499 }
500
501 return 1;
502}
503
504# Remove sessions from session_table if older than session_table_ttl or
505# anonymous_session_table_ttl.
506# Old name: Sympa::Session::purge_old_sessions(),
507# purge_session_table() in task_manager.pl.
508sub do_purge_session_table {
509 my $self = shift;
510 my $task = shift;
511 my $line = shift;
512
513 my $delay =
514 Sympa::Tools::Time::duration_conv($Conf::Conf{'session_table_ttl'});
515 my $anonymous_delay = Sympa::Tools::Time::duration_conv(
516 $Conf::Conf{'anonymous_session_table_ttl'});
517
518 unless ($delay) {
519 $log->syslog('info', 'Exit with delay null');
520 return undef;
521 }
522 unless ($anonymous_delay) {
523 $log->syslog('info', 'Exit with anonymous delay null');
524 return undef;
525 }
526
527 my @sessions;
528 my $sth;
529 my $sdm = Sympa::DatabaseManager->instance;
530 unless ($sdm) {
531 $log->syslog('err', 'Unavailable database connection');
532 return undef;
533 }
534
535 my (@conditions, @anonymous_conditions);
536 push @conditions, sprintf('%d > date_session', time - $delay) if $delay;
537 push @anonymous_conditions,
538 sprintf('%d > date_session', time - $anonymous_delay)
539 if $anonymous_delay;
540
541 my $condition = join ' AND ', @conditions;
542 my $anonymous_condition = join ' AND ', @anonymous_conditions,
543 "email_session = 'nobody'", 'hit_session = 1';
544
545 my $count_statement =
546 sprintf q{SELECT COUNT(*) FROM session_table WHERE %s}, $condition;
547 my $anonymous_count_statement =
548 sprintf q{SELECT COUNT(*) FROM session_table WHERE %s},
549 $anonymous_condition;
550
551 my $statement = sprintf q{DELETE FROM session_table WHERE %s}, $condition;
552 my $anonymous_statement = sprintf q{DELETE FROM session_table WHERE %s},
553 $anonymous_condition;
554
555 unless ($sth = $sdm->do_query($count_statement)) {
556 $log->syslog('err', 'Unable to count old session');
557 return undef;
558 }
559
560 my $total = $sth->fetchrow;
561 if ($total == 0) {
562 $log->syslog('debug', 'No sessions to expire');
563 } else {
564 unless ($sth = $sdm->do_query($statement)) {
565 $log->syslog('err', 'Unable to purge old sessions');
566 return undef;
567 }
568 }
569 unless ($sth = $sdm->do_query($anonymous_count_statement)) {
570 $log->syslog('err', 'Unable to count anonymous sessions');
571 return undef;
572 }
573 my $anonymous_total = $sth->fetchrow;
574 if ($anonymous_total == 0) {
575 $log->syslog('debug', 'No anonymous sessions to expire');
576 } else {
577 unless ($sth = $sdm->do_query($anonymous_statement)) {
578 $log->syslog('err', 'Unable to purge anonymous sessions');
579 return undef;
580 }
581 }
582
583 $log->syslog(
584 'notice',
585 '%s row removed in session_table',
586 $total + $anonymous_total
587 );
588 return 1;
589}
590
591# Remove messages from spools if older than duration given by configuration.
592# Old name: purge_spools() in task_manager.pl.
593sub do_purge_spools {
594 my $self = shift;
595 my $task = shift;
596 my $line = shift;
597
598 # Expiring bad messages in incoming spools and archive spool.
599 foreach my $queue (qw(queue queueautomatic queuebounce queueoutgoing)) {
600 my $directory = $Conf::Conf{$queue} . '/bad';
601 my $clean_delay = $Conf::Conf{'clean_delay_' . $queue};
602 if (-e $directory) {
603 _clean_spool($directory, $clean_delay);
604 }
605 }
606
607 # Expiring bad messages in digest spool.
608 if (opendir my $dh, $Conf::Conf{'queuedigest'}) {
609 my $base_dir = $Conf::Conf{'queuedigest'};
610 my @dirs = grep { !/\A\./ and -d $base_dir . '/' . $_ } readdir $dh;
611 closedir $dh;
612 foreach my $subdir (@dirs) {
613 my $directory = $base_dir . '/' . $subdir . '/bad';
614 my $clean_delay = $Conf::Conf{'clean_delay_queuedigest'};
615 if (-e $directory) {
616 _clean_spool($directory, $clean_delay);
617 }
618 }
619 }
620
621 # Expiring bad packets and messages in bulk spool.
622 foreach my $subdir (qw(pct msg)) {
623 my $directory = $Conf::Conf{'queuebulk'} . '/bad/' . $subdir;
624 my $clean_delay = $Conf::Conf{'clean_delay_queuebulk'};
625 if (-e $directory) {
626 _clean_spool($directory, $clean_delay);
627 }
628 }
629
630 # Expiring moderation spools except mod, topic spool and temporary files.
631 foreach my $queue (
632 qw(queueauth queueautomatic queuesubscribe queuetopic tmpdir)) {
633 my $directory = $Conf::Conf{$queue};
634 my $clean_delay = $Conf::Conf{'clean_delay_' . $queue};
635 if (-e $directory) {
636 _clean_spool($directory, $clean_delay);
637 }
638 }
639
640 # Expiring mod spool.
641 my $modqueue = $Conf::Conf{'queuemod'};
642 if (opendir my $dh, $modqueue) {
643 my @qfiles = sort readdir $dh;
644 closedir $dh;
645 foreach my $i (@qfiles) {
646 next if $i =~ /\A[.]/;
647 next unless -f $modqueue . '/' . $i;
648
649 $i =~ /\A(.+)_[.\w]+\z/;
650 my $list = Sympa::List->new($1, '*', {just_try => 1}) if $1;
651 my $moddelay;
652 if (ref $list eq 'Sympa::List') {
653 $moddelay = $list->{'admin'}{'clean_delay_queuemod'};
654 } else {
655 $moddelay = $Conf::Conf{'clean_delay_queuemod'};
656 }
657 if ($moddelay) {
658 my $mtime =
659 Sympa::Tools::File::get_mtime($modqueue . '/' . $i);
660 if ($mtime < time - $moddelay * 86400) {
661 unlink($modqueue . '/' . $i);
662 $log->syslog('notice',
663 'Deleting unmoderated message %s, too old', $i);
664 }
665 }
666 }
667 }
668
669 # Expiring formatted held messages.
670 if (opendir my $dh, $Conf::Conf{'viewmail_dir'} . '/mod') {
671 my $base_dir = $Conf::Conf{'viewmail_dir'} . '/mod';
672 my @dirs = grep { !/\A\./ and -d $base_dir . '/' . $_ } readdir $dh;
673 closedir $dh;
674 foreach my $list_id (@dirs) {
675 my $clean_delay;
676 my $list = Sympa::List->new($list_id, '*', {just_try => 1});
677 if (ref $list eq 'Sympa::List') {
678 $clean_delay = $list->{'admin'}{'clean_delay_queuemod'};
679 } else {
680 $clean_delay = $Conf::Conf{'clean_delay_queuemod'};
681 }
682 my $directory = $base_dir . '/' . $list_id;
683 if ($clean_delay and -e $directory) {
684 _clean_spool($directory, $clean_delay);
685 }
686 }
687 }
688
689 # Removing messages in bulk spool with no more packet.
690 my $pct_directory = $Conf::Conf{'queuebulk'} . '/pct';
691 my $msg_directory = $Conf::Conf{'queuebulk'} . '/msg';
692 if (opendir my $dh, $pct_directory) {
693 my $msgpath;
694 while ($msgpath = readdir $dh) {
695 next if $msgpath =~ /\A\./;
696 next unless -d $pct_directory . '/' . $msgpath;
697 next
698 if time - 3600 < Sympa::Tools::File::get_mtime(
699 $pct_directory . '/' . $msgpath);
700
701 # If packet directory is empty, remove message also.
702 unlink($msg_directory . '/' . $msgpath)
703 if rmdir($pct_directory . '/' . $msgpath);
704 }
705 closedir $dh;
706 }
707
708 return 1;
709}
710
711# Old name: tools::CleanSpool(), Sympa::Tools::File::CleanDir(),
712# _clean_spool() in task_manager.pl.
713sub _clean_spool {
714 $log->syslog('debug2', '(%s, %s)', @_);
715 my ($directory, $clean_delay) = @_;
716
717 return 1 unless $clean_delay;
718
719 my $dh;
720 unless (opendir $dh, $directory) {
721 $log->syslog('err', 'Unable to open "%s" spool: %m', $directory);
722 return undef;
723 }
724 my @qfile = sort grep { !/\A\.+\z/ and !/\Abad\z/ } readdir $dh;
725 closedir $dh;
726
727 my ($curlist, $moddelay);
728 foreach my $f (@qfile) {
729 if (Sympa::Tools::File::get_mtime("$directory/$f") <
730 time - $clean_delay * 60 * 60 * 24) {
731 if (-f "$directory/$f") {
732 unlink("$directory/$f");
733 $log->syslog('notice', 'Deleting old file %s',
734 "$directory/$f");
735 } elsif (-d "$directory/$f") {
736 unless (Sympa::Tools::File::remove_dir("$directory/$f")) {
737 $log->syslog('err', 'Cannot remove old directory %s: %m',
738 "$directory/$f");
739 next;
740 }
741 $log->syslog('notice', 'Deleting old directory %s',
742 "$directory/$f");
743 }
744 }
745 }
746
747 return 1;
748}
749
750## remove messages from bulkspool table when no more packet have any pointer
751## to this message
752# Old name: purge_tables() in task_manager.pl.
753sub do_purge_tables {
754 my $self = shift;
755 my $task = shift;
756 my $line = shift;
757
758 my $removed;
759
760 $removed = 0;
761 foreach my $robot (Sympa::List::get_robots()) {
762 my $all_lists = Sympa::List::get_lists($robot);
763
764 foreach my $list (@{$all_lists || []}) {
765 my $tracking = Sympa::Tracking->new(context => $list);
766 next unless $tracking;
767
768 $removed +=
769 $tracking->remove_message_by_period(
770 $list->{'admin'}{'tracking'}{'retention_period'});
771 }
772 }
773 $log->syslog('notice', "%s rows removed in tracking table", $removed);
774
775 return 1;
776}
777
778## remove one time ticket table if older than
779## $Conf::Conf{'one_time_ticket_table_ttl'}
780# Old name: purge_one_time_ticket_table() in task_manager.pl.
781sub do_purge_one_time_ticket_table {
782 my $self = shift;
783 my $task = shift;
784 my $line = shift;
785
786 $log->syslog('info', '');
787 my $removed = Sympa::Ticket::purge_old_tickets('*');
788 unless (defined $removed) {
789 $log->syslog('err', 'Failed to remove old tickets');
790 return undef;
791 }
792 $log->syslog('notice', '%s row removed in one_time_ticket_table',
793 $removed);
794 return 1;
795}
796
797# Old name: purge_user_table() in task_manager.pl.
798sub do_purge_user_table {
799 my $self = shift;
800 my $task = shift;
801 my $line = shift;
802
803 my $sdm = Sympa::DatabaseManager->instance;
804
805 my $time = time;
806
807 # Marking super listmasters
808 foreach my $l (Sympa::get_listmasters_email('*')) {
809 unless (
810 $sdm
811 and $sdm->do_prepared_query(
812 q{UPDATE user_table
813 SET last_active_date_user = ?
814 WHERE email_user = ?},
815 $time, lc $l
816 )
817 ) {
818 $log->syslog('err', 'Failed to check activity of users');
819 return undef;
820 }
821 }
822 # Marking per-robot listmasters.
823 foreach my $robot_id (Sympa::List::get_robots()) {
824 foreach my $l (Sympa::get_listmasters_email($robot_id)) {
825 unless (
826 $sdm->do_prepared_query(
827 q{UPDATE user_table
828 SET last_active_date_user = ?
829 WHERE email_user = ?},
830 $time, lc $l
831 )
832 ) {
833 $log->syslog('err', 'Failed to check activity of users');
834 return undef;
835 }
836 }
837 }
838 # Marking new users, owners/editors and subscribers.
839 unless (
840 $sdm->do_prepared_query(
841 q{UPDATE user_table
842 SET last_active_date_user = ?
843 WHERE last_active_date_user IS NULL
844 OR EXISTS (
845 SELECT 1
846 FROM admin_table
847 WHERE admin_table.user_admin = user_table.email_user
848 )
849 OR EXISTS (
850 SELECT 1
851 FROM subscriber_table
852 WHERE subscriber_table.user_subscriber = user_table.email_user
853 )},
854 $time
855 )
856 ) {
857 $log->syslog('err', 'Failed to check activity of users');
858 return undef;
859 }
860
861 # Look for unused entries.
862 my @purged_users;
863 my $sth;
864 unless (
865 $sth = $sdm->do_prepared_query(
866 q{SELECT email_user
867 FROM user_table
868 WHERE last_active_date_user IS NOT NULL AND
869 last_active_date_user < ?},
870 $time
871 )
872 ) {
873 $log->syslog('err', 'Failed to get inactive users');
874 return undef;
875 }
876 @purged_users =
877 grep {$_} map { $_->[0] } @{$sth->fetchall_arrayref || []};
878 $sth->finish;
879
880 # Purge unused entries.
881 foreach my $email (@purged_users) {
882 my $user = Sympa::User->new($email);
883 next unless $user;
884
885 unless ($user->expire) {
886 $log->syslog('err', 'Failed to purge inactive user %s', $user);
887 return undef;
888 } else {
889 $log->syslog('info', 'User %s was expired', $user);
890 }
891 }
892
893 return scalar @purged_users;
894}
895
896## Subroutine which remove bounced message of no-more known users
897# Old name: purge_orphan_bounces() in task_manager.pl.
898sub do_purge_orphan_bounces {
899 my $self = shift;
900 my $task = shift;
901 my $line = shift;
902
903 my $all_lists = Sympa::List::get_lists('*');
904 foreach my $list (@{$all_lists || []}) {
905 # First time: loading DB entries into %bounced_users,
906 # hash {'bounced address' => 1}
907 my %bounced_users;
908
909 for (
910 my $user_ref = $list->get_first_bouncing_list_member();
911 $user_ref;
912 $user_ref = $list->get_next_bouncing_list_member()
913 ) {
914 my $user_id = $user_ref->{'email'};
915 $bounced_users{Sympa::Tools::Text::escape_chars($user_id)} = 1;
916 }
917
918 my $bounce_dir = $list->get_bounce_dir();
919 unless (-d $bounce_dir) {
920 $log->syslog('notice', 'No bouncing subscribers in list %s',
921 $list);
922 next;
923 }
924
925 # Then reading Bounce directory & compare with %bounced_users
926 my $dh;
927 unless (opendir $dh, $bounce_dir) {
928 $log->syslog('err', 'Error while opening bounce directory %s',
929 $bounce_dir);
930 return undef;
931 }
932
933 # Finally removing orphan files
934 my $marshalled;
935 while ($marshalled = readdir $dh) {
936 my $metadata =
937 Sympa::Spool::unmarshal_metadata($bounce_dir, $marshalled,
938 qr/\A([^\s\@]+\@[\w\.\-*]+?)(?:_(\w+))?\z/,
939 [qw(recipient envid)]);
940 next unless $metadata;
941 # Skip <email>_<envid> which is used by tracking feature.
942 next if defined $metadata->{envid};
943
944 unless ($bounced_users{$marshalled}) {
945 $log->syslog('info',
946 'Removing orphan Bounce for user %s in list %s',
947 $marshalled, $list);
948 unless (unlink($bounce_dir . '/' . $marshalled)) {
949 $log->syslog('err', 'Error while removing file %s/%s',
950 $bounce_dir, $marshalled);
951 }
952 }
953 }
954
955 closedir $dh;
956 }
957 return 1;
958}
959
960# If a bounce is older than $list->get_latest_distribution_date() - $delay
961# expire the bounce.
962# Old name: expire_bounce() in task_manager.pl.
963sub do_expire_bounce {
964 my $self = shift;
965 my $task = shift;
966 my $line = shift;
967
968 my @tab = @{$line->{Rarguments} || []};
969 my $delay = $tab[0];
970
971 my $all_lists = Sympa::List::get_lists('*');
972 foreach my $list (@{$all_lists || []}) {
973 my $listname = $list->{'name'};
974
975 # the reference date is the date until which we expire bounces in
976 # second
977 # the latest_distribution_date is the date of last distribution #days
978 # from 01 01 1970
979
980 unless ($list->get_latest_distribution_date()) {
981 $log->syslog(
982 'debug2',
983 'Bounce expiration: skipping list %s because could not get latest distribution date',
984 $listname
985 );
986 next;
987 }
988 my $refdate =
989 (($list->get_latest_distribution_date() - $delay) * 3600 * 24);
990
991 for (
992 my $u = $list->get_first_bouncing_list_member();
993 $u;
994 $u = $list->get_next_bouncing_list_member()
995 ) {
996 $u->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
997 $u->{'last_bounce'} = $2;
998 if ($u->{'last_bounce'} < $refdate) {
999 my $email = $u->{'email'};
1000
1001 unless ($list->is_list_member($email)) {
1002 $log->syslog('info', '%s not subscribed', $email);
1003 next;
1004 }
1005
1006 unless (
1007 $list->update_list_member(
1008 $email,
1009 bounce => undef,
1010 bounce_address => undef
1011 )
1012 ) {
1013 $log->syslog('info', 'Failed update database for %s',
1014 $email);
1015 next;
1016 }
1017 my $escaped_email = Sympa::Tools::Text::escape_chars($email);
1018
1019 my $bounce_dir = $list->get_bounce_dir();
1020
1021 unless (unlink $bounce_dir . '/' . $escaped_email) {
1022 $log->syslog(
1023 'info',
1024 'Failed deleting %s',
1025 $bounce_dir . '/' . $escaped_email
1026 );
1027 next;
1028 }
1029 $log->syslog(
1030 'info',
1031 'Expire bounces for subscriber %s of list %s (last distribution %s, last bounce %s)',
1032 $email,
1033 $listname,
1034 POSIX::strftime(
1035 "%Y-%m-%d",
1036 localtime(
1037 $list->get_latest_distribution_date() * 3600 * 24
1038 )
1039 ),
1040 POSIX::strftime(
1041 "%Y-%m-%d", localtime($u->{'last_bounce'})
1042 )
1043 );
1044 }
1045 }
1046 }
1047
1048 # Expiring formatted bounce messages.
1049 if (opendir my $dh, $Conf::Conf{'viewmail_dir'} . '/bounce') {
1050 my $base_dir = $Conf::Conf{'viewmail_dir'} . '/bounce';
1051 my @dirs = grep { !/\A\./ and -d $base_dir . '/' . $_ } readdir $dh;
1052 closedir $dh;
1053 foreach my $list_id (@dirs) {
1054 my $directory = $base_dir . '/' . $list_id;
1055 if (-e $directory) {
1056 _clean_spool($directory, $delay);
1057 }
1058 }
1059 }
1060
1061 return 1;
1062}
1063
1064# Removed because not yet fully implemented. See r11771.
1065#sub chk_cert_expiration;
1066
1067# Removed becuase not yet fully implemented. See r11771.
1068#sub update_crl;
1069
1070## Subroutine for bouncers evaluation:
1071# give a score for each bouncing user
1072# Old name: eval_bouncers() in task_manager.pl.
1073sub do_eval_bouncers {
1074 my $self = shift;
1075 my $task = shift;
1076 my $line = shift;
1077
1078 my $all_lists = Sympa::List::get_lists('*');
1079 foreach my $list (@{$all_lists || []}) {
1080 my $listname = $list->{'name'};
1081 my $list_traffic = {};
1082
1083 $log->syslog('info', '(%s)', $listname);
1084
1085 ## Analizing file Msg-count and fill %$list_traffic
1086 unless (open(COUNT, $list->{'dir'} . '/msg_count')) {
1087 $log->syslog('debug',
1088 '** Could not open msg_count FILE for list %s', $listname);
1089 next;
1090 }
1091 while (<COUNT>) {
1092 if (/^(\w+)\s+(\d+)/) {
1093 my ($a, $b) = ($1, $2);
1094 $list_traffic->{$a} = $b;
1095 }
1096 }
1097 close(COUNT);
1098
1099 #for each bouncing user
1100 for (
1101 my $user_ref = $list->get_first_bouncing_list_member();
1102 $user_ref;
1103 $user_ref = $list->get_next_bouncing_list_member()
1104 ) {
1105 my $score = _get_score($user_ref, $list_traffic) || 0;
1106
1107 # Copying score into database.
1108 unless (
1109 $list->update_list_member(
1110 $user_ref->{'email'}, bounce_score => $score
1111 )
1112 ) {
1113 $log->syslog('err', 'Error while updating DB for user %s',
1114 $user_ref->{'email'});
1115 next;
1116 }
1117 }
1118 }
1119 return 1;
1120}
1121
1122# Routine for automatic bouncing users management
1123#
1124# This sub apply a treatment foreach category of bouncing-users
1125#
1126# The relation between possible actions and correponding subroutines
1127# is indicated by the following hash (%actions).
1128# It's possible to add actions by completing this hash and the one in list
1129# config (file List.pm, in sections "bouncers_levelX"). Then you must write
1130# the code for your action:
1131# The action subroutines have two parameters:
1132# - current list
1133# - a reference on users email list
1134# Look at the _remove_bouncers() for an example.
1135# Old name: process_bouncers() in task_manager.pl.
1136sub do_process_bouncers {
1137 my $self = shift;
1138 my $task = shift;
1139 my $line = shift;
1140
1141 ## possible actions
1142 my %actions = (
1143 'remove_bouncers' => \&_remove_bouncers,
1144 'notify_bouncers' => \&_notify_bouncers,
1145 'none' => sub {1},
1146 );
1147
1148 my $all_lists = Sympa::List::get_lists('*');
1149 foreach my $list (@{$all_lists || []}) {
1150 my @bouncers;
1151 # @bouncers = (
1152 # ['email1', 'email2', 'email3',....,], There is one line
1153 # ['email1', 'email2', 'email3',....,], foreach bounce
1154 # ['email1', 'email2', 'email3',....,], level.
1155 # );
1156
1157 my $max_level;
1158 for (
1159 my $level = 1;
1160 defined($list->{'admin'}{'bouncers_level' . $level});
1161 $level++
1162 ) {
1163 $max_level = $level;
1164 }
1165
1166 ## first, bouncing email are sorted in @bouncer
1167 for (
1168 my $user_ref = $list->get_first_bouncing_list_member();
1169 $user_ref;
1170 $user_ref = $list->get_next_bouncing_list_member()
1171 ) {
1172 # Skip included users (cannot be removed)
1173 next if defined $user_ref->{'inclusion'};
1174
1175 for (my $level = $max_level; ($level >= 1); $level--) {
1176 if ($user_ref->{'bounce_score'} >=
1177 $list->{'admin'}{'bouncers_level' . $level}{'rate'}) {
1178 push(@{$bouncers[$level]}, $user_ref->{'email'});
1179 $level = ($level - $max_level);
1180 }
1181 }
1182 }
1183
1184 ## then, calling action foreach level
1185 for (my $level = $max_level; ($level >= 1); $level--) {
1186 my $action =
1187 $list->{'admin'}{'bouncers_level' . $level}{'action'};
1188 my $notification =
1189 $list->{'admin'}{'bouncers_level' . $level}{'notification'};
1190 my $robot_id = $list->{'domain'};
1191
1192 if (@{$bouncers[$level] || []}) {
1193 ## calling action subroutine with (list,email list) in
1194 ## parameter
1195 unless ($actions{$action}->($list, $bouncers[$level])) {
1196 $log->syslog(
1197 'err',
1198 'Error while calling action sub for bouncing users in list %s',
1199 $list
1200 );
1201 return undef;
1202 }
1203
1204 # Notify owner or listmaster with list, action, email list.
1205 my $param = {
1206 #'listname' => $listname, # No longer used (<=6.1)
1207 'action' => $action,
1208 'user_list' => \@{$bouncers[$level]},
1209 'total' => scalar(@{$bouncers[$level]}),
1210 };
1211 if ($notification eq 'owner') {
1212 $list->send_notify_to_owner('automatic_bounce_management',
1213 $param);
1214 } elsif ($notification eq 'listmaster') {
1215 Sympa::send_notify_to_listmaster($list,
1216 'automatic_bounce_management', $param);
1217 }
1218 }
1219 }
1220 }
1221 return 1;
1222}
1223
1224# Old name: get_score() in task_manager.pl.
1225sub _get_score {
1226
1227 my $user_ref = shift;
1228 my $list_traffic = shift;
1229
1230 $log->syslog('debug', '(%s)', $user_ref->{'email'});
1231
1232 my $min_period = $Conf::Conf{'minimum_bouncing_period'};
1233 my $min_msg_count = $Conf::Conf{'minimum_bouncing_count'};
1234
1235 # Analizing bounce_subscriber_field and keep useful infos for notation
1236 $user_ref->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
1237
1238 my $BO_period = int($1 / 86400) - $Conf::Conf{'bounce_delay'};
1239 my $EO_period = int($2 / 86400) - $Conf::Conf{'bounce_delay'};
1240 my $bounce_count = $3;
1241 my $bounce_type = $4;
1242
1243 my $msg_count = 0;
1244 my $min_day = $EO_period;
1245
1246 unless ($bounce_count >= $min_msg_count) {
1247 #not enough messages distributed to keep score
1248 $log->syslog('debug', 'Not enough messages for evaluation of user %s',
1249 $user_ref->{'email'});
1250 return undef;
1251 }
1252
1253 unless (($EO_period - $BO_period) >= $min_period) {
1254 #too short bounce period to keep score
1255 $log->syslog('debug', 'Too short period for evaluate %s',
1256 $user_ref->{'email'});
1257 return undef;
1258 }
1259
1260 # calculate number of messages distributed in list while user was bouncing
1261 foreach my $date (sort { $b <=> $a } keys(%$list_traffic)) {
1262 if (($date >= $BO_period) && ($date <= $EO_period)) {
1263 $min_day = $date;
1264 $msg_count += $list_traffic->{$date};
1265 }
1266 }
1267
1268 # Adjust bounce_count when msg_count file is too recent, compared to the
1269 # bouncing period
1270 my $tmp_bounce_count = $bounce_count;
1271 unless ($EO_period == $BO_period) {
1272 my $ratio = (($EO_period - $min_day) / ($EO_period - $BO_period));
1273 $tmp_bounce_count *= $ratio;
1274 }
1275
1276 ## Regularity rate tells how much user has bounced compared to list
1277 ## traffic
1278 $msg_count ||= 1; ## Prevents "Illegal division by zero" error
1279 my $regularity_rate = $tmp_bounce_count / $msg_count;
1280
1281 ## type rate depends on bounce type (5 = permanent ; 4 =tewmporary)
1282 my $type_rate = 1;
1283 $bounce_type =~ /(\d)\.(\d)\.(\d)/;
1284 if ($1 == 4) { # if its a temporary Error: score = score/2
1285 $type_rate = .5;
1286 }
1287
1288 my $note = $bounce_count * $regularity_rate * $type_rate;
1289
1290 ## Note should be an integer
1291 $note = int($note + 0.5);
1292
1293# $note = 100 if ($note > 100); # shift between message ditrib & bounces =>
1294# note > 100
1295
1296 return $note;
1297}
1298
1299# Sub for removing user
1300# Old name: Sympa::List::remove_bouncers().
1301sub _remove_bouncers {
1302 $log->syslog('debug2', '(%s, %s)', @_);
1303 my $list = shift;
1304 my $users = shift;
1305
1306 foreach my $u (@{$users || []}) {
1307 $log->syslog('notice', 'Removing bouncing subsrciber of list %s: %s',
1308 $list, $u);
1309 }
1310 $list->delete_list_member(
1311 users => $users,
1312 exclude => '1',
1313 operation => 'auto_del'
1314 );
1315 return 1;
1316}
1317
1318# Sub for notifying users: "Be careful, you're bouncing".
1319# Old name: Sympa::List::notify_bouncers().
1320sub _notify_bouncers {
1321 $log->syslog('debug2', '(%s, %s)', @_);
1322 my $list = shift;
1323 my $users = shift;
1324
1325 foreach my $u (@{$users || []}) {
1326 $log->syslog('notice', 'Notifying bouncing subsrciber of list %s: %s',
1327 $list, $u);
1328 Sympa::send_notify_to_user($list, 'auto_notify_bouncers', $u);
1329 }
1330 return 1;
1331}
1332
1333# Old name: none() in task_manager.pl.
1334# No longer used.
1335#sub _none;
1336
1337# Old name: sync_include() in task_manager.pl.
1338sub do_sync_include {
1339 my $self = shift;
1340 my $task = shift;
1341 my $line = shift;
1342
1343 my $list = $task->{context};
1344 unless (ref $list eq 'Sympa::List') {
1345 $log->syslog('err', 'No list');
1346 return -1;
1347 }
1348
1349 $list->sync_include('member');
1350 $list->sync_include('owner');
1351 $list->sync_include('editor');
1352
1353 unless ($list->has_data_sources or $list->has_included_users) {
1354 $log->syslog('debug', 'List %s no more require sync_include task',
1355 $list);
1356 return -1;
1357 }
1358}
1359
1360### MISCELLANEOUS SUBROUTINES ###
1361
1362## change the label of a task file
1363# Old name: change_label() in task_manager.pl.
1364# No onger used.
1365#sub _change_label;
1366
1367## send a error message to list-master, log it, and change the label task into
1368## 'ERROR'
1369sub _error {
1370 my $task = shift;
1371 my $message = shift;
1372
1373 my @param = (
1374 sprintf
1375 'An error has occurred during the execution of the task %s: %s',
1376 $task->get_id, $message
1377 );
1378 $log->syslog('err', '%s', $message);
1379 #FIXME: Coresponding mail template would be added.
1380 Sympa::send_notify_to_listmaster('*', 'error_in_task', \@param);
1381}
1382
13831;
1384__END__
 
# spent 2µs within Sympa::Spindle::ProcessTask::_distaff which was called 2 times, avg 1µs/call: # once (1µs+0s) by Sympa::Spindle::new at line 42 of /usr/local/libexec/sympa/Sympa/Spindle.pm # once (600ns+0s) by Sympa::Spindle::new at line 41 of /usr/local/libexec/sympa/Sympa/Spindle.pm
sub Sympa::Spindle::ProcessTask::_distaff; # xsub