Filename | /usr/local/libexec/sympa/Sympa/Spool.pm |
Statements | Executed 132394 statements in 343ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2300 | 1 | 1 | 105ms | 1.20s | unmarshal_metadata | Sympa::Spool::
1494 | 2 | 2 | 98.5ms | 34.5s | next (recurses: max depth 1, inclusive time 2.78s) | Sympa::Spool::
2300 | 1 | 1 | 34.7ms | 45.4ms | split_listname | Sympa::Spool::
2300 | 1 | 1 | 26.5ms | 1.22s | unmarshal | Sympa::Spool::
230 | 2 | 1 | 24.9ms | 62.5ms | _load | Sympa::Spool::
7821 | 3 | 1 | 21.5ms | 21.5ms | CORE:match (opcode) | Sympa::Spool::
1150 | 1 | 1 | 18.6ms | 18.6ms | CORE:open (opcode) | Sympa::Spool::
2300 | 1 | 1 | 14.5ms | 14.5ms | CORE:ftfile (opcode) | Sympa::Spool::
1150 | 1 | 1 | 9.55ms | 9.55ms | CORE:readline (opcode) | Sympa::Spool::
1150 | 1 | 1 | 4.48ms | 4.48ms | CORE:close (opcode) | Sympa::Spool::
230 | 1 | 1 | 3.96ms | 3.96ms | CORE:readdir (opcode) | Sympa::Spool::
230 | 1 | 1 | 3.93ms | 3.93ms | CORE:open_dir (opcode) | Sympa::Spool::
2300 | 1 | 1 | 3.15ms | 3.15ms | CORE:regcomp (opcode) | Sympa::Spool::
2530 | 3 | 1 | 2.25ms | 2.25ms | _is_collection | Sympa::Spool::
231 | 2 | 1 | 680µs | 680µs | CORE:sort (opcode) | Sympa::Spool::
230 | 1 | 1 | 428µs | 428µs | CORE:closedir (opcode) | Sympa::Spool::
230 | 2 | 1 | 253µs | 253µs | _init | Sympa::Spool::
1 | 1 | 1 | 147µs | 351µs | new | Sympa::Spool::
1 | 1 | 1 | 66µs | 104µs | build_glob_pattern | Sympa::Spool::
1 | 1 | 1 | 61µs | 84µs | _create | Sympa::Spool::
2 | 2 | 1 | 23µs | 23µs | CORE:subst (opcode) | Sympa::Spool::
1 | 1 | 1 | 18µs | 18µs | CORE:ftdir (opcode) | Sympa::Spool::
6 | 1 | 1 | 8µs | 8µs | CORE:substcont (opcode) | Sympa::Spool::
1 | 1 | 1 | 3µs | 3µs | _filter_pre | Sympa::Spool::
2 | 2 | 1 | 2µs | 2µs | CORE:umask (opcode) | Sympa::Spool::
1 | 1 | 1 | 1µs | 1µs | _no_glob_pattern | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@187 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@30 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@33 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@35 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@36 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@37 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@39 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@40 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@41 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@42 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@43 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@44 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@45 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | BEGIN@46 | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | __ANON__[:261] | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | _filter | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | _store_key | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | marshal | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | marshal_metadata | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | quarantine | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | remove | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | size | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | store | Sympa::Spool::
0 | 0 | 0 | 0s | 0s | store_spool | Sympa::Spool::
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, 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 | package Sympa::Spool; | ||||
29 | |||||
30 | use strict; | ||||
31 | use warnings; | ||||
32 | use Cwd qw(); | ||||
33 | use Digest::MD5; | ||||
34 | use English qw(-no_match_vars); | ||||
35 | use POSIX qw(); | ||||
36 | use Sys::Hostname qw(); | ||||
37 | use Time::HiRes qw(); | ||||
38 | |||||
39 | use Sympa; | ||||
40 | use Conf; | ||||
41 | use Sympa::Constants; | ||||
42 | use Sympa::Family; | ||||
43 | use Sympa::List; | ||||
44 | use Sympa::LockedFile; | ||||
45 | use Sympa::Log; | ||||
46 | use Sympa::Tools::File; | ||||
47 | |||||
48 | my $log = Sympa::Log->instance; | ||||
49 | |||||
50 | # Methods. | ||||
51 | |||||
52 | # spent 351µs (147+204) within Sympa::Spool::new which was called:
# once (147µs+204µs) by Sympa::Spindle::new at line 42 of /usr/local/libexec/sympa/Sympa/Spindle.pm | ||||
53 | 1 | 6µs | my $class = shift; | ||
54 | 1 | 1µs | my %options = @_; | ||
55 | |||||
56 | 1 | 56µs | 1 | 500ns | die $EVAL_ERROR unless eval sprintf 'require %s', $class->_generator; # spent 500ns making 1 call to Sympa::Spool::Task::_generator # spent 3µs executing statements in string eval |
57 | |||||
58 | my $self = bless { | ||||
59 | %options, | ||||
60 | 1 | 8µs | 1 | 9µs | %{$class->_directories(%options) || {}}, # spent 9µs making 1 call to Sympa::Spool::Task::_directories |
61 | _metadatas => undef, | ||||
62 | _glob_pattern => undef, | ||||
63 | } => $class; | ||||
64 | |||||
65 | 1 | 8µs | 1 | 84µs | $self->_create; # spent 84µs making 1 call to Sympa::Spool::_create |
66 | 1 | 4µs | 1 | 1µs | $self->_init(0) or return undef; # spent 1µs making 1 call to Sympa::Spool::_init |
67 | |||||
68 | # Build glob pattern (using encoded attributes). | ||||
69 | 1 | 4µs | 1 | 1µs | unless ($self->_no_glob_pattern) { # spent 1µs making 1 call to Sympa::Spool::_no_glob_pattern |
70 | 1 | 900ns | my $opts = {%options}; | ||
71 | 1 | 9µs | 1 | 3µs | $self->_filter_pre($opts); # spent 3µs making 1 call to Sympa::Spool::_filter_pre |
72 | $self->{_glob_pattern} = | ||||
73 | 1 | 30µs | 3 | 105µs | Sympa::Spool::build_glob_pattern($self->_marshal_format, # spent 104µs making 1 call to Sympa::Spool::build_glob_pattern
# spent 500ns making 1 call to Sympa::Spool::Task::_marshal_format
# spent 400ns making 1 call to Sympa::Spool::Task::_marshal_keys |
74 | $self->_marshal_keys, %$opts); | ||||
75 | } | ||||
76 | |||||
77 | 1 | 4µs | $self; | ||
78 | } | ||||
79 | |||||
80 | # spent 84µs (61+23) within Sympa::Spool::_create which was called:
# once (61µs+23µs) by Sympa::Spool::new at line 65 | ||||
81 | 1 | 600ns | my $self = shift; | ||
82 | |||||
83 | 1 | 9µs | 1 | 1µs | my $umask = umask oct $Conf::Conf{'umask'}; # spent 1µs making 1 call to Sympa::Spool::CORE:umask |
84 | 1 | 25µs | 2 | 4µs | foreach my $directory (sort values %{$self->_directories}) { # spent 2µs making 1 call to Sympa::Spool::CORE:sort
# spent 1µs making 1 call to Sympa::Spool::Task::_directories |
85 | 1 | 30µs | 1 | 18µs | unless (-d $directory) { # spent 18µs making 1 call to Sympa::Spool::CORE:ftdir |
86 | $log->syslog('info', 'Creating directory %s of %s', | ||||
87 | $directory, $self); | ||||
88 | unless (mkdir $directory, 0775 or -d $directory) { | ||||
89 | die sprintf 'Cannot create %s: %s', $directory, $ERRNO; | ||||
90 | } | ||||
91 | unless ( | ||||
92 | Sympa::Tools::File::set_file_rights( | ||||
93 | file => $directory, | ||||
94 | user => Sympa::Constants::USER(), | ||||
95 | group => Sympa::Constants::GROUP() | ||||
96 | ) | ||||
97 | ) { | ||||
98 | die sprintf 'Cannot create %s: %s', $directory, $ERRNO; | ||||
99 | } | ||||
100 | } | ||||
101 | } | ||||
102 | 1 | 10µs | 1 | 500ns | umask $umask; # spent 500ns making 1 call to Sympa::Spool::CORE:umask |
103 | } | ||||
104 | |||||
105 | 230 | 526µs | sub _init {1} | ||
106 | |||||
107 | 1 | 8µs | # spent 1µs within Sympa::Spool::_no_glob_pattern which was called:
# once (1µs+0s) by Sympa::Spool::new at line 69 | ||
108 | |||||
109 | sub marshal { | ||||
110 | my $self = shift; | ||||
111 | my $message = shift; | ||||
112 | my %options = @_; | ||||
113 | |||||
114 | return Sympa::Spool::marshal_metadata($message, $self->_marshal_format, | ||||
115 | $self->_marshal_keys, %options); | ||||
116 | } | ||||
117 | |||||
118 | # spent 34.5s (98.5ms+34.4) within Sympa::Spool::next which was called 1494 times, avg 23.1ms/call:
# 1265 times (53.6ms+-53.6ms) by Sympa::Spool::Task::_existing_tasks at line 130 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 0s/call
# 229 times (44.9ms+34.4s) by Sympa::Spindle::spin at line 78 of /usr/local/libexec/sympa/Sympa/Spindle.pm, avg 150ms/call | ||||
119 | 1494 | 363µs | my $self = shift; | ||
120 | 1494 | 1.29ms | my %options = @_; | ||
121 | |||||
122 | 1494 | 541µs | return unless $self->{directory}; | ||
123 | |||||
124 | 1494 | 723µs | 115 | 33.3s | unless ($self->{_metadatas}) { # spent 33.3s making 115 calls to Sympa::Spool::Task::_load, avg 290ms/call |
125 | $self->{_metadatas} = $self->_load; | ||||
126 | } | ||||
127 | 1494 | 859µs | unless ($self->{_metadatas} and @{$self->{_metadatas}}) { | ||
128 | 229 | 126µs | undef $self->{_metadatas}; | ||
129 | 229 | 410µs | 229 | 252µs | $self->_init(1); # spent 252µs making 229 calls to Sympa::Spool::_init, avg 1µs/call |
130 | 229 | 302µs | return; | ||
131 | } | ||||
132 | |||||
133 | 1265 | 2.25ms | while (my $marshalled = shift @{$self->{_metadatas}}) { | ||
134 | 2300 | 467µs | my ($handle, $metadata, $message); | ||
135 | |||||
136 | # Try locking message. Those locked or removed by other process will | ||||
137 | # be skipped. | ||||
138 | 2300 | 943µs | if ($options{no_lock}) { | ||
139 | next | ||||
140 | unless open $handle, '<', | ||||
141 | 1150 | 23.2ms | 1150 | 18.6ms | $self->{directory} . '/' . $marshalled; # spent 18.6ms making 1150 calls to Sympa::Spool::CORE:open, avg 16µs/call |
142 | } else { | ||||
143 | $handle = | ||||
144 | 1150 | 6.27ms | 2300 | 406ms | Sympa::LockedFile->new($self->{directory} . '/' . $marshalled, # spent 405ms making 1150 calls to IO::File::new, avg 352µs/call
# spent 1.11ms making 1150 calls to Sympa::Spool::_is_collection, avg 962ns/call |
145 | -1, $self->_is_collection ? '+' : '+<'); | ||||
146 | 1150 | 345µs | next unless $handle; | ||
147 | } | ||||
148 | |||||
149 | 2300 | 3.81ms | 2300 | 1.22s | $metadata = $self->unmarshal($marshalled); # spent 1.22s making 2300 calls to Sympa::Spool::unmarshal, avg 532µs/call |
150 | |||||
151 | 2300 | 1.35ms | if ($metadata) { | ||
152 | 2300 | 2.31ms | 1150 | 3.42ms | if ($options{no_filter}) { # spent 3.42ms making 1150 calls to Sympa::Spool::Task::_filter, avg 3µs/call |
153 | $self->_filter($metadata); | ||||
154 | } else { | ||||
155 | 1150 | 17.0ms | 2300 | 109ms | next unless $self->_filter($metadata); # spent 105ms making 1150 calls to Sympa::LockedFile::DESTROY, avg 91µs/call
# spent 3.85ms making 1150 calls to Sympa::Spool::Task::_filter, avg 3µs/call |
156 | } | ||||
157 | |||||
158 | 1150 | 1.83ms | 1150 | 906µs | if ($self->_is_collection) { # spent 906µs making 1150 calls to Sympa::Spool::_is_collection, avg 788ns/call |
159 | $message = $self->_generator->new(%$metadata); | ||||
160 | } else { | ||||
161 | 3450 | 23.8ms | 1150 | 9.55ms | my $msg_string = do { local $RS; <$handle> }; # spent 9.55ms making 1150 calls to Sympa::Spool::CORE:readline, avg 8µs/call |
162 | 1150 | 8.04ms | 2300 | 2.07s | $message = $self->_generator->new($msg_string, %$metadata); # spent 2.07s making 1150 calls to Sympa::Task::new, avg 1.80ms/call
# spent 638µs making 1150 calls to Sympa::Spool::Task::_generator, avg 555ns/call |
163 | } | ||||
164 | } | ||||
165 | |||||
166 | # Though message might not be deserialized, anyway return the result. | ||||
167 | 1150 | 578µs | if ($options{no_lock}) { | ||
168 | 1150 | 6.48ms | 1150 | 4.48ms | close $handle; # spent 4.48ms making 1150 calls to Sympa::Spool::CORE:close, avg 4µs/call |
169 | 1150 | 6.50ms | return ($message, 1); | ||
170 | } else { | ||||
171 | return ($message, $handle); | ||||
172 | } | ||||
173 | } | ||||
174 | 115 | 339µs | return; | ||
175 | } | ||||
176 | |||||
177 | sub _filter {1} | ||||
178 | |||||
179 | # spent 62.5ms (24.9+37.6) within Sympa::Spool::_load which was called 230 times, avg 272µs/call:
# 115 times (17.2ms+17.1ms) by Sympa::Spool::Task::_existing_tasks at line 127 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 298µs/call
# 115 times (7.73ms+20.5ms) by Sympa::Spool::Task::_load at line 60 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 246µs/call | ||||
180 | 230 | 86µs | my $self = shift; | ||
181 | |||||
182 | 230 | 81µs | my @entries; | ||
183 | 230 | 247µs | if ($self->{_glob_pattern}) { | ||
184 | my $cwd = Cwd::getcwd(); | ||||
185 | die sprintf 'Cannot chdir to %s: %s', $self->{directory}, $ERRNO | ||||
186 | unless chdir $self->{directory}; | ||||
187 | @entries = glob $self->{_glob_pattern}; | ||||
188 | chdir $cwd; | ||||
189 | } else { | ||||
190 | 230 | 86µs | my $dh; | ||
191 | die sprintf 'Cannot open dir %s: %s', $self->{directory}, $ERRNO | ||||
192 | 230 | 5.12ms | 230 | 3.93ms | unless opendir $dh, $self->{directory}; # spent 3.93ms making 230 calls to Sympa::Spool::CORE:open_dir, avg 17µs/call |
193 | 230 | 4.71ms | 230 | 3.96ms | @entries = readdir $dh; # spent 3.96ms making 230 calls to Sympa::Spool::CORE:readdir, avg 17µs/call |
194 | 230 | 1.23ms | 230 | 428µs | closedir $dh; # spent 428µs making 230 calls to Sympa::Spool::CORE:closedir, avg 2µs/call |
195 | } | ||||
196 | |||||
197 | 230 | 472µs | 230 | 238µs | my $iscol = $self->_is_collection; # spent 238µs making 230 calls to Sympa::Spool::_is_collection, avg 1µs/call |
198 | my $metadatas = [ | ||||
199 | sort grep { | ||||
200 | 230 | 2.49ms | 230 | 678µs | !/,lock/ # spent 678µs making 230 calls to Sympa::Spool::CORE:sort, avg 3µs/call |
201 | and !m{(?:\A|/)(?:\.|T\.|BAD-)} | ||||
202 | and ((not $iscol and -f ($self->{directory} . '/' . $_)) | ||||
203 | 2760 | 46.9ms | 7820 | 28.3ms | or ($iscol and -d ($self->{directory} . '/' . $_))) # spent 14.5ms making 2300 calls to Sympa::Spool::CORE:ftfile, avg 6µs/call
# spent 13.9ms making 5520 calls to Sympa::Spool::CORE:match, avg 3µs/call |
204 | } @entries | ||||
205 | ]; | ||||
206 | |||||
207 | 230 | 5.67ms | return $metadatas; | ||
208 | } | ||||
209 | |||||
210 | 2530 | 8.86ms | # spent 2.25ms within Sympa::Spool::_is_collection which was called 2530 times, avg 889ns/call:
# 1150 times (1.11ms+0s) by Sympa::Spool::next at line 144, avg 962ns/call
# 1150 times (906µs+0s) by Sympa::Spool::next at line 158, avg 788ns/call
# 230 times (238µs+0s) by Sympa::Spool::_load at line 197, avg 1µs/call | ||
211 | |||||
212 | sub quarantine { | ||||
213 | my $self = shift; | ||||
214 | my $handle = shift; | ||||
215 | |||||
216 | return undef unless $self->{bad_directory}; | ||||
217 | die 'bug in logic. Ask developer' unless ref $handle; | ||||
218 | |||||
219 | my $bad_file; | ||||
220 | |||||
221 | $bad_file = $self->{bad_directory} . '/' . $handle->basename; | ||||
222 | unless (-d $self->{bad_directory} and $handle->rename($bad_file)) { | ||||
223 | $bad_file = $self->{directory} . '/BAD-' . $handle->basename; | ||||
224 | return undef unless $handle->rename($bad_file); | ||||
225 | } | ||||
226 | |||||
227 | return 1; | ||||
228 | } | ||||
229 | |||||
230 | sub remove { | ||||
231 | my $self = shift; | ||||
232 | my $handle = shift; | ||||
233 | |||||
234 | die 'bug in logic. Ask developer' unless ref $handle; | ||||
235 | |||||
236 | if ($self->_is_collection) { | ||||
237 | return undef | ||||
238 | unless rmdir($self->{directory} . '/' . $handle->basename); | ||||
239 | return $handle->close; | ||||
240 | } else { | ||||
241 | return $handle->unlink; | ||||
242 | } | ||||
243 | } | ||||
244 | |||||
245 | sub size { | ||||
246 | scalar @{shift->_load || []}; | ||||
247 | } | ||||
248 | |||||
249 | sub store { | ||||
250 | my $self = shift; | ||||
251 | my $message = shift->dup; | ||||
252 | my %options = @_; | ||||
253 | |||||
254 | return if $self->_is_collection; | ||||
255 | |||||
256 | $message->{date} = time unless defined $message->{date}; | ||||
257 | |||||
258 | my $marshalled = | ||||
259 | Sympa::Spool::store_spool($self->{directory}, $message, | ||||
260 | $self->_marshal_format, $self->_marshal_keys, %options, | ||||
261 | _filter_pre => sub { $self->_filter_pre(shift) },); | ||||
262 | return unless $marshalled; | ||||
263 | |||||
264 | $log->syslog('notice', '%s is stored into %s as <%s>', | ||||
265 | $message, $self, $marshalled); | ||||
266 | |||||
267 | if ($self->_store_key) { | ||||
268 | my $metadata = $self->unmarshal($marshalled); | ||||
269 | return $metadata ? $metadata->{$self->_store_key} : undef; | ||||
270 | } | ||||
271 | return $marshalled; | ||||
272 | } | ||||
273 | |||||
274 | 1 | 4µs | # spent 3µs within Sympa::Spool::_filter_pre which was called:
# once (3µs+0s) by Sympa::Spool::new at line 71 | ||
275 | |||||
276 | sub _store_key {undef} | ||||
277 | |||||
278 | # spent 1.22s (26.5ms+1.20) within Sympa::Spool::unmarshal which was called 2300 times, avg 532µs/call:
# 2300 times (26.5ms+1.20s) by Sympa::Spool::next at line 149, avg 532µs/call | ||||
279 | 2300 | 550µs | my $self = shift; | ||
280 | 2300 | 557µs | my $marshalled = shift; | ||
281 | |||||
282 | return Sympa::Spool::unmarshal_metadata( | ||||
283 | 2300 | 27.8ms | 6900 | 1.20s | $self->{directory}, $marshalled, # spent 1.20s making 2300 calls to Sympa::Spool::unmarshal_metadata, avg 520µs/call
# spent 1.48ms making 2300 calls to Sympa::Spool::Task::_marshal_regexp, avg 643ns/call
# spent 896µs making 2300 calls to Sympa::Spool::Task::_marshal_keys, avg 389ns/call |
284 | $self->_marshal_regexp, $self->_marshal_keys | ||||
285 | ); | ||||
286 | } | ||||
287 | |||||
288 | # Low-level functions. | ||||
289 | |||||
290 | # spent 104µs (66+38) within Sympa::Spool::build_glob_pattern which was called:
# once (66µs+38µs) by Sympa::Spool::new at line 73 | ||||
291 | 1 | 1µs | my $format = shift; | ||
292 | 1 | 600ns | my $keys = shift; | ||
293 | 1 | 1µs | my %options = @_; | ||
294 | |||||
295 | 1 | 2µs | if (exists $options{context}) { | ||
296 | my $context = $options{context}; | ||||
297 | if (ref $context eq 'Sympa::List') { | ||||
298 | @options{qw(localpart domainpart)} = | ||||
299 | split /\@/, Sympa::get_address($context); | ||||
300 | } else { | ||||
301 | $options{domainpart} = $context; | ||||
302 | } | ||||
303 | } | ||||
304 | |||||
305 | 1 | 46µs | 7 | 27µs | $format =~ s/(%%|%[-#+.\d ]*[l]*\w)/$1 eq '%%' ? '%%' : '%s'/eg; # spent 18µs making 1 call to Sympa::Spool::CORE:subst
# spent 8µs making 6 calls to Sympa::Spool::CORE:substcont, avg 1µs/call |
306 | my @args = | ||||
307 | map { | ||||
308 | 5 | 2µs | if (exists $options{$_} and defined $options{$_}) { | ||
309 | my $val = $options{$_}; | ||||
310 | $val =~ s/([^0-9A-Za-z\x80-\xFF])/\\$1/g; | ||||
311 | $val; | ||||
312 | } else { | ||||
313 | 5 | 5µs | '*'; | ||
314 | } | ||||
315 | } map { | ||||
316 | lc $_ | ||||
317 | 1 | 9µs | } @{$keys || []}; | ||
318 | 1 | 2µs | my $pattern = sprintf $format, @args; | ||
319 | 1 | 7µs | 1 | 5µs | $pattern =~ s/[*][*]+/*/g; # spent 5µs making 1 call to Sympa::Spool::CORE:subst |
320 | |||||
321 | # Eliminate patterns contains only punctuations: | ||||
322 | # ',', '.', '_', wildcard etc. | ||||
323 | 1 | 29µs | 1 | 7µs | return ($pattern =~ /[0-9A-Za-z\x80-\xFF]|\\[^0-9A-Za-z\x80-\xFF]/) # spent 7µs making 1 call to Sympa::Spool::CORE:match |
324 | ? $pattern | ||||
325 | : undef; | ||||
326 | } | ||||
327 | |||||
328 | # spent 45.4ms (34.7+10.7) within Sympa::Spool::split_listname which was called 2300 times, avg 20µs/call:
# 2300 times (34.7ms+10.7ms) by Sympa::Spool::unmarshal_metadata at line 423, avg 20µs/call | ||||
329 | 2300 | 708µs | my $robot_id = shift || '*'; | ||
330 | 2300 | 551µs | my $mailbox = shift; | ||
331 | 2300 | 549µs | return unless defined $mailbox and length $mailbox; | ||
332 | |||||
333 | 2300 | 2.89ms | 2300 | 7.22ms | my $return_path_suffix = # spent 7.22ms making 2300 calls to Conf::get_robot_conf, avg 3µs/call |
334 | Conf::get_robot_conf($robot_id, 'return_path_suffix'); | ||||
335 | my $regexp = join( | ||||
336 | '|', | ||||
337 | map { quotemeta $_ } | ||||
338 | 2300 | 17.2ms | 2300 | 3.43ms | grep { $_ and length $_ } # spent 3.43ms making 2300 calls to Conf::get_robot_conf, avg 1µs/call |
339 | split( | ||||
340 | /[\s,]+/, Conf::get_robot_conf($robot_id, 'list_check_suffixes') | ||||
341 | ) | ||||
342 | ); | ||||
343 | |||||
344 | 2300 | 11.5ms | if ( $mailbox eq 'sympa' | ||
345 | and $robot_id eq $Conf::Conf{'domain'}) { # compat. | ||||
346 | return (undef, 'sympa'); | ||||
347 | } elsif ($mailbox eq Conf::get_robot_conf($robot_id, 'email') | ||||
348 | or $robot_id eq $Conf::Conf{'domain'} | ||||
349 | and $mailbox eq $Conf::Conf{'email'}) { | ||||
350 | return (undef, 'sympa'); | ||||
351 | } elsif ($mailbox eq Conf::get_robot_conf($robot_id, 'listmaster_email') | ||||
352 | or $robot_id eq $Conf::Conf{'domain'} | ||||
353 | and $mailbox eq $Conf::Conf{'listmaster_email'}) { | ||||
354 | return (undef, 'listmaster'); | ||||
355 | } elsif ($mailbox =~ /^(\S+)$return_path_suffix$/) { # -owner | ||||
356 | return ($1, 'return_path'); | ||||
357 | } elsif (!$regexp) { | ||||
358 | return ($mailbox); | ||||
359 | } elsif ($mailbox =~ /^(\S+)-($regexp)$/) { | ||||
360 | my ($name, $suffix) = ($1, $2); | ||||
361 | my $type; | ||||
362 | |||||
363 | if ($suffix eq 'request') { # -request | ||||
364 | if ( $name eq Conf::get_robot_conf($robot_id, 'email') | ||||
365 | or $robot_id eq $Conf::Conf{'domain'} | ||||
366 | and $name eq $Conf::Conf{'email'}) { # sympa-request | ||||
367 | ($name, $type) = (undef, 'sympaowner'); | ||||
368 | } else { | ||||
369 | $type = 'owner'; | ||||
370 | } | ||||
371 | } elsif ($suffix eq 'editor') { | ||||
372 | $type = 'editor'; | ||||
373 | } elsif ($suffix eq 'subscribe') { | ||||
374 | $type = 'subscribe'; | ||||
375 | } elsif ($suffix eq 'unsubscribe') { | ||||
376 | $type = 'unsubscribe'; | ||||
377 | } else { | ||||
378 | $name = $mailbox; | ||||
379 | $type = 'UNKNOWN'; | ||||
380 | } | ||||
381 | return ($name, $type); | ||||
382 | } else { | ||||
383 | return ($mailbox); | ||||
384 | } | ||||
385 | } | ||||
386 | |||||
387 | # Old name: SympaspoolClassic::analyze_file_name(). | ||||
388 | # spent 1.20s (105ms+1.09) within Sympa::Spool::unmarshal_metadata which was called 2300 times, avg 520µs/call:
# 2300 times (105ms+1.09s) by Sympa::Spool::unmarshal at line 283, avg 520µs/call | ||||
389 | 2300 | 3.35ms | 2300 | 589ms | $log->syslog('debug3', '(%s, %s, %s)', @_); # spent 589ms making 2300 calls to Sympa::Log::syslog, avg 256µs/call |
390 | 2300 | 894µs | my $spool_dir = shift; | ||
391 | 2300 | 428µs | my $marshalled = shift; | ||
392 | 2300 | 521µs | my $marshal_regexp = shift; | ||
393 | 2300 | 442µs | my $marshal_keys = shift; | ||
394 | |||||
395 | 2300 | 410µs | my $data; | ||
396 | my @matches; | ||||
397 | 2300 | 33.0ms | 4600 | 10.7ms | unless (@matches = ($marshalled =~ /$marshal_regexp/)) { # spent 7.59ms making 2300 calls to Sympa::Spool::CORE:match, avg 3µs/call
# spent 3.15ms making 2300 calls to Sympa::Spool::CORE:regcomp, avg 1µs/call |
398 | $log->syslog('debug', | ||||
399 | 'File name %s does not have the proper format: %s', | ||||
400 | $marshalled, $marshal_regexp); | ||||
401 | return undef; | ||||
402 | } | ||||
403 | $data = { | ||||
404 | messagekey => $marshalled, | ||||
405 | map { | ||||
406 | 11500 | 2.46ms | my $value = shift @matches; | ||
407 | 11500 | 5.01ms | (defined $value and length $value) ? (lc($_) => $value) : (); | ||
408 | 2300 | 12.5ms | } @{$marshal_keys} | ||
409 | }; | ||||
410 | |||||
411 | 2300 | 512µs | my ($robot_id, $family, $listname, $type, $list, $priority); | ||
412 | |||||
413 | $robot_id = lc($data->{'domainpart'}) | ||||
414 | if defined $data->{'domainpart'} | ||||
415 | and length $data->{'domainpart'} | ||||
416 | 2300 | 8.46ms | 2300 | 5.43ms | and Conf::valid_robot($data->{'domainpart'}, {just_try => 1}); # spent 5.43ms making 2300 calls to Conf::valid_robot, avg 2µs/call |
417 | |||||
418 | 2300 | 2.15ms | if ($data->{localpart} and 0 == index $data->{localpart}, '@') { | ||
419 | my $familyname = substr $data->{localpart}, 1; | ||||
420 | $family = Sympa::Family->new($familyname, $robot_id || '*'); | ||||
421 | } else { | ||||
422 | ($listname, $type) = Sympa::Spool::split_listname($robot_id || '*', | ||||
423 | 2300 | 3.75ms | 2300 | 45.4ms | $data->{'localpart'}); # spent 45.4ms making 2300 calls to Sympa::Spool::split_listname, avg 20µs/call |
424 | 2300 | 759µs | $list = | ||
425 | Sympa::List->new($listname, $robot_id || '*', {'just_try' => 1}) | ||||
426 | if defined $listname; | ||||
427 | } | ||||
428 | |||||
429 | ## Get priority | ||||
430 | #FIXME: is this always needed? | ||||
431 | 2300 | 4.87ms | 2300 | 4.14ms | if (exists $data->{'priority'}) { # spent 4.14ms making 2300 calls to Conf::get_robot_conf, avg 2µs/call |
432 | # Priority was given by metadata. | ||||
433 | ; | ||||
434 | } elsif ($type and $type eq 'sympaowner') { # sympa-request | ||||
435 | $priority = 0; | ||||
436 | } elsif ($type and $type eq 'listmaster') { | ||||
437 | ## highest priority | ||||
438 | $priority = 0; | ||||
439 | } elsif ($type and $type eq 'owner') { # -request | ||||
440 | $priority = Conf::get_robot_conf($robot_id, 'request_priority'); | ||||
441 | } elsif ($type and $type eq 'return_path') { # -owner | ||||
442 | $priority = Conf::get_robot_conf($robot_id, 'owner_priority'); | ||||
443 | } elsif ($type and $type eq 'sympa') { | ||||
444 | $priority = Conf::get_robot_conf($robot_id, 'sympa_priority'); | ||||
445 | } elsif (ref $list eq 'Sympa::List') { | ||||
446 | $priority = $list->{'admin'}{'priority'}; | ||||
447 | } else { | ||||
448 | $priority = Conf::get_robot_conf($robot_id, 'default_list_priority'); | ||||
449 | } | ||||
450 | |||||
451 | 2300 | 3.07ms | $data->{context} = $list || $family || $robot_id || '*'; | ||
452 | 2300 | 339µs | $data->{'listname'} = $listname if $listname; | ||
453 | 2300 | 1.13ms | $data->{'listtype'} = $type if defined $type; | ||
454 | 2300 | 1.09ms | $data->{'priority'} = $priority if defined $priority; | ||
455 | |||||
456 | $log->syslog('debug3', 'messagekey=%s, context=%s, priority=%s', | ||||
457 | 2300 | 3.27ms | 2300 | 436ms | $marshalled, $data->{context}, $data->{'priority'}); # spent 436ms making 2300 calls to Sympa::Log::syslog, avg 189µs/call |
458 | |||||
459 | 2300 | 5.08ms | return $data; | ||
460 | } | ||||
461 | |||||
462 | sub marshal_metadata { | ||||
463 | my $message = shift; | ||||
464 | my $marshal_format = shift; | ||||
465 | my $marshal_keys = shift; | ||||
466 | my %options = @_; | ||||
467 | |||||
468 | # "sympa@DOMAIN", "@FAMILYNAME@DOMAIN" and "LISTNAME(-TYPE)@DOMAIN" are | ||||
469 | # supported. | ||||
470 | my ($localpart, $domainpart); | ||||
471 | my $that = $message->{context}; | ||||
472 | if (ref $that eq 'Sympa::List') { | ||||
473 | ($localpart, $domainpart) = split /\@/, | ||||
474 | Sympa::get_address($that, $message->{listtype}); | ||||
475 | } elsif (ref $that eq 'Sympa::Family') { | ||||
476 | my $familyname; | ||||
477 | ($familyname, $domainpart) = split /\@/, $that->get_id; | ||||
478 | $localpart = sprintf '@%s', $familyname; | ||||
479 | } else { | ||||
480 | my $robot_id = $that || '*'; | ||||
481 | $localpart = Conf::get_robot_conf($robot_id, 'email'); | ||||
482 | $domainpart = Conf::get_robot_conf($robot_id, 'domain'); | ||||
483 | } | ||||
484 | |||||
485 | my @args = map { | ||||
486 | if ($_ eq 'localpart') { | ||||
487 | $localpart; | ||||
488 | } elsif ($_ eq 'domainpart') { | ||||
489 | $domainpart; | ||||
490 | } elsif (lc $_ ne $_ | ||||
491 | and $options{keep_keys} | ||||
492 | and exists $message->{lc $_} | ||||
493 | and defined $message->{lc $_} | ||||
494 | and !ref($message->{lc $_})) { | ||||
495 | # If keep_keys is set, use metadata instead of auto-generated | ||||
496 | # values. | ||||
497 | $message->{lc $_}; | ||||
498 | } elsif ($_ eq 'AUTHKEY') { | ||||
499 | Digest::MD5::md5_hex(time . (int rand 46656) . $domainpart); | ||||
500 | } elsif ($_ eq 'KEYAUTH') { | ||||
501 | substr | ||||
502 | Digest::MD5::md5_hex(time . (int rand 46656) . $domainpart), | ||||
503 | 0, 16; | ||||
504 | } elsif ($_ eq 'PID') { | ||||
505 | $PID; | ||||
506 | } elsif ($_ eq 'RAND') { | ||||
507 | int rand 10000; | ||||
508 | } elsif ($_ eq 'TIME') { | ||||
509 | Time::HiRes::time(); | ||||
510 | } elsif (exists $message->{$_} | ||||
511 | and defined $message->{$_} | ||||
512 | and !ref($message->{$_})) { | ||||
513 | $message->{$_}; | ||||
514 | } else { | ||||
515 | ''; | ||||
516 | } | ||||
517 | } @{$marshal_keys}; | ||||
518 | |||||
519 | # Set "C" locale so that decimal point for "%f" will be ".". | ||||
520 | my $locale_numeric = POSIX::setlocale(POSIX::LC_NUMERIC()); | ||||
521 | POSIX::setlocale(POSIX::LC_NUMERIC(), 'C'); | ||||
522 | my $marshalled = sprintf $marshal_format, @args; | ||||
523 | POSIX::setlocale(POSIX::LC_NUMERIC(), $locale_numeric); | ||||
524 | return $marshalled; | ||||
525 | } | ||||
526 | |||||
527 | sub store_spool { | ||||
528 | my $spool_dir = shift; | ||||
529 | my $message = shift; | ||||
530 | my $marshal_format = shift; | ||||
531 | my $marshal_keys = shift; | ||||
532 | my %options = @_; | ||||
533 | |||||
534 | # At first content is stored into temporary file that has unique name and | ||||
535 | # is referred only by this function. | ||||
536 | my $tmppath = sprintf '%s/T.sympa@_tempfile.%s.%ld.%ld', | ||||
537 | $spool_dir, Sys::Hostname::hostname(), time, $PID; | ||||
538 | my $fh; | ||||
539 | unless (open $fh, '>', $tmppath) { | ||||
540 | die sprintf 'Cannot create %s: %s', $tmppath, $ERRNO; | ||||
541 | } | ||||
542 | print $fh $message->to_string(original => $options{original}); | ||||
543 | close $fh; | ||||
544 | |||||
545 | # Rename temporary path to the file name including metadata. | ||||
546 | # Will retry up to five times. | ||||
547 | my $tries; | ||||
548 | for ($tries = 0; $tries < 5; $tries++) { | ||||
549 | my $metadata = {%$message}; | ||||
550 | if (ref $options{_filter_pre} eq 'CODE') { | ||||
551 | next unless $options{_filter_pre}->($metadata); | ||||
552 | } | ||||
553 | |||||
554 | my $marshalled = | ||||
555 | Sympa::Spool::marshal_metadata($metadata, $marshal_format, | ||||
556 | $marshal_keys); | ||||
557 | next unless defined $marshalled and length $marshalled; | ||||
558 | my $path = $spool_dir . '/' . $marshalled; | ||||
559 | |||||
560 | my $lock; | ||||
561 | unless ($lock = Sympa::LockedFile->new($path, -1, '+')) { | ||||
562 | next; | ||||
563 | } | ||||
564 | if (-e $path) { | ||||
565 | $lock->close; | ||||
566 | next; | ||||
567 | } | ||||
568 | |||||
569 | unless (rename $tmppath, $path) { | ||||
570 | die sprintf 'Cannot create %s: %s', $path, $ERRNO; | ||||
571 | } | ||||
572 | $lock->close; | ||||
573 | |||||
574 | # Set mtime to be {date} in metadata of the message. | ||||
575 | my $mtime = | ||||
576 | defined $message->{date} ? $message->{date} | ||||
577 | : defined $message->{time} ? $message->{time} | ||||
578 | : time; | ||||
579 | utime $mtime, $mtime, $path; | ||||
580 | |||||
581 | return $marshalled; | ||||
582 | } | ||||
583 | |||||
584 | unlink $tmppath; | ||||
585 | return undef; | ||||
586 | } | ||||
587 | |||||
588 | 1; | ||||
589 | __END__ | ||||
# spent 4.48ms within Sympa::Spool::CORE:close which was called 1150 times, avg 4µs/call:
# 1150 times (4.48ms+0s) by Sympa::Spool::next at line 168, avg 4µs/call | |||||
# spent 428µs within Sympa::Spool::CORE:closedir which was called 230 times, avg 2µs/call:
# 230 times (428µs+0s) by Sympa::Spool::_load at line 194, avg 2µs/call | |||||
# spent 18µs within Sympa::Spool::CORE:ftdir which was called:
# once (18µs+0s) by Sympa::Spool::_create at line 85 | |||||
# spent 14.5ms within Sympa::Spool::CORE:ftfile which was called 2300 times, avg 6µs/call:
# 2300 times (14.5ms+0s) by Sympa::Spool::_load at line 203, avg 6µs/call | |||||
# spent 21.5ms within Sympa::Spool::CORE:match which was called 7821 times, avg 3µs/call:
# 5520 times (13.9ms+0s) by Sympa::Spool::_load at line 203, avg 3µs/call
# 2300 times (7.59ms+0s) by Sympa::Spool::unmarshal_metadata at line 397, avg 3µs/call
# once (7µs+0s) by Sympa::Spool::build_glob_pattern at line 323 | |||||
# spent 18.6ms within Sympa::Spool::CORE:open which was called 1150 times, avg 16µs/call:
# 1150 times (18.6ms+0s) by Sympa::Spool::next at line 141, avg 16µs/call | |||||
# spent 3.93ms within Sympa::Spool::CORE:open_dir which was called 230 times, avg 17µs/call:
# 230 times (3.93ms+0s) by Sympa::Spool::_load at line 192, avg 17µs/call | |||||
# spent 3.96ms within Sympa::Spool::CORE:readdir which was called 230 times, avg 17µs/call:
# 230 times (3.96ms+0s) by Sympa::Spool::_load at line 193, avg 17µs/call | |||||
# spent 9.55ms within Sympa::Spool::CORE:readline which was called 1150 times, avg 8µs/call:
# 1150 times (9.55ms+0s) by Sympa::Spool::next at line 161, avg 8µs/call | |||||
# spent 3.15ms within Sympa::Spool::CORE:regcomp which was called 2300 times, avg 1µs/call:
# 2300 times (3.15ms+0s) by Sympa::Spool::unmarshal_metadata at line 397, avg 1µs/call | |||||
sub Sympa::Spool::CORE:sort; # opcode | |||||
sub Sympa::Spool::CORE:subst; # opcode | |||||
# spent 8µs within Sympa::Spool::CORE:substcont which was called 6 times, avg 1µs/call:
# 6 times (8µs+0s) by Sympa::Spool::build_glob_pattern at line 305, avg 1µs/call | |||||
sub Sympa::Spool::CORE:umask; # opcode |