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

Filename/usr/local/libexec/sympa/Sympa.pm
StatementsExecuted 207670 statements in 328ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
150711195ms16.1sSympa::::get_supported_languagesSympa::get_supported_languages
30012265.7ms2.04sSympa::::search_fullpathSympa::search_fullpath
86491156.4ms56.4msSympa::::CORE:ftereadSympa::CORE:fteread (opcode)
74963154.7ms80.6msSympa::::_get_search_pathSympa::_get_search_path (recurses: max depth 2, inclusive time 42.7ms)
30011125.6ms627msSympa::::get_search_pathSympa::get_search_path
30011121.5ms21.5msSympa::::CORE:ftdirSympa::CORE:ftdir (opcode)
3001111.93ms1.93msSympa::::CORE:matchSympa::CORE:match (opcode)
0000s0sSympa::::BEGIN@34Sympa::BEGIN@34
0000s0sSympa::::BEGIN@35Sympa::BEGIN@35
0000s0sSympa::::BEGIN@37Sympa::BEGIN@37
0000s0sSympa::::BEGIN@38Sympa::BEGIN@38
0000s0sSympa::::BEGIN@39Sympa::BEGIN@39
0000s0sSympa::::BEGIN@40Sympa::BEGIN@40
0000s0sSympa::::BEGIN@42Sympa::BEGIN@42
0000s0sSympa::::BEGIN@43Sympa::BEGIN@43
0000s0sSympa::::BEGIN@44Sympa::BEGIN@44
0000s0sSympa::::BEGIN@45Sympa::BEGIN@45
0000s0sSympa::::BEGIN@46Sympa::BEGIN@46
0000s0sSympa::::BEGIN@47Sympa::BEGIN@47
0000s0sSympa::::BEGIN@48Sympa::BEGIN@48
0000s0sSympa::::__ANON__Sympa::__ANON__ (xsub)
0000s0sSympa::::best_languageSympa::best_language
0000s0sSympa::::get_addressSympa::get_address
0000s0sSympa::::get_listmasters_emailSympa::get_listmasters_email
0000s0sSympa::::get_urlSympa::get_url
0000s0sSympa::::is_listmasterSympa::is_listmaster
0000s0sSympa::::send_dsnSympa::send_dsn
0000s0sSympa::::send_fileSympa::send_file
0000s0sSympa::::send_notify_to_listmasterSympa::send_notify_to_listmaster
0000s0sSympa::::send_notify_to_userSympa::send_notify_to_user
0000s0sSympa::::unique_message_idSympa::unique_message_id
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, 2018, 2019, 2020 The Sympa Community. See the AUTHORS.md
12# file at the top-level 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
28## Note to developers:
29## This corresponds to Sympa::ConfigurableObject (and Sympa::Site) package
30## in trunk.
31
32package Sympa;
33
34use strict;
35use warnings;
36#use Cwd qw();
37use DateTime;
38use English qw(-no_match_vars);
39use Scalar::Util qw();
40use URI;
41
42use Conf;
43use Sympa::Constants;
44use Sympa::Language;
45use Sympa::Log;
46use Sympa::Regexps;
47use Sympa::Spindle::ProcessTemplate;
48use Sympa::Tools::Text;
49
50my $log = Sympa::Log->instance;
51
52# Old name: List::compute_auth().
53#DEPRECATED. Reusable auth key is no longer used.
54#sub compute_auth;
55
56# Old name: List::request_auth().
57# DEPRECATED. Reusable auth keys are no longer used.
58#sub request_auth;
59
60# Old names:
61# [<=6.2a] tools::get_filename()
62# [6.2b] tools::search_fullpath()
63# [trunk] Sympa::ConfigurableObject::get_etc_filename()
64
# spent 2.04s (65.7ms+1.97) within Sympa::search_fullpath which was called 3001 times, avg 680µs/call: # 1507 times (35.0ms+929ms) by Sympa::Robot::load_topics at line 188 of /usr/local/libexec/sympa/Sympa/Robot.pm, avg 640µs/call # 1494 times (30.7ms+1.05s) by Sympa::List::_load_edit_list_conf at line 6165 of /usr/local/libexec/sympa/Sympa/List.pm, avg 720µs/call
sub search_fullpath {
6530014.20ms3001610ms $log->syslog('debug3', '(%s, %s, %s)', @_);
# spent 610ms making 3001 calls to Sympa::Log::syslog, avg 203µs/call
6630011.04ms my $that = shift;
673001714µs my $name = shift;
6830011.05ms my %options = @_;
69
703001613µs my (@try, $default_name);
71
72 ## template refers to a language
73 ## => extend search to default tpls
74 ## FIXME: family path precedes to list path. Is it appropriate?
7530017.83ms30011.93ms if ($name =~ /^(\S+)\.([^\s\/]+)\.tt2$/) {
# spent 1.93ms making 3001 calls to Sympa::CORE:match, avg 642ns/call
76 $default_name = $1 . '.tt2';
77 @try =
78 map { ($_ . '/' . $name, $_ . '/' . $default_name) }
79 @{Sympa::get_search_path($that, %options)};
80 } else {
81 @try =
82 map { $_ . '/' . $name }
83300110.5ms3001627ms @{Sympa::get_search_path($that, %options)};
# spent 627ms making 3001 calls to Sympa::get_search_path, avg 209µs/call
84 }
85
863001495µs my @result;
8730011.72ms foreach my $f (@try) {
88864974.8ms864956.4ms next unless -r $f;
# spent 56.4ms making 8649 calls to Sympa::CORE:fteread, avg 7µs/call
8930013.28ms3001679ms $log->syslog('debug3', 'Name: %s; file %s', $name, $f);
# spent 679ms making 3001 calls to Sympa::Log::syslog, avg 226µs/call
90
9130011.32ms if ($options{'order'} and $options{'order'} eq 'all') {
92 push @result, $f;
93 } else {
94300113.1ms return $f;
95 }
96 }
97 if ($options{'order'} and $options{'order'} eq 'all') {
98 return @result;
99 }
100
101 return undef;
102}
103
104# Old names:
105# [<=6.2a] tools::make_tt2_include_path()
106# [6.2b] tools::get_search_path()
107# [trunk] Sympa::ConfigurableObject::get_etc_include_path()
108
# spent 627ms (25.6+602) within Sympa::get_search_path which was called 3001 times, avg 209µs/call: # 3001 times (25.6ms+602ms) by Sympa::search_fullpath at line 83, avg 209µs/call
sub get_search_path {
10930013.50ms3001521ms $log->syslog('debug3', '(%s, %s, %s)', @_);
# spent 521ms making 3001 calls to Sympa::Log::syslog, avg 174µs/call
11030011.11ms my $that = shift;
1113001881µs my %options = @_;
112
11330011.23ms my $subdir = $options{'subdir'};
1143001603µs my $lang = $options{'lang'};
1153001486µs my $lang_only = $options{'lang_only'};
116
117 ## Get language subdirectories.
1183001478µs my $lang_dirs;
1193001424µs if ($lang) {
120 ## For compatibility: add old-style "locale" directory at first.
121 ## Add lang itself and fallback directories.
122 $lang_dirs = [
123 grep {$_} (
124 Sympa::Language::lang2oldlocale($lang),
125 Sympa::Language::implicated_langs($lang)
126 )
127 ];
128 }
129
130300110.3ms300180.6ms return [_get_search_path($that, $subdir, $lang_dirs, $lang_only)];
# spent 80.6ms making 3001 calls to Sympa::_get_search_path, avg 27µs/call
131}
132
133
# spent 80.6ms (54.7+25.9) within Sympa::_get_search_path which was called 7496 times, avg 11µs/call: # 3001 times (29.5ms+51.2ms) by Sympa::get_search_path at line 130, avg 27µs/call # 3001 times (14.8ms+-14.8ms) by Sympa::_get_search_path at line 194, avg 0s/call # 1494 times (10.4ms+-10.4ms) by Sympa::_get_search_path at line 142, avg 0s/call
sub _get_search_path {
13474961.56ms my $that = shift;
13574962.00ms my ($subdir, $lang_dirs, $lang_only) = @_; # shift is not used
136
13774961.15ms my @search_path;
138
13974966.47ms if (ref $that and ref $that eq 'Sympa::List') {
1401494232µs my $path_list;
141 my $path_family;
14214942.23ms14940s @search_path = _get_search_path($that->{'domain'}, @_);
# spent 27.8ms making 1494 calls to Sympa::_get_search_path, avg 19µs/call, recursion: max depth 1, sum of overlapping time 27.8ms
143
1441494462µs if ($subdir) {
145 $path_list = $that->{'dir'} . '/' . $subdir;
146 } else {
1471494695µs $path_list = $that->{'dir'};
148 }
1491494409µs if ($lang_dirs) {
150 unless ($lang_only) {
151 unshift @search_path, $path_list;
152 }
153 unshift @search_path, map { $path_list . '/' . $_ } @$lang_dirs;
154 } else {
1551494780µs unshift @search_path, $path_list;
156 }
157
15814942.98ms14944.39ms if (defined $that->get_family) {
# spent 4.39ms making 1494 calls to Sympa::List::get_family, avg 3µs/call
159 my $family = $that->get_family;
160 if ($subdir) {
161 $path_family = $family->{'dir'} . '/' . $subdir;
162 } else {
163 $path_family = $family->{'dir'};
164 }
165 if ($lang_dirs) {
166 unless ($lang_only) {
167 unshift @search_path, $path_family;
168 }
169 unshift @search_path,
170 map { $path_family . '/' . $_ } @$lang_dirs;
171 } else {
172 unshift @search_path, $path_family;
173 }
174 }
175 } elsif (ref $that and ref $that eq 'Sympa::Family') {
176 my $path_family;
177 @search_path = _get_search_path($that->{'domain'}, @_);
178
179 if ($subdir) {
180 $path_family = $that->{'dir'} . '/' . $subdir;
181 } else {
182 $path_family = $that->{'dir'};
183 }
184 if ($lang_dirs) {
185 unless ($lang_only) {
186 unshift @search_path, $path_family;
187 }
188 unshift @search_path, map { $path_family . '/' . $_ } @$lang_dirs;
189 } else {
190 unshift @search_path, $path_family;
191 }
192 } elsif (not ref $that and $that and $that ne '*') { # Robot
1933001469µs my $path_robot;
19430013.55ms30010s @search_path = _get_search_path('*', @_);
# spent 14.8ms making 3001 calls to Sympa::_get_search_path, avg 5µs/call, recursion: max depth 2, sum of overlapping time 14.8ms
195
1963001761µs if ($subdir) {
197 $path_robot = $Conf::Conf{'etc'} . '/' . $that . '/' . $subdir;
198 } else {
19930011.49ms $path_robot = $Conf::Conf{'etc'} . '/' . $that;
200 }
201300126.1ms300121.5ms if (-d $path_robot) {
# spent 21.5ms making 3001 calls to Sympa::CORE:ftdir, avg 7µs/call
2021153330µs if ($lang_dirs) {
203 unless ($lang_only) {
204 unshift @search_path, $path_robot;
205 }
206 unshift @search_path,
207 map { $path_robot . '/' . $_ } @$lang_dirs;
208 } else {
2091153785µs unshift @search_path, $path_robot;
210 }
211 }
212 } elsif (not ref $that and $that eq '*') { # Site
2133001508µs my $path_etcbindir;
214 my $path_etcdir;
215
21630011.02ms if ($subdir) {
217 $path_etcbindir = Sympa::Constants::DEFAULTDIR . '/' . $subdir;
218 $path_etcdir = $Conf::Conf{'etc'} . '/' . $subdir;
219 } else {
2203001855µs $path_etcbindir = Sympa::Constants::DEFAULTDIR;
22130011.73ms $path_etcdir = $Conf::Conf{'etc'};
222 }
22330011.34ms if ($lang_dirs) {
224 unless ($lang_only) {
225 @search_path = (
226 (map { $path_etcdir . '/' . $_ } @$lang_dirs),
227 $path_etcdir,
228 (map { $path_etcbindir . '/' . $_ } @$lang_dirs),
229 $path_etcbindir
230 );
231 } else {
232 @search_path = (
233 (map { $path_etcdir . '/' . $_ } @$lang_dirs),
234 (map { $path_etcbindir . '/' . $_ } @$lang_dirs)
235 );
236 }
237 } else {
23830011.85ms @search_path = ($path_etcdir, $path_etcbindir);
239 }
240 } else {
241 die 'bug in logic. Ask developer';
242 }
243
244749621.7ms return @search_path;
245}
246
247# Default diagnostic messages taken from IANA registry:
248# http://www.iana.org/assignments/smtp-enhanced-status-codes/
249# They should be modified to fit in Sympa.
250my %diag_messages = (
251 'default' => 'Other undefined Status',
252 # success
253 '2.1.5' => 'Destination address valid',
254 # no available family, dynamic list creation failed, etc.
255 '4.2.1' => 'Mailbox disabled, not accepting messages',
256 # no subscribers in dynamic list
257 '4.2.4' => 'Mailing list expansion problem',
258 # unknown list address
259 '5.1.1' => 'Bad destination mailbox address',
260 # unknown robot
261 '5.1.2' => 'Bad destination system address',
262 # too large
263 '5.2.3' => 'Message length exceeds administrative limit',
264 # no owners defined in list at all, no listmasters defined at all
265 '5.2.4' => 'Mailing list expansion problem',
266 # could not store message into spool or mailer
267 '5.3.0' => 'Other or undefined mail system status',
268 # misconfigured family list
269 '5.3.5' => 'System incorrectly configured',
270 # loop detected
271 '5.4.6' => 'Routing loop detected',
272 # message contains commands
273 '5.6.0' => 'Other or undefined media error',
274 # no command found in message
275 '5.6.1' => 'Media not supported',
276 # failed to personalize (merge_feature)
277 '5.6.5' => 'Conversion Failed',
278 # virus found
279 '5.7.0' => 'Other or undefined security status',
280 # message is not authorized and is rejected
281 '5.7.1' => 'Delivery not authorized, message refused',
282 # failed to re-encrypt decrypted message
283 '5.7.5' => 'Cryptographic failure',
284);
285
286# Old names: tools::send_dsn(), Sympa::ConfigurableObject::send_dsn().
287sub send_dsn {
288 my $that = shift;
289 my $message = shift;
290 my $param = shift || {};
291 my $status = shift;
292 my $diag = shift;
293
294 unless (Scalar::Util::blessed($message)
295 and $message->isa('Sympa::Message')) {
296 $log->syslog('err', 'object %s is not Message', $message);
297 return undef;
298 }
299
300 my $sender;
301 if (defined($sender = $message->{'envelope_sender'})) {
302 ## Won't reply to message with null envelope sender.
303 return 0 if $sender eq '<>';
304 } elsif (!defined($sender = $message->{'sender'})) {
305 $log->syslog('err', 'No sender found');
306 return undef;
307 }
308
309 $param->{listname} ||= $message->{localpart};
310 if (ref $that eq 'Sympa::List') {
311 # List context
312 $param->{recipient} ||=
313 $param->{listname} . '@' . $that->{'domain'};
314 $status ||= '5.1.1';
315
316 if ($status eq '5.2.3') {
317 my $max_size = $that->{'admin'}{'max_size'};
318 $param->{msg_size} = int($message->{'size'} / 1024);
319 $param->{max_size} = int($max_size / 1024);
320 }
321 } elsif (!ref $that and $that and $that ne '*') {
322 # Robot context
323 $param->{recipient} ||=
324 $param->{listname} . '@' . Conf::get_robot_conf($that, 'domain');
325 $status ||= '5.1.1';
326 } elsif ($that eq '*') {
327 # Site context
328 $param->{recipient} ||=
329 $param->{listname} . '@' . $Conf::Conf{'domain'};
330 $status ||= '5.1.2';
331 } else {
332 die 'bug in logic. Ask developer';
333 }
334
335 # Diagnostic message.
336 $diag ||= $diag_messages{$status} || $diag_messages{'default'};
337 # Delivery result, "failed" or "delivered".
338 my $action = (index($status, '2') == 0) ? 'delivered' : 'failed';
339
340 # Attach original (not decrypted) content.
341 my $msg_string = $message->as_string(original => 1);
342 $msg_string =~ s/\AReturn-Path: (.*?)\n(?![ \t])//s;
343 my $header =
344 ($msg_string =~ /\A\r?\n/)
345 ? ''
346 : [split /(?<=\n)\r?\n/, $msg_string, 2]->[0];
347
348 my $date =
349 (eval { DateTime->now(time_zone => 'local') } || DateTime->now)
350 ->strftime('%a, %{day} %b %Y %H:%M:%S %z');
351
352 my $spindle = Sympa::Spindle::ProcessTemplate->new(
353 context => $that,
354 template => 'delivery_status_notification',
355 rcpt => $sender,
356 data => {
357 %$param,
358 'to' => $sender,
359 'date' => $date,
360 'msg' => $msg_string,
361 'header' => $header,
362 'auto_submitted' => 'auto-replied',
363 'action' => $action,
364 'status' => $status,
365 'diagnostic_code' => $diag,
366 },
367 # Set envelope sender. DSN _must_ have null envelope sender.
368 envelope_sender => '<>',
369 );
370 unless ($spindle and $spindle->spin and $spindle->{finish} eq 'success') {
371 $log->syslog('err', 'Unable to send DSN to %s', $sender);
372 return undef;
373 }
374
375 return 1;
376}
377
378# Old name: List::send_file() and List::send_global_file().
379sub send_file {
380 $log->syslog('debug2', '(%s, %s, %s, ...)', @_);
381 my $that = shift;
382 my $tpl = shift;
383 my $who = shift;
384 my $context = shift || {};
385 my %options = @_;
386
387 my $spindle = Sympa::Spindle::ProcessTemplate->new(
388 context => $that,
389 template => $tpl,
390 rcpt => $who,
391 data => $context,
392 %options
393 );
394 unless ($spindle and $spindle->spin and $spindle->{finish} eq 'success') {
395 $log->syslog('err', 'Could not send template %s to %s', $tpl, $who);
396 return undef;
397 }
398
399 return 1;
400}
401
402# Old name: List::send_notify_to_listmaster()
403sub send_notify_to_listmaster {
404 $log->syslog('debug2', '(%s, %s, %s)', @_) unless $_[1] eq 'logs_failed';
405 my $that = shift;
406 my $operation = shift;
407 my $data = shift;
408
409 my ($list, $robot_id);
410 if (ref $that eq 'Sympa::List') {
411 $list = $that;
412 $robot_id = $list->{'domain'};
413 } elsif ($that and $that ne '*') {
414 $robot_id = $that;
415 } else {
416 $robot_id = '*';
417 }
418
419 my @listmasters = Sympa::get_listmasters_email($that);
420 my $to = Sympa::get_address($robot_id, 'listmaster');
421
422 if (ref $data ne 'HASH' and ref $data ne 'ARRAY') {
423 die
424 'Error on incoming parameter "$data", it must be a ref on HASH or a ref on ARRAY';
425 }
426
427 if (ref $data ne 'HASH') {
428 my $d = {};
429 foreach my $i ((0 .. $#{$data})) {
430 $d->{"param$i"} = $data->[$i];
431 }
432 $data = $d;
433 }
434
435 $data->{'to'} = $to;
436 $data->{'type'} = $operation;
437 $data->{'auto_submitted'} = 'auto-generated';
438
439 if ($operation eq 'no_db' or $operation eq 'db_restored') {
440 $data->{'db_name'} = Conf::get_robot_conf($robot_id, 'db_name');
441 }
442
443 # When operation is either missing_dbd, no_db or db_restored,
444 # skip DB access because DB is not accessible.
445 my $spindle = Sympa::Spindle::ProcessTemplate->new(
446 context => $that,
447 template => 'listmaster_notification',
448 rcpt => [@listmasters],
449 data => $data,
450
451 splicing_to => ['Sympa::Spindle::ToListmaster'],
452 );
453 unless ($spindle
454 and $spindle->spin
455 and $spindle->{finish} eq 'success') {
456 $log->syslog(
457 'notice',
458 'Unable to send template "listmaster_notification" to %s listmaster %s',
459 $robot_id,
460 join(', ', @listmasters),
461 ) unless $operation eq 'logs_failed';
462 return undef;
463 }
464
465 return 1;
466}
467
468sub send_notify_to_user {
469 $log->syslog('debug2', '(%s, %s, %s, ...)', @_);
470 my $that = shift;
471 my $operation = shift;
472 my $user = shift;
473 my $param = shift || {};
474
475 my ($list, $robot_id);
476 if (ref $that eq 'Sympa::List') {
477 $list = $that;
478 $robot_id = $list->{'domain'};
479 } elsif ($that and $that ne '*') {
480 $robot_id = $that;
481 } else {
482 $robot_id = '*';
483 }
484
485 $param->{'auto_submitted'} = 'auto-generated';
486
487 die 'Missing parameter "operation"' unless $operation;
488 die 'missing parameter "user"' unless $user;
489
490 if (ref $param eq "HASH") {
491 $param->{'to'} = $user;
492 $param->{'type'} = $operation;
493
494 unless (Sympa::send_file($that, 'user_notification', $user, $param)) {
495 $log->syslog('notice',
496 'Unable to send template "user_notification" to %s', $user);
497 return undef;
498 }
499 } elsif (ref $param eq "ARRAY") {
500 my $data = {
501 'to' => $user,
502 'type' => $operation
503 };
504
505 for my $i (0 .. $#{$param}) {
506 $data->{"param$i"} = $param->[$i];
507 }
508 unless (Sympa::send_file($that, 'user_notification', $user, $data)) {
509 $log->syslog('notice',
510 'Unable to send template "user_notification" to %s', $user);
511 return undef;
512 }
513 } else {
514 $log->syslog(
515 'err',
516 'error on incoming parameter "%s", it must be a ref on HASH or a ref on ARRAY',
517 $param
518 );
519 return undef;
520 }
521 return 1;
522}
523
524sub best_language {
525 my $that = shift;
526 my $accept_string = join ',', grep { $_ and $_ =~ /\S/ } @_;
527 $accept_string ||= $ENV{HTTP_ACCEPT_LANGUAGE} || '*';
528
529 my @supported_languages;
530 my %supported_languages;
531 my @langs = ();
532 my $lang;
533
534 if (ref $that eq 'Sympa::List') {
535 @supported_languages =
536 Sympa::get_supported_languages($that->{'domain'});
537 $lang = $that->{'admin'}{'lang'};
538 } elsif (!ref $that) {
539 @supported_languages = Sympa::get_supported_languages($that || '*');
540 $lang = Conf::get_robot_conf($that || '*', 'lang');
541 } else {
542 die 'bug in logic. Ask developer';
543 }
544 %supported_languages = map { $_ => 1 } @supported_languages;
545 push @langs, $lang
546 if $supported_languages{$lang};
547
548 if (ref $that eq 'Sympa::List') {
549 my $lang = Conf::get_robot_conf($that->{'domain'}, 'lang');
550 push @langs, $lang
551 if $supported_languages{$lang} and !grep { $_ eq $lang } @langs;
552 }
553 if (ref $that eq 'Sympa::List' or !ref $that and $that and $that ne '*') {
554 my $lang = $Conf::Conf{'lang'};
555 push @langs, $lang
556 if $supported_languages{$lang} and !grep { $_ eq $lang } @langs;
557 }
558 foreach my $lang (@supported_languages) {
559 push @langs, $lang
560 if !grep { $_ eq $lang } @langs;
561 }
562
563 return Sympa::Language::negotiate_lang($accept_string, @langs) || $lang;
564}
565
566#FIXME: Inefficient. Would be cached.
567#FIXME: Would also accept Sympa::List object.
568# Old name: [trunk] Sympa::Site::supported_languages().
569
# spent 16.1s (195ms+15.9) within Sympa::get_supported_languages which was called 1507 times, avg 10.7ms/call: # 1507 times (195ms+15.9s) by Sympa::Robot::list_params at line 444 of /usr/local/libexec/sympa/Sympa/Robot.pm, avg 10.7ms/call
sub get_supported_languages {
5701507920µs my $robot = shift;
571
5721507765µs my @lang_list = ();
57315071.01ms if (%Conf::Conf) { # configuration loaded.
5741507313µs my $supported_lang;
575
57615073.11ms15076.63ms if ($robot and $robot ne '*') {
# spent 6.63ms making 1507 calls to Conf::get_robot_conf, avg 4µs/call
577 $supported_lang = Conf::get_robot_conf($robot, 'supported_lang');
578 } else {
579 $supported_lang = $Conf::Conf{'supported_lang'};
580 }
581
58215074.57ms15074.31ms my $language = Sympa::Language->instance;
# spent 4.31ms making 1507 calls to Class::Singleton::instance, avg 3µs/call
58315072.26ms150715.0ms $language->push_lang;
# spent 15.0ms making 1507 calls to Sympa::Language::push_lang, avg 10µs/call
584 @lang_list =
5853767584.1ms3616815.7s grep { $_ and $_ = $language->set_lang($_) }
# spent 15.7s making 36168 calls to Sympa::Language::set_lang, avg 435µs/call
586 split /[\s,]+/, $supported_lang;
58715072.61ms1507166ms $language->pop_lang;
# spent 166ms making 1507 calls to Sympa::Language::pop_lang, avg 110µs/call
588 }
5891507294µs @lang_list = ('en') unless @lang_list;
59015077.12ms return @lang_list if wantarray;
591 return \@lang_list;
592}
593
594sub get_address {
595 my $that = shift || '*';
596 my $type = shift || '';
597
598 if (ref $that eq 'Sympa::List') {
599 unless ($type) {
600 return $that->{'name'} . '@' . $that->{'domain'};
601 } elsif ($type eq 'owner') {
602 return $that->{'name'} . '-request' . '@' . $that->{'domain'};
603 } elsif ($type eq 'editor') {
604 return $that->{'name'} . '-editor' . '@' . $that->{'domain'};
605 } elsif ($type eq 'return_path') {
606 return $that->{'name'}
607 . Conf::get_robot_conf($that->{'domain'},
608 'return_path_suffix')
609 . '@'
610 . $that->{'domain'};
611 } elsif ($type eq 'subscribe') {
612 return $that->{'name'} . '-subscribe' . '@' . $that->{'domain'};
613 } elsif ($type eq 'unsubscribe') {
614 return $that->{'name'} . '-unsubscribe' . '@' . $that->{'domain'};
615 } elsif ($type eq 'sympa'
616 or $type eq 'sympaowner'
617 or $type eq 'listmaster') {
618 # robot address, for convenience.
619 return Sympa::get_address($that->{'domain'}, $type);
620 }
621 } elsif (ref $that eq 'Sympa::Family') {
622 # robot address, for convenience.
623 return Sympa::get_address($that->{'domain'}, $type);
624 } else {
625 unless ($type) {
626 return Conf::get_robot_conf($that, 'email') . '@'
627 . Conf::get_robot_conf($that, 'domain');
628 } elsif ($type eq 'sympa') { # same as above, for convenience
629 return Conf::get_robot_conf($that, 'email') . '@'
630 . Conf::get_robot_conf($that, 'domain');
631 } elsif (
632 $type eq 'owner' or $type eq 'request' # for convenience
633 or $type eq 'sympaowner'
634 ) {
635 return
636 Conf::get_robot_conf($that, 'email')
637 . '-request' . '@'
638 . Conf::get_robot_conf($that, 'domain');
639 } elsif ($type eq 'listmaster') {
640 return Conf::get_robot_conf($that, 'listmaster_email') . '@'
641 . Conf::get_robot_conf($that, 'domain');
642 } elsif ($type eq 'return_path') {
643 return
644 Conf::get_robot_conf($that, 'email')
645 . Conf::get_robot_conf($that, 'return_path_suffix') . '@'
646 . Conf::get_robot_conf($that, 'domain');
647 }
648 }
649
650 $log->syslog('err', 'Unknown type of address "%s" for %s', $type, $that);
651 return undef;
652}
653
654# Old names:
655# [6.2b] Conf::get_robot_conf(..., 'listmasters'), $Conf::Conf{'listmasters'}.
656# [trunk] Site::listmasters().
657sub get_listmasters_email {
658 my $that = shift;
659
660 my $listmaster;
661 if (ref $that eq 'Sympa::List') {
662 $listmaster = Conf::get_robot_conf($that->{'domain'}, 'listmaster');
663 } elsif (ref $that eq 'Sympa::Family') {
664 $listmaster = Conf::get_robot_conf($that->{'domain'}, 'listmaster');
665 } elsif (not ref($that) and $that and $that ne '*') {
666 $listmaster = Conf::get_robot_conf($that, 'listmaster');
667 } else {
668 $listmaster = Conf::get_robot_conf('*', 'listmaster');
669 }
670
671 my @listmasters =
672 grep { Sympa::Tools::Text::valid_email($_) } split /\s*,\s*/,
673 $listmaster;
674 # If no valid adresses found, use listmaster of site config.
675 unless (@listmasters or (not ref $that and $that eq '*')) {
676 $log->syslog('notice', 'Warning: No listmasters found for %s', $that);
677 @listmasters = Sympa::get_listmasters_email('*');
678 }
679
680 return wantarray ? @listmasters : [@listmasters];
681}
682
683sub get_url {
684 my $that = shift;
685 my $action = shift;
686 my %options = @_;
687
688 my $robot_id =
689 (ref $that eq 'Sympa::List') ? $that->{'domain'}
690 : ($that and $that ne '*') ? $that
691 : '*';
692 my $option_authority = $options{authority} || 'default';
693
694 my $base;
695 if ($option_authority eq 'local') {
696 my $uri = URI->new(Conf::get_robot_conf($robot_id, 'wwsympa_url'));
697
698 # Override scheme.
699 if ($ENV{HTTPS} and $ENV{HTTPS} eq 'on') {
700 $uri->scheme('https');
701 }
702
703 # Try authority locally given.
704 my ($host_port, $port);
705 my $hostport_re = Sympa::Regexps::hostport();
706 my $ipv6_re = Sympa::Regexps::ipv6();
707 unless ($host_port = $ENV{HTTP_HOST}
708 and $host_port =~ /\A$hostport_re\z/) {
709 # HTTP/1.0 or earlier?
710 $host_port = $ENV{SERVER_NAME};
711 $port = $ENV{SERVER_PORT};
712 }
713 if ($host_port) {
714 if ($host_port =~ /\A$ipv6_re\z/) {
715 # IPv6 address not enclosed.
716 $host_port = '[' . $host_port . ']';
717 }
718 unless ($host_port =~ /:\d+\z/) {
719 $host_port .= ':'
720 . ($port ? $port : ($uri->scheme eq 'https') ? 443 : 80);
721 }
722 $uri->host_port($host_port);
723 }
724
725 # Override path with actual one.
726 if (my $path = $ENV{SCRIPT_NAME}) {
727 $uri->path($path);
728 }
729
730 $base = $uri->canonical->as_string;
731 } elsif ($option_authority eq 'omit') {
732 $base =
733 URI->new(Conf::get_robot_conf($robot_id, 'wwsympa_url'))->path;
734 } else { # 'default'
735 $base = Conf::get_robot_conf($robot_id, 'wwsympa_url');
736 }
737
738 $base .= '/nomenu' if $options{nomenu};
739
740 if (ref $that eq 'Sympa::List') {
741 $base .= '/' . ($action || 'info');
742 return Sympa::Tools::Text::weburl($base,
743 [$that->{'name'}, @{$options{paths} || []}], %options);
744 } else {
745 $base .= '/' . $action if $action;
746 return Sympa::Tools::Text::weburl($base, $options{paths}, %options);
747 }
748}
749
750# Old names: [6.2b-6.2.3] Sympa::Robot::is_listmaster($who, $robot_id)
751sub is_listmaster {
752 my $that = shift;
753 my $who = Sympa::Tools::Text::canonic_email(shift);
754
755 return undef unless defined $who;
756 return 1 if grep { lc $_ eq $who } Sympa::get_listmasters_email($that);
757 return 1 if grep { lc $_ eq $who } Sympa::get_listmasters_email('*');
758 return 0;
759}
760
761# Old name: tools::get_message_id().
762sub unique_message_id {
763 my $that = shift;
764
765 my $domain;
766 if (ref $that eq 'Sympa::List') {
767 $domain = Conf::get_robot_conf($that->{'domain'}, 'domain');
768 } elsif ($that and $that ne '*') {
769 $domain = Conf::get_robot_conf($that, 'domain');
770 } else {
771 $domain = $Conf::Conf{'domain'};
772 }
773
774 return sprintf '<sympa.%d.%d.%d@%s>', time, $PID, (int rand 999), $domain;
775}
776
7771;
778__END__
 
# spent 21.5ms within Sympa::CORE:ftdir which was called 3001 times, avg 7µs/call: # 3001 times (21.5ms+0s) by Sympa::_get_search_path at line 201, avg 7µs/call
sub Sympa::CORE:ftdir; # opcode
# spent 56.4ms within Sympa::CORE:fteread which was called 8649 times, avg 7µs/call: # 8649 times (56.4ms+0s) by Sympa::search_fullpath at line 88, avg 7µs/call
sub Sympa::CORE:fteread; # opcode
# spent 1.93ms within Sympa::CORE:match which was called 3001 times, avg 642ns/call: # 3001 times (1.93ms+0s) by Sympa::search_fullpath at line 75, avg 642ns/call
sub Sympa::CORE:match; # opcode