Filename | /usr/local/libexec/sympa/Sympa.pm |
Statements | Executed 207670 statements in 328ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1507 | 1 | 1 | 195ms | 16.1s | get_supported_languages | Sympa::
3001 | 2 | 2 | 65.7ms | 2.04s | search_fullpath | Sympa::
8649 | 1 | 1 | 56.4ms | 56.4ms | CORE:fteread (opcode) | Sympa::
7496 | 3 | 1 | 54.7ms | 80.6ms | _get_search_path (recurses: max depth 2, inclusive time 42.7ms) | Sympa::
3001 | 1 | 1 | 25.6ms | 627ms | get_search_path | Sympa::
3001 | 1 | 1 | 21.5ms | 21.5ms | CORE:ftdir (opcode) | Sympa::
3001 | 1 | 1 | 1.93ms | 1.93ms | CORE:match (opcode) | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@35 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@37 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@38 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@39 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@40 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@42 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@43 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@44 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@45 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@46 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@47 | Sympa::
0 | 0 | 0 | 0s | 0s | BEGIN@48 | Sympa::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::
0 | 0 | 0 | 0s | 0s | best_language | Sympa::
0 | 0 | 0 | 0s | 0s | get_address | Sympa::
0 | 0 | 0 | 0s | 0s | get_listmasters_email | Sympa::
0 | 0 | 0 | 0s | 0s | get_url | Sympa::
0 | 0 | 0 | 0s | 0s | is_listmaster | Sympa::
0 | 0 | 0 | 0s | 0s | send_dsn | Sympa::
0 | 0 | 0 | 0s | 0s | send_file | Sympa::
0 | 0 | 0 | 0s | 0s | send_notify_to_listmaster | Sympa::
0 | 0 | 0 | 0s | 0s | send_notify_to_user | Sympa::
0 | 0 | 0 | 0s | 0s | unique_message_id | Sympa::
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 | |||||
32 | package Sympa; | ||||
33 | |||||
34 | use strict; | ||||
35 | use warnings; | ||||
36 | #use Cwd qw(); | ||||
37 | use DateTime; | ||||
38 | use English qw(-no_match_vars); | ||||
39 | use Scalar::Util qw(); | ||||
40 | use URI; | ||||
41 | |||||
42 | use Conf; | ||||
43 | use Sympa::Constants; | ||||
44 | use Sympa::Language; | ||||
45 | use Sympa::Log; | ||||
46 | use Sympa::Regexps; | ||||
47 | use Sympa::Spindle::ProcessTemplate; | ||||
48 | use Sympa::Tools::Text; | ||||
49 | |||||
50 | my $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 | ||||
65 | 3001 | 4.20ms | 3001 | 610ms | $log->syslog('debug3', '(%s, %s, %s)', @_); # spent 610ms making 3001 calls to Sympa::Log::syslog, avg 203µs/call |
66 | 3001 | 1.04ms | my $that = shift; | ||
67 | 3001 | 714µs | my $name = shift; | ||
68 | 3001 | 1.05ms | my %options = @_; | ||
69 | |||||
70 | 3001 | 613µ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? | ||||
75 | 3001 | 7.83ms | 3001 | 1.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 } | ||||
83 | 3001 | 10.5ms | 3001 | 627ms | @{Sympa::get_search_path($that, %options)}; # spent 627ms making 3001 calls to Sympa::get_search_path, avg 209µs/call |
84 | } | ||||
85 | |||||
86 | 3001 | 495µs | my @result; | ||
87 | 3001 | 1.72ms | foreach my $f (@try) { | ||
88 | 8649 | 74.8ms | 8649 | 56.4ms | next unless -r $f; # spent 56.4ms making 8649 calls to Sympa::CORE:fteread, avg 7µs/call |
89 | 3001 | 3.28ms | 3001 | 679ms | $log->syslog('debug3', 'Name: %s; file %s', $name, $f); # spent 679ms making 3001 calls to Sympa::Log::syslog, avg 226µs/call |
90 | |||||
91 | 3001 | 1.32ms | if ($options{'order'} and $options{'order'} eq 'all') { | ||
92 | push @result, $f; | ||||
93 | } else { | ||||
94 | 3001 | 13.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 | ||||
109 | 3001 | 3.50ms | 3001 | 521ms | $log->syslog('debug3', '(%s, %s, %s)', @_); # spent 521ms making 3001 calls to Sympa::Log::syslog, avg 174µs/call |
110 | 3001 | 1.11ms | my $that = shift; | ||
111 | 3001 | 881µs | my %options = @_; | ||
112 | |||||
113 | 3001 | 1.23ms | my $subdir = $options{'subdir'}; | ||
114 | 3001 | 603µs | my $lang = $options{'lang'}; | ||
115 | 3001 | 486µs | my $lang_only = $options{'lang_only'}; | ||
116 | |||||
117 | ## Get language subdirectories. | ||||
118 | 3001 | 478µs | my $lang_dirs; | ||
119 | 3001 | 424µ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 | |||||
130 | 3001 | 10.3ms | 3001 | 80.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 | ||||
134 | 7496 | 1.56ms | my $that = shift; | ||
135 | 7496 | 2.00ms | my ($subdir, $lang_dirs, $lang_only) = @_; # shift is not used | ||
136 | |||||
137 | 7496 | 1.15ms | my @search_path; | ||
138 | |||||
139 | 7496 | 6.47ms | if (ref $that and ref $that eq 'Sympa::List') { | ||
140 | 1494 | 232µs | my $path_list; | ||
141 | my $path_family; | ||||
142 | 1494 | 2.23ms | 1494 | 0s | @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 | |||||
144 | 1494 | 462µs | if ($subdir) { | ||
145 | $path_list = $that->{'dir'} . '/' . $subdir; | ||||
146 | } else { | ||||
147 | 1494 | 695µs | $path_list = $that->{'dir'}; | ||
148 | } | ||||
149 | 1494 | 409µ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 { | ||||
155 | 1494 | 780µs | unshift @search_path, $path_list; | ||
156 | } | ||||
157 | |||||
158 | 1494 | 2.98ms | 1494 | 4.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 | ||||
193 | 3001 | 469µs | my $path_robot; | ||
194 | 3001 | 3.55ms | 3001 | 0s | @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 | |||||
196 | 3001 | 761µs | if ($subdir) { | ||
197 | $path_robot = $Conf::Conf{'etc'} . '/' . $that . '/' . $subdir; | ||||
198 | } else { | ||||
199 | 3001 | 1.49ms | $path_robot = $Conf::Conf{'etc'} . '/' . $that; | ||
200 | } | ||||
201 | 3001 | 26.1ms | 3001 | 21.5ms | if (-d $path_robot) { # spent 21.5ms making 3001 calls to Sympa::CORE:ftdir, avg 7µs/call |
202 | 1153 | 330µ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 { | ||||
209 | 1153 | 785µs | unshift @search_path, $path_robot; | ||
210 | } | ||||
211 | } | ||||
212 | } elsif (not ref $that and $that eq '*') { # Site | ||||
213 | 3001 | 508µs | my $path_etcbindir; | ||
214 | my $path_etcdir; | ||||
215 | |||||
216 | 3001 | 1.02ms | if ($subdir) { | ||
217 | $path_etcbindir = Sympa::Constants::DEFAULTDIR . '/' . $subdir; | ||||
218 | $path_etcdir = $Conf::Conf{'etc'} . '/' . $subdir; | ||||
219 | } else { | ||||
220 | 3001 | 855µs | $path_etcbindir = Sympa::Constants::DEFAULTDIR; | ||
221 | 3001 | 1.73ms | $path_etcdir = $Conf::Conf{'etc'}; | ||
222 | } | ||||
223 | 3001 | 1.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 { | ||||
238 | 3001 | 1.85ms | @search_path = ($path_etcdir, $path_etcbindir); | ||
239 | } | ||||
240 | } else { | ||||
241 | die 'bug in logic. Ask developer'; | ||||
242 | } | ||||
243 | |||||
244 | 7496 | 21.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. | ||||
250 | my %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(). | ||||
287 | sub 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(). | ||||
379 | sub 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() | ||||
403 | sub 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 | |||||
468 | sub 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 | |||||
524 | sub 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 | ||||
570 | 1507 | 920µs | my $robot = shift; | ||
571 | |||||
572 | 1507 | 765µs | my @lang_list = (); | ||
573 | 1507 | 1.01ms | if (%Conf::Conf) { # configuration loaded. | ||
574 | 1507 | 313µs | my $supported_lang; | ||
575 | |||||
576 | 1507 | 3.11ms | 1507 | 6.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 | |||||
582 | 1507 | 4.57ms | 1507 | 4.31ms | my $language = Sympa::Language->instance; # spent 4.31ms making 1507 calls to Class::Singleton::instance, avg 3µs/call |
583 | 1507 | 2.26ms | 1507 | 15.0ms | $language->push_lang; # spent 15.0ms making 1507 calls to Sympa::Language::push_lang, avg 10µs/call |
584 | @lang_list = | ||||
585 | 37675 | 84.1ms | 36168 | 15.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; | ||||
587 | 1507 | 2.61ms | 1507 | 166ms | $language->pop_lang; # spent 166ms making 1507 calls to Sympa::Language::pop_lang, avg 110µs/call |
588 | } | ||||
589 | 1507 | 294µs | @lang_list = ('en') unless @lang_list; | ||
590 | 1507 | 7.12ms | return @lang_list if wantarray; | ||
591 | return \@lang_list; | ||||
592 | } | ||||
593 | |||||
594 | sub 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(). | ||||
657 | sub 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 | |||||
683 | sub 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) | ||||
751 | sub 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(). | ||||
762 | sub 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 | |||||
777 | 1; | ||||
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 | |||||
# 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 | |||||
# 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 |