← 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/Process.pm
StatementsExecuted 42 statements in 642µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11118.1ms18.2msSympa::Process::::daemonizeSympa::Process::daemonize
111277µs2.53msSympa::Process::::write_pidSympa::Process::write_pid
11165µs65µsSympa::Process::::CORE:openSympa::Process::CORE:open (opcode)
22144µs44µsSympa::Process::::CORE:unlinkSympa::Process::CORE:unlink (opcode)
11137µs487µsSympa::Process::::remove_pidSympa::Process::remove_pid
11126µs219µsSympa::Process::::direct_stderr_to_fileSympa::Process::direct_stderr_to_file
11123µs23µsSympa::Process::::CORE:ftdirSympa::Process::CORE:ftdir (opcode)
11121µs21µsSympa::Process::::CORE:truncateSympa::Process::CORE:truncate (opcode)
11111µs11µsSympa::Process::::CORE:ftsizeSympa::Process::CORE:ftsize (opcode)
1118µs8µsSympa::Process::::CORE:ftfileSympa::Process::CORE:ftfile (opcode)
1116µs6µsSympa::Process::::CORE:seekSympa::Process::CORE:seek (opcode)
1111µs1µsSympa::Process::::CORE:printSympa::Process::CORE:print (opcode)
0000s0sSympa::Process::::BEGIN@27Sympa::Process::BEGIN@27
0000s0sSympa::Process::::BEGIN@28Sympa::Process::BEGIN@28
0000s0sSympa::Process::::BEGIN@29Sympa::Process::BEGIN@29
0000s0sSympa::Process::::BEGIN@30Sympa::Process::BEGIN@30
0000s0sSympa::Process::::BEGIN@31Sympa::Process::BEGIN@31
0000s0sSympa::Process::::BEGIN@33Sympa::Process::BEGIN@33
0000s0sSympa::Process::::BEGIN@34Sympa::Process::BEGIN@34
0000s0sSympa::Process::::BEGIN@35Sympa::Process::BEGIN@35
0000s0sSympa::Process::::BEGIN@36Sympa::Process::BEGIN@36
0000s0sSympa::Process::::BEGIN@37Sympa::Process::BEGIN@37
0000s0sSympa::Process::::BEGIN@38Sympa::Process::BEGIN@38
0000s0sSympa::Process::::BEGIN@39Sympa::Process::BEGIN@39
0000s0sSympa::Process::::BEGIN@41Sympa::Process::BEGIN@41
0000s0sSympa::Process::::BEGIN@43Sympa::Process::BEGIN@43
0000s0sSympa::Process::::CORE:closeSympa::Process::CORE:close (opcode)
0000s0sSympa::Process::::CORE:ioctlSympa::Process::CORE:ioctl (opcode)
0000s0sSympa::Process::::CORE:sortSympa::Process::CORE:sort (opcode)
0000s0sSympa::Process::::INITSympa::Process::INIT
0000s0sSympa::Process::::__ANON__Sympa::Process::__ANON__ (xsub)
0000s0sSympa::Process::::__ANON__[:474]Sympa::Process::__ANON__[:474]
0000s0sSympa::Process::::_child_handlerSympa::Process::_child_handler
0000s0sSympa::Process::::_get_pids_in_pid_fileSympa::Process::_get_pids_in_pid_file
0000s0sSympa::Process::::_new_instanceSympa::Process::_new_instance
0000s0sSympa::Process::::_reap_childSympa::Process::_reap_child
0000s0sSympa::Process::::_send_crash_reportSympa::Process::_send_crash_report
0000s0sSympa::Process::::eval_in_timeSympa::Process::eval_in_time
0000s0sSympa::Process::::forkSympa::Process::fork
0000s0sSympa::Process::::initSympa::Process::init
0000s0sSympa::Process::::register_handlerSympa::Process::register_handler
0000s0sSympa::Process::::sync_childSympa::Process::sync_child
0000s0sSympa::Process::::wait_childSympa::Process::wait_child
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#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program. If not, see <http://www.gnu.org/licenses/>.
24
25package Sympa::Process;
26
27use strict;
28use warnings;
29use Config qw();
30use English qw(-no_match_vars);
31use POSIX qw();
32
33use Conf;
34use Sympa;
35use Sympa::Constants;
36use Sympa::Language;
37use Sympa::LockedFile;
38use Sympa::Log;
39use Sympa::Tools::File;
40
41use base qw(Class::Singleton);
42
43BEGIN {
44 # Check compliance to POSIX.
45 die 'Safe signal is not provided'
46 unless $Config::Config{d_sigaction};
47 die 'Non-blocking wait is not supported'
48 unless $Config::Config{d_waitpid}
49 or $Config::Config{d_wait4};
50}
51
52INIT {
53 register_handler();
54}
55
56my $log = Sympa::Log->instance;
57
58# Constructor for Class::Singleton.
59sub _new_instance {
60 my $class = shift;
61
62 bless {
63 children => {},
64 detached => 0,
65 generation => 0,
66 } => $class;
67}
68
69sub init {
70 my $self = shift;
71 my %options = @_;
72
73 foreach my $key (sort keys %options) {
74 $self->{$key} = $options{$key};
75 }
76 $self->{name} ||= $self->{pidname} || [split /\//, $PROGRAM_NAME]->[-1];
77 $self;
78}
79
80# Put ourselves in background. That method works on many systems, although,
81# it seems that Unix conceptors have decided that there won't be a single and
82# easy way to detach a process from its controlling TTY.
83
# spent 18.2ms (18.1+104µs) within Sympa::Process::daemonize which was called: # once (18.1ms+104µs) by main::RUNTIME at line 102 of /usr/local/libexec/sympa/task_manager-debug.pl
sub daemonize {
84 my $self = shift;
85
86 if (open my $tty, '/dev/tty') {
87 ioctl $tty, 0x20007471, 0; # XXX s/b TIOCNOTTY()
88 close $tty;
89 }
90 open STDIN, '<', '/dev/null';
91 open STDOUT, '>>', '/dev/null';
92 open STDERR, '>>', '/dev/null';
93
94 setpgrp 0, 0;
95
96 my $child_pid = CORE::fork();
971137µs if ($child_pid) {
98 $log->syslog('notice', 'Starting %s daemon, PID %d',
99 $self->{name}, $child_pid);
100 exit 0;
101 } elsif (not defined $child_pid) {
102 die sprintf 'Cannot fork %s daemon: %s', $self->{name}, $ERRNO;
103 } else {
10414µs $self->{detached} = 1;
105 }
106}
107
108sub fork {
109 my $self = shift;
110 my $tag = shift || [split /\//, $PROGRAM_NAME]->[-1];
111
112 my $pid = CORE::fork();
113 unless (defined $pid) {
114 ;
115 } elsif ($pid) {
116 $self->{children}->{$pid} = $tag;
117 } else {
118 $self->{children} = {};
119 $self->{generation}++;
120 }
121 $pid;
122}
123
124# Old name: (part of) Sympa::Mailer::reaper().
125sub wait_child {
126 my $self = shift;
127
128 my $pid;
129
130 my $nohang = 0;
131 while (0 < ($pid = waitpid(-1, $nohang))) {
132 $nohang = POSIX::WNOHANG();
133 $self->_reap_child($pid);
134 }
135 $log->syslog(
136 'debug3',
137 'Reaper unwaited PIDs: %s Open = %s',
138 join(' ', sort { $a <=> $b } keys %{$self->{children}}),
139 scalar keys %{$self->{children}}
140 );
141
142 return $pid;
143}
144
145sub register_handler {
146 $SIG{CHLD} = \&_child_handler;
147 $SIG{PIPE} = 'IGNORE';
148}
149
150sub _child_handler {
151 # Don't change $! and $? outside handler.
152 local ($ERRNO, $CHILD_ERROR);
153
154 # Reap only children registered by fork().
155 my $self = __PACKAGE__->instance;
156 foreach my $pid (keys %{$self->{children}}) {
157 next unless 0 < waitpid($pid, POSIX::WNOHANG());
158 $self->_reap_child($pid);
159 }
160
161 # For SysV signal(2).
162 $SIG{CHLD} = \&_child_handler;
163}
164
165sub _reap_child {
166 my $self = shift;
167 my $pid = shift;
168
169 my $for =
170 (exists $self->{children}->{$pid})
171 ? $self->{children}->{$pid}
172 : 'unknown';
173 if ($CHILD_ERROR & 127) {
174 $log->syslog('err',
175 'Child process %s for <%s> was terminated by signal %d',
176 $pid, $for, $CHILD_ERROR & 127);
177 } elsif ($CHILD_ERROR) {
178 $log->syslog('err', 'Child process %s for <%s> exited with status %s',
179 $pid, $for, $CHILD_ERROR >> 8);
180 } else {
181 $log->syslog('debug2', 'Child process %s for <%s> exited normally',
182 $pid, $for);
183 }
184 delete $self->{children}->{$pid};
185}
186
187sub sync_child {
188 my $self = shift;
189 my %options = @_;
190
191 if ($options{hash}) {
192 my $hash = $options{hash};
193 foreach my $child_pid (keys %$hash) {
194 next
195 if exists $self->{children}->{$child_pid}
196 and kill 0, $child_pid;
197 delete $hash->{$child_pid};
198 }
199 }
200
201 if ($self->{pidname} and $options{file}) {
202 foreach my $child_pid (_get_pids_in_pid_file($self->{pidname})) {
203 next if $child_pid == $PID;
204
205 next
206 if exists $self->{children}->{$child_pid}
207 and kill 0, $child_pid;
208
209 $log->syslog(
210 'err',
211 'The %s child exists in the PID file but is no longer running. Removing it and notifying listmaster',
212 $child_pid
213 );
214 $self->remove_pid(pid => $child_pid);
215 _send_crash_report($child_pid);
216 }
217 }
218}
219
220# Moved to Log::_daemon_name().
221#sub get_daemon_name;
222
223# Old name: Sympa::Tools::Daemon::remove_pid().
224
# spent 487µs (37+450) within Sympa::Process::remove_pid which was called: # once (37µs+450µs) by main::RUNTIME at line 160 of /usr/local/libexec/sympa/task_manager-debug.pl
sub remove_pid {
2251800ns my $self = shift;
22611µs my %options = @_;
227
228 my $name = $self->{pidname}
22911µs or die 'bug in logic. Ask developer';
23011µs my $pid = $options{pid} || $PID;
231
2321700ns my $piddir = Sympa::Constants::PIDDIR;
2331900ns my $pidfile = $piddir . '/' . $name . '.pid';
234
2351500ns my @pids;
236
237 # Lock pid file
23813µs1303µs my $lock_fh = Sympa::LockedFile->new($pidfile, 5, '+<');
# spent 303µs making 1 call to IO::File::new
2391900ns unless ($lock_fh) {
240 $log->syslog('err', 'Could not open %s to remove PID %s',
241 $pidfile, $pid);
242 return undef;
243 }
244
245 ## If in multi_process mode (bulk.pl for instance can have child
246 ## processes) then the PID file contains a list of space-separated PIDs
247 ## on a single line
24811µs unless ($options{final}) {
249 # Read pid file
250 seek $lock_fh, 0, 0;
251 my $l = <$lock_fh>;
252 @pids = grep { /^[0-9]+$/ and $_ != $pid } split(/\s+/, $l);
253
254 ## If no PID left, then remove the file
255 unless (@pids) {
256 ## Release the lock
257 unless (unlink $pidfile) {
258 $log->syslog('err', "Failed to remove %s: %m", $pidfile);
259 $lock_fh->close;
260 return undef;
261 }
262 } else {
263 seek $lock_fh, 0, 0;
264 truncate $lock_fh, 0;
265 print $lock_fh join(' ', @pids) . "\n";
266 }
267 } else {
268124µs118µs unless (unlink $pidfile) {
# spent 18µs making 1 call to Sympa::Process::CORE:unlink
269 $log->syslog('err', "Failed to remove %s: %m", $pidfile);
270 $lock_fh->close;
271 return undef;
272 }
27312µs my $err_file = $Conf::Conf{'tmpdir'} . '/' . $pid . '.stderr';
274112µs18µs if (-f $err_file) {
# spent 8µs making 1 call to Sympa::Process::CORE:ftfile
275128µs126µs unless (unlink $err_file) {
# spent 26µs making 1 call to Sympa::Process::CORE:unlink
276 $log->syslog('err', "Failed to remove %s: %m", $err_file);
277 $lock_fh->close;
278 return undef;
279 }
280 }
281 }
282
28312µs194µs $lock_fh->close;
# spent 94µs making 1 call to Sympa::LockedFile::close
28416µs11µs return 1;
# spent 1µs making 1 call to Sympa::LockedFile::DESTROY
285}
286
287# Old name: Sympa::Tools::Daemon::write_pid().
288
# spent 2.53ms (277µs+2.25) within Sympa::Process::write_pid which was called: # once (277µs+2.25ms) by main::RUNTIME at line 107 of /usr/local/libexec/sympa/task_manager-debug.pl
sub write_pid {
28916µs my $self = shift;
290111µs my %options = @_;
291
292 my $name = $self->{pidname}
293112µs or die 'bug in logic. Ask developer';
294111µs my $pid = $options{pid} || $PID;
295
296110µs my $piddir = Sympa::Constants::PIDDIR;
29715µs my $pidfile = $piddir . '/' . $name . '.pid';
298
299 ## Create piddir
300158µs123µs mkdir($piddir, 0755) unless (-d $piddir);
# spent 23µs making 1 call to Sympa::Process::CORE:ftdir
301
302120µs1471µs unless (
# spent 471µs making 1 call to Sympa::Tools::File::set_file_rights
303 Sympa::Tools::File::set_file_rights(
304 file => $piddir,
305 user => Sympa::Constants::USER,
306 group => Sympa::Constants::GROUP,
307 )
308 ) {
309 die sprintf 'Unable to set rights on %s. Exiting.', $piddir;
310 ## No return
311 }
312
3131700ns my @pids;
314
315 # Lock pid file
316145µs11.27ms my $lock_fh = Sympa::LockedFile->new($pidfile, 5, '+>>');
# spent 1.27ms making 1 call to IO::File::new
3171800ns unless ($lock_fh) {
318 die sprintf 'Unable to lock %s file in write mode. Exiting.',
319 $pidfile;
320 }
321 ## If pidfile exists, read the PIDs
322127µs111µs if (-s $pidfile) {
# spent 11µs making 1 call to Sympa::Process::CORE:ftsize
323 # Read pid file
324 seek $lock_fh, 0, 0;
325 my $l = <$lock_fh>;
326 @pids = grep {/^[0-9]+$/} split(/\s+/, $l);
327 }
328
329 # If we can have multiple instances for the process.
330 # Print other pids + this one.
33112µs unless ($options{initial}) {
332 ## Print other pids + this one
333 push(@pids, $pid);
334
335 seek $lock_fh, 0, 0;
336 truncate $lock_fh, 0;
337 print $lock_fh join(' ', @pids) . "\n";
338 } else {
339 ## The previous process died suddenly, without pidfile cleanup
340 ## Send a notice to listmaster with STDERR of the previous process
3411600ns if (@pids) {
342 my $other_pid = $pids[0];
343 $log->syslog('notice',
344 'Previous process %s died suddenly; notifying listmaster',
345 $other_pid);
346 _send_crash_report($other_pid);
347 }
348
349115µs16µs seek $lock_fh, 0, 0;
# spent 6µs making 1 call to Sympa::Process::CORE:seek
350137µs121µs unless (truncate $lock_fh, 0) {
# spent 21µs making 1 call to Sympa::Process::CORE:truncate
351 ## Unlock pid file
352 $lock_fh->close();
353 die sprintf 'Could not truncate %s, exiting.', $pidfile;
354 }
355
356128µs11µs print $lock_fh $pid . "\n";
# spent 1µs making 1 call to Sympa::Process::CORE:print
357 }
358
35914µs1180µs unless (
# spent 180µs making 1 call to Sympa::Tools::File::set_file_rights
360 Sympa::Tools::File::set_file_rights(
361 file => $pidfile,
362 user => Sympa::Constants::USER,
363 group => Sympa::Constants::GROUP,
364 )
365 ) {
366 ## Unlock pid file
367 $lock_fh->close();
368 die sprintf 'Unable to set rights on %s', $pidfile;
369 }
370 ## Unlock pid file
37114µs1260µs $lock_fh->close();
# spent 260µs making 1 call to Sympa::LockedFile::close
372
373121µs13µs return 1;
# spent 3µs making 1 call to Sympa::LockedFile::DESTROY
374}
375
376# Old name: Sympa::Tools::Daemon::direct_stderr_to_file().
377
# spent 219µs (26+193) within Sympa::Process::direct_stderr_to_file which was called: # once (26µs+193µs) by main::RUNTIME at line 109 of /usr/local/libexec/sympa/task_manager-debug.pl
sub direct_stderr_to_file {
3781400ns my $self = shift;
379
380 # Error output is stored in a file with PID-based name.
381 # Useful if process crashes.
382182µs165µs open(STDERR, '>>', $Conf::Conf{'tmpdir'} . '/' . $PID . '.stderr');
# spent 65µs making 1 call to Sympa::Process::CORE:open
38316µs1128µs unless (
# spent 128µs making 1 call to Sympa::Tools::File::set_file_rights
384 Sympa::Tools::File::set_file_rights(
385 file => $Conf::Conf{'tmpdir'} . '/' . $PID . '.stderr',
386 user => Sympa::Constants::USER,
387 group => Sympa::Constants::GROUP,
388 )
389 ) {
390 $log->syslog(
391 'err',
392 'Unable to set rights on %s: %m',
393 $Conf::Conf{'tmpdir'} . '/' . $PID . '.stderr'
394 );
395 return undef;
396 }
39719µs return 1;
398}
399
400# Old name: Sympa::Tools::Daemon::send_crash_report().
401sub _send_crash_report {
402 my $pid = shift;
403
404 my $err_file = $Conf::Conf{'tmpdir'} . '/' . $pid . '.stderr';
405
406 my $language = Sympa::Language->instance;
407 my (@err_output, $err_date);
408 if (-f $err_file) {
409 open(ERR, $err_file);
410 @err_output = map { chomp $_; $_; } <ERR>;
411 close ERR;
412
413 my $err_date_epoch = (stat $err_file)[9];
414 if (defined $err_date_epoch) {
415 $err_date = $language->gettext_strftime("%d %b %Y %H:%M",
416 localtime $err_date_epoch);
417 } else {
418 $err_date = $language->gettext('(unknown date)');
419 }
420 } else {
421 $err_date = $language->gettext('(unknown date)');
422 }
423 Sympa::send_notify_to_listmaster(
424 '*', 'crash',
425 { 'crashed_process' => [split /\//, $PROGRAM_NAME]->[-1],
426 'crash_err' => \@err_output,
427 'crash_date' => $err_date,
428 'pid' => $pid,
429 }
430 );
431}
432
433# return a lockname that is a uniq id of a processus (hostname + pid) ;
434# hostname(20) and pid(10) are truncated in order to store lockname in
435# database varchar(30)
436# DEPRECATED: No longer used.
437#sub get_lockname();
438
439# Old name: Sympa::Tools::Daemon::get_pids_in_pid_file().
440sub _get_pids_in_pid_file {
441 my $name = shift;
442
443 my $piddir = Sympa::Constants::PIDDIR;
444 my $pidfile = $piddir . '/' . $name . '.pid';
445
446 my $lock_fh = Sympa::LockedFile->new($pidfile, 5, '<');
447 unless ($lock_fh) {
448 $log->syslog('err', 'Unable to open PID file %s: %m', $pidfile);
449 return;
450 }
451 my $l = <$lock_fh>;
452 my @pids = grep {/^[0-9]+$/} split(/\s+/, $l);
453 $lock_fh->close;
454
455 return @pids;
456}
457
458# Old name: Sympa::Tools::Daemon::get_children_processes_list().
459# OBSOLETED. No longer used.
460#sub get_children_processes_list;
461
462# Utility functions.
463
464# Old name: tools::eval_in_time().
465sub eval_in_time {
466 my $subref = shift;
467 my $timeout = shift;
468
469 # Call to subroutine uses eval to set a timeout.
470 # This prevents a subroutine to make the process wait forever if it does
471 # not respond.
472 my $ret = eval {
473 local $SIG{__DIE__} = 'DEFAULT';
474 local $SIG{ALRM} = sub { die "TIMEOUT\n" }; # NB: \n required
475 alarm $timeout;
476
477 # Inner eval just in case the subroutine would die, thus leaving the
478 # alarm trigered.
479 my $ret = eval { $subref->() };
480 alarm 0;
481 $ret;
482 };
483 if ($EVAL_ERROR and $EVAL_ERROR eq "TIMEOUT\n") {
484 $log->syslog('err', 'Processing timeout');
485 return undef;
486 } elsif ($EVAL_ERROR) {
487 $log->syslog('err', 'Processing failed: %m');
488 return undef;
489 }
490
491 return $ret;
492}
493
4941;
495__END__
 
# spent 23µs within Sympa::Process::CORE:ftdir which was called: # once (23µs+0s) by Sympa::Process::write_pid at line 300
sub Sympa::Process::CORE:ftdir; # opcode
# spent 8µs within Sympa::Process::CORE:ftfile which was called: # once (8µs+0s) by Sympa::Process::remove_pid at line 274
sub Sympa::Process::CORE:ftfile; # opcode
# spent 11µs within Sympa::Process::CORE:ftsize which was called: # once (11µs+0s) by Sympa::Process::write_pid at line 322
sub Sympa::Process::CORE:ftsize; # opcode
# spent 65µs within Sympa::Process::CORE:open which was called: # once (65µs+0s) by Sympa::Process::direct_stderr_to_file at line 382
sub Sympa::Process::CORE:open; # opcode
# spent 1µs within Sympa::Process::CORE:print which was called: # once (1µs+0s) by Sympa::Process::write_pid at line 356
sub Sympa::Process::CORE:print; # opcode
# spent 6µs within Sympa::Process::CORE:seek which was called: # once (6µs+0s) by Sympa::Process::write_pid at line 349
sub Sympa::Process::CORE:seek; # opcode
# spent 21µs within Sympa::Process::CORE:truncate which was called: # once (21µs+0s) by Sympa::Process::write_pid at line 350
sub Sympa::Process::CORE:truncate; # opcode
# spent 44µs within Sympa::Process::CORE:unlink which was called 2 times, avg 22µs/call: # once (26µs+0s) by Sympa::Process::remove_pid at line 275 # once (18µs+0s) by Sympa::Process::remove_pid at line 268
sub Sympa::Process::CORE:unlink; # opcode