← 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:15 2021

Filename/usr/local/libexec/sympa/Sympa/Tracking.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSympa::Tracking::::BEGIN@30Sympa::Tracking::BEGIN@30
0000s0sSympa::Tracking::::BEGIN@31Sympa::Tracking::BEGIN@31
0000s0sSympa::Tracking::::BEGIN@32Sympa::Tracking::BEGIN@32
0000s0sSympa::Tracking::::BEGIN@33Sympa::Tracking::BEGIN@33
0000s0sSympa::Tracking::::BEGIN@35Sympa::Tracking::BEGIN@35
0000s0sSympa::Tracking::::BEGIN@36Sympa::Tracking::BEGIN@36
0000s0sSympa::Tracking::::BEGIN@37Sympa::Tracking::BEGIN@37
0000s0sSympa::Tracking::::BEGIN@38Sympa::Tracking::BEGIN@38
0000s0sSympa::Tracking::::BEGIN@39Sympa::Tracking::BEGIN@39
0000s0sSympa::Tracking::::BEGIN@40Sympa::Tracking::BEGIN@40
0000s0sSympa::Tracking::::__ANON__Sympa::Tracking::__ANON__ (xsub)
0000s0sSympa::Tracking::::_create_spoolSympa::Tracking::_create_spool
0000s0sSympa::Tracking::::_db_insert_notificationSympa::Tracking::_db_insert_notification
0000s0sSympa::Tracking::::_update_subscriber_bounce_historySympa::Tracking::_update_subscriber_bounce_history
0000s0sSympa::Tracking::::db_fetchSympa::Tracking::db_fetch
0000s0sSympa::Tracking::::find_notification_id_by_messageSympa::Tracking::find_notification_id_by_message
0000s0sSympa::Tracking::::get_recipients_statusSympa::Tracking::get_recipients_status
0000s0sSympa::Tracking::::newSympa::Tracking::new
0000s0sSympa::Tracking::::registerSympa::Tracking::register
0000s0sSympa::Tracking::::remove_message_by_emailSympa::Tracking::remove_message_by_email
0000s0sSympa::Tracking::::remove_message_by_idSympa::Tracking::remove_message_by_id
0000s0sSympa::Tracking::::remove_message_by_periodSympa::Tracking::remove_message_by_period
0000s0sSympa::Tracking::::storeSympa::Tracking::store
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 (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level
12# directory of this distribution and at
13# <https://github.com/sympa-community/sympa.git>.
14#
15# This program is free software; you can redistribute it and/or modify
16# it under the terms of the GNU General Public License as published by
17# the Free Software Foundation; either version 2 of the License, or
18# (at your option) any later version.
19#
20# This program is distributed in the hope that it will be useful,
21# but WITHOUT ANY WARRANTY; without even the implied warranty of
22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23# GNU General Public License for more details.
24#
25# You should have received a copy of the GNU General Public License
26# along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28package Sympa::Tracking;
29
30use strict;
31use warnings;
32use DateTime::Format::Mail;
33use English qw(-no_match_vars);
34
35use Conf;
36use Sympa::Constants;
37use Sympa::DatabaseManager;
38use Sympa::Log;
39use Sympa::Tools::File;
40use Sympa::Tools::Text;
41
42my $log = Sympa::Log->instance;
43
44sub new {
45 my $class = shift;
46
47 my $list;
48 if (ref $_[0]) { # Compat., not recommended.
49 $list = shift;
50 } else {
51 my %options = @_;
52 $list = $options{context};
53 }
54
55 die 'Bug in logic. Ask developer'
56 unless ref $list eq 'Sympa::List';
57
58 my $self = bless {
59 directory => $list->get_bounce_dir,
60 context => $list,
61 } => $class;
62
63 $self->_create_spool;
64
65 return $self;
66}
67
68sub _create_spool {
69 my $self = shift;
70
71 my $umask = umask oct $Conf::Conf{'umask'};
72 foreach my $directory (($self->{directory})) {
73 unless (-d $directory) {
74 $log->syslog('info', 'Creating spool %s', $directory);
75 unless (
76 mkdir($directory, 0755)
77 and Sympa::Tools::File::set_file_rights(
78 file => $directory,
79 user => Sympa::Constants::USER(),
80 group => Sympa::Constants::GROUP()
81 )
82 ) {
83 die sprintf 'Cannot create %s: %s', $directory, $ERRNO;
84 }
85 }
86 }
87 umask $umask;
88}
89
90##############################################
91# get_recipients_status
92##############################################
93# Function use to get mail addresses and status of
94# the recipients who have a different DSN status than "delivered"
95# Use the pk identifiant of the mail
96#
97# -$pk_mail (+): the identifiant of the stored mail
98#
99# OUT : @pk_notifs |undef
100#
101##############################################
102sub get_recipients_status {
103 $log->syslog('debug2', '(%s, %s, %s)', @_);
104 my $msgid = shift;
105 my $listname = shift;
106 my $robot = shift;
107
108 $msgid = Sympa::Tools::Text::canonic_message_id($msgid);
109
110 my $sth;
111 my $sdm = Sympa::DatabaseManager->instance;
112
113 # the message->head method return message-id including <blabla@dom> where
114 # mhonarc return blabla@dom that's why we test both of them
115 unless (
116 $sdm
117 and $sth = $sdm->do_prepared_query(
118 q{SELECT message_id_notification AS message_id,
119 recipient_notification AS recipient,
120 reception_option_notification AS reception_option,
121 status_notification AS status,
122 arrival_date_notification AS arrival_date,
123 arrival_epoch_notification AS arrival_epoch,
124 type_notification AS "type",
125 pk_notification AS envid
126 FROM notification_table
127 WHERE list_notification = ? AND robot_notification = ? AND
128 (message_id_notification = ? OR
129 message_id_notification = ?)},
130 $listname, $robot,
131 $msgid,
132 '<' . $msgid . '>'
133 )
134 ) {
135 $log->syslog(
136 'err',
137 'Unable to retrieve tracking information for message %s, list %s@%s',
138 $msgid,
139 $listname,
140 $robot
141 );
142 return undef;
143 }
144 my @pk_notifs;
145 while (my $pk_notif = $sth->fetchrow_hashref) {
146 push @pk_notifs, $pk_notif;
147 }
148 $sth->finish;
149
150 return \@pk_notifs;
151}
152
153sub db_fetch {
154 my $self = shift;
155 my %options = @_;
156
157 my $list = $self->{context};
158
159 my $recipient = $options{recipient};
160 my $envid = $options{envid};
161 return undef unless $recipient and $envid;
162
163 my $sth;
164 my $sdm = Sympa::DatabaseManager->instance;
165
166 unless (
167 $sdm
168 and $sth = $sdm->do_prepared_query(
169 q{SELECT message_id_notification AS message_id,
170 recipient_notification AS recipient,
171 reception_option_notification AS reception_option,
172 status_notification AS status,
173 arrival_date_notification AS arrival_date,
174 arrival_epoch_notification AS arrival_epoch,
175 type_notification AS "type",
176 pk_notification AS envid
177 FROM notification_table
178 WHERE list_notification = ? AND robot_notification = ? AND
179 recipient_notification = ? AND pk_notification = ?},
180 $list->{'name'}, $list->{'domain'},
181 $recipient, $envid
182 )
183 ) {
184 $log->syslog(
185 'err',
186 'Unable to retrieve tracking information for message %s, list %s',
187 $recipient,
188 $list
189 );
190 return undef;
191 }
192 my $pk_notif = $sth->fetchrow_hashref;
193 $sth->finish;
194
195 return $pk_notif;
196}
197
198# Old name: Sympa::Tracking::db_init_notification_table()
199sub register {
200 my $self = shift;
201 my $message = shift;
202 my $rcpt = shift;
203 my %params = @_;
204
205 # What ever the message is transformed because of the reception option,
206 # tracking use the original message ID.
207 my $msgid = $message->{message_id};
208 my $listname = $self->{context}->{'name'};
209 my $robot = $self->{context}->{'domain'};
210 my $reception_option = $params{'reception_option'};
211 my @rcpt = @{$rcpt || []};
212
213 $log->syslog('debug2',
214 '(msgid = %s, listname = %s, reception_option = %s',
215 $msgid, $listname, $reception_option);
216
217 my $time = time;
218
219 my $sdm = Sympa::DatabaseManager->instance;
220 foreach my $email (@rcpt) {
221 my $email = lc($email);
222
223 unless (
224 $sdm
225 and $sdm->do_prepared_query(
226 q{INSERT INTO notification_table
227 (message_id_notification, recipient_notification,
228 reception_option_notification,
229 list_notification, robot_notification, date_notification)
230 VALUES (?, ?, ?, ?, ?, ?)},
231 $msgid, $email, $reception_option, $listname, $robot, $time
232 )
233 ) {
234 $log->syslog(
235 'err',
236 'Unable to prepare notification table for user %s, message %s, list %s@%s',
237 $email,
238 $msgid,
239 $listname,
240 $robot
241 );
242 return undef;
243 }
244 }
245 return 1;
246}
247
248# copy the bounce to the appropriate filename
249# Old name: store_bounce() in bounced.pl
250sub store {
251 $log->syslog('debug2', '(%s, %s, %s, %s, ...)', @_);
252 my $self = shift;
253 my $message = shift;
254 my $rcpt = shift;
255 my %options = @_;
256
257 my $bounce_dir = $self->{directory};
258
259 # Store bounce
260 my $ofh;
261
262 my $filename;
263 if (defined $options{envid} and length $options{envid}) {
264 unless (_db_insert_notification($rcpt, %options)) {
265 return undef;
266 }
267 $filename = sprintf '%s_%08s',
268 Sympa::Tools::Text::escape_chars($rcpt),
269 $options{envid};
270 } else {
271 unless (
272 $self->_update_subscriber_bounce_history($rcpt, $options{status}))
273 {
274 $log->syslog('err', 'No user %s to be updated in list %s',
275 $rcpt, $self->{context});
276 return undef;
277 }
278 $filename = Sympa::Tools::Text::escape_chars($rcpt);
279 }
280 unless (open $ofh, '>', $bounce_dir . '/' . $filename) {
281 $log->syslog('err', 'Unable to write %s/%s', $bounce_dir, $filename);
282 return undef;
283 }
284 print $ofh $message->as_string;
285 close $ofh;
286
287 $log->syslog('notice', '%s is stored into %s as <%s>',
288 $message, $self, $filename);
289
290 # Remove earlier HTML view.
291 Sympa::Tools::File::remove_dir(
292 join('/',
293 $Conf::Conf{'viewmail_dir'}, 'bounce',
294 $self->{context}->get_id, $filename)
295 );
296
297 return $filename;
298}
299
300##############################################
301# _db_insert_notification
302##############################################
303# Function used to add a notification entry
304# corresponding to a new report. This function
305# is called when a report has been received.
306# It build a new connection with the database
307# using the default database parameter. Then it
308# search the notification entry identifiant which
309# correspond to the received report. Finally it
310# update the recipient entry concerned by the report.
311#
312# IN :-$rcpt (+): original recipient of the initial mail
313# -$id (+): the identifiant entry of the initial mail
314# -$type (+): the notification entry type (DSN|MDN)
315# -$recipient (+): the list subscriber who correspond to this entry
316# -$status (+): the new state of the recipient entry depending of the
317# report data
318# -$arrival_date (+): the mail arrival date.
319#
320# OUT : 1 | undef
321#
322##############################################
323sub _db_insert_notification {
324 $log->syslog('debug3', '(%s, %s => %s, %s => %s, %s => %s, %s => %s)',
325 @_);
326 my $rcpt = shift;
327 my %options = @_;
328
329 my ($notification_id, $type, $status, $arrival_date) =
330 @options{qw(envid type status arrival_date)};
331 chomp $arrival_date;
332 my $arrival_epoch = eval {
333 DateTime::Format::Mail->new->loose->parse_datetime($arrival_date)
334 ->epoch;
335 };
336
337 my $sdm = Sympa::DatabaseManager->instance;
338 my $sth;
339
340 unless (
341 $sdm
342 and $sth = $sdm->do_prepared_query(
343 q{UPDATE notification_table
344 SET status_notification = ?, type_notification = ?,
345 arrival_date_notification = ?,
346 arrival_epoch_notification = ?
347 WHERE recipient_notification = ? AND pk_notification = ?},
348 $status, $type,
349 $arrival_date,
350 $arrival_epoch,
351 $rcpt, $notification_id
352 )
353 ) {
354 $log->syslog('err', 'Unable to update notification <%s> in database',
355 $notification_id);
356 return undef;
357 }
358 # Unknown combination of rcpt and envid.
359 unless ($sth->rows) {
360 $log->syslog('err', 'No notification <%s> for <%s> to be updated',
361 $rcpt, $notification_id);
362 return 0;
363 }
364
365 return 1;
366}
367
368# update subscriber information
369# $bouncefor : the email address the bounce is related for (may be extracted
370# using VERP)
371# $status : delivery status in format /\d+[.]\d+[.]\d+/.
372# Old name: _update_subscriber_bounce_history() in bounced.pl.
373sub _update_subscriber_bounce_history {
374 $log->syslog('debug', '(%s, %s, %s, %s)', @_);
375 my $self = shift;
376 my $bouncefor = shift;
377 my $status = shift || '';
378
379 if ($status =~ /(\d+[.]\d+[.]\d+)/) {
380 $status = $1;
381 } else {
382 $status = '';
383 }
384
385 my $user = $self->{context}->get_list_member($bouncefor);
386 return undef unless $user;
387
388 if ($status =~ /\A[45]/) {
389 my ($first, $last, $count);
390
391 $last = time;
392 if ( $user->{'bounce'}
393 and $user->{'bounce'} =~ /^(\d+)\s\d+\s+(\d+)/) {
394 ($first, $count) = ($1, $2);
395 } else {
396 ($first, $count) = ($last, 0);
397 }
398 $count++;
399
400 $self->{context}->update_list_member($bouncefor,
401 bounce => sprintf('%s %s %s %s', $first, $last, $count, $status));
402 }
403 return 1;
404}
405
406##############################################
407# find_notification_id_by_message
408##############################################
409# return the tracking_id find by recipeint,message-id,listname and robot
410# tracking_id areinitialized by sympa.pl by Sympa::List::distribute_msg
411#
412# used by bulk.pl in order to set return_path when tracking is required.
413#
414##############################################
415
416sub find_notification_id_by_message {
417 $log->syslog('debug2', '(%s, %s, %s, %s)', @_);
418 my $recipient = shift;
419 my $msgid = shift;
420 my $listname = shift;
421 my $robot = shift;
422
423 $msgid = Sympa::Tools::Text::canonic_message_id($msgid);
424
425 my $sth;
426 my $sdm = Sympa::DatabaseManager->instance;
427
428 # the message->head method return message-id including <blabla@dom> where
429 # mhonarc return blabla@dom that's why we test both of them
430 unless (
431 $sdm
432 and $sth = $sdm->do_prepared_query(
433 q{SELECT pk_notification
434 FROM notification_table
435 WHERE recipient_notification = ? AND
436 list_notification = ? AND robot_notification = ? AND
437 (message_id_notification = ? OR
438 message_id_notification = ?)},
439 $recipient,
440 $listname, $robot,
441 $msgid,
442 '<' . $msgid . '>'
443 )
444 ) {
445 $log->syslog(
446 'err',
447 'Unable to retrieve the tracking information for user %s, message %s, list %s@%s',
448 $recipient,
449 $msgid,
450 $listname,
451 $robot
452 );
453 return undef;
454 }
455
456 my @pk_notifications = $sth->fetchrow_array;
457 $sth->finish;
458
459 if (scalar @pk_notifications > 1) {
460 $log->syslog(
461 'err',
462 'Found more then one envelope ID maching (recipient=%s, msgis=%s, listname=%s, robot%s)',
463 $recipient,
464 $msgid,
465 $listname,
466 $robot
467 );
468 # we should return undef...
469 }
470 return $pk_notifications[0];
471}
472
473sub remove_message_by_email {
474 $log->syslog('debug2', '(%s, %s)', @_);
475 my $self = shift;
476 my $email = shift;
477
478 $email = Sympa::Tools::Text::canonic_email($email);
479 return undef unless $email;
480
481 my $bounce_dir = $self->{directory};
482 my $escaped_email = Sympa::Tools::Text::escape_chars($email);
483 my $ret = unlink sprintf('%s/%s', $bounce_dir, $escaped_email);
484
485 # Remove HTML view.
486 Sympa::Tools::File::remove_dir(
487 join('/',
488 $Conf::Conf{'viewmail_dir'}, 'bounce',
489 $self->{context}->get_id, $escaped_email)
490 );
491
492 return $ret;
493}
494
495##############################################
496# remove_message_by_id
497##############################################
498# Function use to remove notifications
499#
500# IN : $msgid : id of related message
501# : $listname
502# : $robot
503#
504# OUT : $sth | undef
505#
506##############################################
507sub remove_message_by_id {
508 $log->syslog('debug2', '(%s, %s, %s)', @_);
509 my $self = shift;
510 my $msgid = shift;
511
512 my $listname = $self->{context}->{'name'};
513 my $robot = $self->{context}->{'domain'};
514
515 my $sth;
516 my $sdm = Sympa::DatabaseManager->instance;
517
518 # Remove messages in bounce directory.
519 unless (
520 $sdm
521 and $sth = $sdm->do_prepared_query(
522 q{SELECT recipient_notification AS recipient,
523 pk_notification AS envid
524 FROM notification_table
525 WHERE message_id_notification = ? AND
526 list_notification = ? AND robot_notification = ?},
527 $msgid,
528 $listname, $robot
529 )
530 ) {
531 $log->syslog(
532 'err',
533 'Unable to search tracking information for message %s, list %s@%s',
534 $msgid,
535 $listname,
536 $robot
537 );
538 return undef;
539 }
540 while (my $info = $sth->fetchrow_hashref('NAME_lc')) {
541 my $bounce_dir = $self->{directory};
542 my $escaped_email =
543 Sympa::Tools::Text::escape_chars($info->{'recipient'});
544 my $envid = $info->{'envid'};
545 unlink sprintf('%s/%s_%08s', $bounce_dir, $escaped_email, $envid);
546 }
547 $sth->finish;
548
549 # Remove row in notification table.
550 unless (
551 $sth = $sdm->do_prepared_query(
552 q{DELETE FROM notification_table
553 WHERE message_id_notification = ? AND
554 list_notification = ? AND robot_notification = ?},
555 $msgid,
556 $listname, $robot
557 )
558 ) {
559 $log->syslog(
560 'err',
561 'Unable to remove the tracking information for message %s, list %s@%s',
562 $msgid,
563 $listname,
564 $robot
565 );
566 return undef;
567 }
568
569 return 1;
570}
571
572##############################################
573# remove_message_by_period
574##############################################
575# Function use to remove notifications older than number of days
576#
577# IN : $period
578# : $listname
579# : $robot
580#
581# OUT : $sth | undef
582#
583##############################################
584sub remove_message_by_period {
585 $log->syslog('debug2', '(%s, %s, %s)', @_);
586 my $self = shift;
587 my $period = shift;
588
589 my $listname = $self->{context}->{'name'};
590 my $robot = $self->{context}->{'domain'};
591
592 my $sth;
593
594 my $limit = time - ($period * 24 * 60 * 60);
595
596 # Remove messages in bounce directory.
597 my $sdm = Sympa::DatabaseManager->instance;
598 unless (
599 $sdm
600 and $sth = $sdm->do_prepared_query(
601 q{SELECT recipient_notification AS recipient,
602 pk_notification AS envid
603 FROM notification_table
604 WHERE date_notification < ? AND
605 list_notification = ? AND robot_notification = ?},
606 $limit,
607 $listname, $robot
608 )
609 ) {
610 $log->syslog(
611 'err',
612 'Unable to search tracking information for older than %s days for list %s@%s',
613 $limit,
614 $listname,
615 $robot
616 );
617 return undef;
618 }
619 while (my $info = $sth->fetchrow_hashref('NAME_lc')) {
620 my $bounce_dir = $self->{directory};
621 my $escaped_email =
622 Sympa::Tools::Text::escape_chars($info->{'recipient'});
623 my $envid = $info->{'envid'};
624 unlink sprintf('%s/%s_%08s', $bounce_dir, $escaped_email, $envid);
625 }
626 $sth->finish;
627
628 # Remove rows in notification table.
629 unless (
630 $sth = $sdm->do_prepared_query(
631 q{DELETE FROM notification_table
632 WHERE date_notification < ? AND
633 list_notification = ? AND robot_notification = ?},
634 $limit,
635 $listname, $robot
636 )
637 ) {
638 $log->syslog(
639 'err',
640 'Unable to remove the tracking information older than %s days for list %s@%s',
641 $limit,
642 $listname,
643 $robot
644 );
645 return undef;
646 }
647
648 my $deleted = $sth->rows;
649 return $deleted;
650}
651
6521;
653__END__