Filename | /usr/local/libexec/sympa/Sympa/List.pm |
Statements | Executed 274112 statements in 1.42s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1494 | 1 | 1 | 841ms | 26.9s | _load_edit_list_conf | Sympa::List::
1343 | 5 | 1 | 70.2ms | 339ms | _load_list_param | Sympa::List::
1494 | 1 | 1 | 69.9ms | 28.6s | new | Sympa::List::
345 | 1 | 1 | 56.2ms | 28.9s | get_lists | Sympa::List::
1494 | 2 | 1 | 53.6ms | 1.36s | load | Sympa::List::
13 | 1 | 1 | 45.2ms | 845ms | _load_list_config_file | Sympa::List::
4791 | 9 | 1 | 36.2ms | 36.2ms | CORE:regcomp (opcode) | Sympa::List::
1377 | 1 | 1 | 36.1ms | 1.07s | has_included_users | Sympa::List::
6093 | 2 | 1 | 35.1ms | 35.1ms | CORE:fteread (opcode) | Sympa::List::
3683 | 6 | 1 | 30.6ms | 30.6ms | CORE:ftdir (opcode) | Sympa::List::
115 | 1 | 1 | 28.4ms | 67.3ms | get_robots | Sympa::List::
3334 | 2 | 1 | 28.2ms | 28.2ms | CORE:ftfile (opcode) | Sympa::List::
11691 | 2 | 2 | 22.4ms | 22.4ms | get_id | Sympa::List::
1377 | 1 | 1 | 18.4ms | 18.4ms | has_data_sources | Sympa::List::
25095 | 25 | 1 | 14.5ms | 14.5ms | CORE:match (opcode) | Sympa::List::
460 | 2 | 1 | 8.39ms | 8.39ms | CORE:readdir (opcode) | Sympa::List::
460 | 2 | 1 | 6.30ms | 6.30ms | CORE:open_dir (opcode) | Sympa::List::
1494 | 1 | 1 | 4.39ms | 4.39ms | get_family | Sympa::List::
1838 | 4 | 1 | 1.72ms | 1.72ms | CORE:subst (opcode) | Sympa::List::
460 | 2 | 1 | 1.32ms | 1.32ms | CORE:sort (opcode) | Sympa::List::
1007 | 3 | 1 | 1.20ms | 1.20ms | CORE:readline (opcode) | Sympa::List::
460 | 2 | 1 | 725µs | 725µs | CORE:closedir (opcode) | Sympa::List::
13 | 1 | 1 | 413µs | 759µs | _load_list_config_postprocess | Sympa::List::
13 | 1 | 1 | 180µs | 180µs | CORE:open (opcode) | Sympa::List::
13 | 1 | 1 | 54µs | 54µs | CORE:close (opcode) | Sympa::List::
39 | 3 | 1 | 46µs | 46µs | CORE:qr (opcode) | Sympa::List::
13 | 1 | 1 | 30µs | 30µs | _load_include_admin_user_postprocess | Sympa::List::
1 | 1 | 1 | 21µs | 284µs | __ANON__[:4267] | Sympa::List::
6 | 1 | 1 | 3µs | 3µs | CORE:substcont (opcode) | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@30 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@33 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@35 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@36 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@38 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@39 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@40 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@41 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@42 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@43 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@44 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@45 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@46 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@47 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@48 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@49 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@4924 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@50 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@51 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@52 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@53 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@54 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@55 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@56 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@57 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@58 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@59 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@60 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@61 | Sympa::List::
0 | 0 | 0 | 0s | 0s | BEGIN@62 | Sympa::List::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:4263] | Sympa::List::
0 | 0 | 0 | 0s | 0s | __ANON__[:4265] | Sympa::List::
0 | 0 | 0 | 0s | 0s | _add_list_admin | Sympa::List::
0 | 0 | 0 | 0s | 0s | _by_order | Sympa::List::
0 | 0 | 0 | 0s | 0s | _cache_get | Sympa::List::
0 | 0 | 0 | 0s | 0s | _cache_publish_expiry | Sympa::List::
0 | 0 | 0 | 0s | 0s | _cache_put | Sympa::List::
0 | 0 | 0 | 0s | 0s | _cache_read_expiry | Sympa::List::
0 | 0 | 0 | 0s | 0s | _create_add_error_string | Sympa::List::
0 | 0 | 0 | 0s | 0s | _flush_list_db | Sympa::List::
0 | 0 | 0 | 0s | 0s | _get_single_param_value | Sympa::List::
0 | 0 | 0 | 0s | 0s | _increment_msg_count | Sympa::List::
0 | 0 | 0 | 0s | 0s | _list_admin_cols | Sympa::List::
0 | 0 | 0 | 0s | 0s | _list_member_cols | Sympa::List::
0 | 0 | 0 | 0s | 0s | _load_config_changes_file | Sympa::List::
0 | 0 | 0 | 0s | 0s | _load_include_admin_user_file | Sympa::List::
0 | 0 | 0 | 0s | 0s | _map_list_admin_cols | Sympa::List::
0 | 0 | 0 | 0s | 0s | _map_list_member_cols | Sympa::List::
0 | 0 | 0 | 0s | 0s | _save_config_changes_file | Sympa::List::
0 | 0 | 0 | 0s | 0s | _save_list_config_file | Sympa::List::
0 | 0 | 0 | 0s | 0s | _save_list_param | Sympa::List::
0 | 0 | 0 | 0s | 0s | _update_list_db | Sympa::List::
0 | 0 | 0 | 0s | 0s | add_list_admin | Sympa::List::
0 | 0 | 0 | 0s | 0s | add_list_header | Sympa::List::
0 | 0 | 0 | 0s | 0s | add_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | available_reception_mode | Sympa::List::
0 | 0 | 0 | 0s | 0s | delete_list_admin | Sympa::List::
0 | 0 | 0 | 0s | 0s | delete_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | delete_list_member_picture | Sympa::List::
0 | 0 | 0 | 0s | 0s | destroy_multiton | Sympa::List::
0 | 0 | 0 | 0s | 0s | dump_users | Sympa::List::
0 | 0 | 0 | 0s | 0s | find_picture_filenames | Sympa::List::
0 | 0 | 0 | 0s | 0s | find_picture_paths | Sympa::List::
0 | 0 | 0 | 0s | 0s | find_picture_url | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_admins | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_admins_email | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_archive_dir | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_available_msg_topic | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_bounce_address | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_bounce_dir | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_cert | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_config_changes | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_current_admins | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_db_field_type | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_default_user_options | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_digest_recipients_per_mode | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_digest_spool_dir | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_exclusion | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_first_bouncing_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_first_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_including_lists | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_info | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_latest_distribution_date | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_list_address | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_list_admin | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_list_id | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_max_size | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_members | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_msg_count | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_next_bouncing_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_next_delivery_date | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_next_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_param_value | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_picture_path | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_recipients_per_mode | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_reply_to | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_resembling_members | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_stats | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_total | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_total_bouncing | Sympa::List::
0 | 0 | 0 | 0s | 0s | get_which | Sympa::List::
0 | 0 | 0 | 0s | 0s | insert_delete_exclusion | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_admin | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_archived | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_archiving_enabled | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_available_msg_topic | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_available_reception_mode | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_digest | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_included | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_member_excluded | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_moderated | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_msg_topic_tagging_required | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_there_msg_topic | Sympa::List::
0 | 0 | 0 | 0s | 0s | is_web_archived | Sympa::List::
0 | 0 | 0 | 0s | 0s | load_data_sources_list | Sympa::List::
0 | 0 | 0 | 0s | 0s | may_edit | Sympa::List::
0 | 0 | 0 | 0s | 0s | move_message | Sympa::List::
0 | 0 | 0 | 0s | 0s | parse_list_member_bounce | Sympa::List::
0 | 0 | 0 | 0s | 0s | restore_suspended_subscription | Sympa::List::
0 | 0 | 0 | 0s | 0s | restore_users | Sympa::List::
0 | 0 | 0 | 0s | 0s | save_config | Sympa::List::
0 | 0 | 0 | 0s | 0s | search_list_among_robots | Sympa::List::
0 | 0 | 0 | 0s | 0s | select_list_members_for_topic | Sympa::List::
0 | 0 | 0 | 0s | 0s | send_notify_to_owner | Sympa::List::
0 | 0 | 0 | 0s | 0s | send_probe_to_user | Sympa::List::
0 | 0 | 0 | 0s | 0s | set_status_error_config | Sympa::List::
0 | 0 | 0 | 0s | 0s | suspend_subscription | Sympa::List::
0 | 0 | 0 | 0s | 0s | sync_include | Sympa::List::
0 | 0 | 0 | 0s | 0s | update_config_changes | Sympa::List::
0 | 0 | 0 | 0s | 0s | update_list_admin | Sympa::List::
0 | 0 | 0 | 0s | 0s | update_list_member | Sympa::List::
0 | 0 | 0 | 0s | 0s | update_stats | Sympa::List::
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 | |||||
28 | package Sympa::List; | ||||
29 | |||||
30 | use strict; | ||||
31 | use warnings; | ||||
32 | use Digest::MD5 qw(); | ||||
33 | use English qw(-no_match_vars); | ||||
34 | use IO::Scalar; | ||||
35 | use POSIX qw(); | ||||
36 | use Storable qw(); | ||||
37 | |||||
38 | use Sympa; | ||||
39 | use Conf; | ||||
40 | use Sympa::ConfDef; | ||||
41 | use Sympa::Constants; | ||||
42 | use Sympa::Database; | ||||
43 | use Sympa::DatabaseDescription; | ||||
44 | use Sympa::DatabaseManager; | ||||
45 | use Sympa::Family; | ||||
46 | use Sympa::Language; | ||||
47 | use Sympa::List::Config; | ||||
48 | use Sympa::ListDef; | ||||
49 | use Sympa::LockedFile; | ||||
50 | use Sympa::Log; | ||||
51 | use Sympa::Regexps; | ||||
52 | use Sympa::Robot; | ||||
53 | use Sympa::Spindle::ProcessRequest; | ||||
54 | use Sympa::Spindle::ProcessTemplate; | ||||
55 | use Sympa::Spool::Auth; | ||||
56 | use Sympa::Template; | ||||
57 | use Sympa::Tools::Data; | ||||
58 | use Sympa::Tools::Domains; | ||||
59 | use Sympa::Tools::File; | ||||
60 | use Sympa::Tools::SMIME; | ||||
61 | use Sympa::Tools::Text; | ||||
62 | use Sympa::User; | ||||
63 | |||||
64 | my @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. | ||||
79 | my %config_in_admin_user_file = map +($_ => 1), | ||||
80 | @sources_providing_listmembers; | ||||
81 | |||||
82 | my $language = Sympa::Language->instance; | ||||
83 | my $log = Sympa::Log->instance; | ||||
84 | |||||
85 | ## Database and SQL statement handlers | ||||
86 | my ($sth, @sth_stack); | ||||
87 | |||||
88 | # DB fields with numeric type. | ||||
89 | # We should not do quote() for these while inserting data. | ||||
90 | my %db_struct = Sympa::DatabaseDescription::full_db_struct(); | ||||
91 | my %numeric_field; | ||||
92 | foreach 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. | ||||
102 | my %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 | ||||
106 | 1494 | 1.38ms | my ($pkg, $name, $robot, $options) = @_; | ||
107 | 1494 | 797µs | my $list = {}; | ||
108 | 1494 | 5.17ms | 1494 | 301ms | $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. | ||||
112 | 1494 | 1.05ms | $name = lc $name; | ||
113 | # In case the variable was multiple. FIXME:required? | ||||
114 | 1494 | 2.98ms | 1494 | 936µ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 | ||||
117 | 1494 | 2.10ms | 1494 | 564µ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. | ||||
124 | 1494 | 809µ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 { | ||||
128 | 1494 | 692µs | $robot = lc $robot; #FIXME: More canonicalization. | ||
129 | } | ||||
130 | |||||
131 | 1494 | 267µ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 | |||||
139 | 1494 | 328µ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. | ||||
143 | 1494 | 403µs | my $listname_regexp = Sympa::Regexps::listname(); | ||
144 | 1494 | 16.5ms | 2988 | 2.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. | ||||
150 | 1494 | 1.02ms | $name = $1; | ||
151 | 1494 | 1.03ms | $name =~ tr/A-Z/a-z/; | ||
152 | |||||
153 | ## Reject listnames with reserved list suffixes | ||||
154 | 1494 | 2.41ms | 1494 | 6.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 |
155 | 1494 | 639µs | if ($regx) { | ||
156 | 1494 | 11.4ms | 2988 | 3.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 | |||||
166 | 1494 | 271µs | my $status; | ||
167 | ## If list already in memory and not previously purged by another process | ||||
168 | 1494 | 18.6ms | 1481 | 14.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 | ||||
171 | 1481 | 1.27ms | $list = $list_of_lists{$robot}{$name}; | ||
172 | |||||
173 | 1481 | 2.52ms | 1481 | 509ms | $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 | ||||
176 | 13 | 8µs | bless $list, $pkg; | ||
177 | |||||
178 | 13 | 15µs | $options->{'first_access'} = 1; | ||
179 | 13 | 41µs | 13 | 855ms | $status = $list->load($name, $robot, $options); # spent 855ms making 13 calls to Sympa::List::load, avg 65.8ms/call |
180 | } | ||||
181 | 1494 | 346µs | unless (defined $status) { | ||
182 | return undef; | ||||
183 | } | ||||
184 | |||||
185 | $list->_load_edit_list_conf( | ||||
186 | 1494 | 3.09ms | 1494 | 26.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 | |||||
188 | 1494 | 13.9ms | return $list; | ||
189 | } | ||||
190 | |||||
191 | ## When no robot is specified, look for a list among robots | ||||
192 | sub 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 | ||||
215 | sub 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 | ||||
235 | sub 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(). | ||||
250 | sub _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 | ||||
290 | sub 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 . | ||||
310 | sub 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 | |||||
341 | sub 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 | |||||
357 | sub 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 | |||||
390 | sub _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 | |||||
409 | sub _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 | |||||
428 | sub _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 | |||||
446 | sub _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. | ||||
460 | sub 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 | ||||
538 | sub 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 | sub load { | ||||
603 | 1494 | 1.93ms | 1494 | 305ms | $log->syslog('debug3', '(%s, %s, %s, ...)', @_); # spent 305ms making 1494 calls to Sympa::Log::syslog, avg 204µs/call |
604 | 1494 | 450µs | my $self = shift; | ||
605 | 1494 | 470µs | my $name = shift; | ||
606 | 1494 | 300µs | my $robot = shift; | ||
607 | 1494 | 328µs | my $options = shift; | ||
608 | |||||
609 | 1494 | 377µs | die 'bug in logic. Ask developer' unless $robot; | ||
610 | |||||
611 | ## Set of initializations ; only performed when the config is first loaded | ||||
612 | 1494 | 653µ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. | ||||
616 | 13 | 74µs | 5 | 49µ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 | |||||
622 | 13 | 153µs | 13 | 93µ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 | |||||
632 | 13 | 12µs | $self->{'domain'} = $robot; | ||
633 | |||||
634 | # default list host is robot domain: Deprecated. | ||||
635 | #XXX$self->{'admin'}{'host'} ||= $self->{'domain'}; | ||||
636 | 13 | 9µs | $self->{'name'} = $name; | ||
637 | } | ||||
638 | |||||
639 | 1494 | 38.4ms | 2988 | 23.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. | ||||
648 | 1494 | 1.11ms | my $last_time_config = $self->{'_mtime'}{'config'}; | ||
649 | 1494 | 372µs | $last_time_config = POSIX::INT_MIN() unless defined $last_time_config; | ||
650 | |||||
651 | 1494 | 2.92ms | 1494 | 50.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 |
652 | 1494 | 1.79ms | 1494 | 22.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"); | ||||
654 | 1494 | 1.32ms | 1494 | 35.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); | ||||
657 | 1494 | 245µs | my $config_reloaded = 0; | ||
658 | 1494 | 263µs | my $admin; | ||
659 | |||||
660 | 1494 | 3.39ms | 1494 | 4.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'}) { | ||||
691 | 13 | 36µs | 13 | 845ms | $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 = | ||||
695 | 13 | 80µs | 13 | 4.47ms | Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<'); # spent 4.47ms making 13 calls to IO::File::new, avg 344µs/call |
696 | 13 | 4µ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 | ||||
702 | 13 | 32µs | 13 | 55µ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 | |||||
712 | 13 | 4µs | $config_reloaded = 1; | ||
713 | 13 | 4µ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 | |||||
724 | 13 | 3µs | $last_time_config = $time_config; | ||
725 | 13 | 50µs | 26 | 1.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... | ||||
729 | 1494 | 320µs | if ($admin) { | ||
730 | 13 | 11µs | $self->{'admin'} = $admin; | ||
731 | |||||
732 | ## check param_constraint.conf if belongs to a family and the config | ||||
733 | ## has been loaded | ||||
734 | 13 | 15µ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 | |||||
752 | 1494 | 22.4ms | 2988 | 18.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 | |||||
756 | 1494 | 738µs | $self->{'_mtime'}{'config'} = $last_time_config; | ||
757 | |||||
758 | 1494 | 1.25ms | $list_of_lists{$self->{'domain'}}{$name} = $self; | ||
759 | 1494 | 3.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 | ||||
787 | 1494 | 349µs | my $self = shift; | ||
788 | |||||
789 | 1494 | 1.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 { | ||||
796 | 1494 | 2.31ms | return undef; | ||
797 | } | ||||
798 | } | ||||
799 | |||||
800 | ## return the config_changes hash | ||||
801 | ## Used ONLY with lists belonging to a family. | ||||
802 | sub 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 | ||||
831 | sub 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 | ||||
886 | sub _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 | ||||
929 | sub _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) | ||||
959 | sub 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 | ||||
1012 | sub _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 | |||||
1077 | sub 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 | |||||
1141 | sub 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 | ###################################################### | ||||
1346 | sub 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. | ||||
1438 | sub 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. | ||||
1448 | sub 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. | ||||
1465 | sub 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. | ||||
1476 | sub 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. | ||||
1488 | sub 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 | |||||
1512 | sub 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) | ||||
1565 | sub 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. | ||||
1639 | sub 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. | ||||
1685 | sub get_max_size { | ||||
1686 | return shift->{'admin'}{'max_size'}; | ||||
1687 | } | ||||
1688 | |||||
1689 | ## Returns an array with the Reply-To data | ||||
1690 | sub 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 | ||||
1702 | sub 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. | ||||
1714 | sub 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 | ###################################################################### | ||||
1767 | sub 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 | ###################################################################### | ||||
1808 | sub 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 | ###################################################################### | ||||
1846 | sub 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 | ###################################################################### | ||||
1933 | sub 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 | |||||
2006 | sub 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 | |||||
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 | |||||
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. | ||||
2057 | sub _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 | |||||
2091 | sub _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 | |||||
2101 | sub 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(). | ||||
2180 | sub 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 | |||||
2194 | sub 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. | ||||
2302 | sub 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. | ||||
2352 | sub _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 | |||||
2380 | sub _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 | |||||
2395 | sub 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. | ||||
2468 | sub 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 | |||||
2511 | sub 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 | |||||
2522 | sub 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. | ||||
2570 | sub 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 | |||||
2608 | sub 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(). | ||||
2633 | sub 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"). | ||||
2751 | sub 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 | |||||
2801 | sub 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 | ||||
2821 | sub 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(). | ||||
2858 | sub 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? | ||||
2878 | sub 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) | ||||
2917 | sub 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) | ||||
3056 | sub 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. | ||||
3231 | sub 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 | |||||
3403 | sub _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. | ||||
3427 | sub 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 | |||||
3442 | sub _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? | ||||
3557 | sub 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 | ||||
3627 | sub 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? | ||||
3643 | sub 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(). | ||||
3652 | sub 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(). | ||||
3664 | sub 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 | |||||
3672 | sub is_archiving_enabled { | ||||
3673 | return Sympa::Tools::Data::smart_eq(shift->{'admin'}{'process_archive'}, | ||||
3674 | 'on'); | ||||
3675 | } | ||||
3676 | |||||
3677 | sub 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 | ||||
3716 | sub 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. | ||||
3750 | sub 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. | ||||
3919 | sub _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. | ||||
4152 | sub 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 | |||||
4222 | sub 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 | ||||
4256 | 345 | 544µs | 345 | 69.9ms | $log->syslog('debug2', '(%s, %s)', @_); # spent 69.9ms making 345 calls to Sympa::Log::syslog, avg 203µs/call |
4257 | 345 | 237µs | my $that = shift || '*'; | ||
4258 | 345 | 166µs | my %options = @_; | ||
4259 | |||||
4260 | # Set signal handler so that long call can be aborted by signal. | ||||
4261 | 345 | 71µs | my $signalled; | ||
4262 | 345 | 1.29ms | my %sighandler = (HUP => $SIG{HUP}, INT => $SIG{INT}, TERM => $SIG{TERM}); | ||
4263 | local $SIG{HUP} = sub { $sighandler{HUP}->(@_); $signalled = 1; } | ||||
4264 | 345 | 329µs | if ref $SIG{HUP} eq 'CODE'; | ||
4265 | local $SIG{INT} = sub { $sighandler{INT}->(@_); $signalled = 1; } | ||||
4266 | 345 | 3.02ms | if ref $SIG{INT} eq 'CODE'; | ||
4267 | 2 | 10µs | 1 | 264µ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 # spent 264µs making 1 call to main::sigterm |
4268 | 345 | 1.73ms | if ref $SIG{TERM} eq 'CODE'; | ||
4269 | |||||
4270 | 345 | 1.02ms | 345 | 608µs | my $sdm = Sympa::DatabaseManager->instance; # spent 608µs making 345 calls to Sympa::DatabaseManager::instance, avg 2µs/call |
4271 | |||||
4272 | 345 | 129µs | my (@lists, @robot_ids, $family_name); | ||
4273 | |||||
4274 | 345 | 621µ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. | ||||
4287 | 345 | 125µs | my $cond_perl = undef; | ||
4288 | 345 | 71µs | my $cond_sql = undef; | ||
4289 | 345 | 64µs | my $which_role = undef; | ||
4290 | 345 | 58µs | my $which_user = undef; | ||
4291 | 345 | 475µs | my @query = @{$options{'filter'} || []}; | ||
4292 | 345 | 98µs | my @clause_perl = (); | ||
4293 | 345 | 135µs | my @clause_sql = (); | ||
4294 | |||||
4295 | ## get family lists | ||||
4296 | 345 | 158µ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 | |||||
4304 | 345 | 271µ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 | |||||
4457 | 345 | 155µs | if (scalar @clause_perl) { | ||
4458 | $cond_perl = join ' && ', @clause_perl; | ||||
4459 | $cond_sql = join ' AND ', @clause_sql; | ||||
4460 | } else { | ||||
4461 | 345 | 64µs | $cond_perl = undef; | ||
4462 | 345 | 55µs | $cond_sql = undef; | ||
4463 | } | ||||
4464 | 345 | 458µs | 345 | 60.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 | ||||
4467 | 345 | 74µs | my $order_perl; | ||
4468 | my $order_sql; | ||||
4469 | 345 | 356µs | my $keys = $options{'order'} || []; | ||
4470 | 345 | 124µs | my @keys_perl = (); | ||
4471 | 345 | 84µs | my @keys_sql = (); | ||
4472 | 345 | 274µ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 | } | ||||
4514 | 345 | 301µs | $order_perl = join(' or ', @keys_perl) || undef; | ||
4515 | push @keys_sql, 'name_list' | ||||
4516 | 345 | 377µs | unless scalar grep { $_ =~ /name_list/ } @keys_sql; | ||
4517 | 345 | 240µs | $order_sql = join(', ', @keys_sql); | ||
4518 | 345 | 371µs | 345 | 70.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 | ||||
4521 | 345 | 160µs | my $limit = $options{'limit'} || undef; | ||
4522 | 345 | 87µs | my $count = 0; | ||
4523 | |||||
4524 | # Check signal at first. | ||||
4525 | 345 | 84µs | return undef if $signalled; | ||
4526 | |||||
4527 | 345 | 252µs | foreach my $robot_id (@robot_ids) { | ||
4528 | 345 | 1.18ms | 345 | 1.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. | ||||
4531 | 345 | 193µs | my @requested_lists = (); | ||
4532 | |||||
4533 | # filter by role | ||||
4534 | 345 | 224µ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 | ||||
4580 | 345 | 369µs | my $robot_dir = $Conf::Conf{'home'} . '/' . $robot_id; | ||
4581 | $robot_dir = $Conf::Conf{'home'} | ||||
4582 | 345 | 4.14ms | 345 | 3.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 |
4583 | 345 | 2.58ms | 345 | 2.03ms | next unless -d $robot_dir; # spent 2.03ms making 345 calls to Sympa::List::CORE:ftdir, avg 6µs/call |
4584 | |||||
4585 | 345 | 5.35ms | 345 | 4.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 = | ||||
4590 | 2875 | 29.8ms | 4715 | 22.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; | ||||
4592 | 345 | 1.23ms | 345 | 542µs | closedir DIR; # spent 542µs making 345 calls to Sympa::List::CORE:closedir, avg 2µs/call |
4593 | } | ||||
4594 | |||||
4595 | 345 | 127µs | my @l = (); | ||
4596 | 345 | 1.20ms | 345 | 490µs | foreach my $listname (sort @requested_lists) { # spent 490µs making 345 calls to Sympa::List::CORE:sort, avg 1µs/call |
4597 | 1495 | 246µs | return undef if $signalled; | ||
4598 | |||||
4599 | ## create object | ||||
4600 | 1494 | 7.42ms | 1494 | 28.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 | ); | ||||
4607 | 1494 | 401µs | next unless defined $list; | ||
4608 | |||||
4609 | ## filter by condition | ||||
4610 | 1494 | 301µs | if (defined $cond_perl) { | ||
4611 | next unless eval $cond_perl; | ||||
4612 | } | ||||
4613 | |||||
4614 | 1494 | 760µs | push @l, $list; | ||
4615 | 1494 | 1.15ms | last if $limit and $limit <= ++$count; | ||
4616 | } | ||||
4617 | |||||
4618 | ## sort | ||||
4619 | 344 | 616µs | if ($order_perl) { | ||
4620 | eval 'use sort "stable"'; | ||||
4621 | push @lists, sort { eval $order_perl } @l; | ||||
4622 | eval 'use sort "defaults"'; | ||||
4623 | } else { | ||||
4624 | 344 | 394µ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 | } | ||||
4696 | 344 | 334µs | last if $limit and $limit <= $count; | ||
4697 | } # foreach my $robot_id | ||||
4698 | |||||
4699 | 344 | 11.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 | ||||
4704 | |||||
4705 | 115 | 53µs | my (@robots, $r); | ||
4706 | 115 | 186µs | 115 | 16.2ms | $log->syslog('debug2', ''); # spent 16.2ms making 115 calls to Sympa::Log::syslog, avg 141µs/call |
4707 | |||||
4708 | 115 | 1.96ms | 115 | 1.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 | } | ||||
4712 | 115 | 66µs | my $use_default_robot = 1; | ||
4713 | 115 | 4.58ms | 230 | 3.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 | ||||
4715 | 3335 | 43.0ms | 6440 | 17.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")); | ||||
4717 | 230 | 110µs | push @robots, $r; | ||
4718 | 230 | 151µs | undef $use_default_robot if ($r eq $Conf::Conf{'domain'}); | ||
4719 | } | ||||
4720 | 115 | 423µs | 115 | 183µs | closedir DIR; # spent 183µs making 115 calls to Sympa::List::CORE:closedir, avg 2µs/call |
4721 | |||||
4722 | 115 | 100µs | push @robots, $Conf::Conf{'domain'} if ($use_default_robot); | ||
4723 | 115 | 345µs | return @robots; | ||
4724 | } | ||||
4725 | |||||
4726 | sub 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. | ||||
4763 | sub 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 | ||||
4787 | sub _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 | ||||
4798 | sub _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 | ||||
4869 | 1343 | 1.35ms | 1343 | 264ms | $log->syslog('debug3', '(%s, %s, %s, %s)', @_); # spent 264ms making 1343 calls to Sympa::Log::syslog, avg 197µs/call |
4870 | 1343 | 343µs | my $self = shift; | ||
4871 | 1343 | 286µs | my $key = shift; | ||
4872 | 1343 | 452µs | my $value = shift; | ||
4873 | 1343 | 230µs | my $p = shift; | ||
4874 | |||||
4875 | 1343 | 535µs | my $robot = $self->{'domain'}; | ||
4876 | |||||
4877 | # Empty value. | ||||
4878 | 1343 | 6.92ms | 1343 | 1.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. | ||||
4884 | 1343 | 430µs | if ($p->{'scenario'} and $value eq 'default') { | ||
4885 | $value = $p->{'default'}; | ||||
4886 | } | ||||
4887 | |||||
4888 | ## Search configuration file | ||||
4889 | 1343 | 48.4ms | if ( ref $value | ||
4890 | and $value->{'conf'} | ||||
4891 | and grep { $_->{'name'} and $_->{'name'} eq $value->{'conf'} } | ||||
4892 | @Sympa::ConfDef::params) { | ||||
4893 | 634 | 197µs | my $param = $value->{'conf'}; | ||
4894 | 634 | 760µs | 634 | 1.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 | ||||
4898 | 1343 | 788µs | if (defined $value and defined $p->{'synonym'}{$value}) { | ||
4899 | $value = $p->{'synonym'}{$value}; | ||||
4900 | } | ||||
4901 | |||||
4902 | ## Scenario | ||||
4903 | 1343 | 486µs | if ($p->{'scenario'}) { | ||
4904 | 208 | 138µs | $value =~ y/,/_/; # Compat. eg "add owner,notify" | ||
4905 | #FIXME: Check existence of scenario file. | ||||
4906 | 208 | 196µ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 | ||||
4912 | 1343 | 7.38ms | 1343 | 513µ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') { | ||||
4917 | 59 | 213µs | 59 | 136µs | $value =~ s/^\s*(.+)\s*$/$1/; # spent 136µs making 59 calls to Sympa::List::CORE:subst, avg 2µs/call |
4918 | 59 | 1.32ms | 59 | 754µ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 { | ||||
4920 | 1284 | 2.24ms | return $value; | ||
4921 | } | ||||
4922 | } | ||||
4923 | |||||
4924 | BEGIN { eval 'use Crypt::OpenSSL::X509'; } # spent 0s executing statements in string eval | ||||
4925 | |||||
4926 | # Load the certificate file. | ||||
4927 | sub 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 | ||||
4982 | 13 | 21µs | 13 | 2.35ms | $log->syslog('debug3', '(%s)', @_); # spent 2.35ms making 13 calls to Sympa::Log::syslog, avg 181µs/call |
4983 | 13 | 6µs | my $self = shift; | ||
4984 | |||||
4985 | 13 | 10µs | my $robot = $self->{'domain'}; | ||
4986 | |||||
4987 | 13 | 42µs | 13 | 407ms | my $pinfo = Sympa::Robot::list_params($robot); # spent 407ms making 13 calls to Sympa::Robot::list_params, avg 31.3ms/call |
4988 | 13 | 11µs | my $config_file = $self->{'dir'} . '/config'; | ||
4989 | |||||
4990 | 13 | 3µs | my %admin; | ||
4991 | my (@paragraphs); | ||||
4992 | |||||
4993 | ## Just in case... | ||||
4994 | 13 | 28µs | local $RS = "\n"; | ||
4995 | |||||
4996 | ## Set defaults to 1 | ||||
4997 | 13 | 170µs | foreach my $pname (keys %$pinfo) { | ||
4998 | $admin{'defaults'}{$pname} = 1 | ||||
4999 | 1404 | 785µs | unless ($pinfo->{$pname}{'internal'}); | ||
5000 | } | ||||
5001 | |||||
5002 | ## Lock file | ||||
5003 | 13 | 59µs | 13 | 8.10ms | my $lock_fh = Sympa::LockedFile->new($config_file, 5, '<'); # spent 8.10ms making 13 calls to IO::File::new, avg 623µs/call |
5004 | 13 | 3µ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 | ||||
5010 | 13 | 4µs | my $i = 0; | ||
5011 | 13 | 131µs | 13 | 95µs | while (<$lock_fh>) { # spent 95µs making 13 calls to Sympa::List::CORE:readline, avg 7µs/call |
5012 | 981 | 2.69ms | 1962 | 790µ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 { | ||||
5015 | 629 | 260µs | push @{$paragraphs[$i]}, $_; | ||
5016 | } | ||||
5017 | } | ||||
5018 | |||||
5019 | 13 | 20µs | for my $index (0 .. $#paragraphs) { | ||
5020 | 341 | 302µs | my @paragraph = @{$paragraphs[$index]}; | ||
5021 | |||||
5022 | 341 | 48µs | my $pname; | ||
5023 | |||||
5024 | ## Clean paragraph, keep comments | ||||
5025 | 341 | 241µs | for my $i (0 .. $#paragraph) { | ||
5026 | 345 | 59µs | my $changed = undef; | ||
5027 | 345 | 150µs | for my $j (0 .. $#paragraph) { | ||
5028 | 629 | 6.36ms | 1252 | 459µs | if ($paragraph[$j] =~ /^\s*\#/) { # spent 459µs making 1252 calls to Sympa::List::CORE:match, avg 366ns/call |
5029 | 6 | 2µs | chomp($paragraph[$j]); | ||
5030 | 6 | 4µs | push @{$admin{'comment'}}, $paragraph[$j]; | ||
5031 | 6 | 3µs | splice @paragraph, $j, 1; | ||
5032 | 6 | 900ns | $changed = 1; | ||
5033 | } elsif ($paragraph[$j] =~ /^\s*$/) { | ||||
5034 | splice @paragraph, $j, 1; | ||||
5035 | $changed = 1; | ||||
5036 | } | ||||
5037 | |||||
5038 | 629 | 238µs | last if $changed; | ||
5039 | } | ||||
5040 | |||||
5041 | 345 | 126µs | last unless $changed; | ||
5042 | } | ||||
5043 | |||||
5044 | ## Empty paragraph | ||||
5045 | 341 | 118µs | next unless ($#paragraph > -1); | ||
5046 | |||||
5047 | ## Look for first valid line | ||||
5048 | 339 | 5.53ms | 339 | 596µ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 | |||||
5054 | 339 | 156µs | $pname = $1; | ||
5055 | |||||
5056 | # Parameter aliases (compatibility concerns). | ||||
5057 | 339 | 206µs | my $alias = $pinfo->{$pname}{'obsolete'}; | ||
5058 | 339 | 72µs | if ($alias and $pinfo->{$alias}) { | ||
5059 | 3 | 50µs | 12 | 30µ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 |
5060 | 3 | 2µs | $pname = $alias; | ||
5061 | } | ||||
5062 | |||||
5063 | 339 | 116µ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 | ||||
5070 | 339 | 116µ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 | ||||
5080 | 339 | 455µs | if (ref $pinfo->{$pname}{'file_format'} eq 'HASH') { | ||
5081 | ## This should be a paragraph | ||||
5082 | 98 | 32µ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 | ||||
5093 | 98 | 27µs | shift @paragraph; | ||
5094 | |||||
5095 | 98 | 21µs | my %hash; | ||
5096 | 98 | 61µs | for my $i (0 .. $#paragraph) { | ||
5097 | 284 | 405µs | 284 | 88µs | next if ($paragraph[$i] =~ /^\s*\#/); # spent 88µs making 284 calls to Sympa::List::CORE:match, avg 308ns/call |
5098 | |||||
5099 | 284 | 537µs | 284 | 250µ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 | |||||
5104 | 284 | 104µs | my $key = $1; | ||
5105 | |||||
5106 | # Subparameter aliases (compatibility concerns). | ||||
5107 | # Note: subparameter alias was introduced by 6.2.15. | ||||
5108 | 284 | 216µs | my $alias = $pinfo->{$pname}{'format'}{$key}{'obsolete'}; | ||
5109 | 284 | 101µs | if ($alias and $pinfo->{$pname}{'format'}{$alias}) { | ||
5110 | $paragraph[$i] =~ s/^\s*$key/$alias/; | ||||
5111 | $key = $alias; | ||||
5112 | } | ||||
5113 | |||||
5114 | 284 | 120µ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 | |||||
5121 | 284 | 20.0ms | 568 | 19.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, | ||||
5138 | 284 | 775µs | 284 | 68.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 | ||||
5142 | 98 | 24µs | my $missing_required_field; | ||
5143 | 98 | 224µs | foreach my $k (keys %{$pinfo->{$pname}{'file_format'}}) { | ||
5144 | |||||
5145 | ## Default value | ||||
5146 | 386 | 189µs | 26 | 6.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 | ||||
5158 | 386 | 247µs | if ($pinfo->{$pname}{'file_format'}{$k}{'occurrence'} eq '1' | ||
5159 | and not $pinfo->{$pname}{'file_format'}{$k}{'obsolete'}) { | ||||
5160 | 52 | 11µ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 | |||||
5169 | 98 | 20µs | next if $missing_required_field; | ||
5170 | |||||
5171 | 98 | 58µs | delete $admin{'defaults'}{$pname}; | ||
5172 | |||||
5173 | ## Should we store it in an array | ||||
5174 | 98 | 245µs | 98 | 47µ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 { | ||||
5177 | 72 | 65µs | $admin{$pname} = \%hash; | ||
5178 | } | ||||
5179 | } else { | ||||
5180 | ## This should be a single line | ||||
5181 | 241 | 76µs | unless ($#paragraph == 0) { | ||
5182 | $log->syslog('info', | ||||
5183 | 'Expecting a single line for "%s" parameter in %s', | ||||
5184 | $pname, $config_file); | ||||
5185 | } | ||||
5186 | |||||
5187 | 241 | 15.3ms | 482 | 14.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 | |||||
5195 | 241 | 401µs | 241 | 46.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 | |||||
5197 | 241 | 136µs | delete $admin{'defaults'}{$pname}; | ||
5198 | |||||
5199 | 241 | 518µs | 261 | 72µ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 { | ||||
5203 | 241 | 152µs | $admin{$pname} = $value; | ||
5204 | } | ||||
5205 | } | ||||
5206 | } | ||||
5207 | |||||
5208 | ## Release the lock | ||||
5209 | 13 | 27µs | 13 | 6.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 | ||||
5216 | 13 | 196µs | foreach my $p (keys %$pinfo) { | ||
5217 | |||||
5218 | ## Defaults | ||||
5219 | 1404 | 498µs | unless (defined $admin{$p}) { | ||
5220 | |||||
5221 | ## Simple (versus structured) parameter case | ||||
5222 | 1074 | 5.82ms | 782 | 111ms | 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 | ||||
5232 | 167 | 24µs | my $hash; | ||
5233 | |||||
5234 | 167 | 349µs | foreach my $key (keys %{$pinfo->{$p}{'format'}}) { | ||
5235 | |||||
5236 | ## Skip keys without default value. | ||||
5237 | 493 | 287µs | unless (defined $pinfo->{$p}{'format'}{$key}{'default'}) { | ||
5238 | 112 | 26µs | next; | ||
5239 | } | ||||
5240 | |||||
5241 | $hash->{$key} = $self->_load_list_param( | ||||
5242 | $key, | ||||
5243 | $pinfo->{$p}{'format'}{$key}{'default'}, | ||||
5244 | 381 | 818µs | 381 | 106ms | $pinfo->{$p}{'format'}{$key} # spent 106ms making 381 calls to Sympa::List::_load_list_param, avg 279µs/call |
5245 | ); | ||||
5246 | } | ||||
5247 | |||||
5248 | 167 | 99µs | $admin{$p} = $hash if (defined $hash); | ||
5249 | |||||
5250 | } | ||||
5251 | |||||
5252 | # $admin{'defaults'}{$p} = 1; | ||||
5253 | } | ||||
5254 | |||||
5255 | ## Required fields | ||||
5256 | 1404 | 2.55ms | 1404 | 427µ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 | |||||
5266 | 13 | 36µs | 13 | 759µs | $self->_load_list_config_postprocess(\%admin); # spent 759µs making 13 calls to Sympa::List::_load_list_config_postprocess, avg 58µs/call |
5267 | 13 | 27µs | 13 | 30µ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 | |||||
5269 | 13 | 7.02ms | 13 | 35µ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 | ||||
5274 | 13 | 4µs | my $self = shift; | ||
5275 | 13 | 4µs | my $config_hash = shift; | ||
5276 | |||||
5277 | ## "Original" parameters | ||||
5278 | 13 | 10µs | if (defined($config_hash->{'digest'})) { | ||
5279 | 8 | 42µs | 8 | 24µs | if ($config_hash->{'digest'} =~ /^(.+)\s+(\d+):(\d+)$/) { # spent 24µs making 8 calls to Sympa::List::CORE:match, avg 3µs/call |
5280 | 8 | 7µs | my $digest = {}; | ||
5281 | 8 | 10µs | $digest->{'hour'} = $2; | ||
5282 | 8 | 9µs | $digest->{'minute'} = $3; | ||
5283 | 8 | 4µs | my $days = $1; | ||
5284 | 8 | 16µs | 8 | 4µs | $days =~ s/\s//g; # spent 4µs making 8 calls to Sympa::List::CORE:subst, avg 550ns/call |
5285 | 8 | 16µs | @{$digest->{'days'}} = split /,/, $days; | ||
5286 | |||||
5287 | 8 | 6µ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 | |||||
5295 | 13 | 7µs | if (defined($config_hash->{'custom_subject'})) { | ||
5296 | 9 | 22µs | 9 | 7µ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 | ||||
5303 | 13 | 20µ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 | ||||
5331 | 13 | 32µs | 13 | 240µ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 | ||||
5355 | 13 | 305µs | 196 | 70µ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 | ||||
5370 | 13 | 6µ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. | ||||
5374 | 13 | 26µ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 | ||||
5413 | sub _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? | ||||
5469 | sub 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. | ||||
5489 | sub 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 | #################################################### | ||||
5513 | sub 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 | #################################################### | ||||
5536 | sub 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 | #################################################### | ||||
5557 | sub 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 | #################################################### | ||||
5581 | sub 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 | #################################################### | ||||
5626 | sub 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. | ||||
5698 | sub 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 | ||||
5760 | 1377 | 372µs | my $self = shift; | ||
5761 | 1377 | 358µs | my $role = shift; | ||
5762 | |||||
5763 | 1377 | 302µs | my @parameters; | ||
5764 | 1377 | 2.12ms | if (not $role or $role eq 'member') { | ||
5765 | push @parameters, @sources_providing_listmembers, 'member_include'; | ||||
5766 | } | ||||
5767 | 1377 | 649µs | if (not $role or $role eq 'owner') { | ||
5768 | push @parameters, 'owner_include'; | ||||
5769 | } | ||||
5770 | 1377 | 478µs | if (not $role or $role eq 'editor') { | ||
5771 | push @parameters, 'editor_include'; | ||||
5772 | } | ||||
5773 | |||||
5774 | 1377 | 604µs | foreach my $type (@parameters) { | ||
5775 | 13770 | 6.28ms | my $resource = $self->{'admin'}{$type} || []; | ||
5776 | 13770 | 5.41ms | return 1 if ref $resource eq 'ARRAY' and @$resource; | ||
5777 | } | ||||
5778 | |||||
5779 | 1377 | 2.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 | ||||
5783 | 1377 | 308µs | my $self = shift; | ||
5784 | 1377 | 265µs | my $role = shift; | ||
5785 | |||||
5786 | 1377 | 3.34ms | 1377 | 2.44ms | my $sdm = Sympa::DatabaseManager->instance; # spent 2.44ms making 1377 calls to Sympa::DatabaseManager::instance, avg 2µs/call |
5787 | 1377 | 221µs | my $sth; | ||
5788 | 1377 | 600µs | if (not $role or $role eq 'member') { | ||
5789 | 1377 | 2.85ms | 1377 | 573ms | 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 | } | ||||
5800 | 1377 | 11.4ms | 1377 | 3.84ms | my ($count) = $sth->fetchrow_array; # spent 3.84ms making 1377 calls to DBI::st::fetchrow_array, avg 3µs/call |
5801 | 1377 | 544µs | return 1 if $count; | ||
5802 | } | ||||
5803 | 1377 | 608µs | if (not $role or $role ne 'member') { | ||
5804 | 1377 | 2.90ms | 1377 | 449ms | 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 | } | ||||
5817 | 1377 | 5.47ms | 1377 | 2.90ms | my ($count) = $sth->fetchrow_array; # spent 2.90ms making 1377 calls to DBI::st::fetchrow_array, avg 2µs/call |
5818 | 1377 | 519µs | return 1 if $count; | ||
5819 | } | ||||
5820 | |||||
5821 | 1377 | 7.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()). | ||||
5827 | sub 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. | ||||
5858 | sub 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. | ||||
5870 | sub 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. | ||||
5878 | sub 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(). | ||||
5886 | sub get_list_address { | ||||
5887 | goto &Sympa::get_address; # "&" is required. | ||||
5888 | } | ||||
5889 | |||||
5890 | sub 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 | ||||
5905 | 11691 | 2.92ms | my $self = shift; | ||
5906 | |||||
5907 | 11691 | 5.93ms | return '' unless $self->{'name'} and $self->{'domain'}; | ||
5908 | 11678 | 49.2ms | return $self->{'name'} . '@' . $self->{'domain'}; | ||
5909 | } | ||||
5910 | |||||
5911 | # OBSOLETED: use get_id() | ||||
5912 | sub get_list_id { shift->get_id } | ||||
5913 | |||||
5914 | sub 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 | |||||
6024 | sub _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 | |||||
6124 | sub _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 | ||||
6151 | 1494 | 1.74ms | 1494 | 343ms | $log->syslog('debug2', '(%s, %s => %s)', @_); # spent 343ms making 1494 calls to Sympa::Log::syslog, avg 230µs/call |
6152 | 1494 | 512µs | my $self = shift; | ||
6153 | 1494 | 1.28ms | my %options = @_; | ||
6154 | |||||
6155 | 1494 | 737µs | my $robot = $self->{'domain'}; | ||
6156 | |||||
6157 | my $pinfo = { | ||||
6158 | 1494 | 80.7ms | 1494 | 24.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). | ||||
6164 | 1494 | 1.57ms | my $last_path_config = $self->{_path}{edit_list} // ''; | ||
6165 | 1494 | 2.08ms | 1494 | 1.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 |
6166 | 1494 | 1.24ms | my $last_mtime_config = $self->{_mtime}{edit_list} // POSIX::INT_MIN(); | ||
6167 | 1494 | 2.10ms | 1494 | 50.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} | ||||
6171 | 1494 | 719ms | or $last_path_config ne $path_config | ||
6172 | or $last_mtime_config < $mtime_config; | ||||
6173 | |||||
6174 | 13 | 3µs | my $fh; | ||
6175 | 13 | 239µs | 13 | 180µ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 | |||||
6182 | 13 | 3µs | my $conf; | ||
6183 | my $error_in_conf; | ||||
6184 | 13 | 56µs | 13 | 31µ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; | ||||
6186 | 13 | 25µs | 13 | 8µs | my $priv_re = qr'(?:read|write|hidden)'i; # spent 8µs making 13 calls to Sympa::List::CORE:qr, avg 592ns/call |
6187 | 13 | 222µs | 26 | 178µ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; | ||||
6189 | 13 | 1.01ms | 13 | 744µs | foreach my $line (<$fh>) { # spent 744µs making 13 calls to Sympa::List::CORE:readline, avg 57µs/call |
6190 | 2145 | 2.82ms | 2145 | 711µs | next unless $line =~ /\S/; # spent 711µs making 2145 calls to Sympa::List::CORE:match, avg 331ns/call |
6191 | 1404 | 1.64ms | 1404 | 369µs | next if $line =~ /\A\s*#/; # spent 369µs making 1404 calls to Sympa::List::CORE:match, avg 263ns/call |
6192 | 1105 | 173µs | chomp $line; | ||
6193 | |||||
6194 | 1105 | 8.62ms | 2210 | 1.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 |
6195 | 1105 | 755µs | my ($param, $role, $priv) = ($1, $2, $3); | ||
6196 | |||||
6197 | # Resolve alias. | ||||
6198 | 1105 | 118µs | my $key; | ||
6199 | 1105 | 509µs | ($param, $key) = split /[.]/, $param, 2; | ||
6200 | 1105 | 401µs | if ($pinfo->{$param}) { | ||
6201 | 975 | 308µs | my $alias = $pinfo->{$param}{obsolete}; | ||
6202 | 975 | 127µs | if ($alias and $pinfo->{$alias}) { | ||
6203 | $param = $alias; | ||||
6204 | } | ||||
6205 | 975 | 213µs | if ( $key | ||
6206 | and ref $pinfo->{$param}{'format'} eq 'HASH' | ||||
6207 | and $pinfo->{$param}{'format'}{$key}) { | ||||
6208 | 78 | 36µs | my $alias = $pinfo->{$param}{'format'}{$key}{obsolete}; | ||
6209 | 78 | 13µs | if ($alias and $pinfo->{$param}{'format'}{$alias}) { | ||
6210 | $key = $alias; | ||||
6211 | } | ||||
6212 | } | ||||
6213 | } | ||||
6214 | 1105 | 127µs | $param = $param . '.' . $key if $key; | ||
6215 | |||||
6216 | 1105 | 755µs | my @roles = split /\s*,\s*/, $role; | ||
6217 | 1105 | 507µs | foreach my $r (@roles) { | ||
6218 | 1768 | 7.89ms | 1768 | 1.58ms | $r =~ s/^\s*(\S+)\s*$/$1/; # spent 1.58ms making 1768 calls to Sympa::List::CORE:subst, avg 892ns/call |
6219 | 1768 | 221µ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 | } | ||||
6227 | 1768 | 1.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 | |||||
6236 | 13 | 3µs | if ($error_in_conf) { | ||
6237 | Sympa::send_notify_to_listmaster($robot, 'edit_list_error', | ||||
6238 | [$path_config]); | ||||
6239 | } | ||||
6240 | |||||
6241 | 13 | 81µs | 13 | 54µs | close $fh; # spent 54µs making 13 calls to Sympa::List::CORE:close, avg 4µs/call |
6242 | |||||
6243 | 13 | 15µs | $self->{_path}{edit_list} = $path_config; | ||
6244 | 13 | 8µs | $self->{_mtime}{edit_list} = $mtime_config; | ||
6245 | 13 | 6.09ms | $self->{_edit_list} = $conf; | ||
6246 | } | ||||
6247 | |||||
6248 | ###### END of the List package ###### | ||||
6249 | |||||
6250 | 1; | ||||
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: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:fteread; # opcode | |||||
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 | |||||
# 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_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: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 | |||||
# 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: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 | |||||
# 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 |