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

Filename/usr/local/libexec/sympa/Sympa/List.pm
StatementsExecuted 274112 statements in 1.42s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
149411841ms26.9sSympa::List::::_load_edit_list_confSympa::List::_load_edit_list_conf
13435170.2ms339msSympa::List::::_load_list_paramSympa::List::_load_list_param
14941169.9ms28.6sSympa::List::::newSympa::List::new
3451156.2ms28.9sSympa::List::::get_listsSympa::List::get_lists
14942153.6ms1.36sSympa::List::::loadSympa::List::load
131145.2ms845msSympa::List::::_load_list_config_fileSympa::List::_load_list_config_file
47919136.2ms36.2msSympa::List::::CORE:regcompSympa::List::CORE:regcomp (opcode)
13771136.1ms1.07sSympa::List::::has_included_usersSympa::List::has_included_users
60932135.1ms35.1msSympa::List::::CORE:ftereadSympa::List::CORE:fteread (opcode)
36836130.6ms30.6msSympa::List::::CORE:ftdirSympa::List::CORE:ftdir (opcode)
1151128.4ms67.3msSympa::List::::get_robotsSympa::List::get_robots
33342128.2ms28.2msSympa::List::::CORE:ftfileSympa::List::CORE:ftfile (opcode)
116912222.4ms22.4msSympa::List::::get_idSympa::List::get_id
13771118.4ms18.4msSympa::List::::has_data_sourcesSympa::List::has_data_sources
2509525114.5ms14.5msSympa::List::::CORE:matchSympa::List::CORE:match (opcode)
460218.39ms8.39msSympa::List::::CORE:readdirSympa::List::CORE:readdir (opcode)
460216.30ms6.30msSympa::List::::CORE:open_dirSympa::List::CORE:open_dir (opcode)
1494114.39ms4.39msSympa::List::::get_familySympa::List::get_family
1838411.72ms1.72msSympa::List::::CORE:substSympa::List::CORE:subst (opcode)
460211.32ms1.32msSympa::List::::CORE:sortSympa::List::CORE:sort (opcode)
1007311.20ms1.20msSympa::List::::CORE:readlineSympa::List::CORE:readline (opcode)
46021725µs725µsSympa::List::::CORE:closedirSympa::List::CORE:closedir (opcode)
1311413µs759µsSympa::List::::_load_list_config_postprocessSympa::List::_load_list_config_postprocess
1311180µs180µsSympa::List::::CORE:openSympa::List::CORE:open (opcode)
131154µs54µsSympa::List::::CORE:closeSympa::List::CORE:close (opcode)
393146µs46µsSympa::List::::CORE:qrSympa::List::CORE:qr (opcode)
131130µs30µsSympa::List::::_load_include_admin_user_postprocessSympa::List::_load_include_admin_user_postprocess
11121µs284µsSympa::List::::__ANON__[:4267]Sympa::List::__ANON__[:4267]
6113µs3µsSympa::List::::CORE:substcontSympa::List::CORE:substcont (opcode)
0000s0sSympa::List::::BEGIN@30Sympa::List::BEGIN@30
0000s0sSympa::List::::BEGIN@31Sympa::List::BEGIN@31
0000s0sSympa::List::::BEGIN@32Sympa::List::BEGIN@32
0000s0sSympa::List::::BEGIN@33Sympa::List::BEGIN@33
0000s0sSympa::List::::BEGIN@34Sympa::List::BEGIN@34
0000s0sSympa::List::::BEGIN@35Sympa::List::BEGIN@35
0000s0sSympa::List::::BEGIN@36Sympa::List::BEGIN@36
0000s0sSympa::List::::BEGIN@38Sympa::List::BEGIN@38
0000s0sSympa::List::::BEGIN@39Sympa::List::BEGIN@39
0000s0sSympa::List::::BEGIN@40Sympa::List::BEGIN@40
0000s0sSympa::List::::BEGIN@41Sympa::List::BEGIN@41
0000s0sSympa::List::::BEGIN@42Sympa::List::BEGIN@42
0000s0sSympa::List::::BEGIN@43Sympa::List::BEGIN@43
0000s0sSympa::List::::BEGIN@44Sympa::List::BEGIN@44
0000s0sSympa::List::::BEGIN@45Sympa::List::BEGIN@45
0000s0sSympa::List::::BEGIN@46Sympa::List::BEGIN@46
0000s0sSympa::List::::BEGIN@47Sympa::List::BEGIN@47
0000s0sSympa::List::::BEGIN@48Sympa::List::BEGIN@48
0000s0sSympa::List::::BEGIN@49Sympa::List::BEGIN@49
0000s0sSympa::List::::BEGIN@4924Sympa::List::BEGIN@4924
0000s0sSympa::List::::BEGIN@50Sympa::List::BEGIN@50
0000s0sSympa::List::::BEGIN@51Sympa::List::BEGIN@51
0000s0sSympa::List::::BEGIN@52Sympa::List::BEGIN@52
0000s0sSympa::List::::BEGIN@53Sympa::List::BEGIN@53
0000s0sSympa::List::::BEGIN@54Sympa::List::BEGIN@54
0000s0sSympa::List::::BEGIN@55Sympa::List::BEGIN@55
0000s0sSympa::List::::BEGIN@56Sympa::List::BEGIN@56
0000s0sSympa::List::::BEGIN@57Sympa::List::BEGIN@57
0000s0sSympa::List::::BEGIN@58Sympa::List::BEGIN@58
0000s0sSympa::List::::BEGIN@59Sympa::List::BEGIN@59
0000s0sSympa::List::::BEGIN@60Sympa::List::BEGIN@60
0000s0sSympa::List::::BEGIN@61Sympa::List::BEGIN@61
0000s0sSympa::List::::BEGIN@62Sympa::List::BEGIN@62
0000s0sSympa::List::::__ANON__Sympa::List::__ANON__ (xsub)
0000s0sSympa::List::::__ANON__[:4263]Sympa::List::__ANON__[:4263]
0000s0sSympa::List::::__ANON__[:4265]Sympa::List::__ANON__[:4265]
0000s0sSympa::List::::_add_list_adminSympa::List::_add_list_admin
0000s0sSympa::List::::_by_orderSympa::List::_by_order
0000s0sSympa::List::::_cache_getSympa::List::_cache_get
0000s0sSympa::List::::_cache_publish_expirySympa::List::_cache_publish_expiry
0000s0sSympa::List::::_cache_putSympa::List::_cache_put
0000s0sSympa::List::::_cache_read_expirySympa::List::_cache_read_expiry
0000s0sSympa::List::::_create_add_error_stringSympa::List::_create_add_error_string
0000s0sSympa::List::::_flush_list_dbSympa::List::_flush_list_db
0000s0sSympa::List::::_get_single_param_valueSympa::List::_get_single_param_value
0000s0sSympa::List::::_increment_msg_countSympa::List::_increment_msg_count
0000s0sSympa::List::::_list_admin_colsSympa::List::_list_admin_cols
0000s0sSympa::List::::_list_member_colsSympa::List::_list_member_cols
0000s0sSympa::List::::_load_config_changes_fileSympa::List::_load_config_changes_file
0000s0sSympa::List::::_load_include_admin_user_fileSympa::List::_load_include_admin_user_file
0000s0sSympa::List::::_map_list_admin_colsSympa::List::_map_list_admin_cols
0000s0sSympa::List::::_map_list_member_colsSympa::List::_map_list_member_cols
0000s0sSympa::List::::_save_config_changes_fileSympa::List::_save_config_changes_file
0000s0sSympa::List::::_save_list_config_fileSympa::List::_save_list_config_file
0000s0sSympa::List::::_save_list_paramSympa::List::_save_list_param
0000s0sSympa::List::::_update_list_dbSympa::List::_update_list_db
0000s0sSympa::List::::add_list_adminSympa::List::add_list_admin
0000s0sSympa::List::::add_list_headerSympa::List::add_list_header
0000s0sSympa::List::::add_list_memberSympa::List::add_list_member
0000s0sSympa::List::::available_reception_modeSympa::List::available_reception_mode
0000s0sSympa::List::::delete_list_adminSympa::List::delete_list_admin
0000s0sSympa::List::::delete_list_memberSympa::List::delete_list_member
0000s0sSympa::List::::delete_list_member_pictureSympa::List::delete_list_member_picture
0000s0sSympa::List::::destroy_multitonSympa::List::destroy_multiton
0000s0sSympa::List::::dump_usersSympa::List::dump_users
0000s0sSympa::List::::find_picture_filenamesSympa::List::find_picture_filenames
0000s0sSympa::List::::find_picture_pathsSympa::List::find_picture_paths
0000s0sSympa::List::::find_picture_urlSympa::List::find_picture_url
0000s0sSympa::List::::get_adminsSympa::List::get_admins
0000s0sSympa::List::::get_admins_emailSympa::List::get_admins_email
0000s0sSympa::List::::get_archive_dirSympa::List::get_archive_dir
0000s0sSympa::List::::get_available_msg_topicSympa::List::get_available_msg_topic
0000s0sSympa::List::::get_bounce_addressSympa::List::get_bounce_address
0000s0sSympa::List::::get_bounce_dirSympa::List::get_bounce_dir
0000s0sSympa::List::::get_certSympa::List::get_cert
0000s0sSympa::List::::get_config_changesSympa::List::get_config_changes
0000s0sSympa::List::::get_current_adminsSympa::List::get_current_admins
0000s0sSympa::List::::get_db_field_typeSympa::List::get_db_field_type
0000s0sSympa::List::::get_default_user_optionsSympa::List::get_default_user_options
0000s0sSympa::List::::get_digest_recipients_per_modeSympa::List::get_digest_recipients_per_mode
0000s0sSympa::List::::get_digest_spool_dirSympa::List::get_digest_spool_dir
0000s0sSympa::List::::get_exclusionSympa::List::get_exclusion
0000s0sSympa::List::::get_first_bouncing_list_memberSympa::List::get_first_bouncing_list_member
0000s0sSympa::List::::get_first_list_memberSympa::List::get_first_list_member
0000s0sSympa::List::::get_including_listsSympa::List::get_including_lists
0000s0sSympa::List::::get_infoSympa::List::get_info
0000s0sSympa::List::::get_latest_distribution_dateSympa::List::get_latest_distribution_date
0000s0sSympa::List::::get_list_addressSympa::List::get_list_address
0000s0sSympa::List::::get_list_adminSympa::List::get_list_admin
0000s0sSympa::List::::get_list_idSympa::List::get_list_id
0000s0sSympa::List::::get_list_memberSympa::List::get_list_member
0000s0sSympa::List::::get_max_sizeSympa::List::get_max_size
0000s0sSympa::List::::get_membersSympa::List::get_members
0000s0sSympa::List::::get_msg_countSympa::List::get_msg_count
0000s0sSympa::List::::get_next_bouncing_list_memberSympa::List::get_next_bouncing_list_member
0000s0sSympa::List::::get_next_delivery_dateSympa::List::get_next_delivery_date
0000s0sSympa::List::::get_next_list_memberSympa::List::get_next_list_member
0000s0sSympa::List::::get_param_valueSympa::List::get_param_value
0000s0sSympa::List::::get_picture_pathSympa::List::get_picture_path
0000s0sSympa::List::::get_recipients_per_modeSympa::List::get_recipients_per_mode
0000s0sSympa::List::::get_reply_toSympa::List::get_reply_to
0000s0sSympa::List::::get_resembling_membersSympa::List::get_resembling_members
0000s0sSympa::List::::get_statsSympa::List::get_stats
0000s0sSympa::List::::get_totalSympa::List::get_total
0000s0sSympa::List::::get_total_bouncingSympa::List::get_total_bouncing
0000s0sSympa::List::::get_whichSympa::List::get_which
0000s0sSympa::List::::insert_delete_exclusionSympa::List::insert_delete_exclusion
0000s0sSympa::List::::is_adminSympa::List::is_admin
0000s0sSympa::List::::is_archivedSympa::List::is_archived
0000s0sSympa::List::::is_archiving_enabledSympa::List::is_archiving_enabled
0000s0sSympa::List::::is_available_msg_topicSympa::List::is_available_msg_topic
0000s0sSympa::List::::is_available_reception_modeSympa::List::is_available_reception_mode
0000s0sSympa::List::::is_digestSympa::List::is_digest
0000s0sSympa::List::::is_includedSympa::List::is_included
0000s0sSympa::List::::is_list_memberSympa::List::is_list_member
0000s0sSympa::List::::is_member_excludedSympa::List::is_member_excluded
0000s0sSympa::List::::is_moderatedSympa::List::is_moderated
0000s0sSympa::List::::is_msg_topic_tagging_requiredSympa::List::is_msg_topic_tagging_required
0000s0sSympa::List::::is_there_msg_topicSympa::List::is_there_msg_topic
0000s0sSympa::List::::is_web_archivedSympa::List::is_web_archived
0000s0sSympa::List::::load_data_sources_listSympa::List::load_data_sources_list
0000s0sSympa::List::::may_editSympa::List::may_edit
0000s0sSympa::List::::move_messageSympa::List::move_message
0000s0sSympa::List::::parse_list_member_bounceSympa::List::parse_list_member_bounce
0000s0sSympa::List::::restore_suspended_subscriptionSympa::List::restore_suspended_subscription
0000s0sSympa::List::::restore_usersSympa::List::restore_users
0000s0sSympa::List::::save_configSympa::List::save_config
0000s0sSympa::List::::search_list_among_robotsSympa::List::search_list_among_robots
0000s0sSympa::List::::select_list_members_for_topicSympa::List::select_list_members_for_topic
0000s0sSympa::List::::send_notify_to_ownerSympa::List::send_notify_to_owner
0000s0sSympa::List::::send_probe_to_userSympa::List::send_probe_to_user
0000s0sSympa::List::::set_status_error_configSympa::List::set_status_error_config
0000s0sSympa::List::::suspend_subscriptionSympa::List::suspend_subscription
0000s0sSympa::List::::sync_includeSympa::List::sync_include
0000s0sSympa::List::::update_config_changesSympa::List::update_config_changes
0000s0sSympa::List::::update_list_adminSympa::List::update_list_admin
0000s0sSympa::List::::update_list_memberSympa::List::update_list_member
0000s0sSympa::List::::update_statsSympa::List::update_stats
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, 2021 The Sympa Community. See the
12# AUTHORS.md 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
28package Sympa::List;
29
30use strict;
31use warnings;
32use Digest::MD5 qw();
33use English qw(-no_match_vars);
34use IO::Scalar;
35use POSIX qw();
36use Storable qw();
37
38use Sympa;
39use Conf;
40use Sympa::ConfDef;
41use Sympa::Constants;
42use Sympa::Database;
43use Sympa::DatabaseDescription;
44use Sympa::DatabaseManager;
45use Sympa::Family;
46use Sympa::Language;
47use Sympa::List::Config;
48use Sympa::ListDef;
49use Sympa::LockedFile;
50use Sympa::Log;
51use Sympa::Regexps;
52use Sympa::Robot;
53use Sympa::Spindle::ProcessRequest;
54use Sympa::Spindle::ProcessTemplate;
55use Sympa::Spool::Auth;
56use Sympa::Template;
57use Sympa::Tools::Data;
58use Sympa::Tools::Domains;
59use Sympa::Tools::File;
60use Sympa::Tools::SMIME;
61use Sympa::Tools::Text;
62use Sympa::User;
63
64my @sources_providing_listmembers = qw/
65 include_file
66 include_ldap_2level_query
67 include_ldap_query
68 include_remote_file
69 include_remote_sympa_list
70 include_sql_query
71 include_sympa_list
72 /;
73
74# No longer used.
75#my @more_data_sources;
76
77# All non-pluggable sources are in the admin user file
78# NO LONGER USED.
79my %config_in_admin_user_file = map +($_ => 1),
80 @sources_providing_listmembers;
81
82my $language = Sympa::Language->instance;
83my $log = Sympa::Log->instance;
84
85## Database and SQL statement handlers
86my ($sth, @sth_stack);
87
88# DB fields with numeric type.
89# We should not do quote() for these while inserting data.
90my %db_struct = Sympa::DatabaseDescription::full_db_struct();
91my %numeric_field;
92foreach my $t (qw(subscriber_table admin_table)) {
93 foreach my $k (keys %{$db_struct{$t}->{fields}}) {
94 if ($db_struct{$t}->{fields}{$k}{struct} =~ /\A(tiny|small|big)?int/)
95 {
96 $numeric_field{$k} = 1;
97 }
98 }
99}
100
101# This is the generic hash which keeps all lists in memory.
102my %list_of_lists = ();
103
104## Creates an object.
105
# spent 28.6s (69.9ms+28.6) within Sympa::List::new which was called 1494 times, avg 19.2ms/call: # 1494 times (69.9ms+28.6s) by Sympa::List::get_lists at line 4600, avg 19.2ms/call
sub new {
10614941.38ms my ($pkg, $name, $robot, $options) = @_;
1071494797µs my $list = {};
10814945.17ms1494301ms $log->syslog('debug3', '(%s, %s, %s)', $name, $robot,
# spent 301ms making 1494 calls to Sympa::Log::syslog, avg 202µs/call
109 join('/', keys %$options));
110
111 # Lowercase list name.
11214941.05ms $name = lc $name;
113 # In case the variable was multiple. FIXME:required?
11414942.98ms1494936µs $name = $1 if $name =~ /^(\S+)\0/;
# spent 936µs making 1494 calls to Sympa::List::CORE:match, avg 627ns/call
115
116 ## Allow robot in the name
11714942.10ms1494564µs if ($name =~ /\@/) {
# spent 564µs making 1494 calls to Sympa::List::CORE:match, avg 377ns/call
118 my @parts = split /\@/, $name;
119 $robot ||= $parts[1];
120 $name = $parts[0];
121 }
122
123 # Look for the list if no robot was provided.
1241494809µs if (not $robot or $robot eq '*') {
125 #FIXME: Default robot would be used instead of oppotunistic search.
126 $robot = search_list_among_robots($name);
127 } else {
1281494692µs $robot = lc $robot; #FIXME: More canonicalization.
129 }
130
1311494267µs unless ($robot) {
132 $log->syslog('err',
133 'Missing robot parameter, cannot create list object for %s',
134 $name)
135 unless ($options->{'just_try'});
136 return undef;
137 }
138
1391494328µs $options = {} unless (defined $options);
140
141 ## Only process the list if the name is valid.
142 #FIXME: Existing lists may be checked with looser rule.
1431494403µs my $listname_regexp = Sympa::Regexps::listname();
144149416.5ms29882.30ms unless ($name and ($name =~ /^($listname_regexp)$/io)) {
# spent 1.99ms making 1494 calls to Sympa::List::CORE:match, avg 1µs/call # spent 309µs making 1494 calls to Sympa::List::CORE:regcomp, avg 207ns/call
145 $log->syslog('err', 'Incorrect listname "%s"', $name)
146 unless ($options->{'just_try'});
147 return undef;
148 }
149 ## Lowercase the list name.
15014941.02ms $name = $1;
15114941.03ms $name =~ tr/A-Z/a-z/;
152
153 ## Reject listnames with reserved list suffixes
15414942.41ms14946.39ms my $regx = Conf::get_robot_conf($robot, 'list_check_regexp');
# spent 6.39ms making 1494 calls to Conf::get_robot_conf, avg 4µs/call
1551494639µs if ($regx) {
156149411.4ms29883.13ms if ($name =~ /^(\S+)-($regx)$/) {
# spent 2.22ms making 1494 calls to Sympa::List::CORE:regcomp, avg 1µs/call # spent 912µs making 1494 calls to Sympa::List::CORE:match, avg 611ns/call
157 $log->syslog(
158 'err',
159 'Incorrect name: listname "%s" matches one of service aliases',
160 $name
161 ) unless ($options->{'just_try'});
162 return undef;
163 }
164 }
165
1661494271µs my $status;
167 ## If list already in memory and not previously purged by another process
168149418.6ms148114.4ms if ($list_of_lists{$robot}{$name}
# spent 14.4ms making 1481 calls to Sympa::List::CORE:ftdir, avg 10µs/call
169 and -d $list_of_lists{$robot}{$name}{'dir'}) {
170 # use the current list in memory and update it
17114811.27ms $list = $list_of_lists{$robot}{$name};
172
17314812.52ms1481509ms $status = $list->load($name, $robot, $options);
# spent 509ms making 1481 calls to Sympa::List::load, avg 344µs/call
174 } else {
175 # create a new object list
176138µs bless $list, $pkg;
177
1781315µs $options->{'first_access'} = 1;
1791341µs13855ms $status = $list->load($name, $robot, $options);
# spent 855ms making 13 calls to Sympa::List::load, avg 65.8ms/call
180 }
1811494346µs unless (defined $status) {
182 return undef;
183 }
184
185 $list->_load_edit_list_conf(
18614943.09ms149426.9s reload_config => ($options->{reload_config} || $status));
# spent 26.9s making 1494 calls to Sympa::List::_load_edit_list_conf, avg 18.0ms/call
187
188149413.9ms return $list;
189}
190
191## When no robot is specified, look for a list among robots
192sub search_list_among_robots {
193 my $listname = shift;
194
195 unless ($listname) {
196 $log->syslog('err', 'Missing list parameter');
197 return undef;
198 }
199
200 ## Search in default robot
201 if (-d $Conf::Conf{'home'} . '/' . $listname) {
202 return $Conf::Conf{'domain'};
203 }
204
205 foreach my $r (keys %{$Conf::Conf{'robots'}}) {
206 if (-d $Conf::Conf{'home'} . '/' . $r . '/' . $listname) {
207 return $r;
208 }
209 }
210
211 return 0;
212}
213
214## set the list in status error_config and send a notify to listmaster
215sub set_status_error_config {
216 $log->syslog('debug2', '(%s, %s, ...)', @_);
217 my ($self, $msg, @param) = @_;
218
219 unless ($self->{'admin'}
220 and $self->{'admin'}{'status'} eq 'error_config') {
221 $self->{'admin'}{'status'} = 'error_config';
222
223 # No more save config in error...
224 # $self->save_config(tools::get_address($self->{'domain'},
225 # 'listmaster'));
226 $log->syslog('err',
227 'The list %s is set in status error_config: %s(%s)',
228 $self, $msg, join(', ', @param));
229 Sympa::send_notify_to_listmaster($self, $msg,
230 [$self->{'name'}, @param]);
231 }
232}
233
234# Destroy multiton instance. FIXME
235sub destroy_multiton {
236 my $self = shift;
237 delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};
238}
239
240## set the list in status family_closed and send a notify to owners
241# Deprecated. Use Sympa::Request::Handler::close_list handler.
242#sub set_status_family_closed;
243
244# Saves the statistics data to disk.
245# Deprecated. Use Sympa::List::update_stats().
246#sub savestats;
247
248## msg count.
249# Old name: increment_msg_count().
250sub _increment_msg_count {
251 $log->syslog('debug2', '(%s)', @_);
252 my $self = shift;
253
254 # Be sure the list has been loaded.
255 my $file = "$self->{'dir'}/msg_count";
256
257 my %count;
258 if (open(MSG_COUNT, $file)) {
259 while (<MSG_COUNT>) {
260 if ($_ =~ /^(\d+)\s(\d+)$/) {
261 $count{$1} = $2;
262 }
263 }
264 close MSG_COUNT;
265 }
266 my $today = int(time / 86400);
267 if ($count{$today}) {
268 $count{$today}++;
269 } else {
270 $count{$today} = 1;
271 }
272
273 unless (open(MSG_COUNT, ">$file.$PID")) {
274 $log->syslog('err', 'Unable to create "%s.%s": %m', $file, $PID);
275 return undef;
276 }
277 foreach my $key (sort { $a <=> $b } keys %count) {
278 printf MSG_COUNT "%d\t%d\n", $key, $count{$key};
279 }
280 close MSG_COUNT;
281
282 unless (rename("$file.$PID", $file)) {
283 $log->syslog('err', 'Unable to write "%s": %m', $file);
284 return undef;
285 }
286 return 1;
287}
288
289# Returns the number of messages sent to the list
290sub get_msg_count {
291 $log->syslog('debug2', '(%s)', @_);
292 my $self = shift;
293
294 # Be sure the list has been loaded.
295 my $file = "$self->{'dir'}/stats";
296
297 my $count = 0;
298 if (open(MSG_COUNT, $file)) {
299 while (<MSG_COUNT>) {
300 if ($_ =~ /^(\d+)\s+(.*)$/) {
301 $count = $1;
302 }
303 }
304 close MSG_COUNT;
305 }
306
307 return $count;
308}
309## last date of distribution message .
310sub get_latest_distribution_date {
311 $log->syslog('debug2', '(%s)', @_);
312 my $self = shift;
313
314 # Be sure the list has been loaded.
315 my $file = "$self->{'dir'}/msg_count";
316
317 my $latest_date = 0;
318 unless (open(MSG_COUNT, $file)) {
319 $log->syslog('debug2', 'Unable to open %s', $file);
320 return undef;
321 }
322
323 while (<MSG_COUNT>) {
324 if ($_ =~ /^(\d+)\s(\d+)$/) {
325 $latest_date = $1 if ($1 > $latest_date);
326 }
327 }
328 close MSG_COUNT;
329
330 return undef if ($latest_date == 0);
331 return $latest_date;
332}
333
334## Update the stats struct
335## Input : num of bytes of msg
336## Output : num of msgs sent
337# Old name: List::update_stats().
338# No longer used. Use Sympa::List::update_stats(1);
339#sub get_next_sequence;
340
341sub get_stats {
342 my $self = shift;
343
344 my @stats;
345 my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '<');
346 if ($lock_fh) {
347 @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
348 $lock_fh->close;
349 }
350
351 foreach my $i ((0 .. 3)) {
352 $stats[$i] = 0 unless $stats[$i];
353 }
354 return @stats[0 .. 3];
355}
356
357sub update_stats {
358 $log->syslog('debug2', '(%s, %s, %s, %s, %s)', @_);
359 my $self = shift;
360 my @diffs = @_;
361
362 my $lock_fh = Sympa::LockedFile->new($self->{'dir'} . '/stats', 2, '+>>');
363 unless ($lock_fh) {
364 $log->syslog('err', 'Could not create new lock');
365 return;
366 }
367
368 # Update stats file.
369 # Note: The last three fields total, last_sync and last_sync_admin_user
370 # were deprecated.
371 seek $lock_fh, 0, 0;
372 my @stats = split /\s+/, do { my $line = <$lock_fh>; $line };
373 foreach my $i ((0 .. 3)) {
374 $stats[$i] ||= 0;
375 $stats[$i] += $diffs[$i] if $diffs[$i];
376 }
377 seek $lock_fh, 0, 0;
378 truncate $lock_fh, 0;
379 printf $lock_fh "%d %.0f %.0f %.0f\n", @stats;
380
381 return unless $lock_fh->close;
382
383 if ($diffs[0]) {
384 $self->_increment_msg_count;
385 }
386
387 return @stats;
388}
389
390sub _cache_publish_expiry {
391 my $self = shift;
392 my $type = shift;
393
394 my $stat_file;
395 if ($type eq 'member') {
396 $stat_file = $self->{'dir'} . '/.last_change.member';
397 } elsif ($type eq 'admin_user') {
398 $stat_file = $self->{'dir'} . '/.last_change.admin';
399 } else {
400 die 'bug in logic. Ask developer';
401 }
402
403 # Touch status file.
404 my $fh;
405 open $fh, '>', $stat_file and close $fh;
406 utime undef, undef, $stat_file; # required for such as NFS.
407}
408
409sub _cache_read_expiry {
410 my $self = shift;
411 my $type = shift;
412
413 if ($type eq 'member') {
414 # If changes have never been done, just now is assumed.
415 my $stat_file = $self->{'dir'} . '/.last_change.member';
416 $self->_cache_publish_expiry('member') unless -e $stat_file;
417 return [stat $stat_file]->[9];
418 } elsif ($type eq 'admin_user') {
419 # If changes have never been done, just now is assumed.
420 my $stat_file = $self->{'dir'} . '/.last_change.admin';
421 $self->_cache_publish_expiry('admin_user') unless -e $stat_file;
422 return [stat $stat_file]->[9];
423 } else {
424 die 'bug in logic. Ask developer';
425 }
426}
427
428sub _cache_get {
429 my $self = shift;
430 my $type = shift;
431
432 my $lasttime = $self->{_mtime}{$type};
433 my $mtime;
434 if ($type eq 'total' or $type eq 'is_list_member') {
435 $mtime = $self->_cache_read_expiry('member');
436 } else {
437 $mtime = $self->_cache_read_expiry($type);
438 }
439 $self->{_mtime}{$type} = $mtime;
440
441 return undef unless defined $lasttime and defined $mtime;
442 return undef if $lasttime <= $mtime;
443 return $self->{_cached}{$type};
444}
445
446sub _cache_put {
447 my $self = shift;
448 my $type = shift;
449 my $value = shift;
450
451 return $self->{_cached}{$type} = $value;
452}
453
454# Old name: List::extract_verp_rcpt().
455# Moved to: Sympa::Spindle::DistributeMessage::_extract_verp_rcpt().
456#sub _extract_verp_rcpt;
457
458# Dumps a copy of list users to disk, in text format.
459# Old name: Sympa::List::dump() which dumped only members.
460sub dump_users {
461 $log->syslog('debug2', '(%s, %s)', @_);
462 my $self = shift;
463 my $role = shift;
464
465 die 'bug in logic. Ask developer'
466 unless grep { $role eq $_ } qw(member owner editor);
467
468 my $file = $self->{'dir'} . '/' . $role . '.dump';
469
470 unlink $file . '.old' if -e $file . '.old';
471 rename $file, $file . '.old' if -e $file;
472 my $lock_fh = Sympa::LockedFile->new($file, 5, '>');
473 unless ($lock_fh) {
474 $log->syslog(
475 'err', 'Failed to save file %s.new: %s',
476 $file, Sympa::LockedFile->last_error
477 );
478 return undef;
479 }
480
481 if ($role eq 'member') {
482 my %map_field = _map_list_member_cols();
483
484 my $user;
485 for (
486 $user = $self->get_first_list_member();
487 $user;
488 $user = $self->get_next_list_member()
489 ) {
490 foreach my $k (sort keys %map_field) {
491 if ($k eq 'custom_attribute') {
492 next unless ref $user->{$k} eq 'HASH' and %{$user->{$k}};
493 my $encoded = Sympa::Tools::Data::encode_custom_attribute(
494 $user->{$k});
495 printf $lock_fh "%s %s\n", $k, $encoded;
496 } else {
497 next unless defined $user->{$k} and length $user->{$k};
498 printf $lock_fh "%s %s\n", $k, $user->{$k};
499 }
500 }
501
502 # Compat.<=6.2.44
503 # This is needed for earlier version of Sympa on e.g. remote host.
504 print $lock_fh "included 1\n"
505 if defined $user->{inclusion};
506
507 print $lock_fh "\n";
508 }
509 } else {
510 my %map_field = _map_list_admin_cols();
511
512 foreach my $user (@{$self->get_current_admins || []}) {
513 next unless $user->{role} eq $role;
514 foreach my $k (sort keys %map_field) {
515 printf $lock_fh "%s %s\n", $k, $user->{$k}
516 if defined $user->{$k} and length $user->{$k};
517 }
518
519 # Compat.<=6.2.44
520 # This is needed for earlier version of Sympa on e.g. remote host.
521 print $lock_fh "included 1\n"
522 if defined $user->{inclusion};
523
524 print $lock_fh "\n";
525 }
526 }
527
528 $lock_fh->close;
529
530 # FIXME:Are these lines required?
531 $self->{'_mtime'}{'config'} =
532 Sympa::Tools::File::get_mtime($self->{'dir'} . '/config');
533
534 return 1;
535}
536
537## Saves the configuration file to disk
538sub save_config {
539 my ($self, $email) = @_;
540 $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $email);
541
542 return undef
543 unless ($self);
544
545 my $config_file_name = "$self->{'dir'}/config";
546
547 ## Lock file
548 my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
549 unless ($lock_fh) {
550 $log->syslog('err', 'Could not create new lock');
551 return undef;
552 }
553
554 my $name = $self->{'name'};
555 my $old_serial = $self->{'admin'}{'serial'};
556 my $old_config_file_name = "$self->{'dir'}/config.$old_serial";
557
558 ## Update management info
559 $self->{'admin'}{'serial'}++;
560 $self->{'admin'}{'update'} = {
561 'email' => $email,
562 'date_epoch' => time,
563 };
564
565 unless (
566 $self->_save_list_config_file(
567 $config_file_name, $old_config_file_name
568 )
569 ) {
570 $log->syslog('info', 'Unable to save config file %s',
571 $config_file_name);
572 $lock_fh->close();
573 return undef;
574 }
575
576 ## Also update the binary version of the data structure
577 if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
578 'binary_file') {
579 eval {
580 Storable::store($self->{'admin'}, "$self->{'dir'}/config.bin");
581 };
582 if ($@) {
583 $log->syslog('err',
584 'Failed to save the binary config %s. error: %s',
585 "$self->{'dir'}/config.bin", $@);
586 }
587 }
588
589 ## Release the lock
590 unless ($lock_fh->close()) {
591 return undef;
592 }
593
594 unless ($self->_update_list_db) {
595 $log->syslog('err', "Unable to update list_table");
596 }
597
598 return 1;
599}
600
601## Loads the administrative data for a list
602
# spent 1.36s (53.6ms+1.31) within Sympa::List::load which was called 1494 times, avg 913µs/call: # 1481 times (52.8ms+456ms) by Sympa::List::new at line 173, avg 344µs/call # 13 times (802µs+854ms) by Sympa::List::new at line 179, avg 65.8ms/call
sub load {
60314941.93ms1494305ms $log->syslog('debug3', '(%s, %s, %s, ...)', @_);
# spent 305ms making 1494 calls to Sympa::Log::syslog, avg 204µs/call
6041494450µs my $self = shift;
6051494470µs my $name = shift;
6061494300µs my $robot = shift;
6071494328µs my $options = shift;
608
6091494377µs die 'bug in logic. Ask developer' unless $robot;
610
611 ## Set of initializations ; only performed when the config is first loaded
6121494653µs if ($options->{'first_access'}) {
613 # Create parent of list directory if not exist yet e.g. when list to
614 # be created manually.
615 # Note: For compatibility, directory with primary domain is omitted.
6161374µs549µs if ( $robot
# spent 49µs making 5 calls to Sympa::List::CORE:ftdir, avg 10µs/call
617 and $robot ne $Conf::Conf{'domain'}
618 and not -d "$Conf::Conf{'home'}/$robot") {
619 mkdir "$Conf::Conf{'home'}/$robot", 0775;
620 }
621
62213153µs1393µs if ($robot && (-d "$Conf::Conf{'home'}/$robot")) {
# spent 93µs making 13 calls to Sympa::List::CORE:ftdir, avg 7µs/call
623 $self->{'dir'} = "$Conf::Conf{'home'}/$robot/$name";
624 } elsif (lc($robot) eq lc($Conf::Conf{'domain'})) {
625 $self->{'dir'} = "$Conf::Conf{'home'}/$name";
626 } else {
627 $log->syslog('err', 'No such robot (virtual domain) %s', $robot)
628 unless ($options->{'just_try'});
629 return undef;
630 }
631
6321312µs $self->{'domain'} = $robot;
633
634 # default list host is robot domain: Deprecated.
635 #XXX$self->{'admin'}{'host'} ||= $self->{'domain'};
636139µs $self->{'name'} = $name;
637 }
638
639149438.4ms298823.1ms unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
# spent 12.4ms making 1494 calls to Sympa::List::CORE:ftfile, avg 8µs/call # spent 10.7ms making 1494 calls to Sympa::List::CORE:ftdir, avg 7µs/call
640 $log->syslog('debug2', 'Missing directory (%s) or config file for %s',
641 $self->{'dir'}, $name)
642 unless ($options->{'just_try'});
643 return undef;
644 }
645
646 # Last modification of list config ($last_time_config) on memory cache.
647 # Note: "subscribers" file was deprecated. No need to load "stats" file.
64814941.11ms my $last_time_config = $self->{'_mtime'}{'config'};
6491494372µs $last_time_config = POSIX::INT_MIN() unless defined $last_time_config;
650
65114942.92ms149450.9ms my $time_config = Sympa::Tools::File::get_mtime("$self->{'dir'}/config");
# spent 50.9ms making 1494 calls to Sympa::Tools::File::get_mtime, avg 34µs/call
65214941.79ms149422.6ms my $time_config_bin =
# spent 22.6ms making 1494 calls to Sympa::Tools::File::get_mtime, avg 15µs/call
653 Sympa::Tools::File::get_mtime("$self->{'dir'}/config.bin");
65414941.32ms149435.4ms my $main_config_time =
# spent 35.4ms making 1494 calls to Sympa::Tools::File::get_mtime, avg 24µs/call
655 Sympa::Tools::File::get_mtime(Sympa::Constants::CONFIG);
656 # my $web_config_time = Sympa::Tools::File::get_mtime(Sympa::Constants::WWSCONFIG);
6571494245µs my $config_reloaded = 0;
6581494263µs my $admin;
659
66014943.39ms14944.21ms if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
# spent 4.21ms making 1494 calls to Conf::get_robot_conf, avg 3µs/call
661 'binary_file'
662 and !$options->{'reload_config'}
663 and $time_config_bin > $last_time_config
664 and $time_config_bin >= $time_config
665 and $time_config_bin >= $main_config_time) {
666 ## Get a shared lock on config file first
667 my $lock_fh =
668 Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
669 unless ($lock_fh) {
670 $log->syslog('err', 'Could not create new lock');
671 return undef;
672 }
673
674 ## Load a binary version of the data structure
675 ## unless config is more recent than config.bin
676 eval { $admin = Storable::retrieve("$self->{'dir'}/config.bin") };
677 if ($@) {
678 $log->syslog('err',
679 'Failed to load the binary config %s, error: %s',
680 "$self->{'dir'}/config.bin", $@);
681 $lock_fh->close();
682 return undef;
683 }
684
685 $config_reloaded = 1;
686 $last_time_config = $time_config_bin;
687 $lock_fh->close();
688 } elsif ($self->{'name'} ne $name
689 or $time_config > $last_time_config
690 or $options->{'reload_config'}) {
6911336µs13845ms $admin = $self->_load_list_config_file;
# spent 845ms making 13 calls to Sympa::List::_load_list_config_file, avg 65.0ms/call
692
693 ## Get a shared lock on config file first
694 my $lock_fh =
6951380µs134.47ms Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
# spent 4.47ms making 13 calls to IO::File::new, avg 344µs/call
696134µs unless ($lock_fh) {
697 $log->syslog('err', 'Could not create new lock');
698 return undef;
699 }
700
701 ## update the binary version of the data structure
7021332µs1355µs if (Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq
# spent 55µs making 13 calls to Conf::get_robot_conf, avg 4µs/call
703 'binary_file') {
704 eval { Storable::store($admin, "$self->{'dir'}/config.bin") };
705 if ($@) {
706 $log->syslog('err',
707 'Failed to save the binary config %s. error: %s',
708 "$self->{'dir'}/config.bin", $@);
709 }
710 }
711
712134µs $config_reloaded = 1;
713134µs unless (defined $admin) {
714 $log->syslog(
715 'err',
716 'Impossible to load list config file for list %s set in status error_config',
717 $self
718 );
719 $self->set_status_error_config('load_admin_file_error');
720 $lock_fh->close();
721 return undef;
722 }
723
724133µs $last_time_config = $time_config;
7251350µs261.10ms $lock_fh->close();
# spent 1.08ms making 13 calls to Sympa::LockedFile::close, avg 83µs/call # spent 17µs making 13 calls to Sympa::LockedFile::DESTROY, avg 1µs/call
726 }
727
728 ## If config was reloaded...
7291494320µs if ($admin) {
7301311µs $self->{'admin'} = $admin;
731
732 ## check param_constraint.conf if belongs to a family and the config
733 ## has been loaded
7341315µs if ( not $options->{'no_check_family'}
735 and defined $admin->{'family_name'}
736 and $admin->{'status'} ne 'error_config') {
737 my $family;
738 unless ($family = $self->get_family()) {
739 $log->syslog(
740 'err',
741 'Impossible to get list %s family: %s. The list is set in status error_config',
742 $self,
743 $self->{'admin'}{'family_name'}
744 );
745 $self->set_status_error_config('no_list_family',
746 $self->{'admin'}{'family_name'});
747 return undef;
748 }
749 }
750 }
751
752149422.4ms298818.3ms $self->{'as_x509_cert'} = 1
# spent 18.3ms making 2988 calls to Sympa::List::CORE:fteread, avg 6µs/call
753 if ((-r "$self->{'dir'}/cert.pem")
754 || (-r "$self->{'dir'}/cert.pem.enc"));
755
7561494738µs $self->{'_mtime'}{'config'} = $last_time_config;
757
75814941.25ms $list_of_lists{$self->{'domain'}}{$name} = $self;
75914943.13ms return $config_reloaded;
760}
761
762## Return a list of hash's owners and their param
763#OBSOLETED. Use get_admins().
764#sub get_owners;
765
766# OBSOLETED: No longer used.
767#sub get_nb_owners;
768
769## Return a hash of list's editors and their param(empty if there isn't any
770## editor)
771#OBSOLETED. Use get_admins().
772#sub get_editors;
773
774## Returns an array of owners' email addresses
775#OBSOLETED: Use get_admins_email('receptive_owner') or
776# get_admins_email('owner').
777#sub get_owners_email;
778
779## Returns an array of editors' email addresses
780# or owners if there isn't any editors' email addresses
781#OBSOLETED: Use get_admins_email('receptive_editor') or
782# get_admins_email('actual_editor').
783#sub get_editors_email;
784
785## Returns an object Sympa::Family if the list belongs to a family or undef
786
# spent 4.39ms within Sympa::List::get_family which was called 1494 times, avg 3µs/call: # 1494 times (4.39ms+0s) by Sympa::_get_search_path at line 158 of /usr/local/libexec/sympa/Sympa.pm, avg 3µs/call
sub get_family {
7871494349µs my $self = shift;
788
78914941.97ms if (ref $self->{'family'} eq 'Sympa::Family') {
790 return $self->{'family'};
791 } elsif ($self->{'admin'}{'family_name'}) {
792 return $self->{'family'} =
793 Sympa::Family->new($self->{'admin'}{'family_name'},
794 $self->{'domain'});
795 } else {
79614942.31ms return undef;
797 }
798}
799
800## return the config_changes hash
801## Used ONLY with lists belonging to a family.
802sub get_config_changes {
803 my $self = shift;
804 $log->syslog('debug3', '(%s)', $self->{'name'});
805
806 unless ($self->{'admin'}{'family_name'}) {
807 $log->syslog('err',
808 '(%s) Is called but there is no family_name for this list',
809 $self->{'name'});
810 return undef;
811 }
812
813 ## load config_changes
814 my $time_file =
815 Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
816 unless (defined $self->{'config_changes'}
817 && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
818 unless ($self->{'config_changes'} =
819 $self->_load_config_changes_file()) {
820 $log->syslog('err',
821 'Impossible to load file config_changes from list %s',
822 $self->{'name'});
823 return undef;
824 }
825 }
826 return $self->{'config_changes'};
827}
828
829## update file config_changes if the list belongs to a family by
830# writing the $what(file or param) name
831sub update_config_changes {
832 my $self = shift;
833 my $what = shift;
834 # one param or a ref on array of param
835 my $name = shift;
836 $log->syslog('debug2', '(%s, %s)', $self->{'name'}, $what);
837
838 unless ($self->{'admin'}{'family_name'}) {
839 $log->syslog(
840 'err',
841 '(%s, %s, %s) Is called but there is no family_name for this list',
842 $self->{'name'},
843 $what
844 );
845 return undef;
846 }
847 unless (($what eq 'file') || ($what eq 'param')) {
848 $log->syslog('err', '(%s, %s) %s is wrong: must be "file" or "param"',
849 $self->{'name'}, $what);
850 return undef;
851 }
852
853 # status parameter isn't updating set in config_changes
854 if (($what eq 'param') && ($name eq 'status')) {
855 return 1;
856 }
857
858 ## load config_changes
859 my $time_file =
860 Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
861 unless (defined $self->{'config_changes'}
862 && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
863 unless ($self->{'config_changes'} =
864 $self->_load_config_changes_file()) {
865 $log->syslog('err',
866 'Impossible to load file config_changes from list %s',
867 $self->{'name'});
868 return undef;
869 }
870 }
871
872 if (ref($name) eq 'ARRAY') {
873 foreach my $n (@{$name}) {
874 $self->{'config_changes'}{$what}{$n} = 1;
875 }
876 } else {
877 $self->{'config_changes'}{$what}{$name} = 1;
878 }
879
880 $self->_save_config_changes_file();
881
882 return 1;
883}
884
885## return a hash of config_changes file
886sub _load_config_changes_file {
887 my $self = shift;
888 $log->syslog('debug3', '(%s)', $self->{'name'});
889
890 my $config_changes = {};
891
892 unless (-e "$self->{'dir'}/config_changes") {
893 $log->syslog('err', 'No file %s/config_changes. Assuming no changes',
894 $self->{'dir'});
895 return $config_changes;
896 }
897
898 unless (open(FILE, "$self->{'dir'}/config_changes")) {
899 $log->syslog('err',
900 'File %s/config_changes exists, but unable to open it: %m',
901 $self->{'dir'});
902 return undef;
903 }
904
905 while (<FILE>) {
906
907 next if /^\s*(\#.*|\s*)$/;
908
909 if (/^param\s+(.+)\s*$/) {
910 $config_changes->{'param'}{$1} = 1;
911
912 } elsif (/^file\s+(.+)\s*$/) {
913 $config_changes->{'file'}{$1} = 1;
914
915 } else {
916 $log->syslog('err', '(%s) Bad line: %s', $self->{'name'}, $_);
917 next;
918 }
919 }
920 close FILE;
921
922 $config_changes->{'mtime'} =
923 Sympa::Tools::File::get_mtime("$self->{'dir'}/config_changes");
924
925 return $config_changes;
926}
927
928## save config_changes file in the list directory
929sub _save_config_changes_file {
930 my $self = shift;
931 $log->syslog('debug3', '(%s)', $self->{'name'});
932
933 unless ($self->{'admin'}{'family_name'}) {
934 $log->syslog('err',
935 '(%s) Is called but there is no family_name for this list',
936 $self->{'name'});
937 return undef;
938 }
939 unless (open FILE, '>', $self->{'dir'} . '/config_changes') {
940 $log->syslog('err', 'Unable to create file %s/config_changes: %m',
941 $self->{'dir'});
942 return undef;
943 }
944
945 foreach my $what ('param', 'file') {
946 foreach my $name (keys %{$self->{'config_changes'}{$what}}) {
947 print FILE "$what $name\n";
948 }
949 }
950 close FILE;
951
952 return 1;
953}
954
955## Returns the list parameter value from $list->{'admin'}
956# the parameter is simple ($param) or composed ($param & $minor_param)
957# the value is a scalar or a ref on an array of scalar
958# (for parameter digest : only for days)
959sub get_param_value {
960 $log->syslog('debug3', '(%s, %s, %s)', @_);
961 my $self = shift;
962 my $param = shift;
963 my $as_arrayref = shift || 0;
964 my $pinfo = Sympa::Robot::list_params($self->{'domain'});
965 my $minor_param;
966 my $value;
967
968 if ($param =~ /^([\w-]+)\.([\w-]+)$/) {
969 $param = $1;
970 $minor_param = $2;
971 }
972 # Resolve aliases.
973 if ($pinfo->{$param}) {
974 my $alias = $pinfo->{$param}{'obsolete'};
975 if ($alias and $pinfo->{$alias}) {
976 $param = $alias;
977 }
978 }
979 if ( $minor_param
980 and ref $pinfo->{$param}{'format'} eq 'HASH'
981 and $pinfo->{$param}{'format'}{$minor_param}) {
982 my $alias = $pinfo->{$param}{'format'}{$minor_param}{'obsolete'};
983 if ($alias and $pinfo->{$param}{'format'}{$alias}) {
984 $minor_param = $alias;
985 }
986 }
987
988 ## Multiple parameter (owner, custom_header, ...)
989 if (ref($self->{'admin'}{$param}) eq 'ARRAY'
990 and !$pinfo->{$param}{'split_char'}) {
991 my @values;
992 foreach my $elt (@{$self->{'admin'}{$param}}) {
993 my $val =
994 _get_single_param_value($pinfo, $elt, $param, $minor_param);
995 push @values, $val if defined $val;
996 }
997 $value = \@values;
998 } else {
999 $value = _get_single_param_value($pinfo, $self->{'admin'}{$param},
1000 $param, $minor_param);
1001 if ($as_arrayref) {
1002 return [$value] if defined $value;
1003 return [];
1004 }
1005 }
1006 return $value;
1007}
1008
1009## Returns the single list parameter value from struct $p, with $key entrie,
1010# $k is optionnal
1011# the single value can be a ref on a list when the parameter value is a list
1012sub _get_single_param_value {
1013 my ($pinfo, $p, $key, $k) = @_;
1014 $log->syslog('debug3', '(%s %s)', $key, $k);
1015
1016 if ( defined($pinfo->{$key}{'scenario'})
1017 || defined($pinfo->{$key}{'task'})) {
1018 return $p->{'name'};
1019
1020 } elsif (ref($pinfo->{$key}{'file_format'})) {
1021
1022 if (defined($pinfo->{$key}{'file_format'}{$k}{'scenario'})) {
1023 return $p->{$k}{'name'};
1024
1025 } elsif (($pinfo->{$key}{'file_format'}{$k}{'occurrence'} =~ /n$/)
1026 && $pinfo->{$key}{'file_format'}{$k}{'split_char'}) {
1027 return $p->{$k}; # ref on an array
1028 } else {
1029 return $p->{$k};
1030 }
1031
1032 } else {
1033 if (($pinfo->{$key}{'occurrence'} =~ /n$/)
1034 && $pinfo->{$key}{'split_char'}) {
1035 return $p; # ref on an array
1036 } elsif ($key eq 'digest') {
1037 return $p->{'days'}; # ref on an array
1038 } else {
1039 return $p;
1040 }
1041 }
1042}
1043
1044##############################################################################
1045# FUNCTIONS FOR MESSAGE SENDING
1046# #
1047##############################################################################
1048#
1049# -list distribution
1050# -template sending
1051# #
1052# -service messages
1053# -notification sending(listmaster, owner, editor, user)
1054# #
1055# #
1056
1057### LIST DISTRIBUTION ###
1058
1059# Moved (split) to:
1060# Sympa::Spindle::TransformIncoming::_twist(),
1061# Sympa::Spindle::ToArchive::_twist(),
1062# Sympa::Spindle::TransformOutgoing::_twist(),
1063# Sympa::Spindle::ToDigest::_twist(), Sympa::Spindle::ToList::_send_msg().
1064#sub distribute_msg;
1065
1066# Moved to: Sympa::Spindle::DecodateOutgoing::_twist().
1067#sub post_archive;
1068
1069# Old name: Sympa::Mail::mail_message()
1070# Moved To: Sympa::Spindle::ToList::_mail_message().
1071#sub _mail_message;
1072
1073# Old name: List::send_msg_digest().
1074# Moved to Sympa::Spindle::ProcessDigest::_distribute_digest().
1075#sub distribute_digest;
1076
1077sub get_digest_recipients_per_mode {
1078 my $self = shift;
1079
1080 my @tabrcpt_digest;
1081 my @tabrcpt_summary;
1082 my @tabrcpt_digestplain;
1083
1084 ## Create the list of subscribers in various digest modes
1085 for (
1086 my $user = $self->get_first_list_member();
1087 $user;
1088 $user = $self->get_next_list_member()
1089 ) {
1090 # Test to know if the rcpt suspended her subscription for this list.
1091 # If yes, don't send the message.
1092 if ($user and $user->{'suspend'}) {
1093 if ( (not $user->{'startdate'} or $user->{'startdate'} <= time)
1094 and (not $user->{'enddate'} or time <= $user->{'enddate'})) {
1095 next;
1096 } elsif ($user->{'enddate'} and $user->{'enddate'} < time) {
1097 # If end date is < time, update subscriber by deleting the
1098 # suspension setting.
1099 $self->restore_suspended_subscription($user->{'email'});
1100 }
1101 }
1102 if ($user->{'reception'} eq "digest") {
1103 push @tabrcpt_digest, $user->{'email'};
1104
1105 } elsif ($user->{'reception'} eq "summary") {
1106 ## Create the list of subscribers in summary mode
1107 push @tabrcpt_summary, $user->{'email'};
1108
1109 } elsif ($user->{'reception'} eq "digestplain") {
1110 push @tabrcpt_digestplain, $user->{'email'};
1111 }
1112 }
1113
1114 return 0
1115 unless @tabrcpt_summary
1116 or @tabrcpt_digest
1117 or @tabrcpt_digestplain;
1118
1119 my $available_recipients;
1120 $available_recipients->{'summary'} = \@tabrcpt_summary
1121 if @tabrcpt_summary;
1122 $available_recipients->{'digest'} = \@tabrcpt_digest if @tabrcpt_digest;
1123 $available_recipients->{'digestplain'} = \@tabrcpt_digestplain
1124 if @tabrcpt_digestplain;
1125
1126 return $available_recipients;
1127}
1128
1129### TEMPLATE SENDING ###
1130
1131# MOVED to Sympa::send_dsn().
1132#sub send_dsn;
1133
1134#MOVED: Use Sympa::send_file() or Sympa::List::send_probe_to_user().
1135# sub send_file($self, $tpl, $who, $robot, $context);
1136
1137#DEPRECATED: Merged to List::distribute_msg(), then moved to
1138# Sympa::Spindle::ToList::_send_msg().
1139# sub send_msg($message);
1140
1141sub get_recipients_per_mode {
1142 my $self = shift;
1143 my $message = shift;
1144 my %options = @_;
1145
1146 my $robot = $self->{'domain'};
1147
1148 my (@tabrcpt_mail, @tabrcpt_mail_verp,
1149 @tabrcpt_notice, @tabrcpt_notice_verp,
1150 @tabrcpt_txt, @tabrcpt_txt_verp,
1151 @tabrcpt_urlize, @tabrcpt_urlize_verp,
1152 @tabrcpt_digestplain, @tabrcpt_digestplain_verp,
1153 @tabrcpt_digest, @tabrcpt_digest_verp,
1154 @tabrcpt_summary, @tabrcpt_summary_verp,
1155 @tabrcpt_nomail, @tabrcpt_nomail_verp,
1156 );
1157
1158 for (
1159 my $user = $self->get_first_list_member();
1160 $user;
1161 $user = $self->get_next_list_member()
1162 ) {
1163 unless ($user->{'email'}) {
1164 $log->syslog('err',
1165 'Skipping user with no email address in list %s', $self);
1166 next;
1167 }
1168 # Test to know if the rcpt suspended her subscription for this list.
1169 # if yes, don't send the message.
1170 if ($user and $user->{'suspend'}) {
1171 if ( (not $user->{'startdate'} or $user->{'startdate'} <= time)
1172 and (not $user->{'enddate'} or time <= $user->{'enddate'})) {
1173 push @tabrcpt_nomail_verp, $user->{'email'};
1174 next;
1175 } elsif ($user->{'enddate'} and $user->{'enddate'} < time) {
1176 # If end date is < time, update subscriber by deleting the
1177 # suspension setting.
1178 $self->restore_suspended_subscription($user->{'email'});
1179 }
1180 }
1181
1182 # Check if "not_me" reception mode is set.
1183 next
1184 if $user->{'reception'} eq 'not_me'
1185 and $message->{sender} eq $user->{'email'};
1186
1187 # Recipients who won't receive encrypted messages.
1188 # The digest, digestplain, nomail and summary reception option are
1189 # initialized for tracking feature only.
1190 if ($user->{'reception'} eq 'digestplain') {
1191 push @tabrcpt_digestplain_verp, $user->{'email'};
1192 next;
1193 } elsif ($user->{'reception'} eq 'digest') {
1194 push @tabrcpt_digest_verp, $user->{'email'};
1195 next;
1196 } elsif ($user->{'reception'} eq 'summary') {
1197 push @tabrcpt_summary_verp, $user->{'email'};
1198 next;
1199 } elsif ($user->{'reception'} eq 'nomail') {
1200 push @tabrcpt_nomail_verp, $user->{'email'};
1201 next;
1202 } elsif ($user->{'reception'} eq 'notice') {
1203 if ($user->{'bounce_address'}) {
1204 push @tabrcpt_notice_verp, $user->{'email'};
1205 } else {
1206 push @tabrcpt_notice, $user->{'email'};
1207 }
1208 next;
1209 }
1210
1211 #XXX Following will be done by ProcessOutgoing spindle.
1212 # # Message should be re-encrypted, however, user certificate is
1213 # # missing.
1214 # if ($message->{'smime_crypted'}
1215 # and not -r $Conf::Conf{'ssl_cert_dir'} . '/'
1216 # . Sympa::Tools::Text::escape_chars($user->{'email'})
1217 # and not -r $Conf::Conf{'ssl_cert_dir'} . '/'
1218 # . Sympa::Tools::Text::escape_chars($user->{'email'} . '@enc')) {
1219 # my $subject = $message->{'decoded_subject'};
1220 # my $sender = $message->{'sender'};
1221 # unless (
1222 # Sympa::send_file(
1223 # $self,
1224 # 'x509-user-cert-missing',
1225 # $user->{'email'},
1226 # { 'mail' =>
1227 # {'subject' => $subject, 'sender' => $sender},
1228 # 'auto_submitted' => 'auto-generated'
1229 # }
1230 # )
1231 # ) {
1232 # $log->syslog(
1233 # 'notice',
1234 # 'Unable to send template "x509-user-cert-missing" to %s',
1235 # $user->{'email'}
1236 # );
1237 # }
1238 # next;
1239 # }
1240 # # Otherwise it may be shelved encryption.
1241
1242 if ($user->{'reception'} eq 'txt') {
1243 if ($user->{'bounce_address'}) {
1244 push @tabrcpt_txt_verp, $user->{'email'};
1245 } else {
1246 push @tabrcpt_txt, $user->{'email'};
1247 }
1248 } elsif ($user->{'reception'} eq 'urlize') {
1249 if ($user->{'bounce_address'}) {
1250 push @tabrcpt_urlize_verp, $user->{'email'};
1251 } else {
1252 push @tabrcpt_urlize, $user->{'email'};
1253 }
1254 } else {
1255 if ($user->{'bounce_score'}) {
1256 push @tabrcpt_mail_verp, $user->{'email'};
1257 } else {
1258 push @tabrcpt_mail, $user->{'email'};
1259 }
1260 }
1261 }
1262
1263 return 0
1264 unless @tabrcpt_mail
1265 or @tabrcpt_notice
1266 or @tabrcpt_txt
1267 or @tabrcpt_urlize
1268 or @tabrcpt_mail_verp
1269 or @tabrcpt_notice_verp
1270 or @tabrcpt_txt_verp
1271 or @tabrcpt_urlize_verp;
1272
1273 my $available_recipients;
1274
1275 $available_recipients->{'mail'}{'noverp'} = \@tabrcpt_mail
1276 if @tabrcpt_mail;
1277 $available_recipients->{'mail'}{'verp'} = \@tabrcpt_mail_verp
1278 if @tabrcpt_mail_verp;
1279 $available_recipients->{'notice'}{'noverp'} = \@tabrcpt_notice
1280 if @tabrcpt_notice;
1281 $available_recipients->{'notice'}{'verp'} = \@tabrcpt_notice_verp
1282 if @tabrcpt_notice_verp;
1283 $available_recipients->{'txt'}{'noverp'} = \@tabrcpt_txt if @tabrcpt_txt;
1284 $available_recipients->{'txt'}{'verp'} = \@tabrcpt_txt_verp
1285 if @tabrcpt_txt_verp;
1286 $available_recipients->{'urlize'}{'noverp'} = \@tabrcpt_urlize
1287 if @tabrcpt_urlize;
1288 $available_recipients->{'urlize'}{'verp'} = \@tabrcpt_urlize_verp
1289 if @tabrcpt_urlize_verp;
1290 $available_recipients->{'digestplain'}{'noverp'} = \@tabrcpt_digestplain
1291 if @tabrcpt_digestplain;
1292 $available_recipients->{'digestplain'}{'verp'} =
1293 \@tabrcpt_digestplain_verp
1294 if @tabrcpt_digestplain_verp;
1295 $available_recipients->{'digest'}{'noverp'} = \@tabrcpt_digest
1296 if @tabrcpt_digest;
1297 $available_recipients->{'digest'}{'verp'} = \@tabrcpt_digest_verp
1298 if @tabrcpt_digest_verp;
1299 $available_recipients->{'summary'}{'noverp'} = \@tabrcpt_summary
1300 if @tabrcpt_summary;
1301 $available_recipients->{'summary'}{'verp'} = \@tabrcpt_summary_verp
1302 if @tabrcpt_summary_verp;
1303 $available_recipients->{'nomail'}{'noverp'} = \@tabrcpt_nomail
1304 if @tabrcpt_nomail;
1305 $available_recipients->{'nomail'}{'verp'} = \@tabrcpt_nomail_verp
1306 if @tabrcpt_nomail_verp;
1307
1308 return $available_recipients;
1309}
1310
1311### SERVICE MESSAGES ###
1312
1313# Old name: List::send_to_editor().
1314# Moved to: Sympa::Spindle::ToEditor & Sympa::Spindle::ToModeration.
1315#sub send_confirm_to_editor;
1316
1317# Old name: List::send_auth().
1318# Moved to Sympa::Spindle::ToHeld::_send_confirm_to_sender().
1319#sub send_confirm_to_sender;
1320
1321#MOVED: Use Sympa::request_auth().
1322#sub request_auth;
1323
1324# Merged into Sympa::Commands::getfile().
1325#sub archive_send;
1326
1327# Merged into Sympa::Commands::last().
1328#sub archive_send_last;
1329
1330### NOTIFICATION SENDING ###
1331
1332####################################################
1333# send_notify_to_owner
1334####################################################
1335# Sends a notice to list owner(s) by parsing
1336# listowner_notification.tt2 template
1337#
1338# IN : -$self (+): ref(List)
1339# -$operation (+): notification type
1340# -$param(+) : ref(HASH) | ref(ARRAY)
1341# values for template parsing
1342#
1343# OUT : 1 | undef
1344#
1345######################################################
1346sub send_notify_to_owner {
1347 $log->syslog('debug2', '(%s, %s, %s)', @_);
1348 my $self = shift;
1349 my $operation = shift;
1350 my $param = shift;
1351
1352 die 'bug in logic. Ask developer' unless defined $operation;
1353
1354 my @rcpt = $self->get_admins_email('receptive_owner');
1355 @rcpt = $self->get_admins_email('owner') unless @rcpt;
1356 unless (@rcpt) {
1357 $log->syslog(
1358 'notice',
1359 'No owner defined at all in list %s; notification is sent to listmasters',
1360 $self
1361 );
1362 @rcpt = Sympa::get_listmasters_email($self);
1363 }
1364
1365 if (ref $param eq 'HASH') {
1366 $param->{'auto_submitted'} = 'auto-generated';
1367 $param->{'to'} = join(',', @rcpt);
1368 $param->{'type'} = $operation;
1369
1370 if ($operation eq 'sigrequest' or $operation eq 'subrequest') {
1371 # Sends notifications by each so that auth links with owners'
1372 # addresses will be included.
1373 foreach my $owner (@rcpt) {
1374 unless (
1375 Sympa::send_file(
1376 $self, 'listowner_notification', $owner, $param
1377 )
1378 ) {
1379 $log->syslog(
1380 'notice',
1381 'Unable to send template "listowner_notification" to %s list owner %s',
1382 $self,
1383 $owner
1384 );
1385 }
1386 }
1387 } else {
1388 if ($operation eq 'bounce_rate') {
1389 $param->{'rate'} = int($param->{'rate'} * 10) / 10;
1390 }
1391 unless (
1392 Sympa::send_file(
1393 $self, 'listowner_notification', [@rcpt], $param
1394 )
1395 ) {
1396 $log->syslog(
1397 'notice',
1398 'Unable to send template "listowner_notification" to %s list owner',
1399 $self
1400 );
1401 return undef;
1402 }
1403 }
1404 } elsif (ref $param eq 'ARRAY') {
1405
1406 my $data = {
1407 'to' => join(',', @rcpt),
1408 'type' => $operation
1409 };
1410
1411 for my $i (0 .. $#{$param}) {
1412 $data->{"param$i"} = $param->[$i];
1413 }
1414 unless (
1415 Sympa::send_file($self, 'listowner_notification', \@rcpt, $data))
1416 {
1417 $log->syslog(
1418 'notice',
1419 'Unable to send template "listowner_notification" to %s list owner',
1420 $self
1421 );
1422 return undef;
1423 }
1424
1425 } else {
1426 $log->syslog(
1427 'err',
1428 '(%s, %s) Error on incoming parameter "$param", it must be a ref on HASH or a ref on ARRAY',
1429 $self,
1430 $operation
1431 );
1432 return undef;
1433 }
1434 return 1;
1435}
1436
1437# FIXME:This might be moved to Sympa::WWW namespace.
1438sub get_picture_path {
1439 my $self = shift;
1440 return join '/', $Conf::Conf{'pictures_path'}, $self->get_id, @_;
1441}
1442
1443# No longer used. Use Sympa::List::find_picture_url().
1444#sub get_picture_url;
1445
1446# Old name: tools::pictures_filename()
1447# FIXME:This might be moved to Sympa::WWW namespace.
1448sub find_picture_filenames {
1449 my $self = shift;
1450 my $email = shift;
1451
1452 my @ret = ();
1453 if ($email) {
1454 my $login = Digest::MD5::md5_hex($email);
1455 foreach my $ext (qw{gif jpg jpeg png}) {
1456 if (-f $self->get_picture_path($login . '.' . $ext)) {
1457 push @ret, $login . '.' . $ext;
1458 }
1459 }
1460 }
1461 return @ret;
1462}
1463
1464# FIXME:This might be moved to Sympa::WWW namespace.
1465sub find_picture_paths {
1466 my $self = shift;
1467 my $email = shift;
1468
1469 return
1470 map { $self->get_picture_path($_) }
1471 $self->find_picture_filenames($email);
1472}
1473
1474# Old name: tools::make_pictures_url().
1475# FIXME:This might be moved to Sympa::WWW namespace.
1476sub find_picture_url {
1477 my $self = shift;
1478 my $email = shift;
1479
1480 my ($filename) = $self->find_picture_filenames($email);
1481 return undef unless $filename;
1482
1483 return Sympa::Tools::Text::weburl($Conf::Conf{'pictures_url'},
1484 [$self->get_id, $filename]);
1485}
1486
1487# FIXME:This might be moved to Sympa::WWW namespace.
1488sub delete_list_member_picture {
1489 $log->syslog('debug2', '(%s, %s)', @_);
1490 my $self = shift;
1491 my $email = shift;
1492
1493 my $ret = 1;
1494 foreach my $path ($self->find_picture_paths($email)) {
1495 unless (unlink $path) {
1496 $log->syslog('err', 'Failed to delete %s', $path);
1497 $ret = undef;
1498 } else {
1499 $log->syslog('debug3', 'File deleted successfully: %s', $path);
1500 }
1501 }
1502
1503 return $ret;
1504}
1505
1506#No longer used.
1507#sub send_notify_to_editor;
1508
1509# Moved to Sympa::send_notify_to_user().
1510#sub send_notify_to_user;
1511
1512sub send_probe_to_user {
1513 my $self = shift;
1514 my $type = shift;
1515 my $who = shift;
1516
1517 # Shelve VERP for welcome or remind message if necessary
1518 my $tracking;
1519 if ( $self->{'admin'}{'welcome_return_path'} eq 'unique'
1520 and $type eq 'welcome') {
1521 $tracking = 'w';
1522 } elsif ($self->{'admin'}{'remind_return_path'} eq 'unique'
1523 and $type eq 'remind') {
1524 $tracking = 'r';
1525 } else {
1526 #FIXME? Return-Path for '*_return_path' parameter with 'owner'
1527 # value is LIST-owner address. It might be LIST-request address.
1528 }
1529
1530 my $spindle = Sympa::Spindle::ProcessTemplate->new(
1531 context => $self,
1532 template => $type,
1533 rcpt => $who,
1534 data => {},
1535 tracking => $tracking,
1536 #FIXME: Why overwrite priority?
1537 priority => Conf::get_robot_conf($self->{'domain'}, 'sympa_priority'),
1538 );
1539 unless ($spindle and $spindle->spin and $spindle->{finish} eq 'success') {
1540 $log->syslog('err', 'Could not send template %s to %s', $type, $who);
1541 return undef;
1542 }
1543
1544 return 1;
1545}
1546
1547### END functions for sending messages ###
1548
1549#MOVED: Use Sympa::compute_auth().
1550#sub compute_auth;
1551
1552# DEPRECATED: Moved to Sympa::Message::_decorate_parts().
1553#sub add_parts;
1554
1555## Delete a user in the user_table
1556##sub delete_global_user
1557## DEPRECATED: Use Sympa::User::delete_global_user() or $user->expire();
1558
1559## Delete the indicate list member
1560## IN : - ref to array
1561## - option exclude
1562##
1563## $list->delete_list_member('users' => \@u, 'exclude' => 1)
1564## $list->delete_list_member('users' => [$email], 'exclude' => 1)
1565sub delete_list_member {
1566 my $self = shift;
1567 my %param = @_;
1568 my @u = @{$param{'users'}};
1569 my $exclude = $param{'exclude'};
1570
1571 # Case of deleting: "auto_del" (bounce management), "signoff" (manual
1572 # signoff) or "del" (deleted by admin)?
1573 my $operation = $param{'operation'};
1574
1575 $log->syslog('debug2', '');
1576
1577 my $name = $self->{'name'};
1578 my $total = 0;
1579
1580 my $sdm = Sympa::DatabaseManager->instance;
1581
1582 foreach my $who (@u) {
1583 $who = Sympa::Tools::Text::canonic_email($who);
1584
1585 ## Include in exclusion_table only if option is set.
1586 if ($exclude) {
1587 # Insert in exclusion_table if $user->{inclusion} defined.
1588 $self->insert_delete_exclusion($who, 'insert');
1589 }
1590
1591 # Delete record in subscriber_table.
1592 unless (
1593 $sdm
1594 and $sdm->do_prepared_query(
1595 q{DELETE FROM subscriber_table
1596 WHERE user_subscriber = ? AND
1597 list_subscriber = ? AND robot_subscriber = ?},
1598 $who, $name, $self->{'domain'}
1599 )
1600 ) {
1601 $log->syslog('err', 'Unable to remove list member %s', $who);
1602 next;
1603 }
1604
1605 # Delete signoff requests if any.
1606 my $spool_req = Sympa::Spool::Auth->new(
1607 context => $self,
1608 action => 'del',
1609 email => $who,
1610 );
1611 while (1) {
1612 my ($request, $handle) = $spool_req->next;
1613 last unless $handle;
1614 next unless $request;
1615
1616 $spool_req->remove($handle);
1617 }
1618
1619 #log in stat_table to make statistics
1620 if ($operation) {
1621 $log->add_stat(
1622 'robot' => $self->{'domain'},
1623 'list' => $name,
1624 'operation' => $operation,
1625 'mail' => $who
1626 );
1627 }
1628
1629 $total--;
1630 }
1631
1632 $self->_cache_publish_expiry('member');
1633 delete_list_member_picture($self, shift(@u));
1634 return (-1 * $total);
1635
1636}
1637
1638## Delete the indicated admin users from the list.
1639sub delete_list_admin {
1640 my ($self, $role, @u) = @_;
1641 $log->syslog('debug2', '', $role);
1642
1643 my $name = $self->{'name'};
1644 my $total = 0;
1645
1646 foreach my $who (@u) {
1647 $who = Sympa::Tools::Text::canonic_email($who);
1648 my $statement;
1649
1650 my $sdm = Sympa::DatabaseManager->instance;
1651
1652 # Delete record in ADMIN
1653 unless (
1654 $sdm
1655 and $sdm->do_prepared_query(
1656 q{DELETE FROM admin_table
1657 WHERE user_admin = ? AND list_admin = ? AND
1658 robot_admin = ? AND role_admin = ?},
1659 $who, $self->{'name'},
1660 $self->{'domain'}, $role
1661 )
1662 ) {
1663 $log->syslog('err', 'Unable to remove admin %s of list %s',
1664 $who, $self);
1665 next;
1666 }
1667
1668 $total--;
1669 }
1670
1671 $self->_cache_publish_expiry('admin_user');
1672
1673 return (-1 * $total);
1674}
1675
1676# Delete all admin_table entries.
1677# OBSOLETED: No longer used.
1678#sub delete_all_list_admin;
1679
1680# OBSOLETED: This may no longer be used.
1681#sub get_cookie;
1682
1683# OBSOLETED: No longer used.
1684# Returns the maximum size allowed for a message to the list.
1685sub get_max_size {
1686 return shift->{'admin'}{'max_size'};
1687}
1688
1689## Returns an array with the Reply-To data
1690sub get_reply_to {
1691 my $admin = shift->{'admin'};
1692
1693 my $value = $admin->{'reply_to_header'}{'value'};
1694
1695 $value = $admin->{'reply_to_header'}{'other_email'}
1696 if ($value eq 'other_email');
1697
1698 return $value;
1699}
1700
1701## Returns a default user option
1702sub get_default_user_options {
1703 $log->syslog('debug3', '(%s,%s)', @_);
1704 my $self = shift;
1705 my $what = shift;
1706
1707 if ($self) {
1708 return $self->{'admin'}{'default_user_options'};
1709 }
1710 return undef;
1711}
1712
1713# Returns the number of subscribers of a list.
1714sub get_total {
1715 my $self = shift;
1716 my $option = shift;
1717
1718 my $total = $self->_cache_get('total');
1719 if (defined $total and not($option and $option eq 'nocache')) {
1720 return $total;
1721 }
1722
1723 my $sdm = Sympa::DatabaseManager->instance;
1724 my $sth;
1725
1726 unless (
1727 $sdm
1728 and $sth = $sdm->do_prepared_query(
1729 q{SELECT COUNT(*)
1730 FROM subscriber_table
1731 WHERE list_subscriber = ? AND robot_subscriber = ?},
1732 $self->{'name'}, $self->{'domain'}
1733 )
1734 ) {
1735 $log->syslog('err', 'Unable to get subscriber count for list %s',
1736 $self);
1737 return $total; # Return cache probably outdated.
1738 }
1739 $total = $self->_cache_put('total', $sth->fetchrow);
1740 $sth->finish;
1741
1742 return $total;
1743}
1744
1745## Returns a hash for a given user
1746##sub get_global_user {
1747## DEPRECATED: Use Sympa::User::get_global_user() or Sympa::User->new().
1748
1749## Returns an array of all users in User table hash for a given user
1750##sub get_all_global_user {
1751## DEPRECATED: Use Sympa::User::get_all_global_user() or
1752## Sympa::User::get_users().
1753
1754######################################################################
1755### suspend_subscription #
1756## Suspend an user from list(s) #
1757######################################################################
1758# IN: #
1759# - email : the subscriber email #
1760# - list : the name of the list #
1761# - data : start_date and end_date #
1762# - robot : domain #
1763# OUT: #
1764# - undef if something went wrong. #
1765# - 1 if user is suspended from the list #
1766######################################################################
1767sub suspend_subscription {
1768
1769 my $email = shift;
1770 my $list = shift;
1771 my $data = shift;
1772 my $robot = shift;
1773 $log->syslog('debug2', '("%s", "%s", "%s")', $email, $list, $data);
1774
1775 my $sdm = Sympa::DatabaseManager->instance;
1776 unless (
1777 $sdm
1778 and $sdm->do_prepared_query(
1779 q{UPDATE subscriber_table
1780 SET suspend_subscriber = 1,
1781 suspend_start_date_subscriber = ?,
1782 suspend_end_date_subscriber = ?
1783 WHERE user_subscriber = ? AND
1784 list_subscriber = ? AND robot_subscriber = ?},
1785 $data->{'startdate'}, $data->{'enddate'},
1786 $email, $list, $robot
1787 )
1788 ) {
1789 $log->syslog('err',
1790 'Unable to suspend subscription of user %s to list %s@%s',
1791 $email, $list, $robot);
1792 return undef;
1793 }
1794
1795 return 1;
1796}
1797
1798######################################################################
1799### restore_suspended_subscription #
1800## Restore the subscription of an user from list(s) #
1801######################################################################
1802# IN: #
1803# - email : the subscriber email #
1804# OUT: #
1805# - undef if something went wrong. #
1806# - 1 if their subscription is restored #
1807######################################################################
1808sub restore_suspended_subscription {
1809 $log->syslog('debug2', '(%s)', @_);
1810 my $self = shift;
1811 my $email = shift;
1812
1813 my $sdm = Sympa::DatabaseManager->instance;
1814 unless (
1815 $sdm
1816 and $sdm->do_prepared_query(
1817 q{UPDATE subscriber_table
1818 SET suspend_subscriber = 0,
1819 suspend_start_date_subscriber = NULL,
1820 suspend_end_date_subscriber = NULL
1821 WHERE user_subscriber = ? AND list_subscriber = ? AND
1822 robot_subscriber = ?},
1823 $email, $self->{'name'}, $self->{'domain'}
1824 )
1825 ) {
1826 $log->syslog('err',
1827 'Unable to restore subscription of user %s to list %s',
1828 $email, $self);
1829 return undef;
1830 }
1831
1832 return 1;
1833}
1834
1835######################################################################
1836# insert_delete_exclusion #
1837# Update the exclusion_table #
1838######################################################################
1839# IN: #
1840# - email : the subscriber email #
1841# - action : insert or delete #
1842# OUT: #
1843# - undef if something went wrong. #
1844# - 1 #
1845######################################################################
1846sub insert_delete_exclusion {
1847 $log->syslog('debug2', '(%s, %s, %s)', @_);
1848 my $self = shift;
1849 my $email = shift;
1850 my $action = shift;
1851
1852 die sprintf 'Invalid parameter: %s', $self
1853 unless ref $self; #prototype changed (6.2b)
1854
1855 my $name = $self->{'name'};
1856 my $robot_id = $self->{'domain'};
1857 my $sdm = Sympa::DatabaseManager->instance;
1858
1859 my $r = 1;
1860
1861 if ($action eq 'insert') {
1862 # INSERT only if $user->{inclusion} defined.
1863 my $user = $self->get_list_member($email);
1864 my $date = time;
1865
1866 if (defined $user->{'inclusion'}) {
1867 unless (
1868 $sdm
1869 and $sdm->do_prepared_query(
1870 q{INSERT INTO exclusion_table
1871 (list_exclusion, family_exclusion, robot_exclusion,
1872 user_exclusion, date_exclusion)
1873 VALUES (?, ?, ?, ?, ?)},
1874 $name, '', $robot_id, $email, $date
1875 )
1876 ) {
1877 $log->syslog('err', 'Unable to exclude user %s from list %s',
1878 $email, $self);
1879 return undef;
1880 }
1881 }
1882 } elsif ($action eq 'delete') {
1883 ## If $email is in exclusion_table, delete it.
1884 my $data_excluded = $self->get_exclusion();
1885 my @users_excluded;
1886
1887 my $key = 0;
1888 while ($data_excluded->{'emails'}->[$key]) {
1889 push @users_excluded, $data_excluded->{'emails'}->[$key];
1890 $key = $key + 1;
1891 }
1892
1893 $r = 0;
1894 my $sth;
1895 foreach my $users (@users_excluded) {
1896 if ($email eq $users) {
1897 ## Delete : list, user and date
1898 unless (
1899 $sdm
1900 and $sth = $sdm->do_prepared_query(
1901 q{DELETE FROM exclusion_table
1902 WHERE list_exclusion = ? AND robot_exclusion = ? AND
1903 user_exclusion = ?},
1904 $name, $robot_id, $email
1905 )
1906 ) {
1907 $log->syslog(
1908 'err',
1909 'Unable to remove entry %s for list %s from table exclusion_table',
1910 $email,
1911 $self
1912 );
1913 }
1914 $r = $sth->rows;
1915 }
1916 }
1917 } else {
1918 $log->syslog('err', 'Unknown action %s', $action);
1919 return undef;
1920 }
1921
1922 return $r;
1923}
1924
1925######################################################################
1926# get_exclusion #
1927# Returns a hash with those excluded from the list and the date. #
1928# #
1929# IN: - name : the name of the list #
1930# OUT: - data_exclu : * %data_exclu->{'emails'}->[] #
1931# * %data_exclu->{'date'}->[] #
1932######################################################################
1933sub get_exclusion {
1934 $log->syslog('debug2', '(%s)', @_);
1935 my $self = shift;
1936
1937 die sprintf 'Invalid parameter: %s', $self
1938 unless ref $self; #prototype changed (6.2b)
1939
1940 my $name = $self->{'name'};
1941 my $robot_id = $self->{'domain'};
1942
1943 push @sth_stack, $sth;
1944 my $sdm = Sympa::DatabaseManager->instance;
1945
1946 if (defined $self->{'admin'}{'family_name'}
1947 and length $self->{'admin'}{'family_name'}) {
1948 unless (
1949 $sdm
1950 and $sth = $sdm->do_prepared_query(
1951 q{SELECT user_exclusion AS email, date_exclusion AS "date"
1952 FROM exclusion_table
1953 WHERE (list_exclusion = ? OR family_exclusion = ?) AND
1954 robot_exclusion = ?},
1955 $name, $self->{'admin'}{'family_name'}, $robot_id
1956 )
1957 ) {
1958 $log->syslog('err',
1959 'Unable to retrieve excluded users for list %s', $self);
1960 $sth = pop @sth_stack;
1961 return undef;
1962 }
1963 } else {
1964 unless (
1965 $sdm
1966 and $sth = $sdm->do_prepared_query(
1967 q{SELECT user_exclusion AS email, date_exclusion AS "date"
1968 FROM exclusion_table
1969 WHERE list_exclusion = ? AND robot_exclusion = ?},
1970 $name, $robot_id
1971 )
1972 ) {
1973 $log->syslog('err',
1974 'Unable to retrieve excluded users for list %s', $self);
1975 $sth = pop @sth_stack;
1976 return undef;
1977 }
1978 }
1979
1980 my @users;
1981 my @date;
1982 my $data;
1983 while ($data = $sth->fetchrow_hashref) {
1984 push @users, $data->{'email'};
1985 push @date, $data->{'date'};
1986 }
1987 # In order to use the data, we add the emails and dates in different
1988 # array
1989 my $data_exclu = {
1990 "emails" => \@users,
1991 "date" => \@date
1992 };
1993 $sth->finish();
1994
1995 $sth = pop @sth_stack;
1996
1997 unless ($data_exclu) {
1998 $log->syslog('err',
1999 'Unable to retrieve information from database for list %s',
2000 $self);
2001 return undef;
2002 }
2003 return $data_exclu;
2004}
2005
2006sub is_member_excluded {
2007 my $self = shift;
2008 my $email = shift;
2009
2010 return undef unless defined $email and length $email;
2011 $email = Sympa::Tools::Text::canonic_email($email);
2012
2013 my $sdm = Sympa::DatabaseManager->instance;
2014 my $sth;
2015
2016 if (defined $self->{'admin'}{'family_name'}
2017 and length $self->{'admin'}{'family_name'}) {
2018 unless (
2019 $sdm
2020 and $sth = $sdm->do_prepared_query(
2021 q{SELECT COUNT(*)
2022 FROM exclusion_table
2023 WHERE (list_exclusion = ? OR family_exclusion = ?) AND
2024 robot_exclusion = ? AND
2025 user_exclusion = ?},
2026 $self->{'name'}, $self->{'admin'}{'family_name'},
2027 $self->{'domain'},
2028 $email
2029 )
2030 ) {
2031 #FIXME: report error
2032 return undef;
2033 }
2034 } else {
2035 unless (
2036 $sdm
2037 and $sth = $sdm->do_prepared_query(
2038 q{SELECT COUNT(*)
2039 FROM exclusion_table
2040 WHERE list_exclusion = ? AND robot_exclusion = ? AND
2041 user_exclusion = ?},
2042 $self->{'name'}, $self->{'domain'},
2043 $email
2044 )
2045 ) {
2046 #FIXME: report error
2047 return undef;
2048 }
2049 }
2050 my ($count) = $sth->fetchrow_array;
2051 $sth->finish;
2052
2053 return $count || 0;
2054}
2055
2056# Mapping between var and field names.
2057sub _map_list_member_cols {
2058 my %map_field = (
2059 date => 'date_epoch_subscriber',
2060 update_date => 'update_epoch_subscriber',
2061 gecos => 'comment_subscriber',
2062 email => 'user_subscriber',
2063 startdate => 'suspend_start_date_subscriber',
2064 enddate => 'suspend_end_date_subscriber',
2065 );
2066
2067 my $fields =
2068 {Sympa::DatabaseDescription::full_db_struct()}->{'subscriber_table'}
2069 ->{fields};
2070 foreach my $f (keys %$fields) {
2071 next if $f eq 'list_subscriber' or $f eq 'robot_subscriber';
2072
2073 my $k = {reverse %map_field}->{$f};
2074 unless ($k) {
2075 $k = $f;
2076 $k =~ s/_subscriber\z//;
2077 $map_field{$k} = $f;
2078 }
2079 }
2080 # Additional DB fields.
2081 if ($Conf::Conf{'db_additional_subscriber_fields'}) {
2082 foreach my $f (split /\s*,\s*/,
2083 $Conf::Conf{'db_additional_subscriber_fields'}) {
2084 $map_field{$f} = $f;
2085 }
2086 }
2087
2088 return %map_field;
2089}
2090
2091sub _list_member_cols {
2092 my $sdm = shift;
2093
2094 my %map_field = _map_list_member_cols();
2095 return join ', ', map {
2096 my $col = $map_field{$_};
2097 ($col eq $_) ? $col : sprintf('%s AS "%s"', $col, $_);
2098 } sort keys %map_field;
2099}
2100
2101sub get_list_member {
2102 $log->syslog('debug2', '(%s, %s)', @_);
2103 my $self = shift;
2104 my $email = Sympa::Tools::Text::canonic_email(shift);
2105
2106 my $sdm = Sympa::DatabaseManager->instance;
2107 my $sth;
2108
2109 unless (
2110 $sdm
2111 and $sth = $sdm->do_prepared_query(
2112 sprintf(
2113 q{SELECT %s
2114 FROM subscriber_table
2115 WHERE user_subscriber = ? AND
2116 list_subscriber = ? AND robot_subscriber = ?},
2117 _list_member_cols($sdm)
2118 ),
2119 $email,
2120 $self->{'name'},
2121 $self->{'domain'}
2122 )
2123 ) {
2124 $log->syslog('err', 'Unable to gather information for user: %s',
2125 $email, $self);
2126 return undef;
2127 }
2128 my $user = $sth->fetchrow_hashref('NAME_lc');
2129 if (defined $user) {
2130 $sth->finish;
2131
2132 $user->{'reception'} ||= 'mail';
2133 $user->{'reception'} =
2134 $self->{'admin'}{'default_user_options'}{'reception'}
2135 unless $self->is_available_reception_mode($user->{'reception'});
2136 $user->{'visibility'} ||= 'noconceal';
2137 $user->{'update_date'} ||= $user->{'date'};
2138
2139 $log->syslog(
2140 'debug2',
2141 'Custom_attribute = (%s)',
2142 $user->{custom_attribute}
2143 );
2144 if (defined $user->{custom_attribute}) {
2145 $user->{'custom_attribute'} =
2146 Sympa::Tools::Data::decode_custom_attribute(
2147 $user->{'custom_attribute'});
2148 }
2149
2150 # Compat.<=6.2.44 FIXME: needed?
2151 $user->{'included'} = 1
2152 if defined $user->{'inclusion'};
2153 } else {
2154 my $error = $sth->err;
2155 $sth->finish;
2156
2157 if ($error) {
2158 $log->syslog(
2159 'err',
2160 'An error occurred while fetching the data from the database: %s',
2161 $sth->errstr
2162 );
2163 return undef;
2164 } else {
2165 $log->syslog('debug',
2166 'User %s was not found in the subscribers of list %s',
2167 $email, $self);
2168 return undef;
2169 }
2170 }
2171
2172 return $user;
2173}
2174
2175# Deprecated. Merged into get_list_member(),
2176#sub get_list_member_no_object;
2177
2178## Returns an admin user of the list.
2179# OBSOLETED. Use get_admins().
2180sub get_list_admin {
2181 $log->syslog('debug2', '(%s, %s, %s)', @_);
2182 my $self = shift;
2183 my $role = shift;
2184 my $email = shift;
2185
2186 my ($admin_user) =
2187 @{$self->get_admins($role, filter => [email => $email])};
2188
2189 return $admin_user;
2190}
2191
2192## Returns the first user for the list.
2193
2194sub get_first_list_member {
2195 my ($self, $data) = @_;
2196
2197 my ($sortby, $offset, $sql_regexp);
2198 $sortby = $data->{'sortby'};
2199 ## Sort may be domain, email, date
2200 $sortby ||= 'email';
2201 $offset = $data->{'offset'};
2202 $sql_regexp = $data->{'sql_regexp'};
2203
2204 $log->syslog('debug2', '(%s, %s, %s)', $self, $sortby, $offset);
2205
2206 my $statement;
2207
2208 my $sdm = Sympa::DatabaseManager->instance;
2209 push @sth_stack, $sth;
2210
2211 ## SQL regexp
2212 my $selection;
2213 if ($sql_regexp) {
2214 $selection =
2215 sprintf
2216 " AND (user_subscriber LIKE %s OR comment_subscriber LIKE %s)",
2217 $sdm->quote($sql_regexp), $sdm->quote($sql_regexp);
2218 }
2219
2220 $statement = sprintf q{SELECT %s
2221 FROM subscriber_table
2222 WHERE list_subscriber = %s AND robot_subscriber = %s %s},
2223 _list_member_cols($sdm),
2224 $sdm->quote($self->{'name'}),
2225 $sdm->quote($self->{'domain'}),
2226 ($selection || '');
2227
2228 ## SORT BY
2229 $statement .= ' ORDER BY '
2230 . (
2231 { email => 'user_subscriber',
2232 date => 'date_epoch_subscriber DESC',
2233 sources =>
2234 'subscribed_subscriber DESC, inclusion_label_subscriber ASC',
2235 name => 'comment_subscriber',
2236 }->{$sortby}
2237 || 'user_subscriber'
2238 );
2239 push @sth_stack, $sth;
2240
2241 unless ($sdm and $sth = $sdm->do_query($statement)) {
2242 $log->syslog('err', 'Unable to get members of list %s', $self);
2243 return undef;
2244 }
2245
2246 # Offset
2247 # Note: Several RDBMSs don't support nonstandard OFFSET clause, OTOH
2248 # some others don't support standard ROW_NUMBER function.
2249 # Instead, fetch unneccessary rows and discard them.
2250 if (defined $offset) {
2251 my $remainder = $offset;
2252 while (1000 < $remainder) {
2253 $remainder -= 1000;
2254 my $rows = $sth->fetchall_arrayref([qw(email)], 1000);
2255 last unless $rows and @$rows;
2256 }
2257 if (0 < $remainder) {
2258 $sth->fetchall_arrayref([qw(email)], $remainder);
2259 }
2260 }
2261
2262 my $user = $sth->fetchrow_hashref('NAME_lc');
2263 if (defined $user) {
2264 $log->syslog('err',
2265 'Warning: Entry with empty email address in list %s', $self)
2266 unless $user->{'email'};
2267 $user->{'reception'} ||= 'mail';
2268 $user->{'reception'} =
2269 $self->{'admin'}{'default_user_options'}{'reception'}
2270 unless $self->is_available_reception_mode($user->{'reception'});
2271 $user->{'visibility'} ||= 'noconceal';
2272 $user->{'update_date'} ||= $user->{'date'};
2273
2274 if (defined $user->{custom_attribute}) {
2275 $user->{'custom_attribute'} =
2276 Sympa::Tools::Data::decode_custom_attribute(
2277 $user->{'custom_attribute'});
2278 }
2279
2280 # Compat.<=6.2.44 FIXME: needed?
2281 $user->{'included'} = 1
2282 if defined $user->{'inclusion'};
2283 } else {
2284 $sth->finish;
2285 $sth = pop @sth_stack;
2286 }
2287
2288 return $user;
2289}
2290
2291# Moved to Sympa::Tools::Data::decode_custom_attribute().
2292#sub parseCustomAttribute;
2293
2294# Moved to Sympa::Tools::Data::encode_custom_attribute().
2295#sub createXMLCustomAttribute;
2296
2297## Returns the first admin_user with $role for the list.
2298#DEPRECATED: Merged into _get_basic_admins(). Use get_admins() instead.
2299#sub get_first_list_admin;
2300
2301## Loop for all subsequent users.
2302sub get_next_list_member {
2303 my $self = shift;
2304 $log->syslog('debug2', '');
2305
2306 unless (defined $sth) {
2307 $log->syslog('err',
2308 'No handle defined, get_first_list_member(%s) was not run',
2309 $self);
2310 return undef;
2311 }
2312
2313 my $user = $sth->fetchrow_hashref('NAME_lc');
2314
2315 if (defined $user) {
2316 $log->syslog('err',
2317 'Warning: Entry with empty email address in list %s', $self)
2318 unless $user->{'email'};
2319 $user->{'reception'} ||= 'mail';
2320 $user->{'reception'} =
2321 $self->{'admin'}{'default_user_options'}{'reception'}
2322 unless $self->is_available_reception_mode($user->{'reception'});
2323 $user->{'visibility'} ||= 'noconceal';
2324 $user->{'update_date'} ||= $user->{'date'};
2325
2326 if (defined $user->{custom_attribute}) {
2327 my $custom_attr = Sympa::Tools::Data::decode_custom_attribute(
2328 $user->{'custom_attribute'});
2329 unless (defined $custom_attr) {
2330 $log->syslog(
2331 'err',
2332 "Failed to parse custom attributes for user %s, list %s",
2333 $user->{'email'},
2334 $self
2335 );
2336 }
2337 $user->{'custom_attribute'} = $custom_attr;
2338 }
2339
2340 # Compat.<=6.2.44 FIXME: needed?
2341 $user->{'included'} = 1
2342 if defined $user->{'inclusion'};
2343 } else {
2344 $sth->finish;
2345 $sth = pop @sth_stack;
2346 }
2347
2348 return $user;
2349}
2350
2351# Mapping between var and field names.
2352sub _map_list_admin_cols {
2353 my %map_field = (
2354 date => 'date_epoch_admin',
2355 update_date => 'update_epoch_admin',
2356 gecos => 'comment_admin',
2357 email => 'user_admin',
2358 );
2359
2360 my $fields =
2361 {Sympa::DatabaseDescription::full_db_struct()}->{'admin_table'}
2362 ->{fields};
2363 foreach my $f (keys %$fields) {
2364 next
2365 if $f eq 'list_admin'
2366 or $f eq 'robot_admin'
2367 or $f eq 'role_admin';
2368
2369 my $k = {reverse %map_field}->{$f};
2370 unless ($k) {
2371 $k = $f;
2372 $k =~ s/_admin\z//;
2373 $map_field{$k} = $f;
2374 }
2375 }
2376
2377 return %map_field;
2378}
2379
2380sub _list_admin_cols {
2381 my $sdm = shift;
2382
2383 my %map_field = _map_list_admin_cols();
2384 return join ', ', map {
2385 my $col = $map_field{$_};
2386 ($col eq $_) ? $col : sprintf('%s AS "%s"', $col, $_);
2387 } sort keys %map_field;
2388}
2389
2390## Loop for all subsequent admin users with the role defined in
2391## get_first_list_admin.
2392#DEPRECATED: Merged into _get_basic_admins(). Use get_admins() instead.
2393#sub get_next_list_admin;
2394
2395sub get_admins {
2396 $log->syslog('debug2', '(%s, %s, %s => %s)', @_);
2397 my $self = shift;
2398 my $role = lc(shift || '');
2399 my %options = @_;
2400
2401 my $admin_user = $self->_cache_get('admin_user');
2402 unless ($admin_user and @{$admin_user || []}) {
2403 # Get recent admins from database.
2404 $admin_user = $self->get_current_admins;
2405 if ($admin_user) {
2406 $self->_cache_put('admin_user', $admin_user);
2407 } else {
2408 # If failed, reuse cache probably outdated.
2409 $admin_user = $self->{_cached}{admin_user};
2410 }
2411 }
2412 return unless $admin_user; # Returns void.
2413
2414 my %query = @{$options{filter} || []};
2415 $query{email} = Sympa::Tools::Text::canonic_email($query{email})
2416 if defined $query{email};
2417
2418 my @users;
2419 if ($role eq 'editor') {
2420 @users =
2421 grep { $_ and $_->{role} eq 'editor' } @{$admin_user || []};
2422 } elsif ($role eq 'owner') {
2423 @users =
2424 grep { $_ and $_->{role} eq 'owner' } @{$admin_user || []};
2425 } elsif ($role eq 'actual_editor') {
2426 @users =
2427 grep { $_ and $_->{role} eq 'editor' } @{$admin_user || []};
2428 @users = grep { $_ and $_->{role} eq 'owner' } @{$admin_user || []}
2429 unless @users;
2430 } elsif ($role eq 'privileged_owner') {
2431 @users = grep {
2432 $_
2433 and $_->{role} eq 'owner'
2434 and $_->{profile}
2435 and $_->{profile} eq 'privileged'
2436 } @{$admin_user || []};
2437 } elsif ($role eq 'receptive_editor') {
2438 @users = grep {
2439 $_
2440 and $_->{role} eq 'editor'
2441 and ($_->{reception} || 'mail') ne 'nomail'
2442 } @{$admin_user || []};
2443 @users = grep {
2444 $_
2445 and $_->{role} eq 'owner'
2446 and ($_->{reception} || 'mail') ne 'nomail'
2447 } @{$admin_user || []}
2448 unless @users;
2449 } elsif ($role eq 'receptive_owner') {
2450 @users = grep {
2451 $_
2452 and $_->{role} eq 'owner'
2453 and ($_->{reception} || 'mail') ne 'nomail'
2454 } @{$admin_user || []};
2455 } else {
2456 die sprintf 'Unknown role "%s"', $role;
2457 }
2458
2459 if (defined $query{email}) {
2460 @users = grep { ($_->{email} || '') eq $query{email} } @users;
2461 }
2462
2463 return wantarray ? @users : [@users];
2464}
2465
2466# Get all admins passing cache.
2467# Note: Use with care. This increases database load.
2468sub get_current_admins {
2469 my $self = shift;
2470
2471 my $sdm = Sympa::DatabaseManager->instance;
2472 my $sth;
2473
2474 unless (
2475 $sdm and $sth = $sdm->do_prepared_query(
2476 sprintf(
2477 q{SELECT %s, role_admin AS "role"
2478 FROM admin_table
2479 WHERE list_admin = ? AND robot_admin = ?
2480 ORDER BY user_admin},
2481 _list_admin_cols($sdm)
2482 ),
2483 $self->{'name'},
2484 $self->{'domain'}
2485 )
2486 ) {
2487 $log->syslog('err', 'Unable to get admins for list %s', $self);
2488 return undef;
2489 }
2490 my $admin_user = $sth->fetchall_arrayref({}) || [];
2491 $sth->finish;
2492
2493 foreach my $user (@$admin_user) {
2494 $user->{'email'} = Sympa::Tools::Text::canonic_email($user->{'email'})
2495 if defined $user->{'email'};
2496 $log->syslog('err',
2497 'Warning: Entry with empty email address in list %s', $self)
2498 unless defined $user->{'email'};
2499 $user->{'reception'} ||= 'mail';
2500 $user->{'visibility'} ||= 'noconceal';
2501 $user->{'update_date'} ||= $user->{'date'};
2502
2503 # Compat.<=6.2.44 FIXME: needed?
2504 $user->{'included'} = 1
2505 if defined $user->{'inclusion'};
2506 }
2507
2508 return $admin_user;
2509}
2510
2511sub get_admins_email {
2512 my $self = shift;
2513 my $role = lc(shift || '');
2514
2515 return unless $role; # Returns void.
2516
2517 return map { $_->{email} } @{$self->get_admins($role) || []};
2518}
2519
2520## Returns the first bouncing user
2521
2522sub get_first_bouncing_list_member {
2523 my $self = shift;
2524 $log->syslog('debug2', '');
2525
2526 my $name = $self->{'name'};
2527
2528 my $sdm = Sympa::DatabaseManager->instance;
2529 push @sth_stack, $sth;
2530
2531 unless (
2532 $sdm
2533 and $sth = $sdm->do_prepared_query(
2534 sprintf(
2535 q{SELECT %s
2536 FROM subscriber_table
2537 WHERE list_subscriber = ? AND robot_subscriber = ? AND
2538 bounce_subscriber IS NOT NULL},
2539 _list_member_cols($sdm)
2540 ),
2541 $self->{'name'},
2542 $self->{'domain'}
2543 )
2544 ) {
2545 $log->syslog('err', 'Unable to get bouncing users %s@%s',
2546 $name, $self->{'domain'});
2547 return undef;
2548 }
2549
2550 my $user = $sth->fetchrow_hashref('NAME_lc');
2551
2552 if (defined $user) {
2553 $log->syslog('err',
2554 'Warning: Entry with empty email address in list %s',
2555 $self->{'name'})
2556 unless defined $user->{'email'} and length $user->{'email'};
2557
2558 # Compat.<=6.2.44 FIXME: needed?
2559 $user->{'included'} = 1
2560 if defined $user->{'inclusion'};
2561 } else {
2562 $sth->finish;
2563 $sth = pop @sth_stack;
2564 }
2565
2566 return $user;
2567}
2568
2569## Loop for all subsequent bouncing users.
2570sub get_next_bouncing_list_member {
2571 my $self = shift;
2572 $log->syslog('debug2', '');
2573
2574 unless (defined $sth) {
2575 $log->syslog(
2576 'err',
2577 'No handle defined, get_first_bouncing_list_member(%s) was not run',
2578 $self->{'name'}
2579 );
2580 return undef;
2581 }
2582
2583 my $user = $sth->fetchrow_hashref('NAME_lc');
2584
2585 if (defined $user) {
2586 $log->syslog('err',
2587 'Warning: Entry with empty email address in list %s',
2588 $self->{'name'})
2589 if (!$user->{'email'});
2590
2591 if (defined $user->{custom_attribute}) {
2592 $user->{'custom_attribute'} =
2593 Sympa::Tools::Data::decode_custom_attribute(
2594 $user->{'custom_attribute'});
2595 }
2596
2597 # Compat.<=6.2.44 FIXME: needed?
2598 $user->{'included'} = 1
2599 if defined $user->{'inclusion'};
2600 } else {
2601 $sth->finish;
2602 $sth = pop @sth_stack;
2603 }
2604
2605 return $user;
2606}
2607
2608sub parse_list_member_bounce {
2609 my ($self, $user) = @_;
2610 if ($user->{bounce}) {
2611 $user->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
2612 $user->{'first_bounce'} = $1;
2613 $user->{'last_bounce'} = $2;
2614 $user->{'bounce_count'} = $3;
2615 if ($5 =~ /^(\d+)\.\d+\.\d+$/) {
2616 $user->{'bounce_class'} = $1;
2617 }
2618
2619 ## Define color in function of bounce_score
2620 if ($user->{'bounce_score'} <=
2621 $self->{'admin'}{'bouncers_level1'}{'rate'}) {
2622 $user->{'bounce_level'} = 0;
2623 } elsif ($user->{'bounce_score'} <=
2624 $self->{'admin'}{'bouncers_level2'}{'rate'}) {
2625 $user->{'bounce_level'} = 1;
2626 } else {
2627 $user->{'bounce_level'} = 2;
2628 }
2629 }
2630}
2631
2632# Old names: get_first_list_member() and get_next_list_member().
2633sub get_members {
2634 $log->syslog('debug2', '(%s, %s, %s => %s, %s => %s, %s => %s)', @_);
2635 my $self = shift;
2636 my $role = shift;
2637 my %options = @_;
2638
2639 my $limit = $options{limit};
2640 my $offset = $options{offset};
2641 my $order = $options{order};
2642 my $cond = $options{othercondition};
2643
2644 my $sdm = Sympa::DatabaseManager->instance;
2645 my $sth;
2646
2647 # Filters
2648 my $filter = '';
2649 if ($role eq 'member') {
2650 $filter = '';
2651 } elsif ($role eq 'unconcealed_member') {
2652 $filter = " AND visibility_subscriber <> 'conceal'";
2653 } else {
2654 die sprintf 'Unknown role "%s"', $role;
2655 }
2656
2657 if ($cond) {
2658 $filter .= " AND ($cond)";
2659 }
2660
2661 # SORT BY
2662 my $order_by = '';
2663 if ($order) {
2664 $order_by = 'ORDER BY '
2665 . (
2666 { email => 'user_subscriber',
2667 date => 'date_epoch_subscriber DESC',
2668 sources =>
2669 'subscribed_subscriber DESC, inclusion_label_subscriber ASC',
2670 name => 'comment_subscriber',
2671 }->{$order}
2672 || 'user_subscriber'
2673 );
2674 }
2675
2676 unless (
2677 $sdm
2678 and $sth = $sdm->do_prepared_query(
2679 sprintf(
2680 q{SELECT %s
2681 FROM subscriber_table
2682 WHERE list_subscriber = ? AND robot_subscriber = ?%s
2683 %s},
2684 _list_member_cols($sdm), $filter, $order_by
2685 ),
2686 $self->{'name'},
2687 $self->{'domain'}
2688 )
2689 ) {
2690 $log->syslog('err', 'Unable to get members of list %s', $self);
2691 return; # Returns void.
2692 }
2693
2694 # Offset
2695 # Note: Several RDBMSs don't support nonstandard OFFSET clause, OTOH
2696 # some others don't support standard ROW_NUMBER function.
2697 # Instead, fetch unneccessary rows and discard them.
2698 if (defined $offset) {
2699 my $remainder = $offset;
2700 while (1000 < $remainder) {
2701 $remainder -= 1000;
2702 my $rows = $sth->fetchall_arrayref([qw(email)], 1000);
2703 last unless $rows and @$rows;
2704 }
2705 if (0 < $remainder) {
2706 $sth->fetchall_arrayref([qw(email)], $remainder);
2707 }
2708 }
2709
2710 my $users = $sth->fetchall_arrayref({}, ($limit || undef));
2711 $sth->finish;
2712
2713 foreach my $user (@{$users || []}) {
2714 $log->syslog('err',
2715 'Warning: Entry with empty email address in list %s',
2716 $self->{'name'})
2717 unless $user->{email};
2718
2719 $user->{reception} ||= 'mail';
2720 $user->{reception} =
2721 $self->{'admin'}{'default_user_options'}{'reception'}
2722 unless $self->is_available_reception_mode($user->{reception});
2723 $user->{visibility} ||= 'noconceal';
2724 $user->{update_date} ||= $user->{date};
2725
2726 if (defined $user->{custom_attribute}) {
2727 my $custom_attr = Sympa::Tools::Data::decode_custom_attribute(
2728 $user->{custom_attribute});
2729 unless (defined $custom_attr) {
2730 $log->syslog(
2731 'err',
2732 "Failed to parse custom attributes for user %s, list %s",
2733 $user->{email},
2734 $self
2735 );
2736 }
2737 $user->{custom_attribute} = $custom_attr;
2738 }
2739
2740 # Compat.<=6.2.44 FIXME: needed?
2741 $user->{included} = 1
2742 if defined $user->{'inclusion'};
2743 }
2744
2745 return wantarray ? @$users : $users;
2746}
2747
2748# Old name: get_resembling_list_members_no_object().
2749# Note that the name of this function in 6.2a.32 or earlier is
2750# "get_ressembling_list_members_no_object" (look at doubled "s").
2751sub get_resembling_members {
2752 $log->syslog('debug2', '(%s, %s)', @_);
2753 my $self = shift;
2754 my $role = shift;
2755 my $searchkey = Sympa::Tools::Text::canonic_email(shift);
2756
2757 return unless defined $searchkey;
2758 $searchkey =~ s/(['%_\\])/\\$1/g;
2759
2760 my ($local, $domain) = split /\@/, $searchkey;
2761 return unless $local and $domain;
2762 my ($account, $ext) = ($local =~ /\A(.*)[+](.*)\z/);
2763 my ($first, $name) = ($local =~ /\A(.*)[.](.*)\z/);
2764 my $initial = $1 if defined $first and $first =~ /\A([a-z])/;
2765 $initial .= $1
2766 if defined $initial
2767 and defined $name
2768 and $name =~ /\A([a-z])/;
2769 my ($top, $upperdomain) = split /[.]/, $domain, 2;
2770
2771 my @cond;
2772 ##### plused
2773 # is subscriber a plused email ?
2774 push @cond, $account . '@' . $domain if defined $ext;
2775 # is some subscriber ressembling with a plused email ?
2776 push @cond, $local . '+%@' . $domain;
2777 # ressembling local part
2778 # try to compare firstname.name@domain with name@domain
2779 push @cond, '%' . $local . '@' . $domain;
2780 push @cond, $name . '@' . $domain if defined $name;
2781 #### Same local_part and ressembling domain
2782 # compare host.domain.tld with domain.tld
2783 # remove first token if there is still at least 2 tokens try to
2784 # find a subscriber with that domain
2785 push @cond, $local . '@' . $upperdomain if defined $upperdomain;
2786 push @cond, $local . '@%' . $domain;
2787 # looking for initial
2788 push @cond, $initial . '@' . $domain if defined $initial;
2789 #XXX#### users in the same local part in any other domain
2790 #XXXpush @cond, $local . '@%';
2791 my $cond = join ' OR ', map {"user_subscriber LIKE '$_'"} @cond;
2792 return unless $cond;
2793
2794 my $users = [$self->get_members($role, othercondition => $cond)];
2795 return wantarray ? @$users : $users;
2796}
2797
2798#DEPRECATED. Merged into get_resembling_members().
2799#sub find_list_member_by_pattern_no_object;
2800
2801sub get_info {
2802 my $self = shift;
2803
2804 my $info;
2805
2806 unless (open INFO, "$self->{'dir'}/info") {
2807 $log->syslog('err', 'Could not open %s: %m',
2808 $self->{'dir'} . '/info');
2809 return undef;
2810 }
2811
2812 while (<INFO>) {
2813 $info .= $_;
2814 }
2815 close INFO;
2816
2817 return $info;
2818}
2819
2820## Total bouncing subscribers
2821sub get_total_bouncing {
2822 my $self = shift;
2823 $log->syslog('debug2', '');
2824
2825 my $name = $self->{'name'};
2826
2827 push @sth_stack, $sth;
2828 my $sdm = Sympa::DatabaseManager->instance;
2829
2830 ## Query the Database
2831 unless (
2832 $sdm
2833 and $sth = $sdm->do_prepared_query(
2834 q{SELECT count(*)
2835 FROM subscriber_table
2836 WHERE list_subscriber = ? AND robot_subscriber = ? AND
2837 bounce_subscriber IS NOT NULL},
2838 $name, $self->{'domain'}
2839 )
2840 ) {
2841 $log->syslog('err',
2842 'Unable to gather bouncing subscribers count for list %s@%s',
2843 $name, $self->{'domain'});
2844 return undef;
2845 }
2846
2847 my $total = $sth->fetchrow;
2848
2849 $sth->finish();
2850
2851 $sth = pop @sth_stack;
2852
2853 return $total;
2854}
2855
2856## Does the user have a particular function in the list?
2857# Old name: [<=6.2.3] am_i().
2858sub is_admin {
2859 $log->syslog('debug2', '(%s, %s, %s, %s)', @_);
2860 my $self = shift;
2861 my $role = lc(shift || '');
2862 my $who = shift;
2863
2864 return undef unless defined $who and length $who;
2865
2866 if (@{$self->get_admins($role, filter => [email => $who])}) {
2867 return 1;
2868 } else {
2869 return undef;
2870 }
2871}
2872
2873## Is the person in user table (db only)
2874##sub is_global_user {
2875## DEPRECATED: Use Sympa::User::is_global_user().
2876
2877## Is the indicated person a subscriber to the list?
2878sub is_list_member {
2879 $log->syslog('debug2', '(%s, %s)', @_);
2880 my ($self, $who) = @_;
2881 $who = Sympa::Tools::Text::canonic_email($who);
2882
2883 return undef unless $who;
2884
2885 my $is_list_member = $self->_cache_get('is_list_member');
2886 if (defined $is_list_member and defined $is_list_member->{$who}) {
2887 return $is_list_member->{$who};
2888 }
2889 $is_list_member ||= {};
2890
2891 my $sdm = Sympa::DatabaseManager->instance;
2892 my $sth;
2893
2894 unless (
2895 $sdm
2896 and $sth = $sdm->do_prepared_query(
2897 q{SELECT count(*)
2898 FROM subscriber_table
2899 WHERE list_subscriber = ? AND robot_subscriber = ? AND
2900 user_subscriber = ?},
2901 $self->{'name'}, $self->{'domain'}, $who
2902 )
2903 ) {
2904 $log->syslog('err',
2905 'Unable to check chether user %s is subscribed to list %s',
2906 $who, $self);
2907 return undef;
2908 }
2909 $is_list_member->{$who} = $sth->fetchrow;
2910 $self->_cache_put('is_list_member', $is_list_member);
2911 $sth->finish;
2912
2913 return $is_list_member->{$who};
2914}
2915
2916## Sets new values for the given user (except gecos)
2917sub update_list_member {
2918 my $self = shift;
2919 my $who = Sympa::Tools::Text::canonic_email(shift);
2920 my $values = $_[0]; # Compat.
2921 $values = {@_} unless ref $values eq 'HASH';
2922
2923 my ($field, $value, $table);
2924
2925 # Mapping between var and field names.
2926 my %map_field = _map_list_member_cols();
2927
2928 my $sdm = Sympa::DatabaseManager->instance;
2929 return undef unless $sdm;
2930
2931 my @set_list;
2932 my @val_list;
2933 while (($field, $value) = each %{$values}) {
2934 die sprintf 'Unknown database field %s', $field
2935 unless $map_field{$field};
2936
2937 if ($field eq 'custom_attribute') {
2938 push @set_list, sprintf('%s = ?', $map_field{$field});
2939 push @val_list,
2940 Sympa::Tools::Data::encode_custom_attribute($value);
2941 } elsif ($numeric_field{$map_field{$field}}) {
2942 push @set_list, sprintf('%s = ?', $map_field{$field});
2943 # FIXME: Can't have a null value?
2944 push @val_list, ($value || 0);
2945 } else {
2946 push @set_list, sprintf('%s = ?', $map_field{$field});
2947 push @val_list, $value;
2948 }
2949 }
2950 return 0 unless @set_list;
2951
2952 # Update field
2953 if ($who eq '*') {
2954 unless (
2955 $sdm->do_prepared_query(
2956 sprintf(
2957 q{UPDATE subscriber_table
2958 SET %s
2959 WHERE list_subscriber = ? AND robot_subscriber = ?},
2960 join(', ', @set_list)
2961 ),
2962 @val_list,
2963 $self->{'name'},
2964 $self->{'domain'}
2965 )
2966 ) {
2967 $log->syslog(
2968 'err',
2969 'Could not update information for subscriber %s in database for list %s',
2970 $who,
2971 $self
2972 );
2973 return undef;
2974 }
2975 } else {
2976 unless (
2977 $sdm->do_prepared_query(
2978 sprintf(
2979 q{UPDATE subscriber_table
2980 SET %s
2981 WHERE user_subscriber = ? AND
2982 list_subscriber = ? AND robot_subscriber = ?},
2983 join(',', @set_list)
2984 ),
2985 @val_list,
2986 $who,
2987 $self->{'name'},
2988 $self->{'domain'}
2989 )
2990 ) {
2991 $log->syslog(
2992 'err',
2993 'Could not update information for subscriber %s in database for list %s',
2994 $who,
2995 $self
2996 );
2997 return undef;
2998 }
2999 }
3000
3001 # Delete subscription / signoff requests no longer used.
3002 my $new_email;
3003 if ( $who ne '*'
3004 and $values->{'email'}
3005 and $new_email = Sympa::Tools::Text::canonic_email($values->{'email'})
3006 and $who ne $new_email) {
3007 my $spool_req;
3008
3009 # Delete signoff requests if any.
3010 $spool_req = Sympa::Spool::Auth->new(
3011 context => $self,
3012 action => 'del',
3013 email => $who,
3014 );
3015 while (1) {
3016 my ($request, $handle) = $spool_req->next;
3017 last unless $handle;
3018 next unless $request;
3019
3020 $spool_req->remove($handle);
3021 }
3022
3023 # Delete subscription requests if any.
3024 $spool_req = Sympa::Spool::Auth->new(
3025 context => $self,
3026 action => 'add',
3027 email => $new_email,
3028 );
3029 while (1) {
3030 my ($request, $handle) = $spool_req->next;
3031 last unless $handle;
3032 next unless $request;
3033
3034 $spool_req->remove($handle);
3035 }
3036 }
3037
3038 # Rename picture on disk if user email changed.
3039 if ($values->{'email'}) {
3040 foreach my $path ($self->find_picture_paths($who)) {
3041 my $extension = [reverse split /\./, $path]->[0];
3042 my $new_path = $self->get_picture_path(
3043 Digest::MD5::md5_hex($values->{'email'}) . '.' . $extension);
3044 unless (rename $path, $new_path) {
3045 $log->syslog('err', 'Failed to rename %s to %s : %m',
3046 $path, $new_path);
3047 last;
3048 }
3049 }
3050 }
3051
3052 return 1;
3053}
3054
3055## Sets new values for the given admin user (except gecos)
3056sub update_list_admin {
3057 $log->syslog('debug2', '(%s, %s, %s, ...)', @_);
3058 my $self = shift;
3059 my $who = Sympa::Tools::Text::canonic_email(shift);
3060 my $role = shift;
3061 my $values = $_[0]; # Compat.
3062 $values = {@_} unless ref $values eq 'HASH';
3063
3064 my ($field, $value, $table);
3065 my $name = $self->{'name'};
3066
3067 ## mapping between var and field names
3068 my %map_field = (
3069 reception => 'reception_admin',
3070 visibility => 'visibility_admin',
3071 date => 'date_epoch_admin',
3072 update_date => 'update_epoch_admin',
3073 inclusion => 'inclusion_admin',
3074 inclusion_ext => 'inclusion_ext_admin',
3075 inclusion_label => 'inclusion_label_admin',
3076 gecos => 'comment_admin',
3077 password => 'password_user',
3078 email => 'user_admin',
3079 subscribed => 'subscribed_admin',
3080 info => 'info_admin',
3081 profile => 'profile_admin',
3082 role => 'role_admin'
3083 );
3084
3085 ## mapping between var and tables
3086 my %map_table = (
3087 reception => 'admin_table',
3088 visibility => 'admin_table',
3089 date => 'admin_table',
3090 update_date => 'admin_table',
3091 inclusion => 'admin_table',
3092 inclusion_ext => 'admin_table',
3093 inclusion_label => 'admin_table',
3094 gecos => 'admin_table',
3095 password => 'user_table',
3096 email => 'admin_table',
3097 subscribed => 'admin_table',
3098 info => 'admin_table',
3099 profile => 'admin_table',
3100 role => 'admin_table'
3101 );
3102 #### ??
3103 ## additional DB fields
3104 #if (defined $Conf::Conf{'db_additional_user_fields'}) {
3105 # foreach my $f (split ',', $Conf::Conf{'db_additional_user_fields'}) {
3106 # $map_table{$f} = 'user_table';
3107 # $map_field{$f} = $f;
3108 # }
3109 #}
3110
3111 # Compat.<=6.2.44 FIXME: is this used?
3112 $values->{inclusion} ||= ($values->{update_date} || time)
3113 if $values->{included};
3114
3115 my $sdm = Sympa::DatabaseManager->instance;
3116 return undef unless $sdm;
3117
3118 ## Update each table
3119 foreach $table ('user_table', 'admin_table') {
3120
3121 my @set_list;
3122 while (($field, $value) = each %{$values}) {
3123
3124 unless ($map_field{$field} and $map_table{$field}) {
3125 $log->syslog('err', 'Unknown database field %s', $field);
3126 next;
3127 }
3128
3129 if ($map_table{$field} eq $table) {
3130 if ($value and $value eq 'NULL') { #FIXME:get_null_value?
3131 if ($Conf::Conf{'db_type'} eq 'mysql') {
3132 $value = '\N';
3133 }
3134 } elsif ($numeric_field{$map_field{$field}}) {
3135 $value ||= 0; #FIXME:Can't have a null value
3136 } else {
3137 $value = $sdm->quote($value);
3138 }
3139 my $set = sprintf "%s=%s", $map_field{$field}, $value;
3140
3141 push @set_list, $set;
3142 }
3143 }
3144 next unless @set_list;
3145
3146 ## Update field
3147 if ($table eq 'user_table') {
3148 unless (
3149 $sth = $sdm->do_query(
3150 q{UPDATE %s SET %s WHERE email_user = %s},
3151 $table, join(',', @set_list),
3152 $sdm->quote($who)
3153 )
3154 ) {
3155 $log->syslog('err',
3156 'Could not update information for admin %s in table %s',
3157 $who, $table);
3158 return undef;
3159 }
3160
3161 } elsif ($table eq 'admin_table') {
3162 if ($who eq '*') {
3163 unless (
3164 $sth = $sdm->do_query(
3165 q{UPDATE %s
3166 SET %s
3167 WHERE list_admin = %s AND robot_admin = %s AND
3168 role_admin = %s},
3169 $table,
3170 join(',', @set_list),
3171 $sdm->quote($name),
3172 $sdm->quote($self->{'domain'}),
3173 $sdm->quote($role)
3174 )
3175 ) {
3176 $log->syslog(
3177 'err',
3178 'Could not update information for admin %s in table %s for list %s@%s',
3179 $who,
3180 $table,
3181 $name,
3182 $self->{'domain'}
3183 );
3184 return undef;
3185 }
3186 } else {
3187 unless (
3188 $sth = $sdm->do_query(
3189 q{UPDATE %s
3190 SET %s
3191 WHERE user_admin = %s AND
3192 list_admin = %s AND robot_admin = %s AND
3193 role_admin = %s},
3194 $table,
3195 join(',', @set_list),
3196 $sdm->quote($who),
3197 $sdm->quote($name),
3198 $sdm->quote($self->{'domain'}),
3199 $sdm->quote($role)
3200 )
3201 ) {
3202 $log->syslog(
3203 'err',
3204 'Could not update information for admin %s in table %s for list %s@%s',
3205 $who,
3206 $table,
3207 $name,
3208 $self->{'domain'}
3209 );
3210 return undef;
3211 }
3212 }
3213 }
3214 }
3215
3216 # Reset session cache.
3217 $self->_cache_publish_expiry('admin_user');
3218
3219 return 1;
3220}
3221
3222## Sets new values for the given user in the Database
3223##sub update_global_user {
3224## DEPRECATED: Use Sympa::User::update_global_user() or $user->save().
3225
3226## Adds a user to the user_table
3227##sub add_global_user {
3228## DEPRECATED: Use Sympa::User::add_global_user() or $user->save().
3229
3230## Adds a list member ; no overwrite.
3231sub add_list_member {
3232 $log->syslog('debug2', '%s, ...', @_);
3233 my $self = shift;
3234 my @new_users = @_;
3235
3236 my $name = $self->{'name'};
3237
3238 $self->{'add_outcome'} = undef;
3239 $self->{'add_outcome'}{'added_members'} = 0;
3240 $self->{'add_outcome'}{'expected_number_of_added_users'} = $#new_users;
3241 $self->{'add_outcome'}{'remaining_members_to_add'} =
3242 $self->{'add_outcome'}{'expected_number_of_added_users'};
3243
3244 my $current_list_members_count = 0;
3245 if ($self->{'admin'}{'max_list_members'} > 0) {
3246 $current_list_members_count = $self->get_total; # FIXME: high db load
3247 }
3248
3249 my $sdm = Sympa::DatabaseManager->instance;
3250
3251 foreach my $new_user (@new_users) {
3252 my $who = Sympa::Tools::Text::canonic_email($new_user->{'email'});
3253 unless (defined $who) {
3254 $log->syslog('err', 'Ignoring %s which is not a valid email',
3255 $new_user->{'email'});
3256 next;
3257 }
3258 if (Sympa::Tools::Domains::is_blocklisted($who)) {
3259 $log->syslog('err', 'Ignoring %s which uses a blocklisted domain',
3260 $new_user->{'email'});
3261 next;
3262 }
3263 unless (
3264 $current_list_members_count < $self->{'admin'}{'max_list_members'}
3265 || $self->{'admin'}{'max_list_members'} == 0) {
3266 $self->{'add_outcome'}{'errors'}{'max_list_members_exceeded'} = 1;
3267 $log->syslog(
3268 'notice',
3269 'Subscription of user %s failed: max number of subscribers (%s) reached',
3270 $new_user->{'email'},
3271 $self->{'admin'}{'max_list_members'}
3272 );
3273 last;
3274 }
3275
3276 # Delete from exclusion_table and force a sync_include if new_user was
3277 # excluded
3278 if ($self->insert_delete_exclusion($who, 'delete')) {
3279 $self->sync_include('member');
3280 if ($self->is_list_member($who)) {
3281 $self->{'add_outcome'}{'added_members'}++;
3282 next;
3283 }
3284 }
3285
3286 $new_user->{'date'} ||= time;
3287 $new_user->{'update_date'} ||= $new_user->{'date'};
3288
3289 my $custom_attribute;
3290 if (ref $new_user->{'custom_attribute'} eq 'HASH') {
3291 $new_user->{'custom_attribute'} =
3292 Sympa::Tools::Data::encode_custom_attribute(
3293 $new_user->{'custom_attribute'});
3294 }
3295 $log->syslog(
3296 'debug3',
3297 'Custom_attribute = %s',
3298 $new_user->{'custom_attribute'}
3299 );
3300
3301 # Compat.<=6.2.44 FIXME: needed?
3302 $new_user->{'inclusion'} ||= ($new_user->{'date'} || time)
3303 if $new_user->{'included'};
3304
3305 ## Either is_included or is_subscribed must be set
3306 ## default is is_subscriber for backward compatibility reason
3307 $new_user->{'subscribed'} = 1 unless defined $new_user->{'inclusion'};
3308 $new_user->{'subscribed'} ||= 0;
3309
3310 unless (defined $new_user->{'inclusion'}) {
3311 ## Is the email in user table?
3312 ## Insert in User Table
3313 unless (
3314 Sympa::User->new(
3315 $who,
3316 'gecos' => $new_user->{'gecos'},
3317 'lang' => $new_user->{'lang'},
3318 'password' => $new_user->{'password'}
3319 )
3320 ) {
3321 $log->syslog('err', 'Unable to add user %s to user_table',
3322 $who);
3323 $self->{'add_outcome'}{'errors'}{'unable_to_add_to_database'}
3324 = 1;
3325 next;
3326 }
3327 }
3328
3329 #Log in stat_table to make staistics
3330 $log->add_stat(
3331 'robot' => $self->{'domain'},
3332 'list' => $self->{'name'},
3333 'operation' => 'add_or_subscribe',
3334 'parameter' => '',
3335 'mail' => $new_user->{'email'}
3336 );
3337
3338 ## Update Subscriber Table
3339 unless (
3340 $sdm
3341 and $sdm->do_prepared_query(
3342 q{INSERT INTO subscriber_table
3343 (user_subscriber, comment_subscriber,
3344 list_subscriber, robot_subscriber,
3345 date_epoch_subscriber, update_epoch_subscriber,
3346 inclusion_subscriber, inclusion_ext_subscriber,
3347 inclusion_label_subscriber,
3348 reception_subscriber, topics_subscriber,
3349 visibility_subscriber, subscribed_subscriber,
3350 custom_attribute_subscriber,
3351 suspend_subscriber,
3352 suspend_start_date_subscriber,
3353 suspend_end_date_subscriber,
3354 number_messages_subscriber)
3355 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 0)},
3356 $who, $new_user->{'gecos'},
3357 $name, $self->{'domain'},
3358 $new_user->{'date'}, $new_user->{'update_date'},
3359 $new_user->{'inclusion'}, $new_user->{'inclusion_ext'},
3360 $new_user->{'inclusion_label'},
3361 $new_user->{'reception'}, $new_user->{'topics'},
3362 $new_user->{'visibility'}, $new_user->{'subscribed'},
3363 $new_user->{'custom_attribute'},
3364 $new_user->{'suspend'},
3365 $new_user->{'startdate'},
3366 $new_user->{'enddate'}
3367 )
3368 ) {
3369 $log->syslog(
3370 'err',
3371 'Unable to add subscriber %s to table subscriber_table for list %s@%s %s',
3372 $who,
3373 $name,
3374 $self->{'domain'}
3375 );
3376 next;
3377 }
3378
3379 # Delete subscription requests if any.
3380 my $spool_req = Sympa::Spool::Auth->new(
3381 context => $self,
3382 action => 'add',
3383 email => $who,
3384 );
3385 while (1) {
3386 my ($request, $handle) = $spool_req->next;
3387 last unless $handle;
3388 next unless $request;
3389
3390 $spool_req->remove($handle);
3391 }
3392
3393 $self->{'add_outcome'}{'added_members'}++;
3394 $self->{'add_outcome'}{'remaining_member_to_add'}--;
3395 $current_list_members_count++;
3396 }
3397
3398 $self->_cache_publish_expiry('member');
3399 $self->_create_add_error_string() if ($self->{'add_outcome'}{'errors'});
3400 return 1;
3401}
3402
3403sub _create_add_error_string {
3404 my $self = shift;
3405 $self->{'add_outcome'}{'errors'}{'error_message'} = '';
3406 if ($self->{'add_outcome'}{'errors'}{'max_list_members_exceeded'}) {
3407 $self->{'add_outcome'}{'errors'}{'error_message'} .=
3408 $language->gettext_sprintf(
3409 'Attempt to exceed the max number of members (%s) for this list.',
3410 $self->{'admin'}{'max_list_members'}
3411 );
3412 }
3413 if ($self->{'add_outcome'}{'errors'}{'unable_to_add_to_database'}) {
3414 $self->{'add_outcome'}{'error_message'} .= ' '
3415 . $language->gettext(
3416 'Attempts to add some users in database failed.');
3417 }
3418 $self->{'add_outcome'}{'errors'}{'error_message'} .= ' '
3419 . $language->gettext_sprintf(
3420 'Added %s users out of %s required.',
3421 $self->{'add_outcome'}{'added_members'},
3422 $self->{'add_outcome'}{'expected_number_of_added_users'}
3423 );
3424}
3425
3426## Adds a new list admin user, no overwrite.
3427sub add_list_admin {
3428 $log->syslog('debug2', '(%s, %s, ...)', @_);
3429 my $self = shift;
3430 my $role = shift;
3431 my @users = @_;
3432
3433 my $total = 0;
3434 foreach my $user (@users) {
3435 $total++ if $self->_add_list_admin($role, $user);
3436 }
3437
3438 $self->_cache_publish_expiry('admin_user') if $total;
3439 return $total;
3440}
3441
3442sub _add_list_admin {
3443 my $self = shift;
3444 my $role = shift;
3445 my $user = shift;
3446 my %options = @_;
3447
3448 my $who = Sympa::Tools::Text::canonic_email($user->{'email'});
3449 return undef unless defined $who and length $who;
3450
3451 unless (defined $user->{'inclusion'}) {
3452 # Is the email in user_table? Insert it.
3453 #FIXME: Is it required?
3454 unless (
3455 Sympa::User->new(
3456 $who,
3457 'gecos' => $user->{'gecos'},
3458 'lang' => $user->{'lang'},
3459 'password' => $user->{'password'},
3460 )
3461 ) {
3462 $log->syslog('err', 'Unable to add admin %s to user_table', $who);
3463 return undef;
3464 }
3465 }
3466
3467 $user->{'reception'} ||= 'mail';
3468 $user->{'visibility'} ||= 'noconceal';
3469 $user->{'profile'} ||= 'normal';
3470
3471 $user->{'date'} ||= time;
3472 $user->{'update_date'} ||= $user->{'date'};
3473
3474 # Compat.<=6.2.44 FIXME: needed?
3475 $user->{'inclusion'} ||= $user->{'date'}
3476 if $user->{'included'};
3477
3478 # Either is_included or is_subscribed must be set.
3479 # Default is is_subscriber for backward compatibility reason.
3480 $user->{'subscribed'} = 1 unless defined $user->{'inclusion'};
3481 $user->{'subscribed'} ||= 0;
3482
3483 my $sdm = Sympa::DatabaseManager->instance;
3484 my $sth;
3485 my %map_field = _map_list_admin_cols();
3486 my @key_list =
3487 grep { $_ ne 'email' and $_ ne 'role' } sort keys %map_field;
3488 my (@set_list, @val_list);
3489
3490 # Update Admin Table
3491 @set_list =
3492 @map_field{grep { $_ ne 'date' and exists $user->{$_} } @key_list};
3493 @val_list =
3494 @{$user}{grep { $_ ne 'date' and exists $user->{$_} } @key_list};
3495 if ( $options{replace}
3496 and @set_list
3497 and $sdm
3498 and $sth = $sdm->do_prepared_query(
3499 sprintf(
3500 q{UPDATE admin_table
3501 SET %s
3502 WHERE role_admin = ? AND user_admin = ? AND
3503 list_admin = ? AND robot_admin = ?},
3504 join(', ', map { sprintf '%s = ?', $_ } @set_list)
3505 ),
3506 @val_list,
3507 $role,
3508 $user->{email},
3509 $self->{'name'},
3510 $self->{'domain'}
3511 )
3512 and $sth->rows # If no affected rows, then insert a new row
3513 ) {
3514 return 1;
3515 }
3516 @set_list = @map_field{@key_list};
3517 @val_list = @{$user}{@key_list};
3518 if ( @set_list
3519 and $sdm
3520 and $sdm->do_prepared_query(
3521 sprintf(
3522 q{INSERT INTO admin_table
3523 (%s, role_admin, user_admin, list_admin, robot_admin)
3524 VALUES (%s, ?, ?, ?, ?)},
3525 join(', ', @set_list),
3526 join(', ', map {'?'} @set_list)
3527 ),
3528 @val_list,
3529 $role,
3530 $who,
3531 $self->{'name'},
3532 $self->{'domain'}
3533 )
3534 ) {
3535 return 1;
3536 }
3537
3538 $log->syslog('err',
3539 'Unable to add %s %s to table admin_table for list %s',
3540 $role, $who, $self);
3541 return undef;
3542}
3543
3544# Moved to: (part of) Sympa::Request::Handler::move_list::_move().
3545#sub rename_list_db;
3546
3547## Check list authorizations
3548## Higher level sub for request_action
3549# DEPRECATED; Use Sympa::Scenario::request_action();
3550#sub check_list_authz;
3551
3552## Initialize internal list cache
3553# Deprecated. No longer used.
3554#sub init_list_cache;
3555
3556## May the indicated user edit the indicated list parameter or not?
3557sub may_edit {
3558 $log->syslog('debug3', '(%s, %s, %s)', @_);
3559 my $self = shift;
3560 my $parameter = shift;
3561 my $who = shift;
3562 my %options = @_;
3563
3564 # Special case for file edition.
3565 if ($options{file}) {
3566 $parameter = 'info.file' if $parameter eq 'info';
3567 }
3568
3569 my $edit_list_conf = $self->{_edit_list};
3570
3571 my $role;
3572
3573 ## What privilege?
3574 if (Sympa::is_listmaster($self, $who)) {
3575 $role = 'listmaster';
3576 } elsif ($self->is_admin('privileged_owner', $who)) {
3577 $role = 'privileged_owner';
3578 } elsif ($self->is_admin('owner', $who)) {
3579 $role = 'owner';
3580 } elsif ($self->is_admin('editor', $who)) {
3581 $role = 'editor';
3582# }elsif ( $self->is_admin('subscriber',$who) ) {
3583# $role = 'subscriber';
3584 } else {
3585 return ('user', 'hidden');
3586 }
3587
3588 ## What privilege does he/she has?
3589 my ($what, @order);
3590
3591 if ( $parameter =~ /^(\w+)\.(\w+)$/
3592 and $parameter !~ /\.tt2$/
3593 and $parameter ne 'message_header.mime'
3594 and $parameter ne 'message_footer.mime'
3595 and $parameter ne 'message_global_footer.mime') {
3596 my $main_parameter = $1;
3597 @order = (
3598 $edit_list_conf->{$parameter}{$role},
3599 $edit_list_conf->{$main_parameter}{$role},
3600 $edit_list_conf->{'default'}{$role},
3601 $edit_list_conf->{'default'}{'default'}
3602 );
3603 } else {
3604 @order = (
3605 $edit_list_conf->{$parameter}{$role},
3606 $edit_list_conf->{'default'}{$role},
3607 $edit_list_conf->{'default'}{'default'}
3608 );
3609 }
3610
3611 foreach $what (@order) {
3612 if (defined $what) {
3613 return ($role, $what);
3614 }
3615 }
3616
3617 return ('user', 'hidden');
3618}
3619
3620# Never used.
3621#sub may_create_parameter;
3622
3623# OBSOLETED: No longer used.
3624#sub may_do;
3625
3626## Does the list support digest mode
3627sub is_digest {
3628 return (shift->{'admin'}{'digest'});
3629}
3630
3631## Does the file exist?
3632# DEPRECATED. No longer used.
3633#sub archive_exist;
3634
3635## List the archived files
3636# DEPRECATED. Use Sympa::Archive::get_archives().
3637#sub archive_ls;
3638
3639# Merged into distribute_msg().
3640#sub archive_msg;
3641
3642## Is the list moderated?
3643sub is_moderated {
3644
3645 return 1 if (defined shift->{'admin'}{'editor'});
3646
3647 return 0;
3648}
3649
3650## Is the list archived?
3651#FIXME: Broken. Use scenario or is_archiving_enabled().
3652sub is_archived {
3653 $log->syslog('debug', '');
3654 if (shift->{'admin'}{'archive'}{'web_access'}) {
3655 $log->syslog('debug', '1');
3656 return 1;
3657 }
3658 $log->syslog('debug', 'Undef');
3659 return undef;
3660}
3661
3662## Is the list web archived?
3663#FIXME: Broken. Use scenario or is_archiving_enabled().
3664sub is_web_archived {
3665 my $self = shift;
3666 return 1
3667 if ref $self->{'admin'}{'archive'} eq 'HASH'
3668 and $self->{'admin'}{'archive'}{'web_access'};
3669 return undef;
3670}
3671
3672sub is_archiving_enabled {
3673 return Sympa::Tools::Data::smart_eq(shift->{'admin'}{'process_archive'},
3674 'on');
3675}
3676
3677sub is_included {
3678 my $self = shift;
3679
3680 my $sdm = Sympa::DatabaseManager->instance;
3681 my $sth;
3682
3683 unless (
3684 $sdm
3685 and $sth = $sdm->do_prepared_query(
3686 q{SELECT COUNT(*)
3687 FROM inclusion_table
3688 WHERE source_inclusion = ?},
3689 $self->get_id
3690 )
3691 ) {
3692 $log->syslog('err', 'Failed to get inclusion information on list %s',
3693 $self);
3694 return 1; # Fake positive result.
3695 }
3696 my ($num) = $sth->fetchrow_array;
3697 $sth->finish;
3698
3699 return $num;
3700}
3701
3702# Old name: Sympa::List::get_nextdigest().
3703# Moved to Sympa::Spindle::ProcessDigest::_may_distribute_digest().
3704#sub may_distribute_digest;
3705
3706# Moved: Use Sympa::Scenario::get_scenarios().
3707#sub load_scenario_list;
3708
3709# Deprecated: Use Sympa::Task::get_tasks().
3710#sub load_task_list;
3711
3712# No longer used.
3713#sub _load_task_title;
3714
3715## Loads all data sources
3716sub load_data_sources_list {
3717 my ($self, $robot) = @_;
3718 $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $robot);
3719
3720 my %list_of_data_sources;
3721
3722 foreach
3723 my $dir (@{Sympa::get_search_path($self, subdir => 'data_sources')}) {
3724 next unless -d $dir;
3725
3726 while (my $file = <$dir/*.incl>) {
3727 next unless $file =~ m{(?<=/)([^./][^/]*)\.incl\z};
3728 my $name = $1; # FIXME: Escape or omit hostile characters.
3729
3730 next if defined $list_of_data_sources{$name};
3731
3732 open my $fh, '<', $file or next;
3733 my ($title) = grep {s/\A\s*name\s+(.+)/$1/} <$fh>;
3734 close $fh;
3735 $list_of_data_sources{$name}{'title'} = $title || $name;
3736
3737 $list_of_data_sources{$name}{'name'} = $name;
3738 }
3739 }
3740
3741 return \%list_of_data_sources;
3742}
3743
3744## Loads the statistics information
3745# No longer used.
3746#sub _load_stats_file;
3747
3748## Loads the list of users.
3749# Old name:: Sympa::List::_load_list_members_file($file) which loaded members.
3750sub restore_users {
3751 $log->syslog('debug2', '(%s, %s)', @_);
3752 my $self = shift;
3753 my $role = shift;
3754
3755 die 'bug in logic. Ask developer'
3756 unless grep { $role eq $_ } qw(member owner editor);
3757
3758 # Open the file and switch to paragraph mode.
3759 my $file = $self->{'dir'} . '/' . $role . '.dump';
3760 my $lock_fh = Sympa::LockedFile->new($file, 5, '<') or return;
3761 local $RS = '';
3762
3763 my $time = time;
3764 if ($role eq 'member') {
3765 my %map_field = _map_list_member_cols();
3766
3767 while (my $para = <$lock_fh>) {
3768 my $user = {
3769 map {
3770 #FIMXE: Define appropriate schema.
3771 if (/^\s*(suspend|subscribed|included)\s+(\S+)\s*$/) {
3772 # Note: "included" is kept for comatibility.
3773 ($1 => !!$2);
3774 } elsif (/^\s*(custom_attribute)\s+(.+)\s*$/) {
3775 my $k = $1;
3776 my $decoded =
3777 Sympa::Tools::Data::decode_custom_attribute($2);
3778 ($decoded and %$decoded) ? ($k => $decoded) : ();
3779 } elsif (
3780 /^\s*(date|update_date|inclusion|inclusion_ext|startdate|enddate|bounce_score|number_messages)\s+(\d+)\s*$/
3781 or
3782 /^\s*(reception)\s+(mail|digest|nomail|summary|notice|txt|html|urlize|not_me)\s*$/
3783 or /^\s*(visibility)\s+(conceal|noconceal)\s*$/
3784 or (/^\s*(\w+)\s+(.+)\s*$/ and $map_field{$1})) {
3785 ($1 => $2);
3786 } else {
3787 ();
3788 }
3789 } split /\n/,
3790 $para
3791 };
3792 next unless $user->{email};
3793
3794 $user->{update_date} = $time;
3795 # Compat. <= 6.2.44
3796 # This is needed for dump by earlier version of Sympa.
3797 $user->{inclusion} ||= ($user->{update_date} || time)
3798 if $user->{included};
3799
3800 $self->add_list_member($user);
3801 }
3802 } else {
3803 my $changed = 0;
3804 my %map_field = _map_list_admin_cols();
3805
3806 while (my $para = <$lock_fh>) {
3807 my $user = {
3808 map {
3809 #FIMXE:Define appropriate schema.
3810 if (/^\s*(subscribed|included)\s+(\S+)\s*$/) {
3811 # Note: "included" is kept for comatibility.
3812 ($1 => !!$2);
3813 } elsif (/^\s*(email|gecos|info|id)\s+(.+)\s*$/
3814 or /^\s*(profile)\s+(normal|privileged)\s*$/
3815 or
3816 /^\s*(date|update_date|inclusion|inclusion_ext)\s+(\d+)\s*$/
3817 or /^\s*(reception)\s+(mail|nomail)\s*$/
3818 or /^\s*(visibility)\s+(conceal|noconceal)\s*$/
3819 or (/^\s*(\w+)\s+(.+)\s*$/ and $map_field{$1})) {
3820 ($1 => $2);
3821 } else {
3822 ();
3823 }
3824 } split /\n/,
3825 $para
3826 };
3827 next unless defined $user->{email} and length $user->{email};
3828
3829 $user->{update_date} = $time;
3830 # Compat. <= 6.2.44
3831 # This is needed for dump by earlier version of Sympa.
3832 $user->{inclusion} ||= ($user->{update_date} || time)
3833 if $user->{included};
3834
3835 $self->_add_list_admin($role, $user, replace => 1)
3836 and $changed++;
3837 }
3838
3839 # Remove outdated permanent users.
3840 # Included users will be cleared in the next time of sync.
3841 my $sdm = Sympa::DatabaseManager->instance;
3842 my $sth;
3843 unless (
3844 $sdm
3845 and $sth = $sdm->do_prepared_query(
3846 q{DELETE FROM admin_table
3847 WHERE role_admin = ? AND
3848 list_admin = ? AND robot_admin = ? AND
3849 subscribed_admin = 1 AND
3850 inclusion_admin IS NULL AND
3851 (update_epoch_admin IS NULL OR
3852 update_epoch_admin < ?)},
3853 $role, $self->{'name'}, $self->{'domain'},
3854 $time
3855 )
3856 ) {
3857 $log->syslog('err', '(%s) Failed to delete %s %s(s)',
3858 $self, $role);
3859 }
3860 $changed++ if $sth and $sth->rows;
3861 unless (
3862 $sdm
3863 and $sth = $sdm->do_prepared_query(
3864 q{UPDATE admin_table
3865 SET subscribed_admin = 0, update_epoch_admin = ?
3866 WHERE role_admin = ? AND
3867 list_admin = ? AND robot_admin = ? AND
3868 subscribed_admin = 1 AND
3869 inclusion_admin IS NOT NULL AND
3870 (update_epoch_admin IS NULL OR
3871 update_epoch_admin < ?)},
3872 $time,
3873 $role, $self->{'name'}, $self->{'domain'},
3874 $time
3875 )
3876 ) {
3877 $log->syslog('err', '(%s) Failed to delete %s', $self, $role);
3878 }
3879 $changed++ if $sth and $sth->rows;
3880
3881 $self->_cache_publish_expiry('admin_user') if $changed;
3882 }
3883
3884 $lock_fh->close;
3885}
3886
3887# Moved or deprecated:
3888#sub _include_users_remote_sympa_list;
3889# -> Sympa::DataSource::RemoteDump class.
3890#sub _get_https;
3891# -> No longer used.
3892#sub _include_users_list;
3893# -> Sympa::DataSource::List class.
3894#sub _include_users_admin;
3895# -> Never used.
3896#sub _include_users_file;
3897# -> Sympa::DataSource::File class.
3898#sub _include_users_remote_file;
3899# -> Sympa::DataSource::RemoteFile class.
3900#sub _include_users_ldap;
3901# -> Sympa::DataSource::LDAP class.
3902#sub _include_users_ldap_2level;
3903# -> Sympa::DataSource::LDAP2 class.
3904#sub _include_sql_ca;
3905# -> Sympa::DataSource::SQL class.
3906#sub _include_ldap_ca;
3907# -> Sympa::DataSource::LDAP class.
3908#sub _include_ldap_2level_ca;
3909# -> Sympa::DataSource::LDAP2 class.
3910#sub _include_users_sql;
3911# -> Sympa::DataSource::SQL class.
3912#sub _load_list_members_from_include;
3913# -> Sympa::Request::Handler::include class.
3914#sub _load_list_admin_from_include;
3915# -> Sympa::Request::Handler::include class.
3916
3917# Load an include admin user file (xx.incl)
3918#FIXME: Would be merged to _load_list_config_file() which mostly duplicates.
3919sub _load_include_admin_user_file {
3920 $log->syslog('debug3', '(%s, %s)', @_);
3921 my $self = shift;
3922 my $entry = shift;
3923
3924 my $output = '';
3925 my $filename = $entry->{'source'} . '.incl';
3926 my @data = split ',', $entry->{'source_parameters'}
3927 if defined $entry->{'source_parameters'};
3928 my $template = Sympa::Template->new($self, subdir => 'data_sources');
3929 unless ($template->parse({param => [@data]}, $filename, \$output)) {
3930 $log->syslog('err', 'Failed to parse %s', $filename);
3931 return undef;
3932 }
3933 1 while $output =~ s/(\A|\n)\s+\n/$1\n/g; # Clean empty lines
3934 my @paragraphs = map { [split /\n/, $_] } split /\n\n+/, $output;
3935
3936 my $robot = $self->{'domain'};
3937
3938 my $pinfo = {};
3939 # 'include_list' is kept for comatibility with 6.2.15 or earlier.
3940 my @sources = (@sources_providing_listmembers, 'include_list');
3941 @{$pinfo}{@sources} =
3942 @{Sympa::Robot::list_params($robot) || {}}{@sources};
3943
3944 my %include;
3945 for my $index (0 .. $#paragraphs) {
3946 my @paragraph = @{$paragraphs[$index]};
3947
3948 my $pname;
3949
3950 ## Clean paragraph, keep comments
3951 for my $i (0 .. $#paragraph) {
3952 my $changed = undef;
3953 for my $j (0 .. $#paragraph) {
3954 if ($paragraph[$j] =~ /^\s*\#/) {
3955 chomp($paragraph[$j]);
3956 push @{$include{'comment'}}, $paragraph[$j];
3957 splice @paragraph, $j, 1;
3958 $changed = 1;
3959 } elsif ($paragraph[$j] =~ /^\s*$/) {
3960 splice @paragraph, $j, 1;
3961 $changed = 1;
3962 }
3963
3964 last if $changed;
3965 }
3966
3967 last unless $changed;
3968 }
3969
3970 ## Empty paragraph
3971 next unless ($#paragraph > -1);
3972
3973 ## Look for first valid line
3974 unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) {
3975 $log->syslog(
3976 'info',
3977 'Bad paragraph "%s" in %s',
3978 join("\n", @paragraph), $filename
3979 );
3980 next;
3981 }
3982
3983 $pname = $1;
3984
3985 # Parameter aliases (compatibility concerns).
3986 my $alias = $pinfo->{$pname}{'obsolete'};
3987 if ($alias and $pinfo->{$alias}) {
3988 $paragraph[0] =~ s/^\s*$pname/$alias/;
3989 $pname = $alias;
3990 }
3991
3992 unless ($pinfo->{$pname}) {
3993 $log->syslog('info', 'Unknown parameter "%s" in %s',
3994 $pname, $filename);
3995 next;
3996 }
3997
3998 ## Uniqueness
3999 if (defined $include{$pname}) {
4000 unless (($pinfo->{$pname}{'occurrence'} eq '0-n')
4001 or ($pinfo->{$pname}{'occurrence'} eq '1-n')) {
4002 $log->syslog('info', 'Multiple parameter "%s" in %s',
4003 $pname, $filename);
4004 }
4005 }
4006
4007 ## Line or Paragraph
4008 if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') {
4009 ## This should be a paragraph
4010 unless ($#paragraph > 0) {
4011 $log->syslog(
4012 'info',
4013 'Expecting a paragraph for "%s" parameter in %s, ignore it',
4014 $pname,
4015 $filename
4016 );
4017 next;
4018 }
4019
4020 ## Skipping first line
4021 shift @paragraph;
4022
4023 my %hash;
4024 for my $i (0 .. $#paragraph) {
4025 next if ($paragraph[$i] =~ /^\s*\#/);
4026
4027 unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) {
4028 $log->syslog('info', 'Bad line "%s" in %s',
4029 $paragraph[$i], $filename);
4030 }
4031
4032 my $key = $1;
4033
4034 # Subparameter aliases (compatibility concerns).
4035 # Note: subparameter alias was introduced by 6.2.15.
4036 my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'};
4037 if ($alias and $pinfo->{$pname}{'format'}{$alias}) {
4038 $paragraph[$i] =~ s/^\s*$key/$alias/;
4039 $key = $alias;
4040 }
4041
4042 unless (defined $pinfo->{$pname}{'file_format'}{$key}) {
4043 $log->syslog('info',
4044 'Unknown key "%s" in paragraph "%s" in %s',
4045 $key, $pname, $filename);
4046 next;
4047 }
4048
4049 unless ($paragraph[$i] =~
4050 /^\s*$key(?:\s+($pinfo->{$pname}{'file_format'}{$key}{'file_format'}))?\s*$/i
4051 ) {
4052 chomp($paragraph[$i]);
4053 $log->syslog('info',
4054 'Bad entry "%s" for key "%s", paragraph "%s" in %s',
4055 $paragraph[$i], $key, $pname, $filename);
4056 next;
4057 }
4058
4059 $hash{$key} =
4060 $self->_load_list_param($key, $1,
4061 $pinfo->{$pname}{'file_format'}{$key});
4062 }
4063
4064 ## Apply defaults & Check required keys
4065 my $missing_required_field;
4066 foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) {
4067
4068 ## Default value
4069 unless (defined $hash{$k}) {
4070 if (defined $pinfo->{$pname}{'file_format'}{$k}{'default'}
4071 ) {
4072 $hash{$k} = $self->_load_list_param(
4073 $k,
4074 $pinfo->{$pname}{'file_format'}{$k}{'default'},
4075 $pinfo->{$pname}{'file_format'}{$k}
4076 );
4077 }
4078 }
4079 ## Required fields
4080 if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1'
4081 and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) {
4082 unless (defined $hash{$k}) {
4083 $log->syslog('info',
4084 'Missing key "%s" in param "%s" in %s',
4085 $k, $pname, $filename);
4086 $missing_required_field++;
4087 }
4088 }
4089 }
4090
4091 next if $missing_required_field;
4092
4093 ## Should we store it in an array
4094 if (($pinfo->{$pname}{'occurrence'} =~ /n$/)) {
4095 push @{$include{$pname}}, \%hash;
4096 } else {
4097 $include{$pname} = \%hash;
4098 }
4099 } else {
4100 ## This should be a single line
4101 unless ($#paragraph == 0) {
4102 $log->syslog('info',
4103 'Expecting a single line for "%s" parameter in %s',
4104 $pname, $filename);
4105 }
4106
4107 unless ($paragraph[0] =~
4108 /^\s*$pname(?:\s+($pinfo->{$pname}{'file_format'}))?\s*$/i) {
4109 chomp($paragraph[0]);
4110 $log->syslog('info', 'Bad entry "%s" in %s',
4111 $paragraph[0], $filename);
4112 next;
4113 }
4114
4115 my $value = $self->_load_list_param($pname, $1, $pinfo->{$pname});
4116
4117 if (($pinfo->{$pname}{'occurrence'} =~ /n$/)
4118 && !(ref($value) =~ /^ARRAY/)) {
4119 push @{$include{$pname}}, $value;
4120 } else {
4121 $include{$pname} = $value;
4122 }
4123 }
4124 }
4125
4126 _load_include_admin_user_postprocess(\%include);
4127
4128 delete $include{defaults};
4129 foreach my $cfgs (values %include) {
4130 foreach my $cfg (@{$cfgs || []}) {
4131 next unless ref $cfg; # include_file doesn't have parameters
4132 foreach my $k (keys %$entry) {
4133 next if $k eq 'source';
4134 next if $k eq 'source_parameters';
4135 next unless defined $entry->{$k};
4136 $cfg->{$k} = $entry->{$k};
4137 }
4138 }
4139 }
4140
4141 return \%include;
4142}
4143
4144#sub get_list_of_sources_id;
4145# -> No longer used.
4146#sub sync_include_ca;
4147# -> sync_include('member').
4148#sub purge_ca;
4149# -> Never used.
4150
4151# FIXME: Use Sympa::Request::Handler::include handler.
4152sub sync_include {
4153 $log->syslog('debug2', '(%s, %s)', @_);
4154 my $self = shift;
4155 my $role = shift;
4156 my %options = @_;
4157
4158 $role ||= 'member'; # Compat.<=6.2.54
4159
4160 return 0
4161 unless $self->has_data_sources($role)
4162 or $self->has_included_users($role);
4163
4164 my $spindle = Sympa::Spindle::ProcessRequest->new(
4165 context => $self,
4166 action => 'include',
4167 role => $role,
4168 delay => $options{delay},
4169 scenario_context => {skip => 1},
4170 );
4171 unless ($spindle and $spindle->spin) {
4172 $log->syslog('err',
4173 'Could not get users (%s) from an data source for list %s',
4174 $role, $self);
4175 if ($role eq 'member') {
4176 Sympa::send_notify_to_listmaster($self,
4177 'sync_include_failed', {});
4178 } else {
4179 Sympa::send_notify_to_listmaster($self,
4180 'sync_include_admin_failed', {});
4181 }
4182 return undef;
4183 }
4184
4185 return 1;
4186}
4187
4188#sub _update_inclusion_table;
4189# -> _update_inclusion_table() and/or _clean_inclusion_table() in
4190# Sympa::Request::Handler::include class.
4191
4192# The function sync_include('member') is to be called by the task_manager.
4193# This one is to be called from anywhere else. This function deletes the
4194# scheduled sync_include task. If this deletion happened in sync_include(),
4195# it would disturb the normal task_manager.pl functionning.
4196# 6.2.4: Returns 0 if synchronization is not needed.
4197# No longer used. Use sync_include('member', delay => ...);
4198#sub on_the_fly_sync_include;
4199
4200# DEPRECATED. Use sync_include('owner') & sync_include('editor').
4201#sub sync_include_admin;
4202
4203#sub _load_list_admin_from_config;
4204# -> No longer used.
4205#sub is_update_param;
4206# -> Never used.
4207#sub _inclusion_loop;
4208# -> Sympa::DataSouce::List::_inclusion_loop().
4209
4210# Merged into Sympa::List::get_total().
4211#sub _load_total_db;
4212
4213## Writes the user list to disk
4214# Depreceted. Use Sympa::List::dump_users().
4215#sub _save_list_members_file;
4216
4217## Does the real job : stores the message given as an argument into
4218## the digest of the list.
4219# Moved to Sympa::Spool::Digest::store().
4220#sub store_digest;
4221
4222sub get_including_lists {
4223 my $self = shift;
4224 my $role = shift || 'member';
4225
4226 my $sdm = Sympa::DatabaseManager->instance;
4227 my $sth;
4228
4229 unless (
4230 $sdm
4231 and $sth = $sdm->do_prepared_query(
4232 q{SELECT target_inclusion AS "target"
4233 FROM inclusion_table
4234 WHERE source_inclusion = ? AND role_inclusion = ?},
4235 $self->get_id, $role
4236 )
4237 ) {
4238 $log->syslog('err', 'Cannot get lists including %s', $self);
4239 return undef;
4240 }
4241
4242 my @lists;
4243 while (my $r = $sth->fetchrow_hashref('NAME_lc')) {
4244 next unless $r and $r->{target};
4245 my $l = __PACKAGE__->new($r->{target});
4246 next unless $l;
4247
4248 push @lists, $l;
4249 }
4250 $sth->finish;
4251
4252 return [@lists];
4253}
4254
4255
# spent 28.9s (56.2ms+28.9) within Sympa::List::get_lists which was called 345 times, avg 83.8ms/call: # 345 times (56.2ms+28.9s) by Sympa::Spool::Task::_create_all_tasks at line 93 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 83.8ms/call
sub get_lists {
4256345544µs34569.9ms $log->syslog('debug2', '(%s, %s)', @_);
# spent 69.9ms making 345 calls to Sympa::Log::syslog, avg 203µs/call
4257345237µs my $that = shift || '*';
4258345166µs my %options = @_;
4259
4260 # Set signal handler so that long call can be aborted by signal.
426134571µs my $signalled;
42623451.29ms my %sighandler = (HUP => $SIG{HUP}, INT => $SIG{INT}, TERM => $SIG{TERM});
4263 local $SIG{HUP} = sub { $sighandler{HUP}->(@_); $signalled = 1; }
4264345329µs if ref $SIG{HUP} eq 'CODE';
4265 local $SIG{INT} = sub { $sighandler{INT}->(@_); $signalled = 1; }
42663453.02ms if ref $SIG{INT} eq 'CODE';
4267210µs1264µs
# spent 284µs (21+264) within Sympa::List::__ANON__[/usr/local/libexec/sympa/Sympa/List.pm:4267] which was called: # once (21µs+264µs) by Sympa::Language::canonic_lang at line 177 of /usr/local/libexec/sympa/Sympa/Language.pm
local $SIG{TERM} = sub { $sighandler{TERM}->(@_); $signalled = 1; }
# spent 264µs making 1 call to main::sigterm
42683451.73ms if ref $SIG{TERM} eq 'CODE';
4269
42703451.02ms345608µs my $sdm = Sympa::DatabaseManager->instance;
# spent 608µs making 345 calls to Sympa::DatabaseManager::instance, avg 2µs/call
4271
4272345129µs my (@lists, @robot_ids, $family_name);
4273
4274345621µs if (ref $that and ref $that eq 'Sympa::Family') {
4275 @robot_ids = ($that->{'domain'});
4276 $family_name = $that->{'name'};
4277 } elsif (!ref $that and $that and $that ne '*') {
4278 @robot_ids = ($that);
4279 } elsif (!$that or $that eq '*') {
4280 @robot_ids = get_robots();
4281 } else {
4282 die 'bug in logic. Ask developer';
4283 }
4284
4285 # Build query: Perl expression for files and SQL expression for
4286 # list_table.
4287345125µs my $cond_perl = undef;
428834571µs my $cond_sql = undef;
428934564µs my $which_role = undef;
429034558µs my $which_user = undef;
4291345475µs my @query = @{$options{'filter'} || []};
429234598µs my @clause_perl = ();
4293345135µs my @clause_sql = ();
4294
4295 ## get family lists
4296345158µs if ($family_name) {
4297 push @clause_perl,
4298 sprintf(
4299 '$list->{"admin"}{"family_name"} and $list->{"admin"}{"family_name"} eq "%s"',
4300 quotemeta $family_name);
4301 push @clause_sql, sprintf(q{family_list LIKE '%s'}, $family_name);
4302 }
4303
4304345271µs while (1 < scalar @query) {
4305 my @expr_perl = ();
4306 my @expr_sql = ();
4307
4308 my $keys = shift @query;
4309 next unless defined $keys and $keys =~ /\S/;
4310 $keys =~ s/^(!?)\s*//;
4311 my $negate = $1;
4312 my @keys = split /[|]/, $keys;
4313
4314 my $vals = shift @query;
4315 next unless defined $vals and length $vals; # spaces are allowed
4316 my @vals = split /[|]/, $vals;
4317
4318 foreach my $k (@keys) {
4319 next unless $k =~ /\S/;
4320
4321 my $cmpl = undef;
4322 my ($prfx, $sffx) = ('', '');
4323 $prfx = $1 if $k =~ s/^(%)//;
4324 $sffx = $1 if $k =~ s/(%)$//;
4325 if ($prfx or $sffx) {
4326 unless ($sffx) {
4327 $cmpl = '%s eq "%s"';
4328 } elsif ($prfx) {
4329 $cmpl = 'index(%s, "%s") >= 0';
4330 } else {
4331 $cmpl = 'index(%s, "%s") == 0';
4332 }
4333 } elsif ($k =~ s/\s*([<>])\s*$//) {
4334 $cmpl = '%s ' . $1 . ' %s';
4335 }
4336
4337 ## query with single key and single value
4338
4339 if ($k =~ /^(member|owner|editor)$/) {
4340 if (defined $which_role) {
4341 $log->syslog('err', 'bug in logic. Ask developer: $k=%s',
4342 $k);
4343 return undef;
4344 }
4345 $which_role = $k;
4346 $which_user = $vals;
4347 next;
4348 }
4349
4350 ## query with single value
4351
4352 if ($k eq 'name' or $k eq 'subject') {
4353 my ($vl, $ve, $key_perl, $key_sql);
4354 if ($k eq 'name') {
4355 $key_perl = '$list->{"name"}';
4356 $key_sql = 'name_list';
4357 $vl = lc $vals;
4358 } else {
4359 $key_perl =
4360 'Sympa::Tools::Text::foldcase($list->{"admin"}{"subject"})';
4361 $key_sql = 'searchkey_list';
4362 $vl = Sympa::Tools::Text::foldcase($vals);
4363 }
4364
4365 ## Perl expression
4366 $ve = $vl;
4367 $ve =~ s/([^ \w\x80-\xFF])/\\$1/g;
4368 push @expr_perl,
4369 sprintf(($cmpl ? $cmpl : '%s eq "%s"'), $key_perl, $ve);
4370
4371 ## SQL expression
4372 if ($sffx or $prfx) {
4373 $ve = $sdm->quote($vl);
4374 $ve =~ s/^["'](.*)['"]$/$1/;
4375 $ve =~ s/([%_])/\\$1/g;
4376 push @expr_sql,
4377 sprintf("%s LIKE '%s'", $key_sql, "$prfx$ve$sffx");
4378 } else {
4379 push @expr_sql,
4380 sprintf('%s = %s', $key_sql, $sdm->quote($vl));
4381 }
4382
4383 next;
4384 }
4385
4386 foreach my $v (@vals) {
4387 ## Perl expressions
4388 if ($k eq 'creation' or $k eq 'update') {
4389 push @expr_perl,
4390 sprintf(
4391 ($cmpl ? $cmpl : '%s == %s'),
4392 sprintf('$list->{"admin"}{"%s"}->{"date_epoch"}', $k),
4393 $v
4394 );
4395# } elsif ($k eq 'web_archive') {
4396# push @expr_perl,
4397# sprintf('%s$list->is_web_archived',
4398# ($v+0 ? '' : '! '));
4399 } elsif ($k eq 'status') {
4400 my $ve = lc $v;
4401 $ve =~ s/([^ \w\x80-\xFF])/\\$1/g;
4402 push @expr_perl,
4403 sprintf('$list->{"admin"}{"status"} eq "%s"', $ve);
4404 } elsif ($k eq 'topics') {
4405 my $ve = lc $v;
4406 if ($ve eq 'others' or $ve eq 'topicsless') {
4407 push @expr_perl,
4408 '! scalar(grep { $_ ne "others" } @{$list->{"admin"}{"topics"} || []})';
4409 } else {
4410 $ve =~ s/([^ \w\x80-\xFF])/\\$1/g;
4411 push @expr_perl,
4412 sprintf(
4413 'scalar(grep { $_ eq "%s" or index($_, "%s/") == 0 } @{$list->{"admin"}{"topics"} || []})',
4414 $ve, $ve);
4415 }
4416 } else {
4417 $log->syslog('err', 'bug in logic. Ask developer: $k=%s',
4418 $k);
4419 return undef;
4420 }
4421
4422 ## SQL expressions
4423 if ($k eq 'creation' or $k eq 'update') {
4424 push @expr_sql,
4425 sprintf('%s_epoch_list %s %s',
4426 $k, ($cmpl ? $cmpl : '='), $v);
4427# } elsif ($k eq 'web_archive') {
4428# push @expr_sql,
4429# sprintf('web_archive_list = %d', ($v+0 ? 1 : 0));
4430 } elsif ($k eq 'status') {
4431 push @expr_sql,
4432 sprintf('%s_list = %s', $k, $sdm->quote($v));
4433 } elsif ($k eq 'topics') {
4434 my $ve = lc $v;
4435 if ($ve eq 'others' or $ve eq 'topicsless') {
4436 push @expr_sql, "topics_list = ''";
4437 } else {
4438 $ve = $sdm->quote($ve);
4439 $ve =~ s/^["'](.*)['"]$/$1/;
4440 $ve =~ s/([%_])/\\$1/g;
4441 push @expr_sql,
4442 sprintf(
4443 "topics_list LIKE '%%,%s,%%' OR topics_list LIKE '%%,%s/%%'",
4444 $ve, $ve);
4445 }
4446 }
4447 }
4448 }
4449 if (scalar @expr_perl) {
4450 push @clause_perl,
4451 ($negate ? '! ' : '') . '(' . join(' || ', @expr_perl) . ')';
4452 push @clause_sql,
4453 ($negate ? 'NOT ' : '') . '(' . join(' OR ', @expr_sql) . ')';
4454 }
4455 }
4456
4457345155µs if (scalar @clause_perl) {
4458 $cond_perl = join ' && ', @clause_perl;
4459 $cond_sql = join ' AND ', @clause_sql;
4460 } else {
446134564µs $cond_perl = undef;
446234555µs $cond_sql = undef;
4463 }
4464345458µs34560.5ms $log->syslog('debug3', 'filter %s; %s', $cond_perl, $cond_sql);
# spent 60.5ms making 345 calls to Sympa::Log::syslog, avg 175µs/call
4465
4466 ## Sort order
446734574µs my $order_perl;
4468 my $order_sql;
4469345356µs my $keys = $options{'order'} || [];
4470345124µs my @keys_perl = ();
447134584µs my @keys_sql = ();
4472345274µs foreach my $key (@{$keys}) {
4473 my $desc = ($key =~ s/^\s*-\s*//i);
4474
4475 if ($key eq 'creation' or $key eq 'update') {
4476 if ($desc) {
4477 push @keys_perl,
4478 sprintf
4479 '$b->{"admin"}{"%s"}->{"date_epoch"} <=> $a->{"admin"}{"%s"}->{"date_epoch"}',
4480 $key,
4481 $key;
4482 } else {
4483 push @keys_perl,
4484 sprintf
4485 '$a->{"admin"}{"%s"}->{"date_epoch"} <=> $b->{"admin"}{"%s"}->{"date_epoch"}',
4486 $key,
4487 $key;
4488 }
4489 } elsif ($key eq 'name') {
4490 if ($desc) {
4491 push @keys_perl, '$b->{"name"} cmp $a->{"name"}';
4492 } else {
4493 push @keys_perl, '$a->{"name"} cmp $b->{"name"}';
4494 }
4495 } elsif ($key eq 'total') {
4496 if ($desc) {
4497 push @keys_perl, '$b->get_total <=> $a->get_total';
4498 } else {
4499 push @keys_perl, '$a->get_total <=> $b->get_total';
4500 }
4501 } else {
4502 $log->syslog('err', 'bug in logic. Ask developer: $key=%s',
4503 $key);
4504 return undef;
4505 }
4506
4507 if ($key eq 'creation' or $key eq 'update') {
4508 push @keys_sql,
4509 sprintf '%s_epoch_list%s', $key, ($desc ? ' DESC' : '');
4510 } else {
4511 push @keys_sql, sprintf '%s_list%s', $key, ($desc ? ' DESC' : '');
4512 }
4513 }
4514345301µs $order_perl = join(' or ', @keys_perl) || undef;
4515 push @keys_sql, 'name_list'
4516345377µs unless scalar grep { $_ =~ /name_list/ } @keys_sql;
4517345240µs $order_sql = join(', ', @keys_sql);
4518345371µs34570.4ms $log->syslog('debug3', 'order %s; %s', $order_perl, $order_sql);
# spent 70.4ms making 345 calls to Sympa::Log::syslog, avg 204µs/call
4519
4520 ## limit number of result
4521345160µs my $limit = $options{'limit'} || undef;
452234587µs my $count = 0;
4523
4524 # Check signal at first.
452534584µs return undef if $signalled;
4526
4527345252µs foreach my $robot_id (@robot_ids) {
45283451.18ms3451.85ms if (!Sympa::Tools::Data::smart_eq($Conf::Conf{'db_list_cache'}, 'on')
# spent 1.85ms making 345 calls to Sympa::Tools::Data::smart_eq, avg 5µs/call
4529 or $options{'reload_config'}) {
4530 # Files are used instead of list_table DB cache.
4531345193µs my @requested_lists = ();
4532
4533 # filter by role
4534345224µs if (defined $which_role) {
4535 my %r = ();
4536
4537 push @sth_stack, $sth;
4538
4539 if ($which_role eq 'member') {
4540 $sth = $sdm->do_prepared_query(
4541 q{SELECT list_subscriber
4542 FROM subscriber_table
4543 WHERE robot_subscriber = ? AND user_subscriber = ?},
4544 $robot_id, $which_user
4545 );
4546 } else {
4547 $sth = $sdm->do_prepared_query(
4548 q{SELECT list_admin
4549 FROM admin_table
4550 WHERE robot_admin = ? AND user_admin = ? AND
4551 role_admin = ?},
4552 $robot_id, $which_user, $which_role
4553 );
4554 }
4555 unless ($sth) {
4556 $log->syslog(
4557 'err',
4558 'failed to get lists with user %s as %s from database: %s',
4559 $which_user,
4560 $which_role,
4561 $EVAL_ERROR
4562 );
4563 $sth = pop @sth_stack;
4564 return undef;
4565 }
4566 my @row;
4567 while (@row = $sth->fetchrow_array) {
4568 my $listname = $row[0];
4569 $r{$listname} = 1;
4570 }
4571 $sth->finish;
4572
4573 $sth = pop @sth_stack;
4574
4575 # none found
4576 next unless %r; # foreach my $robot_id
4577 @requested_lists = keys %r;
4578 } else {
4579 # check existence of robot directory
4580345369µs my $robot_dir = $Conf::Conf{'home'} . '/' . $robot_id;
4581 $robot_dir = $Conf::Conf{'home'}
45823454.14ms3453.35ms if !-d $robot_dir and $robot_id eq $Conf::Conf{'domain'};
# spent 3.35ms making 345 calls to Sympa::List::CORE:ftdir, avg 10µs/call
45833452.58ms3452.03ms next unless -d $robot_dir;
# spent 2.03ms making 345 calls to Sympa::List::CORE:ftdir, avg 6µs/call
4584
45853455.35ms3454.66ms unless (opendir(DIR, $robot_dir)) {
# spent 4.66ms making 345 calls to Sympa::List::CORE:open_dir, avg 14µs/call
4586 $log->syslog('err', 'Unable to open %s', $robot_dir);
4587 return undef;
4588 }
4589 @requested_lists =
4590287529.8ms471522.6ms grep { !/^\.+$/ and -f "$robot_dir/$_/config" }
# spent 15.8ms making 1840 calls to Sympa::List::CORE:ftfile, avg 9µs/call # spent 5.71ms making 345 calls to Sympa::List::CORE:readdir, avg 17µs/call # spent 1.11ms making 2530 calls to Sympa::List::CORE:match, avg 441ns/call
4591 readdir DIR;
45923451.23ms345542µs closedir DIR;
# spent 542µs making 345 calls to Sympa::List::CORE:closedir, avg 2µs/call
4593 }
4594
4595345127µs my @l = ();
45963451.20ms345490µs foreach my $listname (sort @requested_lists) {
# spent 490µs making 345 calls to Sympa::List::CORE:sort, avg 1µs/call
45971495246µs return undef if $signalled;
4598
4599 ## create object
460014947.42ms149428.6s my $list = __PACKAGE__->new(
# spent 28.6s making 1494 calls to Sympa::List::new, avg 19.2ms/call
4601 $listname,
4602 $robot_id,
4603 { %options,
4604 skip_name_check => 1, #ToDo: implement it.
4605 }
4606 );
46071494401µs next unless defined $list;
4608
4609 ## filter by condition
46101494301µs if (defined $cond_perl) {
4611 next unless eval $cond_perl;
4612 }
4613
46141494760µs push @l, $list;
461514941.15ms last if $limit and $limit <= ++$count;
4616 }
4617
4618 ## sort
4619344616µs if ($order_perl) {
4620 eval 'use sort "stable"';
4621 push @lists, sort { eval $order_perl } @l;
4622 eval 'use sort "defaults"';
4623 } else {
4624344394µs push @lists, @l;
4625 }
4626 } else {
4627 # Use list_table DB cache.
4628 my @requested_lists;
4629
4630 my $table;
4631 my $cond;
4632 if (!defined $which_role) {
4633 $table = 'list_table';
4634 $cond = '';
4635 } elsif ($which_role eq 'member') {
4636 $table = 'list_table, subscriber_table';
4637 $cond = sprintf q{robot_list = robot_subscriber AND
4638 name_list = list_subscriber AND
4639 user_subscriber = %s}, $sdm->quote($which_user);
4640 } else {
4641 $table = 'list_table, admin_table';
4642 $cond = sprintf q{robot_list = robot_admin AND
4643 name_list = list_admin AND
4644 role_admin = %s AND
4645 user_admin = %s}, $sdm->quote($which_role),
4646 $sdm->quote($which_user);
4647 }
4648
4649 push @sth_stack, $sth;
4650
4651 $sth = $sdm->do_query(
4652 q{SELECT name_list AS name
4653 FROM %s
4654 WHERE %s
4655 ORDER BY %s},
4656 $table,
4657 join(
4658 ' AND ',
4659 grep {$_} (
4660 $cond_sql, $cond,
4661 sprintf 'robot_list = %s', $sdm->quote($robot_id)
4662 )
4663 ),
4664 $order_sql
4665 );
4666 unless ($sth) {
4667 $log->syslog('err', 'Failed to get lists from %s', $table);
4668 $sth = pop @sth_stack;
4669 return undef;
4670 }
4671
4672 @requested_lists =
4673 map { ref $_ ? $_->[0] : $_ }
4674 @{$sth->fetchall_arrayref([0], ($limit || undef))};
4675 $sth->finish;
4676
4677 $sth = pop @sth_stack;
4678
4679 foreach my $listname (@requested_lists) {
4680 return undef if $signalled;
4681
4682 my $list = __PACKAGE__->new(
4683 $listname,
4684 $robot_id,
4685 { %options,
4686 skip_name_check => 1, #ToDo: implement it.
4687 }
4688 );
4689 next unless $list;
4690
4691 push @lists, $list;
4692 last if $limit and $limit <= ++$count;
4693 }
4694
4695 }
4696344334µs last if $limit and $limit <= $count;
4697 } # foreach my $robot_id
4698
469934411.2ms return \@lists;
4700}
4701
4702## List of robots hosted by Sympa
4703
# spent 67.3ms (28.4+38.9) within Sympa::List::get_robots which was called 115 times, avg 585µs/call: # 115 times (28.4ms+38.9ms) by Sympa::Spool::Task::_create_all_tasks at line 92 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 585µs/call
sub get_robots {
4704
470511553µs my (@robots, $r);
4706115186µs11516.2ms $log->syslog('debug2', '');
# spent 16.2ms making 115 calls to Sympa::Log::syslog, avg 141µs/call
4707
47081151.96ms1151.63ms unless (opendir(DIR, $Conf::Conf{'etc'})) {
# spent 1.63ms making 115 calls to Sympa::List::CORE:open_dir, avg 14µs/call
4709 $log->syslog('err', 'Unable to open %s', $Conf::Conf{'etc'});
4710 return undef;
4711 }
471211566µs my $use_default_robot = 1;
47131154.58ms2303.51ms foreach $r (sort readdir(DIR)) {
# spent 2.68ms making 115 calls to Sympa::List::CORE:readdir, avg 23µs/call # spent 835µs making 115 calls to Sympa::List::CORE:sort, avg 7µs/call
4714 next
4715333543.0ms644017.4ms unless (($r !~ /^\./o)
# spent 16.9ms making 3105 calls to Sympa::List::CORE:fteread, avg 5µs/call # spent 558µs making 3335 calls to Sympa::List::CORE:match, avg 167ns/call
4716 && (-r "$Conf::Conf{'etc'}/$r/robot.conf"));
4717230110µs push @robots, $r;
4718230151µs undef $use_default_robot if ($r eq $Conf::Conf{'domain'});
4719 }
4720115423µs115183µs closedir DIR;
# spent 183µs making 115 calls to Sympa::List::CORE:closedir, avg 2µs/call
4721
4722115100µs push @robots, $Conf::Conf{'domain'} if ($use_default_robot);
4723115345µs return @robots;
4724}
4725
4726sub get_which {
4727 $log->syslog('debug2', '(%s, %s, %s)', @_);
4728 my $email = Sympa::Tools::Text::canonic_email(shift);
4729 my $robot_id = shift;
4730 my $role = shift;
4731
4732 unless ($role eq 'member' or $role eq 'owner' or $role eq 'editor') {
4733 $log->syslog('err',
4734 'Internal error, unknown or undefined parameter "%s"', $role);
4735 return undef;
4736 }
4737
4738 my $all_lists =
4739 get_lists($robot_id,
4740 'filter' => [$role => $email, '! status' => 'closed|family_closed']);
4741
4742 return @{$all_lists || []};
4743}
4744
4745## return total of messages awaiting moderation
4746# DEPRECATED: Use Sympa::Spool::Moderation::size().
4747# sub get_mod_spool_size;
4748
4749### moderation for shared
4750
4751# DEPRECATED: Use {status} attribute of Sympa::WWW::SharedDocument instance.
4752#sub get_shared_status;
4753
4754# DEPRECATED: Use Sympa::WWW::SharedDocument::get_moderated_descendants().
4755#sub get_shared_moderated;
4756
4757# DEPRECATED: Subroutine of get_shared_moderated().
4758#sub sort_dir_to_get_mod;
4759
4760## Get the type of a DB field
4761#OBSOLETED: No longer used. This is specific to MySQL: Use $sdm->get_fields()
4762# instead.
4763sub get_db_field_type {
4764 my ($table, $field) = @_;
4765
4766 my $sdm = Sympa::DatabaseManager->instance;
4767 unless ($sdm and $sth = $sdm->do_query('SHOW FIELDS FROM %s', $table)) {
4768 $log->syslog('err', 'Get the list of fields for table %s', $table);
4769 return undef;
4770 }
4771
4772 while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
4773 next unless ($ref->{'Field'} eq $field);
4774
4775 return $ref->{'Type'};
4776 }
4777
4778 return undef;
4779}
4780
4781# Moved to _lowercase_field() in sympa.pl.
4782#sub lowercase_field;
4783
4784############ THIS IS RELATED TO NEW LOAD_ADMIN_FILE #############
4785
4786## Sort function for writing config files
4787sub _by_order {
4788 (($Sympa::ListDef::pinfo{$a || ''}{'order'} || 0)
4789 <=> ($Sympa::ListDef::pinfo{$b || ''}{'order'} || 0))
4790 || (($a || '') cmp($b || ''));
4791}
4792
4793## Apply defaults to parameters definition (%Sympa::ListDef::pinfo)
4794## DEPRECATED: use Sympa::Robot::list_params($robot).
4795##sub _apply_defaults {
4796
4797## Save a parameter
4798sub _save_list_param {
4799 my ($robot_id, $key, $p, $defaults, $fd) = @_;
4800
4801 ## Ignore default value
4802 return 1 if $defaults;
4803 return 1 unless (defined($p));
4804
4805 my $pinfo = Sympa::Robot::list_params($robot_id);
4806 if ( defined($pinfo->{$key}{'scenario'})
4807 || defined($pinfo->{$key}{'task'})) {
4808 return 1 if ($p->{'name'} eq 'default');
4809
4810 $fd->print(sprintf "%s %s\n", $key, $p->{'name'});
4811 $fd->print("\n");
4812
4813 } elsif (ref($pinfo->{$key}{'file_format'}) eq 'HASH') {
4814 $fd->print(sprintf "%s\n", $key);
4815 foreach my $k (keys %{$p}) {
4816
4817 if (defined($pinfo->{$key}{'file_format'}{$k}{'scenario'})) {
4818 ## Skip if empty value
4819 next
4820 unless defined $p->{$k}{'name'}
4821 and $p->{$k}{'name'} =~ /\S/;
4822
4823 $fd->print(sprintf "%s %s\n", $k, $p->{$k}{'name'});
4824
4825 } elsif (($pinfo->{$key}{'file_format'}{$k}{'occurrence'} =~ /n$/)
4826 && $pinfo->{$key}{'file_format'}{$k}{'split_char'}) {
4827 next unless $p->{$k} and @{$p->{$k}};
4828
4829 $fd->print(
4830 sprintf "%s %s\n",
4831 $k,
4832 join(
4833 $pinfo->{$key}{'file_format'}{$k}{'split_char'},
4834 @{$p->{$k}}
4835 )
4836 );
4837 } else {
4838 ## Skip if empty value
4839 next unless defined $p->{$k} and $p->{$k} =~ /\S/;
4840
4841 $fd->print(sprintf "%s %s\n", $k, $p->{$k});
4842 }
4843 }
4844 $fd->print("\n");
4845
4846 } else {
4847 if (($pinfo->{$key}{'occurrence'} =~ /n$/)
4848 && $pinfo->{$key}{'split_char'}) {
4849 ### " avant de debugger do_edit_list qui crée des nouvelles
4850 ### entrées vides
4851 my $string = join($pinfo->{$key}{'split_char'}, @{$p});
4852 $string =~ s/\,\s*$//;
4853
4854 $fd->print(sprintf "%s %s\n\n", $key, $string);
4855 } elsif ($key eq 'digest') {
4856 my $value = sprintf '%s %d:%d', join(',', @{$p->{'days'}}),
4857 $p->{'hour'}, $p->{'minute'};
4858 $fd->print(sprintf "%s %s\n\n", $key, $value);
4859 } else {
4860 $fd->print(sprintf "%s %s\n\n", $key, $p);
4861 }
4862 }
4863
4864 return 1;
4865}
4866
4867## Load a single line
4868
# spent 339ms (70.2+269) within Sympa::List::_load_list_param which was called 1343 times, avg 252µs/call: # 411 times (27.3ms+83.4ms) by Sympa::List::_load_list_config_file at line 5222, avg 269µs/call # 381 times (30.6ms+75.9ms) by Sympa::List::_load_list_config_file at line 5244, avg 279µs/call # 284 times (3.24ms+65.5ms) by Sympa::List::_load_list_config_file at line 5138, avg 242µs/call # 241 times (6.41ms+39.6ms) by Sympa::List::_load_list_config_file at line 5195, avg 191µs/call # 26 times (2.74ms+4.11ms) by Sympa::List::_load_list_config_file at line 5146, avg 263µs/call
sub _load_list_param {
486913431.35ms1343264ms $log->syslog('debug3', '(%s, %s, %s, %s)', @_);
# spent 264ms making 1343 calls to Sympa::Log::syslog, avg 197µs/call
48701343343µs my $self = shift;
48711343286µs my $key = shift;
48721343452µs my $value = shift;
48731343230µs my $p = shift;
4874
48751343535µs my $robot = $self->{'domain'};
4876
4877 # Empty value.
487813436.92ms13431.35ms unless (defined $value and $value =~ /\S/) {
# spent 1.35ms making 1343 calls to Sympa::List::CORE:match, avg 1µs/call
4879 return undef; #FIXME
4880 }
4881
4882 # For compatibility to <= 6.2.40: Special name "default" stands for
4883 # the default scenario.
48841343430µs if ($p->{'scenario'} and $value eq 'default') {
4885 $value = $p->{'default'};
4886 }
4887
4888 ## Search configuration file
4889134348.4ms if ( ref $value
4890 and $value->{'conf'}
4891 and grep { $_->{'name'} and $_->{'name'} eq $value->{'conf'} }
4892 @Sympa::ConfDef::params) {
4893634197µs my $param = $value->{'conf'};
4894634760µs6341.80ms $value = Conf::get_robot_conf($robot, $param);
# spent 1.80ms making 634 calls to Conf::get_robot_conf, avg 3µs/call
4895 }
4896
4897 ## Synonyms
48981343788µs if (defined $value and defined $p->{'synonym'}{$value}) {
4899 $value = $p->{'synonym'}{$value};
4900 }
4901
4902 ## Scenario
49031343486µs if ($p->{'scenario'}) {
4904208138µs $value =~ y/,/_/; # Compat. eg "add owner,notify"
4905 #FIXME: Check existence of scenario file.
4906208196µs $value = {'name' => $value};
4907 } elsif ($p->{'task'}) {
4908 $value = {'name' => $value};
4909 }
4910
4911 ## Do we need to split param if it is not already an array
491213437.38ms1343513µs if ( exists $p->{'occurrence'}
# spent 513µs making 1343 calls to Sympa::List::CORE:match, avg 382ns/call
4913 and $p->{'occurrence'} =~ /n$/
4914 and $p->{'split_char'}
4915 and defined $value
4916 and ref $value ne 'ARRAY') {
491759213µs59136µs $value =~ s/^\s*(.+)\s*$/$1/;
# spent 136µs making 59 calls to Sympa::List::CORE:subst, avg 2µs/call
4918591.32ms59754µs return [split /\s*$p->{'split_char'}\s*/, $value];
# spent 754µs making 59 calls to Sympa::List::CORE:regcomp, avg 13µs/call
4919 } else {
492012842.24ms return $value;
4921 }
4922}
4923
4924BEGIN { eval 'use Crypt::OpenSSL::X509'; }
# spent 0s executing statements in string eval
4925
4926# Load the certificate file.
4927sub get_cert {
4928 $log->syslog('debug2', '(%s)', @_);
4929 my $self = shift;
4930 my $format = shift;
4931
4932 ## Default format is PEM (can be DER)
4933 $format ||= 'pem';
4934
4935 # we only send the encryption certificate: this is what the user
4936 # needs to send mail to the list; if they ever get anything signed,
4937 # it will have the respective cert attached anyways.
4938 # (the problem is that netscape, opera and IE can't only
4939 # read the first cert in a file)
4940 my ($certs, $keys) = Sympa::Tools::SMIME::find_keys($self, 'encrypt');
4941
4942 my @cert;
4943 if ($format eq 'pem') {
4944 unless (open(CERT, $certs)) {
4945 $log->syslog('err', 'Unable to open %s: %m', $certs);
4946 return undef;
4947 }
4948
4949 my $state;
4950 while (<CERT>) {
4951 chomp;
4952 if ($state) {
4953 # convert to CRLF for windows clients
4954 push(@cert, "$_\r\n");
4955 if (/^-+END/) {
4956 pop @cert;
4957 last;
4958 }
4959 } elsif (/^-+BEGIN/) {
4960 $state = 1;
4961 }
4962 }
4963 close CERT;
4964 } elsif ($format eq 'der' and $Crypt::OpenSSL::X509::VERSION) {
4965 my $x509 = eval { Crypt::OpenSSL::X509->new_from_file($certs) };
4966 unless ($x509) {
4967 $log->syslog('err', 'Unable to open certificate %s: %m', $certs);
4968 return undef;
4969 }
4970 @cert = ($x509->as_string(Crypt::OpenSSL::X509::FORMAT_ASN1()));
4971 } else {
4972 $log->syslog('err', 'Unknown "%s" certificate format', $format);
4973 return undef;
4974 }
4975
4976 return join '', @cert;
4977}
4978
4979## Load a config file of a list
4980#FIXME: Would merge _load_include_admin_user_file() which mostly duplicates.
4981
# spent 845ms (45.2+800) within Sympa::List::_load_list_config_file which was called 13 times, avg 65.0ms/call: # 13 times (45.2ms+800ms) by Sympa::List::load at line 691, avg 65.0ms/call
sub _load_list_config_file {
49821321µs132.35ms $log->syslog('debug3', '(%s)', @_);
# spent 2.35ms making 13 calls to Sympa::Log::syslog, avg 181µs/call
4983136µs my $self = shift;
4984
49851310µs my $robot = $self->{'domain'};
4986
49871342µs13407ms my $pinfo = Sympa::Robot::list_params($robot);
# spent 407ms making 13 calls to Sympa::Robot::list_params, avg 31.3ms/call
49881311µs my $config_file = $self->{'dir'} . '/config';
4989
4990133µs my %admin;
4991 my (@paragraphs);
4992
4993 ## Just in case...
49941328µs local $RS = "\n";
4995
4996 ## Set defaults to 1
499713170µs foreach my $pname (keys %$pinfo) {
4998 $admin{'defaults'}{$pname} = 1
49991404785µs unless ($pinfo->{$pname}{'internal'});
5000 }
5001
5002 ## Lock file
50031359µs138.10ms my $lock_fh = Sympa::LockedFile->new($config_file, 5, '<');
# spent 8.10ms making 13 calls to IO::File::new, avg 623µs/call
5004133µs unless ($lock_fh) {
5005 $log->syslog('err', 'Could not create new lock on %s', $config_file);
5006 return undef;
5007 }
5008
5009 ## Split in paragraphs
5010134µs my $i = 0;
501113131µs1395µs while (<$lock_fh>) {
# spent 95µs making 13 calls to Sympa::List::CORE:readline, avg 7µs/call
50129812.69ms1962790µs if (/^\s*$/) {
# spent 424µs making 981 calls to Sympa::List::CORE:match, avg 432ns/call # spent 366µs making 981 calls to Sympa::List::CORE:readline, avg 373ns/call
5013 $i++ if $paragraphs[$i];
5014 } else {
5015629260µs push @{$paragraphs[$i]}, $_;
5016 }
5017 }
5018
50191320µs for my $index (0 .. $#paragraphs) {
5020341302µs my @paragraph = @{$paragraphs[$index]};
5021
502234148µs my $pname;
5023
5024 ## Clean paragraph, keep comments
5025341241µs for my $i (0 .. $#paragraph) {
502634559µs my $changed = undef;
5027345150µs for my $j (0 .. $#paragraph) {
50286296.36ms1252459µs if ($paragraph[$j] =~ /^\s*\#/) {
# spent 459µs making 1252 calls to Sympa::List::CORE:match, avg 366ns/call
502962µs chomp($paragraph[$j]);
503064µs push @{$admin{'comment'}}, $paragraph[$j];
503163µs splice @paragraph, $j, 1;
50326900ns $changed = 1;
5033 } elsif ($paragraph[$j] =~ /^\s*$/) {
5034 splice @paragraph, $j, 1;
5035 $changed = 1;
5036 }
5037
5038629238µs last if $changed;
5039 }
5040
5041345126µs last unless $changed;
5042 }
5043
5044 ## Empty paragraph
5045341118µs next unless ($#paragraph > -1);
5046
5047 ## Look for first valid line
50483395.53ms339596µs unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) {
# spent 596µs making 339 calls to Sympa::List::CORE:match, avg 2µs/call
5049 $log->syslog('err', 'Bad paragraph "%s" in %s, ignore it',
5050 @paragraph, $config_file);
5051 next;
5052 }
5053
5054339156µs $pname = $1;
5055
5056 # Parameter aliases (compatibility concerns).
5057339206µs my $alias = $pinfo->{$pname}{'obsolete'};
505833972µs if ($alias and $pinfo->{$alias}) {
5059350µs1230µs $paragraph[0] =~ s/^\s*$pname/$alias/;
# spent 22µs making 3 calls to Sympa::List::CORE:regcomp, avg 7µs/call # spent 5µs making 3 calls to Sympa::List::CORE:subst, avg 2µs/call # spent 3µs making 6 calls to Sympa::List::CORE:substcont, avg 550ns/call
506032µs $pname = $alias;
5061 }
5062
5063339116µs unless (defined $pinfo->{$pname}) {
5064 $log->syslog('err', 'Unknown parameter "%s" in %s, ignore it',
5065 $pname, $config_file);
5066 next;
5067 }
5068
5069 ## Uniqueness
5070339116µs if (defined $admin{$pname}) {
5071 unless (($pinfo->{$pname}{'occurrence'} eq '0-n')
5072 or ($pinfo->{$pname}{'occurrence'} eq '1-n')) {
5073 $log->syslog('err',
5074 'Multiple occurrences of a unique parameter "%s" in %s',
5075 $pname, $config_file);
5076 }
5077 }
5078
5079 ## Line or Paragraph
5080339455µs if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') {
5081 ## This should be a paragraph
50829832µs unless ($#paragraph > 0) {
5083 $log->syslog(
5084 'err',
5085 'Expecting a paragraph for "%s" parameter in %s, ignore it',
5086 $pname,
5087 $config_file
5088 );
5089 next;
5090 }
5091
5092 ## Skipping first line
50939827µs shift @paragraph;
5094
50959821µs my %hash;
50969861µs for my $i (0 .. $#paragraph) {
5097284405µs28488µs next if ($paragraph[$i] =~ /^\s*\#/);
# spent 88µs making 284 calls to Sympa::List::CORE:match, avg 308ns/call
5098
5099284537µs284250µs unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) {
# spent 250µs making 284 calls to Sympa::List::CORE:match, avg 880ns/call
5100 $log->syslog('err', 'Bad line "%s" in %s',
5101 $paragraph[$i], $config_file);
5102 }
5103
5104284104µs my $key = $1;
5105
5106 # Subparameter aliases (compatibility concerns).
5107 # Note: subparameter alias was introduced by 6.2.15.
5108284216µs my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'};
5109284101µs if ($alias and $pinfo->{$pname}{'format'}{$alias}) {
5110 $paragraph[$i] =~ s/^\s*$key/$alias/;
5111 $key = $alias;
5112 }
5113
5114284120µs unless (defined $pinfo->{$pname}{'file_format'}{$key}) {
5115 $log->syslog('err',
5116 'Unknown key "%s" in paragraph "%s" in %s',
5117 $key, $pname, $config_file);
5118 next;
5119 }
5120
512128420.0ms56819.1ms unless ($paragraph[$i] =~
# spent 18.4ms making 284 calls to Sympa::List::CORE:regcomp, avg 65µs/call # spent 747µs making 284 calls to Sympa::List::CORE:match, avg 3µs/call
5122 /^\s*$key(?:\s+($pinfo->{$pname}{'file_format'}{$key}{'file_format'}))?\s*$/i
5123 ) {
5124 chomp($paragraph[$i]);
5125 $log->syslog(
5126 'err',
5127 'Bad entry "%s" for key "%s", paragraph "%s" in file "%s"',
5128 $paragraph[$i],
5129 $key,
5130 $pname,
5131 $config_file
5132 );
5133 next;
5134 }
5135
5136 $hash{$key} =
5137 $self->_load_list_param($key, $1,
5138284775µs28468.7ms $pinfo->{$pname}{'file_format'}{$key});
# spent 68.7ms making 284 calls to Sympa::List::_load_list_param, avg 242µs/call
5139 }
5140
5141 ## Apply defaults & Check required keys
51429824µs my $missing_required_field;
514398224µs foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) {
5144
5145 ## Default value
5146386189µs266.85ms unless (defined $hash{$k}) {
# spent 6.85ms making 26 calls to Sympa::List::_load_list_param, avg 263µs/call
5147 if (defined $pinfo->{$pname}{'file_format'}{$k}{'default'}
5148 ) {
5149 $hash{$k} = $self->_load_list_param(
5150 $k,
5151 $pinfo->{$pname}{'file_format'}{$k}{'default'},
5152 $pinfo->{$pname}{'file_format'}{$k}
5153 );
5154 }
5155 }
5156
5157 ## Required fields
5158386247µs if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1'
5159 and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) {
51605211µs unless (defined $hash{$k}) {
5161 $log->syslog('info',
5162 'Missing key "%s" in param "%s" in %s',
5163 $k, $pname, $config_file);
5164 $missing_required_field++;
5165 }
5166 }
5167 }
5168
51699820µs next if $missing_required_field;
5170
51719858µs delete $admin{'defaults'}{$pname};
5172
5173 ## Should we store it in an array
517498245µs9847µs if (($pinfo->{$pname}{'occurrence'} =~ /n$/)) {
# spent 47µs making 98 calls to Sympa::List::CORE:match, avg 478ns/call
5175 push @{$admin{$pname}}, \%hash;
5176 } else {
51777265µs $admin{$pname} = \%hash;
5178 }
5179 } else {
5180 ## This should be a single line
518124176µs unless ($#paragraph == 0) {
5182 $log->syslog('info',
5183 'Expecting a single line for "%s" parameter in %s',
5184 $pname, $config_file);
5185 }
5186
518724115.3ms48214.5ms unless ($paragraph[0] =~
# spent 13.9ms making 241 calls to Sympa::List::CORE:regcomp, avg 58µs/call # spent 551µs making 241 calls to Sympa::List::CORE:match, avg 2µs/call
5188 /^\s*$pname(?:\s+($pinfo->{$pname}{'file_format'}))?\s*$/i) {
5189 chomp($paragraph[0]);
5190 $log->syslog('info', 'Bad entry "%s" in %s',
5191 $paragraph[0], $config_file);
5192 next;
5193 }
5194
5195241401µs24146.0ms my $value = $self->_load_list_param($pname, $1, $pinfo->{$pname});
# spent 46.0ms making 241 calls to Sympa::List::_load_list_param, avg 191µs/call
5196
5197241136µs delete $admin{'defaults'}{$pname};
5198
5199241518µs26172µs if (($pinfo->{$pname}{'occurrence'} =~ /n$/)
# spent 72µs making 261 calls to Sympa::List::CORE:match, avg 277ns/call
5200 && !(ref($value) =~ /^ARRAY/)) {
5201 push @{$admin{$pname}}, $value;
5202 } else {
5203241152µs $admin{$pname} = $value;
5204 }
5205 }
5206 }
5207
5208 ## Release the lock
52091327µs136.02ms unless ($lock_fh->close) {
# spent 6.02ms making 13 calls to Sympa::LockedFile::close, avg 463µs/call
5210 $log->syslog('err', 'Could not remove the read lock on file %s',
5211 $config_file);
5212 return undef;
5213 }
5214
5215 ## Apply defaults & check required parameters
521613196µs foreach my $p (keys %$pinfo) {
5217
5218 ## Defaults
52191404498µs unless (defined $admin{$p}) {
5220
5221 ## Simple (versus structured) parameter case
522210745.82ms782111ms if (defined $pinfo->{$p}{'default'}) {
# spent 111ms making 411 calls to Sympa::List::_load_list_param, avg 269µs/call # spent 186µs making 371 calls to Sympa::List::CORE:match, avg 501ns/call
5223 $admin{$p} =
5224 $self->_load_list_param($p, $pinfo->{$p}{'default'},
5225 $pinfo->{$p});
5226
5227 ## Sructured parameters case : the default values are defined
5228 ## at the next level
5229 } elsif ((ref $pinfo->{$p}{'format'} eq 'HASH')
5230 && ($pinfo->{$p}{'occurrence'} =~ /1$/)) {
5231 ## If the paragraph is not defined, try to apply defaults
523216724µs my $hash;
5233
5234167349µs foreach my $key (keys %{$pinfo->{$p}{'format'}}) {
5235
5236 ## Skip keys without default value.
5237493287µs unless (defined $pinfo->{$p}{'format'}{$key}{'default'}) {
523811226µs next;
5239 }
5240
5241 $hash->{$key} = $self->_load_list_param(
5242 $key,
5243 $pinfo->{$p}{'format'}{$key}{'default'},
5244381818µs381106ms $pinfo->{$p}{'format'}{$key}
# spent 106ms making 381 calls to Sympa::List::_load_list_param, avg 279µs/call
5245 );
5246 }
5247
524816799µs $admin{$p} = $hash if (defined $hash);
5249
5250 }
5251
5252# $admin{'defaults'}{$p} = 1;
5253 }
5254
5255 ## Required fields
525614042.55ms1404427µs if ( $pinfo->{$p}{'occurrence'}
# spent 427µs making 1404 calls to Sympa::List::CORE:match, avg 304ns/call
5257 and $pinfo->{$p}{'occurrence'} =~ /^1(-n)?$/
5258 and not $pinfo->{$p}{'obsolete'}) {
5259 unless (defined $admin{$p}) {
5260 $log->syslog('info', 'Missing parameter "%s" in %s',
5261 $p, $config_file);
5262 }
5263 }
5264 }
5265
52661336µs13759µs $self->_load_list_config_postprocess(\%admin);
# spent 759µs making 13 calls to Sympa::List::_load_list_config_postprocess, avg 58µs/call
52671327µs1330µs _load_include_admin_user_postprocess(\%admin);
# spent 30µs making 13 calls to Sympa::List::_load_include_admin_user_postprocess, avg 2µs/call
5268
5269137.02ms1335µs return \%admin;
# spent 35µs making 13 calls to Sympa::LockedFile::DESTROY, avg 3µs/call
5270}
5271
5272# Proprocessing particular parameters.
5273
# spent 759µs (413+346) within Sympa::List::_load_list_config_postprocess which was called 13 times, avg 58µs/call: # 13 times (413µs+346µs) by Sympa::List::_load_list_config_file at line 5266, avg 58µs/call
sub _load_list_config_postprocess {
5274134µs my $self = shift;
5275134µs my $config_hash = shift;
5276
5277 ## "Original" parameters
52781310µs if (defined($config_hash->{'digest'})) {
5279842µs824µs if ($config_hash->{'digest'} =~ /^(.+)\s+(\d+):(\d+)$/) {
# spent 24µs making 8 calls to Sympa::List::CORE:match, avg 3µs/call
528087µs my $digest = {};
5281810µs $digest->{'hour'} = $2;
528289µs $digest->{'minute'} = $3;
528384µs my $days = $1;
5284816µs84µs $days =~ s/\s//g;
# spent 4µs making 8 calls to Sympa::List::CORE:subst, avg 550ns/call
5285816µs @{$digest->{'days'}} = split /,/, $days;
5286
528786µs $config_hash->{'digest'} = $digest;
5288 }
5289 }
5290
5291 # The 'host' parameter is ignored if the list is stored on a
5292 # virtual robot directory.
5293 # $config_hash->{'host'} = $self{'domain'} if ($self{'dir'} ne '.');
5294
5295137µs if (defined($config_hash->{'custom_subject'})) {
5296922µs97µs if ($config_hash->{'custom_subject'} =~ /^\s*\[\s*(\w+)\s*\]\s*$/) {
# spent 7µs making 9 calls to Sympa::List::CORE:match, avg 767ns/call
5297 $config_hash->{'custom_subject'} = $1;
5298 }
5299 }
5300
5301 ## Format changed for reply_to parameter
5302 ## New reply_to_header parameter
53031320µs if (( $config_hash->{'forced_reply_to'}
5304 && !$config_hash->{'defaults'}{'forced_reply_to'}
5305 )
5306 || ($config_hash->{'reply_to'}
5307 && !$config_hash->{'defaults'}{'reply_to'})
5308 ) {
5309 my ($value, $apply, $other_email);
5310 $value = $config_hash->{'forced_reply_to'}
5311 || $config_hash->{'reply_to'};
5312 $apply = 'forced' if ($config_hash->{'forced_reply_to'});
5313 if ($value =~ /\@/) {
5314 $other_email = $value;
5315 $value = 'other_email';
5316 }
5317
5318 $config_hash->{'reply_to_header'} = {
5319 'value' => $value,
5320 'other_email' => $other_email,
5321 'apply' => $apply
5322 };
5323
5324 ## delete old entries
5325 $config_hash->{'reply_to'} = undef;
5326 $config_hash->{'forced_reply_to'} = undef;
5327 }
5328
5329 # lang
5330 # canonicalize language
53311332µs13240µs unless ($config_hash->{'lang'} =
# spent 240µs making 13 calls to Sympa::Language::canonic_lang, avg 18µs/call
5332 Sympa::Language::canonic_lang($config_hash->{'lang'})) {
5333 $config_hash->{'lang'} =
5334 Conf::get_robot_conf($self->{'domain'}, 'lang');
5335 }
5336
5337 ############################################
5338 ## Below are constraints between parameters
5339 ############################################
5340
5341 ## This default setting MUST BE THE LAST ONE PERFORMED
5342 #if ($config_hash->{'status'} ne 'open') {
5343 # # requested and closed list are just list hidden using visibility
5344 # # parameter and with send parameter set to closed.
5345 # $config_hash->{'send'} =
5346 # $self->_load_list_param('send', 'closed', $pinfo->{'send'});
5347 # $config_hash->{'visibility'} =
5348 # $self->_load_list_param('visibility', 'conceal',
5349 # $pinfo->{'visibility'});
5350 #}
5351
5352 ## reception of default_user_options must be one of reception of
5353 ## available_user_options. If none, warning and put reception of
5354 ## default_user_options in reception of available_user_options
535513305µs19670µs if (!grep (/^$config_hash->{'default_user_options'}{'reception'}$/,
# spent 48µs making 98 calls to Sympa::List::CORE:regcomp, avg 493ns/call # spent 22µs making 98 calls to Sympa::List::CORE:match, avg 222ns/call
5356 @{$config_hash->{'available_user_options'}{'reception'}})
5357 ) {
5358 push @{$config_hash->{'available_user_options'}{'reception'}},
5359 $config_hash->{'default_user_options'}{'reception'};
5360 $log->syslog(
5361 'info',
5362 'Reception is not compatible between default_user_options and available_user_options in configuration of %s',
5363 $self
5364 );
5365 }
5366}
5367
5368# Proprocessing particular parameters specific to datasources.
5369
# spent 30µs within Sympa::List::_load_include_admin_user_postprocess which was called 13 times, avg 2µs/call: # 13 times (30µs+0s) by Sympa::List::_load_list_config_file at line 5267, avg 2µs/call
sub _load_include_admin_user_postprocess {
5370136µs my $config_hash = shift;
5371
5372 # The include_list was obsoleted by include_sympa_list on 6.2.16.
5373 #FIXME: Existing lists may be checked with looser rule.
53741326µs if ($config_hash->{'include_list'}) {
5375 my $listname_regex =
5376 Sympa::Regexps::listname() . '(?:\@'
5377 . Sympa::Regexps::host() . ')?';
5378 my $filter_regex = '(' . $listname_regex . ')\s+filter\s+(.+)';
5379
5380 $config_hash->{'include_sympa_list'} ||= [];
5381 foreach my $incl (@{$config_hash->{'include_list'} || []}) {
5382 next unless defined $incl and $incl =~ /\S/;
5383
5384 my ($listname, $filter);
5385 if ($incl =~ /\A$filter_regex/) {
5386 ($listname, $filter) = (lc $1, $2);
5387 undef $filter unless $filter =~ /\S/;
5388 } elsif ($incl =~ /\A$listname_regex\z/) {
5389 $listname = lc $incl;
5390 } else {
5391 $log->syslog(
5392 'err',
5393 'Malformed value "%s" in include_list parameter. Skipped',
5394 $incl
5395 );
5396 next;
5397 }
5398
5399 push @{$config_hash->{'include_sympa_list'}},
5400 {
5401 name => sprintf('include_list %s', $incl),
5402 listname => $listname,
5403 filter => $filter,
5404 };
5405 }
5406 delete $config_hash->{'include_list'};
5407 delete $config_hash->{'defaults'}{'include_list'}
5408 if $config_hash->{'defaults'};
5409 }
5410}
5411
5412## Save a config file
5413sub _save_list_config_file {
5414 $log->syslog('debug3', '(%s, %s, %s)', @_);
5415 my $self = shift;
5416 my ($config_file, $old_config_file) = @_;
5417
5418 my $pinfo = Sympa::Robot::list_params($self->{'domain'});
5419
5420 unless (rename $config_file, $old_config_file) {
5421 $log->syslog(
5422 'notice', 'Cannot rename %s to %s',
5423 $config_file, $old_config_file
5424 );
5425 return undef;
5426 }
5427
5428 my $fh_config;
5429 unless (open $fh_config, '>', $config_file) {
5430 $log->syslog('info', 'Cannot open %s', $config_file);
5431 return undef;
5432 }
5433 my $config = '';
5434 my $fd = IO::Scalar->new(\$config);
5435
5436 foreach my $c (@{$self->{'admin'}{'comment'}}) {
5437 $fd->print(sprintf "%s\n", $c);
5438 }
5439 $fd->print("\n");
5440
5441 foreach my $key (sort _by_order keys %{$self->{'admin'}}) {
5442
5443 next if ($key =~ /^(comment|defaults)$/);
5444 next unless (defined $self->{'admin'}{$key});
5445
5446 ## Multiple parameter (owner, custom_header,...)
5447 if ((ref($self->{'admin'}{$key}) eq 'ARRAY')
5448 && !$pinfo->{$key}{'split_char'}) {
5449 foreach my $elt (@{$self->{'admin'}{$key}}) {
5450 _save_list_param($self->{'domain'}, $key, $elt,
5451 $self->{'admin'}{'defaults'}{$key}, $fd);
5452 }
5453 } else {
5454 _save_list_param(
5455 $self->{'domain'}, $key,
5456 $self->{'admin'}{$key},
5457 $self->{'admin'}{'defaults'}{$key}, $fd
5458 );
5459 }
5460 }
5461 print $fh_config $config;
5462 close $fh_config;
5463
5464 return 1;
5465}
5466
5467# Is a reception mode in the parameter reception of the available_user_options
5468# section?
5469sub is_available_reception_mode {
5470 my ($self, $mode) = @_;
5471 $mode =~ y/[A-Z]/[a-z]/;
5472
5473 return undef unless ($self && $mode);
5474
5475 my @available_mode =
5476 @{$self->{'admin'}{'available_user_options'}{'reception'}};
5477
5478 foreach my $m (@available_mode) {
5479 if ($m eq $mode) {
5480 return $mode;
5481 }
5482 }
5483
5484 return undef;
5485}
5486
5487# List the parameter reception of the available_user_options section
5488# Note: Since Sympa 6.1.18, this returns an array under array context.
5489sub available_reception_mode {
5490 my $self = shift;
5491 return @{$self->{'admin'}{'available_user_options'}{'reception'} || []}
5492 if wantarray;
5493 return join(' ',
5494 @{$self->{'admin'}{'available_user_options'}{'reception'} || []});
5495}
5496
5497##############################################################################
5498# FUNCTIONS FOR MESSAGE TOPICS
5499# #
5500##############################################################################
5501#
5502#
5503
5504####################################################
5505# is_there_msg_topic
5506####################################################
5507# Test if some msg_topic are defined
5508#
5509# IN : -$self (+): ref(List)
5510#
5511# OUT : 1 - some are defined | 0 - not defined
5512####################################################
5513sub is_there_msg_topic {
5514 my ($self) = shift;
5515
5516 if (defined $self->{'admin'}{'msg_topic'}) {
5517 if (ref($self->{'admin'}{'msg_topic'}) eq "ARRAY") {
5518 if ($#{$self->{'admin'}{'msg_topic'}} >= 0) {
5519 return 1;
5520 }
5521 }
5522 }
5523 return 0;
5524}
5525
5526####################################################
5527# is_available_msg_topic
5528####################################################
5529# Checks for a topic if it is available in the list
5530# (look foreach list parameter msg_topic.name)
5531#
5532# IN : -$self (+): ref(List)
5533# -$topic (+): string
5534# OUT : -$topic if it is available | undef
5535####################################################
5536sub is_available_msg_topic {
5537 my ($self, $topic) = @_;
5538
5539 my @available_msg_topic;
5540 foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
5541 return $topic
5542 if ($msg_topic->{'name'} eq $topic);
5543 }
5544
5545 return undef;
5546}
5547
5548####################################################
5549# get_available_msg_topic
5550####################################################
5551# Return an array of available msg topics (msg_topic.name)
5552#
5553# IN : -$self (+): ref(List)
5554#
5555# OUT : -\@topics : ref(ARRAY)
5556####################################################
5557sub get_available_msg_topic {
5558 my ($self) = @_;
5559
5560 my @topics;
5561 foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
5562 if ($msg_topic->{'name'}) {
5563 push @topics, $msg_topic->{'name'};
5564 }
5565 }
5566
5567 return \@topics;
5568}
5569
5570####################################################
5571# is_msg_topic_tagging_required
5572####################################################
5573# Checks for the list parameter msg_topic_tagging
5574# if it is set to 'required'
5575#
5576# IN : -$self (+): ref(List)
5577#
5578# OUT : 1 - the msg must must be tagged
5579# | 0 - the msg can be no tagged
5580####################################################
5581sub is_msg_topic_tagging_required {
5582 my ($self) = @_;
5583
5584 if ($self->{'admin'}{'msg_topic_tagging'} =~ /required/) {
5585 return 1;
5586 } else {
5587 return 0;
5588 }
5589}
5590
5591# DEPRECATED.
5592# Use Sympa::Message::compute_topic() and Sympa::Spool::Topic::store() instead.
5593#sub automatic_tag;
5594
5595# Moved to Sympa::Message::compute_topic().
5596#sub compute_topic;
5597
5598# DEPRECATED. Use Sympa::Spool::Topic::store() instead.
5599#sub tag_topic;
5600
5601# DEPRECATED. Use Sympa::Spool::Topic::load() instead.
5602#sub load_msg_topic_file;
5603
5604# Moved to _notify_deleted_topic() in wwsympa.fcgi.
5605#sub modifying_msg_topic_for_list_members;
5606
5607####################################################
5608# select_list_members_for_topic
5609####################################################
5610# Select users subscribed to a topic that is in
5611# the topic list incoming when reception mode is 'mail', 'notice', 'not_me',
5612# 'txt' or 'urlize', and the other
5613# subscribers (recpetion mode different from 'mail'), 'mail' and no topic
5614# subscription.
5615# Note: 'html' mode was deprecated as of 6.2.23b.2.
5616#
5617# IN : -$self(+) : ref(List)
5618# -$string_topic(+) : string splitted by ','
5619# topic list
5620# -$subscribers(+) : ref(ARRAY) - list of subscribers(emails)
5621#
5622# OUT : @selected_users
5623#
5624#
5625####################################################
5626sub select_list_members_for_topic {
5627 my ($self, $string_topic, $subscribers) = @_;
5628 $log->syslog('debug3', '(%s, %s)', $self->{'name'}, $string_topic);
5629
5630 my @selected_users;
5631 my $msg_topics;
5632
5633 if ($string_topic) {
5634 $msg_topics =
5635 Sympa::Tools::Data::get_array_from_splitted_string($string_topic);
5636 }
5637
5638 foreach my $user (@$subscribers) {
5639
5640 # user topic
5641 my $info_user = $self->get_list_member($user);
5642
5643 if ($info_user->{'reception'} !~
5644 /^(mail|notice|not_me|txt|html|urlize)$/i) {
5645 push @selected_users, $user;
5646 next;
5647 }
5648 unless ($info_user->{'topics'}) {
5649 push @selected_users, $user;
5650 next;
5651 }
5652 my $user_topics = Sympa::Tools::Data::get_array_from_splitted_string(
5653 $info_user->{'topics'});
5654
5655 if ($string_topic) {
5656 my $result =
5657 Sympa::Tools::Data::diff_on_arrays($msg_topics, $user_topics);
5658 if ($#{$result->{'intersection'}} >= 0) {
5659 push @selected_users, $user;
5660 }
5661 } else {
5662 my $result =
5663 Sympa::Tools::Data::diff_on_arrays(['other'], $user_topics);
5664 if ($#{$result->{'intersection'}} >= 0) {
5665 push @selected_users, $user;
5666 }
5667 }
5668 }
5669 return @selected_users;
5670}
5671
5672#
5673#
5674#
5675### END - functions for message topics ###
5676
5677# DEPRECATED. Use Sympa::Spool::Auth::store().
5678#sub store_subscription_request;
5679
5680# DEPRECATED. Use Sympa::Spool::Auth::next().
5681#sub get_subscription_requests;
5682
5683# DEPRECATED. Use Sympa::Spool::Auth::size().
5684#sub get_subscription_request_count;
5685
5686# DEPRECATED. Use Sympa::Spool::Auth::remove().
5687#sub delete_subscription_request;
5688
5689# OBSOLETED: Use Sympa::WWW::SharedDocument::get_size().
5690#sub get_shared_size;
5691
5692# OBSOLETED: Use Sympa::Archive::get_size().
5693#sub get_arc_size;
5694
5695# return the date epoch for next delivery planified for a list
5696# Note: As of 6.2a.41, returns undef if parameter is not set or invalid.
5697# Previously it returned current time.
5698sub get_next_delivery_date {
5699 my $self = shift;
5700
5701 my $dtime = $self->{'admin'}{'delivery_time'};
5702 return undef unless $dtime;
5703 my ($h, $m) = split /:/, $dtime, 2;
5704 return undef unless $h == 24 and $m == 0 or $h <= 23 and $m <= 60;
5705
5706 my $date = time();
5707 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
5708 localtime($date);
5709
5710 my $plannified_time = (($h * 60) + $m) * 60; # plannified time in sec
5711 my $now_time =
5712 ((($hour * 60) + $min) * 60) + $sec; # Now #sec since to day 00:00
5713
5714 my $result = $date - $now_time + $plannified_time;
5715 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
5716 localtime($result);
5717
5718 if ($now_time <= $plannified_time) {
5719 return ($date - $now_time + $plannified_time);
5720 } else {
5721 # plannified time is past so report to tomorrow
5722 return ($date - $now_time + $plannified_time + (24 * 3600));
5723 }
5724}
5725
5726#sub search_datasource;
5727# -> No longer used.
5728#sub get_datasource_name;
5729# -> No longer used.
5730#sub add_source_id;
5731# -> No longer used.
5732
5733## Remove a task in the tasks spool
5734# No longer used.
5735#sub remove_task;
5736
5737# Deprecated. Use Sympa::Request::Handler::close_list handler.
5738#sub close_list;
5739
5740## Remove the list
5741# Deprecated. Use Sympa::Request::Handler::close_list handler.
5742#sub purge;
5743
5744## Remove list aliases
5745# Deprecated. Use Sympa::Aliases::del().
5746#sub remove_aliases;
5747
5748# Moved: use Sympa::Spindle::ProcessTask::_remove_bouncers().
5749#sub remove_bouncers;
5750
5751# Moved: Use Sympa::Spindle::ProcessTask::_notify_bouncers().
5752#sub notify_bouncers;
5753
5754# DDEPRECATED: Use Sympa::WWW::SharedDocument::create().
5755#sub create_shared;
5756
5757# Check if a list has data sources
5758# Old name: Sympa::List::has_include_data_sources(), without $role parameter.
5759
# spent 18.4ms within Sympa::List::has_data_sources which was called 1377 times, avg 13µs/call: # 1377 times (18.4ms+0s) by Sympa::Spool::Task::_create_all_tasks at line 103 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 13µs/call
sub has_data_sources {
57601377372µs my $self = shift;
57611377358µs my $role = shift;
5762
57631377302µs my @parameters;
576413772.12ms if (not $role or $role eq 'member') {
5765 push @parameters, @sources_providing_listmembers, 'member_include';
5766 }
57671377649µs if (not $role or $role eq 'owner') {
5768 push @parameters, 'owner_include';
5769 }
57701377478µs if (not $role or $role eq 'editor') {
5771 push @parameters, 'editor_include';
5772 }
5773
57741377604µs foreach my $type (@parameters) {
5775137706.28ms my $resource = $self->{'admin'}{$type} || [];
5776137705.41ms return 1 if ref $resource eq 'ARRAY' and @$resource;
5777 }
5778
577913772.67ms return 0;
5780}
5781
5782
# spent 1.07s (36.1ms+1.03) within Sympa::List::has_included_users which was called 1377 times, avg 775µs/call: # 1377 times (36.1ms+1.03s) by Sympa::Spool::Task::_create_all_tasks at line 103 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 775µs/call
sub has_included_users {
57831377308µs my $self = shift;
57841377265µs my $role = shift;
5785
578613773.34ms13772.44ms my $sdm = Sympa::DatabaseManager->instance;
# spent 2.44ms making 1377 calls to Sympa::DatabaseManager::instance, avg 2µs/call
57871377221µs my $sth;
57881377600µs if (not $role or $role eq 'member') {
578913772.85ms1377573ms unless (
# spent 573ms making 1377 calls to Sympa::DatabaseDriver::PostgreSQL::do_prepared_query, avg 416µs/call
5790 $sdm and $sth = $sdm->do_prepared_query(
5791 q{SELECT COUNT(*)
5792 FROM subscriber_table
5793 WHERE list_subscriber = ? AND robot_subscriber = ? AND
5794 inclusion_subscriber IS NOT NULL},
5795 $self->{'name'}, $self->{'domain'}
5796 )
5797 ) {
5798 return undef;
5799 }
5800137711.4ms13773.84ms my ($count) = $sth->fetchrow_array;
# spent 3.84ms making 1377 calls to DBI::st::fetchrow_array, avg 3µs/call
58011377544µs return 1 if $count;
5802 }
58031377608µs if (not $role or $role ne 'member') {
580413772.90ms1377449ms unless (
# spent 449ms making 1377 calls to Sympa::DatabaseDriver::PostgreSQL::do_prepared_query, avg 326µs/call
5805 $sdm and $sth = $sdm->do_prepared_query(
5806 q{SELECT COUNT(*)
5807 FROM admin_table
5808 WHERE list_admin = ? AND robot_admin = ? AND
5809 inclusion_admin IS NOT NULL AND
5810 (role_admin = ? OR role_admin = ?)},
5811 $self->{'name'}, $self->{'domain'},
5812 ($role || 'owner'), ($role || 'editor')
5813 )
5814 ) {
5815 return undef;
5816 }
581713775.47ms13772.90ms my ($count) = $sth->fetchrow_array;
# spent 2.90ms making 1377 calls to DBI::st::fetchrow_array, avg 2µs/call
58181377519µs return 1 if $count;
5819 }
5820
582113777.15ms return 0;
5822}
5823
5824# move a message to a queue or distribute spool
5825#DEPRECATED: No longer used.
5826# Use Sympa::Spool::XXX::store() (and Sympa::Spool::XXX::remove()).
5827sub move_message {
5828 my ($self, $file, $queue) = @_;
5829 $log->syslog('debug2', '(%s, %s, %s)', $file, $self->{'name'}, $queue);
5830
5831 my $dir = $queue || (Sympa::Constants::SPOOLDIR() . '/distribute');
5832 my $filename = $self->get_id . '.' . time . '.' . (int rand 999);
5833
5834 unless (open OUT, ">$dir/T.$filename") {
5835 $log->syslog('err', 'Cannot create file %s', "$dir/T.$filename");
5836 return undef;
5837 }
5838
5839 unless (open IN, $file) {
5840 $log->syslog('err', 'Cannot open file %s', $file);
5841 return undef;
5842 }
5843
5844 print OUT <IN>;
5845 close IN;
5846 close OUT;
5847 unless (rename "$dir/T.$filename", "$dir/$filename") {
5848 $log->syslog(
5849 'err', 'Cannot rename file %s into %s',
5850 "$dir/T.$filename", "$dir/$filename"
5851 );
5852 return undef;
5853 }
5854 return 1;
5855}
5856
5857# New in 6.2.13.
5858sub get_archive_dir {
5859 my $self = shift;
5860
5861 my $arc_dir = Conf::get_robot_conf($self->{'domain'}, 'arc_path');
5862 die sprintf
5863 'Robot %s has no archives directory. Check arc_path parameter in this robot.conf and in sympa.conf',
5864 $self->{'domain'}
5865 unless $arc_dir;
5866 return $arc_dir . '/' . $self->get_id;
5867}
5868
5869# Return the path to the list bounce directory, where bounces are stored.
5870sub get_bounce_dir {
5871 my $self = shift;
5872
5873 my $root_dir = Conf::get_robot_conf($self->{'domain'}, 'bounce_path');
5874 return $root_dir . '/' . $self->get_id;
5875}
5876
5877# New in 6.2.13.
5878sub get_digest_spool_dir {
5879 my $self = shift;
5880
5881 my $spool_dir = $Conf::Conf{'queuedigest'};
5882 return $spool_dir . '/' . $self->get_id;
5883}
5884
5885# OBSOLETED. Merged into Sympa::get_address().
5886sub get_list_address {
5887 goto &Sympa::get_address; # "&" is required.
5888}
5889
5890sub get_bounce_address {
5891 my $self = shift;
5892 my $who = shift;
5893 my @opts = @_;
5894
5895 my $escwho = $who;
5896 $escwho =~ s/\@/==a==/;
5897
5898 return sprintf('%s+%s@%s',
5899 $Conf::Conf{'bounce_email_prefix'},
5900 join('==', $escwho, $self->{'name'}, @opts),
5901 $self->{'domain'});
5902}
5903
5904
# spent 22.4ms within Sympa::List::get_id which was called 11691 times, avg 2µs/call: # 8709 times (16.6ms+0s) by Sympa::Log::syslog at line 112 of /usr/local/libexec/sympa/Sympa/Log.pm, avg 2µs/call # 2982 times (5.81ms+0s) by Sympa::Spool::Task::_create_all_tasks at line 97 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 2µs/call
sub get_id {
5905116912.92ms my $self = shift;
5906
5907116915.93ms return '' unless $self->{'name'} and $self->{'domain'};
59081167849.2ms return $self->{'name'} . '@' . $self->{'domain'};
5909}
5910
5911# OBSOLETED: use get_id()
5912sub get_list_id { shift->get_id }
5913
5914sub add_list_header {
5915 my $self = shift;
5916 my $message = shift;
5917 my $field = shift;
5918 my %options = @_;
5919
5920 my $robot = $self->{'domain'};
5921
5922 if ($field eq 'id') {
5923 $message->add_header('List-Id',
5924 sprintf('<%s.%s>', $self->{'name'}, $self->{'domain'}));
5925 } elsif ($field eq 'help') {
5926 $message->add_header(
5927 'List-Help',
5928 sprintf(
5929 '<%s>',
5930 Sympa::Tools::Text::mailtourl(
5931 Sympa::get_address($self, 'sympa'),
5932 query => {subject => 'help'}
5933 )
5934 )
5935 );
5936 } elsif ($field eq 'unsubscribe') {
5937 $message->add_header(
5938 'List-Unsubscribe',
5939 sprintf(
5940 '<%s>',
5941 Sympa::Tools::Text::mailtourl(
5942 Sympa::get_address($self, 'sympa'),
5943 query => {
5944 subject => sprintf('unsubscribe %s', $self->{'name'})
5945 }
5946 )
5947 )
5948 );
5949 } elsif ($field eq 'subscribe') {
5950 $message->add_header(
5951 'List-Subscribe',
5952 sprintf(
5953 '<%s>',
5954 Sympa::Tools::Text::mailtourl(
5955 Sympa::get_address($self, 'sympa'),
5956 query =>
5957 {subject => sprintf('subscribe %s', $self->{'name'})}
5958 )
5959 )
5960 );
5961 } elsif ($field eq 'post') {
5962 $message->add_header(
5963 'List-Post',
5964 sprintf('<%s>',
5965 Sympa::Tools::Text::mailtourl(Sympa::get_address($self)))
5966 );
5967 } elsif ($field eq 'owner') {
5968 $message->add_header(
5969 'List-Owner',
5970 sprintf(
5971 '<%s>',
5972 Sympa::Tools::Text::mailtourl(
5973 Sympa::get_address($self, 'owner')
5974 )
5975 )
5976 );
5977 } elsif ($field eq 'archive') {
5978 if (Conf::get_robot_conf($robot, 'wwsympa_url')
5979 and $self->is_web_archived()) {
5980 $message->add_header('List-Archive',
5981 sprintf('<%s>', Sympa::get_url($self, 'arc')));
5982 } else {
5983 return 0;
5984 }
5985 } elsif ($field eq 'archived_at') {
5986 if (Conf::get_robot_conf($robot, 'wwsympa_url')
5987 and $self->is_web_archived()) {
5988 # Use possiblly anonymized Message-Id: field instead of
5989 # {message_id} attribute.
5990 my $message_id = Sympa::Tools::Text::canonic_message_id(
5991 $message->get_header('Message-Id'));
5992
5993 my $arc;
5994 if (defined $options{arc} and length $options{arc}) {
5995 $arc = $options{arc};
5996 } else {
5997 my @now = localtime time;
5998 $arc = sprintf '%04d-%02d', 1900 + $now[5], $now[4] + 1;
5999 }
6000 $message->add_header(
6001 'Archived-At',
6002 sprintf(
6003 '<%s>',
6004 Sympa::get_url(
6005 $self, 'arcsearch_id',
6006 paths => [$arc, $message_id]
6007 )
6008 )
6009 );
6010 } else {
6011 return 0;
6012 }
6013 } else {
6014 die sprintf 'Unknown field "%s". Ask developer', $field;
6015 }
6016
6017 return 1;
6018}
6019
6020# connect to stat_counter_table and extract data.
6021# DEPRECATED: No longer used.
6022#sub get_data;
6023
6024sub _update_list_db {
6025 my ($self) = shift;
6026 my @admins;
6027 my $i;
6028 my $adm_txt;
6029 my $ed_txt;
6030
6031 my $name = $self->{'name'};
6032 my $searchkey =
6033 Sympa::Tools::Text::clip(
6034 Sympa::Tools::Text::foldcase($self->{'admin'}{'subject'} // ''), 255);
6035 my $status = $self->{'admin'}{'status'};
6036 my $robot = $self->{'domain'};
6037
6038 my $family = $self->{'admin'}{'family_name'};
6039 $family = undef unless defined $family and length $family;
6040
6041 my $web_archive = $self->is_web_archived ? 1 : 0;
6042 my $topics = join ',',
6043 grep { defined $_ and length $_ and $_ ne 'others' }
6044 @{$self->{'admin'}{'topics'} || []};
6045 $topics = ",$topics," if length $topics;
6046
6047 my $creation_epoch = $self->{'admin'}{'creation'}->{'date_epoch'};
6048 my $creation_email = $self->{'admin'}{'creation'}->{'email'};
6049 my $update_epoch = $self->{'admin'}{'update'}->{'date_epoch'};
6050 my $update_email = $self->{'admin'}{'update'}->{'email'};
6051# This may be added too.
6052# my $latest_instantiation_epoch =
6053# $self->{'admin'}{'latest_instantiation'}->{'date_epoch'};
6054# my $latest_instantiation_email =
6055# $self->{'admin'}{'latest_instantiation'}->{'email'};
6056
6057# Not yet implemented.
6058# eval { $config = Storable::nfreeze($self->{'admin'}); };
6059# if ($@) {
6060# $log->syslog('err',
6061# 'Failed to save the config to database. error: %s', $@);
6062# return undef;
6063# }
6064
6065 push @sth_stack, $sth;
6066 my $sdm = Sympa::DatabaseManager->instance;
6067
6068 # update database cache
6069 # try INSERT then UPDATE
6070 unless (
6071 $sdm
6072 and $sth = $sdm->do_prepared_query(
6073 q{UPDATE list_table
6074 SET status_list = ?, name_list = ?, robot_list = ?,
6075 family_list = ?,
6076 creation_epoch_list = ?, creation_email_list = ?,
6077 update_epoch_list = ?, update_email_list = ?,
6078 searchkey_list = ?, web_archive_list = ?, topics_list = ?
6079 WHERE robot_list = ? AND name_list = ?},
6080 $status, $name, $robot,
6081 $family,
6082 $creation_epoch, $creation_email,
6083 $update_epoch, $update_email,
6084 $searchkey, $web_archive, $topics,
6085 $robot, $name
6086 )
6087 and $sth->rows
6088 or $sth = $sdm->do_prepared_query(
6089 q{INSERT INTO list_table
6090 (status_list, name_list, robot_list, family_list,
6091 creation_epoch_list, creation_email_list,
6092 update_epoch_list, update_email_list,
6093 searchkey_list, web_archive_list, topics_list)
6094 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)},
6095 $status, $name, $robot, $family,
6096 $creation_epoch, $creation_email,
6097 $update_epoch, $update_email,
6098 $searchkey, $web_archive, $topics
6099 )
6100 and $sth->rows
6101 ) {
6102 $log->syslog('err', 'Unable to update list %s in database', $self);
6103 $sth = pop @sth_stack;
6104 return undef;
6105 }
6106
6107 # If inclusion settings do no longer exist, inclusion_table won't be
6108 # sync'ed anymore. Rows left behind should be removed.
6109 foreach my $role (qw(member owner editor)) {
6110 unless ($self->has_data_sources($role)) {
6111 $sdm and $sdm->do_prepared_query(
6112 q{DELETE FROM inclusion_table
6113 WHERE target_inclusion = ? AND role_inclusion = ?},
6114 $self->get_id, $role
6115 );
6116 }
6117 }
6118
6119 $sth = pop @sth_stack;
6120
6121 return 1;
6122}
6123
6124sub _flush_list_db {
6125 my $listname = shift;
6126
6127 my $sth;
6128 my $sdm = Sympa::DatabaseManager->instance;
6129 unless ($listname) {
6130 # Do DELETE because SQLite does not have TRUNCATE TABLE.
6131 $sth = $sdm->do_prepared_query('DELETE FROM list_table');
6132 } else {
6133 $sth = $sdm->do_prepared_query(
6134 q{DELETE FROM list_table
6135 WHERE name_list = ?}, $listname
6136 );
6137 }
6138
6139 unless ($sth) {
6140 $log->syslog('err', 'Unable to flush lists table');
6141 return undef;
6142 }
6143}
6144
6145# Moved to Sympa::ListOpt::get_title().
6146#sub get_option_title;
6147
6148# Return a hash from the edit_list_conf file.
6149# Old name: tools::load_edit_list_conf().
6150
# spent 26.9s (841ms+26.0) within Sympa::List::_load_edit_list_conf which was called 1494 times, avg 18.0ms/call: # 1494 times (841ms+26.0s) by Sympa::List::new at line 186, avg 18.0ms/call
sub _load_edit_list_conf {
615114941.74ms1494343ms $log->syslog('debug2', '(%s, %s => %s)', @_);
# spent 343ms making 1494 calls to Sympa::Log::syslog, avg 230µs/call
61521494512µs my $self = shift;
615314941.28ms my %options = @_;
6154
61551494737µs my $robot = $self->{'domain'};
6156
6157 my $pinfo = {
6158149480.7ms149424.5s %{Sympa::Robot::list_params($self->{'domain'})},
# spent 24.5s making 1494 calls to Sympa::Robot::list_params, avg 16.4ms/call
6159 %Sympa::ListDef::user_info
6160 };
6161
6162 # Load edit_list.conf: Track by file, not domain (file may come from
6163 # server, robot, family or list context).
616414941.57ms my $last_path_config = $self->{_path}{edit_list} // '';
616514942.08ms14941.08s my $path_config = Sympa::search_fullpath($self, 'edit_list.conf');
# spent 1.08s making 1494 calls to Sympa::search_fullpath, avg 720µs/call
616614941.24ms my $last_mtime_config = $self->{_mtime}{edit_list} // POSIX::INT_MIN();
616714942.10ms149450.6ms my $mtime_config = Sympa::Tools::File::get_mtime($path_config);
# spent 50.6ms making 1494 calls to Sympa::Tools::File::get_mtime, avg 34µs/call
6168 return
6169 unless $options{reload_config}
6170 or not $self->{_edit_list}
61711494719ms or $last_path_config ne $path_config
6172 or $last_mtime_config < $mtime_config;
6173
6174133µs my $fh;
617513239µs13180µs unless (open $fh, '<', $path_config) {
# spent 180µs making 13 calls to Sympa::List::CORE:open, avg 14µs/call
6176 $log->syslog('err', 'Unable to open config file %s: %m',
6177 $path_config);
6178 $self->{_edit_list} = {};
6179 return;
6180 }
6181
6182133µs my $conf;
6183 my $error_in_conf;
61841356µs1331µs my $role_re =
# spent 31µs making 13 calls to Sympa::List::CORE:qr, avg 2µs/call
6185 qr'(?:listmaster|privileged_owner|owner|editor|subscriber|default)'i;
61861325µs138µs my $priv_re = qr'(?:read|write|hidden)'i;
# spent 8µs making 13 calls to Sympa::List::CORE:qr, avg 592ns/call
618713222µs26178µs my $line_re =
# spent 171µs making 13 calls to Sympa::List::CORE:regcomp, avg 13µs/call # spent 7µs making 13 calls to Sympa::List::CORE:qr, avg 562ns/call
6188 qr/\A\s*(\S+)\s+($role_re(?:\s*,\s*$role_re)*)\s+($priv_re)\s*\z/i;
6189131.01ms13744µs foreach my $line (<$fh>) {
# spent 744µs making 13 calls to Sympa::List::CORE:readline, avg 57µs/call
619021452.82ms2145711µs next unless $line =~ /\S/;
# spent 711µs making 2145 calls to Sympa::List::CORE:match, avg 331ns/call
619114041.64ms1404369µs next if $line =~ /\A\s*#/;
# spent 369µs making 1404 calls to Sympa::List::CORE:match, avg 263ns/call
61921105173µs chomp $line;
6193
619411058.62ms22101.96ms if ($line =~ /$line_re/) {
# spent 1.54ms making 1105 calls to Sympa::List::CORE:match, avg 1µs/call # spent 417µs making 1105 calls to Sympa::List::CORE:regcomp, avg 377ns/call
61951105755µs my ($param, $role, $priv) = ($1, $2, $3);
6196
6197 # Resolve alias.
61981105118µs my $key;
61991105509µs ($param, $key) = split /[.]/, $param, 2;
62001105401µs if ($pinfo->{$param}) {
6201975308µs my $alias = $pinfo->{$param}{obsolete};
6202975127µs if ($alias and $pinfo->{$alias}) {
6203 $param = $alias;
6204 }
6205975213µs if ( $key
6206 and ref $pinfo->{$param}{'format'} eq 'HASH'
6207 and $pinfo->{$param}{'format'}{$key}) {
62087836µs my $alias = $pinfo->{$param}{'format'}{$key}{obsolete};
62097813µs if ($alias and $pinfo->{$param}{'format'}{$alias}) {
6210 $key = $alias;
6211 }
6212 }
6213 }
62141105127µs $param = $param . '.' . $key if $key;
6215
62161105755µs my @roles = split /\s*,\s*/, $role;
62171105507µs foreach my $r (@roles) {
621817687.89ms17681.58ms $r =~ s/^\s*(\S+)\s*$/$1/;
# spent 1.58ms making 1768 calls to Sympa::List::CORE:subst, avg 892ns/call
62191768221µs if ($r eq 'default') {
6220 $error_in_conf = 1;
6221 $log->syslog('notice', '"default" is no more recognised');
6222 foreach my $set (qw(owner privileged_owner listmaster)) {
6223 $conf->{$param}{$set} = $priv;
6224 }
6225 next;
6226 }
622717681.36ms $conf->{$param}{$r} = $priv;
6228 }
6229 } else {
6230 $log->syslog('info', 'Unknown parameter in %s (Ignored): %s',
6231 $path_config, $line);
6232 next;
6233 }
6234 }
6235
6236133µs if ($error_in_conf) {
6237 Sympa::send_notify_to_listmaster($robot, 'edit_list_error',
6238 [$path_config]);
6239 }
6240
62411381µs1354µs close $fh;
# spent 54µs making 13 calls to Sympa::List::CORE:close, avg 4µs/call
6242
62431315µs $self->{_path}{edit_list} = $path_config;
6244138µs $self->{_mtime}{edit_list} = $mtime_config;
6245136.09ms $self->{_edit_list} = $conf;
6246}
6247
6248###### END of the List package ######
6249
62501;
6251
6252__END__
 
# spent 54µs within Sympa::List::CORE:close which was called 13 times, avg 4µs/call: # 13 times (54µs+0s) by Sympa::List::_load_edit_list_conf at line 6241, avg 4µs/call
sub Sympa::List::CORE:close; # opcode
# spent 725µs within Sympa::List::CORE:closedir which was called 460 times, avg 2µs/call: # 345 times (542µs+0s) by Sympa::List::get_lists at line 4592, avg 2µs/call # 115 times (183µs+0s) by Sympa::List::get_robots at line 4720, avg 2µs/call
sub Sympa::List::CORE:closedir; # opcode
# spent 30.6ms within Sympa::List::CORE:ftdir which was called 3683 times, avg 8µs/call: # 1494 times (10.7ms+0s) by Sympa::List::load at line 639, avg 7µs/call # 1481 times (14.4ms+0s) by Sympa::List::new at line 168, avg 10µs/call # 345 times (3.35ms+0s) by Sympa::List::get_lists at line 4582, avg 10µs/call # 345 times (2.03ms+0s) by Sympa::List::get_lists at line 4583, avg 6µs/call # 13 times (93µs+0s) by Sympa::List::load at line 622, avg 7µs/call # 5 times (49µs+0s) by Sympa::List::load at line 616, avg 10µs/call
sub Sympa::List::CORE:ftdir; # opcode
# spent 35.1ms within Sympa::List::CORE:fteread which was called 6093 times, avg 6µs/call: # 3105 times (16.9ms+0s) by Sympa::List::get_robots at line 4715, avg 5µs/call # 2988 times (18.3ms+0s) by Sympa::List::load at line 752, avg 6µs/call
sub Sympa::List::CORE:fteread; # opcode
# spent 28.2ms within Sympa::List::CORE:ftfile which was called 3334 times, avg 8µs/call: # 1840 times (15.8ms+0s) by Sympa::List::get_lists at line 4590, avg 9µs/call # 1494 times (12.4ms+0s) by Sympa::List::load at line 639, avg 8µs/call
sub Sympa::List::CORE:ftfile; # opcode
# spent 14.5ms within Sympa::List::CORE:match which was called 25095 times, avg 576ns/call: # 3335 times (558µs+0s) by Sympa::List::get_robots at line 4715, avg 167ns/call # 2530 times (1.11ms+0s) by Sympa::List::get_lists at line 4590, avg 441ns/call # 2145 times (711µs+0s) by Sympa::List::_load_edit_list_conf at line 6190, avg 331ns/call # 1494 times (1.99ms+0s) by Sympa::List::new at line 144, avg 1µs/call # 1494 times (936µs+0s) by Sympa::List::new at line 114, avg 627ns/call # 1494 times (912µs+0s) by Sympa::List::new at line 156, avg 611ns/call # 1494 times (564µs+0s) by Sympa::List::new at line 117, avg 377ns/call # 1404 times (427µs+0s) by Sympa::List::_load_list_config_file at line 5256, avg 304ns/call # 1404 times (369µs+0s) by Sympa::List::_load_edit_list_conf at line 6191, avg 263ns/call # 1343 times (1.35ms+0s) by Sympa::List::_load_list_param at line 4878, avg 1µs/call # 1343 times (513µs+0s) by Sympa::List::_load_list_param at line 4912, avg 382ns/call # 1252 times (459µs+0s) by Sympa::List::_load_list_config_file at line 5028, avg 366ns/call # 1105 times (1.54ms+0s) by Sympa::List::_load_edit_list_conf at line 6194, avg 1µs/call # 981 times (424µs+0s) by Sympa::List::_load_list_config_file at line 5012, avg 432ns/call # 371 times (186µs+0s) by Sympa::List::_load_list_config_file at line 5222, avg 501ns/call # 339 times (596µs+0s) by Sympa::List::_load_list_config_file at line 5048, avg 2µs/call # 284 times (747µs+0s) by Sympa::List::_load_list_config_file at line 5121, avg 3µs/call # 284 times (250µs+0s) by Sympa::List::_load_list_config_file at line 5099, avg 880ns/call # 284 times (88µs+0s) by Sympa::List::_load_list_config_file at line 5097, avg 308ns/call # 261 times (72µs+0s) by Sympa::List::_load_list_config_file at line 5199, avg 277ns/call # 241 times (551µs+0s) by Sympa::List::_load_list_config_file at line 5187, avg 2µs/call # 98 times (47µs+0s) by Sympa::List::_load_list_config_file at line 5174, avg 478ns/call # 98 times (22µs+0s) by Sympa::List::_load_list_config_postprocess at line 5355, avg 222ns/call # 9 times (7µs+0s) by Sympa::List::_load_list_config_postprocess at line 5296, avg 767ns/call # 8 times (24µs+0s) by Sympa::List::_load_list_config_postprocess at line 5279, avg 3µs/call
sub Sympa::List::CORE:match; # opcode
# spent 180µs within Sympa::List::CORE:open which was called 13 times, avg 14µs/call: # 13 times (180µs+0s) by Sympa::List::_load_edit_list_conf at line 6175, avg 14µs/call
sub Sympa::List::CORE:open; # opcode
# spent 6.30ms within Sympa::List::CORE:open_dir which was called 460 times, avg 14µs/call: # 345 times (4.66ms+0s) by Sympa::List::get_lists at line 4585, avg 14µs/call # 115 times (1.63ms+0s) by Sympa::List::get_robots at line 4708, avg 14µs/call
sub Sympa::List::CORE:open_dir; # opcode
# spent 46µs within Sympa::List::CORE:qr which was called 39 times, avg 1µs/call: # 13 times (31µs+0s) by Sympa::List::_load_edit_list_conf at line 6184, avg 2µs/call # 13 times (8µs+0s) by Sympa::List::_load_edit_list_conf at line 6186, avg 592ns/call # 13 times (7µs+0s) by Sympa::List::_load_edit_list_conf at line 6187, avg 562ns/call
sub Sympa::List::CORE:qr; # opcode
# spent 8.39ms within Sympa::List::CORE:readdir which was called 460 times, avg 18µs/call: # 345 times (5.71ms+0s) by Sympa::List::get_lists at line 4590, avg 17µs/call # 115 times (2.68ms+0s) by Sympa::List::get_robots at line 4713, avg 23µs/call
sub Sympa::List::CORE:readdir; # opcode
# spent 1.20ms within Sympa::List::CORE:readline which was called 1007 times, avg 1µs/call: # 981 times (366µs+0s) by Sympa::List::_load_list_config_file at line 5012, avg 373ns/call # 13 times (744µs+0s) by Sympa::List::_load_edit_list_conf at line 6189, avg 57µs/call # 13 times (95µs+0s) by Sympa::List::_load_list_config_file at line 5011, avg 7µs/call
sub Sympa::List::CORE:readline; # opcode
# spent 36.2ms within Sympa::List::CORE:regcomp which was called 4791 times, avg 8µs/call: # 1494 times (2.22ms+0s) by Sympa::List::new at line 156, avg 1µs/call # 1494 times (309µs+0s) by Sympa::List::new at line 144, avg 207ns/call # 1105 times (417µs+0s) by Sympa::List::_load_edit_list_conf at line 6194, avg 377ns/call # 284 times (18.4ms+0s) by Sympa::List::_load_list_config_file at line 5121, avg 65µs/call # 241 times (13.9ms+0s) by Sympa::List::_load_list_config_file at line 5187, avg 58µs/call # 98 times (48µs+0s) by Sympa::List::_load_list_config_postprocess at line 5355, avg 493ns/call # 59 times (754µs+0s) by Sympa::List::_load_list_param at line 4918, avg 13µs/call # 13 times (171µs+0s) by Sympa::List::_load_edit_list_conf at line 6187, avg 13µs/call # 3 times (22µs+0s) by Sympa::List::_load_list_config_file at line 5059, avg 7µs/call
sub Sympa::List::CORE:regcomp; # opcode
# spent 1.32ms within Sympa::List::CORE:sort which was called 460 times, avg 3µs/call: # 345 times (490µs+0s) by Sympa::List::get_lists at line 4596, avg 1µs/call # 115 times (835µs+0s) by Sympa::List::get_robots at line 4713, avg 7µs/call
sub Sympa::List::CORE:sort; # opcode
# spent 1.72ms within Sympa::List::CORE:subst which was called 1838 times, avg 938ns/call: # 1768 times (1.58ms+0s) by Sympa::List::_load_edit_list_conf at line 6218, avg 892ns/call # 59 times (136µs+0s) by Sympa::List::_load_list_param at line 4917, avg 2µs/call # 8 times (4µs+0s) by Sympa::List::_load_list_config_postprocess at line 5284, avg 550ns/call # 3 times (5µs+0s) by Sympa::List::_load_list_config_file at line 5059, avg 2µs/call
sub Sympa::List::CORE:subst; # opcode
# spent 3µs within Sympa::List::CORE:substcont which was called 6 times, avg 550ns/call: # 6 times (3µs+0s) by Sympa::List::_load_list_config_file at line 5059, avg 550ns/call
sub Sympa::List::CORE:substcont; # opcode