1#!--PERL--
2# -*- indent-tabs-mode: nil; -*-
3# vim:ft=perl:et:sw=4
4# $Id$
5
6# Sympa - SYsteme de Multi-Postage Automatique
7#
8# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
9# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
10# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
11# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
12# Copyright 2017, 2018, 2019, 2020, 2021 The Sympa Community. See the
13# AUTHORS.md file at the top-level directory of this distribution and at
14# <https://github.com/sympa-community/sympa.git>.
15#
16# This program is free software; you can redistribute it and/or modify
17# it under the terms of the GNU General Public License as published by
18# the Free Software Foundation; either version 2 of the License, or
19# (at your option) any later version.
20#
21# This program is distributed in the hope that it will be useful,
22# but WITHOUT ANY WARRANTY; without even the implied warranty of
23# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24# GNU General Public License for more details.
25#
26# You should have received a copy of the GNU General Public License
27# along with this program.  If not, see <http://www.gnu.org/licenses/>.
28
29## Copyright 1999 Comité Réseaux des Universités
30## web interface to Sympa mailing lists manager
31## Sympa: http://www.sympa.org/
32## Authors :
33##           Serge Aumont <sa AT cru.fr>
34##           Olivier Salaün <os AT cru.fr>
35
36use strict;
37##use warnings;
38use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
39
40use Archive::Zip qw();
41use DateTime;
42use DateTime::Format::Mail;
43use Digest::MD5;
44use Encode qw();
45use English qw(-no_match_vars);
46use IO::File qw();
47use MIME::EncWords;
48use MIME::Lite::HTML;
49use POSIX qw();
50use Time::Local qw();
51use URI;
52use Data::Dumper;    # tentative
53BEGIN { eval 'use Crypt::OpenSSL::X509'; }
54
55use Sympa;
56use Sympa::Archive;
57use Conf;
58use Sympa::ConfDef;
59use Sympa::Constants;
60use Sympa::Crash Hook => \&_crash_handler;    # Show traceback.
61use Sympa::Database;
62use Sympa::DatabaseManager;
63use Sympa::Family;
64use Sympa::HTMLSanitizer;
65use Sympa::Language;
66use Sympa::List;
67use Sympa::List::Config;
68use Sympa::List::Users;
69use Sympa::Log;
70use Sympa::Message;
71use Sympa::Regexps;
72use Sympa::Robot;
73use Sympa::Scenario;
74use Sympa::Spindle::ProcessRequest;
75use Sympa::Spindle::ResendArchive;
76use Sympa::Spool::Archive;
77use Sympa::Spool::Auth;
78use Sympa::Spool::Held;
79use Sympa::Spool::Incoming;
80use Sympa::Spool::Listmaster;
81use Sympa::Spool::Moderation;
82use Sympa::Spool::Outgoing;
83use Sympa::Spool::Topic;
84use Sympa::Task;
85use Sympa::Template;
86use Sympa::Ticket;
87use Sympa::Tools::Data;
88use Sympa::Tools::File;
89use Sympa::Tools::Password;
90use Sympa::Tools::Text;
91use Sympa::Tracking;
92use Sympa::User;
93use Sympa::WWW::Auth;
94use Sympa::WWW::FastCGI;
95use Sympa::WWW::Marc::Search;
96use Sympa::WWW::Report;
97use Sympa::WWW::Session;
98use Sympa::WWW::SharedDocument;
99use Sympa::WWW::Tools;
100
101## WWSympa librairies
102my %options;
103
104my $sympa_conf_file = Sympa::Constants::CONFIG;
105
106our $list;
107our $param = {};
108our $robot_id;
109our $session;
110
111my $robot;
112my $cookie_domain;
113my $ip;
114my $rss;
115my $ajax;
116
117my $allow_absolute_path;    #FIXME: to be removed in the future.
118my @other_include_path;     #FIXME: ditto.
119
120## Load sympa config
121unless (Conf::load()) {
122    printf STDERR
123        "Unable to load sympa configuration, file %s or one of the vhost robot.conf files contain errors. Exiting.\n",
124        Conf::get_sympa_conf();
125    exit 1;
126}
127
128# Open log
129my $log = Sympa::Log->instance;
130$log->{level} = $Conf::Conf{'log_level'};
131$log->openlog($Conf::Conf{'log_facility'} || $Conf::Conf{'syslog'},
132    $Conf::Conf{'log_socket_type'});
133
134Sympa::Spool::Listmaster->instance->{use_bulk} = 1;
135
136# hash of all the description files already loaded
137# format :
138#     $desc_files{pathfile}{'date'} : date of the last load
139#     $desc_files{pathfile}{'desc_hash'} : hash which describes
140#                         the description file
141
142#%desc_files_map; NOT USED ANYMORE
143
144## Shared directory and description file
145
146#$shared = 'shared';
147#$desc = '.desc';
148
149## subroutines
150our %comm = (
151    'confirm_action' => 'do_confirm_action',
152    'home'           => 'do_home',
153    'logout'         => 'do_logout',
154    #'loginrequest'           => 'do_loginrequest',
155    'login'               => 'do_login',
156    'sso_login'           => 'do_sso_login',
157    'sso_login_succeeded' => 'do_sso_login_succeeded',
158    'subscribe'           => 'do_subscribe',
159    #'multiple_subscribe'     => 'do_multiple_subscribe',
160    #'subrequest'             => 'do_subrequest',
161    'subindex'       => 'do_subindex',
162    'suboptions'     => 'do_suboptions',
163    'signoff'        => 'do_signoff',
164    'auto_signoff'   => 'do_auto_signoff',
165    'family_signoff' => 'do_family_signoff',
166    #'family_signoff_request' => 'do_family_signoff_request',
167    #XXX'multiple_signoff'    => 'do_multiple_signoff',
168    #'sigrequest' => 'do_sigrequest',
169    'sigindex' => 'do_sigindex',
170    'decl_add' => 'do_decl_add',
171    'decl_del' => 'do_decl_del',
172    'my'       => 'do_my',
173    #'which' => 'do_which',
174    'lists'            => 'do_lists',
175    'lists_categories' => 'do_lists_categories',
176    'latest_lists'     => 'do_latest_lists',
177    'active_lists'     => 'do_active_lists',
178    'including_lists'  => 'do_including_lists',
179    'info'             => 'do_info',
180    'subscriber_count' => 'do_subscriber_count',
181    'review'           => 'do_review',
182    'search'           => 'do_search',
183    'pref',            => 'do_pref',
184    'setpref'          => 'do_setpref',
185    'setpasswd'        => 'do_setpasswd',
186    'renewpasswd'      => 'do_renewpasswd',
187    'firstpasswd'      => 'do_firstpasswd',
188    'requestpasswd'    => 'do_requestpasswd',
189    'choosepasswd'     => 'do_choosepasswd',
190    'set'              => 'do_set',
191    'admin'            => 'do_admin',
192    'import'           => 'do_import',
193    'add'              => 'do_add',
194    'auth_add'         => 'do_auth_add',
195    'del'              => 'do_del',
196    'auth_del'         => 'do_auth_del',
197    'mass_del'         => 'do_mass_del',
198    'modindex'         => 'do_modindex',
199    'docindex'         => 'do_docindex',
200    'reject'           => 'do_reject',
201    #XXX'reject_notify' => 'do_reject_notify',
202    'distribute'      => 'do_distribute',
203    'add_frommod'     => 'do_add_frommod',
204    'viewmod'         => 'do_viewmod',
205    'd_reject_shared' => 'do_d_reject_shared',
206    #XXX'reject_notify_shared' => 'do_reject_notify_shared',
207    'd_install_shared'  => 'do_d_install_shared',
208    'editfile'          => 'do_editfile',
209    'savefile'          => 'do_savefile',
210    'arc'               => 'do_arc',
211    'latest_arc'        => 'do_latest_arc',
212    'latest_d_read'     => 'do_latest_d_read',
213    'arc_manage'        => 'do_arc_manage',
214    'remove_arc'        => 'do_remove_arc',
215    'send_me'           => 'do_send_me',
216    'view_source'       => 'do_view_source',
217    'tracking'          => 'do_tracking',
218    'arcsearch_form'    => 'do_arcsearch_form',
219    'arcsearch_id'      => 'do_arcsearch_id',
220    'arcsearch'         => 'do_arcsearch',
221    'rebuildarc'        => 'do_rebuildarc',
222    'rebuildallarc'     => 'do_rebuildallarc',
223    'arc_download'      => 'do_arc_download',
224    'arc_delete'        => 'do_arc_delete',
225    'serveradmin'       => 'do_serveradmin',
226    'set_loglevel'      => 'do_set_loglevel',
227    'set_dumpvars'      => 'do_set_dumpvars',
228    'show_sessions'     => 'do_show_sessions',
229    'unset_dumpvars'    => 'do_unset_dumpvars',
230    'set_session_email' => 'do_set_session_email',
231    'restore_email'     => 'do_restore_email',
232    'skinsedit'         => 'do_skinsedit',
233    #XXX'css' => 'do_css',
234    'help'                     => 'do_help',
235    'edit_list_request'        => 'do_edit_list_request',
236    'edit_list'                => 'do_edit_list',
237    'create_list_request'      => 'do_create_list_request',
238    'create_list'              => 'do_create_list',
239    'get_pending_lists'        => 'do_get_pending_lists',
240    'get_closed_lists'         => 'do_get_closed_lists',
241    'get_latest_lists'         => 'do_get_latest_lists',
242    'get_inactive_lists'       => 'do_get_inactive_lists',
243    'get_biggest_lists'        => 'do_get_biggest_lists',
244    'set_pending_list_request' => 'do_set_pending_list_request',
245    'install_pending_list'     => 'do_install_pending_list',
246    'edit_config'              => 'do_edit_config',
247    #XXX'submit_list' => 'do_submit_list',
248    'editsubscriber'      => 'do_editsubscriber',
249    'edit'                => 'do_edit',
250    'viewbounce'          => 'do_viewbounce',
251    'redirect'            => 'do_redirect',
252    'rename_list_request' => 'do_rename_list_request',
253    'move_list'           => 'do_move_list',
254    'copy_list'           => 'do_copy_list',
255    'reviewbouncing'      => 'do_reviewbouncing',
256    'resetbounce'         => 'do_resetbounce',
257    'scenario_test'       => 'do_scenario_test',
258    'search_list'         => 'do_search_list',
259    'search_list_request' => 'do_search_list_request',
260    'show_cert'           => 'do_show_cert',
261    'close_list'          => 'do_close_list',
262    'open_list'           => 'do_open_list',
263    'purge_list'          => 'do_purge_list',
264    'upload_pictures'     => 'do_upload_pictures',
265    'delete_pictures'     => 'do_delete_pictures',
266    'd_read'              => 'do_d_read',
267    'd_create_child'      => 'do_d_create_child',
268    'd_unzip'             => 'do_d_unzip',
269    'd_editfile'          => 'do_d_editfile',
270    'd_properties'        => 'do_d_properties',
271    'd_update'            => 'do_d_update',
272    'd_describe'          => 'do_d_describe',
273    'd_delete'            => 'do_d_delete',
274    'd_rename'            => 'do_d_rename',
275    'd_control'           => 'do_d_control',
276    'd_change_access'     => 'do_d_change_access',
277    'd_set_owner'         => 'do_d_set_owner',
278    'd_admin'             => 'do_d_admin',
279    'dump_scenario'       => 'do_dump_scenario',
280    'export_member'       => 'do_export_member',
281    'remind'              => 'do_remind',
282    'move_user'           => 'do_move_user',
283    'load_cert'           => 'do_load_cert',
284    'compose_mail'        => 'do_compose_mail',
285    'send_mail'           => 'do_send_mail',
286    'request_topic'       => 'do_request_topic',
287    'tag_topic_by_sender' => 'do_tag_topic_by_sender',
288    'search_user'         => 'do_search_user',
289    'set_lang'            => 'do_set_lang',
290    'attach'              => 'do_attach',
291    'stats'               => 'do_stats',
292    'viewlogs'            => 'do_viewlogs',
293    'wsdl'                => 'do_wsdl',
294    'sync_include'        => 'do_sync_include',
295    'review_family'       => 'do_review_family',
296    'ls_templates'        => 'do_ls_templates',
297    'remove_template'     => 'do_remove_template',
298    'copy_template'       => 'do_copy_template',
299    'view_template'       => 'do_view_template',
300    'edit_template'       => 'do_edit_template',
301    #'rss' => 'do_rss', #FIXME:Currently processed in differenct way.
302    'rss_request'     => 'do_rss_request',
303    'maintenance'     => 'do_maintenance',
304    'blocklist'       => 'do_blocklist',
305    'edit_attributes' => 'do_edit_attributes',
306    'ticket'          => 'do_ticket',
307    'manage_template' => 'do_manage_template',
308    'rt_create'       => 'do_rt_create',
309    'rt_delete'       => 'do_rt_delete',
310    'rt_edit'         => 'do_rt_edit',
311    'rt_setdefault'   => 'do_rt_setdefault',
312    'rt_update'       => 'do_rt_update',
313    #XXX'send_newsletter' => 'do_send_newsletter',
314    'suspend'                => 'do_suspend',
315    'suspend_request'        => 'do_suspend_request',
316    'suspend_request_action' => 'do_suspend_request_action',
317    'show_exclude'           => 'do_show_exclude',
318    # 'ca' stands for 'custom_action'. I used a short name to make it discrete
319    # in a URL.
320    'ca' => 'do_ca',
321    # 'lca' stands for 'list_custom_action'. I used a short name to make it
322    # discrete in a URL.
323    'lca' => 'do_lca',
324    #XXX'automatic_lists_management_request' =>
325    #XXX    'do_automatic_lists_management_request',
326    #XXX'automatic_lists_management'    => 'do_automatic_lists_management',
327    'create_automatic_list'         => 'do_create_automatic_list',
328    'create_automatic_list_request' => 'do_create_automatic_list_request',
329    'auth'                          => 'do_auth',
330    'delete_account'                => 'do_delete_account',
331);
332
333my %comm_aliases = (
334    'add_fromsub'             => 'auth_add',
335    'add_request'             => 'import',
336    'automatic_lists'         => 'create_automatic_list',
337    'automatic_lists_request' => 'create_automatic_list_request',
338    'blacklist'               => 'blocklist',
339    'change_email'            => 'move_user',
340    'change_email_request'    => 'move_user',
341    'del_fromsig'             => 'auth_del',
342    'dump'                    => 'export_member',
343    'family_signoff_request'  => 'family_signoff',
344    'ignoresig'               => 'decl_del',
345    'ignoresub'               => 'decl_add',
346    'loginrequest'            => 'login',
347    'rename_list'             => 'move_list',
348    'restore_list'            => 'open_list',
349    'sigrequest'              => 'signoff',
350    'subrequest'              => 'subscribe',
351);
352
353# No longer used.
354#my %auth_action;
355
356# Arguments awaited in the PATH_INFO, depending on the action.
357# NOTE:
358# * The email addresses should NOT be embedded in PATH_INFO, because included
359#   slashes (/) cannot be handled correctly by web servers. They are kept just
360#   for compatibility to earlier releases of Sympa.  Use query parameters
361#   instead.
362our %action_args = (
363    'default'         => ['list'],
364    'editfile'        => ['list', 'file', 'previous_action'],
365    'requestpasswd'   => ['email'],
366    'choosepasswd'    => ['email', 'passwd'],
367    'lists'           => ['topic', 'subtopic'],
368    'latest_lists'    => ['topic', 'subtopic'],
369    'active_lists'    => ['topic', 'subtopic'],
370    'including_lists' => ['list'],
371    'login'           => ['previous_action', 'previous_list'],
372    'sso_login' => ['auth_service_name', 'subaction', 'email', 'ticket'],
373    'sso_login_succeeded' =>
374        ['auth_service_name', 'previous_action', 'previous_list'],
375    #'loginrequest' => ['previous_action', 'previous_list'],
376    'logout'      => ['previous_action', 'previous_list'],
377    'renewpasswd' => ['previous_action', 'previous_list'],
378    'firstpasswd' => ['previous_action', 'previous_list'],
379    #XXX'css' => ['file'],
380    'pref'             => ['previous_action', 'previous_list'],
381    'reject'           => ['list',            'id'],
382    'distribute'       => ['list',            'id'],
383    'add_frommod'      => ['list',            'id'],
384    'dump_scenario'    => ['list',            'scenario_function'],
385    'd_reject_shared'  => ['list',            'id'],
386    'd_install_shared' => ['list',            'id'],
387    'modindex'         => ['list'],
388    'docindex'         => ['list'],
389    'viewmod'          => ['list',            'id', '@file'],
390    'add'              => ['list',            'email'],
391    'import' => ['list'],
392    'del'    => ['list', 'email'],
393    #'editsubscriber' =>
394    #    ['list', 'email', 'previous_action', 'custom_attribute'],
395    #'editsubscriber' => ['list', 'email', 'previous_action'],
396    'editsubscriber' => ['list'],
397    'edit'           => ['list', 'role'],
398    #'viewbounce' => ['list', 'email', '@file'],
399    'viewbounce' => ['list', 'dir', '@file'],
400    #'resetbounce'    => ['list', 'email'],
401    'review'         => ['list', 'page',  'size', 'sortby'],
402    'reviewbouncing' => ['list', 'page',  'size'],
403    'arc'            => ['list', 'month', '@arc_file'],
404    'latest_arc'     => ['list'],
405    'arc_manage'     => ['list'],
406    'arcsearch_form' => ['list', 'archive_name'],
407    'arcsearch_id'   => ['list', 'archive_name', '@msgid'],
408    'rebuildarc'     => ['list', 'month'],
409    'rebuildallarc' => [],
410    'arc_download'  => ['list'],
411    'arc_delete'    => ['list', 'zip'],
412    'home'          => [],
413    'help'          => ['help_topic'],
414    'show_cert'     => [],
415    'subscribe'     => ['list'],
416    #'subrequest' => ['list','email'],
417    'subindex'       => ['list'],
418    'decl_add'       => ['list'],
419    'signoff'        => ['list'],
420    'auto_signoff'   => ['list'],
421    'family_signoff' => ['family'],
422    #'family_signoff_request' => ['family', 'email'],
423    #'sigrequest'             => ['list',   'email'],
424    'sigindex'           => ['list'],
425    'decl_del'           => ['list'],
426    'set'                => ['list', 'email', 'reception', 'gecos'],
427    'serveradmin'        => ['subaction'],
428    'set_session_email'  => ['email'],
429    'skinsedit'          => [],
430    'get_pending_lists'  => [],
431    'get_closed_lists'   => [],
432    'get_latest_lists'   => [],
433    'get_inactive_lists' => [],
434    'get_biggest_lists'  => [],
435    'search_list'        => ['filter_list'],
436    'shared'            => ['list', '@path'],        #FIXME: no such function.
437    'd_read'            => ['list', '@path'],
438    'latest_d_read'     => ['list'],
439    'd_admin'           => ['list', 'd_admin'],
440    'd_delete'          => ['list', '@path'],
441    'd_rename'          => ['list', '@path'],
442    'd_create_child'    => ['list', '@path'],
443    'd_update'          => ['list', '@path'],
444    'd_describe'        => ['list', '@path'],
445    'd_editfile'        => ['list', '@path'],
446    'd_properties'      => ['list', '@path'],
447    'd_control'         => ['list', '@path'],
448    'd_change_access'   => ['list', '@path'],
449    'd_set_owner'       => ['list', '@path'],
450    'export_member'     => ['list', 'format'],
451    'search'            => ['list', 'filter'],
452    'search_user'       => ['email'],
453    'set_lang'          => ['lang'],
454    'attach'            => ['list', 'dir', 'file'],
455    'stats'             => ['list'],
456    'edit_list_request' => ['list', 'group'],
457    'move_list'           => ['list', 'new_listname', 'new_robot'],
458    'copy_list'           => ['list', 'new_listname', 'new_robot'],
459    'redirect'            => [],
460    'viewlogs'            => ['list', 'page', 'size', 'sortby'],
461    'wsdl'                => [],
462    'sync_include'        => ['list'],
463    'review_family'       => ['family_name'],
464    'ls_templates'        => ['list'],
465    'view_template'       => [],
466    'remove_template'     => [],
467    'copy_template'       => ['list'],
468    'edit_template'       => ['list'],
469    'rss_request'         => ['list'],
470    'request_topic'       => ['list', 'authkey'],
471    'tag_topic_by_sender' => ['list'],
472    'ticket'              => ['ticket'],
473    'move_user'           => [],
474    'manage_template'     => ['subaction', 'list', 'message_template'],
475    'rt_delete'           => ['list', 'message_template'],
476    'rt_edit'             => ['list', 'message_template'],
477    'send_newsletter'     => [],
478    'compose_mail'        => ['list', 'subaction'],
479    'suspend'             => ['list'],
480    'suspend_request'     => ['subaction'],
481    'show_exclude'        => ['list'],
482    'ca'                  => ['custom_action', '@cap'],
483    'lca'                 => ['custom_action', 'list', '@cap'],
484    #XXX'automatic_lists_management_request' => [],
485    #XXX'automatic_lists_management'         => [],
486    'create_automatic_list'         => ['family'],
487    'create_automatic_list_request' => ['family'],
488    'auth'                          => ['id', 'heldaction', 'listname'],
489    'auth_add'                      => ['list'],
490    'auth_del'                      => ['list'],
491);
492
493## Define the required parameters for each action
494## Parameter names refer to the %in structure of to $param if mentionned as
495## 'param.x'
496## This structure is used to determine if any parameter is missing
497## The list of parameters is not ordered
498## Some keywords are reserved: param.list and param.user.email
499## Alternate parameters can be defined with the '|' character
500## Limits of this structure: it does not define optional parameters (a or b)
501## Limit: it does not allow to have a specific error message and redirect to a
502## given page if the parameter is missing
503our %required_args = (
504    'active_lists'   => ['for|count'],
505    'admin'          => ['param.list', 'param.user.email'],
506    'add'            => ['param.list', 'param.user.email'],
507    'import'         => ['param.list', 'param.user.email'],
508    'arc'            => ['param.list'],
509    'arc_delete'     => ['param.user.email', 'param.list'],
510    'arc_download'   => ['param.user.email', 'param.list'],
511    'arc_manage'     => ['param.list'],
512    'arcsearch'      => ['param.list'],
513    'arcsearch_form' => ['param.list'],
514    'arcsearch_id'   => ['param.list'],
515    'auth'           => ['id', 'heldaction', 'email'],
516    'auth_add'       => ['param.list', 'param.user.email', 'id'],
517    'auth_del'       => ['param.list', 'param.user.email', 'id'],
518    'auto_signoff'   => ['param.list', 'email'],
519    'attach'         => ['param.list'],
520    'blocklist'      => ['param.list'],
521    'move_user' =>
522        ['param.user.email', 'current_email|old_email', 'email|new_email'],
523    'close_list'    => ['param.user.email', 'param.list'],
524    'compose_mail'  => ['param.user.email', 'param.list'],
525    'copy_template' => ['webormail'],
526    ## other required parameters are checked in the subroutine
527    'create_automatic_list'         => ['param.user.email', 'family'],
528    'create_automatic_list_request' => ['param.user.email', 'family'],
529    'create_list'                   => ['param.user.email', 'info'],
530    'create_list_request'           => ['param.user.email'],
531    #XXX'css' => [],
532    'd_admin'         => ['param.list', 'param.user.email'],
533    'd_change_access' => ['param.list', 'param.user.email'],
534    'd_control'       => ['param.list', 'param.user.email'],
535    'd_create_child' =>
536        ['param.list', 'param.user.email', 'new_name|uploaded_file'],
537    'd_delete'         => ['param.list', 'param.user.email'],
538    'd_describe'       => ['param.list', 'param.user.email', 'content'],
539    'd_editfile'       => ['param.list', 'param.user.email'],
540    'd_install_shared' => ['param.list', 'param.user.email', 'id'],
541    'd_properties'     => ['param.list', 'param.user.email'],
542    'd_read'          => ['param.list'],
543    'd_reject_shared' => ['param.list', 'param.user.email', 'id'],
544    'd_rename'        => ['param.list', 'param.user.email', 'new_name'],
545    'd_update' =>
546        ['param.list', 'param.user.email', 'content|url|uploaded_file'],
547    'd_set_owner'     => ['param.list', 'param.user.email'],
548    'd_unzip'         => ['param.list', 'param.user.email', 'uploaded_file'],
549    'del'             => ['param.list', 'param.user.email', 'email'],
550    'delete_pictures' => ['param.list', 'param.user.email'],
551    'distribute'      => ['param.list', 'param.user.email', 'id|idspam'],
552    'add_frommod'     => ['param.list', 'param.user.email', 'id'],
553    'dump_scenario'   => ['param.list', 'scenario_function|pname'],
554    'edit'            => ['param.list', 'param.user.email', 'role', 'email'],
555    'edit_list'         => ['param.user.email', 'param.list'],
556    'edit_list_request' => ['param.user.email', 'param.list'],
557    'edit_template'     => ['webormail'],
558    'editfile'          => ['param.user.email'],
559    'editsubscriber'    => ['param.list',       'param.user.email', 'email'],
560    'export_member'        => ['param.list'],
561    'family_signoff'       => ['family', 'email'],
562    'get_closed_lists'     => ['param.user.email'],
563    'get_inactive_lists'   => ['param.user.email'],
564    'get_latest_lists'     => ['param.user.email'],
565    'get_biggest_lists'    => ['param.user.email'],
566    'get_pending_lists'    => ['param.user.email'],
567    'decl_del'             => ['param.list', 'param.user.email', 'id'],
568    'decl_add'             => ['param.list', 'param.user.email', 'id'],
569    'delete_account'       => ['passwd', 'i_understand_the_consequences'],
570    'including_lists'      => ['param.list', 'param.user.email'],
571    'info'                 => ['param.list'],
572    'install_pending_list' => ['param.user.email'],
573    'edit_config'          => ['param.user.email'],
574    'latest_arc'           => ['param.list', 'for|count'],
575    'latest_d_read'        => ['param.list', 'for', 'count'],
576    'latest_lists'         => ['for|count'],
577    'load_cert'            => ['param.list'],
578    'logout'               => ['param.user.email'],
579    'manage_template'      => ['param.list', 'param.user.email'],
580    'my'                   => ['param.user.email'],
581    'rt_create' => ['param.list', 'param.user.email', 'new_template_name'],
582    'rt_delete' => ['param.list', 'param.user.email', 'message_template'],
583    'rt_edit'   => ['param.list', 'param.user.email', 'message_template'],
584    'rt_setdefault' => ['param.list', 'param.user.email', 'new_default'],
585    'rt_update' =>
586        ['param.list', 'param.user.email', 'message_template', 'content'],
587    'modindex'      => ['param.list',       'param.user.email'],
588    'docindex'      => ['param.list',       'param.user.email'],
589    'pref'          => ['param.user.email'],
590    'purge_list'    => ['param.user.email', 'selected_lists'],
591    'rebuildallarc' => ['param.user.email'],
592    'rebuildarc'    => ['param.user.email', 'param.list'],
593    'reject'        => ['param.list',       'param.user.email', 'id|idspam'],
594    'remind'        => ['param.list',       'param.user.email'],
595    'remove_arc'      => ['param.list'],
596    'remove_template' => ['webormail'],
597    'move_list' =>
598        ['param.user.email', 'param.list', 'new_listname', 'new_robot'],
599    'copy_list' =>
600        ['param.user.email', 'param.list', 'new_listname', 'new_robot'],
601    'open_list'           => ['param.user.email', 'param.list'],
602    'rename_list_request' => ['param.user.email', 'param.list'],
603    'request_topic'       => ['param.list',       'authkey'],
604    'resetbounce'     => ['param.list', 'param.user.email', 'email'],
605    'review'          => ['param.list'],
606    'review_family'   => ['param.user.email', 'family_name'],
607    'reviewbouncing'  => ['param.list'],
608    'rss_request'     => [],
609    'savefile'        => ['param.user.email', 'file'],
610    'search'          => ['param.list'],
611    'search_user'     => ['param.user.email', 'email'],
612    'send_mail'       => ['param.user.email'],
613    'send_newsletter' => ['param.list', 'param.user.email', 'url'],
614    'send_me'         => ['param.list'],
615    'view_source'     => ['param.list'],
616    'tracking'        => ['param.list'],
617    'requestpasswd'   => ['email'],
618    'serveradmin'     => ['param.user.email'],
619    'set'      => ['param.user.email', 'param.list', 'reception|visibility'],
620    'set_lang' => [],
621    'set_pending_list_request' => ['param.user.email'],
622    'setpasswd'        => ['param.user.email', 'newpasswd1', 'newpasswd2'],
623    'setpref'          => ['param.user.email'],
624    'sigindex'         => ['param.list', 'param.user.email'],
625    'signoff'          => ['param.list'],
626    'skinsedit'        => ['param.user.email'],
627    'sso_login'        => ['auth_service_name'],
628    'stats'            => ['param.list'],
629    'subindex'         => ['param.list', 'param.user.email'],
630    'suboptions'       => ['param.list', 'param.user.email'],
631    'subscribe'        => ['param.list'],
632    'subscriber_count' => ['param.list'],
633    'suspend'          => ['param.list', 'param.user.email'],
634    'suspend_request'  => [],
635    'suspend_request_action' => [],
636    'show_exclude'           => ['param.list'],
637    'sync_include'           => ['param.list', 'param.user.email'],
638    'tag_topic_by_sender'    => ['param.list'],
639    'upload_pictures'        => ['param.user.email', 'param.list'],
640    'view_template'          => ['webormail'],
641    'viewbounce'             => ['param.list', 'email|file'],
642    'viewlogs'               => ['param.list'],
643    'viewmod' => ['param.list', 'param.user.email', 'id|idspam'],
644    'wsdl'    => [],
645    #'which' => ['param.user.email'],
646);
647
648## Defines the required privileges to access privileged actions
649## You can define a set ofequiivalent privileges in the ARRAYREF
650our %required_privileges = (
651    'admin'                    => ['owner', 'editor'],
652    'arc_delete'               => ['owner'],
653    'arc_download'             => ['owner'],
654    'arc_manage'               => ['owner'],
655    'auth_add'                 => ['owner', 'editor'],
656    'auth_del'                 => ['owner', 'editor'],
657    'blocklist'                => ['owner', 'editor'],
658    'close_list'               => ['privileged_owner'],
659    'copy_template'            => ['listmaster'],
660    'd_install_shared'         => ['editor', 'owner'],
661    'd_reject_shared'          => ['editor', 'owner'],
662    'distribute'               => ['editor', 'owner', 'listmaster'],
663    'add_frommod'              => ['editor', 'owner'],
664    'dump_scenario'            => ['listmaster'],
665    'edit'                     => ['editor', 'owner', 'listmaster'],
666    'edit_list'                => ['owner'],
667    'edit_list_request'        => ['owner'],
668    'edit_template'            => ['listmaster'],
669    'editfile'                 => ['owner', 'listmaster'],
670    'editsubscriber'           => ['owner', 'editor'],
671    'get_closed_lists'         => ['listmaster'],
672    'get_inactive_lists'       => ['listmaster'],
673    'get_latest_lists'         => ['listmaster'],
674    'get_biggest_lists'        => ['listmaster'],
675    'get_pending_lists'        => ['listmaster'],
676    'decl_del'                 => ['owner', 'editor'],
677    'decl_add'                 => ['owner', 'editor'],
678    'including_lists'          => ['owner', 'listmaster'],
679    'install_pending_list'     => ['listmaster'],
680    'edit_config'              => ['listmaster'],
681    'ls_templates'             => ['listmaster'],
682    'manage_template'          => ['owner'],
683    'mass_del'                 => ['listmaster'],
684    'rt_create'                => ['owner'],
685    'rt_delete'                => ['owner'],
686    'rt_edit'                  => ['owner'],
687    'rt_setdefault'            => ['owner'],
688    'rt_update'                => ['owner'],
689    'modindex'                 => ['editor', 'owner', 'listmaster'],
690    'docindex'                 => ['editor', 'owner', 'listmaster'],
691    'purge_list'               => ['privileged_owner', 'listmaster'],
692    'rebuildallarc'            => ['listmaster'],
693    'rebuildarc'               => ['listmaster'],
694    'reject'                   => ['editor', 'owner', 'listmaster'],
695    'remove_template'          => ['listmaster'],
696    'move_list'                => ['privileged_owner'],
697    'copy_list'                => ['owner', 'listmaster'],
698    'open_list'                => ['listmaster'],
699    'rename_list_request'      => ['privileged_owner'],
700    'resetbounce'              => ['owner', 'editor'],
701    'review_family'            => ['listmaster'],
702    'reviewbouncing'           => ['owner', 'editor'],
703    'savefile'                 => ['owner', 'listmaster'],
704    'search_user'              => ['listmaster'],
705    'serveradmin'              => ['listmaster'],
706    'set_dumpvars'             => ['listmaster'],
707    'set_loglevel'             => ['listmaster'],
708    'set_pending_list_request' => ['listmaster'],
709    'set_session_email'        => ['listmaster'],
710    'show_sessions'            => ['listmaster'],
711    'sigindex'                 => ['owner', 'editor'],
712    'stats'                    => ['owner'],
713    'subindex'                 => ['owner', 'editor'],
714    'sync_include'             => ['owner', 'editor'],
715    'skinsedit'                => ['listmaster'],
716    'view_template'            => ['listmaster'],
717    'viewbounce'               => ['owner', 'editor'],
718    'viewlogs'                 => ['owner', 'editor'],
719    'viewmod'                  => ['editor', 'owner', 'listmaster'],
720    #XXX'automatic_lists_management_request' => ['listmaster'],
721    #XXX'automatic_lists_management'         => ['listmaster'],
722);
723
724# An action is a candidate for this list if it modifies an object or setting.
725#
726# Why not just protect all actions? Many of them are used in GET requests
727# without any forms, making it more difficult to supply a CSRF token.
728# This list intentionally starts out small in the name of breaking as little
729# as possible.
730
731our %require_csrftoken = (
732    'add'       => 1,
733    'del'       => 1,
734    'move_user' => 1,
735    'savefile'  => 1,
736    'setpasswd' => 1,
737    'setpref'   => 1,
738);
739
740# this definition is used to choose the left side menu type (admin ->
741# listowner admin menu | serveradmin -> server_admin menu | none list or
742# your_list menu)
743my %action_type = (
744    'review' => 'admin',
745    'search' => 'admin',
746    'admin'  => 'admin',
747    'import' => 'admin',
748    'add'    => 'admin',
749    'del'    => 'admin',
750    # 'modindex' =>'admin',
751    'reject'            => 'admin',
752    'reject_notify'     => 'admin',
753    'distribute'        => 'admin',
754    'add_frommod'       => 'admin',
755    'viewmod'           => 'admin',
756    'savefile'          => 'admin',
757    'rebuildallarc'     => 'admin',    #FIXME: serveradmin?
758    'reviewbouncing'    => 'admin',
759    'edit'              => 'admin',
760    'edit_list_request' => 'admin',
761    'edit_list'         => 'admin',
762    'editsubscriber'    => 'admin',
763    'viewbounce'        => 'admin',
764    'resetbounce'       => 'admin',
765    'scenario_test'     => 'admin',
766    'close_list'        => 'admin',
767    'd_admin'           => 'admin',
768    'd_reject_shared'   => 'admin',
769    'd_install_shared'  => 'admin',
770    'dump_scenario'     => 'admin',
771    'export_member'     => 'admin',
772    'open_list'         => 'admin',
773    'remind'            => 'admin',
774    #'subindex' => 'admin',
775    'stats'               => 'admin',
776    'decl_del'            => 'admin',
777    'decl_add'            => 'admin',
778    'move_list'           => 'admin',
779    'copy_list'           => 'admin',
780    'rename_list_request' => 'admin',
781    'arc_manage'          => 'admin',
782    'sync_include'        => 'admin',
783    'view_template'       => 'admin',
784    'remove_template'     => 'admin',
785    'copy_template'       => 'admin',
786    'edit_template'       => 'admin',
787    'blocklist'           => 'admin',
788    'viewlogs'            => 'admin',
789    'serveradmin'         => 'serveradmin',
790    'get_pending_lists'   => 'serveradmin',
791    'get_closed_lists'    => 'serveradmin',
792    'get_inactive_lists'  => 'serveradmin',
793    'get_latest_lists'    => 'serveradmin',
794    'get_biggest_lists'   => 'serveradmin',
795    'ls_templates'        => 'serveradmin',
796    'skinsedit'           => 'serveradmin',
797    'review_family'       => 'serveradmin',
798    'search_user'         => 'serveradmin',
799    'show_sessions'       => 'serveradmin',
800    'show_exclude'        => 'admin',
801    'rebuildarc'          => 'serveradmin',
802    'set_session_email'   => 'serveradmin',
803    'set_loglevel'        => 'serveradmin',
804    'editfile'            => 'serveradmin',    #FIXME: admin?
805    'unset_dumpvars'      => 'serveradmin',
806    'set_dumpvars'        => 'serveradmin',
807    #XXX'automatic_lists_management_request' => 'serveradmin',
808    #XXX'automatic_lists_management'         => 'serveradmin',
809);
810
811# Actions that are not used in return of login,
812my %temporary_actions = (
813    'confirm_action'      => 1,
814    'logout'              => 1,
815    'loginrequest'        => 1,
816    'login'               => 1,
817    'sso_login'           => 1,
818    'sso_login_succeeded' => 1,
819    'ticket'              => 1,
820    #XXX'css' => 1,
821    'rss'      => 1,    # FIXME:currently not used.
822    'ajax'     => 1,
823    'wsdl'     => 1,
824    'redirect' => 1,
825);
826
827## Regexp applied on incoming parameters (%in)
828## The aim is not a strict definition of parameter format
829## but rather a security check
830our %in_regexp = (
831    ## Default regexp
832    '*' => '[\w\-\.]+',
833
834    ## List config parameters
835    'single_param'   => '.+',
836    'multiple_param' => '.+',
837    'deleted_param'  => '.+',
838
839    ## Textarea content
840    'template_content'     => '.+',
841    'content'              => '.+',
842    'body'                 => '.+',
843    'info'                 => '.+',
844    'new_scenario_content' => '.+',
845    'blacklist'            => '.*',    # Compat.<=6.2.60
846    'blocklist'            => '.*',
847
848    ## Integer
849    'page' => '\d+|owner|editor',
850    'size' => '\d+',
851
852    ## Free data
853    'subject'          => '.*',
854    'gecos'            => '[^<>\\\*\$\n]+',
855    'fromname'         => '[^<>\\\*\$\n]+',
856    'additional_field' => '[^<>\\\*\$\n]+',
857    'dump'             => '[^<>\\\*\$]+',     # contents email + gecos
858
859    ## Search
860    'filter'      => '.*',                    # search subscriber
861    'filter_list' => '.*',                    # search list
862    'key_word'    => '.*',
863    'format'      => '[^<>\\\$\n]+',          # dump format/filter string
864
865    ## File names
866    'file'          => '[^<>\*\$\n]+',
867    'template_path' => '[\w\-\.\/_]+',
868    'arc_file'      => '[^<>\\\*\$\n]+',
869    'path'          => '[^<>\\\*\$\n]+',
870    'uploaded_file' =>
871        '(.*[\/\\\\])?[^<>\*\$\n]+',          # Could be precised (use of "'")
872    'dir'               => '[^<>\\\*\$\n]+',
873    'new_name'          => '[^<>\\\*\$\[\]\/\n]+',
874    'shortname'         => '[^<>\\\*\$\n]+',
875    'id'                => '[^<>\\\*\$\n]+',
876    'template_name'     => Sympa::Regexps::template_name(),
877    'new_template_name' => Sympa::Regexps::template_name(),
878    'message_template'  => Sympa::Regexps::template_name(),
879    'new_default'       => Sympa::Regexps::template_name(),
880
881    ## Archives
882    ## format is yyyy-mm for 'arc' and mm for 'send_me'
883    'month' => '\d{2}|\d{4}\-\d{2}',
884
885    ## URL
886    'referer'         => '[^\\\$\*\"\'\`\^\|\<\>\n]+',
887    'failure_referer' => '[^\\\$\*\"\'\`\^\|\<\>\n]+',
888    'url'             => '[^\\\$\*\"\'\`\^\|\<\>\n]+',
889
890    ## Msg ID
891    'msgid'       => '[^\\\*\"\'\`\^\|\n]+',
892    'in_reply_to' => '[^\\\*\"\'\`\^\|\n]+',
893    'message_id'  => '[^\\\*\"\'\`\^\|\n]+',
894    'msg_subject' => '.*',
895
896    ## Password
897    'passwd'       => '.+',
898    'password'     => '.+',
899    'newpasswd1'   => '.+',
900    'newpasswd2'   => '.+',
901    'new_password' => '.+',
902
903    ## Topics
904    'topic'    => '\@?[\-\w\/]+',
905    'topics'   => '[\-\w\/]+',
906    'subtopic' => '[\-\w\/]+',
907
908    ## List names
909    'list' => '[\w\-\.\+]*',    ## Sympa::Regexps::listname() + uppercase
910    'previous_list'  => '[\w\-\.\+]*',
911    'listname'       => '[\w\-\.\+]*',
912    'new_listname'   => '[\w\-\.\+]*',
913    'selected_lists' => '[\w\-\.\+]*',
914
915    ## Family names
916    'family_name' => Sympa::Regexps::family_name(),
917    'family'      => Sympa::Regexps::family_name(),
918
919    # Email addresses
920    'current_email' => Sympa::Regexps::email(),
921    'email'         => Sympa::Regexps::email() . '|' . Sympa::Regexps::uid(),
922    'init_email'    => Sympa::Regexps::email(),
923    'old_email'     => Sympa::Regexps::email(),
924    'new_email'     => Sympa::Regexps::email(),
925    'sender'        => Sympa::Regexps::email(),
926    'fromaddr'      => Sympa::Regexps::email(),
927    'del_emails'    => '.*',
928    'to' => '(([\w\-\_\.\/\+\=\']+|\".*\")\s[\w\-]+(\.[\w\-]+)+(,?))*',
929    'automatic_list_part_*' => '[\w\-\.\+]*',
930
931    ## Host
932    'new_robot'   => Sympa::Regexps::host(),
933    'remote_host' => Sympa::Regexps::host(),
934    'remote_addr' => Sympa::Regexps::host(),
935
936    ## Scenario name
937    'scenario'    => Sympa::Regexps::scenario_name(),
938    'read_access' => Sympa::Regexps::scenario_name(),
939    'edit_access' => Sympa::Regexps::scenario_name(),
940    ## RSS URL or blank
941    'active_lists'  => '.*',
942    'latest_lists'  => '.*',
943    'latest_arc'    => '.*',
944    'latest_d_read' => '.*',
945
946    ##Logs
947    'target_type' => '[\w\-\.\:]*',
948    'target'      => Sympa::Regexps::email(),
949    'date_from'   => '[\d\/\-]+',
950    'date_to'     => '[\d\/\-]+',
951    'ip'          => Sympa::Regexps::host(),
952
953    ## colors
954    'subaction_test'    => '.*',
955    'subaction_reset'   => '.*',
956    'subaction_install' => '.*',
957    'color_0'           => '\#[0-9a-fA-F]+',
958    'color_1'           => '\#[0-9a-fA-F]+',
959    'color_2'           => '\#[0-9a-fA-F]+',
960    'color_3'           => '\#[0-9a-fA-F]+',
961    'color_4'           => '\#[0-9a-fA-F]+',
962    'color_5'           => '\#[0-9a-fA-F]+',
963    'color_6'           => '\#[0-9a-fA-F]+',
964    'color_7'           => '\#[0-9a-fA-F]+',
965    'color_8'           => '\#[0-9a-fA-F]+',
966    'color_9'           => '\#[0-9a-fA-F]+',
967    'color_10'          => '\#[0-9a-fA-F]+',
968    'color_11'          => '\#[0-9a-fA-F]+',
969    'color_12'          => '\#[0-9a-fA-F]+',
970    'color_13'          => '\#[0-9a-fA-F]+',
971    'color_14'          => '\#[0-9a-fA-F]+',
972    'color_15'          => '\#[0-9a-fA-F]+',
973
974    ## Custom attribute
975    'custom_attribute' => '.*',
976
977    ## Templates
978    'scope' => 'distrib|robot|family|list|site',
979
980    ## Custom Inputs from create_list_request.tt2
981    'custom_input' => '.*',
982
983    ## conf parameters
984    'conf_new_value' => '.*',
985
986    ## custom actions
987    'cap'  => '.*',
988    'lcap' => '.*',
989
990    'plugin' => '.*',
991
992    ## Envelope ID
993    'envid' => '\w+',
994
995    ## Authentication/moderation key
996    'authkey' => '\w+',
997
998    # Role
999    'role' => 'member|editor|owner',
1000);
1001
1002## Regexp applied on incoming parameters (%in)
1003## This regular expression defines forbidden expressions applied on all
1004## incoming parameters
1005## Note that you can use the ^ and $ expressions to match beginning and ending
1006## of expressions
1007our %in_negative_regexp = ('arc_file' => '^(arctxt|\.)');
1008
1009# No longer used as of 6.2.19b.
1010#my %filtering;
1011
1012## Set locale configuration
1013my $language = Sympa::Language->instance;
1014$language->set_lang($Conf::Conf{'lang'}, 'en');
1015
1016# Important to leave this there because it defined defaults for
1017# user_data_source
1018#FIXME: Is it really required?
1019Sympa::DatabaseManager->instance;
1020
1021## Check that the data structure is uptodate
1022## If not, set the web interface to maintenance mode
1023my $maintenance_mode;
1024unless (Conf::data_structure_uptodate()) {
1025    $maintenance_mode = 1;
1026    $log->syslog('err',
1027        'WWSympa set to maintenance mode; you should run sympa.pl --upgrade');
1028}
1029
1030our %in;
1031my $query;
1032
1033my $birthday = [stat $PROGRAM_NAME]->[9];
1034
1035my $bulk = Sympa::Spool::Outgoing->new;
1036
1037$log->syslog('info', 'WWSympa started, process %d', $PID);
1038
1039# Now internal encoding is same as input/output.
1040#XXX## Set output encoding
1041#XXX## All outgoing strings will be recoded transparently using this charset
1042#XXXbinmode STDOUT, ":utf8";
1043
1044#XXX## Incoming data is utf8-encoded
1045#XXXbinmode STDIN, ":utf8";
1046
1047# Main loop.
1048my $loop_count = 0;
1049my $start_time = time;
1050while ($query = Sympa::WWW::FastCGI->new) {
1051    $loop_count++;
1052
1053    undef $param;
1054    undef $list;
1055    undef $robot;
1056    undef $cookie_domain;
1057    undef $ip;
1058    undef $rss;
1059    undef $ajax;
1060    undef $session;
1061
1062    $log->{level} = $Conf::Conf{'log_level'};
1063    $language->set_lang(Sympa::best_language('*'));
1064
1065    # Process grouped notifications.
1066    Sympa::Spool::Listmaster->instance->flush;
1067
1068    ## Check effective ID
1069    unless ($EUID eq (getpwnam(Sympa::Constants::USER))[2]) {
1070        $maintenance_mode = 1;
1071        Sympa::WWW::Report::reject_report_web('intern_quiet',
1072            'incorrect_server_config', {}, '', '');
1073        wwslog(
1074            'err',
1075            'Config error: WWSympa should run with UID %s (instead of %s). *** Switching to maintenance mode. ***',
1076            (getpwnam(Sympa::Constants::USER))[2],
1077            $EUID
1078        );
1079    }
1080
1081    ## We set the real UID with the effective UID value
1082    ## It is useful to allow execution of scripts like alias_manager
1083    ## that otherwise might loose the benefit of SetUID
1084    $UID = $EUID;    ## UID
1085    $GID = $EGID;    ## GID
1086
1087    unless (Sympa::DatabaseManager->instance) {
1088        Sympa::WWW::Report::reject_report_web('system_quiet', 'no_database',
1089            {}, '', '');
1090        $log->syslog('info', 'WWSympa requires a RDBMS to run');
1091    }
1092
1093    ## If in maintenance mode, check if the data structure is now uptodate
1094    if (    $maintenance_mode
1095        and Conf::data_structure_uptodate()
1096        and ($EUID eq (getpwnam(Sympa::Constants::USER))[2])) {
1097        $maintenance_mode = undef;
1098        $log->syslog('notice',
1099            "Data structure seem updated, setting OFF maintenance mode");
1100    }
1101
1102    ## Generate traceback if crashed.
1103    ## Though I don't know why, __DIE__ handler is cleared after INIT.
1104    Sympa::Crash::register_handler();
1105
1106    foreach my $envvar (
1107        qw(ORIG_PATH_INFO ORIG_SCRIPT_NAME
1108        PATH_INFO QUERY_STRING REMOTE_ADDR REMOTE_HOST REQUEST_METHOD
1109        SCRIPT_NAME SERVER_NAME SERVER_PORT
1110        SYMPA_DOMAIN)
1111    ) {
1112        $log->syslog('debug', '%s=%s', $envvar, $ENV{$envvar});
1113    }
1114
1115    ## Get params in a hash
1116    %in = $query->Vars;
1117
1118    # Determin robot.
1119    $robot = $ENV{SYMPA_DOMAIN};
1120    unless ($robot) {
1121        # No robot providing web service found.
1122        print "Status: 421 Misdirected Request\n";
1123        print "\n\n";
1124        next;
1125    }
1126
1127    # Default robot.
1128    $param->{'default_robot'} = 1
1129        if $robot eq $Conf::Conf{'domain'};
1130
1131    $ip = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} || 'undef';
1132
1133    $cookie_domain = Sympa::WWW::Tools::get_cookie_domain($robot);
1134
1135    $log->{level} = Conf::get_robot_conf($robot, 'log_level');
1136
1137    ## Sympa parameters in $param->{'conf'}
1138    $param->{'conf'} = {};
1139    foreach my $p (
1140        'email',
1141        'soap_url',
1142        'wwsympa_url',
1143        'listmaster_email',
1144        'logo_html_definition',
1145        'favicon_url',
1146        'main_menu_custom_button_1_url',
1147        'main_menu_custom_button_1_title',
1148        'main_menu_custom_button_1_target',
1149        'main_menu_custom_button_2_url',
1150        'main_menu_custom_button_2_title',
1151        'main_menu_custom_button_2_target',
1152        'main_menu_custom_button_3_url',
1153        'main_menu_custom_button_3_title',
1154        'main_menu_custom_button_3_target',
1155        'static_content_url',
1156        'use_blocklist',
1157        'antispam_feature',
1158        'custom_robot_parameter',
1159        'reporting_spam_script_path',
1160        'automatic_list_families',
1161        'spam_protection',
1162        'pictures_max_size',
1163        'show_report_abuse',
1164        'quiet_subscription',
1165        'allow_account_deletion',
1166    ) {
1167
1168        $param->{'conf'}{$p} = Conf::get_robot_conf($robot, $p);
1169        $param->{$p} = Conf::get_robot_conf($robot, $p)
1170            if $p =~ /_url\z/;
1171    }
1172    # Compat.: deprecated attributes of Robot.
1173    $param->{'conf'}{'sympa'} = Sympa::get_address($robot);
1174    $param->{'conf'}{'request'} = Sympa::get_address($robot, 'owner');
1175    # Compat <= 6.2.16: CSS related.
1176    $param->{'css_path'} = sprintf '%s/%s', $Conf::Conf{'css_path'}, $robot;
1177    $param->{'css_url'}  = sprintf '%s/%s', $Conf::Conf{'css_url'},  $robot;
1178    # Compat. < 6.2.32: "host" parameter was deprecated.
1179    $param->{'conf'}{'host'} = Conf::get_robot_conf($robot, 'domain');
1180    # Compat. < 6.2.62: Renamed parameters.
1181    $param->{'conf'}{'use_blacklist'} =
1182        Conf::get_robot_conf($robot, 'use_blocklist');
1183
1184    foreach my $auth (keys %{$Conf::Conf{'cas_id'}{$robot}}) {
1185        $log->syslog('debug2', 'CAS authentication service %s', $auth);
1186        $param->{'sso'}{$auth} =
1187            $Conf::Conf{'cas_id'}{$robot}{$auth}
1188            {'auth_service_friendly_name'};
1189    }
1190
1191    foreach my $auth (keys %{$Conf::Conf{'generic_sso_id'}{$robot}}) {
1192        $log->syslog('debug', 'Generic SSO authentication service %s', $auth);
1193        $param->{'sso'}{$auth} =
1194            $Conf::Conf{'auth_services'}{$robot}
1195            [$Conf::Conf{'generic_sso_id'}{$robot}{$auth}]{'service_name'};
1196    }
1197
1198    $param->{'sso_number'} =
1199        $Conf::Conf{'cas_number'}{$robot} +
1200        $Conf::Conf{'generic_sso_number'}{$robot};
1201    $param->{'use_passwd'} = $Conf::Conf{'use_passwd'}{$robot};
1202    $param->{'use_sso'} = 1 if ($param->{'sso_number'});
1203    $param->{'authentication_info_url'} =
1204        $Conf::Conf{'authentication_info_url'}{$robot};
1205    $param->{'wwsconf'} = Conf::_load_wwsconf;    #FXIME: no longer used?
1206
1207    $param->{'version'} = Sympa::Constants::VERSION;
1208    $param->{'date'} =
1209        $language->gettext_strftime("%d %b %Y at %H:%M:%S", localtime time);
1210    $param->{'time'} =
1211        $language->gettext_strftime("%H:%M:%S", localtime time);
1212
1213    ## Hash defining the parameters where no control is performed (because
1214    ## they are supposed to contain html and/or javascript).
1215    $param->{'htmlAllowedParam'} = {
1216        #'hidden_head'          => 1,
1217        #'hidden_end'           => 1,
1218        #'hidden_at'            => 1,
1219        'selected'             => 1,
1220        'logo_html_definition' => 1,
1221        'html_dumpvars'        => 1,
1222        'html_editor_init'     => 1,
1223        'html_content'         => 1,
1224    };
1225    ## Hash defining the parameters where HTML must be filtered.
1226    $param->{'htmlToFilter'} = {
1227        'homepage_content' => 1,
1228        'info_content'     => 1,
1229    };
1230
1231    ## Change to list root
1232    unless (chdir $Conf::Conf{'home'}) {
1233        Sympa::WWW::Report::reject_report_web('intern', 'chdir_error', {},
1234            '', '', '', $robot);
1235        wwslog('info', 'Unable to change directory');
1236        exit -1;
1237    }
1238
1239    ## Sets the UMASK
1240    umask(oct($Conf::Conf{'umask'}));
1241
1242    ## Authentication
1243    ## use https client certificate information if define.
1244
1245    ## Default auth method (for scenarios)
1246    $param->{'auth_method'} = 'md5';
1247
1248    Sympa::WWW::Report::init_report_web();
1249
1250    ## Get PATH_INFO parameters
1251    get_parameters($robot);
1252
1253    # Propagate plugins parameters
1254    $param->{'plugin'} = $in{'plugin'};
1255
1256    $session = Sympa::WWW::Session->new(
1257        $robot,
1258        {   'cookie' =>
1259                Sympa::WWW::Session::get_session_cookie($ENV{'HTTP_COOKIE'}),
1260            'action' => $in{'action'},
1261            'rss'    => $rss,
1262            'ajax'   => $ajax
1263        }
1264    );
1265
1266    # Getting rid of the environment variable to make sure it won't be
1267    # affected to another anonymous session.
1268    undef $ENV{'HTTP_COOKIE'};
1269    unless (defined $session) {
1270        wwslog('info', 'Failed to create session');
1271        $session = Sympa::WWW::Session->new($robot, {});
1272    }
1273
1274    # Generate session-specific CSRF token
1275    if (not defined($session->{'csrftoken'})) {
1276        $session->{'csrftoken'} =
1277            Digest::MD5::md5_hex(sprintf("%d %d", time, rand 0xFFFFFFFF));
1278        wwslog('debug', "Session CSRF token: %s", $session->{'csrftoken'});
1279    }
1280
1281    $param->{'session'} = $session->as_hashref();
1282
1283    $log->{level} = $session->{'log_level'} if ($session->{'log_level'});
1284    $param->{'restore_email'} = $session->{'restore_email'};
1285    $param->{'dumpvars'}      = $session->{'dumpvars'};
1286    $param->{'csrftoken'}     = $session->{'csrftoken'};
1287
1288    ## RSS does not require user authentication
1289    unless ($rss) {
1290        if (    $Crypt::OpenSSL::X509::VERSION
1291            and $ENV{SSL_CLIENT_VERIFY}
1292            and $ENV{SSL_CLIENT_VERIFY} eq 'SUCCESS'
1293            and $in{'action'} ne 'sso_login') {
1294            # Get rfc822Name in X.509v3 subjectAltName, otherwise
1295            # emailAddress attribute in subject DN (the first one of either).
1296            # Note: Earlier efforts getting attribute such as MAIL, Email in
1297            # subject DN are no longer supported.
1298            my $x509 = eval {
1299                Crypt::OpenSSL::X509->new_from_string($ENV{SSL_CLIENT_CERT});
1300            };
1301            my $email = Sympa::Tools::Text::canonic_email($x509->email)
1302                if $x509 and Sympa::Tools::Text::valid_email($x509->email);
1303
1304            if ($email) {
1305                $param->{'user'}{'email'}    = $email;
1306                $session->{'email'}          = $email;
1307                $param->{'auth_method'}      = 'smime';
1308                $session->{'auth'}           = 'x509';
1309                $param->{'ssl_client_s_dn'}  = $x509->subject;
1310                $param->{'ssl_client_v_end'} = $x509->notAfter;
1311                $param->{'ssl_client_i_dn'}  = $x509->issuer;
1312                # Only with Apache+mod_ssl or lighttpd+mod_openssl.
1313                $param->{'ssl_cipher_usekeysize'} =
1314                    $ENV{SSL_CIPHER_USEKEYSIZE};
1315            }
1316        } elsif (($session->{'email'}) && ($session->{'email'} ne 'nobody')) {
1317            $param->{'user'}{'email'} = $session->{'email'};
1318        } elsif ($in{'ticket'} =~ /(S|P)T\-/) {
1319            # the request contain a CAS named ticket that use CAS ticket format
1320            #reset do_not_use_cas because this client probably use CAS
1321            delete $session->{'do_not_use_cas'};
1322
1323            # select the cas server that redirect the user to sympa and check
1324            # the ticket
1325            $log->syslog('notice',
1326                "CAS ticket is detected. in{'ticket'}=$in{'ticket'} checked_cas=$session->{'checked_cas'}"
1327            );
1328
1329            my $cas_id = '';
1330            if ($in{'checked_cas'} =~ /^(\d+)\,?/) {
1331                $cas_id = $1;
1332            } elsif ($session->{'checked_cas'} =~ /^(\d+)\,?/) {
1333                $cas_id = $1;
1334            }
1335            if ($cas_id ne '') {
1336
1337                my $ticket = $in{'ticket'};
1338                my $cas_server =
1339                    $Conf::Conf{'auth_services'}{$robot}[$cas_id]
1340                    {'cas_server'};
1341
1342                my $service_url = Sympa::WWW::Tools::get_my_url($robot);
1343                $service_url =~ s/[&;?]ticket=.+\z//;
1344
1345                my $net_id = $cas_server->validateST($service_url, $ticket);
1346
1347                if (defined $net_id) {    # the ticket is valid net-id
1348                    $log->syslog('notice', 'Login CAS OK server netid=%s',
1349                        $net_id);
1350                    $param->{'user'}{'email'} = lc(
1351                        Sympa::WWW::Auth::get_email_by_net_id(
1352                            $robot, $cas_id, {'uid' => $net_id}
1353                        )
1354                    );
1355                    $session->{'auth'}  = 'cas';
1356                    $session->{'email'} = $param->{user}{email};
1357
1358                    $session->{'cas_server'} = $cas_id;
1359
1360                } else {
1361                    $log->syslog('err', 'CAS ticket validation failed: %s',
1362                        AuthCAS::get_errors());
1363                }
1364            } else {
1365                $log->syslog('notice',
1366                    "Internal error while receiving a CAS ticket $session->{'checked_cas'} "
1367                );
1368            }
1369        } elsif ($Conf::Conf{'cas_number'}{$robot} > 0
1370            and $in{'action'} !~ /^(login|sso_login|wsdl)$/) {
1371            # some cas server are defined but no CAS ticket detected
1372            unless ($session->{'do_not_use_cas'}) {
1373                # user not taggued as not using cas
1374                foreach
1375                    my $auth_service (@{$Conf::Conf{'auth_services'}{$robot}})
1376                {
1377                    # skip auth services not related to cas
1378                    next
1379                        unless ($auth_service->{'auth_type'} eq 'cas');
1380                    next
1381                        unless (
1382                        $auth_service->{'non_blocking_redirection'} eq 'on');
1383
1384                    ## skip cas server where client as been already redirect
1385                    ## to the list of cas servers already checked is stored in
1386                    ## the session
1387                    ## the check below works fine as long as we
1388                    ## don't have more then 10 CAS servers (because we don't
1389                    ## properly split the list of values)
1390                    $log->syslog('debug',
1391                        "check_cas checker_cas : $session->{'checked_cas'} current cas_id $Conf::Conf{'cas_id'}{$robot}{$auth_service->{'auth_service_name'}}{'casnum'}"
1392                    );
1393                    next
1394                        if ($session->{'checked_cas'} =~
1395                        /$Conf::Conf{'cas_id'}{$robot}{$auth_service->{'auth_service_name'}}{'casnum'}/
1396                        );
1397
1398                    # before redirect update the list of already checked cas
1399                    # server to prevent loop
1400                    my $cas_server = $auth_service->{'cas_server'};
1401                    my $return_url = Sympa::WWW::Tools::get_my_url($robot);
1402
1403                    ## Append the current CAS server ID to the list of checked
1404                    ## CAS servers
1405                    $session->{'checked_cas'} .=
1406                        $Conf::Conf{'cas_id'}{$robot}
1407                        {$auth_service->{'auth_service_name'}}{'casnum'};
1408
1409                    my $redirect_url =
1410                        $cas_server->getServerLoginGatewayURL($return_url);
1411
1412                    if ($redirect_url =~ /http(s)+\:\//i) {
1413                        $in{'action'} = 'redirect';                #FIXME
1414                        $param->{'redirect_to'} = $redirect_url;
1415
1416                        last;
1417                    } elsif ($redirect_url == -1) {    # CAS server auth error
1418                        $log->syslog('notice',
1419                            "CAS server auth error $auth_service->{'auth_service_name'}"
1420                        );
1421                    } else {
1422                        $log->syslog('notice',
1423                            "Strange CAS ticket detected and validated check sympa code !"
1424                        );
1425                    }
1426                }
1427                # set do_not_use_cas because all cas servers have been checked
1428                # without success
1429                $session->{'do_not_use_cas'} = 1
1430                    unless ($param->{'redirect_to'} =~ /http(s)+\:\//i);
1431            }
1432        }
1433
1434        if ($param->{'user'}{'email'}) {
1435            if (Sympa::User::is_global_user($param->{'user'}{'email'})) {
1436                $param->{'user'} =
1437                    Sympa::User::get_global_user($param->{'user'}{'email'});
1438            }
1439
1440            ## For the parser to display an empty field instead of [xxx]
1441            $param->{'user'}{'gecos'} ||= '';
1442            unless (defined $param->{'user'}{'cookie_delay'}) {
1443                $param->{'user'}{'cookie_delay'} =
1444                    $Conf::Conf{'cookie_expire'};
1445            }
1446        }
1447    }    # END unless ($rss)
1448
1449    ## Action
1450    my $action = $in{'action'};
1451    # Resolve alias.
1452    $action = $comm_aliases{$action}
1453        while $action
1454        and exists $comm_aliases{$action};
1455
1456    # Store current action in the session in order to redirect after a login
1457    # or other temporary actions.
1458    # - We should not memorize URLs that are transitory actions.
1459    # - POST is not handled.
1460    # - Embedded images in archive should be ignored.
1461    # - A lot of other methods where used in the past (before session was
1462    #   introduced in Sympa). We must clean all.
1463    # N.B.: Location to where redirect should respect local authority.
1464    if (not $temporary_actions{$action}
1465        and $ENV{'REQUEST_METHOD'} eq 'GET') {
1466        my $arc_file = $in{'arc_file'} // '';
1467        unless (
1468            $action eq 'arc'
1469            and not($arc_file eq ''
1470                or $arc_file =~ m{/\z}
1471                or $arc_file =~ m{\A(?:mail|msg|thrd)\d+[.]html\z})
1472        ) {
1473            my $redirect_url =
1474                Sympa::WWW::Tools::get_my_url($robot, authority => 'local');
1475            $redirect_url =~ s/[?].*\z//;
1476            $session->{'redirect_url'} = $redirect_url;
1477        }
1478    }
1479
1480    $action ||= Conf::get_robot_conf($robot, 'default_home');
1481    $param->{'remote_addr'}     = $ENV{'REMOTE_ADDR'};
1482    $param->{'remote_host'}     = $ENV{'REMOTE_HOST'};
1483    $param->{'http_user_agent'} = $ENV{'HTTP_USER_AGENT'};
1484
1485    $session->confirm_action($action, 'init');
1486
1487    #if ($in{'action'} eq 'css') {
1488    #    do_css();
1489    #    $param->{'action'} = 'css';
1490    #} elsif
1491    if ($maintenance_mode) {
1492        do_maintenance();
1493        $param->{'action'} = 'maintenance';
1494    } else {
1495        ## Session loop
1496        while ($action) {
1497            if (defined $in{'list'} and length $in{'list'}) {
1498                # Create a new Sympa::List instance.
1499                unless ($list = Sympa::List->new($in{'list'}, $robot)) {
1500                    wwslog('info', 'Unknown list "%s"', $in{'list'});
1501                    if ($action eq 'info') {
1502                        # To prevent sniffing lists, don't notice error to
1503                        # users.
1504                        $action =
1505                            Conf::get_robot_conf($robot, 'default_home');
1506                    } else {
1507                        Sympa::WWW::Report::reject_report_web('user',
1508                            'unknown_list', {listname => $in{'list'}},
1509                            $action, $list);
1510                        last;
1511                    }
1512                }
1513            }
1514
1515            check_param_in();
1516
1517            if (not $comm{$action} or _is_action_disabled($action)) {
1518                # Previously we searched the list using value of action here.
1519                # To prevent sniffing lists, we no longer do.
1520                Sympa::WWW::Report::reject_report_web('user',
1521                    'unknown_action', {}, $action, $list);
1522                wwslog('info', 'Unknown action %s', $action);
1523
1524                $action = Conf::get_robot_conf($robot, 'default_home');
1525                unless ($comm{$action}) {
1526                    unless ($action = prevent_visibility_bypass()) {
1527                        last;
1528                    }
1529                }
1530            }
1531
1532            $param->{'action'} = $action;
1533
1534            my $old_action    = $action;
1535            my $old_subaction = $in{'subaction'};
1536
1537            ## Check required action parameters
1538            my $check_output = check_action_parameters($action);
1539
1540            if (!defined $check_output) {
1541                wwslog('err', 'Missing required parameters for action "%s"',
1542                    $action);
1543                delete($param->{'action'});
1544                last;
1545
1546            } elsif ($check_output != 1) {
1547                ## The output of the check may indicate another action to run
1548                ## first
1549                ## Example : running loginrequest if user is not authenticated
1550                $action = $param->{'action'} = $check_output;
1551            }
1552
1553            ## Execute the action ##
1554            if (defined $action) {
1555                no strict 'refs';
1556                $action = $comm{$action}->();
1557            }
1558
1559            unless (defined $action) {
1560                unless ($action = prevent_visibility_bypass()) {
1561                    delete($param->{'action'});
1562                    last;
1563                } else {
1564                    Sympa::WWW::Report::reject_report_web('user',
1565                        'authorization_reject', {}, $param->{'action'}, '');
1566                }
1567            }
1568
1569            # after redirect do not send anything, it will crash fcgi lib
1570            last
1571                if ($action =~ /redirect/);
1572
1573            if ($action eq $old_action) {
1574                # if a subaction is define and change, then it is not a loop
1575                if (!defined($in{'subaction'})
1576                    || ($in{'subaction'} eq $old_subaction)) {
1577                    wwslog('info', 'Stopping loop with %s action', $action);
1578                    # The last resort. Never use default_home.
1579                    $action = 'home';
1580                }
1581            }
1582
1583            undef $action if ($action == 1);
1584        }
1585    }
1586
1587    ## Prepare outgoing params
1588    check_param_out();
1589
1590    ## Params
1591    $param->{'refparam'}    = ref($param);
1592    $param->{'action_type'} = $action_type{$param->{'action'}};
1593
1594    $param->{'action_type'} = 'none'
1595        unless (($param->{'is_priv'})
1596        || ($param->{'action_type'} eq 'serveradmin'));
1597
1598    #FIXME: is this block neccessary?
1599    unless ($param->{'lang'}) {
1600        my $user_lang = $param->{'user'}{'lang'} if $param->{'user'};
1601        $param->{'lang'} =
1602            $language->set_lang($user_lang, Sympa::best_language($robot));
1603        # compatibility: 6.1.
1604        $param->{'lang_tag'} = $param->{'lang'};
1605    }
1606
1607    if ($param->{'list'}) {
1608        $param->{'list_title'}      = $list->{'admin'}{'subject'};
1609        $param->{'title'}           = Sympa::get_address($list);
1610        $param->{'title_clear_txt'} = "$param->{'list'}";
1611
1612        if ($param->{'subtitle'}) {
1613            $param->{'main_title'} =
1614                "$param->{'list'} - $param->{'subtitle'}";
1615        }
1616    } else {
1617        $param->{'main_title'} = $param->{'title'} =
1618            Conf::get_robot_conf($robot, 'title');
1619        $param->{'title_clear_txt'} = $param->{'title'};
1620    }
1621
1622    $param->{'is_user_allowed_to'} = sub {
1623        my $function = shift;
1624        my $list     = shift;
1625        return 0 unless $function and $list;
1626
1627        $list = Sympa::List->new($list, $robot)
1628            unless ref $list eq 'Sympa::List';
1629
1630        return 0
1631            if $function eq 'subscribe'
1632            and $param->{'user'}{'email'}
1633            and $list->is_list_member($param->{'user'}{'email'});
1634
1635        my $result = Sympa::Scenario->new($list, $function)->authz(
1636            $param->{'auth_method'},
1637            {   'sender'      => $param->{'user'}{'email'},
1638                'remote_host' => $param->{'remote_host'},
1639                'remote_addr' => $param->{'remote_addr'}
1640            }
1641        );
1642        return 0 unless ref $result eq 'HASH';
1643        return 0 if $result->{action} =~ /\Areject\b/i;
1644        return 1;
1645    };
1646
1647    ## store in session table this session contexte
1648    $session->store();
1649
1650    # Do not manage cookies at this level if content was already sent.
1651    unless ($param->{'bypass'} eq 'extreme'
1652        or $maintenance_mode
1653        or $rss
1654        or $ajax) {
1655        $session->renew unless $param->{'use_ssl'};
1656
1657        $session->set_cookie($cookie_domain, $param->{'user'}{'cookie_delay'},
1658            $param->{'use_ssl'});
1659
1660        if ($param->{'user'}{'email'}) {
1661            $session->{'auth'} ||= 'classic';
1662        }
1663    }
1664
1665    ## Available languages
1666    $param->{'languages'} = {};
1667    $language->push_lang;
1668    foreach my $lang (Sympa::get_supported_languages($robot)) {
1669        next unless $lang = $language->set_lang($lang);
1670        $param->{'languages'}{$lang} = {};
1671    }
1672    if (my $lang = $language->set_lang($param->{'lang'})) {    #current lang
1673        $param->{'languages'}{$lang}{'selected'} = 'selected="selected"';
1674    }
1675    $language->pop_lang;
1676
1677    $param->{'html_dumpvars'} = Sympa::Tools::Data::dump_html_var($param)
1678        if $session->{'dumpvars'};
1679
1680    # if bypass is defined select the content-type from various vars
1681    if ($param->{'bypass'}) {
1682
1683        ## if bypass = 'extreme' leave the action send the content-type and
1684        ## the content itself
1685        unless ($param->{'bypass'} eq 'extreme') {
1686
1687            ## if bypass = 'asis', file content-type is in the file itself as is define by the action in $param->{'content_type'};
1688            unless ($param->{'bypass'} eq 'asis') {
1689                my $type =
1690                       $param->{'content_type'}
1691                    || Conf::get_mime_type($param->{'file_extension'})
1692                    || 'application/octet-stream';
1693                printf "Content-Type: %s\n\n", $type;
1694            }
1695
1696            #  $param->{'file'} or $param->{'error'} must be define in this case.
1697
1698            if (open(FILE, $param->{'file'})) {
1699                print <FILE>;
1700                close FILE;
1701            } elsif (Sympa::WWW::Report::is_there_any_reject_report_web()) {
1702                ## for compatibility : it could be better
1703                my $intern = Sympa::WWW::Report::get_intern_error_web();
1704                my $system = Sympa::WWW::Report::get_system_error_web();
1705                my $user   = Sympa::WWW::Report::get_user_error_web();
1706                my $auth   = Sympa::WWW::Report::get_auth_reject_web();
1707
1708                if (ref($intern) eq 'ARRAY') {
1709                    print "INTERNAL SERVER ERROR\n";
1710                }
1711                if (ref($system) eq 'ARRAY') {
1712                    print "SYSTEM ERROR\n";
1713                }
1714                if (ref($user) eq 'ARRAY') {
1715                    foreach my $err (@$user) {
1716                        printf "ERROR : %s\n", $err;
1717                    }
1718                }
1719                if (ref($auth) eq 'ARRAY') {
1720                    foreach my $err (@$auth) {
1721                        printf "AUTHORIZATION FAILED : %s\n", $err;
1722                    }
1723                }
1724
1725            } else {
1726                print "Internal error content-type nor file defined\n";
1727                $log->syslog('err',
1728                    'Internal error content-type nor file defined');
1729            }
1730        }
1731
1732    } elsif ($rss) {
1733        ## Send RSS
1734        print "Cache-control: no-cache\n";
1735        print "Content-Type: application/rss+xml; charset=utf-8\n\n";
1736
1737        ## Icons
1738        $param->{'icons_url'} =
1739            Conf::get_robot_conf($robot, 'static_content_url') . '/icons';
1740
1741        ## Retro compatibility concerns
1742        $param->{'active'} = 1;
1743
1744        if (defined $list) {
1745            #FIXME: Not used by default.
1746            $param->{'list_conf'} = $list->{'admin'};
1747        }
1748
1749        my $template = Sympa::Template->new(
1750            $list || $robot,
1751            subdir       => 'web_tt2',
1752            lang         => $param->{'lang'},
1753            include_path => [@other_include_path]
1754        );
1755        unless ($template->parse($param, 'rss.tt2', \*STDOUT)) {
1756            my $error = $template->{last_error};
1757            $error = $error->as_string if ref $error;
1758            $param->{'tt2_error'} = $error;
1759
1760            Sympa::send_notify_to_listmaster($robot, 'web_tt2_error',
1761                [$error]);
1762            wwslog('err', '/rss: error: %s', $error);
1763            printf STDOUT "\n<!-- %s -->\n",
1764                Sympa::Tools::Text::encode_html($error);
1765        }
1766    } elsif ($ajax) {
1767        print "Cache-control: no-cache\n";
1768        print "Content-Type: text/html; charset=utf-8\n\n";
1769
1770        ## Icons
1771        $param->{'icons_url'} =
1772            Conf::get_robot_conf($robot, 'static_content_url') . '/icons';
1773
1774        ## Retro compatibility concerns
1775        $param->{'active'} = 1;
1776
1777        if (defined $list) {
1778            #FIXME: Probably not used by default.
1779            $param->{'list_conf'} = $list->{'admin'};
1780        }
1781
1782        # XSS escaping applied to all outgoing parameters.
1783        # Escape parameters on a copy to avoid altering useful data.
1784        my $param_copy = Sympa::Tools::Data::dup_var($param);
1785        if (defined $param_copy) {
1786            unless (
1787                Sympa::HTMLSanitizer->new($robot)->sanitize_var(
1788                    $param_copy,
1789                    'htmlAllowedParam' => $param_copy->{'htmlAllowedParam'},
1790                    'htmlToFilter'     => $param_copy->{'htmlToFilter'},
1791                )
1792            ) {
1793                $log->syslog('err', 'Failed to sanitize $param in host %s',
1794                    $robot);
1795            }
1796        }
1797
1798        my $template = Sympa::Template->new(
1799            $list || $robot,
1800            subdir       => 'web_tt2',
1801            lang         => $param->{'lang'},
1802            include_path => [@other_include_path]
1803        );
1804        # Reset additional settings.
1805        undef $allow_absolute_path;
1806        @other_include_path = ();
1807
1808        unless ($template->parse($param_copy, 'ajax.tt2', \*STDOUT)) {
1809            my $error = $template->{last_error};
1810            $error = $error->as_string if ref $error;
1811            $param->{'tt2_error'} = $error;
1812
1813            Sympa::send_notify_to_listmaster($robot, 'web_tt2_error',
1814                [$error]);
1815            wwslog('err', '/ajax/%s: error: %s', $param->{'action'}, $error);
1816            printf "\n<!-- %s -->\n", Sympa::Tools::Text::encode_html($error);
1817        }
1818        # close FILE;
1819    } elsif ($param->{'redirect_to'}) {
1820        $log->syslog('notice', 'Redirecting to %s', $param->{'redirect_to'});
1821        _redirect($param->{'redirect_to'});
1822    } else {
1823        prepare_report_user();
1824        send_html('main.tt2');
1825    }
1826
1827    # Exit if wwsympa.fcgi itself has changed.
1828    if (defined $birthday) {
1829        my $age = [stat $PROGRAM_NAME]->[9];
1830        if (defined $age and $birthday != $age) {
1831            $log->syslog(
1832                'notice',
1833                'Exiting because %s has changed since FastCGI server started',
1834                $PROGRAM_NAME
1835            );
1836            exit(0);
1837        }
1838    }
1839
1840}
1841
1842# Purge grouped notifications
1843Sympa::Spool::Listmaster->instance->flush(purge => 1);
1844
1845##############################################################
1846#-#\#|#/#-#\#|#/#-#\#|#/#-#\#|#/#-#\#|#/#-#\#|#/#-#\#|#/#-#\#|#/
1847##############################################################
1848
1849## Write to log
1850sub wwslog {
1851    my $facility = shift;
1852
1853    my $msg    = shift;
1854    my $remote = $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'};
1855    my $wwsmsg = '';
1856
1857    $wwsmsg = "[list $param->{'list'}] " . $wwsmsg
1858        if $param->{'list'};
1859
1860    $wwsmsg = "[user $param->{'user'}{'email'}] " . $wwsmsg
1861        if $param->{'user'}{'email'};
1862
1863    $wwsmsg = "[rss] " . $wwsmsg
1864        if $rss;
1865
1866    $wwsmsg = "[client $remote] " . $wwsmsg
1867        if $remote;
1868
1869    $wwsmsg = "[session $session->{'id_session'}] " . $wwsmsg
1870        if $session;
1871
1872    $wwsmsg = "[robot $robot] " . $wwsmsg;
1873
1874    push @_, $wwsmsg;
1875    if ($msg =~ /^([(][^)]*[)])\s*(.*)/s) {
1876        $msg = sprintf '%s %%%d$s%s', $1, scalar(@_), $2;
1877    } else {
1878        $msg = sprintf '%%%d$s%s', scalar(@_), $msg;
1879    }
1880
1881    # Don't push caller stack.  Note that goto statement requires "&" prefix!
1882    unshift @_, $log, $facility, $msg;
1883    goto &Sympa::Log::syslog;
1884}
1885
1886sub web_db_log {
1887    my $data = shift;
1888
1889    my %options = %{$data || {}};
1890
1891    $options{'client'} = $param->{'remote_addr'};
1892    $options{'daemon'} = 'wwsympa';
1893    $options{'robot'}      ||= $robot;
1894    $options{'list'}       ||= $list->{'name'} if ref $list eq 'Sympa::List';
1895    $options{'action'}     ||= $param->{'action'};
1896    $options{'user_email'} ||= $param->{'user'}{'email'}
1897        if defined $param->{'user'};
1898    # Default email is the user email
1899    $options{'target_email'} ||= $options{'user_email'};
1900
1901    unless ($log->db_log(%options)) {
1902        wwslog('err', 'Failed to log in database');
1903        return undef;
1904    }
1905
1906    return 1;
1907}
1908
1909###################################
1910# log in stat_table via web interface
1911sub web_db_stat_log {
1912    my %options = @_;
1913
1914    $options{'mail'} ||= $param->{'user'}{'email'}
1915        if defined $param->{'user'};
1916    $options{'operation'} ||= $param->{'action'};
1917    $options{'list'} ||= $list->{'name'} if ref $list eq 'Sympa::List';
1918    $options{'daemon'} = 'wwsympa';
1919    $options{'client'} = $param->{'remote_addr'};
1920    $options{'robot'} ||= $robot;
1921
1922    unless ($log->add_stat(%options)) {
1923        wwslog('err', 'Failed to log in database');
1924        return undef;
1925    }
1926    return 1;
1927}
1928
1929####################################
1930sub _crash_handler {
1931    my ($mess, $longmess) = @_;
1932
1933    $param->{'traceback'}     = $longmess;
1934    $param->{'error_message'} = $mess;
1935    $param->{'main_title'} ||= Conf::get_robot_conf($robot, 'title');
1936    $param->{'last_action'} = $param->{'action'};
1937    $param->{'action'}      = 'crash';
1938    eval { send_html('crash.tt2'); };
1939    print "\n\n";    # when tt2 failed to parse
1940    exit 0;
1941}
1942
1943# No longer used.
1944#sub new_loop;
1945
1946# DEPRECATED.  Use Sympa::WWW::Tools::get_server_name() or
1947# Sympa::WWW::Tools::get_http_host().
1948#sub get_header_field;
1949
1950# _split_params is used by get_parameters to split path info in the
1951# appropriate parameters list.
1952# It is used also by action ticket to prepare the context stored in the
1953# one_time_ticket table in string like path_info
1954# input ENV{'PATH_INFO'} like string, output in the global $param hash
1955sub _split_params {
1956    my $args_string = shift;
1957
1958    $args_string =~ s+^/++;
1959
1960    my $ending_slash = 0;
1961    if ($args_string =~ /\/$/) {
1962        $ending_slash = 1;
1963    }
1964
1965    my @params = split /\//, $args_string;
1966
1967    if ($params[0] eq 'nomenu') {
1968        $param->{'nomenu'} = 1;
1969        shift @params;
1970    }
1971
1972    ## debug mode
1973    if ($params[0] =~ /debug(\d)?/) {
1974        shift @params;
1975        if ($1) {
1976            $main::options{'debug_level'} = $1 if ($1);
1977        } else {
1978            $main::options{'debug_level'} = 1;
1979        }
1980    } else {
1981        $main::options{'debug_level'} = 0;
1982    }
1983    $log->syslog('debug2', 'Debug level %s', $main::options{'debug_level'});
1984
1985    ## rss mode
1986    if ($params[0] eq 'rss') {
1987        shift @params;
1988        $rss = 1;
1989    }
1990
1991    ## ajax mode
1992    if ($params[0] eq 'ajax') {
1993        shift @params;
1994        $ajax = 1;
1995    }
1996
1997    if ($#params >= 0) {
1998        $in{'action'} = $params[0];
1999        my $args;
2000        if (defined $action_args{$in{'action'}}) {
2001            $args = $action_args{$in{'action'}};
2002        } else {
2003            $args = $action_args{'default'};
2004        }
2005
2006        my $i = 1;
2007        foreach my $p (@$args) {
2008            my $pname;
2009            ## More than 1 param
2010            if ($p =~ /^\@(\w+)$/) {
2011                $pname = $1;
2012                $in{$pname} = join '/', @params[$i .. $#params];
2013                $in{$pname} .= '/' if $ending_slash;
2014                last;
2015            } else {
2016                $pname = $p;
2017                $in{$pname} = $params[$i];
2018            }
2019            wwslog('debug', 'Incoming parameter: %s=%s', $pname, $in{$pname});
2020            $i++;
2021        }
2022    }
2023}
2024
2025sub get_parameters {
2026    my $robot = shift;
2027
2028    $param->{'path_info'} = $ENV{'PATH_INFO'};
2029    # Useful to skip previous_action when using POST.
2030    $param->{'http_method'} = $ENV{'REQUEST_METHOD'};
2031
2032    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
2033        _split_params($ENV{'PATH_INFO'});
2034    } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
2035        ## POST
2036
2037        if ($in{'javascript_action'}) {
2038            ## because of incompatibility javascript
2039            $in{'action'} = $in{'javascript_action'};
2040        }
2041        foreach my $p (keys %in) {
2042            $log->syslog('debug2', 'POST key %s value %s', $p, $in{$p})
2043                unless ($p =~ /passwd/);
2044            if ($p =~ /^((\w*)action)_(\w+)((\.\w+)*)$/) {
2045                # Getting $in{'action'}, $in{'response_action'} etc.
2046                $in{$1} = $3;
2047                if ($4) {
2048                    foreach my $v (split /\./, $4) {
2049                        $v =~ s/^\.?(\w+)\.?/$1/;
2050                        $in{$v} = 1;
2051                    }
2052                }
2053                undef $in{$p};
2054            }
2055        }
2056        $param->{'nomenu'} = $in{'nomenu'};
2057    }
2058
2059    # Compatibility to the templates customized for version <=6.2.60:
2060    # 'blacklist' was renamed to 'blocklist'.
2061    $in{'blocklist'} //= $in{'blacklist'} if defined $in{'blacklist'};
2062
2063    # From CGI URL get {base_url} and {path_cgi} parameters.
2064    # Note that other links should keep the nomenu attribute.
2065    # NOTE: The base_url is kept for compatibility to Sympa < 6.2.15.  The
2066    # path_cgi is still used in archives, help etc.
2067    my $uri =
2068        URI->new(Sympa::get_url($robot, undef, nomenu => $param->{'nomenu'}));
2069    $param->{'base_url'} = $uri->scheme . '://' . $uri->authority
2070        if $uri->authority;
2071    $param->{'path_cgi'} = $uri->path;
2072
2073    # mod_ssl sets SSL_PROTOCOL; Apache-SSL sets SSL_PROTOCOL_VERSION.
2074    $param->{'use_ssl'} = ($ENV{HTTPS} && $ENV{HTTPS} eq 'on');
2075
2076    ## Lowercase email addresses
2077    $in{'email'} = lc($in{'email'});
2078
2079    ## Don't get multiple listnames
2080    if ($in{'list'}) {
2081        my @lists = split /\0/, $in{'list'};
2082        $in{'list'} = $lists[0];
2083    }
2084
2085    my $custom_attribute;
2086    my $custom_input;
2087    my $plugin = {};
2088
2089    ## Check parameters format
2090    foreach my $p (keys %in) {
2091
2092        ## Skip empty parameters
2093        next if ($in{$p} =~ /^$/);
2094
2095        ## Remove DOS linefeeds (^M) that cause problems with Outlook 98, AOL,
2096        ## and EIMS:
2097        $in{$p} =~ s/\r\n|\r/\n/g;
2098
2099        #XXX## Convert from the web encoding to unicode string
2100        #XXX$in{$p} = Encode::decode('utf8', $in{$p});
2101
2102        my @tokens = split(/\./, $p);
2103        my $pname = $tokens[0];
2104
2105        ## Regular expressions applied on parameters
2106
2107        my $regexp;
2108        if ($pname =~ /^additional_field/) {
2109            $regexp = $in_regexp{'additional_field'};
2110        } elsif ($pname =~ /^custom_attribute(.*)$/) {
2111            my $key = $tokens[1];
2112            $regexp = $in_regexp{'custom_attribute'};
2113            # $log->syslog('debug2', '() (%s)(%s) %s %s %s', $p, $key, $name,
2114            #     $in{$p}, $Conf::Conf{$key}->{type});
2115            $custom_attribute->{$key} = {value => $in{$p}};
2116            undef $in{$p};
2117        } elsif ($pname eq 'plugin' and $#tokens >= 2) {
2118            my $plugin_name = $tokens[1];
2119            my $param_name  = $tokens[2];
2120            $regexp = $in_regexp{'plugin'};
2121            $plugin->{$plugin_name} = {}
2122                unless defined $plugin->{$plugin_name};
2123            $plugin->{$plugin_name}{$param_name} = $in{$p};
2124            undef $in{$p};
2125        } elsif ($pname eq 'custom_input') {
2126            my $key = $tokens[1];
2127            $regexp = $in_regexp{'custom_input'};
2128            $log->syslog('debug2', '(%s) %s', $p, $in{$p});
2129            $custom_input ||= {};
2130            $custom_input->{$key} = $in{$p};
2131            undef $in{$p};
2132        } elsif ($in_regexp{$pname}) {
2133            $regexp = $in_regexp{$pname};
2134        } else {
2135            $regexp = $in_regexp{'*'};
2136        }
2137
2138        my $negative_regexp;
2139        if ($pname =~ /^additional_field/) {
2140            $negative_regexp = $in_negative_regexp{'additional_field'};
2141        } elsif ($in_negative_regexp{$pname}) {
2142            $negative_regexp = $in_negative_regexp{$pname};
2143        }
2144
2145        # If we are editing an HTML file in the shared, allow HTML but prevent
2146        # XSS.
2147        if (   $pname eq 'content'
2148            && $in{'action'} eq 'd_update'
2149            && $in{'path'} =~ $list->{'dir'} . '/shared'
2150            && lc($in{'path'}) =~ /\.html?/) {
2151            my $tmpparam = $in{$p};
2152            $tmpparam =
2153                Sympa::HTMLSanitizer->new($robot)->sanitize_html($in{$p});
2154            if (defined $tmpparam) {
2155                $in{$p} = $tmpparam;
2156            } else {
2157                $log->syslog('err', 'Unable to sanitize parameter %s',
2158                    $pname);
2159            }
2160        }
2161        foreach my $one_p (split /\0/, $in{$p}) {
2162            if ($one_p !~ /^$regexp$/s
2163                || (defined $negative_regexp && $one_p =~ /$negative_regexp/s)
2164            ) {
2165                Sympa::WWW::Report::reject_report_web('user', 'syntax_errors',
2166                    {p_name => $p},
2167                    '', '');
2168                wwslog(
2169                    'err',
2170                    'Syntax error for parameter %s value "%s" not conform to regexp:%s',
2171                    $pname,
2172                    $one_p,
2173                    $regexp
2174                );
2175                $in{$p} = '';
2176                last;
2177            }
2178        }
2179    }
2180
2181    $in{custom_attribute} = $custom_attribute;
2182    $in{custom_input}     = $custom_input if $custom_input;
2183    $in{plugin}           = $plugin;
2184
2185    return 1;
2186}
2187
2188# NO LONGER USED.
2189#sub get_parameters_old;
2190
2191## Check required parameters for an action
2192## It compares incoming parameter to those declared as required in
2193## %required_args
2194## Also check required privileges to perform each action
2195sub check_action_parameters {
2196    my $action = shift;
2197
2198    if (defined $required_args{$action}) {
2199        foreach my $arg_name (@{$required_args{$action}}) {
2200
2201            ## Missing list parameter
2202            if ($arg_name eq 'param.list') {
2203                unless (defined $list) {
2204                    Sympa::WWW::Report::reject_report_web('user',
2205                        'missing_arg', {'argument' => 'list'}, $action);
2206                    wwslog('info', 'Missing list parameter');
2207                    web_db_log(
2208                        {   'status'     => 'error',
2209                            'error_type' => 'no_list'
2210                        }
2211                    );
2212
2213                    return undef;
2214                }
2215
2216                ## User is not authenticated
2217            } elsif ($arg_name eq 'param.user.email') {
2218                unless ($param->{'user'} and $param->{'user'}{'email'}) {
2219                    if (prevent_visibility_bypass()) {
2220                        Sympa::WWW::Report::reject_report_web('user',
2221                            'authorization_reject', {}, $param->{'action'},
2222                            '');
2223                    } else {
2224                        Sympa::WWW::Report::reject_report_web('user',
2225                            'no_user', {}, $action);
2226                    }
2227                    wwslog('err', 'User not logged in');
2228                    web_db_log(
2229                        {   'status'     => 'error',
2230                            'error_type' => "not_logged_in"
2231                        }
2232                    );
2233
2234                    # User is redirected to the login request form.
2235                    # Once logged in, they will be redirected to the URL in
2236                    # $session->{'redirect_url'}.
2237                    delete $in{'submit'};    # Clear it.
2238                    return 'login';
2239                }
2240                ## Other incoming parameters
2241            } else {
2242                ## There may be alternate parameters
2243                ## Then at least one of them MUST be set
2244                my @req_parameters = split(/\|/, $arg_name);
2245                my $ok = 0;
2246                foreach my $req_param (@req_parameters) {
2247                    $ok = 1 if ($in{$req_param});
2248                }
2249                unless ($ok) {
2250                    ## Replace \0 and '|' with ',' before logging
2251                    $in{$arg_name} =~ s/\0/,/g;
2252                    $in{$arg_name} =~ s/\|/,/g;
2253
2254                    if (prevent_visibility_bypass()) {
2255                        Sympa::WWW::Report::reject_report_web('user',
2256                            'authorization_reject', {'list' => $in{'list'}},
2257                            $param->{'action'}, '');
2258                    }
2259                    Sympa::WWW::Report::reject_report_web('user',
2260                        'missing_arg', {'argument' => $arg_name}, $action);
2261                    wwslog('info', 'Missing parameter "%s"', $arg_name);
2262                    web_db_log(
2263                        {   'status'     => 'error',
2264                            'error_type' => 'missing_parameter'
2265                        }
2266                    );
2267                    delete $param->{'list'};
2268                    return undef;
2269                }
2270            }
2271        }
2272    }
2273
2274    ## Validate CSRF token when one is required
2275    if (defined($require_csrftoken{$param->{'action'}})) {
2276        wwslog('debug', 'Action %s: CSRF token required', $param->{'action'});
2277
2278        unless (defined($in{'csrftoken'})
2279            and ($in{'csrftoken'} eq $session->{'csrftoken'})) {
2280            Sympa::WWW::Report::reject_report_web('user',
2281                'authorization_reject', {'list' => $in{'list'}},
2282                $param->{'action'}, '');
2283
2284            wwslog('info', 'CSRF token mismatch: in="%s" session="%s"',
2285                $in{'csrftoken'}, $session->{'csrftoken'});
2286            web_db_log(
2287                {   'status'     => 'error',
2288                    'error_type' => 'authorization'
2289                }
2290            );
2291            delete $param->{'list'};
2292            # invalidate the CSRF token so a new one will be generated
2293            delete $session->{'csrftoken'};
2294            return undef;
2295        }
2296    }
2297
2298    ## Check required privileges
2299    if (defined $required_privileges{$action}) {
2300        ## There may be alternate privileges
2301        ## Then at least one of them MUST verified
2302        my $ok = 0;
2303        my $missing_priv;
2304        foreach my $req_priv (@{$required_privileges{$action}}) {
2305            $ok = 1 if ($param->{'is_' . $req_priv});
2306            $missing_priv = $req_priv;
2307        }
2308        unless ($ok) {
2309            Sympa::WWW::Report::reject_report_web('auth',
2310                'action_' . $missing_priv,
2311                {}, $param->{'action'}, $list);
2312            wwslog('info', 'Authorization failed, insufficient privileges');
2313            web_db_log(
2314                {   'status'     => 'error',
2315                    'error_type' => 'authorization'
2316                }
2317            );
2318            delete $param->{'list'};
2319            return undef;
2320        }
2321    }
2322
2323    return 1;
2324}
2325
2326## Send HTML output
2327sub send_html {
2328    my $tt2_file = shift;
2329
2330    ## Send HTML headers
2331    if ($param->{'date'}) {
2332        printf "Date: %s\n",
2333            DateTime->now->strftime("%a, %{day} %b %Y %H:%M:%S GMT");
2334    }
2335    ## If we set the header indicating the last time the file to send was
2336    ## modified, add an HTTP header (limitate web harvesting).
2337    if ($param->{'header_date'}) {
2338        printf "Last-Modified: %s\n",
2339            DateTime->from_epoch(epoch => $param->{'header_date'})
2340            ->strftime("%a, %{day} %b %Y %H:%M:%S GMT");
2341    }
2342    print "Cache-control: max-age=0\n" unless $param->{'action'} eq 'arc';
2343    print "Content-Type: text/html; charset=utf-8\n";
2344    ## Workaround for Internet Explorer 8 or later.
2345    print "X-UA-Compatible: IE=100\n";
2346
2347    ## Notify crash to client.
2348    if ($param->{'action'} eq 'crash') {
2349        print "Status: 503 Service Unavailable\n";
2350        print "Retry-After: 300\n";
2351    }
2352
2353    ## Icons
2354    $param->{'icons_url'} =
2355        Conf::get_robot_conf($robot, 'static_content_url') . '/icons';
2356
2357    ## Retro compatibility concerns
2358    $param->{'active'} = 1;
2359
2360    ## undefined $list has been initialized to be hashref.
2361    if (ref $list eq 'HASH') {
2362        $log->syslog('notice',
2363            'Someone tried to access inside of List object directly.  Fix the codes'
2364        );
2365        local $Data::Dumper::Varname = 'list';
2366        local $Data::Dumper::Indent  = 0;
2367        $log->syslog('notice', '%s', Dumper($list));
2368        undef $list;
2369    }
2370
2371    if (ref $list eq 'Sympa::List') {
2372        $param->{'list_conf'} =
2373            Sympa::Tools::Data::clone_var($list->{'admin'});    #FIXME
2374        # Compat. < 6.2.32
2375        $param->{'list_conf'}{'host'} = $list->{'domain'};
2376    }
2377
2378    ## Trying to use custom_vars
2379    if (ref $list eq 'Sympa::List'
2380        and @{$list->{'admin'}{'custom_vars'} || []}) {
2381        foreach my $var (@{$list->{'admin'}{'custom_vars'}}) {
2382            $param->{'custom_vars'}{$var->{'name'}} = $var->{'value'};
2383        }
2384    }
2385
2386    # Main CSS, possiblly customized.
2387    my $main_css;
2388    if ($session->{'custom_css'}) {
2389        $main_css = Sympa::WWW::Tools::get_css_url(
2390            $robot,
2391            custom_css => {
2392                map { ($_ => $session->{$_}) }
2393                grep { /\Acolor_/ and $session->{$_} } keys %$session
2394            }
2395        );
2396        unless ($main_css) {
2397            wwslog('info', 'Error while parsing custom CSS');
2398            delete $session->{'custom_css'};
2399        }
2400    }
2401    $main_css ||= Sympa::WWW::Tools::get_css_url($robot);
2402    $param->{'main_css'} = $main_css;
2403
2404    # Per-locale CSS.
2405    $param->{'lang_css'} =
2406        Sympa::WWW::Tools::get_css_url($robot, lang => $param->{'lang'})
2407        if $param->{'lang'};
2408
2409    # XSS escaping applied to all outgoing parameters.
2410    ## Escape parameters on a copy to avoid altering useful data.
2411    my $param_copy = Sympa::Tools::Data::dup_var($param);
2412    if (defined $param_copy) {
2413        unless (
2414            Sympa::HTMLSanitizer->new($robot)->sanitize_var(
2415                $param_copy,
2416                'htmlAllowedParam' => $param_copy->{'htmlAllowedParam'},
2417                'htmlToFilter'     => $param_copy->{'htmlToFilter'},
2418            )
2419        ) {
2420            $log->syslog('err', 'Failed to sanitize $param in host %s',
2421                $robot);
2422        }
2423    }
2424
2425    # Now include locale paths (lang parameter).
2426    my $template = Sympa::Template->new(
2427        $list || $robot,
2428        allow_absolute => $allow_absolute_path,
2429        subdir         => 'web_tt2',
2430        lang           => $param->{'lang'},
2431        include_path   => [@other_include_path]
2432    );
2433    # Reset additional settings.
2434    undef $allow_absolute_path;
2435    @other_include_path = ();
2436
2437    # Then output the content.
2438    my $output = '';
2439    unless (
2440        $template->parse($param_copy, $tt2_file, \$output, has_header => 1)) {
2441        my $error = $template->{last_error};
2442
2443        if (    $param->{'action'} eq 'help'
2444            and ref $error
2445            and $error->type eq 'file') {
2446            # "Not Found" response for random help page.
2447            print "Status: 404 Not Found\n";
2448
2449            $error = $error->as_string;
2450        } else {
2451            $error = $error->as_string if ref $error;
2452
2453            Sympa::send_notify_to_listmaster($robot, 'web_tt2_error',
2454                [$error]);
2455            wwslog('err', '/%s: error: %s', $param->{'action'}, $error);
2456        }
2457
2458        my $error_escaped = Sympa::Tools::Text::encode_html($error);
2459        $param->{'tt2_error'}      = $error_escaped;
2460        $param_copy->{'tt2_error'} = $error_escaped;
2461        $output                    = '';
2462        $template->parse($param_copy, 'tt2_error.tt2', \$output,
2463            has_header => 1);
2464        $output .= "\n\n";    # when tt2 failed to parse
2465    }
2466
2467    # Insert CSRF token.
2468    if ($session->{'csrftoken'}) {
2469        my $csrf_field =
2470            sprintf '<input type="hidden" name="csrftoken" value="%s" />',
2471            $session->{'csrftoken'};
2472        $output =~ s{
2473            ( <form (?=\s) [^>]* \s method="post" (?=[\s>]) [^>]* > )
2474            ( .*? )
2475            ( </form> )
2476        }{
2477            my ($beg, $content, $end) = ($1, $2, $3);
2478            $content =~ s/( <fieldset (?=[\s>]) [^>]* > )/$1$csrf_field/ix
2479                or $content =~ s/\A/$csrf_field/;
2480            $beg . $content . $end;
2481        }egisx;
2482    }
2483    # Add autocomplete="off" to all forms unless explicitly enabled.
2484    $output =~ s{
2485        <form ( \s+ [^>]*? /? ) >
2486    }{
2487        my $attrs = $1;
2488        $attrs =~ s/(\s*\/?)\z/ autocomplete="off"$1/
2489            unless $attrs =~ /\sautocomplete="[^"]*"/i;
2490        "<form$attrs>";
2491    }egisx;
2492
2493    print $output;
2494}
2495
2496sub prepare_report_user {
2497    $param->{'intern_errors'} = Sympa::WWW::Report::get_intern_error_web();
2498    $param->{'system_errors'} = Sympa::WWW::Report::get_system_error_web();
2499    $param->{'user_errors'}   = Sympa::WWW::Report::get_user_error_web();
2500    $param->{'auth_rejects'}  = Sympa::WWW::Report::get_auth_reject_web();
2501    $param->{'notices'}       = Sympa::WWW::Report::get_notice_web();
2502    $param->{'errors'} = Sympa::WWW::Report::is_there_any_reject_report_web();
2503}
2504
2505#=head2 sub check_param_in
2506#
2507#Checks parameters contained in the global variable $in. It is the process used to analyze the incoming parameters.
2508#Use it just after List object is created and initialize output parameters.
2509#
2510#=head3 Arguments
2511#
2512#=over
2513#
2514#=item * I<None>
2515#
2516#=back
2517#
2518#=head3 Return
2519#
2520#=over
2521#
2522#=item C<1>
2523#
2524#=back
2525#
2526#=cut
2527
2528## Analysis of incoming parameters
2529sub check_param_in {
2530    wwslog('debug2', '');
2531
2532    # Restore last login info if any: See do_login() & do_sso_login().
2533    $param->{'last_login_epoch'} = delete $session->{'last_login_date'};
2534    $param->{'last_login_host'}  = delete $session->{'last_login_host'};
2535
2536    # listmaster has owner and editor privileges for the list.
2537    if (Sympa::is_listmaster($robot, $param->{'user'}{'email'})) {
2538        $param->{'is_listmaster'} = 1;
2539    }
2540
2541    unless (ref $list eq 'Sympa::List') {
2542        $param->{'domain'} = $robot;
2543        # Compat. < 6.2.32
2544        $param->{'host'} = $robot;
2545    } else {
2546        # Gather list configuration information for further output.
2547        $param->{'list'}   = $list->{'name'};
2548        $param->{'domain'} = $list->{'domain'};
2549        # Compat. < 6.2.32
2550        $param->{'host'} = $list->{'domain'};
2551
2552        $param->{'subtitle'}  = $list->{'admin'}{'subject'};
2553        $param->{'subscribe'} = $list->{'admin'}{'subscribe'}{'name'};
2554        #FIXME: Use Sympa::Scenario::get_current_title().
2555        $param->{'send'} =
2556            $list->{'admin'}{'send'}{'title'}{$param->{'lang'}};
2557
2558        # Pictures are not available unless it is configured for the list and
2559        # the robot
2560        if ($list->{'admin'}{'pictures_feature'} eq 'off') {
2561            $param->{'pictures_display'} = undef;
2562        } else {
2563            $param->{'pictures_display'} = 'on';
2564        }
2565
2566        ## Get the total number of subscribers to the list.
2567        if (defined $param->{'total'}) {
2568            $param->{'total'} = $list->get_total();
2569        } else {
2570            $param->{'total'} = $list->get_total('nocache');
2571        }
2572
2573        ## Check if the current list has a public key X.509 certificate.
2574        $param->{'list_as_x509_cert'} = $list->{'as_x509_cert'};
2575
2576        ## Stores to output the whole list's admin configuration.
2577        $param->{'listconf'} = $list->{'admin'};
2578
2579        ## If an user is logged in, checks this user's privileges.
2580        if ($param->{'user'}{'email'}) {
2581            $param->{'is_subscriber'} =
2582                $list->is_list_member($param->{'user'}{'email'});
2583            $param->{'subscriber'} =
2584                $list->get_list_member($param->{'user'}{'email'})
2585                if $param->{'is_subscriber'};
2586            $param->{'is_privileged_owner'} =
2587                $list->is_admin('privileged_owner', $param->{'user'}{'email'})
2588                || Sympa::is_listmaster($list, $param->{'user'}{'email'});
2589            $param->{'is_owner'} =
2590                $list->is_admin('owner', $param->{'user'}{'email'})
2591                || Sympa::is_listmaster($list, $param->{'user'}{'email'});
2592            $param->{'is_editor'} =
2593                $list->is_admin('actual_editor', $param->{'user'}{'email'});
2594            $param->{'is_priv'} = $param->{'is_owner'}
2595                || $param->{'is_editor'};
2596            $param->{'pictures_url'} =
2597                $list->find_picture_url($param->{'user'}{'email'});
2598
2599            ## Checks if the user can post in this list.
2600            my $result = Sympa::Scenario->new($list, 'send')->authz(
2601                $param->{'auth_method'},
2602                {   'sender'      => $param->{'user'}{'email'},
2603                    'remote_host' => $param->{'remote_host'},
2604                    'remote_addr' => $param->{'remote_addr'}
2605                }
2606            );
2607            my $r_action;
2608            $r_action = $result->{'action'} if (ref($result) eq 'HASH');
2609            $param->{'may_post'} = 1 if ($r_action !~ /reject/);
2610        } else {
2611            # If no user logged in, the output can ask for authentication.
2612            $param->{'user'}{'email'} = undef;
2613            $param->{'need_login'} = 1;
2614
2615        }
2616
2617        ## Check if this list's messages must be moderated.
2618        $param->{'is_moderated'} = $list->is_moderated();
2619
2620        # If the user logged in is a privileged user, gather information
2621        # relative to administration tasks.
2622        if ($param->{'is_priv'}) {
2623            $param->{'mod_message'} =
2624                Sympa::Spool::Moderation->new(context => $list)->size;
2625            $param->{'mod_subscription'} = Sympa::Spool::Auth->new(
2626                context => $list,
2627                action  => 'add'
2628            )->size;
2629            $param->{'mod_signoff'} = Sympa::Spool::Auth->new(
2630                context => $list,
2631                action  => 'del'
2632            )->size;
2633
2634            my $shared_doc = Sympa::WWW::SharedDocument->new($list);
2635            $param->{'mod_total_shared'} =
2636                $shared_doc->count_moderated_descendants;
2637
2638            if ($param->{'total'}) {
2639                $param->{'bounce_total'} = $list->get_total_bouncing();
2640                $param->{'bounce_rate'} =
2641                    $param->{'bounce_total'} * 100 / $param->{'total'};
2642                $param->{'bounce_rate'} =
2643                    int($param->{'bounce_rate'} * 10) / 10;
2644            } else {
2645                $param->{'bounce_rate'} = 0;
2646            }
2647            $param->{'mod_total'} =
2648                $param->{'mod_total_shared'} +
2649                $param->{'mod_message'} +
2650                $param->{'mod_subscription'};
2651        }
2652
2653        ## Check unsubscription authorization for the current user and list.
2654        my $result = Sympa::Scenario->new($list, 'unsubscribe')->authz(
2655            $param->{'auth_method'},
2656            {   'sender'      => $param->{'user'}{'email'},
2657                'remote_host' => $param->{'remote_host'},
2658                'remote_addr' => $param->{'remote_addr'}
2659            }
2660        );
2661        $main::action = $result->{'action'} if (ref($result) eq 'HASH');
2662
2663        if (!$param->{'user'}{'email'}) {
2664            $param->{'may_signoff'} = 1
2665                if ($main::action =~ /do_it|owner|request_auth/);
2666
2667        } elsif ($param->{'is_subscriber'}) {
2668            $param->{'may_signoff'} = 1
2669                if ($main::action =~ /do_it|owner|request_auth/);
2670            $param->{'may_suboptions'} = 1;
2671        }
2672
2673        ## Check subscription authorization for the current user and list.
2674        $result = Sympa::Scenario->new($list, 'subscribe')->authz(
2675            $param->{'auth_method'},
2676            {   'sender'      => $param->{'user'}{'email'},
2677                'remote_host' => $param->{'remote_host'},
2678                'remote_addr' => $param->{'remote_addr'}
2679            }
2680        );
2681        $main::action = $result->{'action'} if (ref($result) eq 'HASH');
2682
2683        $param->{'may_subscribe'} = 1
2684            if ($main::action =~ /do_it|owner|request_auth/);
2685
2686        # Check if the current user can read the shared documents.
2687        my $shared_doc = Sympa::WWW::SharedDocument->new($list);
2688        my %access     = $shared_doc->get_privileges(
2689            mode             => 'read',
2690            sender           => $param->{'user'}{'email'},
2691            auth_method      => $param->{'auth_method'},
2692            scenario_context => {
2693                sender      => $param->{'user'}{'email'},
2694                remote_host => $param->{'remote_host'},
2695                remote_addr => $param->{'remote_addr'}
2696            }
2697        );
2698        $param->{'may_d_read'} = $access{'may'}{'read'};
2699
2700        # Check the status (exists, deleted, doesn't exist) of the shared
2701        # directory.
2702        $param->{'shared'} = $shared_doc->{status};
2703    }
2704
2705    ## Check if the current user can create a list.
2706    my $result = Sympa::Scenario->new($robot, 'create_list')->authz(
2707        $param->{'auth_method'},
2708        {   'sender'      => $param->{'user'}{'email'},
2709            'remote_host' => $param->{'remote_host'},
2710            'remote_addr' => $param->{'remote_addr'}
2711        }
2712    );
2713    my $r_action;
2714    my $reason;
2715    if (ref($result) eq 'HASH') {
2716        $r_action = $result->{'action'};
2717        $reason   = $result->{'reason'};
2718    }
2719    $param->{'create_list_reason'} = $reason;
2720
2721    if ($param->{'user'}{'email'}
2722        && (($param->{'create_list'} = $r_action) =~ /do_it|listmaster/)) {
2723        $param->{'may_create_list'} = 1;
2724    } else {
2725        undef($param->{'may_create_list'});
2726    }
2727
2728    # Check if the current user can create automatic list.
2729    $param->{'may_create_automatic_list'} = {};
2730    my $automatic_list_families =
2731        Conf::get_robot_conf($robot, 'automatic_list_families');
2732    foreach my $key (keys %{$automatic_list_families || {}}) {
2733        my $family = Sympa::Family->new($key, $robot);
2734        next unless $family;
2735
2736        my $result =
2737            Sympa::Scenario->new($family->{'domain'},
2738            'automatic_list_creation')->authz(
2739            $param->{'auth_method'},
2740            {   'sender'             => $param->{'user'}{'email'},
2741                'message'            => undef,
2742                'family'             => $family,
2743                'automatic_listname' => '',
2744            }
2745            );
2746        my $r_action = $result->{'action'} if ref $result eq 'HASH';
2747        $param->{'may_create_automatic_list'}{$key} = 1
2748            if $r_action and $r_action =~ /do_it/;
2749    }
2750    # Compat. <= 6.2.22.
2751    $param->{'session'}{'is_family_owner'} =
2752        $param->{'may_create_automatic_list'};
2753
2754    # Set best content language.
2755    my $user_lang = $param->{'user'}{'lang'} if $param->{'user'};
2756    my $lang_context = (ref $list eq 'Sympa::List') ? $list : $robot;
2757    $param->{'lang'} =
2758        $language->set_lang($session->{'lang'}, $user_lang,
2759        Sympa::best_language($lang_context));
2760    # compatibility concern: old-style locale.
2761    $param->{'locale'} =
2762        Sympa::Language::lang2oldlocale($param->{'lang'});
2763    # compatibility concern: for 6.1.
2764    $param->{'lang_tag'} = $param->{'lang'};
2765
2766    export_topics($robot);
2767
2768    return 1;
2769}
2770
2771## Prepare outgoing params
2772sub check_param_out {
2773    wwslog('debug2', '');
2774
2775    $param->{'loop_count'} = $loop_count;
2776    $param->{'start_time'} =
2777        $language->gettext_strftime("%d %b %Y at %H:%M:%S",
2778        localtime $start_time);
2779    $param->{'process_id'} = $PID;
2780
2781    ## listmaster has owner and editor privileges for the list
2782    if (Sympa::is_listmaster($robot, $param->{'user'}{'email'})) {
2783        $param->{'is_listmaster'} = 1;
2784    } else {
2785        undef $param->{'is_listmaster'};
2786    }
2787
2788    ## Reset $list variable if it is not expected for the current action
2789    ## To prevent the list panel from being printed in a non list context
2790    ## Only check if the corresponding entry exists in %action_args
2791    if (   defined $param->{'action'}
2792        && defined $action_args{$param->{'action'}}) {
2793        unless (grep /^list$/, @{$action_args{$param->{'action'}}}) {
2794            $param->{'list'} = undef;
2795            $list = undef;
2796        }
2797    }
2798
2799    # Compat: 6.2.13 and earlier generated HTML archive etc. using these
2800    # parameters for email addresses protection.
2801    $param->{'hidden_head'} = '';
2802    $param->{'hidden_at'}   = '@';
2803    $param->{'hidden_end'}  = '';
2804
2805    if (ref $list eq 'Sympa::List' and $list->{'name'}) {
2806        wwslog('debug2', 'List-name %s', $list->{'name'});
2807
2808        # Owners and editors
2809        foreach my $role (qw(owner editor)) {
2810            my @users =
2811                grep { $_->{role} eq $role }
2812                @{$list->get_current_admins || []};
2813            foreach my $u (@users) {
2814                next unless $u->{'email'};
2815
2816                my ($local, $domain) = split /\@/, $u->{'email'};
2817
2818                $param->{$role}{$u->{'email'}} = {
2819                    gecos      => $u->{gecos},
2820                    visibility => $u->{visibility},
2821                    local      => $local,
2822                    domain     => $domain,
2823                };
2824            }
2825        }
2826
2827        ## Environment variables
2828        foreach my $k (keys %ENV) {
2829            $param->{'env'}{$k} = $ENV{$k};
2830        }
2831        ## privileges
2832        if ($param->{'user'}{'email'}) {
2833            $param->{'is_subscriber'} =
2834                $list->is_list_member($param->{'user'}{'email'});
2835            $param->{'subscriber'} =
2836                $list->get_list_member($param->{'user'}{'email'})
2837                if $param->{'is_subscriber'};
2838            $param->{'is_privileged_owner'} =
2839                $list->is_admin('privileged_owner', $param->{'user'}{'email'})
2840                || Sympa::is_listmaster($list, $param->{'user'}{'email'});
2841            $param->{'is_owner'} =
2842                $list->is_admin('owner', $param->{'user'}{'email'})
2843                || Sympa::is_listmaster($list, $param->{'user'}{'email'});
2844            $param->{'is_editor'} =
2845                $list->is_admin('actual_editor', $param->{'user'}{'email'});
2846            $param->{'is_priv'} = $param->{'is_owner'}
2847                || $param->{'is_editor'};
2848
2849            #May post:
2850            my $result = Sympa::Scenario->new($list, 'send')->authz(
2851                $param->{'auth_method'},
2852                {   'sender'      => $param->{'user'}{'email'},
2853                    'remote_host' => $param->{'remote_host'},
2854                    'remote_addr' => $param->{'remote_addr'}
2855                }
2856            );
2857
2858            my $r_action;
2859            my $reason;
2860            if (ref($result) eq 'HASH') {
2861                $r_action = $result->{'action'};
2862                $reason   = $result->{'reason'};
2863            }
2864
2865            if ($r_action =~ /do_it/) {
2866                $param->{'may_post'} = 1;
2867            } else {
2868                $param->{'may_post_reason'} = $reason;
2869            }
2870
2871            $param->{'may_include'} = {
2872                member => (
2873                    $param->{'is_owner'} and $list->has_data_sources('member')
2874                ),
2875                owner => (
2876                            $param->{'is_privileged_owner'}
2877                        and $list->has_data_sources('owner')
2878                ),
2879                editor => (
2880                            $param->{'is_privileged_owner'}
2881                        and $list->has_data_sources('editor')
2882                ),
2883            };
2884            # Compat.<=6.2.54
2885            $param->{'may_sync'} = $param->{'may_include'}{'member'};
2886        }
2887
2888        ## Should Not be used anymore ##
2889        $param->{'may_subunsub'} = 1
2890            if ($param->{'may_signoff'} || $param->{'may_subscribe'});
2891
2892        ## May review
2893        my $result = Sympa::Scenario->new($list, 'review')->authz(
2894            $param->{'auth_method'},
2895            {   'sender'      => $param->{'user'}{'email'},
2896                'remote_host' => $param->{'remote_host'},
2897                'remote_addr' => $param->{'remote_addr'}
2898            }
2899        );
2900        my $r_action;
2901        $r_action = $result->{'action'} if (ref($result) eq 'HASH');
2902
2903        $param->{'may_suboptions'} = 1;
2904        $param->{'total'}          = $list->get_total();
2905        $param->{'may_review'}     = 1 if ($r_action =~ /do_it/);
2906        $param->{'list_status'}    = $list->{'admin'}{'status'};
2907
2908        ## May signoff
2909        $result = Sympa::Scenario->new($list, 'unsubscribe')->authz(
2910            $param->{'auth_method'},
2911            {   'sender'      => $param->{'user'}{'email'},
2912                'remote_host' => $param->{'remote_host'},
2913                'remote_addr' => $param->{'remote_addr'}
2914            }
2915        );
2916        $main::action = $result->{'action'} if (ref($result) eq 'HASH');
2917
2918        if (!$param->{'user'}{'email'}) {
2919            $param->{'may_signoff'} = 1
2920                if ($main::action =~ /do_it|owner|request_auth/);
2921
2922        } elsif ($param->{'is_subscriber'}
2923            && ($param->{'subscriber'}{'subscribed'} == 1)) {
2924            $param->{'may_signoff'} = 1
2925                if ($main::action =~ /do_it|owner|request_auth/);
2926            $param->{'may_suboptions'} = 1;
2927        }
2928
2929        ## May Subscribe
2930        $result = Sympa::Scenario->new($list, 'subscribe')->authz(
2931            $param->{'auth_method'},
2932            {   'sender'      => $param->{'user'}{'email'},
2933                'remote_host' => $param->{'remote_host'},
2934                'remote_addr' => $param->{'remote_addr'}
2935            }
2936        );
2937        $main::action = $result->{'action'} if (ref($result) eq 'HASH');
2938
2939        $param->{'may_subscribe'} = 1
2940            if ($main::action =~ /do_it|owner|request_auth/);
2941
2942# SJS START
2943        ## May Add or del subscribers
2944        my $result = Sympa::Scenario->new($list, 'add')->authz(
2945            $param->{'auth_method'},
2946            {   'sender'      => $param->{'user'}{'email'},
2947                'remote_host' => $param->{'remote_host'},
2948                'remote_addr' => $param->{'remote_addr'}
2949            }
2950        );
2951        $main::action = $result->{'action'} if (ref($result) eq 'HASH');
2952        $param->{'may_add'} = 1 if ($main::action =~ /do_it/);
2953        my $result = Sympa::Scenario->new($list, 'del')->authz(
2954            $param->{'auth_method'},
2955            {   'sender'      => $param->{'user'}{'email'},
2956                'remote_host' => $param->{'remote_host'},
2957                'remote_addr' => $param->{'remote_addr'}
2958            }
2959        );
2960        $main::action = $result->{'action'} if (ref($result) eq 'HASH');
2961        $param->{'may_del'} = 1 if ($main::action =~ /do_it/);
2962# SJS END
2963
2964        ## Archives Access control
2965        if (defined $list->is_archiving_enabled) {
2966            $param->{'is_archived'} = 1;
2967
2968            ## Check if the current user may access web archives
2969            my $result =
2970                Sympa::Scenario->new($list, 'archive_web_access')->authz(
2971                $param->{'auth_method'},
2972                {   'sender'      => $param->{'user'}{'email'},
2973                    'remote_host' => $param->{'remote_host'},
2974                    'remote_addr' => $param->{'remote_addr'}
2975                }
2976                );
2977            my $r_action;
2978            $r_action = $result->{'action'} if (ref($result) eq 'HASH');
2979
2980            if ($r_action =~ /do_it/i) {
2981                $param->{'arc_access'} = 1;
2982            } else {
2983                undef($param->{'arc_access'});
2984            }
2985
2986            ## Check if web archive is publically accessible (useful
2987            ## information for RSS)
2988            $result = Sympa::Scenario->new($list, 'archive_web_access')
2989                ->authz($param->{'auth_method'}, {'sender' => 'nobody'});
2990            $r_action = $result->{'action'} if (ref($result) eq 'HASH');
2991
2992            if ($r_action =~ /do_it/i) {
2993                $param->{'arc_public_access'} = 1;
2994            }
2995        }
2996
2997        if (Conf::get_robot_conf($robot, 'shared_feature') eq 'on') {
2998            $param->{'is_shared_allowed'} = 1;
2999
3000            # Shared documents access control.
3001            my $shared_doc = Sympa::WWW::SharedDocument->new($list);
3002            if ($shared_doc and $shared_doc->{status} eq 'exist') {
3003                # Check if shared is publically accessible (useful information
3004                # for RSS).
3005                my %access = $shared_doc->get_privileges(
3006                    mode             => 'read',
3007                    sender           => undef,
3008                    auth_method      => $param->{'auth_method'},
3009                    scenario_context => {sender => 'nobody'}
3010                );
3011                $param->{'shared_public_access'} = $access{'may'}{'read'};
3012            }
3013        }
3014
3015        # List included in other list may not be closed nor renamed.
3016        $param->{'is_included'} = 1 if $list->is_included;
3017    }
3018
3019    $param->{'robot'} = $robot;
3020
3021    # If parameter has the Unicode Perl flag, then switch to utf-8.
3022    # This switch is applied recursively.
3023    Sympa::Tools::Data::recursive_transformation(
3024        $param,
3025        sub {
3026            my $s = shift;
3027            return Encode::encode_utf8($s) if Encode::is_utf8($s);
3028            return $s;
3029        }
3030    );
3031}
3032
3033sub do_confirm_action {
3034    $param->{confirm_action} = $session->{confirm_action};
3035
3036    return 1;
3037}
3038
3039## ticket : this action is used if someone submits a one time ticket
3040sub do_ticket {
3041    wwslog('info', '(%s)', $in{'ticket'});
3042
3043    $param->{'ticket_context'} =
3044        Sympa::Ticket::load($robot, $in{'ticket'}, $ip);
3045    $param->{'ticket_context'}{'printable_date'} =
3046        $language->gettext_strftime("%d %b %Y at %H:%M:%S",
3047        localtime($param->{'ticket_context'}{'date'}));
3048
3049    return 1
3050        unless ($param->{'ticket_context'}{'result'} eq 'success'
3051        or $param->{'ticket_context'}{'result'} eq 'closed');
3052
3053    # if the ticket is related to someone which is not logged in, the system
3054    # performs the same operation as for a login
3055    my $email_regexp = Sympa::Regexps::email();
3056    if (($param->{'ticket_context'}{'result'} eq 'success')
3057        || # a valid ticket or a closed or expired ticket but with a valid pre-existing session
3058        (   (      ($param->{'ticket_context'}{'result'} eq 'expired')
3059                || ($param->{'ticket_context'}{'result'} eq 'closed')
3060            )
3061            && (lc($param->{'ticket_context'}{'email'}) eq
3062                $session->{'email'})
3063        )
3064    ) {
3065        $session->{'email'} = lc($param->{'ticket_context'}{'email'});
3066        $param->{'user'} = Sympa::User::get_global_user($session->{'email'});
3067        $param->{'user'}{'email'} = $session->{'email'};
3068        # Save and update last login info.
3069        $session->{'last_login_host'} = $param->{'user'}{'last_login_host'};
3070        $session->{'last_login_date'} = $param->{'user'}{'last_login_date'};
3071        Sympa::User::update_global_user($param->{'user'}{'email'},
3072            {last_login_date => time(), last_login_host => $ip});
3073    } elsif ($param->{'ticket_context'}{'result'} eq 'closed') {
3074        wwslog(
3075            'info',
3076            '(%s) Refusing to perform login because the ticket has been used before',
3077            $in{'ticket'}
3078        );
3079        return 1;
3080    } else {
3081        wwslog('err',
3082            '(%s) Unable to evaluate the ticket validity (status: %s)',
3083            $in{'ticket'}, $param->{'ticket_context'}{'result'});
3084        return 1;
3085    }
3086    _split_params($param->{'ticket_context'}{'data'});
3087    return $in{'action'};
3088
3089}
3090
3091# Login WWSympa
3092sub do_login {
3093    wwslog('info', '(%s)', $in{'email'});
3094
3095    my $email  = Sympa::Tools::Text::canonic_email($in{'email'});
3096    my $passwd = delete $in{'passwd'};                             # Clear it.
3097
3098    my $previous_action = $in{'previous_action'}
3099        if $in{'previous_action'}
3100        and $in{'previous_action'} =~ /\A\w+\z/;
3101    my $listname_re   = Sympa::Regexps::listname();    #FIXME:Check required?
3102    my $previous_list = $in{'previous_list'}
3103        if $in{'previous_list'}
3104        and $in{'previous_list'} =~ /\A$listname_re\z/;
3105    my $only_passwd = $in{'only_passwd'};
3106    $only_passwd ||= $in{'login_method'};              # Compat. <= 6.2.36
3107    my $success_referer = _clean_referer($in{'referer'});
3108    my $failure_referer = _clean_referer($in{'failure_referer'});
3109    my $ldap_auth_info  = is_ldap_user($email);
3110
3111    if ($param->{'user'}{'email'}) {
3112        Sympa::WWW::Report::reject_report_web('user', 'already_login',
3113            {'email' => $param->{'user'}{'email'}},
3114            $param->{'action'});
3115        wwslog('info', 'User %s already logged in',
3116            $param->{'user'}{'email'});
3117        web_db_log(
3118            {   'parameters'   => $in{'email'},
3119                'target_email' => $in{'email'},
3120                'status'       => 'error',
3121                'error_type'   => 'already_login'
3122            }
3123        );
3124        return _do_login_exit($success_referer, $previous_action,
3125            $previous_list);
3126    }
3127
3128    $param->{'email'}           = $email;
3129    $param->{'previous_action'} = $previous_action;
3130    $param->{'previous_list'}   = $previous_list;
3131    $param->{'only_passwd'}     = $only_passwd;
3132    $param->{'referer'}         = $success_referer;
3133    $param->{'failure_referer'} = $failure_referer;
3134    $param->{'is_ldap_user'}    = ($ldap_auth_info ? 1 : 0);
3135
3136    $param->{'unauthenticated_email'} = $email;    # Compat. <= 6.2.36
3137    $param->{'init_email'}            = $email;    # Compat. <= 6.2.36
3138
3139    # Show form if not yet submitted.
3140    return 1 unless delete $in{'submit'};          # Clear it.
3141    # Show form if HTTP POST method not used.
3142    return 1 unless $ENV{'REQUEST_METHOD'} eq 'POST';
3143
3144    unless ($email) {
3145        Sympa::WWW::Report::reject_report_web('user', 'no_email', {},
3146            $param->{'action'});
3147        wwslog('info', 'No email');
3148        web_db_log(
3149            {   'parameters'   => $in{'email'},
3150                'target_email' => $in{'email'},
3151                'status'       => 'error',
3152                'error_type'   => "no_email"
3153            }
3154        );
3155        return 1;
3156    }
3157
3158    unless ($passwd) {
3159        Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
3160            {'argument' => 'passwd'},
3161            $param->{'action'});
3162        wwslog('info', 'Missing parameter passwd');
3163        web_db_log(
3164            {   'parameters'   => $in{'email'},
3165                'target_email' => $in{'email'},
3166                'status'       => 'error',
3167                'error_type'   => "missing_parameter"
3168            }
3169        );
3170        return 1;
3171    }
3172
3173    my $data;
3174
3175    unless ($data = Sympa::WWW::Auth::check_auth($robot, $email, $passwd)) {
3176        $log->syslog('notice', 'Authentication failed');
3177        web_db_log(
3178            {   'parameters'   => $in{'email'},
3179                'target_email' => $in{'email'},
3180                'status'       => 'error',
3181                'error_type'   => 'authentication'
3182            }
3183        );
3184        my $u = Sympa::User::get_global_user($email);
3185        if (    $u
3186            and $u->{'wrong_login_count'}
3187            and $u->{'wrong_login_count'} >
3188            Conf::get_robot_conf($robot, 'max_wrong_password')) {
3189            $param->{'login_error'} = 'password_reset';
3190            return _do_login_exit($failure_referer || $ldap_auth_info,
3191                'renewpasswd');
3192        } else {
3193            #$param->{'login_error'} = 'wrong_password';
3194            return _do_login_exit($failure_referer, 1);
3195        }
3196
3197    }
3198
3199    $param->{'user'}    = $data->{'user'};
3200    $session->{'auth'}  = $data->{'auth'};
3201    $session->{'email'} = $email =
3202        Sympa::Tools::Text::canonic_email($param->{'user'}{'email'});
3203
3204    # Save and update information of last login.
3205    $session->{'last_login_host'} = $param->{'user'}{'last_login_host'};
3206    $session->{'last_login_date'} = $param->{'user'}{'last_login_date'};
3207    Sympa::User::update_global_user(
3208        $param->{'user'}{'email'},
3209        {   last_login_date   => time(),
3210            last_login_host   => $ip,
3211            wrong_login_count => 0
3212        }
3213    );
3214
3215    if ($session->{'lang'}) {
3216        # user did choose a specific language before being logged.  Apply it
3217        # as a user pref.
3218        # FIXME: Should users' language preference be changed?
3219        Sympa::User::update_global_user($param->{'user'}{'email'},
3220            {lang => $session->{'lang'}});
3221        $param->{'lang'} = $session->{'lang'};
3222    } else {
3223        # user did not choose a specific language, apply user pref for this
3224        # session.
3225        my $lang_context = (ref $list eq 'Sympa::List') ? $list : $robot;
3226        $param->{'lang'} = $language->set_lang($param->{'user'}{'lang'},
3227            Sympa::best_language($lang_context));
3228        $session->{'lang'} = $param->{'lang'};
3229    }
3230    # compatibility: old-style locale.
3231    $param->{'locale'} = Sympa::Language::lang2oldlocale($param->{'lang'});
3232    # compatibility: 6.1.
3233    $param->{'lang_tag'} = $param->{'lang'};
3234
3235    if ($session->{'review_page_size'}) {
3236        # user did choose a specific page size upgrade prefs
3237        Sympa::User::update_global_user($param->{'user'}{'email'},
3238            {data => $param->{'user'}{'prefs'}});
3239    }
3240
3241    if ($session->{'shared_mode'}) {
3242        # user did choose a shared expert/standard mode
3243        Sympa::User::update_global_user($param->{'user'}{'email'},
3244            {data => $param->{'user'}{'prefs'}});
3245    }
3246
3247    web_db_log(
3248        {   'parameters'   => $in{'email'},
3249            'target_email' => $in{'email'},
3250            'status'       => 'success'
3251        }
3252    );
3253
3254    web_db_stat_log();
3255
3256    return _do_login_exit($success_referer, $previous_action, $previous_list);
3257}
3258
3259sub _do_login_exit {
3260    my $referer  = shift;
3261    my $action   = shift;
3262    my $listname = shift;
3263
3264    if ($param->{'nomenu'}) {
3265        $param->{'back_to_mom'} = 1;
3266        return 1;
3267    } elsif ($referer and $referer =~ m{\Ahttps?://}i) {
3268        $param->{'redirect_to'} = $referer;
3269        return 1;
3270    } elsif ($action
3271        and not $temporary_actions{$action}
3272        and not($action eq 'referer')) {    # Compat. <= 6.2.36
3273        $in{'list'} = $listname;
3274        return $action;
3275    } else {
3276        $param->{'redirect_to'} = $session->{'redirect_url'}
3277            || Sympa::get_url($robot, undef, authority => 'local');
3278        return 1;
3279    }
3280}
3281
3282sub _clean_referer {
3283    my $referer = shift;
3284
3285    return undef
3286        unless $referer and $referer =~ m{\Ahttps?://}i;
3287
3288    # Allow referer within scope of cookie domain.
3289    my $host = lc(URI->new($referer)->host);
3290    my $mydom = lc($cookie_domain || 'localhost');
3291    if ($mydom eq 'localhost') {
3292        my $myhost = Sympa::WWW::Tools::get_http_host() || '';
3293        $myhost =~ s/:\d+\z//;
3294        return undef
3295            unless $host eq $myhost;
3296    } else {
3297        $mydom =~ s/\A(?![.])/./;
3298        return undef
3299            unless substr($host, -length $mydom) eq $mydom
3300            or ".$host" eq $mydom;
3301    }
3302
3303    return $referer;
3304}
3305
3306## Login WWSympa
3307## The sso_login action is made of 4 subactions that make a complete workflow.
3308## Note that this comlexe workflow is only used if the SSO server does not
3309## provide
3310## the user email address or if this email address is not trusted and
3311## therefore
3312## needs to be checked.
3313## The workflow:
3314##  1) init: determine if email address needs to be collected/checked
3315##  2) requestemail: collect the user email address in a web form. Note that
3316##  form may be initialized with
3317##     one email address provided by the SSO server
3318##  3) validateemail: a challenge is sent to the email address to validate it
3319##  4) confirmemail: user confirms their email address with the challenge
3320sub do_sso_login {
3321    wwslog('info', '(%s)', $in{'auth_service_name'});
3322
3323    # When user require CAS login, reset do_not_use_cas cookie.
3324    delete $session->{'do_not_use_cas'};
3325    my $next_action;
3326
3327    if ($param->{'user'}{'email'}) {
3328        wwslog(
3329            'info',
3330            'User %s already logged in. Session reset',
3331            $param->{'user'}{'email'}
3332        );
3333
3334        delete $param->{'user'};
3335        $session->{'email'} = 'nobody';
3336        delete $session->{'cas_server'};
3337        delete $session->{'sso_id'};
3338    }
3339
3340    ## This is a CAS service
3341    if (defined(
3342            my $cas_id =
3343                $Conf::Conf{'cas_id'}{$robot}{$in{'auth_service_name'}}
3344                {'casnum'}
3345        )
3346    ) {
3347        my $cas_server =
3348            $Conf::Conf{'auth_services'}{$robot}[$cas_id]{'cas_server'};
3349
3350        $session->{'checked_cas'} = $cas_id;
3351        my $service = Sympa::get_url(
3352            $robot, 'sso_login_succeeded',
3353            nomenu => $param->{'nomenu'},
3354            paths  => [$in{'auth_service_name'}],
3355        );
3356
3357        my $redirect_url = $cas_server->getServerLoginURL($service);
3358        wwslog('info', '(%s)', $redirect_url);
3359        if ($redirect_url =~ /http(s)+\:\//i) {
3360            $in{'action'} = 'redirect';                #FIXME
3361            $param->{'redirect_to'} = $redirect_url;
3362            _redirect($redirect_url);
3363        }
3364
3365    } elsif (
3366        defined(
3367            my $sso_id =
3368                $Conf::Conf{'generic_sso_id'}{$robot}
3369                {$in{'auth_service_name'}}
3370        )
3371    ) {
3372        ## Generic SSO
3373
3374        ## If contacted via POST, then redirect the user to the URL for the
3375        ## access control to apply
3376        if ($ENV{'REQUEST_METHOD'} eq 'POST') {
3377            my @paths;
3378            my $service;
3379
3380            if ($param->{'nomenu'}) {
3381                push @paths, 'nomenu';    #FIXME:Is it required?
3382            }
3383
3384            wwslog('info', 'POST request processing');
3385
3386            if ($in{'subaction'} eq 'validateemail') {
3387                push @paths, 'validateemail', $in{'email'};
3388            } elsif ($in{'subaction'} eq 'confirmemail') {
3389                push @paths, 'confirmemail', $in{'email'}, $in{'ticket'};
3390            } else {
3391                push @paths, 'init';
3392            }
3393
3394            $service = Sympa::get_url(
3395                $robot, 'sso_login',
3396                nomenu    => $param->{'nomenu'},
3397                paths     => [$in{'auth_service_name'}, @paths],
3398                authority => 'local'
3399            );
3400
3401            wwslog('info', 'Redirect user to %s', $service);
3402            $in{'action'} = 'redirect';           #FIXME
3403            $param->{'redirect_to'} = $service;
3404            _redirect($service);
3405            return 1;
3406        }
3407
3408        my $email;
3409        ## We need to collect/verify the user's email address
3410        if (defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3411            {'force_email_verify'}) {
3412            my $email_is_trusted = 0;
3413
3414            ## the subactions order is : init, requestemail, validateemail,
3415            ## sendssopasswd, confirmemail
3416
3417            ## get email from NetiD table
3418            if (defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3419                {'internal_email_by_netid'}) {
3420                wwslog('debug', 'Lookup email internal: %s', $sso_id);
3421                if ($email = Sympa::WWW::Auth::get_email_by_net_id(
3422                        $robot, $sso_id, \%ENV
3423                    )
3424                ) {
3425                    $email_is_trusted = 1;
3426                }
3427            }
3428
3429            ## get email from authN module
3430            if (defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3431                {'email_http_header'} && !$email_is_trusted) {
3432                my @email_list = split(
3433                    /$Conf::Conf{'auth_services'}{$robot}[$sso_id]{'http_header_value_separator'}/,
3434                    lc( $ENV{
3435                            $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3436                                {'email_http_header'}
3437                        }
3438                    )
3439                );
3440                ## Only get the first occurrence if multi-valued
3441                $email = $email_list[0];
3442            }
3443
3444            ## Start the email validation process
3445            if ($in{'subaction'} eq 'init'
3446                && ($email_is_trusted == 0 || !$email)) {
3447                wwslog('info', 'Return request email');
3448                $session->{'auth'}        = 'generic_sso';
3449                $param->{'server'}{'key'} = $in{'auth_service_name'};
3450                $param->{'subaction'}     = 'requestemail';
3451                $param->{'init_email'}    = $email;
3452                return 1;
3453            }
3454
3455            if (defined($in{'email'}) and !($in{'subaction'} eq 'init')) {
3456                $email = $in{'email'};
3457            }
3458
3459            ## Send a confirmation email and request it on the web interface
3460            if ($in{'subaction'} eq 'validateemail') {
3461                $session->{'auth'}        = 'generic_sso';
3462                $param->{'server'}{'key'} = $in{'auth_service_name'};
3463                $param->{'init_email'}    = $email;
3464
3465                ## Replace sendpassword with one time ticket
3466                $param->{'one_time_ticket'} = Sympa::Ticket::create(
3467                    $in{'email'},
3468                    $robot,
3469                    'sso_login/confirmemail?auth_service_name='
3470                        . $in{'auth_service_name'},
3471                    $ip
3472                );
3473
3474                unless (sendssopasswd($email)) {
3475                    Sympa::WWW::Report::reject_report_web('user',
3476                        'incorrect_email', {'email' => $email},
3477                        $param->{'action'});
3478                    $param->{'subaction'} = 'requestemail';
3479                    return 1;
3480                }
3481
3482                $param->{'subaction'} = 'validateemail';
3483                return 1;
3484            }
3485
3486            if ($in{'subaction'} eq 'confirmemail') {
3487                $session->{'auth'}        = 'generic_sso';
3488                $param->{'server'}{'key'} = $in{'auth_service_name'};
3489                $param->{'init_email'}    = $email;
3490                $in{'email'}              = $email;
3491
3492                #
3493                # Check input parameters and verify ticket for email, stolen
3494                # from do_login()
3495                #
3496                unless ($in{'email'}) {
3497                    Sympa::WWW::Report::reject_report_web('user', 'no_email',
3498                        {}, $param->{'action'});
3499                    wwslog('info', 'No email');
3500                    web_db_log(
3501                        {   'parameters'   => $in{'auth_service_name'},
3502                            'target_email' => $in{'email'},
3503                            'status'       => 'error',
3504                            'error_type'   => 'no_email'
3505                        }
3506                    );
3507                    $param->{'subaction'} = 'validateemail';
3508                    return 1;
3509                }
3510
3511                unless ($in{'ticket'}) {
3512                    $in{'init_email'} = $in{'email'};
3513                    $param->{'init_email'} = $in{'email'};
3514
3515                    Sympa::WWW::Report::reject_report_web('user',
3516                        'missing_arg', {'argument' => 'ticket'},
3517                        $param->{'action'});
3518                    wwslog('info', 'Confirmemail: missing parameter ticket');
3519                    web_db_log(
3520                        {   'parameters'   => $in{'auth_service_name'},
3521                            'target_email' => $in{'email'},
3522                            'status'       => 'error',
3523                            'error_type'   => 'missing_parameter'
3524                        }
3525                    );
3526                    $param->{'subaction'} = 'validateemail';
3527                    return 1;
3528                }
3529
3530                ## Validate the ticket
3531                my $ticket_output =
3532                    Sympa::Ticket::load($robot, $in{'ticket'}, $ip);
3533                unless ($ticket_output->{'result'} eq 'success') {
3534                    Sympa::WWW::Report::reject_report_web('user',
3535                        'auth_failed', {}, $param->{'action'});
3536                    web_db_log(
3537                        {   'parameters'   => $in{'auth_service_name'},
3538                            'target_email' => $in{'email'},
3539                            'status'       => 'error',
3540                            'error_type'   => 'authentication'
3541                        }
3542                    );
3543                    wwslog('err', 'Authentication failed');
3544
3545                    $param->{'subaction'} = 'validateemail';
3546                    return 1;
3547                }
3548
3549                wwslog('info', 'Confirmemail: email validation succeeded');
3550                # need to create netid to email map entry
3551                $email = $in{'email'};
3552
3553                # everything is ok to proceed to with possible sympa account
3554                # created and traddional sso login
3555
3556                ## TODO : netidmap_table should also be used when no
3557                ## confirmation is performed
3558                if (defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3559                    {'internal_email_by_netid'}) {
3560
3561                    my $netid =
3562                        $ENV{$Conf::Conf{'auth_services'}{$robot}[$sso_id]
3563                            {'netid_http_header'}};
3564                    my $idpname =
3565                        $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3566                        {'service_id'};
3567
3568                    unless (
3569                        Sympa::Robot::set_netidtoemail_db(
3570                            $robot, $netid, $idpname, $in{'email'}
3571                        )
3572                    ) {
3573                        Sympa::WWW::Report::reject_report_web('intern',
3574                            'db_update_failed', {}, $param->{'action'}, '',
3575                            $param->{'user'}{'email'}, $robot);
3576                        wwslog('err', 'Error update netid map');
3577                        web_db_log(
3578                            {   'parameters'   => $in{'auth_service_name'},
3579                                'target_email' => $in{'email'},
3580                                'status'       => 'error',
3581                                'error_type'   => 'internal'
3582                            }
3583                        );
3584                        return Conf::get_robot_conf($robot, 'default_home');
3585                    }
3586
3587                } else {
3588                    wwslog('info', 'Confirmemail: validation failed');
3589
3590                    $param->{'subaction'} = 'validateemail';
3591                    return 1;
3592                }
3593            }
3594
3595        } else {
3596            ##
3597            if (defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3598                {'email_http_header'}) {
3599                my @email_list = split(
3600                    $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3601                        {'http_header_value_separator'},
3602                    lc( $ENV{
3603                            $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3604                                {'email_http_header'}
3605                        }
3606                    )
3607                );
3608                ## Only get the first occurrence if multi-valued
3609                $email = $email_list[0];
3610
3611            } else {
3612                unless (
3613                    defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3614                    {'host'}
3615                    && defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3616                    {'get_email_by_uid_filter'}) {
3617                    Sympa::WWW::Report::reject_report_web('intern',
3618                        'auth_conf_no_identified_user',
3619                        {}, $param->{'action'}, '', '', $robot);
3620                    wwslog('err',
3621                        'auth.conf error: Either email_http_header or host/get_email_by_uid_filter entries should be defined'
3622                    );
3623                    web_db_log(
3624                        {   'parameters'   => $in{'auth_service_name'},
3625                            'target_email' => $in{'email'},
3626                            'status'       => 'error',
3627                            'error_type'   => 'internal'
3628                        }
3629                    );
3630                    return 'home';
3631                }
3632
3633                $email =
3634                    Sympa::WWW::Auth::get_email_by_net_id($robot, $sso_id,
3635                    \%ENV);
3636            }
3637        }
3638
3639        unless ($email) {
3640            Sympa::WWW::Report::reject_report_web('intern',
3641                'no_identified_user', {}, $param->{'action'}, '', '', $robot);
3642            wwslog(
3643                'err',
3644                'User could not be identified, no %s HTTP header set',
3645                $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3646                    {'email_http_header'}
3647            );
3648            web_db_log(
3649                {   'parameters' => $in{'auth_service_name'},
3650
3651                    'status'     => 'error',
3652                    'error_type' => 'no_email'
3653                }
3654            );
3655            return 'home';
3656        }
3657
3658        $param->{'user'}{'email'} = $email;
3659        $session->{'email'}       = $email;
3660        $session->{'auth'}        = 'generic_sso';
3661
3662        wwslog('notice', 'User identified as %s', $email);
3663
3664        ## There are two ways to list the attributes that Sympa will cache for
3665        ## the user
3666        ## Either with a defined header prefix (http_header_prefix)
3667        ## Or with an explicit list of header fields (http_header_list)
3668        my $sso_attrs;
3669        if (my $list_of_headers =
3670            $Conf::Conf{'auth_services'}{$robot}[$sso_id]{'http_header_list'})
3671        {
3672            $sso_attrs = {
3673                map { ($_ => $ENV{$_}) } grep { defined $ENV{$_} }
3674                    split(/\s*,\s*/, $list_of_headers)
3675            };
3676        } elsif (my $prefix = $Conf::Conf{'auth_services'}{$robot}[$sso_id]
3677            {'http_header_prefix'}) {
3678            $sso_attrs = {
3679                map { ($_ => $ENV{$_}) } grep {/^($prefix)/}
3680                    keys %ENV
3681            };
3682        } else {
3683            $sso_attrs = {};
3684        }
3685
3686        ## Create user entry if required
3687        unless (Sympa::User::is_global_user($email)) {
3688            unless (Sympa::User::add_global_user({'email' => $email})) {
3689                Sympa::WWW::Report::reject_report_web('intern',
3690                    'add_user_db_failed', {'email' => $email},
3691                    $param->{'action'}, '', $email, $robot);
3692                wwslog('info', 'Add failed');
3693                web_db_log(
3694                    {   'parameters'   => $in{'auth_service_name'},
3695                        'target_email' => $in{'email'},
3696                        'status'       => 'error',
3697                        'error_type'   => 'internal'
3698                    }
3699                );
3700                return undef;
3701            }
3702        }
3703
3704        unless (
3705            Sympa::User::update_global_user(
3706                $email, {attributes => $sso_attrs}
3707            )
3708        ) {
3709            Sympa::WWW::Report::reject_report_web('intern',
3710                'update_user_db_failed', {'user' => Sympa::User->new($email)},
3711                $param->{'action'}, '', $email, $robot);
3712            wwslog('info', 'Update failed');
3713            web_db_log(
3714                {   'parameters'   => $in{'auth_service_name'},
3715                    'target_email' => $in{'email'},
3716                    'status'       => 'error',
3717                    'error_type'   => 'internal'
3718                }
3719            );
3720            return undef;
3721        }
3722
3723        Sympa::WWW::Report::notice_report_web('you_have_been_authenticated',
3724            {}, $param->{'action'});
3725
3726        ## Keep track of the SSO used to login
3727        ## Required to provide logout feature if available
3728        $session->{'sso_id'} = $in{'auth_service_name'};
3729
3730        _redirect(
3731            $session->{'redirect_url'} || Sympa::get_url(
3732                $robot, undef,
3733                nomenu    => $param->{'nomenu'},
3734                authority => 'local'
3735            )
3736        );
3737        return 1;
3738    } else {
3739        ## Unknown SSO service
3740        Sympa::WWW::Report::reject_report_web(
3741            'intern',
3742            'unknown_authentication_service',
3743            {'name' => $in{'auth_service_name'}},
3744            $param->{'action'}, '', '', $robot
3745        );
3746        wwslog(
3747            'err',
3748            'Unknown authentication service %s',
3749            $in{'auth_service_name'}
3750        );
3751        web_db_log(
3752            {   'parameters'   => $in{'auth_service_name'},
3753                'target_email' => $in{'email'},
3754                'status'       => 'error',
3755                'error_type'   => 'internal'
3756            }
3757        );
3758        return 'home';
3759    }
3760    web_db_log(
3761        {   'parameters'   => $in{'auth_service_name'},
3762            'target_email' => $in{'email'},
3763            'status'       => 'success'
3764        }
3765    );
3766    return 1;
3767}
3768
3769sub do_sso_login_succeeded {
3770    wwslog('info', '(%s)', $in{'auth_service_name'});
3771
3772    if (defined $param->{'user'} && $param->{'user'}{'email'}) {
3773        Sympa::WWW::Report::notice_report_web('you_have_been_authenticated',
3774            {}, $param->{'action'});
3775        web_db_log(
3776            {   'parameters' => $in{'auth_service_name'},
3777                'status'     => 'success'
3778            }
3779        );
3780
3781    } else {
3782        Sympa::WWW::Report::reject_report_web('user', 'auth_failed', {},
3783            $param->{'action'});
3784        web_db_log(
3785            {   'parameters' => $in{'auth_service_name'},
3786                'status'     => 'error',
3787                'error_type' => 'authentication'
3788            }
3789        );
3790    }
3791
3792    ## We should refresh the main window
3793    if ($param->{'nomenu'}) {
3794        $param->{'back_to_mom'} = 1;
3795        return 1;
3796    } else {
3797        _redirect(
3798            $session->{'redirect_url'} || Sympa::get_url(
3799                $robot, undef,
3800                nomenu    => $param->{'nomenu'},
3801                authority => 'local'
3802            )
3803        );
3804        return 1;
3805    }
3806}
3807
3808sub is_ldap_user {
3809    my $auth = shift;    ## User email or UID
3810    wwslog('debug2', '(%s)', $auth);
3811
3812    unless (Sympa::search_fullpath($robot, 'auth.conf')) {
3813        return undef;
3814    }
3815
3816    # List all LDAP servers first
3817    my @ldap_servers;
3818    foreach my $ldap (@{$Conf::Conf{'auth_services'}{$robot}}) {
3819        next unless ($ldap->{'auth_type'} eq 'ldap');
3820
3821        push @ldap_servers, $ldap;
3822    }
3823
3824    unless (@ldap_servers) {
3825        return undef;
3826    }
3827
3828    my $filter;
3829
3830    foreach my $ldap (@ldap_servers) {
3831        # skip ldap auth service if the user id or email do not match regexp
3832        # auth service parameter
3833        next unless $auth =~ /$ldap->{'regexp'}/i;
3834
3835        my $db = Sympa::Database->new('LDAP', %$ldap);
3836        unless ($db and $db->connect) {
3837            $log->syslog('err', 'Unable to connect to the LDAP server "%s"',
3838                $ldap->{'host'});
3839            next;
3840        }
3841
3842        my $attrs = $ldap->{'email_attribute'};
3843
3844        if (Sympa::Tools::Text::valid_email($auth)) {
3845            $filter = $ldap->{'get_dn_by_email_filter'};
3846        } else {
3847            $filter = $ldap->{'get_dn_by_uid_filter'};
3848        }
3849        $filter =~ s/\[sender\]/$auth/ig;
3850
3851        ## !! une fonction get_dn_by_email/uid
3852
3853        my $mesg = $db->do_operation(
3854            'search',
3855            base    => $ldap->{'suffix'},
3856            filter  => "$filter",
3857            scope   => $ldap->{'scope'},
3858            timeout => $ldap->{'timeout'}
3859        );
3860
3861        unless ($mesg and $mesg->count()) {
3862            wwslog('notice',
3863                'No entry in the LDAP Directory Tree of %s for %s',
3864                $ldap->{'host'}, $auth);
3865            $db->disconnect();
3866            last;
3867        }
3868
3869        $db->disconnect();
3870        return $ldap->{'authentication_info_url'} || 'none';
3871    }
3872
3873    return undef;
3874}
3875
3876## send back login form
3877# No longer used.
3878#sub do_loginrequest;
3879
3880## Help / about WWSympa
3881sub do_help {
3882    wwslog('info', '(%s)', $in{'help_topic'});
3883
3884    # Strip extensions.
3885    $in{'help_topic'} =~ s/[.].*// if $in{'help_topic'};
3886    # Given partial top URI, redirect to base.
3887    unless ($in{'help_topic'} or ($ENV{PATH_INFO} // '') =~ m{/\z}) {
3888        $param->{'redirect_to'} = Sympa::get_url(
3889            $robot, 'help',
3890            nomenu    => $param->{'nomenu'},
3891            paths     => [''],                 # Ends with '/'.
3892            authority => 'local'
3893        );
3894        return 1;
3895    }
3896
3897    $param->{'help_topic'} = $in{'help_topic'}
3898        if $in{'help_topic'};
3899    return 1;
3900}
3901
3902#FIXME: Would be obsoleted. Used internally only.
3903sub do_redirect {
3904    _redirect($param->{'redirect_to'});
3905    return 1;
3906}
3907
3908# update session cookie and redirect the client to redirect_to parameter or
3909# glob var;
3910sub _redirect {
3911    my $redirect_to = shift;
3912
3913    $session->set_cookie($cookie_domain, 'session', $param->{'use_ssl'});
3914    print "Status: 302 Moved\n";
3915    print "Location: $redirect_to\n\n";
3916    $param->{'bypass'} = 'extreme';
3917    return 1;
3918}
3919
3920# Logout from WWSympa
3921sub do_logout {
3922    wwslog('info', '(%s)', $param->{'user'}{'email'});
3923
3924    delete $param->{'user'};
3925    $session->{'email'} = 'nobody';
3926
3927    if (length($session->{'cas_server'} // '')
3928        and $Conf::Conf{'auth_services'}{$robot}[$session->{'cas_server'}]) {
3929        # This user was logged using CAS.
3930        my $cas_server =
3931            $Conf::Conf{'auth_services'}{$robot}[$session->{'cas_server'}]
3932            {'cas_server'};
3933        delete $session->{'cas_server'};
3934
3935        $param->{'redirect_to'} =
3936            $cas_server->getServerLogoutURL(Sympa::get_url($robot));
3937        return 1;
3938    } elsif (defined $session->{'sso_id'}) {
3939        # This user was logged using a generic_sso.
3940
3941        my $sso = Conf::get_sso_by_id(
3942            robot      => $robot,
3943            service_id => $session->{'sso_id'}
3944        );
3945        unless ($sso) {
3946            wwslog('err', 'Unknown SSO service_id "%s"',
3947                $session->{'sso_id'});
3948            return undef;
3949        }
3950        delete $session->{'sso_id'};
3951
3952        if ($sso->{logout_url}) {
3953            $param->{'redirect_to'} = $sso->{logout_url};
3954            return 1;
3955        }
3956    }
3957
3958    Sympa::WWW::Report::notice_report_web('logout', {}, $param->{'action'});
3959    wwslog('info', 'Logout performed');
3960    web_db_log(
3961        {   'parameters'   => $param->{'user'}{'email'},
3962            'target_email' => $in{'email'},
3963            'status'       => 'success'
3964        }
3965    );
3966
3967    web_db_stat_log();
3968
3969    return Conf::get_robot_conf($robot, 'default_home');
3970}
3971
3972sub sendssopasswd {
3973    my $email = shift;
3974    $log->syslog('info', '(%s)', $email);
3975
3976    my ($passwd, $user);
3977
3978    unless ($email) {
3979        Sympa::WWW::Report::reject_report_web('user', 'no_email', {},
3980            $param->{'action'});
3981        wwslog('info', 'No email');
3982        web_db_log(
3983            {   'parameters'   => $email,
3984                'target_email' => $email,
3985                'status'       => 'error',
3986                'error_type'   => "no_email"
3987            }
3988        );
3989        return 'requestemail';
3990    }
3991
3992    unless (Sympa::Tools::Text::valid_email($email)) {
3993        Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
3994            {'email' => $email},
3995            $param->{'action'});
3996        wwslog('info', 'Incorrect email %s', $email);
3997        web_db_log(
3998            {   'parameters'   => $email,
3999                'target_email' => $email,
4000                'status'       => 'error',
4001                'error_type'   => "incorrect_email"
4002            }
4003        );
4004
4005        return 'requestemail';
4006    }
4007
4008    my $url_redirect;
4009
4010    $param->{'newuser'} =
4011        Sympa::User::get_global_user($email) || {'email' => $email};
4012
4013    $param->{'init_passwd'} = 1
4014        if ($param->{'user'}{'password'} =~ /^init/);
4015
4016    #FIXME: check error
4017    Sympa::send_file($robot, 'sendssopasswd', $email, $param);
4018
4019    $param->{'email'} = $email;
4020    web_db_log(
4021        {   'parameters'   => $email,
4022            'target_email' => $email,
4023            'status'       => 'success'
4024        }
4025    );
4026
4027    return 'validateemail';
4028}
4029
4030sub do_firstpasswd {
4031    wwslog('info', '(%s)', $in{'email'});
4032    $param->{'reason'} = 'firstpasswd';
4033    return 'renewpasswd';
4034}
4035## send a ticket for choosing a new password
4036sub do_renewpasswd {
4037    wwslog('info', '(%s)', $in{'email'});
4038
4039    my $url_redirect;
4040    if ($in{'email'}) {
4041        if ($url_redirect = is_ldap_user($in{'email'})) {
4042            $param->{'redirect_to'} = $url_redirect
4043                if $url_redirect ne 'none';
4044        } elsif (!Sympa::Tools::Text::valid_email($in{'email'})) {
4045            Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
4046                {'email' => $in{'email'}},
4047                $param->{'action'});
4048            wwslog('info', 'Incorrect email "%s"', $in{'email'});
4049            web_db_log(
4050                {   'parameters'   => $in{'email'},
4051                    'target_email' => $in{'email'},
4052                    'status'       => 'error',
4053                    'error_type'   => 'incorrect_email'
4054                }
4055            );
4056            return undef;
4057        }
4058    }
4059
4060    $param->{'email'} = $in{'email'};
4061    web_db_log(
4062        {   'parameters'   => $in{'email'},
4063            'target_email' => $in{'email'},
4064            'status'       => 'success',
4065        }
4066    );
4067
4068    return 1;
4069}
4070
4071####################################################
4072# do_requestpasswd
4073####################################################
4074#  Sends a message to the user containing user password.
4075#
4076# IN : -
4077#
4078# OUT : 'renewpasswd' |  1 | 'loginrequest' | undef
4079#
4080####################################################
4081sub do_requestpasswd {
4082    wwslog('info', '(%s)', $in{'email'});
4083
4084    my $email  = $in{'email'};
4085    my $reason = $in{'reason'};
4086
4087    $param->{'account_creation'} = 1;
4088    $param->{'email'}            = $email;
4089    $param->{'reason'}           = $reason;
4090
4091    # Action confirmed?
4092    my $next_action = $session->confirm_action(
4093        $in{'action'},
4094        $in{'response_action'},
4095        arg             => join(',', $email, $reason),
4096        previous_action => (
4097            $in{'previous_action'}
4098                || ($reason ? 'firstpasswd' : 'renewpasswd')
4099        )
4100    );
4101    return $next_action unless $next_action eq '1';
4102
4103    my $url_redirect;
4104    if ($url_redirect = is_ldap_user($in{'email'})) {
4105        ## There might be no authentication_info_url URL defined in auth.conf
4106        if ($url_redirect eq 'none') {
4107            Sympa::WWW::Report::reject_report_web('user', 'ldap_user', {},
4108                $param->{'action'});
4109            wwslog('info', 'LDAP user %s, cannot remind password',
4110                $in{'email'});
4111            web_db_log(
4112                {   'parameters'   => $in{'email'},
4113                    'target_email' => $in{'email'},
4114                    'status'       => 'error',
4115                    'error_type'   => 'internal'
4116                }
4117            );
4118            return 'home';
4119        } else {
4120            $param->{'redirect_to'} = $url_redirect;
4121            return 1;
4122        }
4123    }
4124
4125    ## Check auth.conf before creating/sending a password
4126    unless (Sympa::WWW::Auth::may_use_sympa_native_auth($robot, $in{'email'}))
4127    {
4128        ## TODO: Error handling
4129        Sympa::WWW::Report::reject_report_web('user',
4130            'passwd_reminder_not_allowed', {}, $param->{'action'});
4131        return undef;
4132    }
4133    wwslog('debug', 'Sending one time ticket for %s', $in{'email'});
4134    $param->{'one_time_ticket'} =
4135        Sympa::Ticket::create($in{'email'}, $robot, 'choosepasswd', $ip);
4136    $param->{'request_from_host'} = $ip;
4137    unless ($param->{'newuser'} = Sympa::User::get_global_user($in{'email'}))
4138    {
4139        $param->{'newuser'} =
4140            {'email' => Sympa::Tools::Text::canonic_email($in{'email'})};
4141    }
4142    if ($param->{'one_time_ticket'}) {
4143        $param->{'login_error'} = 'ticket_sent';
4144        unless (Sympa::send_file($robot, 'sendpasswd', $in{'email'}, $param))
4145        {
4146            wwslog('notice', 'Unable to send template "sendpasswd" to %s',
4147                $in{'email'});
4148            $param->{'login_error'} = 'unable_to_send_ticket';
4149        }
4150    } else {
4151        wwslog('notice', "Unable to create_one_time_ticket");
4152        Sympa::WWW::Report::reject_report_web('user',
4153            'passwd_reminder_error', {}, $param->{'action'});
4154        $param->{'login_error'} = 'unable_to_create_ticket';
4155    }
4156
4157    return 1 unless ($param->{'previous_action'});
4158    return $param->{'previous_action'};
4159}
4160
4161sub do_my {
4162    wwslog('info', '');
4163
4164    # Sets the date of the field "start date" to "today"
4165    $param->{'d_day'} = POSIX::strftime('%d-%m-%Y', localtime time);
4166    _set_my_lists_info();
4167    return 1;
4168}
4169
4170## Which list the user is subscribed to
4171## TODO (pour listmaster, toutes les listes)
4172# DEPRECATED: No longer used.
4173#sub do_which {
4174
4175## The list of list
4176sub do_lists {
4177    my @lists;
4178    wwslog('info', '(%s, %s)', $in{'topic'}, $in{'subtopic'});
4179
4180    # Get member/owner/editor data used to avoid lookups in the loop
4181    my $which = {member => {}, owner => {}, editor => {}};
4182    if ($param->{'user'}{'email'}) {
4183        foreach my $role ('member', 'owner', 'editor') {
4184            foreach my $list (
4185                Sympa::List::get_which(
4186                    $param->{'user'}{'email'},
4187                    $robot, $role
4188                )
4189            ) {
4190                $which->{$role}->{$list->{'name'}} = $list;
4191            }
4192        }
4193    }
4194
4195    my $all_lists = [];
4196    if ($in{'topic'} and $in{'topic'} eq '@which') {
4197        my %lists = ();
4198        foreach my $role ('member', 'owner', 'editor') {
4199            foreach my $list (values %{$which->{$role}}) {
4200                $lists{$list->{'name'}} = $list;
4201            }
4202        }
4203        $all_lists = [map { $lists{$_} } sort keys %lists];
4204        $param->{'subtitle'} = $language->gettext('Your lists');
4205    } elsif ($in{'topic'}) {
4206        my $topic = join '/', grep {$_} ($in{'topic'}, $in{'subtopic'});
4207        $param->{'topic'} = $topic;
4208
4209        # Filter lists by topic.
4210        # topic argument 'topicsless' or 'other' means 'lists with topic
4211        # "other" or without topics'.
4212        # no topic argument; List all lists
4213        my $options = {};
4214        if ($topic) {
4215            $options->{'filter'} = ['topics' => $topic];
4216        }
4217        $all_lists = Sympa::List::get_lists($robot, %$options);
4218    } else {
4219        $all_lists = Sympa::List::get_lists($robot);
4220    }
4221
4222    foreach my $list (@$all_lists) {
4223        my $sender = $param->{'user'}{'email'} || 'nobody';
4224        my $listname = $list->{'name'};
4225
4226        my $result =
4227            Sympa::Scenario->new($list, 'visibility',
4228            dont_reload_scenario => 1)->authz(
4229            $param->{'auth_method'},
4230            {   'sender'      => $sender,
4231                'remote_host' => $param->{'remote_host'},
4232                'remote_addr' => $param->{'remote_addr'},
4233            }
4234            );
4235
4236        my $r_action;
4237        $r_action = $result->{'action'} if (ref($result) eq 'HASH');
4238
4239        next unless ($r_action eq 'do_it');
4240
4241        my $list_info = {};
4242        $list_info->{'subject'} = $list->{'admin'}{'subject'};
4243        $list_info->{'date_epoch'} =
4244            $list->{'admin'}{'creation'}{'date_epoch'};
4245        $list_info->{'topics'} = $list->{'admin'}{'topics'};
4246        #Compat.<6.2.32
4247        $list_info->{'host'} = $list->{'domain'};
4248
4249        if ($param->{'user'}{'email'}) {
4250            if ($which->{owner}->{$listname}) {
4251                if ($list->is_admin(
4252                        'privileged_owner', $param->{'user'}{'email'}
4253                    )
4254                ) {
4255                    $list_info->{is_privileged_owner} = 1;
4256                }
4257                if (not $which->{editor}->{$listname}
4258                    and $list->is_admin(
4259                        'actual_editor', $param->{'user'}{'email'}
4260                    )
4261                ) {
4262                    $list_info->{is_editor} = 1;
4263                }
4264                $list_info->{is_owner} = 1;
4265                # Compat. < 6.2b.2.
4266                $list_info->{'admin'} = 1;
4267            }
4268            if ($which->{editor}->{$listname}) {
4269                $list_info->{is_editor} = 1;
4270                # Compat. < 6.2b.2.
4271                $list_info->{'admin'} = 1;
4272            }
4273            if ($which->{member}->{$listname}) {
4274                $list_info->{'is_subscriber'} = 1;
4275            }
4276        }
4277
4278        $param->{'which'} ||= {};
4279        $param->{'which'}{$listname} = $list_info;
4280        if ($listname =~ /^([a-z])/) {
4281            push @{$param->{'orderedlist'}{$1}}, $listname;
4282        } else {
4283            push @{$param->{'orderedlist'}{'others'}}, $listname;
4284        }
4285    }
4286    return 1;
4287}
4288
4289sub do_lists_categories {
4290    wwslog('info', '');
4291    return 1;
4292}
4293
4294## The list of latest created lists
4295sub do_latest_lists {
4296    wwslog('info', '(for=%s, count=%s, topic=%s, subtopic=%s)',
4297        $in{'for'}, $in{'count'}, $in{'topic'}, $in{'subtopic'});
4298
4299    unless (do_lists()) {
4300        wwslog('err', 'Error while calling do_lists');
4301        return undef;
4302    }
4303
4304    my $today = time;
4305
4306    my $oldest_day;
4307    if (defined $in{'for'}) {
4308        $oldest_day = $today - (3600 * 24 * ($in{'for'}));
4309        $param->{'for'} = $in{'for'};
4310        unless ($oldest_day >= 0) {
4311            Sympa::WWW::Report::reject_report_web('user', 'nb_days_to_much',
4312                {'nb_days' => $in{'for'}},
4313                $param->{'action'});
4314            wwslog('err', 'Parameter "for" is too big"');
4315        }
4316    }
4317
4318    my $nb_lists = 0;
4319    my @date_lists;
4320    foreach my $listname (keys(%{$param->{'which'}})) {
4321        if ($param->{'which'}{$listname}{'date_epoch'} < $oldest_day) {
4322            delete $param->{'which'}{$listname};
4323            next;
4324        }
4325        $nb_lists++;
4326    }
4327
4328    if (defined $in{'count'}) {
4329        $param->{'count'} = $in{'count'};
4330
4331        unless ($in{'count'}) {
4332            $param->{'which'} = undef;
4333        }
4334    }
4335
4336    my $count_lists = 0;
4337    foreach my $l (
4338        sort {
4339            $param->{'which'}{$b}{'date_epoch'}
4340                <=> $param->{'which'}{$a}{'date_epoch'}
4341        } (keys(%{$param->{'which'}}))
4342    ) {
4343
4344        $count_lists++;
4345
4346        if ($in{'count'}) {
4347            if ($count_lists > $in{'count'}) {
4348                last;
4349            }
4350        }
4351
4352        $param->{'which'}{$l}{'name'} = $l;
4353        push @{$param->{'latest_lists'}}, $param->{'which'}{$l};
4354    }
4355
4356    $param->{'which'} = undef;
4357
4358    return 1;
4359}
4360
4361## The list of the most active lists
4362sub do_active_lists {
4363    wwslog('info', '(for=%s, count=%s, topic=%s, subtopic=%s)',
4364        $in{'for'}, $in{'count'}, $in{'topic'}, $in{'subtopic'});
4365
4366    unless (do_lists()) {
4367        wwslog('err', 'Error while calling do_lists');
4368        return undef;
4369    }
4370
4371    ## oldest interesting day
4372    my $oldest_day = 0;
4373
4374    if (defined $in{'for'}) {
4375        $oldest_day = int(time / 86400) - $in{'for'};
4376        unless ($oldest_day >= 0) {
4377            Sympa::WWW::Report::reject_report_web('user', 'nb_days_to_much',
4378                {'nb_days' => $in{'for'}},
4379                $param->{'action'});
4380            wwslog('err', 'Parameter "for" is too big"');
4381            return undef;
4382        }
4383    }
4384
4385    ## get msg count for each list
4386    foreach my $l (keys(%{$param->{'which'}})) {
4387        my $list = Sympa::List->new($l, $robot);
4388        my $file = "$list->{'dir'}/msg_count";
4389
4390        my %count;
4391
4392        if (open(MSG_COUNT, $file)) {
4393            while (<MSG_COUNT>) {
4394                if ($_ =~ /^(\d+)\s(\d+)$/) {
4395                    $count{$1} = $2;
4396                }
4397            }
4398            close MSG_COUNT;
4399
4400            $param->{'which'}{$l}{'msg_count'} =
4401                count_total_msg_since($oldest_day, \%count);
4402
4403            if ($in{'for'}) {
4404                my $average =
4405                    $param->{'which'}{$l}{'msg_count'} /
4406                    $in{'for'};    ## nb msg by day
4407                $average = int($average * 10);
4408                $param->{'which'}{$l}{'average'} = $average / 10; ## one digit
4409            }
4410        } else {
4411            $param->{'which'}{$l}{'msg_count'} = 0;
4412        }
4413    }
4414
4415    my $nb_lists = 0;
4416
4417    ## get "count" lists
4418    foreach my $l (
4419        sort {
4420            $param->{'which'}{$b}{'msg_count'}
4421                <=> $param->{'which'}{$a}{'msg_count'}
4422        } (keys(%{$param->{'which'}}))
4423    ) {
4424        if (defined $in{'count'}) {
4425            $nb_lists++;
4426            if ($nb_lists > $in{'count'}) {
4427                last;
4428            }
4429        }
4430
4431        $param->{'which'}{$l}{'name'} = $l;
4432        push @{$param->{'active_lists'}}, $param->{'which'}{$l};
4433
4434    }
4435
4436    if (defined $in{'count'}) {
4437        $param->{'count'} = $in{'count'};
4438    }
4439    if (defined $in{'for'}) {
4440        $param->{'for'} = $in{'for'};
4441    }
4442
4443    $param->{'which'} = undef;
4444
4445    return 1;
4446}
4447
4448sub do_including_lists {
4449    my %which;
4450
4451    foreach my $role (qw(member owner editor)) {
4452        foreach my $l (@{$list->get_including_lists($role) || []}) {
4453            unless (exists $which{$l->get_id}) {
4454                # Check visibility.
4455                my $result =
4456                    Sympa::Scenario->new($l, 'visibility',
4457                    dont_reload_scenario => 1)->authz(
4458                    $param->{'auth_method'},
4459                    {   'sender'      => $param->{'user'}{'email'},
4460                        'remote_host' => $param->{'remote_host'},
4461                        'remote_addr' => $param->{'remote_addr'},
4462                    }
4463                    );
4464                my $action = $result->{'action'} if ref $result eq 'HASH';
4465                next unless $action;
4466
4467                $which{$l->get_id} = {
4468                    name   => $l->{'name'},
4469                    domain => $l->{'domain'},
4470                    host   => $l->{'domain'},    # Compat.<6.2.32
4471                    robot  => $l->{'domain'},    # Compat.
4472                    subject => ($l->{'admin'}{'subject'} || $l->{'name'}),
4473                    url_abs => Sympa::get_url($l, 'info'),
4474                    url_rel =>
4475                        Sympa::get_url($l, 'info', authority => 'omit'),
4476                    visible => ($action =~ /\Ado_it\b/i),
4477                };
4478            }
4479            $which{$l->get_id}->{$role . '_include'} = 1;
4480        }
4481    }
4482
4483    $param->{which} = {%which};
4484
4485    return 1;
4486}
4487
4488sub count_total_msg_since {
4489    my $oldest_day = shift;
4490    my $count      = shift;
4491
4492    my $total = 0;
4493    foreach my $d (sort { $b <=> $a } (keys %$count)) {
4494        if ($d < $oldest_day) {
4495            last;
4496        }
4497        $total = $total + $count->{$d};
4498    }
4499    return $total;
4500}
4501
4502## List information page
4503sub do_info {
4504    wwslog('info', '');
4505
4506    ## Access control
4507    unless (defined check_authz('do_info', 'info')) {
4508        delete $param->{'list'};
4509
4510        # To prevent sniffing lists, we behave the same as when list was
4511        # unknown.
4512        return Conf::get_robot_conf($robot, 'default_home');
4513    }
4514
4515    ## Get List Description
4516    if (-r $list->{'dir'} . '/homepage') {
4517        my $file_path = $list->{'dir'} . '/homepage';
4518        $param->{'homepage_content'} = Sympa::Tools::Text::slurp($file_path);
4519        unless (defined $param->{'homepage_content'}) {
4520            wwslog('err', 'Failed to open file %s: %m', $file_path);
4521            Sympa::WWW::Report::reject_report_web('intern',
4522                'cannot_open_file', {'file' => $file_path},
4523                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
4524            web_db_log(
4525                {   'parameters' => $file_path,
4526                    'status'     => 'error',
4527                    'error_type' => 'internal'
4528                }
4529            );
4530            return undef;
4531        }
4532
4533        ## Used by previous templates
4534        $param->{'homepage'} = 1;
4535    } elsif (-r $list->{'dir'} . '/info') {
4536        my $file_path = $list->{'dir'} . '/info';
4537        $param->{'info_content'} = Sympa::Tools::Text::slurp($file_path);
4538        unless (defined $param->{'info_content'}) {
4539            wwslog('err', 'Failed to open file %s: %m', $file_path);
4540            Sympa::WWW::Report::reject_report_web('intern',
4541                'cannot_open_file', {'file' => $file_path},
4542                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
4543            web_db_log(
4544                {   'parameters' => $file_path,
4545                    'status'     => 'error',
4546                    'error_type' => 'internal'
4547                }
4548            );
4549            return undef;
4550        }
4551        #FIXME: needed?
4552        $param->{'info_content'} =~ s/\n/\<br\/\>/g;
4553    }
4554
4555    push @other_include_path, $list->{'dir'};
4556
4557    return 1;
4558}
4559
4560## List subcriber count page
4561sub do_subscriber_count {
4562    wwslog('info', '');
4563
4564    unless (do_info()) {
4565        wwslog('info', 'Error while calling do_info');
4566        return undef;
4567    }
4568
4569    print "Content-type: text/plain\n\n";
4570    print $list->get_total() . "\n";
4571
4572    $param->{'bypass'} = 'extreme';
4573
4574    return 1;
4575}
4576
4577## Subscribers' list
4578sub do_review {
4579    wwslog('info', '(%s)', $in{'page'});
4580
4581    $param->{'page'} = $in{'page'} || 1;
4582    if ($param->{'page'} eq 'owner') {
4583        return _review_user('owner');
4584    } elsif ($in{'page'} eq 'editor') {
4585        return _review_user('editor');
4586    } else {
4587        return _review_member();
4588    }
4589}
4590
4591# List of owners / editors
4592sub _review_user {
4593    wwslog('info', '(%s)', @_);
4594    my $role = shift;
4595
4596    # Access control
4597    return undef
4598        unless Sympa::is_listmaster($list, $param->{'user'}{'email'})
4599        or $list->is_admin('owner', $param->{'user'}{'email'});
4600
4601    my $new_admin = _deserialize_changes();
4602    if ($in{'submit'} and $new_admin and %$new_admin) {
4603        delete $in{'submit'};
4604
4605        my $users =
4606            [grep { $_->{role} eq $role } @{$list->get_current_admins || []}];
4607
4608        my @deleted_emails =
4609            map  { $in{$_} }
4610            grep {/\Adeleted_param[.]$role[.]\d+\z/} keys %in;
4611        my $update_admin = {
4612            $role => [
4613                map {
4614                    my $email = $_->{email};
4615                    (grep { $email eq $_ } @deleted_emails)
4616                        ? {email => undef}
4617                        : $_;
4618                } ( @$users,
4619                    grep {
4620                        $_ and $_->{email}
4621                    } @{$new_admin->{$role} || []}
4622                )
4623            ]
4624        };
4625
4626        my $config =
4627            Sympa::List::Users->new($list, config => {$role => $users});
4628        my $errors = [];
4629
4630        my $validity =
4631            $config->submit($update_admin, $param->{'user'}{'email'},
4632            $errors);
4633        unless (defined $validity) {
4634            if (my @intern = grep { $_->[0] eq 'intern' } @$errors) {
4635                foreach my $err (@intern) {
4636                    Sympa::WWW::Report::reject_report_web($err->[0],
4637                        $err->[1], {}, $param->{'action'}, $list);
4638                    wwslog('err', 'Internal error %s', $err->[1]);
4639                }
4640            } else {
4641                Sympa::WWW::Report::reject_report_web('intern', 'unknown', {},
4642                    $param->{'action'}, $list);
4643                wwslog('err', 'Unknown error');
4644            }
4645            web_db_log(
4646                {   'status'     => 'error',
4647                    'error_type' => 'internal'
4648                }
4649            );
4650            return undef;
4651        }
4652
4653        my $error_return = 0;
4654        foreach my $err (grep { $_->[0] eq 'user' } @$errors) {
4655            $error_return = 1 unless $err->[1] eq 'mandatory_parameter';
4656
4657            Sympa::WWW::Report::reject_report_web(
4658                $err->[0],
4659                $err->[1],
4660                {   'p_name' =>
4661                        $language->gettext($err->[2]->{p_info}->{gettext_id}),
4662                    %{$err->[2]}
4663                },
4664                $param->{'action'},
4665                $list
4666            );
4667            wwslog(
4668                'err',
4669                'Error on parameter %s: %s',
4670                join('.', @{$err->[2]->{p_paths}}),
4671                $err->[1]
4672            );
4673            web_db_log(
4674                {   'status'     => 'error',
4675                    'error_type' => 'syntax_errors'
4676                }
4677            );
4678        }
4679        if ($error_return) {
4680            ;
4681        } elsif ($validity eq '') {
4682            Sympa::WWW::Report::notice_report_web('no_parameter_edited',
4683                {}, $param->{'action'});
4684            wwslog('info', 'No parameter was edited by user');
4685        } else {
4686            # Validation of the form finished. Start of valid data treatments.
4687            # FIXME: Use commit().
4688
4689            # Delete/add users.
4690            my @del_users = map {
4691                my $email;
4692                if ($_ =~ /\Adeleted_param[.]$role[.]\d+\z/) {
4693                    $email = Sympa::Tools::Text::canonic_email($in{$_});
4694                    $email ? ($email) : ();
4695                } else {
4696                    ();
4697                }
4698            } keys %in;
4699            my $new_users = [grep { $_ and $_->{email} }
4700                    @{($new_admin || {})->{$role} || []}];
4701
4702            foreach my $email (@del_users) {
4703                next if grep { $email eq $_->{email} } @$new_users;
4704                $list->delete_list_admin($role, $email);
4705            }
4706            foreach
4707                my $user (@{(ref $new_users eq 'ARRAY') ? $new_users : []}) {
4708                my $email = $user->{email};
4709                if (grep { $email eq $_ } @del_users) {
4710                    ;    #FIXME: Update user?
4711                } elsif ($list->add_list_admin($role, $user)) {
4712                    # Notify the new list owner/editor
4713                    Sympa::send_notify_to_user(
4714                        $list,
4715                        'added_as_listadmin',
4716                        $email,
4717                        {   admin_type => $role,
4718                            delegator  => $param->{'user'}{'email'}
4719                        }
4720                    );
4721                    Sympa::WWW::Report::notice_report_web('user_notified',
4722                        {'notified_user' => $email},
4723                        $param->{'action'});
4724                } else {
4725                    #FIXME: Report error
4726                }
4727            }
4728
4729            if ($list->get_family and (@del_users or @{$new_users || []})) {
4730                $list->update_config_changes('param', $role);
4731            }
4732        }
4733    }
4734
4735    my $users =
4736        [grep { $_->{role} eq $role } @{$list->get_current_admins || []}];
4737    my $config = Sympa::List::Users->new($list, config => {$role => $users});
4738    my $schema = $config->get_schema($param->{'user'}{'email'});
4739    my @schema = _do_edit_list_request($config, $schema->{$role}, [$role]);
4740
4741    # If at least one param was editable, make the update button appear in
4742    # the form.
4743    $param->{'is_form_editable'} =
4744        grep { $_->{privilege} eq 'write' } @schema;
4745    $param->{'config_schema'} = [@schema];
4746    $param->{'config_values'} = {
4747        map {
4748            my @value = $config->get($_->{name});
4749            @value ? ($_->{name} => $value[0]) : ();
4750        } @schema
4751    };
4752
4753    return 1;
4754}
4755
4756sub _review_member {
4757    my $record;
4758    my @users;
4759    my $size;
4760    my $sortby = lc($in{'sortby'} || 'email');
4761
4762    ## Access control
4763    return undef unless defined check_authz('do_review', 'review');
4764
4765    if ($in{'size'}) {
4766        $size = $in{'size'};
4767        $session->{'review_page_size'} = $in{'size'};
4768        if ($param->{'user'}{'prefs'}{'review_page_size'} ne $in{'size'}) {
4769            # update user pref  as soon as connected user change page size
4770            $param->{'user'}{'prefs'}{'review_page_size'} = $in{'size'};
4771            Sympa::User::update_global_user($param->{'user'}{'email'},
4772                {data => $param->{'user'}{'prefs'}});
4773        }
4774    } else {
4775        $size =
4776               $param->{'user'}{'prefs'}{'review_page_size'}
4777            || $session->{'review_page_size'}
4778            || $Conf::Conf{'review_page_size'};
4779    }
4780    $param->{'review_page_size'} = $size;
4781
4782    unless ($param->{'total'}) {
4783        wwslog('info', 'No subscriber');
4784
4785        return 1;
4786    }
4787
4788    ## Owner
4789    $param->{'page'} = $in{'page'} || 1;
4790    $param->{'total_page'} = int($param->{'total'} / $size);
4791    $param->{'total_page'}++
4792        if ($param->{'total'} % $size);
4793
4794    if ($param->{'total_page'} > 0
4795        and ($param->{'page'} > $param->{'total_page'})) {
4796        Sympa::WWW::Report::reject_report_web('user', 'no_page',
4797            {'page' => $param->{'page'}},
4798            $param->{'action'}, $list);
4799        web_db_log({'status' => 'error', 'error_type' => 'out of pages'});
4800        wwslog('info', 'No page %d', $param->{'page'});
4801        return undef;
4802    }
4803
4804    my $offset;
4805    if ($param->{'page'} > 1) {
4806        $offset = (($param->{'page'} - 1) * $size);
4807    } else {
4808        $offset = 0;
4809    }
4810
4811    ## Additional DB fields
4812    my @additional_fields = split ',',
4813        $Conf::Conf{'db_additional_subscriber_fields'};
4814
4815    # Members list
4816    # Some review pages may be empty while viewed by subscribers.
4817    my @members = $list->get_members(
4818        ($param->{'is_priv'} ? 'member' : 'unconcealed_member'),
4819        (     ($sortby eq 'domain')
4820            ? (order => 'email')
4821            : (offset => $offset, order => $sortby, limit => $size)
4822        )
4823    );
4824    # Special treatment of key "domain".
4825    if ($sortby eq 'domain') {
4826        # Sort
4827        foreach my $u (@members) {
4828            $u ||= {};
4829            my ($local, $dom) = split /\@/, ($u->{email} || '');
4830            $u->{_dom} = join '.', reverse split(/[.]/, $dom);
4831        }
4832        @members = sort { $a->{_dom} cmp $b->{_dom} } @members;
4833        # Offset
4834        splice @members, 0, $offset if $offset and @members;
4835        # Size
4836        @members = splice @members, 0, $size if $size and @members;
4837    }
4838    foreach my $i (@members) {
4839        # Add user
4840        _prepare_subscriber($i, \@additional_fields);
4841        push @{$param->{'members'}}, $i;
4842    }
4843
4844    if ($param->{'page'} > 1) {
4845        $param->{'prev_page'} = $param->{'page'} - 1;
4846    }
4847
4848    unless (($offset + $size) >= $param->{'total'}) {
4849        $param->{'next_page'} = $param->{'page'} + 1;
4850    }
4851
4852    $param->{'size'}   = $size;
4853    $param->{'sortby'} = $sortby;
4854
4855    ######################
4856    if ($in{'exclude'} eq '1') {
4857        $param->{'exclude_opt'} = 0;
4858    } else {
4859        $param->{'exclude_opt'} = 1;
4860    }
4861    #######################
4862
4863    ## additional DB fields
4864    $param->{'additional_fields'} =
4865        $Conf::Conf{'db_additional_subscriber_fields'};
4866    web_db_log({'status' => 'success'});
4867
4868    ## msg_topics
4869    if ($list->is_there_msg_topic()) {
4870        foreach my $top (@{$list->{'admin'}{'msg_topic'}}) {
4871            if (defined $top->{'name'}) {
4872                push(@{$param->{'available_topics'}}, $top);
4873            }
4874        }
4875    }
4876
4877    return 1;
4878}
4879
4880sub do_edit {
4881    wwslog('info', '(%s, %s)', $in{'role'}, $in{'email'});
4882
4883    my $role  = $in{'role'};
4884    my $email = $in{'email'};
4885
4886    $param->{'role'} = $role;
4887    $param->{'page'} = $role;    # For review action
4888
4889    my $users = [grep { $_ and $_->{email} eq $email and $_->{role} eq $role }
4890            @{$list->get_current_admins || []}];
4891    #FIXME
4892    return 1 unless @$users;
4893
4894    my $config = Sympa::List::Users->new($list, config => {$role => $users});
4895    my $schema = $config->get_schema($param->{'user'}{'email'});
4896    my @schema = _do_edit_list_request($config, $schema->{$role}, [$role]);
4897
4898    # Initial access. show current value.
4899    my $new_admin = _deserialize_changes();
4900    if ($in{'submit'} and $new_admin and %$new_admin) {
4901        delete $in{'submit'};
4902
4903        #FIXME
4904        return 1 unless $new_admin->{$role} and $new_admin->{$role}->[0];
4905        # Prevent changing email.
4906        $new_admin->{$role}->[0]->{email} = $email;
4907
4908        # Start parsing the data sent by the edition form.
4909        my $errors   = [];
4910        my $validity = $config->submit(
4911            $new_admin, $param->{'user'}{'email'},
4912            $errors, no_global_validations => 1
4913        );
4914        unless (defined $validity) {
4915            if (my @intern = grep { $_->[0] eq 'intern' } @$errors) {
4916                foreach my $err (@intern) {
4917                    Sympa::WWW::Report::reject_report_web($err->[0],
4918                        $err->[1], {}, $param->{'action'}, $list);
4919                    wwslog('err', 'Internal error %s', $err->[1]);
4920                }
4921            } else {
4922                Sympa::WWW::Report::reject_report_web('intern', 'unknown', {},
4923                    $param->{'action'}, $list);
4924                wwslog('err', 'Unknown error');
4925            }
4926            web_db_log(
4927                {   'status'     => 'error',
4928                    'error_type' => 'internal'
4929                }
4930            );
4931            return undef;
4932        }
4933
4934        my $error_return = 0;
4935        foreach my $err (grep { $_->[0] eq 'user' } @$errors) {
4936            $error_return = 1 unless $err->[1] eq 'mandatory_parameter';
4937
4938            Sympa::WWW::Report::reject_report_web(
4939                $err->[0],
4940                $err->[1],
4941                {   'p_name' =>
4942                        $language->gettext($err->[2]->{p_info}->{gettext_id}),
4943                    %{$err->[2]}
4944                },
4945                $param->{'action'},
4946                $list
4947            );
4948            wwslog(
4949                'err',
4950                'Error on parameter %s: %s',
4951                join('.', @{$err->[2]->{p_paths}}),
4952                $err->[1]
4953            );
4954            web_db_log(
4955                {   'status'     => 'error',
4956                    'error_type' => 'syntax_errors'
4957                }
4958            );
4959        }
4960        if ($error_return) {
4961            ;
4962        } elsif ($validity eq '') {
4963            Sympa::WWW::Report::notice_report_web('no_parameter_edited',
4964                {}, $param->{'action'});
4965            wwslog('info', 'No parameter was edited by user');
4966        } else {
4967            # Validation of the form finished. Start of valid data
4968            # treatments.
4969            # FIXME: Use commit().
4970            $list->update_list_admin($email, $role, $new_admin->{$role}->[0]);
4971
4972            # Keep track of changes for family.
4973            if ($list->get_family) {
4974                $list->update_config_changes('param', $role);
4975            }
4976        }
4977
4978        $in{'page'} = $role;    # For review.
4979        return $in{'previous_action'} || 'review';
4980    }
4981
4982    # If at least one param was editable, make the update button appear in
4983    # the form.
4984    $param->{'is_form_editable'} =
4985        grep { $_->{privilege} eq 'write' } @schema;
4986    $param->{'config_schema'} = [@schema];
4987    $param->{'config_values'} = {$role => $users} if $users and @$users;
4988
4989    $param->{'previous_action'} = $in{'previous_action'} || 'review';
4990    return 1;
4991}
4992
4993## Show the table of exclude
4994sub do_show_exclude {
4995    wwslog('info', '');
4996
4997    return undef
4998        unless $param->{'user'}{'email'};
4999
5000    # Get the emails of the exclude about a list and the date of their
5001    # insertion
5002    my $data_exclu = $list->get_exclusion();
5003
5004    my $excluded;
5005    my $key = 0;
5006    while (($data_exclu->{emails}->[$key]) && ($data_exclu->{date}->[$key])) {
5007        my $email = $data_exclu->{'emails'}->[$key];
5008        my $date =
5009            $language->gettext_strftime("%d %b %Y",
5010            localtime($data_exclu->{'date'}->[$key]));
5011
5012        $excluded = {
5013            'email' => $email,
5014            'since' => $date
5015        };
5016        push @{$param->{'exclude_users'}}, $excluded;
5017        $key = $key + 1;
5018    }
5019    return 1;
5020}
5021
5022## Search in subscribers and in exclude
5023sub do_search {
5024    wwslog('info', '(%s)', $in{'filter'});
5025
5026    my %emails;
5027
5028    ## Additional DB fields
5029    my @additional_fields = split ',',
5030        $Conf::Conf{'db_additional_subscriber_fields'};
5031    ## Access control
5032    return undef unless defined check_authz('do_search', 'review');
5033
5034    # Search key.
5035    # GH #341: Keep search key in session store.
5036    $param->{'filter'} = $in{'filter'} || $session->{'search__filter'};
5037    my $searchkey = Sympa::Tools::Text::foldcase($param->{'filter'})
5038        if defined $param->{'filter'} and length $param->{'filter'};
5039    $session->{'search__filter'} = $param->{'filter'};
5040
5041    return 1 unless defined $searchkey;
5042
5043    my $record = 0;
5044    ## Maximum size of selection
5045    my $max_select = 50;
5046
5047    ## Members list
5048    for (
5049        my $i = $list->get_first_list_member({'sortby' => 'email'});
5050        $i;
5051        $i = $list->get_next_list_member()
5052    ) {
5053
5054        ## Search filter
5055        next if $i->{'visibility'} eq 'conceal' and !$param->{'is_owner'};
5056
5057        if (defined $searchkey) {
5058            my $gecos = undef;
5059            $gecos = Sympa::Tools::Text::foldcase($i->{'gecos'})
5060                if defined $i->{'gecos'};
5061            next
5062                unless index($i->{'email'}, $searchkey) >= 0
5063                or (defined $gecos and index($gecos, $searchkey) >= 0);
5064        }
5065
5066        ## Add user
5067        _prepare_subscriber($i, \@additional_fields);
5068
5069        $record++;
5070        push @{$param->{'members'}}, $i;
5071        $emails{$i->{'email'}} = 1;
5072    }
5073
5074    my $data_exclu = $list->get_exclusion();
5075    my $key        = 0;
5076    ## Exclude users are searched too
5077    while (($data_exclu->{emails}->[$key]) && ($data_exclu->{date}->[$key])) {
5078        my $email = $data_exclu->{'emails'}->[$key];
5079        my $date =
5080            $language->gettext_strftime("%d %b %Y",
5081            localtime($data_exclu->{'date'}->[$key]));
5082        $key = $key + 1;
5083
5084        ## Search filter
5085        next unless $param->{'is_owner'};
5086
5087        if (defined $searchkey) {
5088            next unless index($email, $searchkey) >= 0;
5089        }
5090
5091        my $excluded = {
5092            'email' => $email,
5093            'since' => $date
5094        };
5095
5096        push @{$param->{'exclude_users'}}, $excluded;
5097        $record++;
5098    }
5099
5100    if ($record > $max_select && $param->{'filter'} !~ /^\@[\w-]+\./) {
5101        undef $param->{'members'};
5102        $param->{'too_many_select'} = 1;
5103    }
5104
5105    $param->{'similar_subscribers_occurrence'} = 0;
5106    if ($param->{'filter'} !~ /^\@[\w-]+\./) {
5107        foreach my $user (
5108            $list->get_resembling_members(
5109                ($param->{'is_owner'} ? 'member' : 'unconcealed_member'),
5110                $in{'filter'}
5111            )
5112        ) {
5113            next unless $user and $user->{email};
5114
5115            next if $emails{$user->{email}};
5116            push @{$param->{'similar_subscribers'}}, $user;
5117            last if ($#{$param->{'similar_subscribers'}} + 1 > $max_select);
5118        }
5119        $param->{'similar_subscribers_occurrence'} =
5120            $#{$param->{'similar_subscribers'}} + 1;
5121    }
5122    # for misspelling in 6.2a or earlier.
5123    $param->{'similar_subscribers_occurence'} =
5124        $param->{'similar_subscribers_occurrence'};
5125
5126    $param->{'occurrence'} = $record;
5127    return 1;
5128}
5129
5130## Access to user preferences
5131sub do_pref {
5132    wwslog('info', '');
5133
5134    ## Find nearest expiration period
5135    my $selected = 0;
5136    foreach my $p (sort { $b <=> $a } keys %Sympa::WWW::Tools::cookie_period)
5137    {
5138        my $entry = {'value' => $p};
5139
5140        ## Set description from NLS
5141        $entry->{'desc'} =
5142            $language->gettext(
5143            $Sympa::WWW::Tools::cookie_period{$p}{'gettext_id'});
5144
5145        ## Choose nearest delay
5146        if ((!$selected) && $param->{'user'}{'cookie_delay'} >= $p) {
5147            $entry->{'selected'} = 'selected="selected"';
5148            $selected = 1;
5149        }
5150
5151        unshift @{$param->{'cookie_periods'}}, $entry;
5152    }
5153
5154    $param->{'previous_list'}   = $in{'previous_list'};
5155    $param->{'previous_action'} = $in{'previous_action'};
5156
5157    return 1;
5158}
5159
5160## Set the initial password
5161sub do_choosepasswd {
5162    wwslog('info', '');
5163
5164    if ($session->{'auth'} eq 'ldap') {
5165        Sympa::WWW::Report::reject_report_web('auth', '',
5166            {'login' => $param->{'need_login'}},
5167            $param->{'action'});
5168        wwslog('notice', 'User not authorized');
5169        web_db_log(
5170            {   'parameters'   => $in{'email'},
5171                'target_email' => $in{'email'},
5172                'status'       => 'error',
5173                'error_type'   => 'authorization'
5174            }
5175        );
5176    }
5177
5178    unless ($param->{'user'}{'email'}) {
5179        unless ($in{'email'} && $in{'passwd'}) {
5180            Sympa::WWW::Report::reject_report_web('user', 'no_user', {},
5181                $param->{'action'});
5182            wwslog('info', 'No user');
5183            web_db_log(
5184                {   'parameters'   => $in{'email'},
5185                    'target_email' => $in{'email'},
5186                    'status'       => 'error',
5187                    'error_type'   => 'no_user'
5188                }
5189            );
5190        }
5191
5192        $in{'previous_action'} = 'choosepasswd';
5193        delete $in{'submit'};    # Clear it.
5194        return 'login';
5195    }
5196    web_db_log(
5197        {   'parameters'   => "$in{'email'}",
5198            'target_email' => $in{'email'} || $param->{'user'}{'email'},
5199            'status'       => 'success',
5200        }
5201    );
5202    $param->{'init_passwd'} = 1 if ($param->{'user'}{'password'} =~ /^INIT/i);
5203
5204    return 1;
5205}
5206
5207####################################################
5208# do_set
5209####################################################
5210# Changes subscription parameter (reception or visibility)
5211#
5212# IN : -
5213#
5214# OUT :'loginrequest'|'info' | undef
5215
5216sub do_set {
5217    wwslog('info', '(%s, %s)', $in{'reception'}, $in{'visibility'});
5218
5219    my ($reception, $visibility) = ($in{'reception'}, $in{'visibility'});
5220    my $email;
5221
5222    if ($in{custom_attribute}) {
5223        return undef
5224            unless _check_custom_attribute($list, $param->{action},
5225            $in{custom_attribute});
5226    }
5227
5228    if ($in{'email'}) {
5229        unless ($param->{'is_owner'}) {
5230            Sympa::WWW::Report::reject_report_web('auth', 'action_owner', {},
5231                $param->{'action'}, $list);
5232            wwslog('info', 'Not owner');
5233            web_db_log(
5234                {   'parameters' => "$in{'reception'},$in{'visibility'}",
5235                    'status'     => 'error',
5236                    'error_type' => 'authorization'
5237                }
5238            );
5239            return undef;
5240        }
5241
5242        $email = $in{'email'};
5243    } else {
5244        $email = $param->{'user'}{'email'};
5245    }
5246
5247    unless ($list->is_list_member($email)) {
5248        Sympa::WWW::Report::reject_report_web('user', 'not_subscriber',
5249            {email => $email, listname => $param->{'list'}},
5250            $param->{'action'}, $list);
5251        wwslog('info', '%s not subscriber of list %s',
5252            $email, $param->{'list'});
5253        web_db_log(
5254            {   'parameters' => "$in{'reception'},$in{'visibility'}",
5255                'status'     => 'error',
5256                'error_type' => 'not_subscriber'
5257            }
5258        );
5259        return undef;
5260    }
5261
5262    # Verify that the mode is allowed
5263    if (!$list->is_available_reception_mode($reception)) {
5264        Sympa::WWW::Report::reject_report_web(
5265            'user',
5266            'not_available_reception_mode',
5267            {   reception_modes => [$list->available_reception_mode],
5268                recpetion_mode  => $reception,
5269                listname        => $list->{'name'},
5270            },
5271            $param->{'action'},
5272            $list
5273        );
5274        return undef;
5275    }
5276
5277    $reception  = '' if $reception eq 'mail';
5278    $visibility = '' if $visibility eq 'noconceal';
5279
5280    my $update = {
5281        'reception'   => $reception,
5282        'visibility'  => $visibility,
5283        'update_date' => time
5284    };
5285
5286    ## Lower-case new email address
5287    $in{'new_email'} = lc($in{'new_email'});
5288
5289    if ($in{'new_email'} and $in{'email'} ne $in{'new_email'}) {
5290        unless ($in{'new_email'}
5291            and Sympa::Tools::Text::valid_email($in{'new_email'})) {
5292            wwslog('notice', 'Incorrect email %s', $in{'new_email'});
5293            Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
5294                {'email' => $in{'new_email'}},
5295                $param->{'action'});
5296            web_db_log(
5297                {   'parameters' => "$in{'reception'},$in{'visibility'}",
5298                    'status'     => 'error',
5299                    'error_type' => 'incorrect_email'
5300                }
5301            );
5302            return undef;
5303        }
5304
5305        ## Check if new email is already subscribed
5306        if ($list->is_list_member($in{'new_email'})) {
5307            Sympa::WWW::Report::reject_report_web('user',
5308                'already_subscriber',
5309                {email => $in{'new_email'}, listname => $list->{'name'}},
5310                $param->{'action'}, $list);
5311            wwslog('info', '%s already subscriber', $in{'new_email'});
5312            web_db_log(
5313                {   'parameters' => $in{'new_email'},
5314                    'status'     => 'error',
5315                    'error_type' => 'already subscriber'
5316                }
5317            );
5318            return undef;
5319        }
5320
5321        ## Duplicate entry in user_table
5322        unless (Sympa::User::is_global_user($in{'new_email'})) {
5323
5324            my $user_pref = Sympa::User::get_global_user($in{'email'});
5325            $user_pref->{'email'} = $in{'new_email'};
5326            Sympa::User::add_global_user($user_pref);
5327        }
5328
5329        $update->{'email'} = $in{'new_email'};
5330    }
5331
5332    ## message topic subscription
5333    if ($list->is_there_msg_topic()) {
5334        my @user_topics;
5335
5336        if ($in{'no_topic'}) {
5337            $update->{'topics'} = undef;
5338
5339        } else {
5340            foreach my $msg_topic (@{$list->{'admin'}{'msg_topic'}}) {
5341                my $var_name = "topic_" . "$msg_topic->{'name'}";
5342                if ($in{"$var_name"}) {
5343                    push @user_topics, $msg_topic->{'name'};
5344                }
5345            }
5346
5347            if ($in{"topic_other"}) {
5348                push @user_topics, 'other';
5349            }
5350
5351            $update->{'topics'} = join(',', @user_topics);
5352        }
5353    }
5354
5355    if ($reception =~ /^(digest|digestplain|nomail|summary)$/i) {
5356        $update->{'topics'} = '';
5357    }
5358
5359    ## Get additional DB fields
5360    foreach my $v (keys %in) {
5361        if ($v =~ /^additional_field_(\w+)$/) {
5362            $update->{$1} = $in{$v};
5363        }
5364    }
5365
5366    if ($in{'gecos'}) {
5367        $update->{'gecos'} = $in{'gecos'};
5368    } else {
5369        $update->{'gecos'} = undef;
5370    }
5371    $update->{'custom_attribute'} = $in{custom_attribute}
5372        if $in{custom_attribute};
5373
5374    unless ($list->update_list_member($email, $update)) {
5375        Sympa::WWW::Report::reject_report_web('intern',
5376            'update_subscriber_db_failed', {'sub' => $email},
5377            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
5378        wwslog('info', 'Set failed');
5379        web_db_log(
5380            {   'parameters' => "$email,$update",
5381                'status'     => 'error',
5382                'error_type' => 'internal'
5383            }
5384        );
5385        return undef;
5386    }
5387
5388    Sympa::WWW::Report::notice_report_web('performed', {},
5389        $param->{'action'});
5390    web_db_log(
5391        {   'parameters' => "$in{'reception'},$in{'visibility'}",
5392            'status'     => 'success',
5393        }
5394    );
5395
5396    return $in{'previous_action'} || 'info';
5397}
5398
5399## checks if each element of the custom attribute is conform to the list's
5400## definition
5401# Old name: check_custom_attribute() in wwsympa.fcgi.
5402# TODO: This would be moved to a method of appropriate class.
5403sub _check_custom_attribute {
5404    my $list             = shift;
5405    my $action           = shift;
5406    my $custom_attribute = shift;
5407
5408    my @custom_attributes = @{$list->{'admin'}{'custom_attribute'}};
5409    my $isOK              = 1;
5410
5411    foreach my $ca (@custom_attributes) {
5412        my $value = $custom_attribute->{$ca->{id}}{value};
5413        if (    $ca->{optional}
5414            and $ca->{optional} eq 'required'
5415            and not(defined $value and length $value)) {
5416            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
5417                {'argument' => $ca->{name}}, $action);
5418            wwslog('info', 'Missing parameter "%s"', $ca->{id});
5419            web_db_log(
5420                {   'parameters' => $ca->{id},
5421                    'status'     => 'error',
5422                    'error_type' => 'missing_parameter'
5423                }
5424            );
5425            $isOK = undef;
5426            next;
5427        }
5428
5429        # No further checking if attribute is empty.
5430        next unless defined $value and length $value;
5431
5432        my @values = split /,/, $ca->{enum_values}
5433            if defined $ca->{enum_values};
5434
5435        ## Check that the parameter has the correct format
5436        unless (($ca->{type} eq 'enum' and grep { $value eq $_ } @values)
5437            or ($ca->{type} eq 'integer' and $value =~ /\A\d+\z/)
5438            or ($ca->{type} eq 'string'  and $value =~ /\A.+\z/)
5439            or ($ca->{type} eq 'text'    and length $value)) {
5440            Sympa::WWW::Report::reject_report_web('user', 'syntax_errors',
5441                {p_name => $ca->{name}}, $action);
5442            wwslog('info', 'Syntax error in parameter "%s"', $ca->{id});
5443            web_db_log(
5444                {   'parameters' => $ca->{id},
5445                    'status'     => 'error',
5446                    'error_type' => 'missing_parameter'
5447                }
5448            );
5449            $isOK = undef;
5450            next;
5451        }
5452    }
5453    return $isOK;
5454}
5455
5456## Update of user preferences
5457sub do_setpref {
5458    wwslog('info', '');
5459    my $changes = {};
5460
5461    # Set session language and user language to new value
5462    # At first check if it is available lang.
5463    my $lang;
5464    if ($in{'lang'} and $lang = $language->set_lang($in{'lang'})) {
5465        $session->{'lang'} = $lang;
5466        $param->{'lang'}   = $lang;
5467        # compatibility: 6.1.
5468        $param->{'lang_tag'} = $lang;
5469
5470        $changes->{'lang'} = $lang;
5471    }
5472    # other prefs.
5473    foreach my $p ('gecos', 'cookie_delay') {
5474        $changes->{$p} = $in{$p} if defined $in{$p};
5475    }
5476
5477    if (Sympa::User::is_global_user($param->{'user'}{'email'})) {
5478
5479        unless (
5480            Sympa::User::update_global_user(
5481                $param->{'user'}{'email'}, $changes
5482            )
5483        ) {
5484            Sympa::WWW::Report::reject_report_web(
5485                'intern', 'update_user_db_failed',
5486                {'user' => $param->{'user'}}, $param->{'action'},
5487                '', $param->{'user'}{'email'},
5488                $robot
5489            );
5490            wwslog('info', 'Update failed');
5491            web_db_log(
5492                {   'parameters' =>
5493                        "$in{'gecos'},$in{'lang'},$in{'cookie_delay'}",
5494                    'status'     => 'error',
5495                    'error_type' => 'internal'
5496                }
5497            );
5498            return undef;
5499        }
5500    } else {
5501        $changes->{'email'} = $param->{'user'}{'email'};
5502        unless (Sympa::User::add_global_user($changes)) {
5503            Sympa::WWW::Report::reject_report_web('intern',
5504                'add_user_db_failed', {'user' => $param->{'user'}},
5505                $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
5506            wwslog('info', 'Add failed');
5507            web_db_log(
5508                {   'parameters' =>
5509                        "$in{'gecos'},$in{'lang'},$in{'cookie_delay'}",
5510                    'status'     => 'error',
5511                    'error_type' => 'internal'
5512                }
5513            );
5514            return undef;
5515        }
5516    }
5517
5518    $param->{'user'} =
5519        Sympa::User::get_global_user($param->{'user'}{'email'});
5520
5521    web_db_log(
5522        {   'parameters' => "$in{'gecos'},$in{'lang'},$in{'cookie_delay'}",
5523            'status'     => 'success',
5524        }
5525    );
5526    if ($in{'previous_action'}) {
5527        $in{'list'} = $in{'previous_list'};
5528        return $in{'previous_action'};
5529    } else {
5530        return 'pref';
5531    }
5532}
5533
5534## Prendre en compte les défauts
5535# No longer used.
5536#sub do_viewfile;
5537
5538# Subscribes a user to the list
5539# IN : email, gecos, custom_attribute.
5540# OUT :'subscribe' | 'info' | $in{'previous_action'} | undef
5541sub do_subscribe {
5542    wwslog('info', '(%s)', $in{'email'});
5543
5544    my $scenario = Sympa::Scenario->new($list, 'subscribe') or return undef;
5545    return $in{'previous_action'} || 'info' if $scenario->is_purely_closed;
5546
5547    if (    $param->{'user'}{'email'}
5548        and $list->is_list_member($param->{'user'}{'email'})) {
5549        # Already subscribed and logged in.
5550        return 1;
5551    }
5552
5553    my ($sender, $email, $gecos);
5554    if ($param->{'user'} and $param->{'user'}{'email'}) {
5555        $sender = $param->{'user'}{'email'};
5556        $email  = $param->{'user'}{'email'};
5557        $gecos  = $in{'gecos'} || $param->{'user'}{'gecos'};
5558    } else {
5559        # User is not autenticated.
5560        $sender = 'nobody';
5561        $email  = Sympa::Tools::Text::canonic_email($in{'email'});
5562        $gecos  = $in{'gecos'};
5563    }
5564
5565    @{$param}{qw(email gecos custom_attribute)} =
5566        ($email, $gecos, $in{'custom_attribute'});
5567
5568    # Initial access. show empty form.
5569    unless ($in{'email'}) {
5570        return 1;
5571    }
5572
5573    if ($list->{'admin'}{'custom_attribute'}
5574        and not _check_custom_attribute(
5575            $list, $param->{'action'}, $in{'custom_attribute'}
5576        )
5577    ) {
5578        wwslog('notice', "Missing required custom attributes");
5579        return 1;
5580    }
5581    unless ($email and Sympa::Tools::Text::valid_email($email)) {
5582        return 1;
5583    }
5584
5585    # Action confirmed?
5586    my $next_action = $session->confirm_action(
5587        $in{'action'}, $in{'response_action'},
5588        arg             => join(',', grep {$_} ($email, $gecos)),
5589        previous_action => ($in{'previous_action'} || 'info')
5590    );
5591    return $next_action unless $next_action eq '1';
5592
5593    my $spindle = Sympa::Spindle::ProcessRequest->new(
5594        context => $list,
5595        action  => 'subscribe',
5596        sender  => $sender,
5597        email   => $email,
5598        gecos   => $gecos,
5599        (   $in{'custom_attribute'}
5600            ? (custom_attribute => $in{'custom_attribute'})
5601            : ()
5602        ),
5603        (   $param->{'user'}{'email'} ? (md5_check => 1)
5604            : ()
5605        ),
5606        scenario_context => {
5607            sender      => $sender,
5608            remote_host => $param->{'remote_host'},
5609            remote_addr => $param->{'remote_addr'},
5610        },
5611    );
5612    unless ($spindle and $spindle->spin) {
5613        wwslog('err', 'Failed to add user');
5614        return undef;
5615    }
5616
5617    foreach my $report (@{$spindle->{stash} || []}) {
5618        if ($report->[1] eq 'notice') {
5619            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
5620                $param->{'action'});
5621        } else {
5622            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
5623                $param->{action});
5624        }
5625    }
5626    unless (@{$spindle->{stash} || []}) {
5627        Sympa::WWW::Report::notice_report_web('performed', {},
5628            $param->{'action'});
5629        web_db_log({'parameters' => $in{'email'}, 'status' => 'success'});
5630    }
5631
5632    return ($in{'previous_action'} || 'info');
5633}
5634
5635# No longer used.
5636#sub do_multiple_subscribe;
5637
5638sub do_suboptions {
5639    wwslog('info', '');
5640
5641    my ($s, $m);
5642
5643    unless ($s = $param->{'subscriber'}) {
5644        Sympa::WWW::Report::reject_report_web(
5645            'user',
5646            'not_subscriber',
5647            {email => $param->{'user'}{'email'}, listname => $list->{'name'}},
5648            $param->{'action'},
5649            $list,
5650            $param->{'user'}{'email'},
5651            $robot
5652        );
5653        wwslog('info', 'Subscriber %s not found', $param->{'user'}{'email'});
5654        return $in{'previous_action'} || 'info';
5655    }
5656
5657    foreach $m ($list->available_reception_mode) {
5658        if ($s->{'reception'} eq $m) {
5659            $param->{'reception'}{$m}{'selected'} = ' selected';
5660            if ($m =~ /^(mail|notice|not_me|txt|html|urlize)$/i) {
5661                $param->{'possible_topic'} = 1;
5662            }
5663        } else {
5664            $param->{'reception'}{$m}{'selected'} = '';
5665        }
5666    }
5667
5668    foreach $m (qw(conceal noconceal)) {
5669        if ($s->{'visibility'} eq $m) {
5670            $param->{'visibility'}{$m}{'selected'} = ' selected';
5671        } else {
5672            $param->{'visibility'}{$m}{'selected'} = '';
5673        }
5674    }
5675
5676    #msg_topic
5677    $param->{'sub_user_topic'} = 0;
5678    foreach my $user_topic (split(/,/, $s->{'topics'})) {
5679        $param->{'topic_checked'}{$user_topic} = 1;
5680        $param->{'sub_user_topic'}++;
5681    }
5682
5683    if ($list->is_there_msg_topic()) {
5684        foreach my $top (@{$list->{'admin'}{'msg_topic'}}) {
5685            if (defined $top->{'name'}) {
5686                push(@{$param->{'available_topics'}}, $top);
5687            }
5688        }
5689    }
5690
5691    return 1;
5692}
5693
5694#OBSOLETED. Now 'subrequest' is an alias of 'subscribe'.
5695#sub do_subrequest;
5696
5697# Unsubcribes a user from a list, without authentication.
5698# This function will be used for unsubscription link in such as the message
5699# footer.
5700sub do_auto_signoff {
5701    wwslog('info', '(%s)', $in{'email'});
5702    # If the URL isn't valid, then go to home page. No need to guide the
5703    # user: this function is supposed to be used by clicking on autocreated
5704    # URL only.
5705    my $default_home = Conf::get_robot_conf($robot, 'default_home');
5706
5707    my $scenario = Sympa::Scenario->new($list, 'unsubscribe') or return undef;
5708    return $default_home if $scenario->is_purely_closed;
5709
5710    my $email = Sympa::Tools::Text::canonic_email($in{'email'});
5711    return $default_home
5712        unless $email and Sympa::Tools::Text::valid_email($email);
5713
5714    $param->{'email'} = $email;
5715
5716    # Action confirmed?
5717    my $next_action = $session->confirm_action(
5718        $in{'action'}, $in{'response_action'},
5719        arg             => $email,
5720        previous_action => $default_home
5721    );
5722    return $next_action unless $next_action eq '1';
5723
5724    my $spindle = Sympa::Spindle::ProcessRequest->new(
5725        context          => $list,
5726        action           => 'signoff',
5727        sender           => 'nobody',
5728        email            => $email,
5729        scenario_context => {
5730            sender      => 'nobody',
5731            remote_host => $param->{'remote_host'},
5732            remote_addr => $param->{'remote_addr'},
5733        },
5734    );
5735    unless ($spindle and $spindle->spin) {
5736        wwslog('err', 'Failed to delete user');
5737        return undef;
5738    }
5739
5740    foreach my $report (@{$spindle->{stash} || []}) {
5741        if ($report->[1] eq 'notice') {
5742            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
5743                $param->{'action'});
5744        } else {
5745            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
5746                $param->{action});
5747        }
5748    }
5749    unless (@{$spindle->{stash} || []}) {
5750        Sympa::WWW::Report::notice_report_web('performed', {},
5751            $param->{'action'});
5752        web_db_log({'parameters' => $in{'email'}, 'status' => 'success'});
5753    }
5754
5755    return $default_home;
5756}
5757
5758# Became an alias of do_family_signoff().
5759#sub do_family_signoff_request {
5760
5761sub do_family_signoff {
5762    wwslog('info', '(%s, %s)', $in{'family'}, $in{'email'});
5763    # If the URL isn't valid, then go to home page. No need to guide the
5764    # user: this function is supposed to be used by clicking on autocreated
5765    # URL only.
5766    my $default_home = Conf::get_robot_conf($robot, 'default_home');
5767
5768    my $scenario = Sympa::Scenario->new($robot, 'family_signoff')
5769        or return undef;
5770    return $default_home if $scenario->is_purely_closed;
5771
5772    return $default_home unless $in{'email'} and $in{'family'};    #FIXME
5773    my $family = Sympa::Family->new($in{'family'}, $robot);
5774    return $default_home
5775        unless $family;
5776    my $email = Sympa::Tools::Text::canonic_email($in{'email'});
5777    return $default_home
5778        unless $email and Sympa::Tools::Text::valid_email($email);
5779
5780    $param->{'email'}  = $email;
5781    $param->{'family'} = $family->{name};
5782
5783    # Action confirmed?
5784    my $next_action = $session->confirm_action(
5785        $in{'action'}, $in{'response_action'},
5786        arg             => $email,
5787        previous_action => $default_home
5788    );
5789    return $next_action unless $next_action eq '1';
5790
5791    my $spindle = Sympa::Spindle::ProcessRequest->new(
5792        context          => $family,
5793        action           => 'family_signoff',
5794        sender           => 'nobody',
5795        email            => $email,
5796        scenario_context => {
5797            sender      => 'nobody',
5798            remote_host => $param->{'remote_host'},
5799            remote_addr => $param->{'remote_addr'},
5800        },
5801    );
5802    unless ($spindle and $spindle->spin) {
5803        wwslog('err', 'Failed to delete user');
5804        return undef;
5805    }
5806
5807    foreach my $report (@{$spindle->{stash} || []}) {
5808        if ($report->[1] eq 'notice') {
5809            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
5810                $param->{'action'});
5811        } else {
5812            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
5813                $param->{action});
5814        }
5815    }
5816    unless (@{$spindle->{stash} || []}) {
5817        Sympa::WWW::Report::notice_report_web('performed_soon', {},
5818            $param->{'action'});
5819        web_db_log({'parameters' => $in{'email'}, 'status' => 'success'});
5820    }
5821
5822    return $default_home;
5823}
5824
5825# Unsubcribes a user from a list
5826# IN : email
5827# OUT : 'signoff' | 'info' | undef
5828sub do_signoff {
5829    wwslog('info', '(%s)', $in{'email'});
5830
5831    my $scenario = Sympa::Scenario->new($list, 'unsubscribe') or return undef;
5832    return $in{'previous_action'} || 'info' if $scenario->is_purely_closed;
5833
5834    if ($param->{'user'}{'email'}
5835        and not $list->is_list_member($param->{'user'}{'email'})) {
5836        # Not yet subscribed and already logged in.
5837        return 1;
5838    }
5839
5840    my ($sender, $email);
5841    if ($param->{'user'} and $param->{'user'}{'email'}) {
5842        $sender = $param->{'user'}{'email'};
5843        $email  = $param->{'user'}{'email'};
5844    } else {
5845        # User is not autenticated.
5846        $sender = 'nobody';
5847        $email  = Sympa::Tools::Text::canonic_email($in{'email'});
5848    }
5849
5850    $param->{email} = $email;
5851
5852    unless ($email and Sympa::Tools::Text::valid_email($email)) {
5853        return 1;
5854    }
5855
5856    # Action confirmed?
5857    my $next_action = $session->confirm_action(
5858        $in{'action'}, $in{'response_action'},
5859        arg             => $email,
5860        previous_action => ($in{'previous_action'} || 'info')
5861    );
5862    return $next_action unless $next_action eq '1';
5863
5864    my $spindle = Sympa::Spindle::ProcessRequest->new(
5865        context => $list,
5866        action  => 'signoff',
5867        sender  => $sender,
5868        email   => $email,
5869        (   $param->{'user'}{'email'}
5870            ? (md5_check => 1)
5871            : ()
5872        ),
5873        scenario_context => {
5874            sender      => $sender,
5875            remote_host => $param->{'remote_host'},
5876            remote_addr => $param->{'remote_addr'},
5877        },
5878    );
5879    unless ($spindle and $spindle->spin) {
5880        wwslog('err', 'Failed to delete user');
5881        return undef;
5882    }
5883
5884    foreach my $report (@{$spindle->{stash} || []}) {
5885        if ($report->[1] eq 'notice') {
5886            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
5887                $param->{'action'});
5888        } else {
5889            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
5890                $param->{action});
5891        }
5892    }
5893    unless (@{$spindle->{stash} || []}) {
5894        Sympa::WWW::Report::notice_report_web('performed', {},
5895            $param->{'action'});
5896        web_db_log({'parameters' => $in{'email'}, 'status' => 'success'});
5897    }
5898
5899    return ($in{'previous_action'} || 'info');
5900}
5901
5902# No longer used.
5903#sub unsubscribe;
5904
5905#OBSOLETED: Now an alias of 'signoff'.
5906#sub do_sigrequest;
5907
5908## Update of password
5909sub do_setpasswd {
5910    wwslog('info', '');
5911    my $user;
5912
5913    if ($in{'newpasswd1'} =~ /^\s+$/) {
5914        Sympa::WWW::Report::reject_report_web('user', 'no_passwd', {},
5915            $param->{'action'});
5916        wwslog('info', 'No newpasswd1');
5917        web_db_log(
5918            {   'status'     => 'error',
5919                'error_type' => 'missing_parameter'
5920            }
5921        );
5922        if ($in{'previous_action'}) {
5923            $in{'list'} = $in{'previous_list'};
5924            return $in{'previous_action'};
5925        } else {
5926            return 'pref';
5927        }
5928    }
5929
5930    unless ($in{'newpasswd1'} eq $in{'newpasswd2'}) {
5931        Sympa::WWW::Report::reject_report_web('user', 'diff_passwd', {},
5932            $param->{'action'});
5933        wwslog('info', 'Different newpasswds');
5934        web_db_log(
5935            {   'status'     => 'error',
5936                'error_type' => 'bad_parameter'
5937            }
5938        );
5939        if ($in{'previous_action'}) {
5940            $in{'list'} = $in{'previous_list'};
5941            return $in{'previous_action'};
5942        } else {
5943            return 'pref';
5944        }
5945    }
5946
5947    if (my $reason =
5948        Sympa::Tools::Password::password_validation($in{'newpasswd1'})) {
5949        Sympa::WWW::Report::reject_report_web('user', 'passwd_validation',
5950            {'reason' => $reason},
5951            $param->{'action'});
5952        wwslog('info', 'Password validation');
5953        web_db_log({'status' => 'error', 'error_type' => 'bad_parameter'});
5954        if ($in{'previous_action'}) {
5955            $in{'list'} = $in{'previous_list'};
5956            return $in{'previous_action'};
5957        } else {
5958            return 'pref';
5959        }
5960    }
5961
5962    if (Sympa::User::is_global_user($param->{'user'}{'email'})) {
5963
5964        unless (
5965            Sympa::User::update_global_user(
5966                $param->{'user'}{'email'},
5967                {'password' => $in{'newpasswd1'}, 'wrong_login_count' => 0}
5968            )
5969        ) {
5970            Sympa::WWW::Report::reject_report_web(
5971                'intern', 'update_user_db_failed',
5972                {'user' => $param->{'user'}}, $param->{'action'},
5973                '', $param->{'user'}{'email'},
5974                $robot
5975            );
5976            wwslog('info', 'Update failed');
5977            web_db_log(
5978                {   'status'     => 'error',
5979                    'error_type' => 'internal'
5980                }
5981            );
5982            return undef;
5983        }
5984    } else {
5985
5986        unless (
5987            Sympa::User::add_global_user(
5988                {   'email'             => $param->{'user'}{'email'},
5989                    'password'          => $in{'newpasswd1'},
5990                    'wrong_login_count' => 0
5991                }
5992            )
5993        ) {
5994            Sympa::WWW::Report::reject_report_web('intern',
5995                'add_user_db_failed', {'user' => $param->{'user'}},
5996                $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
5997            wwslog('info', 'Update failed');
5998            web_db_log(
5999                {   'status'     => 'error',
6000                    'error_type' => 'internal'
6001                }
6002            );
6003            return undef;
6004        }
6005    }
6006
6007    $param->{'user'}{'password'} = $in{'newpasswd1'};
6008
6009    Sympa::WWW::Report::notice_report_web('performed', {},
6010        $param->{'action'});
6011    web_db_log({'status' => 'success'});
6012
6013    if ($in{'previous_action'}) {
6014        $in{'list'} = $in{'previous_list'};
6015        return $in{'previous_action'};
6016    } else {
6017        return 'pref';
6018    }
6019}
6020
6021## List admin page
6022sub do_admin {
6023    wwslog('info', '');
6024
6025    return 1;
6026}
6027
6028## Server admin page
6029sub do_serveradmin {
6030    wwslog('info', '');
6031
6032    my $f;
6033
6034    ## Lists Default files
6035    foreach my $f (
6036        'welcome.tt2',    'bye.tt2',
6037        'removed.tt2',    'message_header',
6038        'message_footer', 'remind.tt2',
6039        'invite.tt2',     'reject.tt2',
6040        'your_infected_msg.tt2'
6041    ) {
6042        if ($Sympa::WWW::Tools::filenames{$f}{'gettext_id'}) {
6043            $param->{'lists_default_files'}{$f}{'complete'} =
6044                $language->gettext(
6045                $Sympa::WWW::Tools::filenames{$f}{'gettext_id'});
6046        } else {
6047            $param->{'lists_default_files'}{$f}{'complete'} = $f;
6048        }
6049        $param->{'lists_default_files'}{$f}{'selected'} = '';
6050    }
6051
6052    ## Checking families and other virtual hosts.
6053    get_server_details();
6054
6055    ## Server files
6056    foreach my $f (
6057        'helpfile.tt2',            'lists.tt2',
6058        'global_remind.tt2',       'summary.tt2',
6059        'create_list_request.tt2', 'list_created.tt2',
6060        'list_aliases.tt2'
6061    ) {
6062        $param->{'server_files'}{$f}{'complete'} =
6063            $language->gettext(
6064            $Sympa::WWW::Tools::filenames{$f}{'gettext_id'});
6065        $param->{'server_files'}{$f}{'selected'} = '';
6066    }
6067    $param->{'server_files'}{'helpfile.tt2'}{'selected'} =
6068        'selected="selected"';
6069    $param->{'log_level'} = $session->{'log_level'};
6070    $param->{'subaction'} = $in{'subaction'};
6071    return 1;
6072}
6073
6074sub do_edit_config {
6075    my $editable_params = [
6076        map  { Sympa::Tools::Data::dup_var($_) }
6077        grep { not $_->{obsolete} } @Sympa::ConfDef::params
6078    ];
6079
6080    get_server_details();
6081
6082    unless ($param->{'main_robot'}) {
6083        Sympa::WWW::Report::reject_report_web('auth',
6084            'super lismaster feature only',
6085            {}, $param->{'action'});
6086        wwslog(
6087            'info',
6088            'Access denied in edit_config for %s because not super listmaster',
6089            $param->{'user'}{'email'}
6090        );
6091    }
6092
6093    for my $p (@$editable_params) {
6094        if ($p->{'name'}) {
6095            my $name = $p->{'name'};
6096            my $v = Conf::get_robot_conf($robot || '*', $name);
6097            if (ref $v eq 'ARRAY') {
6098                $p->{'current_value'} = join ',', @$v;
6099            } else {
6100                $p->{'current_value'} = $v;
6101            }
6102            $p->{'query'} = $language->gettext($p->{'gettext_id'})
6103                if $p->{'gettext_id'};
6104            $p->{'advice'} = $language->gettext($p->{'gettext_comment'})
6105                if $p->{'gettext_comment'};
6106        } elsif ($p->{'gettext_id'}) {
6107            $p->{'title'} = $language->gettext($p->{'gettext_id'});
6108            unless ($p->{'group'}) {
6109                my $g = $p->{'gettext_id'};
6110                $g =~ s/([^-\w])/sprintf '.%02X', ord $1/eg;
6111                $p->{'group'} = $g;
6112            }
6113        }
6114    }
6115
6116    if ($in{'conf_new_value'}) {
6117        my $editable;
6118        my $i;
6119        foreach my $p (@$editable_params) {
6120            next unless $p->{'name'};
6121
6122            # if the parameter is editable and if the is a change
6123            next unless $p->{'name'} eq $in{'conf_parameter_name'};
6124            unless ($p->{'edit'} and $p->{'edit'} eq '1') {
6125                $log->syslog(
6126                    'err',
6127                    'Ignoring change of parameter %s (value %s) because not editable',
6128                    $in{'conf_parameter_name'},
6129                    $in{'conf_new_value'}
6130                );
6131                last;
6132            }
6133            if ($in{'conf_new_value'} eq $p->{'current_value'}) {
6134                $log->syslog(
6135                    'notice',
6136                    'Ignoring change of parameter %s (value %s) because inchanged',
6137                    $in{'conf_parameter_name'},
6138                    $in{'conf_new_value'}
6139                );
6140                last;
6141            } else {
6142                $p->{'current_value'} = $in{'conf_new_value'};
6143                Conf::set_robot_conf($robot, $in{'conf_parameter_name'},
6144                    $in{'conf_new_value'});
6145                $log->syslog(
6146                    'notice',
6147                    'Setting parameter %s to value %s',
6148                    $in{'conf_parameter_name'},
6149                    $in{'conf_new_value'}
6150                );
6151                last;
6152            }
6153        }
6154    }
6155
6156    $param->{'editable_params'} = $editable_params;
6157    return 1;
6158
6159}
6160
6161## Change log_level for the current session
6162sub do_set_loglevel {
6163    wwslog('info', '');
6164
6165    $session->{'log_level'} = $in{'log_level'};
6166    return 'serveradmin';
6167}
6168
6169## activate dump var feature
6170sub do_set_dumpvars {
6171    wwslog('info', '');
6172
6173    $session->{'dumpvars'}  = 'true';
6174    $param->{'dumpavars'}   = $session->{'dumpvars'};
6175    $param->{'redirect_to'} = Sympa::get_url(
6176        $robot, 'serveradmin',
6177        nomenu    => $param->{'nomenu'},
6178        authority => 'local'
6179    );
6180    return '1';
6181}
6182## un-activate dump var feature
6183sub do_unset_dumpvars {
6184    wwslog('info', '');
6185
6186    $session->{'dumpvars'}  = '';
6187    $param->{'dumpavars'}   = '';
6188    $param->{'redirect_to'} = Sympa::get_url(
6189        $robot, 'serveradmin',
6190        nomenu    => $param->{'nomenu'},
6191        authority => 'local'
6192    );
6193    return '1';
6194}
6195## un-activate dump var feature
6196sub do_show_sessions {
6197    wwslog('info', '');
6198
6199    $in{'session_delay'} = 10 unless ($in{'session_delay'});
6200    my $delay = 60 * $in{'session_delay'};
6201    my $sessions =
6202        Sympa::WWW::Session::list_sessions($delay, $robot,
6203        $in{'connected_only'});
6204    foreach my $session (@$sessions) {
6205        $session->{'date'} =
6206            $language->gettext_strftime("%d %b %Y at %H:%M:%S",
6207            localtime($session->{'date_epoch'}));
6208        $session->{'start_date'} =
6209            $language->gettext_strftime("%d %b %Y at %H:%M:%S",
6210            localtime($session->{'start_date_epoch'}));
6211        # Compatibility for misspelling.
6212        $session->{'formated_date'}       = $session->{'date'};
6213        $session->{'formated_start_date'} = $session->{'start_date'};
6214    }
6215    $param->{'sessions'} = $sessions;
6216    return '1';
6217}
6218
6219## Change user email
6220sub do_set_session_email {
6221    wwslog('info', '');
6222
6223    my $email_regexp = Sympa::Regexps::email();
6224    unless ($in{'email'} =~ /^\s*$email_regexp\s*$/) {
6225        Sympa::WWW::Report::reject_report_web('user',
6226            'Invalid email provided.',
6227            {}, $param->{'action'}, $list);
6228        return 'serveradmin';
6229    }
6230
6231    # Prevent getting privilege of super-listmaster.
6232    if (Sympa::is_listmaster('*', $in{'email'})) {
6233        Sympa::WWW::Report::reject_report_web('user',
6234            'You are not allowed to get the privilege of this user.',
6235            {}, $param->{'action'}, $list);
6236        return 'serveradmin';
6237    }
6238
6239    if ($session) {
6240        $session->{'restore_email'} ||= $param->{'user'}{'email'};
6241        $session->{'email'}     = $in{'email'};
6242        $param->{'redirect_to'} = Sympa::get_url(
6243            $robot, undef,
6244            nomenu    => $param->{'nomenu'},
6245            authority => 'local'
6246        );
6247        return '1';
6248    } else {
6249        Sympa::WWW::Report::reject_report_web('user', 'No active session',
6250            {}, $param->{'action'}, $list);
6251        return 'serveradmin';
6252    }
6253}
6254
6255## Change user email
6256sub do_restore_email {
6257    wwslog('info', '');
6258    wwslog('debug2', 'From %s to %s',
6259        $session->{'email'}, $session->{'restore_email'});
6260
6261    if ($param->{'restore_email'}) {
6262        $session->{'email'}       = $session->{'restore_email'};
6263        $param->{'restore_email'} = $session->{'restore_email'} = '';
6264        $param->{'redirect_to'}   = Sympa::get_url(
6265            $robot, undef,
6266            nomenu    => $param->{'nomenu'},
6267            authority => 'local'
6268        );
6269    } else {
6270        wwslog(
6271            'info',
6272            'From %s no restore_email attached to current session',
6273            $param->{'user'}{'email'}
6274        );
6275        Sympa::WWW::Report::reject_report_web('user', 'wrong_param', {},
6276            $param->{'action'}, $list);
6277    }
6278    return 'home';
6279}
6280
6281## list available templates
6282sub do_ls_templates {
6283    wwslog('info', '');
6284
6285    $in{'webormail'} ||= 'web';
6286
6287    $param->{'templates'} =
6288        Sympa::WWW::Tools::get_templates_list($list || $robot,
6289        $in{'webormail'});
6290
6291    ## List of lang per type
6292    foreach my $level ('site', 'robot', 'list') {
6293        $param->{'lang_per_level'}{$level}{'default'} = 1;
6294    }
6295
6296    foreach my $file (keys %{$param->{'templates'}}) {
6297        foreach my $level (keys %{$param->{'templates'}{$file}}) {
6298            foreach my $subdir (keys %{$param->{'templates'}{$file}{$level}})
6299            {
6300                # Allow unknown lang.
6301                my $lang = Sympa::Language::canonic_lang($subdir);
6302                $param->{'lang_per_level'}{$level}{$subdir} =
6303                    {lang => ($lang || $subdir)};
6304            }
6305        }
6306    }
6307
6308    ## Colspan per level
6309    foreach my $level (keys %{$param->{'lang_per_level'}}) {
6310        foreach my $subdir (keys %{$param->{'lang_per_level'}{$level}}) {
6311            $param->{'colspan_per_level'}{$level}++;
6312            foreach my $file (keys %{$param->{'templates'}}) {
6313                $param->{'templates'}{$file}{$level}{$subdir} ||= '';
6314            }
6315        }
6316    }
6317
6318    $param->{'webormail'} = $in{'webormail'};
6319
6320    return 1;
6321}
6322
6323# show a template, used by copy_template and edit_emplate
6324sub do_remove_template {
6325    wwslog('info', '');
6326
6327    if ($in{'scope'} eq 'list' and ref $list ne 'Sympa::List') {
6328        Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
6329            {'argument' => 'list'},
6330            $param->{'action'});
6331        wwslog('err', 'Missing parameter list');
6332        web_db_log(
6333            {   'parameters' => $in{'webormail'},
6334                'status'     => 'error',
6335                'error_type' => 'missing_parameter'
6336            }
6337        );
6338        return 1;
6339    }
6340    $param->{'webormail'}     = $in{'webormail'};
6341    $param->{'scope'}         = $in{'scope'};
6342    $param->{'template_name'} = $in{'template_name'};
6343    $param->{'tpl_lang'}      = $in{'tpl_lang'};
6344
6345    # Action confirmed?
6346    my $next_action = $session->confirm_action(
6347        $in{'action'}, $in{'response_action'},
6348        arg => join('/', @in{qw(webormail scope template_name tpl_lang)}),
6349        previous_action => 'ls_templates'
6350    );
6351    return $next_action unless $next_action eq '1';
6352
6353    my $template_path = Sympa::WWW::Tools::get_template_path(
6354        $list || $robot, $in{'webormail'}, $in{'scope'},
6355        $in{'template_name'}, $in{'tpl_lang'}
6356    );
6357    my $template_old_path =
6358        Sympa::Tools::File::shift_file($template_path, 10);
6359    unless ($template_old_path) {
6360        Sympa::WWW::Report::reject_report_web('intern', 'remove_failed',
6361            {'path' => $template_path},
6362            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
6363        wwslog('info', 'Could not remove %s', $template_path);
6364        web_db_log(
6365            {   'parameters' => $in{'webormail'},
6366                'status'     => 'error',
6367                'error_type' => 'internal'
6368            }
6369        );
6370        return undef;
6371    }
6372
6373    Sympa::WWW::Report::notice_report_web('file_renamed',
6374        {'orig_file' => $template_path, 'new_file' => $template_old_path},
6375        $param->{'action'});
6376    web_db_log(
6377        {   'parameters' => $in{'webormail'},
6378            'status'     => 'status'
6379        }
6380    );
6381
6382    return 'ls_templates';
6383}
6384
6385# show a template, used by copy_template and edit_emplate
6386sub do_view_template {
6387    wwslog(
6388        'info',
6389        '(type=%s, template-name=%s, listname=%s, path=%s, scope=%s, lang=%s)',
6390        $in{'webormail'},
6391        $in{'template_name'},
6392        $in{'list'},
6393        $in{'template_path'},
6394        $in{'scope'},
6395        $in{'tpl_lang'}
6396    );
6397
6398    my $template_path;
6399
6400    if ($in{'scope'} eq 'list' and ref $list ne 'Sympa::List') {
6401        Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
6402            {'argument' => 'list'},
6403            $param->{'action'});
6404        wwslog('err', 'Missing parameter webormail');
6405        web_db_log(
6406            {   'parameters' => $in{'webormail'},
6407                'status'     => 'error',
6408                'error_type' => 'missing_parameter'
6409            }
6410        );
6411        return 1;
6412    }
6413    $template_path = Sympa::WWW::Tools::get_template_path(
6414        $list || $robot, $in{'webormail'}, $in{'scope'},
6415        $in{'template_name'}, $in{'tpl_lang'}
6416    );
6417
6418    my $fh;
6419    unless ($template_path and open $fh, '<', $template_path) {
6420        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6421            {'path' => $in{'template_path'}},
6422            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6423        wwslog('err', 'Can\'t open file %s', $template_path);
6424        return undef;
6425    }
6426
6427    $param->{'rows'} = 5;    # minimum size of 5 rows;
6428    $param->{'template_content'} = do { local $RS; <$fh> };
6429    close $fh;
6430
6431    $param->{'webormail'}     = $in{'webormail'};
6432    $param->{'template_name'} = $in{'template_name'};
6433    $param->{'template_path'} = $template_path;
6434    $param->{'scope'}         = $in{'scope'};
6435
6436    my $tpl_lang = $in{'tpl_lang'} || 'default';
6437    $param->{'tpl_lang'} = $tpl_lang;
6438    unless ($tpl_lang eq 'default') {
6439        # Allow unknown lang.
6440        $param->{'tpl_lang_lang'} = Sympa::Language::canonic_lang($tpl_lang);
6441    }
6442
6443    return 1;
6444}
6445
6446##  template copy
6447sub do_copy_template {
6448    wwslog('info', '');
6449
6450    ## Load original template
6451    do_view_template();
6452
6453    ## Return form
6454    unless ($in{'scope_out'}) {
6455        return 1;
6456    }
6457
6458    # one of these parameters is commit from the form submission
6459    if ($in{'scope_out'} eq 'list') {
6460        if ($in{'list_out'}) {
6461            my $list_out;
6462            unless ($list_out =
6463                Sympa::List->new($in{'list_out'}, $robot, {just_try => 1})) {
6464                Sympa::WWW::Report::reject_report_web('user', 'unknown_list',
6465                    {listname => $in{'list_out'}},
6466                    $param->{'action'}, '');
6467                wwslog('info', 'Unknown list %s', $in{'list_out'});
6468                web_db_log(
6469                    {   'parameters' => $in{'list_out'},
6470                        'status'     => 'error',
6471                        'error_type' => 'unknown_list'
6472                    }
6473                );
6474                return undef;
6475            }
6476            $param->{'template_path_out'} =
6477                Sympa::WWW::Tools::get_template_path($list_out,
6478                $in{'webormail'}, 'list', $in{'template_name_out'},
6479                $in{'tpl_lang_out'});
6480        } else {
6481            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
6482                {'argument' => 'list'},
6483                $param->{'action'});
6484            wwslog('err', 'Missing parameter webormail');
6485            web_db_log(
6486                {   'parameters' => $in{'webormail'},
6487                    'status'     => 'error',
6488                    'error_type' => 'missing_parameter'
6489                }
6490            );
6491            return 1;
6492        }
6493    } else {
6494        $param->{'template_path_out'} =
6495            Sympa::WWW::Tools::get_template_path($robot, $in{'webormail'},
6496            $in{'scope_out'}, $in{'template_name_out'},
6497            $in{'tpl_lang_out'});
6498    }
6499
6500    unless ($param->{'template_path_out'}
6501        and Sympa::Tools::File::mk_parent_dir($param->{'template_path_out'}))
6502    {
6503        Sympa::WWW::Report::reject_report_web(
6504            'intern',
6505            'cannot_open_file',
6506            {'path' => $param->{'template_path_out'}},
6507            $param->{'action'},
6508            '',
6509            $param->{'user'}{'email'},
6510            $robot
6511        );
6512        wwslog(
6513            'err',
6514            'Can\'t create parent directory for %s: %s',
6515            $param->{'template_path_out'}, $ERRNO
6516        );
6517        web_db_log(
6518            {   'parameters' => $param->{'template_name_out'},
6519                'status'     => 'error',
6520                'error_type' => 'internal'
6521            }
6522        );
6523        return undef;
6524    }
6525
6526    my $ofh;
6527    unless (open $ofh, '>', $param->{'template_path_out'}) {
6528        Sympa::WWW::Report::reject_report_web(
6529            'intern',
6530            'cannot_open_file',
6531            {'path' => $param->{'template_path_out'}},
6532            $param->{'action'},
6533            '',
6534            $param->{'user'}{'email'},
6535            $robot
6536        );
6537        wwslog(
6538            'err',
6539            'Can\'t open file %s: %s',
6540            $param->{'template_path_out'}, $ERRNO
6541        );
6542        web_db_log(
6543            {   'parameters' => $param->{'template_name_out'},
6544                'status'     => 'error',
6545                'error_type' => 'internal'
6546            }
6547        );
6548        return undef;
6549    }
6550    print $ofh $param->{'template_content'};
6551    close $ofh;
6552
6553    if ($in{'list_out'}) { $param->{'list'} = $in{'list'} = $in{'list_out'}; }
6554
6555    $param->{'webormail'} = $in{'webormail'};
6556
6557    my $tpl_lang = $in{'tpl_lang_out'} || 'default';
6558    $param->{'tpl_lang'} = $in{'tpl_lang'} = $tpl_lang;
6559    unless ($tpl_lang eq 'default') {
6560        # Allow unknown lang.
6561        $param->{'tpl_lang_lang'} = Sympa::Language::canonic_lang($tpl_lang);
6562    }
6563
6564    $param->{'scope'} = $in{'scope'} = $in{'scope_out'};
6565    $param->{'template_path'} = $in{'template_path'} =
6566        $param->{'template_path_out'};
6567    $param->{'template_name'} = $in{'template_name'} =
6568        $in{'template_name_out'};
6569    web_db_log(
6570        {   'parameters' => $param->{'template_name_out'},
6571            'status'     => 'success'
6572        }
6573    );
6574    return ('edit_template');
6575}
6576
6577# Manage the rejection templates.
6578#FIXME: Would rename to do_rt_XXX().
6579sub do_manage_template {
6580    wwslog('info');
6581
6582    my $base = $list->{'dir'} . '/mail_tt2/';
6583
6584    # Build the list of available templates.
6585    my $available_files = Sympa::WWW::Tools::get_templates_list($list, 'mail',
6586        ignore_global => 1);
6587    foreach my $file (keys %$available_files) {
6588        if ($file eq 'reject.tt2') {
6589            my $absolute_file = $base . 'reject.tt2';
6590            if (-l $absolute_file) {
6591                my $default = readlink $absolute_file;
6592                if (-f $default or -f $base . $default) {
6593                    $default =~ s/\A.*reject_//;
6594                    $default =~ s/[.]tt2\z//;
6595                    $default =~ s/_/ /g;
6596                    $param->{'default_reject_template'} = $default;
6597                } else {
6598                    # Link to no existing file. Remove link.
6599                    wwslog(
6600                        'err',
6601                        'Link %s point to un no existing file (%s)',
6602                        $base . 'reject.tt2', $default
6603                    );
6604                    unless (unlink $absolute_file) {
6605                        wwslog(
6606                            'err',
6607                            'Could not unlink %s',
6608                            $base . 'reject.tt2'
6609                        );
6610                    }
6611                }
6612            } elsif (-f $absolute_file) {
6613                # replace existing reject.tt2 file by a symlink to
6614                # reject_default.tt2 for compatibility with version older than
6615                # 6.0
6616                unless (rename $absolute_file, $base . 'reject_default.tt2') {
6617                    wwslog(
6618                        'err',
6619                        'Could not rename %, %s',
6620                        $base . 'reject.tt2',
6621                        $base . 'reject_default.tt2'
6622                    );
6623                }
6624                unless (symlink $base . 'reject_default.tt2', $absolute_file)
6625                {
6626                    wwslog(
6627                        'err',
6628                        'Could not symlink %s, %s',
6629                        $base . 'reject_default.tt2',
6630                        $absolute_file
6631                    );
6632                }
6633
6634                $param->{'default_reject_template'} = 'default';
6635                push @{$param->{'available_files'}}, 'default';
6636            }
6637        } else {
6638            next unless $file =~ /^reject_/;
6639            $file =~ s/\Areject_//;
6640            $file =~ s/[.]tt2\z//;
6641            $file =~ s/_/ /g;
6642            push @{$param->{'available_files'}}, $file;
6643        }
6644    }
6645
6646    return 1;
6647}
6648
6649sub _rt_canonic_name {
6650    my $name = shift;
6651
6652    return $name unless $name;
6653    $name =~ s/^reject_//;
6654    $name =~ s/\s/_/g;
6655    return $name;
6656}
6657
6658# Old name: do_manage_template() with subaction "save".
6659sub do_rt_update {
6660    wwslog('info', '(%s, ...)', $in{'message_template'});
6661
6662    my $template_name = _rt_canonic_name($in{'message_template'});
6663    my $template_path =
6664        Sympa::WWW::Tools::get_template_path($list,
6665        'mail', 'list', 'reject_' . $template_name . '.tt2')
6666        if $template_name;
6667
6668    # Create the parent directory if it doesn't already exist.
6669    unless ($template_path
6670        and Sympa::Tools::File::mk_parent_dir($template_path)) {
6671        my $errno = $ERRNO;
6672        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6673            {'path' => $template_name},
6674            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6675        wwslog('err', 'Can\'t create parent directory for %s: %s',
6676            $template_path, $errno);
6677        web_db_log(
6678            {   'parameters' => $template_name,
6679                'status'     => 'error',
6680                'error_type' => 'internal'
6681            }
6682        );
6683        return undef;
6684    }
6685    # Open the template.
6686    my $ofh;
6687    unless (open $ofh, '>', $template_path) {
6688        my $errno = $ERRNO;
6689        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6690            {'path' => $template_name},
6691            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6692        wwslog('err', 'Can\'t open file %s: %s', $template_path, $errno);
6693        web_db_log(
6694            {   'parameters' => $template_name,
6695                'status'     => 'error',
6696                'error_type' => 'internal'
6697            }
6698        );
6699        return undef;
6700    }
6701    ##  save template contents
6702    print $ofh $in{'content'};
6703    close $ofh;
6704    Sympa::WWW::Report::notice_report_web('performed', {}, $in{'subaction'});
6705
6706    return 'manage_template';
6707}
6708
6709# Old name: do_manage_template() with subaction "create_new".
6710sub do_rt_create {
6711    wwslog('info', '(%s)', $in{'new_template_name'});
6712
6713    my $new_template_name = _rt_canonic_name($in{'new_template_name'});
6714    my $new_template_path =
6715        Sympa::WWW::Tools::get_template_path($list,
6716        'mail', 'list', 'reject_' . $new_template_name . '.tt2')
6717        if $new_template_name;
6718    my $default_file =
6719        Sympa::search_fullpath($list, 'reject.tt2', subdir => 'mail_tt2');
6720
6721    unless ($new_template_path) {
6722        Sympa::WWW::Report::reject_report_web(
6723            'user',
6724            'missing template name',
6725            {'path' => ''},
6726            $param->{'action'}, '', $param->{'user'}{'email'}, $robot
6727        );
6728        return undef;
6729    }
6730    if (-f $new_template_path) {
6731        Sympa::WWW::Report::reject_report_web(
6732            'intern',
6733            'template already exist',
6734            {'path' => $new_template_name},
6735            $param->{'action'}, '', $param->{'user'}{'email'}, $robot
6736        );
6737        return undef;
6738    }
6739    # Create the parent directory if it doesn't already exist.
6740    unless (Sympa::Tools::File::mk_parent_dir($new_template_path)) {
6741        my $errno = $ERRNO;
6742        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6743            {'path' => $new_template_name},
6744            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6745        wwslog('err', 'Can\'t create parent directory for %s: %s',
6746            $new_template_path, $errno);
6747        web_db_log(
6748            {   'parameters' => $new_template_name,
6749                'status'     => 'error',
6750                'error_type' => 'internal'
6751            }
6752        );
6753        return undef;
6754    }
6755
6756    my $fh;
6757    unless (open $fh, '<', $default_file) {
6758        my $errno = $ERRNO;
6759        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6760            {'path' => $default_file},
6761            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6762        wwslog('err', 'Can\'t open file %s: %s', $default_file, $errno);
6763        return undef;
6764    }
6765    my $ofh;
6766    unless (open $ofh, '>', $new_template_path) {
6767        my $errno = $ERRNO;
6768        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6769            {'path' => $new_template_name},
6770            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6771        wwslog('err', 'Can\'t open file %s: %s', $new_template_path, $errno);
6772        return undef;
6773    }
6774
6775    my $content = do { local $RS; <$fh> };
6776    print $ofh $content;
6777    close $fh;
6778    close $ofh;
6779    #XXX$in{'subaction'}        = 'modify';
6780    $in{'message_template'} = $new_template_name;
6781    #XXXreturn 'manage_template';
6782
6783    return 'rt_edit';
6784}
6785
6786# Old name: do_manage_template() with subaction "modify".
6787sub do_rt_edit {
6788    wwslog('info', '(%s, ...)', $in{'message_template'});
6789
6790    my $template_name = _rt_canonic_name($in{'message_template'});
6791    my $template_path =
6792        Sympa::WWW::Tools::get_template_path($list,
6793        'mail', 'list', 'reject_' . $template_name . '.tt2')
6794        if $template_name;
6795
6796    my $fh;
6797    unless ($template_path and open $fh, '<', $template_path) {
6798        my $errno = $ERRNO;
6799        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6800            {'path' => $template_name},
6801            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6802        wwslog('err', 'Can\'t open file MODIFY %s: %s',
6803            $template_path, $errno);
6804        web_db_log(
6805            {   'parameters' => $template_name,
6806                'status'     => 'error',
6807                'error_type' => 'internal'
6808            }
6809        );
6810        return undef;
6811    }
6812    $param->{'content'} = do { local $RS; <$fh> };
6813    close $fh;
6814    $param->{'message_template'} = $template_name;
6815
6816    return 'manage_template';
6817}
6818
6819# Old name: do_manage_template() with subaction "setdefault".
6820sub do_rt_setdefault {
6821    wwslog('info', '(%s)', $in{'new_default'});
6822
6823    # Replace existing reject.tt2 file by a symlink to reject_default.tt2
6824    # for compatibility with version older than 6.0
6825    my $base          = $list->{'dir'} . '/mail_tt2/';
6826    my $new_default   = _rt_canonic_name($in{'new_default'});
6827    my $absolute_file = $base . 'reject_' . $new_default . '.tt2';
6828
6829    $log->syslog(
6830        'info',
6831        'Change default by linking %s 2 %s',
6832        $base . 'reject.tt2',
6833        $absolute_file
6834    );
6835    if (-l $base . 'reject.tt2') {
6836        unless (unlink $base . 'reject.tt2') {
6837            wwslog('err', 'Could not unlink %s', $base . 'reject.tt2');
6838        }
6839    }
6840    unless (symlink $absolute_file, $base . 'reject.tt2') {
6841        wwslog('err', 'Could not symlink %s, %s',
6842            $absolute_file, $base . 'reject.tt2');
6843    }
6844
6845    return 'manage_template';
6846}
6847
6848# Old name: (part of) do_manage_template() with subaction "delete".
6849sub do_rt_delete {
6850    wwslog('info', '(%s)', $in{'message_template'});
6851
6852    my $template_name = _rt_canonic_name($in{'message_template'});
6853    my $template_path =
6854        Sympa::WWW::Tools::get_template_path($list,
6855        'mail', 'list', 'reject_' . $template_name . '.tt2')
6856        if $template_name;
6857    $param->{'message_template'} = $template_name;
6858
6859    # Action confirmed?
6860    my $next_action = $session->confirm_action(
6861        $in{'action'}, $in{'response_action'},
6862        arg             => $template_name,
6863        previous_action => 'manage_template'
6864    );
6865    return $next_action unless $next_action eq '1';
6866
6867    unless ($template_path and unlink $template_path) {
6868        my $errno = $ERRNO;
6869        Sympa::WWW::Report::reject_report_web('intern', 'cannot_delete',
6870            {'file_del' => $template_name},
6871            '', '', '', $robot);
6872        wwslog('err', 'Can\'t open file %s: %s', $template_path, $errno);
6873        web_db_log(
6874            {   'parameters' => $template_name,
6875                'status'     => 'error',
6876                'error_type' => 'internal'
6877            }
6878        );
6879        return undef;
6880    }
6881    Sympa::WWW::Report::notice_report_web('performed', {}, $in{'subaction'});
6882
6883    return 'manage_template';
6884}
6885
6886## online template edition
6887sub do_edit_template {
6888
6889    $in{'subdir'} ||= 'default';
6890
6891    wwslog(
6892        'info',
6893        '(type=%s, template-name=%s, listname=%s, path=%s, scope=%s, lang=%s)',
6894        $in{'webormail'},
6895        $in{'template_name'},
6896        $in{'list'},
6897        $in{'template_path'},
6898        $in{'scope'},
6899        $in{'tpl_lang'}
6900    );
6901
6902    ## Load original template
6903    do_view_template();
6904
6905    unless ($in{'content'}) {
6906        return 1;
6907    }
6908    if ($in{'scope'} eq 'list' and ref $list ne 'Sympa::List') {
6909        Sympa::WWW::Report::reject_report_web('user', 'listname_needed', {},
6910            $param->{'action'});
6911        wwslog('info', 'No output lisname while output scope is list');
6912        web_db_log(
6913            {   'parameters' => $in{'template_name'},
6914                'status'     => 'error',
6915                'error_type' => 'no_list'
6916            }
6917        );
6918        return undef;
6919    }
6920    $param->{'template_path'} = Sympa::WWW::Tools::get_template_path(
6921        $list || $robot, $in{'webormail'}, $in{'scope'},
6922        $in{'template_name'}, $in{'tpl_lang'}
6923    );
6924
6925    my $ofh;
6926    unless ($param->{'template_path'} and open $ofh,
6927        '>', $param->{'template_path'}) {
6928        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
6929            {'path' => $param->{'template_path'}},
6930            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
6931        wwslog('err', 'Can\'t open file %s', $param->{'template_path'});
6932        web_db_log(
6933            {   'parameters' => $in{'template_name'},
6934                'status'     => 'error',
6935                'error_type' => 'internal'
6936            }
6937        );
6938        return undef;
6939    }
6940    print $ofh $in{'content'};
6941    close $ofh;
6942
6943    $param->{'saved'}            = 1;
6944    $param->{'template_content'} = $in{'content'};
6945    $param->{'webormail'}        = $in{'webormail'};
6946    $param->{'template_name'}    = $in{'template_name'};
6947    $param->{'list'}             = $in{'list'};
6948    $param->{'scope'}            = $in{'scope'};
6949    $param->{'template_path'}    = $in{'template_path'};
6950    $param->{'tpl_lang'}         = $in{'tpl_lang'};
6951
6952    web_db_log(
6953        {   'parameters' => $in{'template_name'},
6954            'status'     => 'success'
6955        }
6956    );
6957
6958    return 'ls_templates';
6959
6960}
6961
6962# Server show colors, and install static css in future edit colors etc.
6963sub do_skinsedit {
6964    wwslog('info', '(%s)', $in{'subaction'});
6965
6966    my @std_color_names = map { 'color_' . $_ } (0 .. 15);
6967    my @obs_color_names = qw(dark_color light_color text_color bg_color
6968        error_color selected_color shaded_color);
6969
6970    if ($in{'editcolors'} and $in{'subaction'}) {
6971        if ($in{'subaction'} eq 'test') {
6972            my $custom_css;
6973            foreach my $cn (@std_color_names) {
6974                $session->{$cn} = lc $in{$cn}
6975                    if $in{$cn} and $in{$cn} =~ /\A#[0-9a-z]+\z/i;
6976
6977                my $cur_color = Conf::get_robot_conf($robot, $cn);
6978                unless ($session->{$cn}) {
6979                    $session->{$cn} = $cur_color;
6980                } elsif ($session->{$cn} ne $cur_color) {
6981                    $custom_css = 1;
6982                }
6983            }
6984            $session->{'custom_css'} = $custom_css;
6985        } else {    # 'install' or 'reset'.
6986            if ($in{'subaction'} eq 'install') {
6987                # Update config.
6988                my @keys = grep { $session->{$_} } @std_color_names;
6989                foreach my $key (@keys) {
6990                    Conf::set_robot_conf($robot, $key, $session->{$key});
6991                }
6992                # Force update CSS.
6993                Sympa::WWW::Tools::get_css_url($robot, force => 1);
6994
6995                $param->{'css_result'} = 1;
6996            }
6997
6998            delete @{$session}{'custom_css', @std_color_names};
6999            delete @{$param->{'session'}}{'custom_css', @std_color_names};
7000        }
7001    }
7002
7003    $param->{'custom_css'} = $session->{'custom_css'};
7004    foreach my $cn (@std_color_names) {
7005        $param->{$cn} = $session->{$cn} || Conf::get_robot_conf($robot, $cn);
7006    }
7007    # Compat.
7008    foreach my $cn (@obs_color_names) {
7009        $param->{$cn} = Conf::get_robot_conf($robot, $cn);
7010    }
7011
7012    return 1;
7013}
7014
7015# Adds multiple users to a list.
7016sub do_import {
7017    wwslog('info', '(...)');
7018
7019    my $content;
7020    my $fh = $query->upload('uploaded_file');
7021    if (defined $fh) {
7022        my $ioh = $fh->handle;
7023        $content = do { local $RS; <$ioh> };
7024    } else {
7025        $content = $in{'dump'};
7026    }
7027
7028    $param->{'dump'}  = $content;
7029    $param->{'quiet'} = $in{'quiet'};
7030
7031    return 1 unless $content and $content =~ /\S/;
7032
7033    ## Action confirmed?
7034    #my $next_action = $session->confirm_action(
7035    #    $in{'action'}, $in{'response_action'},
7036    #    arg             => $in{'dump'},
7037    #    previous_action => ($in{'previous_action'} || 'reviw'),
7038    #);
7039    #return $next_action unless $next_action eq '1';
7040
7041    my $spindle = Sympa::Spindle::ProcessRequest->new(
7042        context          => $list,
7043        action           => 'import',
7044        dump             => $content,
7045        sender           => $param->{'user'}{'email'},
7046        quiet            => $param->{'quiet'},
7047        md5_check        => 1,
7048        scenario_context => {
7049            sender      => $param->{'user'}{'email'},
7050            remote_host => $param->{'remote_host'},
7051            remote_addr => $param->{'remote_addr'}
7052        },
7053    );
7054    unless ($spindle and $spindle->spin) {
7055        return $in{'previous_action'} || 'review';
7056    }
7057
7058    foreach my $report (@{$spindle->{stash} || []}) {
7059        if ($report->[1] eq 'notice') {
7060            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
7061                $param->{'action'});
7062        } else {
7063            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
7064                $param->{action});
7065        }
7066    }
7067    unless (@{$spindle->{stash} || []}) {
7068        Sympa::WWW::Report::notice_report_web('performed', {},
7069            $param->{'action'});
7070    }
7071
7072    return $in{'previous_action'} || 'review';
7073}
7074
7075# Adds a user to a list (requested by another user).
7076sub do_add {
7077    wwslog('info', '(%s)', $in{'email'});
7078
7079    # Access control.
7080    return undef unless defined check_authz('do_add', 'add');
7081
7082    my @emails =
7083        grep {$_} map { Sympa::Tools::Text::canonic_email($_) }
7084        split /\0/, $in{'email'};
7085    return $in{'previous_action'} || 'review' unless @emails;
7086
7087    $param->{'email'} = [@emails];
7088    $param->{'quiet'} = $in{'quiet'};
7089
7090    # Action confirmed?
7091    my $next_action = $session->confirm_action(
7092        $in{'action'}, $in{'response_action'},
7093        arg             => join(',', sort @emails),
7094        previous_action => ($in{'previous_action'} || 'review')
7095    );
7096    return $next_action unless $next_action eq '1';
7097
7098    my $stash     = [];
7099    my $processed = 0;
7100    foreach my $email (@emails) {
7101        my $spindle = Sympa::Spindle::ProcessRequest->new(
7102            context          => $list,
7103            action           => 'add',
7104            email            => $email,
7105            sender           => $param->{'user'}{'email'},
7106            quiet            => $param->{'quiet'},
7107            md5_check        => 1,
7108            scenario_context => {
7109                email       => $email,
7110                sender      => $param->{'user'}{'email'},
7111                remote_host => $param->{'remote_host'},
7112                remote_addr => $param->{'remote_addr'}
7113            },
7114            stash => $stash,
7115        );
7116        $spindle and $processed += $spindle->spin;
7117    }
7118    unless ($processed) {
7119        return $in{'previous_action'} || 'review';
7120    }
7121
7122    foreach my $report (@$stash) {
7123        if ($report->[1] eq 'notice') {
7124            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
7125                $param->{'action'});
7126        } else {
7127            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
7128                $param->{action});
7129        }
7130    }
7131    unless (@$stash) {
7132        Sympa::WWW::Report::notice_report_web('performed', {},
7133            $param->{'action'});
7134    }
7135
7136    return $in{'previous_action'} || 'review';
7137}
7138
7139# By owner, authorizes held subscribe (add) requests.
7140# Old name: do_add_fromsub().
7141sub do_auth_add {
7142    wwslog('info', '(%s)', $in{'id'});
7143
7144    my @ids = grep { $_ and /\A\w+\z/ } split /\0/, $in{'id'};
7145    return ($in{'previous_action'} || 'subindex') unless @ids;
7146
7147    $param->{'id'} = [@ids];
7148
7149    # Action confirmed?
7150    my $next_action = $session->confirm_action(
7151        $in{'action'}, $in{'response_action'},
7152        arg             => join(',', sort @ids),
7153        previous_action => ($in{'previous_action'} || 'subindex'),
7154    );
7155    return $next_action unless $next_action eq '1';
7156
7157    my $spindle = Sympa::Spindle::ProcessRequest->new(
7158        context          => $robot,
7159        action           => 'auth',
7160        keyauth          => [@ids],
7161        request          => {context => $list, action => 'add'},
7162        sender           => $param->{'user'}{'email'},
7163        scenario_context => {
7164            sender      => $param->{'user'}{'email'},
7165            remote_host => $param->{'remote_host'},
7166            remote_addr => $param->{'remote_addr'}
7167        },
7168    );
7169    unless ($spindle and $spindle->spin) {
7170        return ($in{'previous_action'} || 'subindex');
7171    }
7172
7173    foreach my $report (@{$spindle->{stash} || []}) {
7174        if ($report->[1] eq 'notice') {
7175            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
7176                $param->{'action'});
7177        } else {
7178            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
7179                $param->{action});
7180        }
7181    }
7182    unless (@{$spindle->{stash} || []}) {
7183        Sympa::WWW::Report::notice_report_web('performed', {},
7184            $param->{'action'});
7185    }
7186
7187    return ($in{'previous_action'} || 'subindex');
7188}
7189
7190# Deletes user(s) from a list (requested by owner)
7191sub do_del {
7192    wwslog('info', '(%s)', $in{'email'});
7193
7194    # Access control.
7195    return undef unless defined check_authz('do_del', 'del');
7196
7197    my @emails =
7198        grep {$_} map { Sympa::Tools::Text::canonic_email($_) }
7199        split /\0/, $in{'email'};
7200    return $in{'previous_action'} || 'review' unless @emails;
7201
7202    $param->{'email'} = [@emails];
7203    $param->{'quiet'} = $in{'quiet'};
7204
7205    # Action confirmed?
7206    my $next_action = $session->confirm_action(
7207        $in{'action'}, $in{'response_action'},
7208        arg             => join(',', sort @emails),
7209        previous_action => ($in{'previous_action'} || 'review')
7210    );
7211    return $next_action unless $next_action eq '1';
7212
7213    my $stash     = [];
7214    my $processed = 0;
7215    foreach my $email (@emails) {
7216        my $spindle = Sympa::Spindle::ProcessRequest->new(
7217            context          => $list,
7218            action           => 'del',
7219            email            => $email,
7220            sender           => $param->{'user'}{'email'},
7221            quiet            => $param->{'quiet'},
7222            md5_check        => 1,
7223            scenario_context => {
7224                email       => $email,
7225                sender      => $param->{'user'}{'email'},
7226                remote_host => $param->{'remote_host'},
7227                remote_addr => $param->{'remote_addr'}
7228            },
7229            stash => $stash,
7230        );
7231        $spindle and $processed += $spindle->spin;
7232    }
7233    unless ($processed) {
7234        return $in{'previous_action'} || 'review';
7235    }
7236
7237    foreach my $report (@$stash) {
7238        if ($report->[1] eq 'notice') {
7239            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
7240                $param->{'action'});
7241        } else {
7242            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
7243                $param->{action});
7244        }
7245    }
7246    unless (@$stash) {
7247        Sympa::WWW::Report::notice_report_web('performed', {},
7248            $param->{'action'});
7249    }
7250
7251    # Skip search because we don't have the expression anymore.
7252    delete $in{'previous_action'} if $in{'previous_action'} eq 'search';
7253    return $in{'previous_action'} || 'review';
7254}
7255
7256# By owner, authorizes held signoff (del) requests.
7257# Old name: do_del_fromsig().
7258sub do_auth_del {
7259    wwslog('info', '(%s)', $in{'id'});
7260
7261    my @ids = grep { $_ and /\A\w+\z/ } split /\0/, $in{'id'};
7262    return ($in{'previous_action'} || 'sigindex') unless @ids;
7263
7264    $param->{'id'} = [@ids];
7265
7266    # Action confirmed?
7267    my $next_action = $session->confirm_action(
7268        $in{'action'}, $in{'response_action'},
7269        arg             => join(',', sort @ids),
7270        previous_action => ($in{'previous_action'} || 'sigindex'),
7271    );
7272    return $next_action unless $next_action eq '1';
7273
7274    my $spindle = Sympa::Spindle::ProcessRequest->new(
7275        context          => $robot,
7276        action           => 'auth',
7277        keyauth          => [@ids],
7278        request          => {context => $list, action => 'del'},
7279        sender           => $param->{'user'}{'email'},
7280        scenario_context => {
7281            sender      => $param->{'user'}{'email'},
7282            remote_host => $param->{'remote_host'},
7283            remote_addr => $param->{'remote_addr'}
7284        },
7285    );
7286    unless ($spindle and $spindle->spin) {
7287        return ($in{'previous_action'} || 'sigindex');
7288    }
7289
7290    foreach my $report (@{$spindle->{stash} || []}) {
7291        if ($report->[1] eq 'notice') {
7292            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
7293                $param->{'action'});
7294        } else {
7295            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
7296                $param->{action});
7297        }
7298    }
7299    unless (@{$spindle->{stash} || []}) {
7300        Sympa::WWW::Report::notice_report_web('performed', {},
7301            $param->{'action'});
7302    }
7303
7304    return ($in{'previous_action'} || 'sigindex');
7305}
7306# Deletes user from lists (requested by listmaster)
7307sub do_mass_del {
7308    wwslog('info', '(%s) (%s)', $in{'email'},
7309        join(', ', split /\0/, $in{'lists'}));
7310
7311    # Access control is done by %required_privileges
7312
7313    # Turn data into usable structures
7314    my @lists = split /\0/, $in{'lists'};
7315    my $email = Sympa::Tools::Text::canonic_email($in{'email'});
7316
7317    return $in{'previous_action'} || 'serveradmin'
7318        unless Sympa::Tools::Text::valid_email($email);
7319
7320    # Action confirmed?
7321    $param->{'email'} = $email;
7322    $param->{'lists'} = \@lists;
7323    $param->{'quiet'} = $in{'quiet'};
7324
7325    my $next_action = $session->confirm_action(
7326        $in{'action'}, $in{'response_action'},
7327        arg             => join(',', @lists),
7328        previous_action => 'serveradmin'
7329    );
7330    return $next_action unless $next_action eq '1';
7331
7332    for my $list (@lists) {
7333        return $in{'previous_action'} || 'serveradmin' unless $email;
7334
7335        next unless Sympa::List->new($list, $robot, {just_try => 1});
7336        $list = Sympa::List->new($list, $robot);
7337
7338        my $stash     = [];
7339        my $processed = 0;
7340        my $spindle   = Sympa::Spindle::ProcessRequest->new(
7341            context          => $list,
7342            action           => 'del',
7343            email            => $email,
7344            sender           => $param->{'user'}{'email'},
7345            quiet            => $param->{'quiet'},
7346            md5_check        => 1,
7347            scenario_context => {
7348                email       => $email,
7349                sender      => $param->{'user'}{'email'},
7350                remote_host => $param->{'remote_host'},
7351                remote_addr => $param->{'remote_addr'}
7352            },
7353            stash => $stash,
7354        );
7355        $spindle and $processed += $spindle->spin;
7356        unless ($processed) {
7357            return $in{'previous_action'} || 'serveradmin';
7358        }
7359
7360        foreach my $report (@$stash) {
7361            if ($report->[1] eq 'notice') {
7362                Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
7363                    $param->{'action'});
7364            } else {
7365                Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
7366                    $param->{action});
7367            }
7368        }
7369        unless (@$stash) {
7370            Sympa::WWW::Report::notice_report_web('performed', {},
7371                $param->{'action'});
7372        }
7373
7374        # Skip search because we don't have the expression anymore.
7375        delete $in{'previous_action'} if $in{'previous_action'} eq 'search';
7376    }
7377    return $in{'previous_action'} || 'serveradmin';
7378}
7379
7380####################################################
7381#  do_modindex
7382####################################################
7383#  Web page for an editor to moderate documents and
7384#  and/or to tag message in message topic context
7385#
7386# IN : -
7387#
7388# OUT : 'loginrequest' | 'admin' | '1' | undef
7389#
7390#######################################################
7391sub do_modindex {
7392    wwslog('info', '');
7393
7394    # Load message list.
7395    $param->{'spool'} = [];
7396    my $spool_mod = Sympa::Spool::Moderation->new(context => $list);
7397    while (1) {
7398        my ($message, $handle) = $spool_mod->next(no_lock => 1);
7399        last unless $handle;
7400        next unless $message and not $message->{validated};
7401
7402        my $id = $message->{authkey};
7403
7404        my ($date_smtp, $date_epoch, $date);
7405        $date_smtp = $message->get_header('Date') || undef;
7406        if ($date_smtp) {
7407            $date_epoch = eval {
7408                DateTime::Format::Mail->new->loose->parse_datetime($date_smtp)
7409                    ->epoch;
7410            };
7411            if (defined $date_epoch) {
7412                $date = $language->gettext_strftime('%a, %d %b %Y %H:%M:%S',
7413                    localtime $date_epoch);
7414            }
7415        }
7416
7417        push @{$param->{'spool'}},
7418            {
7419            key   => $id,
7420            value => {
7421                size          => int($message->{size} / 1024 + 0.5),
7422                subject       => $message->{decoded_subject},
7423                date_smtp     => $date_smtp,
7424                date_epoch    => $date_epoch,
7425                date          => $date,
7426                from          => $message->{sender},
7427                gecos         => $message->{gecos},
7428                spam_status   => $message->{spam_status},
7429                is_subscriber => $list->is_list_member($message->{sender}),
7430            }
7431            };
7432    }
7433
7434    #if ($list->is_there_msg_topic()) {
7435    #    $param->{'request_topic'} = 1; # Compat. <= 6.2.16.
7436    #
7437    #    foreach my $top (@{$list->{'admin'}{'msg_topic'}}) {
7438    #        if ($top->{'name'}) {
7439    #            push(@{$param->{'available_topics'}}, $top);
7440    #        }
7441    #    }
7442    #    $param->{'topic_required'} = $list->is_msg_topic_tagging_required();
7443    #}
7444
7445    my $available_files = Sympa::WWW::Tools::get_templates_list($list, 'mail',
7446        ignore_global => 1);
7447    foreach my $file (keys %$available_files) {
7448
7449        if ($file eq 'reject.tt2') {
7450
7451            my $base          = $list->{'dir'} . '/mail_tt2/';
7452            my $absolute_file = $base . 'reject.tt2';
7453            if (-l $absolute_file) {
7454
7455                my $default = readlink($absolute_file);
7456                if ((-f $default) || (-f $base . $default)) {
7457                    $default =~ s/^.*reject_//;
7458                    $default =~ s/.tt2$//;
7459                    $param->{'default_reject_template'} = $default;
7460                } else {
7461                    # link to no existing file. remove link
7462                    wwslog(
7463                        'err',
7464                        'Link %s point to un no existing file (%s)',
7465                        $base . 'reject.tt2', $default
7466                    );
7467                    unless (unlink($absolute_file)) {
7468                        wwslog(
7469                            'err',
7470                            'Could not unlink %s',
7471                            $base . 'reject.tt2'
7472                        );
7473                    }
7474                }
7475            } elsif (-f $absolute_file) {
7476                # replace existing reject.tt2 file by a symlink to
7477                # reject_default.tt2 for compatibility with version older than
7478                # 6.0
7479                unless (rename($absolute_file, $base . 'reject_default.tt2'))
7480                {
7481                    wwslog(
7482                        'err',
7483                        'Could not rename %, %s',
7484                        $base . 'reject.tt2',
7485                        $base . 'reject_default.tt2'
7486                    );
7487                }
7488                unless (symlink($base . 'reject_default.tt2', $absolute_file))
7489                {
7490                    wwslog(
7491                        'err',
7492                        'Could not symlink %s, %s',
7493                        $base . 'reject_default.tt2',
7494                        $absolute_file
7495                    );
7496                }
7497
7498                $param->{'default_reject_template'} = 'default';
7499                push(@{$param->{'available_files'}}, 'default');
7500            }
7501        } else {
7502            next unless ($file =~ /^reject_/);
7503            $file =~ s/^reject_//;
7504            $file =~ s/.tt2$//;
7505            push(@{$param->{'available_files'}}, $file);
7506        }
7507    }
7508
7509    return 1;
7510}
7511
7512sub do_docindex {
7513    wwslog('info', '');
7514
7515    # Shared documents awaiting moderation.
7516    my $shared_doc = Sympa::WWW::SharedDocument->new($list);
7517    unless ($shared_doc and -r $shared_doc->{fs_path}) {
7518        wwslog('err', 'There is no shared documents');
7519        Sympa::WWW::Report::reject_report_web('user', 'no_shared', {},
7520            $param->{'action'}, $list);
7521        web_db_log(
7522            {   'parameters' => '',
7523                'status'     => 'error',
7524                'error_type' => 'internal'
7525            }
7526        );
7527        return undef;
7528    }
7529    $param->{'shared_doc'} = $shared_doc->as_hashref;
7530
7531    my @mod = map { $_->as_hashref } $shared_doc->get_moderated_descendants;
7532    $param->{'shared_doc'}{'children'} = [@mod] if @mod;
7533
7534    return 1;
7535}
7536
7537# Installation of moderated documents of shared.
7538sub do_d_install_shared {
7539    wwslog('info', '(%s)', $in{'id'});
7540
7541    if ($in{'mode_cancel'}) {
7542        return 'docindex';
7543    }
7544
7545    my $shared_doc = Sympa::WWW::SharedDocument->new($list);
7546    unless ($shared_doc and -r $shared_doc->{fs_path}) {
7547        wwslog('err', 'There is no shared documents');
7548        Sympa::WWW::Report::reject_report_web('user', 'no_shared', {},
7549            $param->{'action'}, $list);
7550        web_db_log(
7551            {   'parameters' => '',
7552                'status'     => 'error',
7553                'error_type' => 'internal'
7554            }
7555        );
7556        return undef;
7557    }
7558    $param->{'shared_doc'} = $shared_doc->as_hashref;
7559
7560    my @id = split /\0/, $in{'id'};
7561
7562    unless ($in{'mode_confirm'} || $in{'mode_cancel'}) {
7563        # File already exists ?
7564        my @children_hash = map { $_->as_hashref }
7565            grep { $_ and not $_->{moderate} }
7566            map { Sympa::WWW::SharedDocument->new($list, $_) } @id;
7567
7568        if (@children_hash) {
7569            $param->{'shared_doc'}{'children'} = [@children_hash];
7570            $param->{'id'} = [@id];
7571
7572            return 1;
7573        }
7574    }
7575
7576    # Install the file(s) selected
7577    foreach my $id (@id) {
7578        next unless $id;
7579        my $child = Sympa::WWW::SharedDocument->new($list, $id);
7580        next unless $child and $child->{moderate};
7581
7582        unless ($child->install) {
7583            my $errno = $ERRNO;
7584            Sympa::WWW::Report::reject_report_web('intern',
7585                'install_shared_failed', {}, $param->{'action'}, $list,
7586                $param->{'user'}{'email'}, $robot);
7587            wwslog('err', 'Failed to nstall %s; %s', $child, $errno);
7588            web_db_log(
7589                {   'status'     => 'error',
7590                    'error_type' => 'internal'
7591                }
7592            );
7593            return undef;
7594        }
7595
7596        # Send a message to the author.
7597        my %context;
7598        $context{'installed_by'} = $param->{'user'}{'email'};
7599        $context{'filename'} = join '/', @{$child->{paths}};
7600
7601        my $sender = $child->{owner};
7602        unless (
7603            Sympa::send_file($list, 'd_install_shared', $sender, \%context)) {
7604            wwslog('notice',
7605                'Unable to send template "d_install_shared" to %s', $sender);
7606        }
7607    }
7608
7609    Sympa::WWW::Report::notice_report_web('performed', {},
7610        $param->{'action'});
7611    web_db_log({'status' => 'success'});
7612    return 'docindex';
7613}
7614
7615# Reject moderated documents of shared.
7616sub do_d_reject_shared {
7617    wwslog('info', '(%s)', $in{'id'});
7618
7619    my $shared_doc = Sympa::WWW::SharedDocument->new($list);
7620    unless ($shared_doc and -r $shared_doc->{fs_path}) {
7621        wwslog('err', 'There is no shared documents');
7622        Sympa::WWW::Report::reject_report_web('user', 'no_shared', {},
7623            $param->{'action'}, $list);
7624        web_db_log(
7625            {   'parameters' => '',
7626                'status'     => 'error',
7627                'error_type' => 'internal'
7628            }
7629        );
7630        return undef;
7631    }
7632    $param->{'shared_doc'} = $shared_doc->as_hashref;
7633
7634    my @id = split /\0/, $in{'id'};
7635
7636    foreach my $id (@id) {
7637        my $child = Sympa::WWW::SharedDocument->new($list, $id);
7638        next unless $child and $child->{moderate};
7639
7640        unless ($in{'quiet'}) {
7641            my %context;
7642            my $sender;
7643            $context{'rejected_by'} = $param->{'user'}{'email'};
7644            $context{'filename'} = join '/', @{$child->{paths}};
7645
7646            $sender = $child->{owner};
7647
7648            unless (
7649                Sympa::send_file(
7650                    $list, 'd_reject_shared', $sender, \%context
7651                )
7652            ) {
7653                wwslog('notice',
7654                    'Unable to send template "d_reject_shared" to %s',
7655                    $sender);
7656            }
7657        }
7658
7659        unless ($child->unlink) {
7660            Sympa::WWW::Report::reject_report_web(
7661                'intern',
7662                'erase_file',
7663                {'file' => join('/', @{$child->{paths}})},
7664                $param->{'action'},
7665                $list,
7666                $param->{'user'}{'email'},
7667                $robot
7668            );
7669            wwslog('err', 'Failed to erase %s', $child->{fs_path});
7670            web_db_log(
7671                {   'parameters' => $id,
7672                    'status'     => 'error',
7673                    'error_type' => 'internal'
7674                }
7675            );
7676            return undef;
7677        }
7678    }
7679
7680    Sympa::WWW::Report::notice_report_web('performed', {},
7681        $param->{'action'});
7682    web_db_log(
7683        {   'parameters' => $in{'id'},
7684            'status'     => 'success'
7685        }
7686    );
7687    return 'docindex';
7688}
7689
7690####################################################
7691#  do_reject
7692####################################################
7693#  Moderation of messages : rejects messages and notifies
7694#  their senders. If in{'blocklist'} add sender to list blocklist
7695#
7696# IN : -
7697#
7698# OUT : 'loginrequest' | 'modindex' | undef
7699#
7700####################################################
7701sub do_reject {
7702
7703    # toggle selection javascript have a distinction of spam and ham base on
7704    # the checkbox name . It is not useful here so join id list and idspam
7705    # list.
7706    $in{'id'} .= ',' . $in{'idspam'} if ($in{'idspam'});
7707    $in{'id'} =~ s/^,//;
7708    $in{'id'} =~ s/\0/,/g;
7709
7710    ## The quiet information might either be provided by the 'quiet' variable
7711    ## or by the 'quiet' value of the 'message_template' variable
7712    if ($in{'message_template'} eq 'quiet') {
7713        $in{'quiet'} = 1;
7714        delete $in{'message_template'};
7715    }
7716    if ($in{'blocklist'}) {
7717        $in{'quiet'} = 1;
7718    }
7719
7720    wwslog('info', '(%s)', $in{'id'});
7721    my $file;
7722
7723    $param->{'blocklist_added'}   = 0;
7724    $param->{'blocklist_ignored'} = 0;
7725    foreach my $id (split(/,/, $in{'id'})) {
7726        next unless $id and $id =~ /\A\w+\z/;
7727
7728        my $spool_mod =
7729            Sympa::Spool::Moderation->new(context => $list, authkey => $id);
7730        my ($message, $handle);
7731        while (1) {
7732            ($message, $handle) = $spool_mod->next;
7733            last unless $handle;
7734            last if $message and not $message->{validated};
7735        }
7736
7737        unless ($message) {
7738            Sympa::WWW::Report::reject_report_web('user', 'already_moderated',
7739                {key => $id, listname => $list->{'name'}},
7740                $param->{'action'});
7741            wwslog('err', 'Unable to get message with <%s> for list %s',
7742                $id, $list);
7743            web_db_log(
7744                {   'parameters' => $id,
7745                    'status'     => 'error',
7746                    'error_type' => 'internal'
7747                }
7748            );
7749            next;
7750        }
7751
7752        #  extract sender address is needed to report reject to sender and in
7753        #  case the sender is to be added to the blocklist
7754        if (($in{'quiet'} ne '1') || ($in{'blocklist'})) {
7755            my $rejected_sender = $message->{'sender'};
7756            if ($rejected_sender) {
7757                unless ($in{'message_template'} eq 'reject_quiet') {
7758                    my %context;
7759                    $context{'subject'}       = $message->{'decoded_subject'};
7760                    $context{'rejected_by'}   = $param->{'user'}{'email'};
7761                    $context{'template_used'} = $in{'message_template'};
7762                    unless (
7763                        Sympa::send_file(
7764                            $list,            $in{'message_template'},  #FIXME
7765                            $rejected_sender, \%context
7766                        )
7767                    ) {
7768                        wwslog('notice',
7769                            "Unable to send template $in{'message_template'} to $rejected_sender"
7770                        );
7771                    }
7772                }
7773                if ($in{'blocklist'}) {
7774                    if (_add_in_blocklist($rejected_sender, $robot, $list)) {
7775                        $param->{'blocklist_added'} += 1;
7776                        wwslog('info',
7777                            "added $rejected_sender to $list->{'name'} blocklist"
7778                        );
7779                    } else {
7780                        wwslog('notice',
7781                            "Unable to add $rejected_sender to $list->{'name'} blocklist"
7782                        );
7783                        $param->{'blocklist_ignored'} += 0;
7784                    }
7785                }
7786            } else {
7787                $log->syslog(
7788                    'err',
7789                    'No sender found for message %s.  Unable to use her address to add to blocklist or send notification',
7790                    $message
7791                );
7792            }
7793        }
7794
7795        if (   ($in{'signal_spam'})
7796            && ($Conf::Conf{'reporting_spam_script_path'} ne '')) {
7797            if (-x $Conf::Conf{'reporting_spam_script_path'}) {
7798                unless (
7799                    open(SCRIPT, "|$Conf::Conf{'reporting_spam_script_path'}"
7800                    )
7801                ) {
7802                    $log->syslog('err',
7803                        "could not execute $Conf::Conf{'reporting_spam_script_path'}"
7804                    );
7805                }
7806                # Sending encrypted form in case a crypted message would be
7807                # sent by error.
7808                print SCRIPT $message->as_string;
7809
7810                if (close(SCRIPT)) {
7811                    $log->syslog('info',
7812                        "message $file reported as spam by $param->{'user'}{'email'}"
7813                    );
7814                } else {
7815                    $log->syslog('err',
7816                        "could not report message $file as spam (close failed)"
7817                    );
7818                }
7819            } else {
7820                $log->syslog('err',
7821                    "ignoring parameter reporting_spam_script_path, value $Conf::Conf{'reporting_spam_script_path'} because not an executable script"
7822                );
7823            }
7824        }
7825
7826        $spool_mod->remove($handle) and $spool_mod->html_remove($message);
7827
7828    }
7829    web_db_log(
7830        {   'parameters' => $in{'id'},
7831            'status'     => 'success'
7832        }
7833    );
7834
7835    web_db_stat_log();
7836
7837    Sympa::WWW::Report::notice_report_web('performed', {},
7838        $param->{'action'});
7839
7840    return 'modindex';
7841}
7842
7843####################################################
7844#  do_distribute
7845####################################################
7846#  Moderation of messages : distributes moderated
7847#  messages and tag it in message moderation context
7848#
7849# IN : - id of message to distribute. This value can also be in idspam
7850# parameter
7851#
7852# OUT : 'loginrequest' | 'modindex' | undef
7853#
7854######################################################
7855sub do_distribute {
7856    wwslog('info', '(%s)', $in{'id'});
7857
7858    my @ids = split /\0/, $in{'id'};
7859    $param->{'id'} = [@ids];
7860    my @topics = grep { defined $_ and length $_ } split /\0/, $in{'topic'};
7861    $param->{'topic'} = [@topics];
7862    $param->{'topic_required'} =
7863        ($list->is_there_msg_topic and $list->is_msg_topic_tagging_required);
7864
7865    # Action confirmed?
7866    if ($param->{'topic_required'}) {
7867        my $response_action = (
7868            @topics    # Topics are required.
7869                or ($in{'response_action'}
7870                and $in{'response_action'} eq 'cancel')
7871            )
7872            ? $in{'response_action'}
7873            : undef;
7874        my $next_action = $session->confirm_action(
7875            $in{'action'}, $response_action,
7876            arg             => join(',', sort @ids),
7877            previous_action => ($in{'previous_action'} || 'modindex')
7878        );
7879        return $next_action unless $next_action eq '1';
7880    }
7881
7882    # Load message list.
7883    my @mail_command = ();
7884    foreach my $id (@ids) {    # QUIET DISTRIBUTE
7885        next unless $id and $id =~ /\A\w+\z/;
7886
7887        my $spool_mod =
7888            Sympa::Spool::Moderation->new(context => $list, authkey => $id);
7889        my ($message, $handle);
7890        while (1) {
7891            ($message, $handle) = $spool_mod->next;
7892            last unless $handle;
7893            last if $message and not $message->{validated};
7894        }
7895
7896        unless ($message) {
7897            Sympa::WWW::Report::reject_report_web('user', 'already_moderated',
7898                {key => $id, listname => $list->{'name'}},
7899                $param->{'action'});
7900            wwslog('err', 'Unable to find message with <%s> for list %s',
7901                $id, $list);
7902            web_db_log(
7903                {   'parameters' => $id,
7904                    'status'     => 'error',
7905                    'error_type' => 'internal'
7906                }
7907            );
7908            next;
7909        }
7910        push @mail_command,
7911            sprintf('QUIET DISTRIBUTE %s %s', $list->{'name'}, $id);
7912
7913        # TAG
7914        if (@topics) {
7915            Sympa::Spool::Topic->new(
7916                topic  => join(',', @topics),
7917                method => 'editor'
7918            )->store($message);
7919        }
7920
7921        $spool_mod->remove($handle, action => 'distribute');
7922    }
7923
7924    # Commands are injected into incoming spool directly with "md5"
7925    # authentication level.
7926    my $cmd_message = Sympa::Message->new(
7927        sprintf("\n\n%s\n", join("\n", @mail_command)),
7928        context         => $robot,
7929        envelope_sender => Sympa::get_address($robot, 'owner'),
7930        sender          => $param->{'user'}{'email'},
7931        md5_check       => 1,
7932        message_id      => Sympa::unique_message_id($robot)
7933    );
7934    $cmd_message->add_header('Content-Type', 'text/plain; Charset=utf-8');
7935
7936    unless (Sympa::Spool::Incoming->new->store($cmd_message)) {
7937        Sympa::WWW::Report::reject_report_web(
7938            'intern',
7939            'cannot_send_distribute',
7940            {   'from'     => $param->{'user'}{'email'},
7941                'listname' => $list->{'name'}
7942            },
7943            $param->{'action'},
7944            $list,
7945            $param->{'user'}{'email'},
7946            $robot
7947        );
7948        wwslog('err', 'Failed to send message for list %s, id %s',
7949            $list, $in{'id'});
7950        web_db_log(
7951            {   'parameters' => $in{'id'},
7952                'status'     => 'error',
7953                'error_type' => 'internal'
7954            }
7955        );
7956        return undef;
7957    }
7958
7959    web_db_log(
7960        {   'parameters' => $in{'id'},
7961            'status'     => 'success'
7962        }
7963    );
7964
7965    Sympa::WWW::Report::notice_report_web('performed_soon', {},
7966        $param->{'action'});
7967
7968    return 'modindex';
7969}
7970
7971# Adds user from moderation index.
7972sub do_add_frommod {
7973    wwslog('info', '(%s)', $in{'id'});
7974
7975    my @ids = split /\0/, $in{'id'};
7976    $param->{'id'} = [@ids];
7977
7978    my @users;
7979    foreach my $id (@ids) {
7980        next unless $id and $id =~ /\A\w+\z/;
7981
7982        my $spool_mod =
7983            Sympa::Spool::Moderation->new(context => $list, authkey => $id);
7984        my ($message, $handle);
7985        while (1) {
7986            ($message, $handle) = $spool_mod->next(no_lock => 1);
7987            last unless $handle;
7988            last if $message;    # Won't check {validated} metadata.
7989        }
7990        unless ($message) {
7991            Sympa::WWW::Report::reject_report_web('user', 'already_moderated',
7992                {key => $id, listname => $list->{'name'}},
7993                $param->{'action'});
7994            wwslog('err',
7995                'No message with authkey %s.  It may be already moderated',
7996                $id);
7997            web_db_log(
7998                {   'parameters' => $id,
7999                    'status'     => 'error',
8000                    'error_type' => 'internal'
8001                }
8002            );
8003            next;
8004        }
8005        my $email = $message->{sender};
8006        next unless $email and Sympa::Tools::Text::valid_email($email);
8007        my $fullname = $message->{gecos}
8008            if defined $message->{gecos} and $message->{gecos} =~ /\S/;
8009
8010        push @users,
8011            (
8012            defined $fullname
8013            ? {email => $email, gecos => $fullname}
8014            : {email => $email}
8015            );
8016    }
8017    return 'modindex' unless @users;
8018
8019    $param->{'email'} = [@users];
8020
8021    # Action confirmed?
8022    my $next_action = $session->confirm_action(
8023        $in{'action'}, $in{'response_action'},
8024        arg             => join(',', sort @ids),
8025        previous_action => 'modindex'
8026    );
8027    return $next_action unless $next_action eq '1';
8028
8029    my $stash     = [];
8030    my $processed = 0;
8031    foreach my $u (@users) {
8032        my $spindle = Sympa::Spindle::ProcessRequest->new(
8033            context          => $list,
8034            action           => 'add',
8035            email            => $u->{email},
8036            gecos            => $u->{gecos},
8037            sender           => $param->{'user'}{'email'},
8038            md5_check        => 1,
8039            scenario_context => {
8040                email       => $u->{email},
8041                sender      => $param->{'user'}{'email'},
8042                remote_host => $param->{'remote_host'},
8043                remote_addr => $param->{'remote_addr'}
8044            },
8045            stash => $stash,
8046        );
8047        $processed += $spindle->spin if $spindle;
8048    }
8049    unless ($processed) {
8050        return 'modindex';
8051    }
8052
8053    foreach my $report (@$stash) {
8054        if ($report->[1] eq 'notice') {
8055            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
8056                $param->{'action'});
8057        } else {
8058            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
8059                $param->{action});
8060        }
8061    }
8062    unless (@$stash) {
8063        Sympa::WWW::Report::notice_report_web('performed', {},
8064            $param->{'action'});
8065    }
8066
8067    return 'modindex';
8068}
8069
8070####################################################
8071#  do_viewmod
8072####################################################
8073#  Web page for an editor to moderate a mail and/or
8074#  to tag it in message topic context
8075#
8076# IN : -
8077#
8078# OUT : 'login,request' | '1' | undef
8079#
8080####################################################
8081sub do_viewmod {
8082    wwslog('info', '(%s, %s)', $in{'id'}, $in{'file'});
8083
8084    # Prevent directory traversal.
8085    if ($in{'file'}) {
8086        my $subpath = $in{'file'};
8087        $subpath =~ s{\Amsg00000/}{};
8088        delete $in{'file'} if $subpath =~ m{/};
8089    }
8090
8091    my $msg;
8092    my $tmp_dir;
8093
8094    my $available_files = Sympa::WWW::Tools::get_templates_list($list, 'mail',
8095        ignore_global => 1);
8096    foreach my $file (keys %$available_files) {
8097        next unless ($file =~ /^reject_/);
8098        $file =~ s/^reject_//;
8099        $file =~ s/.tt2$//;
8100        push(@{$param->{'available_files'}}, $file);
8101    }
8102
8103    my $html_dir =
8104          $Conf::Conf{'viewmail_dir'} . '/mod/'
8105        . $list->get_id . '/'
8106        . $in{'id'};
8107
8108    unless (-d $html_dir) {
8109        Sympa::WWW::Report::reject_report_web('intern',
8110            'no_html_message_available', {'dir' => $html_dir},
8111            $param->{'action'});
8112        wwslog('err', 'No HTML version of the message available in %s',
8113            $html_dir);
8114        return undef;
8115    }
8116
8117    if (    $in{'file'}
8118        and $in{'file'} ne 'msg00000.html'
8119        and -f $html_dir . '/' . $in{'file'}
8120        and -r $html_dir . '/' . $in{'file'}) {
8121        $in{'file'} =~ /\.(\w+)$/;
8122        $param->{'file_extension'} = $1;
8123        $param->{'file'}           = $html_dir . '/' . $in{'file'};
8124        $param->{'bypass'}         = 1;
8125        return 1;
8126    }
8127
8128    if (open my $fh, '<', $html_dir . '/msg00000.html') {
8129        $param->{'html_content'} = do { local $RS; <$fh> };
8130        close $fh;
8131    }
8132
8133    #XXX#FIXME: Is this required?
8134    #XXXpush @other_include_path, $html_dir;
8135
8136    my $id = $in{'id'};
8137
8138    my $spool_mod =
8139        Sympa::Spool::Moderation->new(context => $list, authkey => $id);
8140    my ($message, $handle);
8141    while (1) {
8142        ($message, $handle) = $spool_mod->next(no_lock => 1);
8143        last unless $handle;
8144        last if $message and not $message->{validated};
8145    }
8146    unless ($message) {
8147        Sympa::WWW::Report::reject_report_web('user', 'already_moderated',
8148            {key => $id, listname => $list->{'name'}},
8149            $param->{'action'});
8150        wwslog('err', 'Unable to get message with <%s> for list %s',
8151            $id, $list);
8152        web_db_log(
8153            {   'parameters' => $id,
8154                'status'     => 'error',
8155                'error_type' => 'internal'
8156            }
8157        );
8158        return undef;
8159    }
8160
8161    my ($date_smtp, $date_epoch, $date);
8162    $date_smtp = $message->get_header('Date') || undef;
8163    if ($date_smtp) {
8164        $date_epoch = eval {
8165            DateTime::Format::Mail->new->loose->parse_datetime($date_smtp)
8166                ->epoch;
8167        };
8168        if (defined $date_epoch) {
8169            $date = $language->gettext_strftime('%a, %d %b %Y %H:%M:%S',
8170                localtime $date_epoch);
8171        }
8172    }
8173
8174    $param->{'msg'} = {
8175        key   => $id,
8176        value => {
8177            size          => int($message->{size} / 1024 + 0.5),
8178            subject       => $message->{decoded_subject},
8179            date_smtp     => $date_smtp,
8180            date_epoch    => $date_epoch,
8181            date          => $date,
8182            from          => $message->{sender},
8183            gecos         => $message->{gecos},
8184            spam_status   => $message->{spam_status},
8185            is_subscriber => $list->is_list_member($message->{sender}),
8186        }
8187    };
8188
8189    if ($list->is_there_msg_topic()) {
8190        $param->{'request_topic'} = 1;
8191
8192        foreach my $top (@{$list->{'admin'}{'msg_topic'} || []}) {
8193            if ($top->{'name'}) {
8194                push(@{$param->{'available_topics'}}, $top);
8195            }
8196        }
8197        $param->{'topic_required'} = $list->is_msg_topic_tagging_required();
8198    }
8199
8200    return 1;
8201}
8202
8203## Edition of list/sympa files
8204## No list -> sympa files (helpfile,...)
8205## TODO : upload
8206## TODO : edit family file ???
8207sub do_editfile {
8208    wwslog('info', '(%s)', $in{'file'});
8209
8210    $param->{'subtitle'} = sprintf $param->{'subtitle'}, $in{'file'};
8211
8212    my %files = (
8213        description_templates => ['info', 'homepage'],
8214        message_templates     => [
8215            'welcome.tt2',    'bye.tt2',
8216            'removed.tt2',    'message_header',
8217            'message_footer', 'remind.tt2',
8218            'invite.tt2',     'reject.tt2',
8219            'your_infected_msg.tt2'
8220        ],
8221        all_templates => [
8222            'info',           'homepage',
8223            'welcome.tt2',    'bye.tt2',
8224            'removed.tt2',    'message_header',
8225            'message_footer', 'remind.tt2',
8226            'invite.tt2',     'reject.tt2',
8227            'your_infected_msg.tt2'
8228        ]
8229    );
8230
8231    $in{'file'} = 'all_templates' unless ($in{'file'});
8232    $param->{'selected_file'} = $in{'file'};
8233    $param->{'previous_action'} = $in{'previous_action'} || '';
8234
8235    if (defined $files{$in{'file'}}) {
8236        foreach my $f (@{$files{$in{'file'}}}) {
8237            my ($role, $right) =
8238                $list->may_edit($f, $param->{'user'}{'email'}, file => 1);
8239            next unless $right eq 'write';
8240            if ($Sympa::WWW::Tools::filenames{$f}{'gettext_id'}) {
8241                $param->{'files'}{$f}{'complete'} =
8242                    $language->gettext(
8243                    $Sympa::WWW::Tools::filenames{$f}{'gettext_id'});
8244            } else {
8245                $param->{'files'}{$f}{'complete'} = $f;
8246            }
8247        }
8248        return 1;
8249    }
8250
8251    unless (defined $Sympa::WWW::Tools::filenames{$in{'file'}}) {
8252        Sympa::WWW::Report::reject_report_web('user', 'file_not_editable',
8253            {'file' => $in{'file'}},
8254            $param->{'action'});
8255        wwslog('err', 'File %s not editable', $in{'file'});
8256        web_db_log(
8257            {   'parameters' => $in{'file'},
8258                'status'     => 'error',
8259                'error_type' => 'internal'
8260            }
8261        );
8262        return undef;
8263    }
8264
8265    $param->{'file'} = $in{'file'};
8266    $param->{'complete'} =
8267        $language->gettext(
8268        $Sympa::WWW::Tools::filenames{$in{'file'}}{'gettext_id'});
8269
8270    my $subdir = '';
8271    if ($in{'file'} =~ /\.tt2$/) {
8272        $subdir = 'mail_tt2/';
8273    }
8274
8275    if ($param->{'list'}) {
8276        my ($role, $right) =
8277            $list->may_edit($in{'file'}, $param->{'user'}{'email'},
8278            file => 1);
8279        unless ($right eq 'write') {
8280            Sympa::WWW::Report::reject_report_web('auth', 'edit_right',
8281                {'role' => $role, 'right' => $right},
8282                $param->{'action'}, $list);
8283            wwslog('err', 'Not allowed');
8284            web_db_log(
8285                {   'parameters' => $in{'file'},
8286                    'status'     => 'error',
8287                    'error_type' => 'authorization'
8288                }
8289            );
8290            return undef;
8291        }
8292
8293        ## Add list lang to tpl filename
8294        my $file = $in{'file'};
8295        #$file =~ s/\.tpl$/\.$list->{'admin'}{'lang'}\.tpl/;
8296
8297        ## Look for the template
8298        $param->{'filepath'} =
8299            Sympa::search_fullpath($list || $robot, $file, subdir => $subdir);
8300
8301        ## There might be no matching file if default template not provided
8302        ## with Sympa
8303        if (defined $param->{'filepath'}) {
8304            ## open file and provide filecontent to the parser
8305            ## It allows to us the correct file encoding
8306            my $file_path = $param->{'filepath'};
8307            $param->{'filecontent'} = Sympa::Tools::Text::slurp($file_path);
8308            unless (defined $param->{'filecontent'}) {
8309                wwslog('err', 'Failed to open file %s: %m', $file_path);
8310                Sympa::WWW::Report::reject_report_web(
8311                    'intern', 'cannot_open_file',
8312                    {'file' => $file_path}, $param->{'action'},
8313                    $list, $param->{'user'}{'email'},
8314                    $robot
8315                );
8316                web_db_log(
8317                    {   'parameters' => $in{'file'},
8318                        'status'     => 'error',
8319                        'error_type' => 'internal'
8320                    }
8321                );
8322                return undef;
8323            }
8324        } else {
8325            $param->{'filepath'} = $list->{'dir'} . '/' . $subdir . $file;
8326        }
8327
8328        ## Default for 'homepage' is 'info'
8329        if (($in{'file'} eq 'homepage')
8330            && !$param->{'filepath'}) {
8331            $param->{'filepath'} = Sympa::search_fullpath($list || $robot,
8332                'info', subdir => $subdir);
8333        }
8334    } else {
8335        unless (Sympa::is_listmaster($robot, $param->{'user'}{'email'})) {
8336            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
8337                {'argument' => 'list'},
8338                $param->{'action'});
8339            wwslog('err', 'No list');
8340            web_db_log(
8341                {   'parameters' => $in{'file'},
8342                    'status'     => 'error',
8343                    'error_type' => 'no_list'
8344                }
8345            );
8346            return undef;
8347        }
8348
8349        my $file = $in{'file'};
8350
8351        ## Look for the template
8352        if ($file eq 'list_aliases.tt2') {
8353            $param->{'filepath'} =
8354                Sympa::search_fullpath($list || $robot, $file);
8355        } else {
8356            $param->{'filepath'} = Sympa::search_fullpath($list || $robot,
8357                $file, subdir => $subdir);
8358        }
8359
8360        $param->{'filecontent'} =
8361            Sympa::Tools::Text::slurp($param->{'filepath'});
8362
8363        unless (defined $param->{'filecontent'}) {
8364            wwslog('err', 'Failed to open file %s: %m', $param->{'filepath'});
8365            Sympa::WWW::Report::reject_report_web(
8366                'intern',
8367                'cannot_open_file',
8368                {'file' => $param->{'file_path'}},
8369                $param->{'action'},
8370                $list,
8371                $param->{'user'}{'email'},
8372                $robot
8373            );
8374            web_db_log(
8375                {   'parameters' => $in{'file'},
8376                    'status'     => 'error',
8377                    'error_type' => 'internal'
8378                }
8379            );
8380            return undef;
8381        }
8382    }
8383
8384    if (-f $param->{'filepath'} && (!-r $param->{'filepath'})) {
8385        Sympa::WWW::Report::reject_report_web('intern', 'cannot_read',
8386            {'filepath' => $param->{'filepath'}},
8387            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
8388        wwslog('err', 'Cannot read %s', $param->{'filepath'});
8389        web_db_log(
8390            {   'parameters' => $in{'file'},
8391                'status'     => 'error',
8392                'error_type' => 'internal'
8393            }
8394        );
8395        return undef;
8396    }
8397    web_db_log(
8398        {   'parameters' => $in{'file'},
8399            'status'     => 'success'
8400        }
8401    );
8402
8403    #FIXME: Required?
8404    $allow_absolute_path = 1;
8405
8406    return 1;
8407}
8408
8409##############################################################################
8410
8411## Saving of list files
8412sub do_savefile {
8413    wwslog('info', '(%s)', $in{'file'});
8414
8415    $param->{'subtitle'} = sprintf $param->{'subtitle'}, $in{'file'};
8416
8417    unless ($in{'file'} and $Sympa::WWW::Tools::filenames{$in{'file'}}) {
8418        Sympa::WWW::Report::reject_report_web('user', 'file_not_editable',
8419            {'file' => $in{'file'}},
8420            $param->{'action'});
8421        wwslog('info', 'File %s not editable', $in{'file'});
8422        return undef;
8423    }
8424
8425    if ($param->{'list'}) {
8426        my ($role, $right) =
8427            $list->may_edit($in{'file'}, $param->{'user'}{'email'},
8428            file => 1);
8429        unless ($right eq 'write') {
8430            Sympa::WWW::Report::reject_report_web('auth', 'edit_right',
8431                {'role' => $role, 'right' => $right},
8432                $param->{'action'}, $list);
8433            wwslog('err', 'Not allowed');
8434            web_db_log(
8435                {   'parameters' => $in{'file'},
8436                    'status'     => 'error',
8437                    'error_type' => 'authorization'
8438                }
8439            );
8440            return undef;
8441        }
8442
8443        if ($in{'file'} =~ /\.tt2$/) {
8444            $param->{'filepath'} =
8445                $list->{'dir'} . '/mail_tt2/' . $in{'file'};
8446        } else {
8447            $param->{'filepath'} = $list->{'dir'} . '/' . $in{'file'};
8448
8449            if (defined $list->{'admin'}{'family_name'}) {
8450                unless ($list->update_config_changes('file', $in{'file'})) {
8451                    Sympa::WWW::Report::reject_report_web('intern',
8452                        'update_config_changes', {}, $param->{'action'},
8453                        $list, $param->{'user'}{'email'}, $robot);
8454                    wwslog('info',
8455                        'Cannot write in config_changes for file %s',
8456                        $param->{'filepath'});
8457                    web_db_log(
8458                        {   'parameters' => $in{'file'},
8459                            'status'     => 'error',
8460                            'error_type' => 'internal'
8461                        }
8462                    );
8463                    return undef;
8464                }
8465            }
8466
8467        }
8468    } else {
8469        unless (Sympa::is_listmaster($robot, $param->{'user'}{'email'})) {
8470            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
8471                {'argument' => 'list'},
8472                $param->{'action'});
8473            wwslog('err', 'No list');
8474            web_db_log(
8475                {   'parameters' => $in{'file'},
8476                    'status'     => 'error',
8477                    'error_type' => 'no_list'
8478                }
8479            );
8480            return undef;
8481        }
8482
8483        if ($robot ne $Conf::Conf{'domain'}) {
8484            if ($in{'file'} eq 'list_aliases.tt2') {
8485                $param->{'filepath'} =
8486                    "$Conf::Conf{'etc'}/$robot/$in{'file'}";
8487            } elsif ($in{'file'} =~ /\.tt2$/) {
8488                $param->{'filepath'} =
8489                    "$Conf::Conf{'etc'}/$robot/mail_tt2/$in{'file'}";
8490            } else {
8491                $param->{'filepath'} =
8492                    "$Conf::Conf{'etc'}/$robot/$in{'file'}";
8493            }
8494        } else {
8495            if ($in{'file'} eq 'list_aliases.tt2') {
8496                $param->{'filepath'} = "$Conf::Conf{'etc'}/$in{'file'}";
8497            } elsif ($in{'file'} =~ /\.tt2$/) {
8498                $param->{'filepath'} =
8499                    "$Conf::Conf{'etc'}/mail_tt2/$in{'file'}";
8500            } else {
8501                $param->{'filepath'} = "$Conf::Conf{'etc'}/$in{'file'}";
8502            }
8503        }
8504    }
8505
8506    unless ((!-e $param->{'filepath'}) or (-w $param->{'filepath'})) {
8507        Sympa::WWW::Report::reject_report_web('intern', 'cannot_write',
8508            {'filepath' => $param->{'filepath'}},
8509            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
8510        wwslog('err', 'Cannot write %s', $param->{'filepath'});
8511        web_db_log(
8512            {   'parameters' => $in{'file'},
8513                'status'     => 'error',
8514                'error_type' => 'internal'
8515            }
8516        );
8517        return undef;
8518    }
8519
8520    ## Keep the old file
8521    if (-e $param->{'filepath'}) {
8522        rename($param->{'filepath'}, "$param->{'filepath'}.orig");
8523    }
8524
8525    ## Not empty
8526    if ($in{'content'} && ($in{'content'} !~ /^\s*$/)) {
8527
8528        ## Remove DOS linefeeds (^M) that cause problems with Outlook 98, AOL,
8529        ## and EIMS:
8530        $in{'content'} =~ s/\r\n|\r/\n/g;
8531
8532        ## Create directory if required
8533        my $dir = $param->{'filepath'};
8534        $dir =~ s/\/[^\/]+$//;
8535        unless (-d $dir) {
8536            unless (mkdir $dir, 0777) {
8537                Sympa::WWW::Report::reject_report_web('intern',
8538                    'cannot_mkdir', {'dir' => $dir},
8539                    $param->{'action'}, $list, $param->{'user'}{'email'},
8540                    $robot);
8541                wwslog('err', 'Failed to create directory %s: %s',
8542                    $dir, $ERRNO);
8543                web_db_log(
8544                    {   'parameters' => $in{'file'},
8545                        'status'     => 'error',
8546                        'error_type' => 'internal'
8547                    }
8548                );
8549                return undef;
8550            }
8551        }
8552
8553        ## Save new file
8554        my $ofh;
8555        unless (open $ofh, '>', $param->{'filepath'}) {
8556            Sympa::WWW::Report::reject_report_web(
8557                'intern', 'cannot_open_file',
8558                {'file' => $param->{'filepath'}}, $param->{'action'},
8559                $list, $param->{'user'}{'email'},
8560                $robot
8561            );
8562            wwslog('err', 'Failed to save file %s: %s',
8563                $param->{'filepath'}, $ERRNO);
8564            web_db_log(
8565                {   'parameters' => $in{'file'},
8566                    'status'     => 'error',
8567                    'error_type' => 'internal'
8568                }
8569            );
8570            return undef;
8571        }
8572        print $ofh Sympa::Tools::Text::canonic_text($in{'content'});
8573        close $ofh;
8574    } elsif (-f $param->{'filepath'}) {
8575        wwslog('info', 'Deleting %s', $param->{'filepath'});
8576        unlink $param->{'filepath'};
8577    }
8578    web_db_log(
8579        {   'parameters' => $in{'file'},
8580            'status'     => 'success'
8581        }
8582    );
8583
8584    Sympa::WWW::Report::notice_report_web('performed', {},
8585        $param->{'action'});
8586
8587    #    undef $in{'file'};
8588    #    undef $param->{'file'};
8589    my $pa = 'editfile';
8590    $pa = $in{'previous_action'} if ($in{'previous_action'});
8591    return $pa;
8592}
8593
8594## Access to web archives
8595sub do_arc {
8596    wwslog('info', '(%s, %s)', $in{'month'}, $in{'arc_file'});
8597    my $latest;
8598
8599    my $index = $session->{'arc_mode'}
8600        || $Conf::Conf{'archive_default_index'};
8601    $index = 'thrd' unless $index and $index =~ /^(thrd|mail)$/;
8602
8603    ## Clean arc_file
8604    if ($in{'arc_file'} eq '/') {
8605        delete $in{'arc_file'};
8606    }
8607
8608    ## Access control
8609    unless (defined check_authz('do_arc', 'archive_web_access')) {
8610        $param->{'previous_action'} = 'arc';
8611        $param->{'previous_list'}   = $list->{'name'};
8612        return undef;
8613    }
8614
8615    # Check authorization for tracking.
8616    my $result = Sympa::Scenario->new($list, 'tracking')->authz(
8617        $param->{'auth_method'},
8618        {   'sender'      => $param->{'user'}{'email'},
8619            'remote_host' => $param->{'remote_host'},
8620            'remote_addr' => $param->{'remote_addr'}
8621        }
8622    );
8623    my $r_action;
8624    if (ref($result) eq 'HASH') {
8625        $r_action = $result->{'action'};
8626    }
8627
8628    if ($r_action =~ /do_it/i) {
8629        $param->{'may_tracking'} = 1;
8630    } else {
8631        $param->{'may_tracking'} = 0;
8632    }
8633
8634    if (    ($session->{'archive_sniffer'} || '') ne 'false'
8635        and not $param->{'user'}{'email'}
8636        and $list->{'admin'}{'web_archive_spam_protection'} eq 'cookie') {
8637        my $month    = $in{'month'}    || '';
8638        my $arc_file = $in{'arc_file'} || '';
8639
8640        $param->{'month'}    = $month;
8641        $param->{'arc_file'} = $arc_file;
8642
8643        # Action confirmed?
8644        my $next_action = $session->confirm_action(
8645            $in{'action'}, $in{'response_action'},
8646            arg             => join('/', $month, $arc_file),
8647            previous_action => ($in{'previous_action'} || 'info')
8648        );
8649        return $next_action unless $next_action eq '1';
8650
8651        # If confirmed, set flag and redirect to the file.
8652        $session->{'archive_sniffer'} = 'false';
8653        $param->{'redirect_to'}       = Sympa::get_url(
8654            $list, 'arc',
8655            paths => ($month ? [$month, $arc_file] : ['']),
8656            authority => 'local'
8657        );
8658        return 1;
8659    }
8660
8661    my $archive = Sympa::Archive->new(context => $list);
8662    # Calendar
8663    my @arcs = $archive->get_archives;
8664    unless (@arcs) {
8665        Sympa::WWW::Report::reject_report_web('user', 'empty_archives', {},
8666            $param->{'action'}, $list);
8667        wwslog('err', 'Empty archive %s', $archive);
8668        return undef;
8669    }
8670    foreach my $arc (@arcs) {
8671        my $info;
8672        if (    $info = $archive->select_archive($arc, count => 1)
8673            and $info->{count}) {
8674            my ($yyyy, $mm) = split /-/, $arc;
8675            $param->{'calendar'}{$yyyy}{$mm} = $info->{count};
8676            $latest = $arc;
8677        }
8678    }
8679
8680    # Given partial URI, redirect to base.
8681    unless ($in{'month'}) {
8682        $param->{'redirect_to'} = Sympa::get_url(
8683            $list, 'arc',
8684            nomenu    => $param->{'nomenu'},
8685            paths     => [$latest, ''],        # Ends with '/'.
8686            authority => 'local'
8687        );
8688        return 1;
8689    }
8690    unless ($in{'arc_file'} or ($ENV{PATH_INFO} // '') =~ m{/\z}) {
8691        $param->{'redirect_to'} = Sympa::get_url(
8692            $list, 'arc',
8693            nomenu    => $param->{'nomenu'},
8694            paths     => [$in{'month'}, ''],    # Ends with '/'.
8695            authority => 'local'
8696        );
8697        return 1;
8698    }
8699
8700    # Read HTML file
8701    unless ($archive->select_archive($in{'month'})) {
8702        wwslog('err', 'Unable to find month "%s" in %s',
8703            $in{'month'}, $archive);
8704        Sympa::WWW::Report::reject_report_web(
8705            'user',
8706            'month_not_found',
8707            {   'month'    => $in{'month'},
8708                'listname' => $param->{'list'}
8709            },
8710            $param->{'action'},
8711            $list,
8712            $param->{'user'}{'email'},
8713            $robot
8714        );
8715
8716        $archive->select_archive($latest);
8717    }
8718
8719    # File exists?
8720    my $html_metadata;
8721    unless ($in{'arc_file'}) {
8722        while ($html_metadata = $archive->html_next(reverse => 1)) {
8723            next unless %$html_metadata;
8724            next unless $html_metadata->{filename} =~ /\A$index(\d+)\.html\z/;
8725            last;
8726        }
8727        $in{'arc_file'} = $html_metadata->{filename} if $html_metadata;
8728    } else {
8729        $html_metadata = $archive->html_fetch(file => $in{'arc_file'});
8730    }
8731    unless ($html_metadata) {
8732        wwslog('err', 'Unable to read HTML message <%s>', $in{'arc_file'});
8733        Sympa::WWW::Report::reject_report_web(
8734            'user',
8735            'arc_not_found',    #FIXME: Not implemented.
8736            {   'arc_file' => $in{'arc_file'},
8737                'month'    => $in{'month'},
8738                'listname' => $param->{'list'}
8739            },
8740            $param->{'action'},
8741            $list,
8742            $param->{'user'}{'email'},
8743            $robot
8744        );
8745        return undef;
8746    }
8747
8748    ## File type
8749    if ($in{'arc_file'} =~ /^(mail\d+|msg\d+|thrd\d+)\.html$/) {
8750        if ($in{'arc_file'} =~ /^(thrd|mail)\d+\.html/) {
8751            $session->{'arc_mode'} = $1;
8752        }
8753        if ($param->{'user'}{'email'}) {
8754            if ($param->{'user'}{'prefs'}{'arc_mode'} ne
8755                $session->{'arc_mode'}) {
8756                # update user pref  as soon as connected user change the way
8757                # they consult archives
8758                $param->{'user'}{'prefs'}{'arc_mode'} =
8759                    $session->{'arc_mode'};
8760                Sympa::User::update_global_user($param->{'user'}{'email'},
8761                    {data => $param->{'user'}{'prefs'}});
8762            }
8763        }
8764
8765        if ($in{'arc_file'} =~ /^(msg\d+)\.html$/) {
8766            # If the file is a message, load the metadata to find out who is
8767            # the author of the message.
8768            $param->{'include_picture'} =
8769                $list->find_picture_url($html_metadata->{'X-From'});
8770            $param->{'subtitle'} = $html_metadata->{'X-Subject'};
8771        }
8772
8773        # Provide a file content to the TT2 parser (instead of a filename
8774        # previously).
8775        $param->{'html_content'} = $html_metadata->{html_content};
8776
8777        #FIXME: Is this required?
8778        push @other_include_path, $archive->{arc_directory};
8779    } else {
8780        if ($in{'arc_file'} =~ /\.(\w+)$/) {
8781            $param->{'file_extension'} = $1;
8782        }
8783
8784        $param->{'bypass'} = 1;
8785        $param->{'file'} = $archive->{arc_directory} . '/' . $in{'arc_file'};
8786    }
8787
8788    $param->{'date'} = Sympa::Tools::File::get_mtime(
8789        $archive->{arc_directory} . '/' . $in{'arc_file'});
8790    # send page as static if client is a bot. That's prevent crawling all
8791    # archices every weeks by google, yahoo and others bots
8792    if ($session->{'is_a_crawler'}) {
8793        $param->{'header_date'} = $param->{'date'};
8794    }
8795    $param->{'archive_name'} = $in{'month'};
8796
8797    #test pour différentier les action d'un robot et d'un simple abonné
8798
8799    web_db_stat_log();
8800
8801    return 1;
8802}
8803
8804## Access to latest web archives
8805sub do_latest_arc {
8806    wwslog('info', '(%s, %s, %s)', $in{'list'}, $in{'for'}, $in{'count'});
8807
8808    ## Access control
8809    return undef
8810        unless defined check_authz('do_latest_arc', 'archive_web_access');
8811
8812    ## parameters of the query
8813    my $today = time;
8814
8815    my $oldest_day;
8816    if (defined $in{'for'}) {
8817        $oldest_day = $today - (86400 * ($in{'for'}));
8818        $param->{'for'} = $in{'for'};
8819        unless ($oldest_day >= 0) {
8820            Sympa::WWW::Report::reject_report_web('user', 'nb_days_to_much',
8821                {'nb_days' => $in{'for'}},
8822                $param->{'action'}, $list);
8823            wwslog('err', 'Parameter "for" is too big"');
8824        }
8825    }
8826
8827    my $nb_arc;
8828    my $NB_ARC_MAX = 100;
8829    if (defined $in{'count'}) {
8830        if ($in{'count'} > $NB_ARC_MAX) {
8831            $in{'count'} = $NB_ARC_MAX;
8832        }
8833        $param->{'count'} = $in{'count'};
8834        $nb_arc = $in{'count'};
8835    } else {
8836        $nb_arc = $NB_ARC_MAX;
8837    }
8838
8839    my $archive = Sympa::Archive->new(context => $list);
8840    my @arcs = reverse $archive->get_archives;
8841    my $stop_search;
8842    my @archives;
8843
8844    # year-month directory
8845    foreach my $arc (@arcs) {
8846        if ($nb_arc <= 0) {
8847            last;
8848        }
8849
8850        last if $stop_search;
8851
8852        unless ($archive->select_archive($arc)) {
8853            Sympa::WWW::Report::reject_report_web(
8854                'intern',
8855                'inaccessible_archive',
8856                {   'year_month' => $arc,
8857                    'listname'   => $list->{'name'}
8858                },
8859                $param->{'action'},
8860                $list,
8861                $param->{'user'}{'email'},
8862                $robot
8863            );
8864            wwslog('err', 'Unable to open directory %s in %s', $arc,
8865                $archive);
8866            next;
8867        }
8868
8869        # Messages in the year-month directory
8870        while (1) {
8871            my ($message, $handle) = $archive->next(reverse => 1);
8872            last unless $handle;
8873            next unless $message;
8874
8875            last if $nb_arc <= 0;
8876
8877            my ($date_smtp, $date_epoch, $date);
8878            $date_smtp = $message->get_header('Date') || undef;
8879            unless ($date_smtp) {
8880                wwslog('err', 'No date found in message %s', $message);
8881                next;
8882            }
8883            $date_epoch = eval {
8884                DateTime::Format::Mail->new->loose->parse_datetime($date_smtp)
8885                    ->epoch;
8886            };
8887            if (defined $date_epoch) {
8888                if ($date_epoch < $oldest_day) {
8889                    $stop_search = 1;
8890                    last;
8891                }
8892                $date = $language->gettext_strftime("%d %b %Y",
8893                    localtime $date_epoch);
8894            }
8895
8896            push @archives,
8897                {
8898                subject    => $message->{decoded_subject},
8899                date_smtp  => $date_smtp,
8900                date_epoch => $date_epoch,
8901                date       => $date,
8902                from       => $message->{sender},
8903                gecos      => $message->{gecos},
8904                message_id => $message->{message_id},
8905                year_month => $arc,
8906                };
8907            $nb_arc--;
8908        }
8909    }
8910
8911    @{$param->{'archives'}} =
8912        sort ({ $b->{'date_epoch'} <=> $a->{'date_epoch'} } @archives);
8913
8914    return 1;
8915}
8916
8917sub get_timelocal_from_date {
8918    my ($mday, $mon, $yr, $hr, $min, $sec, $zone) = @_;
8919    my ($time) = 0;
8920
8921    $yr -= 1900 if $yr >= 1900;    # if given full 4 digit year
8922    $yr += 100 if $yr <= 37;       # in case of 2 digit years
8923    if (($yr < 70) || ($yr > 137)) {
8924        warn "Warning: Bad year (", $yr + 1900, ") using current\n";
8925        $yr = (localtime(time))[5];
8926    }
8927
8928    $time = Time::Local::timelocal($sec, $min, $hr, $mday, $mon, $yr);
8929    return $time;
8930
8931}
8932
8933####################################################
8934#  do_remove_arc
8935####################################################
8936#
8937#  request by list owner or message sender to remove message from archive
8938#  Create in the outgoing spool a file containing the message-id of mesage to
8939#  be removed
8940#
8941# IN : list@host yyyy month and a tab of msgid
8942#
8943# OUT :  1 | undef
8944#
8945####################################################
8946
8947sub do_remove_arc {
8948    wwslog('info', 'List %s, yyyy %s, mm %s, #message %s',
8949        $in{'list'}, $in{'yyyy'}, $in{'month'});
8950
8951    # $in{'msgid'} = Sympa::Tools::Text::unescape_chars($in{'msgid'});
8952    my @msgids       = split /\0/, $in{'msgid'};
8953    my @msg_subjects = split /\0/, $in{'msg_subject'};
8954
8955    unless (@msgids) {
8956        Sympa::WWW::Report::reject_report_web('user', 'may_not_remove_arc',
8957            {}, $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
8958        wwslog('err', 'No message id found');
8959        web_db_log(
8960            {   'parameters' => $in{'msgid'},
8961                'msg_id'     => $in{'msgid'},
8962                'status'     => 'error',
8963                'error_type' => 'no_msgid'
8964            }
8965        );
8966        $param->{'status'} = 'no_msgid';
8967        return undef;
8968    }
8969    $param->{'yyyy'}           = $in{'yyyy'};
8970    $param->{'month'}          = $in{'month'};
8971    $param->{'signal_as_spam'} = $in{'signal_as_spam'};
8972    $param->{'msgid'}          = [@msgids];
8973    $param->{'msg_subject'}    = [@msg_subjects];
8974
8975    # Action confirmed?
8976    my $next_action = $session->confirm_action(
8977        $in{'action'}, $in{'response_action'},
8978        arg             => join(',', $in{'yyyy'}, $in{'month'}, @msgids),
8979        previous_action => 'arc'
8980    );
8981    unless ($next_action eq '1') {
8982        $in{'month'} = sprintf '%s-%s', $in{'yyyy'}, $in{'month'}
8983            if $next_action eq 'arc';
8984        return $next_action;
8985    }
8986
8987    my $msg_string = "\n\n";
8988    my $tracking = Sympa::Tracking->new(context => $list);
8989    foreach my $msgid (@msgids) {
8990        chomp $msgid;
8991        if (defined($in{signal_as_spam})
8992            && $Conf::Conf{'reporting_spam_script_path'} ne '') {
8993            $msg_string .= sprintf "signal_spam %s %s-%s %s\n",
8994                $list->{'name'},
8995                $in{'yyyy'}, $in{'month'}, $msgid;
8996        }
8997        $msg_string .= sprintf "remove_arc %s %s-%s %s\n", $list->{'name'},
8998            $in{'yyyy'}, $in{'month'}, $msgid;
8999
9000        #FIXME: Removing tracking should be done by archived.
9001        $tracking->remove_message_by_id($msgid);
9002    }
9003    my $arc_message = Sympa::Message->new(
9004        $msg_string,
9005        context => $robot,
9006        sender  => $param->{'user'}{'email'},
9007        date    => time
9008    );
9009    my $marshalled = Sympa::Spool::Archive->new->store($arc_message);
9010    unless ($marshalled) {
9011        Sympa::WWW::Report::reject_report_web('intern',
9012            'cannot_store_command', {'command' => 'remove'},
9013            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
9014        wwslog('info',
9015            'Cannot store command to remove archive %s-%s of list %s',
9016            $in{'yyyy'}, $in{'month'}, $list);
9017        web_db_log(
9018            {   'parameters' => $in{'msgid'},
9019                'msg_id'     => $in{'msgid'},
9020                'status'     => 'error',
9021                'error_type' => 'internal'
9022            }
9023        );
9024        return undef;
9025    }
9026
9027    wwslog(
9028        'info',
9029        '%d messages marked to be removed by archived',
9030        scalar @msgids
9031    );
9032    web_db_log(
9033        {   'parameters' => $in{'msgid'},
9034            'msg_id'     => $in{'msgid'},
9035            'status'     => 'success'
9036        }
9037    );
9038
9039    #web_db_stat_log();
9040
9041    $param->{'status'} = 'done';
9042
9043    return 1;
9044}
9045
9046####################################################
9047#  do_send_me
9048####################################################
9049#  Sends a web archive message to a
9050#  requesting user
9051#
9052# IN : -
9053#
9054# OUT : 'arc' | 1 | undef
9055#
9056####################################################
9057sub do_send_me {
9058    wwslog('info', '(%s, %s, %s, %s)',
9059        $in{'list'}, $in{'yyyy'}, $in{'month'}, $in{'msgid'});
9060
9061    my $message_id = Sympa::Tools::Text::canonic_message_id($in{'msgid'});
9062    unless ($message_id
9063        and $message_id !~ /NO-ID-FOUND\.mhonarc\.org/) {
9064        Sympa::WWW::Report::reject_report_web('intern', 'may_not_send_me', {},
9065            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
9066        wwslog('info', 'No message id found');
9067        $param->{'status'} = 'no_msgid';
9068        return undef;
9069    }
9070
9071    my $spindle = Sympa::Spindle::ResendArchive->new(
9072        resent_by  => $param->{'user'}{'email'},
9073        context    => $list,
9074        arc        => "$in{'yyyy'}-$in{'month'}",
9075        message_id => $message_id,
9076        quiet      => 1
9077    );
9078
9079    unless ($spindle and $spindle->spin) {
9080        wwslog('info', 'No file match msgid');
9081        $param->{'status'} = 'not_found';
9082        return undef;
9083    } elsif ($spindle->{finish} and $spindle->{finish} eq 'success') {
9084        wwslog(
9085            'info',      'Message %s spooled for %s',
9086            $message_id, $param->{'user'}{'email'}
9087        );
9088        Sympa::WWW::Report::notice_report_web('performed', {},
9089            $param->{'action'});
9090        $in{'month'} = $in{'yyyy'} . "-" . $in{'month'};
9091        return 'arc';
9092    } else {
9093        $param->{'status'} = 'message_err';
9094        wwslog(
9095            'err',
9096            'Impossible to send archive file to %s',
9097            $param->{'user'}{'email'}
9098        );
9099        return undef;
9100    }
9101
9102    return 1;
9103}
9104
9105####################################################
9106#  do_view_source
9107####################################################
9108#  Display message as text/plain in archives
9109#
9110# IN : -
9111#
9112# OUT : 'arc' | 1 | undef
9113#
9114####################################################
9115sub do_view_source {
9116    wwslog('info', '(%s, %s, %s, %s)',
9117        $in{'list'}, $in{'yyyy'}, $in{'month'}, $in{'msgid'});
9118
9119    ## Access control
9120    unless (defined check_authz('do_arc', 'archive_web_access')) {
9121        $param->{'previous_action'} = 'arc';
9122        $param->{'previous_list'}   = $list->{'name'};
9123        return undef;
9124    }
9125
9126    unless ($in{'msgid'}
9127        and $in{'msgid'} !~ /NO-ID-FOUND\.mhonarc\.org/) {
9128        Sympa::WWW::Report::reject_report_web('intern',
9129            'may_not_view_source', {},
9130            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
9131        wwslog('info', 'No message id found');
9132        $param->{'status'} = 'no_msgid';
9133        return undef;
9134    }
9135
9136    my $archive = Sympa::Archive->new(context => $list);
9137    my ($message, $handle);
9138    if ($archive->select_archive("$in{'yyyy'}-$in{'month'}")) {
9139        ($message, $handle) = $archive->fetch(message_id => $in{'msgid'});
9140    }
9141    if ($message) {
9142        $param->{'bypass'} = 'extreme';
9143        print "Content-Type: text/plain\n\n";
9144        print $message->as_string;
9145    } else {
9146        wwslog('info', 'No file match msgid');
9147        $param->{'status'} = 'not_found';
9148        return undef;
9149    }
9150
9151    return 1;
9152}
9153
9154####################################################
9155#  do_tracking
9156####################################################
9157#  Display notifications status when a recipient is not usually delivered
9158#
9159# IN : -
9160#
9161# OUT : 'arc' | 1 | undef
9162#
9163####################################################
9164sub do_tracking {
9165    wwslog('info', '(%s, %s, %s, %s)',
9166        $in{'list'}, $in{'yyyy'}, $in{'month'}, $in{'msgid'});
9167
9168    if (    $in{'yyyy'}
9169        and $in{'yyyy'} =~ /\A\d\d\d\d\z/
9170        and $in{'month'}
9171        and $in{'month'} =~ /\A\d\d?\z/) {
9172        $param->{'archive_name'} = sprintf '%d-%02d', $in{'yyyy'},
9173            $in{'month'};
9174    }
9175
9176    ## Access control
9177    my $result = Sympa::Scenario->new($list, 'tracking')->authz(
9178        $param->{'auth_method'},
9179        {   'sender'      => $param->{'user'}{'email'},
9180            'remote_host' => $param->{'remote_host'},
9181            'remote_addr' => $param->{'remote_addr'}
9182        }
9183    );
9184    my $r_action;
9185    my $reason;
9186    if (ref($result) eq 'HASH') {
9187        $r_action = $result->{'action'};
9188        $reason   = $result->{'reason'};
9189    }
9190
9191    unless ($r_action =~ /do_it/i) {
9192        $param->{'previous_action'} = 'arc';
9193        $param->{'previous_list'}   = $list->{'name'};
9194        Sympa::WWW::Report::reject_report_web('auth', $reason, {},
9195            $param->{'action'}, $list);
9196        wwslog('info', 'Access denied for %s', $param->{'user'}{'email'});
9197        return undef;
9198    }
9199
9200    # is tracking configured for this list ?
9201    unless (
9202        ($list->{admin}{tracking}{delivery_status_notification} eq 'on')
9203        || ($list->{admin}{tracking}{message_disposition_notification} eq
9204            'on')
9205        || ($list->{admin}{tracking}{message_disposition_notification} eq
9206            'on_demand')
9207    ) {
9208        wwslog('err', 'List not configured for tracking');
9209        Sympa::WWW::Report::reject_report_web('intern',
9210            'list_not_configured_for_tracking');
9211        $param->{'previous_action'} = 'arc';
9212        $param->{'previous_list'}   = $list->{'name'};
9213        return undef;
9214    }
9215    if (  !$in{'msgid'}
9216        || $in{'msgid'} =~ /NO-ID-FOUND\.mhonarc\.org/) {
9217        Sympa::WWW::Report::reject_report_web('user', 'no_msgid', {},
9218            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
9219        wwslog('err', 'No message id found');
9220        $param->{'status'} = 'no_msgid';
9221        return undef;
9222    }
9223    ##
9224
9225    $param->{'subject'}  = $in{'subject'};
9226    $param->{'fromname'} = $in{'fromname'};
9227    $param->{'fromaddr'} = $in{'fromaddr'};
9228    $param->{'msgid'}    = $in{'msgid'};
9229    $param->{'listname'} = $in{'list'};
9230
9231    my $tracking_info =
9232        Sympa::Tracking::get_recipients_status($in{'msgid'}, $in{'list'},
9233        $robot);
9234    unless ($tracking_info) {
9235        Sympa::WWW::Report::reject_report_web('user',
9236            'could_not_get_tracking_info', {}, $param->{'action'}, $list,
9237            $param->{'user'}{'email'}, $robot);
9238        wwslog('err',
9239            "could not get tracking info for message_id $in{'msgid'} and list $in{'list'}"
9240        );
9241        delete $param->{'tracking_info'};
9242        $param->{'status'} = 'could_not_get_tracking_info';
9243        return undef;
9244    }
9245
9246    # Arrival-Date would be reformatted as local time and current language.
9247    foreach my $info (@$tracking_info) {
9248        $info->{'arrival_date'} =
9249            $language->gettext_strftime('%d %b %Y at %H:%M:%S',
9250            localtime $info->{'arrival_epoch'})
9251            if defined $info->{'arrival_epoch'};
9252    }
9253
9254    $param->{'tracking_info'} = $tracking_info;
9255    return 1;
9256}
9257
9258## Output an initial form to search in web archives
9259sub do_arcsearch_form {
9260    wwslog('info', '(%s)', $param->{'list'});
9261
9262    ## Access control
9263    return undef
9264        unless defined check_authz('do_arcsearch_form', 'archive_web_access');
9265
9266    my $archive = Sympa::Archive->new(context => $list);
9267    $param->{'yyyymm'}       = [reverse $archive->get_archives];
9268    $param->{'key_word'}     = $in{'key_word'};
9269    $param->{'archive_name'} = $in{'archive_name'};
9270
9271    return 1;
9272}
9273
9274## Search in web archives
9275sub do_arcsearch {
9276    wwslog('info', '(%s)', $param->{'list'});
9277
9278    # Access control
9279    return undef
9280        unless defined check_authz('do_arcsearch', 'archive_web_access');
9281
9282    my $search = Sympa::WWW::Marc::Search->new;
9283    my $archive = Sympa::Archive->new(context => $list);
9284    $search->search_base($archive->{base_directory});
9285    $search->base_href(Sympa::get_url($list, 'arc'));
9286    $search->archive_name($in{'archive_name'});
9287
9288    unless (defined($in{'directories'})) {
9289        # by default search in current month and in the previous non-empty one
9290        my $archive_name = $in{'archive_name'} || '';
9291        $archive_name = POSIX::strftime('%Y-%m', localtime time)
9292            unless $archive_name =~ /^\d{4}-\d{2}$/;
9293        my @directories = ();
9294        foreach my $arc (reverse $archive->get_archives) {
9295            if ($archive_name) {
9296                push @directories, $arc if $arc le $archive_name;
9297                $archive_name = '' if $arc lt $archive_name;
9298            }
9299            push @{$param->{'yyyymm'}}, $arc;
9300        }
9301        $in{'directories'} = join "\0", @directories;
9302    }
9303
9304    if (defined($in{'directories'})) {
9305        $search->directories($in{'directories'});
9306        foreach my $dir (split /\0/, $in{'directories'}) {
9307            push @{$param->{'directories'}}, $dir;
9308        }
9309    }
9310
9311    if (defined $in{'previous'}) {
9312        $search->body_count($in{'body_count'});
9313        $search->date_count($in{'date_count'});
9314        $search->from_count($in{'from_count'});
9315        $search->subj_count($in{'subj_count'});
9316        $search->previous($in{'previous'});
9317    }
9318
9319    ## User didn't enter any search terms
9320    if ($in{'key_word'} =~ /^\s*$/) {
9321        Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
9322            {'argument' => 'key_word'},
9323            $param->{'action'});
9324        wwslog('info', 'No search term');
9325        return undef;
9326    }
9327
9328    $param->{'key_word'} = $in{'key_word'};
9329
9330    $search->limit($in{'limit'});
9331
9332    $search->age(1)
9333        if ($in{'age'} eq 'new');
9334
9335    $search->match(1)
9336        if (($in{'match'} eq 'partial') or ($in{'match'} eq '1'));
9337
9338    $search->clean_words($in{'key_word'});
9339    my @clean_words = split(/\s+/, $in{'key_word'});
9340    my @words = @clean_words;
9341    foreach my $w (@words) {
9342        $w =~ s/([^\x00-\x1F\s\w\x7F-\xFF])/\\$1/g;    # Escape non-words.
9343        $w = '\b' . $w . '\b'
9344            if $in{'match'} eq 'exact';
9345    }
9346    $search->words(\@words);
9347
9348    $search->key_word(join('|', @words));
9349
9350    if ($in{'case'} eq 'off') {
9351        $search->case(1);
9352        $search->key_word('(?i)' . $search->key_word);
9353    }
9354    if ($in{'how'} eq 'any') {
9355        $search->function2($search->match_any(@words));
9356        $search->how('any');
9357    } elsif ($in{'how'} eq 'all') {
9358        $search->function1($search->body_match_all(@clean_words, @words));
9359        $search->function2($search->match_all(@words));
9360        $search->how('all');
9361    } else {
9362        $search->function2($search->match_this(@words));
9363        $search->how('phrase');
9364    }
9365
9366    $search->subj(defined($in{'subj'}));
9367    $search->from(defined($in{'from'}));
9368    $search->date(defined($in{'date'}));
9369    $search->body(defined($in{'body'}));
9370
9371    $search->body(1)
9372        if (not($search->subj)
9373        and not($search->from)
9374        and not($search->body)
9375        and not($search->date));
9376
9377    my $searched = $search->search;
9378
9379    if (defined($search->error)) {
9380        wwslog('info', '%s', $search->error);
9381    }
9382
9383    $search->searched($searched);
9384
9385    if ($searched < $search->file_count) {
9386        $param->{'continue'} = 1;
9387    }
9388
9389    foreach my $field (
9390        'list',  'archive_name', 'age',  'body',
9391        'case',  'date',         'from', 'how',
9392        'limit', 'match',        'subj'
9393    ) {
9394        $param->{$field} = $in{$field};
9395    }
9396
9397    $param->{'body_count'}  = $search->body_count;
9398    $param->{'clean_words'} = $search->clean_words;
9399    $param->{'date_count'}  = $search->date_count;
9400    $param->{'from_count'}  = $search->from_count;
9401    $param->{'subj_count'}  = $search->subj_count;
9402
9403    $param->{'num'}      = $search->file_count + 1;
9404    $param->{'searched'} = $search->searched;
9405
9406    $param->{'res'} = $search->res;
9407
9408    return 1;
9409}
9410
9411## Search message-id in web archives
9412sub do_arcsearch_id {
9413    wwslog('info', '(%s, %s, %s)', $param->{'list'}, $in{'archive_name'},
9414        $in{'msgid'});
9415
9416    # Access control
9417    return undef
9418        unless defined check_authz('do_arcsearch_id', 'archive_web_access');
9419
9420    if (    ($session->{'archive_sniffer'} || '') ne 'false'
9421        and not $param->{'user'}{'email'}
9422        and $list->{'admin'}{'web_archive_spam_protection'} eq 'cookie') {
9423        my $archive_name = $in{'archive_name'} || '';
9424        my $msgid        = $in{'msgid'}        || '';
9425        $param->{'archive_name'} = $archive_name;
9426        $param->{'msgid'}        = $msgid;
9427
9428        # Action confirmed?
9429        my $next_action = $session->confirm_action(
9430            $in{'action'}, $in{'response_action'},
9431            arg             => join('/', $archive_name, $msgid),
9432            previous_action => 'info'
9433        );
9434        return $next_action unless $next_action eq '1';
9435
9436        # If confirmed, set flag.
9437        $session->{'archive_sniffer'} = 'false';
9438    }
9439
9440    my $search = Sympa::WWW::Marc::Search->new;
9441    my $archive = Sympa::Archive->new(context => $list);
9442    $search->search_base($archive->{base_directory});
9443    $search->base_href(Sympa::get_url($list, 'arc'));
9444
9445    $search->archive_name($in{'archive_name'});
9446
9447    # search in current month and in the previous none empty one
9448    my $search_base = $search->search_base;
9449    my $previous_active_dir;
9450    foreach my $arc (reverse $archive->get_archives) {
9451        if ($arc =~ /^(\d{4})-(\d{2})$/ and $arc lt $search->archive_name) {
9452            $previous_active_dir = $arc;
9453            last;
9454        }
9455    }
9456    $in{'archive_name'} = $search->archive_name . "\0" . $previous_active_dir;
9457
9458    $search->directories($in{'archive_name'});
9459    #    $search->directories ($search->archive_name);
9460
9461    ## User didn't enter any search terms
9462    if ($in{'msgid'} =~ /^\s*$/) {
9463        Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
9464            {'argument' => 'msgid'},
9465            $param->{'action'});
9466        wwslog('info', 'No search term');
9467        return undef;
9468    }
9469
9470    #$in{'msgid'} = Sympa::Tools::Text::unescape_chars($in{'msgid'});
9471    $param->{'msgid'} = $in{'msgid'};
9472
9473    $search->limit(1);
9474
9475    $search->clean_words($in{'msgid'});
9476    my @words = split(/\s+/, $in{'msgid'});
9477    foreach my $w (@words) {
9478        $w =~ s/([^\x00-\x1F\s\w\x7F-\xFF])/\\$1/g;    # Escape non-words.
9479    }
9480    $search->words(\@words);
9481
9482    $search->key_word(join('|', @words));
9483
9484    $search->function2($search->match_this(@words));
9485
9486    $search->id(1);
9487
9488    my $searched = $search->search;
9489
9490    if (defined($search->error)) {
9491        wwslog('info', '%s', $search->error);
9492    }
9493
9494    $search->searched($searched);
9495
9496    $param->{'res'} = $search->res;
9497
9498    unless ($#{$param->{'res'}} >= 0) {
9499        Sympa::WWW::Report::reject_report_web('intern_quiet',
9500            'archive_not_found', {'msgid' => $in{'msgid'}},
9501            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
9502        wwslog('err', 'No message found in archives matching message ID %s',
9503            $in{'msgid'});
9504        return 'arc';
9505    }
9506
9507    $param->{'redirect_to'} = $param->{'res'}[0]{'file'};
9508
9509    return 1;
9510}
9511
9512# get pendings lists
9513sub do_get_pending_lists {
9514
9515    wwslog('info', '');
9516
9517    ## Checking families and other virtual hosts.
9518    get_server_details();
9519
9520    my $all_lists =
9521        Sympa::List::get_lists($robot, 'filter' => ['status' => 'pending']);
9522    foreach my $list (@$all_lists) {
9523        $param->{'pending'}{$list->{'name'}}{'subject'} =
9524            $list->{'admin'}{'subject'};
9525        $param->{'pending'}{$list->{'name'}}{'by'} =
9526            $list->{'admin'}{'update'}{'email'};
9527        $param->{'pending'}{$list->{'name'}}{'date_epoch'} =
9528            $list->{'admin'}{'update'}{'date_epoch'};
9529    }
9530
9531    return 1;
9532}
9533
9534# get closed lists
9535sub do_get_closed_lists {
9536    wwslog('info', '');
9537
9538    ## Checking families and other virtual hosts.
9539    get_server_details();
9540
9541    my $all_lists =
9542        Sympa::List::get_lists($robot,
9543        'filter' => ['status' => 'closed|family_closed']);
9544    foreach my $list (@$all_lists) {
9545        $param->{'closed'}{$list->{'name'}}{'subject'} =
9546            $list->{'admin'}{'subject'};
9547        $param->{'closed'}{$list->{'name'}}{'by'} =
9548            $list->{'admin'}{'creation'}{'email'};
9549    }
9550
9551    return 1;
9552}
9553
9554# get ordered latest lists
9555sub do_get_latest_lists {
9556
9557    wwslog('info', '');
9558
9559    ## Checking families and other virtual hosts.
9560    get_server_details();
9561
9562    my @unordered_lists;
9563    my $all_lists = Sympa::List::get_lists($robot);
9564    foreach my $list (@$all_lists) {
9565
9566        push @unordered_lists,
9567            {
9568            'name'    => $list->{'name'},
9569            'subject' => $list->{'admin'}{'subject'},
9570            'creation_date_epoch' =>
9571                $list->{'admin'}{'creation'}{'date_epoch'}
9572            };
9573    }
9574
9575    foreach my $l (
9576        sort { $b->{'creation_date_epoch'} <=> $a->{'creation_date_epoch'} }
9577        @unordered_lists) {
9578        push @{$param->{'latest_lists'}}, $l;
9579    }
9580
9581    return 1;
9582}
9583
9584# get inactive lists
9585sub do_get_inactive_lists {
9586    wwslog('info', '');
9587
9588    ## Checking families and other virtual hosts.
9589    get_server_details();
9590
9591    my @unordered_lists;
9592    my $all_lists =
9593        Sympa::List::get_lists($robot,
9594        filter => ['! status' => 'closed|family_closed']);
9595    foreach my $list (@$all_lists) {
9596        my $last_message = 0;
9597
9598        if (open COUNT, $list->{'dir'} . '/msg_count') {
9599            while (<COUNT>) {
9600                $last_message = $1 if (/^(\d+)\s/ && ($1 > $last_message));
9601            }
9602            close COUNT;
9603
9604        } else {
9605            wwslog(
9606                'info',
9607                'Could not open file %s',
9608                $list->{'dir'} . '/msg_count'
9609            );
9610        }
9611
9612        push @unordered_lists,
9613            {
9614            'name'          => $list->{'name'},
9615            'creator'       => $list->{'admin'}{'creation'}{'email'},
9616            'send_scenario' => $list->{'admin'}{'send'}{'name'},
9617            'owners'        => join(", ",
9618                map      { $_->{'email'} }
9619                    grep { $_->{role} eq 'owner' }
9620                    @{$list->get_current_admins}),
9621            'editors' => join(", ",
9622                map      { $_->{'email'} }
9623                    grep { $_->{role} eq 'editor' }
9624                    @{$list->get_current_admins}),
9625            'subscribers_count'  => $list->get_total('nocache'),
9626            'subject'            => $list->{'admin'}{'subject'},
9627            'msg_count'          => $list->get_msg_count(),
9628            'last_message_epoch' => $last_message,
9629            'last_message_date'  => $language->gettext_strftime(
9630                "%d %b %Y", localtime($last_message * 86400)
9631            ),
9632            'creation_date_epoch' =>
9633                $list->{'admin'}{'creation'}{'date_epoch'},
9634            };
9635    }
9636
9637    foreach my $l (
9638        sort { $a->{'last_message_epoch'} <=> $b->{'last_message_epoch'} }
9639        @unordered_lists) {
9640        push @{$param->{'inactive_lists'}}, $l;
9641    }
9642
9643    return 1;
9644}
9645
9646# get ordered biggest lists
9647sub do_get_biggest_lists {
9648    wwslog('info', '');
9649
9650    ## Checking families and other virtual hosts.
9651    get_server_details();
9652
9653    my @unordered_lists;
9654    my $all_lists = Sympa::List::get_lists($robot);
9655    foreach my $list (@$all_lists) {
9656        push @unordered_lists,
9657            {
9658            'name'    => $list->{'name'},
9659            'subject' => $list->{'admin'}{'subject'},
9660            'creation_date_epoch' =>
9661                $list->{'admin'}{'creation'}{'date_epoch'},
9662            'subscribers' => $list->get_total
9663            };
9664    }
9665
9666    foreach my $l (sort { $b->{'subscribers'} <=> $a->{'subscribers'} }
9667        @unordered_lists) {
9668        push @{$param->{'biggest_lists'}}, $l;
9669    }
9670
9671## Not yet implemented.
9672##	my $all_lists = Sympa::List::get_lists($robot, 'order' => ['-total']);
9673##	$param->{'biggest_lists'} = [
9674##	    map { {
9675##		'name' => $_->{'name'},
9676##		'subject' => $_->{'admin'}{'subject'},
9677##		'creation_date' =>
9678##                  $language->gettext_strftime("%d %b %Y",
9679##                  localtime $_->creation->{'date_epoch'}),
9680##		'subscribers' => $_->total
9681##	    }; } @{$all_lists || []}
9682##	];
9683
9684    return 1;
9685}
9686
9687## show a list parameters
9688sub do_set_pending_list_request {
9689    wwslog('info', '(%s)', $in{'list'});
9690
9691    my $list_dir = $list->{'dir'};
9692
9693    $param->{'list_config'} = $list_dir . '/config';
9694    if (-f $list_dir . '/info') {
9695        $param->{'list_info_file_exists'} = 1;
9696    }
9697    $param->{'list_info'}       = $list_dir . '/info';
9698    $param->{'list_subject'}    = $list->{'admin'}{'subject'};
9699    $param->{'list_request_by'} = $list->{'admin'}{'update'}{'email'};
9700    $param->{'list_request_date_epoch'} =
9701        $list->{'admin'}{'update'}{'date_epoch'};
9702    $param->{'list_serial'} = $list->{'admin'}{'serial'};
9703    $param->{'list_status'} = $list->{'admin'}{'status'};
9704
9705    if (open my $fh, '<', $list_dir . '/config') {
9706        $param->{'list_config_content'} = do { local $RS; <$fh> };
9707        close $fh;
9708    }
9709    if (open my $fh, '<', $list_dir . '/info') {
9710        $param->{'list_info_content'} = do { local $RS; <$fh> };
9711        close $fh;
9712    }
9713
9714    return 1;
9715}
9716
9717# Show a list parameters.
9718# Kept for comaptibility <= 6.2.22.
9719sub do_install_pending_list {
9720    my $status = $in{'status'};
9721
9722    $in{'mode'} = 'install';
9723    return
9724          ($status eq 'closed') ? 'close_list'
9725        : ($status eq 'open')   ? 'open_list'
9726        :                         undef;
9727}
9728
9729#=head2 sub do_create_list
9730#
9731#Creates a list using a list template
9732#
9733#=head3 Arguments
9734#
9735#=over
9736#
9737#=item * I<None>
9738#
9739#=back
9740#
9741#=head3 Return
9742#
9743#=over
9744#
9745#=item * I<1>, if no problem is encountered
9746#
9747#=item * I<undef>, if anything goes wrong
9748#
9749#=item * I<'loginrequest'> if no user is logged in at the time the function is called.
9750#
9751#=back
9752#
9753#=cut
9754
9755# create a list using a list template.
9756sub do_create_list {
9757    wwslog(
9758        'info', '(%s, %s, %s)', $in{'listname'}, $in{'subject'},
9759        $in{'template'}
9760    );
9761
9762    my $spindle = Sympa::Spindle::ProcessRequest->new(
9763        context    => $robot,
9764        action     => 'create_list',
9765        parameters => {
9766            listname => $in{'listname'},
9767            owner    => [
9768                {   email => $param->{'user'}{'email'},
9769                    gecos => $param->{'user'}{'gecos'},
9770                }
9771            ],
9772            subject        => $in{'subject'},
9773            creation_email => $param->{'user'}{'email'},
9774            lang           => $param->{'lang'},
9775            status         => $param->{'status'},          #FIXME
9776            type           => $in{'template'},
9777            topics         => $in{'topics'},
9778            description    => $in{'info'},
9779            custom_input   => $in{'custom_input'},
9780        },
9781        sender => $param->{'user'}{'email'},
9782        (   $param->{'user'}{'email'}
9783            ? (md5_check => 1)
9784            : ()
9785        ),
9786
9787        scenario_context => {
9788            sender             => $param->{'user'}{'email'},
9789            candidate_listname => $in{'listname'},
9790            candidate_subject  => $in{'subject'},
9791            candidate_template => $in{'template'},
9792            candidate_info     => $in{'info'},
9793            candidate_topics   => $in{'topics'},
9794            remote_host        => $param->{'remote_host'},
9795            remote_addr        => $param->{'remote_addr'},
9796        }
9797    );
9798
9799    unless ($spindle and $spindle->spin) {
9800        return 'create_list_request';
9801    }
9802
9803    foreach my $report (@{$spindle->{stash} || []}) {
9804        if ($report->[1] eq 'notice') {
9805            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
9806                $param->{'action'});
9807        } else {
9808            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
9809                $param->{action});
9810        }
9811    }
9812    unless (@{$spindle->{stash} || []}) {
9813        Sympa::WWW::Report::notice_report_web('performed', {},
9814            $param->{'action'});
9815    }
9816
9817    unless ($spindle->success) {
9818        return 'create_list_request';
9819    }
9820
9821    # Were aliases installed?
9822    if (grep { $_->[1] eq 'notice' and $_->[2] eq 'auto_aliases' }
9823        @{$spindle->{stash} || []}) {
9824        $param->{'auto_aliases'} = 1;
9825    } else {
9826        $param->{'auto_aliases'} = 0;
9827    }
9828
9829    # Switch to new list context.
9830    $list = Sympa::List->new($in{'listname'}, $robot);
9831    $param->{'list'} = $in{'listname'};
9832    $param->{'redirect_to'} =
9833        Sympa::get_url($list, 'admin', nomenu => $param->{'nomenu'});
9834
9835    return 1;
9836}
9837
9838#=head2 sub do_create_list_request
9839#
9840#Sends back the list creation edition form.
9841#
9842#=head3 Arguments
9843#
9844#=over
9845#
9846#=item * I<None>
9847#
9848#=back
9849#
9850#=head3 Return
9851#
9852#=over
9853#
9854#=item * I<1>, if no problem is encountered
9855#
9856#=item * I<undef>, if anything goes wrong
9857#
9858#=item * I<'loginrequest'> if no user is logged in at the time the function is called.
9859#
9860#=back
9861#
9862#=cut
9863
9864## Return the creation form
9865sub do_create_list_request {
9866    wwslog('info', '');
9867
9868    my $result = Sympa::Scenario->new($robot, 'create_list')->authz(
9869        $param->{'auth_method'},
9870        {   'sender'      => $param->{'user'}{'email'},
9871            'remote_host' => $param->{'remote_host'},
9872            'remote_addr' => $param->{'remote_addr'}
9873        }
9874    );
9875
9876    my $r_action;
9877    my $reason;
9878    if (ref($result) eq 'HASH') {
9879        $r_action = $result->{'action'};
9880        $reason   = $result->{'reason'};
9881    }
9882
9883    $param->{'create_action'} = $r_action;
9884    ## Initialize the form
9885    ## When returning to the form
9886    foreach my $p ('listname', 'template', 'subject', 'topics', 'info') {
9887        $param->{'saved'}{$p} = $in{$p};
9888    }
9889
9890    if ($param->{'create_action'} =~ /reject/) {
9891        Sympa::WWW::Report::reject_report_web('auth', $reason, {},
9892            $param->{'action'}, $list);
9893        wwslog('info', 'Not allowed');
9894        return undef;
9895    }
9896
9897    # load lists the user is administoring
9898    #XXX# Slow on the host with large number of lists.
9899    #XXXif ($param->{'is_listmaster'}) {
9900    #XXX    $param->{'all_lists'} = Sympa::List::get_lists($robot) || [];
9901    #XXX} else {
9902    $param->{'all_lists'} =
9903        Sympa::List::get_lists($robot,
9904        filter => ['owner' => $param->{'user'}{'email'}])
9905        || [];
9906    #XXX}
9907
9908    my %topics = map { ($_ => {}) } Sympa::Robot::topic_keys($robot);
9909    if ($in{'topics'} and exists $topics{$in{'topics'}}) {
9910        $topics{$in{'topics'}}->{selected} = 1;
9911    }
9912    $param->{'list_of_topics'} = {%topics};
9913
9914    unless ($param->{'list_list_tpl'} =
9915        Sympa::WWW::Tools::get_list_list_tpl($robot)) {
9916        Sympa::WWW::Report::reject_report_web('intern',
9917            'unable_to_load_create_list_templates',
9918            {}, $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
9919    }
9920
9921    $param->{'tpl_count'} = scalar keys %{$param->{'list_list_tpl'} || {}};
9922
9923    $param->{'list_list_tpl'}{$in{'template'}}{'selected'} = 1
9924        if $in{'template'};
9925
9926    return 1;
9927
9928}
9929
9930## WWSympa Home-Page
9931sub do_home {
9932    wwslog('info', '');
9933
9934    return 1;
9935
9936}
9937
9938sub do_editsubscriber {
9939    wwslog('info', '(%s)', $in{'email'});
9940
9941    my $subscriber;
9942
9943    unless ($subscriber = $list->get_list_member($in{'email'})) {
9944        Sympa::WWW::Report::reject_report_web(
9945            'user',
9946            'user_not_subscriber',
9947            {email => $in{'email'}, listname => $list->{'name'}},
9948            $param->{'action'},
9949            $list,
9950            $param->{'user'}{'email'},
9951            $robot
9952        );
9953        wwslog('info', 'Subscriber %s not found', $in{'email'});
9954        return $in{'previous_action'} || 'review';
9955    }
9956
9957    $param->{'current_subscriber'} = $subscriber;
9958    $param->{'current_subscriber'}{'date'} =
9959        $language->gettext_strftime("%d %b %Y",
9960        localtime($subscriber->{'date'}));
9961    $param->{'current_subscriber'}{'update_date'} =
9962        $language->gettext_strftime("%d %b %Y",
9963        localtime($subscriber->{'update_date'}));
9964    $param->{'current_subscriber'}{'pictures_url'} =
9965        $list->find_picture_url($subscriber->{'email'});
9966
9967    ## Prefs
9968    $param->{'current_subscriber'}{'reception'}  ||= 'mail';
9969    $param->{'current_subscriber'}{'visibility'} ||= 'noconceal';
9970
9971    ## Get language from user_table
9972    my $user = Sympa::User::get_global_user($in{'email'});
9973    $language->push_lang;
9974    $param->{'current_subscriber'}{'lang'} =
9975        $language->set_lang($user->{'lang'}, Sympa::best_language($list));
9976    $language->pop_lang;
9977
9978    foreach my $m ($list->available_reception_mode) {
9979        if ($param->{'current_subscriber'}{'reception'} eq $m) {
9980            $param->{'reception'}{$m}{'selected'} = ' selected';
9981        } else {
9982            $param->{'reception'}{$m}{'selected'} = '';
9983        }
9984    }
9985
9986    foreach my $m (qw(conceal noconceal)) {
9987        if ($param->{'current_subscriber'}{'visibility'} eq $m) {
9988            $param->{'visibility'}{$m}{'selected'} = ' selected';
9989        } else {
9990            $param->{'visibility'}{$m}{'selected'} = '';
9991        }
9992    }
9993
9994    ## Bounces
9995    if ($subscriber->{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/) {
9996        my @bounce = ($1, $2, $3, $5);
9997        $param->{'current_subscriber'}{'first_bounce'} =
9998            $language->gettext_strftime("%d %b %Y", localtime($bounce[0]));
9999        $param->{'current_subscriber'}{'last_bounce'} =
10000            $language->gettext_strftime("%d %b %Y", localtime($bounce[1]));
10001        $param->{'current_subscriber'}{'bounce_count'} = $bounce[2];
10002        if ($bounce[3] and $bounce[3] =~ /^(\d+\.(\d+\.\d+))$/) {
10003            $subscriber->{'bounce_code'} = $1;
10004            $subscriber->{'bounce_status'} =
10005                $Sympa::WWW::Tools::bounce_status{$2};
10006        } else {
10007            $subscriber->{'bounce_status'} = $bounce[3];
10008        }
10009
10010        $param->{'previous_action'} = $in{'previous_action'};
10011    }
10012
10013    ## Additional DB fields
10014    if ($Conf::Conf{'db_additional_subscriber_fields'}) {
10015        my @additional_fields = split ',',
10016            $Conf::Conf{'db_additional_subscriber_fields'};
10017
10018        my %data;
10019
10020        my $sdm = Sympa::DatabaseManager->instance;
10021        foreach my $field (@additional_fields) {
10022            # Is the Database defined
10023            unless ($sdm) {
10024                wwslog('err', 'Unavailable database connection');
10025                return undef;
10026            }
10027
10028            # Check field type (enum or not).
10029            #FIXME FIXME: ENUM data type is not supported by at least SQLite;
10030            # types might be better to be defined by configuration.
10031            my $field_type;
10032            if ($sdm->can('get_fields')) {
10033                my $fields = $sdm->get_fields({table => 'subscriber_table'});
10034                $field_type = ($fields || {})->{$field};
10035            }
10036            if ($field_type and $field_type =~ /^enum[(](.+)[)]$/) {
10037                my @enum = split /\s*,\s*/, $1;
10038                foreach my $e (@enum) {
10039                    $e =~ s/^\'([^\']+)\'$/$1/;
10040                    $data{$field}{'enum'}{$e} = '';
10041                }
10042                $data{$field}{'type'} = 'enum';
10043
10044                $data{$field}{'enum'}{$subscriber->{$field}} =
10045                    'selected="selected"'
10046                    if (defined $subscriber->{$field});
10047            } else {
10048                $data{$field}{'type'}  = 'string';
10049                $data{$field}{'value'} = $subscriber->{$field};
10050            }
10051        }
10052        $param->{'additional_fields'} = \%data;
10053    }
10054
10055    $param->{'previous_action'} = $in{'previous_action'};
10056
10057    return 1;
10058}
10059
10060sub do_viewbounce {
10061    wwslog('info', '(dir/file=%s/%s, email=%s, envid=%s)',
10062        $in{'dir'}, $in{'file'}, $in{'email'}, $in{'envid'});
10063
10064    # Prevent directory traversal.
10065    if ($in{'file'}) {
10066        my $subpath = $in{'file'};
10067        $subpath =~ s{\Amsg00000/}{};
10068        delete $in{'file'} if $subpath =~ m{/};
10069    }
10070    if ($in{'dir'}) {
10071        delete $in{'dir'} if 0 <= index($in{'dir'}, '/');
10072    }
10073
10074    my $html_relpath;
10075    if ($in{'email'}) {
10076        my $escaped_email = Sympa::Tools::Text::escape_chars($in{'email'});
10077        $html_relpath =
10078            $in{'envid'}
10079            ? sprintf('%s_%08s', $escaped_email, $in{'envid'})
10080            : $escaped_email;
10081    } elsif ($in{'dir'} and $in{'file'}) {
10082        $html_relpath = $in{'dir'};
10083    } else {
10084        return undef;
10085    }
10086
10087    my $bounce_path = $list->get_bounce_dir() . '/' . $html_relpath;
10088    unless (-r $bounce_path) {
10089        Sympa::WWW::Report::reject_report_web('user', 'no_bounce_user',
10090            {'email' => $in{'email'}},
10091            $param->{'action'}, $list);
10092        wwslog('info', 'No bounce %s', $param->{'lastbounce_path'});
10093        return undef;
10094    }
10095
10096    my $html_dir =
10097          $Conf::Conf{'viewmail_dir'}
10098        . '/bounce/'
10099        . $list->get_id . '/'
10100        . $html_relpath;
10101    unless (-d $html_dir) {
10102        my $bounce_message =
10103            Sympa::Message->new_from_file($bounce_path, context => $list);
10104        Sympa::Archive::html_format(
10105            $bounce_message,
10106            'destination_dir' => $html_dir,
10107            'attachment_url' => ['viewbounce', $list->{'name'}, $html_relpath]
10108        ) if $bounce_message;
10109    }
10110
10111    unless (-d $html_dir) {
10112        Sympa::WWW::Report::reject_report_web('intern',
10113            'no_html_message_available', {'dir' => $html_dir},
10114            $param->{'action'});
10115        wwslog('err', 'No HTML version of the message available in %s',
10116            $html_dir);
10117        return undef;
10118    }
10119
10120    if (    $in{'file'}
10121        and $in{'file'} ne 'msg00000.html'
10122        and -f $html_dir . '/' . $in{'file'}
10123        and -r $html_dir . '/' . $in{'file'}) {
10124        $in{'file'} =~ /\.(\w+)$/;
10125        $param->{'file_extension'} = $1;
10126        $param->{'file'}           = $html_dir . '/' . $in{'file'};
10127        $param->{'bypass'}         = 1;
10128    } else {
10129        if (open my $fh, '<', $html_dir . '/msg00000.html') {
10130            $param->{'html_content'} = do { local $RS; <$fh> };
10131            close $fh;
10132        }
10133
10134        #FIXME: Is this required?
10135        push @other_include_path, $html_dir;
10136    }
10137
10138    if ($in{'email'} and $in{'envid'}) {
10139        my $tracking = Sympa::Tracking->new(context => $list);
10140        my $info = $tracking->db_fetch(
10141            recipient => $in{'email'},
10142            envid     => $in{'envid'}
10143        );
10144        if ($info) {
10145            $info->{arrival_date} =
10146                $language->gettext_strftime('%d %b %Y at %H:%M:%S',
10147                localtime $info->{arrival_epoch})
10148                if defined $info->{arrival_epoch};
10149            $param->{'tracking_info'} = $info;
10150        }
10151    } elsif ($in{'email'}) {
10152        $param->{'tracking_info'} = {recipient => $in{'email'},};
10153    }
10154    $param->{'previous_action'} = $in{'previous_action'} || 'editsubscriber';
10155
10156    return 1;
10157}
10158
10159## some help for listmaster and developpers
10160#FIXME Works only under doamin context.
10161sub do_scenario_test {
10162    wwslog('info', '');
10163
10164    # List available scenarios.
10165    # FIXME Use get_scenarios().
10166    my $dh;
10167    unless (opendir $dh, Sympa::Constants::DEFAULTDIR . '/scenari/') {
10168        Sympa::WWW::Report::reject_report_web(
10169            'intern',
10170            'cannot_open_dir',
10171            {'dir' => Sympa::Constants::DEFAULTDIR . '/scenari/'},
10172            $param->{'action'},
10173            $list,
10174            $param->{'user'}{'email'},
10175            $robot
10176        );
10177        wwslog('info', 'Unable to open %s/scenari',
10178            Sympa::Constants::DEFAULTDIR);
10179        return undef;
10180    }
10181    foreach my $scfile (readdir $dh) {
10182        if ($scfile =~ /^([-\w]+)[.](\w+)/) {
10183            $param->{'scenario'}{$1}{'defined'} = 1;
10184        }
10185    }
10186    closedir $dh;
10187
10188    my $all_lists = Sympa::List::get_lists('*');
10189    foreach my $list (@$all_lists) {
10190        $param->{'listname'}{$list->{'name'}}{'defined'} = 1;
10191    }
10192    foreach my $a ('smtp', 'md5', 'smime') {
10193        #$param->{'auth_method'}{$a}{'define'}=1 ;
10194        $param->{'authmethod'}{$a}{'defined'} = 1;
10195    }
10196
10197    $param->{'scenario'}{$in{'scenario'}}{'selected'} = 'selected="selected"'
10198        if $in{'scenario'};
10199
10200    $param->{'listname'}{$in{'listname'}}{'selected'} = 'selected="selected"'
10201        if $in{'listname'};
10202
10203    $param->{'authmethod'}{$in{'auth_method'}}{'selected'} =
10204        'selected="selected"'
10205        if $in{'auth_method'};
10206
10207    $param->{'email'} = $in{'email'};
10208
10209    if ($in{'scenario'}) {
10210        my $function = $in{'scenario'};
10211        wwslog('debug3', 'Perform scenario_test');
10212
10213        my $result = Sympa::Scenario->new($robot, $function)->authz(
10214            $in{'auth_method'},
10215            {   'listname'    => $in{'listname'},    # FIXME: Unavailable list
10216                'sender'      => $in{'sender'},
10217                'email'       => $in{'email'},
10218                'remote_host' => $in{'remote_host'},
10219                'remote_addr' => $in{'remote_addr'}
10220            },
10221            debug => 1
10222        );
10223        if (ref($result) eq 'HASH') {
10224            $param->{'scenario_action'}      = $result->{'action'};
10225            $param->{'scenario_condition'}   = $result->{'condition'};
10226            $param->{'scenario_auth_method'} = $result->{'auth_method'};
10227            $param->{'scenario_reason'}      = $result->{'reason'};
10228        }
10229    }
10230    return 1;
10231}
10232
10233## Bouncing addresses review
10234sub do_reviewbouncing {
10235    wwslog('info', '(%s)', $in{'page'});
10236    my $size = $in{'size'} || $Conf::Conf{'review_page_size'};
10237
10238    ## Owner
10239    $param->{'page'} = $in{'page'} || 1;
10240    if ($size eq 'all') {
10241        $param->{'total_page'} = $param->{'bounce_total'};
10242    } else {
10243        $param->{'total_page'} = int($param->{'bounce_total'} / $size);
10244        $param->{'total_page'}++
10245            if ($param->{'bounce_total'} % $size);
10246    }
10247
10248    if ($param->{'total_page'} > 0
10249        and ($param->{'page'} > $param->{'total_page'})) {
10250        Sympa::WWW::Report::reject_report_web('user', 'no_page',
10251            {'page' => $param->{'page'}},
10252            $param->{'action'});
10253        wwslog('info', 'No page %d', $param->{'page'});
10254        return 'admin';
10255    }
10256
10257    my @users;
10258    ## Members list
10259    for (
10260        my $i = $list->get_first_bouncing_list_member();
10261        $i;
10262        $i = $list->get_next_bouncing_list_member()
10263    ) {
10264        $list->parse_list_member_bounce($i);
10265        push @users, $i;
10266    }
10267
10268    my $record;
10269    foreach my $i (
10270        sort {
10271                   ($b->{'bounce_score'} <=> $a->{'bounce_score'})
10272                || ($b->{'last_bounce'} <=> $a->{'last_bounce'})
10273                || ($b->{'bounce_class'} <=> $a->{'bounce_class'})
10274        } @users
10275    ) {
10276        $record++;
10277
10278        if (($size ne 'all') && ($record > ($size * ($param->{'page'})))) {
10279            $param->{'next_page'} = $param->{'page'} + 1;
10280            last;
10281        }
10282
10283        next
10284            if (($size ne 'all')
10285            && ($record <= (($param->{'page'} - 1) * $size)));
10286
10287        $i->{'first_bounce'} =
10288            $language->gettext_strftime("%d %b %Y",
10289            localtime($i->{'first_bounce'}));
10290        $i->{'last_bounce'} =
10291            $language->gettext_strftime("%d %b %Y",
10292            localtime($i->{'last_bounce'}));
10293
10294        push @{$param->{'members'}}, $i;
10295    }
10296
10297    if ($param->{'page'} > 1) {
10298        $param->{'prev_page'} = $param->{'page'} - 1;
10299    }
10300
10301    $param->{'size'} = $size;
10302
10303    return 1;
10304}
10305
10306sub do_resetbounce {
10307    wwslog('info', '');
10308
10309    my @emails = split /\0/, $in{'email'};
10310
10311    foreach my $email (@emails) {
10312
10313        my $escaped_email = Sympa::Tools::Text::escape_chars($email);
10314
10315        unless ($list->is_list_member($email)) {
10316            Sympa::WWW::Report::reject_report_web('user',
10317                'user_not_subscriber',
10318                {email => $email, listname => $list->{'name'}},
10319                $param->{'action'}, $list);
10320            wwslog('info', '%s not subscribed', $email);
10321            web_db_log(
10322                {   'status'     => 'error',
10323                    'error_type' => 'not_subscriber'
10324                }
10325            );
10326            return undef;
10327        }
10328
10329        unless (
10330            $list->update_list_member(
10331                $email,
10332                bounce       => undef,
10333                update_date  => time,
10334                bounce_score => 0
10335            )
10336        ) {
10337            Sympa::WWW::Report::reject_report_web(
10338                'intern', 'update_subscriber_db_failed',
10339                {'sub' => $email}, $param->{'action'},
10340                $list, $param->{'user'}{'email'},
10341                $robot
10342            );
10343            wwslog('info', 'Failed update database for %s', $email);
10344            web_db_log(
10345                {   'status'     => 'error',
10346                    'error_type' => 'internal'
10347                }
10348            );
10349            return undef;
10350        }
10351
10352        my $bounce_dir = $list->get_bounce_dir();
10353
10354        unless (unlink $bounce_dir . '/' . $escaped_email) {
10355            wwslog(
10356                'info',
10357                'Failed deleting %s',
10358                $bounce_dir . '/' . $escaped_email
10359            );
10360            web_db_log(
10361                {   'status'     => 'error',
10362                    'error_type' => 'internal'
10363                }
10364            );
10365        }
10366
10367        wwslog('info', 'Bounces for %s reset', $email);
10368        web_db_log({'status' => 'success'});
10369
10370    }
10371
10372    return $in{'previous_action'} || 'review';
10373}
10374
10375## Rebuild an archive using arctxt/
10376sub do_rebuildarc {
10377    wwslog('info', '(%s, %s)', $param->{'list'}, $in{'month'});
10378
10379    unless (_rebuildarc($list)) {
10380        return undef;
10381    }
10382
10383    Sympa::WWW::Report::notice_report_web('performed_soon', {},
10384        $param->{'action'});
10385    web_db_log(
10386        {   'parameters' => $in{'month'},
10387            'status'     => 'success'
10388        }
10389    );
10390    return 'admin';
10391}
10392
10393sub _rebuildarc {
10394    my $that = shift;
10395
10396    my $listname;
10397    if (ref $list eq 'Sympa::List') {
10398        $listname = $list->{'name'};
10399    } else {
10400        $listname = '*';
10401    }
10402
10403    my $arc_message = Sympa::Message->new(
10404        sprintf("\nrebuildarc %s *\n\n", $listname),
10405        context => $robot,
10406        sender  => $param->{'user'}{'email'},
10407        date    => time
10408    );
10409    my $marshalled = Sympa::Spool::Archive->new->store($arc_message);
10410    unless ($marshalled) {
10411        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
10412            {'command' => 'rebuild'},
10413            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
10414        wwslog('info', 'Cannot store command to rebuild archive of list %s',
10415            $list);
10416        web_db_log(
10417            {   'parameters' => $in{'month'},
10418                'status'     => 'error',
10419                'error_type' => 'internal'
10420            }
10421        );
10422        return undef;
10423    }
10424
10425    return 1;
10426}
10427
10428# Rebuild all archives using arctxt/
10429sub do_rebuildallarc {
10430    wwslog('info', '');
10431
10432    unless (_rebuildarc($robot)) {
10433        return undef;
10434    }
10435    Sympa::WWW::Report::notice_report_web('performed_soon', {},
10436        $param->{'action'});
10437    web_db_log({'status' => 'success'});
10438    return 'serveradmin';
10439}
10440
10441## Search among lists
10442sub do_edit_attributes {
10443    wwslog('info', '(%s)', $in{'filter'});
10444
10445    return 1;
10446}
10447
10448## list search form
10449sub do_search_list_request {
10450    wwslog('info', '');
10451
10452    return 1;
10453}
10454
10455## Search among lists
10456sub do_search_list {
10457    wwslog('info', '(%s)', $in{'filter_list'});
10458
10459    ## trim leading/trailing whitespace
10460    if (defined $in{'filter_list'}) {
10461        $in{'filter_list'} =~ s/^\s+|\s+$//g;
10462    }
10463
10464    unless (defined $in{'filter_list'} and length $in{'filter_list'}) {
10465        wwslog('info', 'No filter');
10466        return 'search_list_request';
10467    }
10468
10469    ## Search key
10470    $param->{'filter_list'} = $in{'filter_list'};
10471
10472    ## Members list
10473    my $record = 0;
10474    my $all_lists =
10475        Sympa::List::get_lists($robot,
10476        'filter' => ['%name%|%subject%' => $param->{'filter_list'}]);
10477    foreach my $list (@$all_lists) {
10478        my $is_admin = 0;
10479        my $result = Sympa::Scenario->new($list, 'visibility')->authz(
10480            $param->{'auth_method'},
10481            {   'sender'      => $param->{'user'}{'email'},
10482                'remote_host' => $param->{'remote_host'},
10483                'remote_addr' => $param->{'remote_addr'}
10484            }
10485        );
10486        my $r_action;
10487        $r_action = $result->{'action'} if (ref($result) eq 'HASH');
10488        next unless ($r_action eq 'do_it');
10489
10490        if ($param->{'user'}{'email'}
10491            and (  $list->is_admin('owner', $param->{'user'}{'email'})
10492                or $list->is_admin('editor', $param->{'user'}{'email'}))
10493        ) {
10494            $is_admin = 1;
10495        }
10496
10497        $record++;
10498        $param->{'which'}{$list->{'name'}} = {
10499            'subject' => $list->{'admin'}{'subject'},
10500            'admin'   => $is_admin,
10501            'export'  => 'no',
10502            # Compat. < 6.2.32
10503            'host' => $list->{'domain'},
10504        };
10505    }
10506    $param->{'occurrence'} = $record;
10507    foreach my $listname (sort keys %{$param->{'which'}}) {
10508        if ($listname =~ /^([a-z])/) {
10509            push @{$param->{'orderedlist'}{$1}}, $listname;
10510        } else {
10511            push @{$param->{'orderedlist'}{'others'}}, $listname;
10512        }
10513    }
10514
10515    return 1;
10516}
10517
10518sub do_edit_list {
10519    wwslog('info', '');
10520
10521    ## Check that the serial number sent by the form is the same as the one we
10522    ## expect.
10523    ## Avoid modifying a list previously modified by another way.
10524    unless ($list->{'admin'}{'serial'} == $in{'serial'}) {
10525        Sympa::WWW::Report::reject_report_web('user', 'config_changed',
10526            {'email' => $list->{'admin'}{'update'}{'email'}},
10527            $param->{'action'}, $list);
10528        wwslog(
10529            'info',
10530            'Config file has been modified(%d => %d) by %s. Cannot apply changes',
10531            $in{'single_param.serial'},
10532            $list->{'admin'}{'serial'},
10533            $list->{'admin'}{'update'}{'email'}
10534        );
10535        web_db_log(
10536            {   'status'     => 'error',
10537                'error_type' => 'internal'
10538            }
10539        );
10540        return undef;
10541    }
10542
10543    # Start parsing the data sent by the edition form.
10544    my $new_admin = _deserialize_changes();
10545
10546    my $config = Sympa::List::Config->new($list, config => $list->{'admin'});
10547    my $errors = [];
10548    my $validity =
10549        $config->submit($new_admin, $param->{'user'}{'email'}, $errors);
10550    unless (defined $validity) {
10551        if (my @intern = grep { $_->[0] eq 'intern' } @$errors) {
10552            foreach my $err (@intern) {
10553                Sympa::WWW::Report::reject_report_web($err->[0], $err->[1],
10554                    {}, $param->{'action'}, $list);
10555                wwslog('err', 'Internal error %s', $err->[1]);
10556            }
10557        } else {
10558            Sympa::WWW::Report::reject_report_web('intern', 'unknown', {},
10559                $param->{'action'}, $list);
10560            wwslog('err', 'Unknown error');
10561        }
10562        web_db_log(
10563            {   'status'     => 'error',
10564                'error_type' => 'internal'
10565            }
10566        );
10567        return undef;
10568    }
10569
10570    my $error_return = 0;
10571    foreach my $err (grep { $_->[0] eq 'user' } @$errors) {
10572        $error_return = 1 unless $err->[1] eq 'mandatory_parameter';
10573
10574        Sympa::WWW::Report::reject_report_web(
10575            $err->[0],
10576            $err->[1],
10577            {   'p_name' =>
10578                    $language->gettext($err->[2]->{p_info}->{gettext_id}),
10579                %{$err->[2]}
10580            },
10581            $param->{'action'},
10582            $list
10583        );
10584        wwslog(
10585            'err',
10586            'Error on parameter %s: %s',
10587            join('.', @{$err->[2]->{p_paths}}),
10588            $err->[1]
10589        );
10590        web_db_log(
10591            {   'status'     => 'error',
10592                'error_type' => 'syntax_errors'
10593            }
10594        );
10595    }
10596    return 'edit_list_request' if $error_return;
10597
10598    if ($validity eq '') {
10599        Sympa::WWW::Report::notice_report_web('no_parameter_edited', {},
10600            $param->{'action'});
10601        wwslog('info', 'No parameter was edited by user');
10602        return 'edit_list_request';
10603    }
10604
10605    # Validation of the form finished. Start of valid data treatments.
10606
10607    # For changed msg_topic.name.
10608    if (_notify_deleted_topic($config)) {
10609        Sympa::WWW::Report::notice_report_web(
10610            'subscribers_noticed_deleted_topics',
10611            {}, $param->{'action'});
10612    }
10613
10614    my $data_source_updated_member = 1
10615        if grep { $config->get_change($_) }
10616        grep { $_ =~ /\Ainclude_/ or $_ eq 'member_include' } $config->keys;
10617    my $data_source_updated_owner = 1
10618        if $config->get_change('owner_include');
10619    my $data_source_updated_editor = 1
10620        if $config->get_change('editor_include');
10621
10622    # Update config in memory.
10623    $config->commit;
10624
10625    ## Save config file
10626    unless ($list->save_config($param->{'user'}{'email'})) {
10627        Sympa::WWW::Report::reject_report_web('intern', 'cannot_save_config',
10628            {}, $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
10629        wwslog('info', 'Cannot save config file');
10630        web_db_log(
10631            {   'status'     => 'error',
10632                'error_type' => 'internal'
10633            }
10634        );
10635        return undef;
10636    }
10637
10638    ## Reload config to clean some empty entries in $list->{'admin'}
10639    $list = Sympa::List->new($list->{'name'}, $robot, {reload_config => 1});
10640
10641    unless (defined $list) {
10642        Sympa::WWW::Report::reject_report_web('intern', 'list_reload', {},
10643            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
10644        wwslog('info', 'Error in list reloading');
10645        web_db_log(
10646            {   'status'     => 'error',
10647                'error_type' => 'internal'
10648            }
10649        );
10650        return undef;
10651    }
10652
10653    if ($data_source_updated_member) {
10654        Sympa::WWW::Report::notice_report_web('member_updated_soon', {},
10655            $param->{'action'});
10656    }
10657    if ($data_source_updated_owner) {
10658        Sympa::WWW::Report::notice_report_web('owner_updated_soon', {},
10659            $param->{'action'});
10660    }
10661    if ($data_source_updated_editor) {
10662        Sympa::WWW::Report::notice_report_web('editor_updated_soon', {},
10663            $param->{'action'});
10664    }
10665
10666    Sympa::WWW::Report::notice_report_web('list_config_updated', {},
10667        $param->{'action'});
10668    web_db_log({'status' => 'success'});
10669    return 'edit_list_request';
10670}
10671
10672# Parses all the data sent from the web interface to the FCGI.
10673# Context:
10674#   $list: Sympa::List instance.
10675#   %in: Input from form.
10676# Parameters:
10677#   None.
10678# Returns:
10679#   Hashref containing parsed input.
10680sub _deserialize_changes {
10681    my $new_admin = {};
10682
10683    foreach my $key (sort keys %in) {
10684        next unless $key =~ /\A(single_param|multiple_param)[.](\S+)\z/;
10685        my ($type, $name) = ($1, $2);
10686
10687        # If the parameter is a multiple values parameter, store the values
10688        # into an array.
10689        my $value;
10690        if ($type eq 'multiple_param') {
10691            $value = [grep {/\S/} split /\0/, $in{$key}];
10692        } else {
10693            $value = ($in{$key} =~ /\S/) ? $in{$key} : undef;
10694        }
10695
10696        # $in{'owner.0.gecos'} is stored into $new_admin->{owner}[0]{gecos}.
10697        # Inconsistent subscripts will be ignored.
10698        my @subscripts = map {
10699            if (/\A\d+\z/) {
10700                sprintf '[%s]', $_;
10701            } elsif (/\A[-\w]+\z/) {
10702                sprintf "{'%s'}", $_;
10703            } else {
10704                "{''}";
10705            }
10706        } split /[.]/, $name;
10707        eval sprintf '$new_admin->%s = $value', join('->', @subscripts);
10708    }
10709
10710    # Deleted parameters or paragraphs.
10711    foreach my $key (sort keys %in) {
10712        next unless $key =~ /\Adeleted_param[.](\S+)\z/;
10713        my $name = $1;
10714        next unless defined $in{$key} and $in{$key} =~ /\S/;
10715
10716        my @subscripts = map {
10717            if (/\A\d+\z/) {
10718                sprintf '[%s]', $_;
10719            } elsif (/\A[-\w]+\z/) {
10720                sprintf "{'%s'}", $_;
10721            } else {
10722                "{''}";
10723            }
10724        } split /[.]/, $name;
10725        my $var = sprintf '$new_admin->%s', join('->', @subscripts);
10726
10727        if (eval "exists $var and ref $var eq 'HASH'") {
10728            my %hash = map { ($_ => undef) } keys %{eval $var};
10729            eval "$var = {%hash}";
10730        } else {
10731            eval "$var = undef";
10732        }
10733    }
10734
10735    return $new_admin;
10736}
10737
10738# No longer used.
10739#sub _shift_var;
10740
10741# Deletes topics subscriber that does not exist anymore and send a notify to
10742# concerned subscribers.
10743# Returns 0 if no subscriber topics have been deleted; 1 if some subscribers
10744# topics have been deleted.
10745# Old name: Sympa::List::modifying_msg_topic_for_list_members().
10746sub _notify_deleted_topic {
10747    $log->syslog('debug3', '(%s)', @_);
10748    my $config = shift;
10749
10750    my @msg_topics = @{$config->get('msg_topic') || []};
10751    my @msg_topics_changes = $config->get_change('msg_topic');
10752    return 0 unless @msg_topics_changes;    # No changes.
10753
10754    my @msg_topics_deleted;
10755    my ($msg_topics_changes) = @msg_topics_changes;
10756    unless (defined $msg_topics_changes) {
10757        @msg_topics_deleted = @msg_topics;
10758    } else {
10759        my %msg_topics_changes = %{$config->get_change('msg_topic') || {}};
10760        @msg_topics_deleted =
10761            map { $msg_topics[$_] ? ($msg_topics[$_]->{name}) : (); }
10762            grep { not defined $msg_topics_changes{$_} }
10763            sort { $a <=> $b } keys %msg_topics_changes;
10764    }
10765
10766    my $deleted = 0;
10767    if (@msg_topics_deleted) {
10768        for (
10769            my $subscriber = $list->get_first_list_member();
10770            $subscriber;
10771            $subscriber = $list->get_next_list_member()
10772        ) {
10773            if ($subscriber->{'reception'} eq 'mail') {
10774                my $topics = Sympa::Tools::Data::diff_on_arrays(
10775                    [@msg_topics_deleted],
10776                    Sympa::Tools::Data::get_array_from_splitted_string(
10777                        $subscriber->{'topics'}
10778                    )
10779                );
10780
10781                if (@{$topics->{'intersection'}}) {
10782                    Sympa::send_notify_to_user(
10783                        $list, 'deleted_msg_topics',
10784                        $subscriber->{'email'},
10785                        {del_topics => $topics->{'intersection'}}
10786                    );
10787                    unless (
10788                        $list->update_list_member(
10789                            lc($subscriber->{'email'}),
10790                            update_date => time,
10791                            topics      => join(',', @{$topics->{'added'}})
10792                        )
10793                    ) {
10794                        $log->syslog(
10795                            'err',
10796                            'Impossible to update user "%s" of list %s',
10797                            $subscriber->{'email'}, $list
10798                        );
10799                    }
10800                    $deleted = 1;
10801                }
10802            }
10803        }
10804    }
10805    return $deleted;
10806}
10807
10808# Sends back the list config edition form.
10809sub do_edit_list_request {
10810    wwslog('info', '(%s)', $in{'group'});
10811
10812    return 1 unless $in{'group'};
10813
10814    my $config = Sympa::List::Config->new($list, config => $list->{'admin'});
10815    my $schema = $config->get_schema($param->{'user'}{'email'});
10816
10817    my @schema = map {
10818        # Skip comments and default values.
10819        # Skip parameters belonging to another group.
10820        if (   $_ eq 'comment'
10821            or $_ eq 'defaults'
10822            or $schema->{$_}->{group} ne $in{'group'}) {
10823            ();
10824        } else {
10825            my @p = _do_edit_list_request($config, $schema->{$_}, [$_]);
10826            if (@p) {
10827                # Store if the parameter is still at its default value or not.
10828                # FIXME:Multiple levels of keys should be possible.
10829                $p[0]->{'default_value'} = $config->get('defaults')->{$_};
10830            }
10831            @p;
10832        }
10833    } $config->keys;
10834
10835    # If at least one param was editable, make the update button appear in
10836    # the form.
10837    $param->{'is_form_editable'} =
10838        grep { $_->{privilege} eq 'write' } @schema;
10839    $param->{'config_schema'} = [@schema];
10840    $param->{'config_values'} = {
10841        map {
10842            my @value = $config->get($_->{name});
10843            @value ? ($_->{name} => $value[0]) : ();
10844        } @schema
10845    };
10846
10847    $param->{'group'}  = $in{'group'};
10848    $param->{'serial'} = $config->get('serial');
10849
10850    return 1;
10851}
10852
10853sub _do_edit_list_request {
10854    my $config = shift;
10855    my $pitem  = shift;
10856    my $pnames = shift;
10857
10858    # Skip obsolete parameters and alias names.
10859    # Skip hidden parameters.
10860    return () if $pitem->{obsolete};
10861    return () if $pitem->{privilege} eq 'hidden';
10862
10863    $pitem->{name}  = $pnames->[-1];
10864    $pitem->{title} = $language->gettext($pitem->{gettext_id})
10865        if exists $pitem->{gettext_id};
10866    $pitem->{comment} = $language->gettext($pitem->{gettext_comment})
10867        if exists $pitem->{gettext_comment};
10868    $pitem->{unit} = $language->gettext($pitem->{gettext_unit})
10869        if exists $pitem->{gettext_unit};
10870
10871    if (ref $pitem->{format} eq 'ARRAY' and $pitem->{occurrence} =~ /n$/) {
10872        $pitem->{type} = 'set';
10873    } elsif (ref $pitem->{format} eq 'HASH') {
10874        $pitem->{type} = 'paragraph';
10875
10876        my @format = map {
10877            _do_edit_list_request(
10878                $config,
10879                $pitem->{format}->{$_},
10880                [@$pnames, $_]
10881            );
10882        } $config->keys(join '.', @$pnames);
10883
10884        if (@format) {
10885            $pitem->{format} = [@format];
10886        } else {
10887            return ();
10888        }
10889    } else {
10890        $pitem->{type} = 'leaf';
10891
10892        $pitem->{enum} = 1
10893            if ref $pitem->{format} eq 'ARRAY';
10894
10895        if ($pitem->{scenario}) {
10896            my $scenarios =
10897                Sympa::Scenario::get_scenarios($list, $pitem->{scenario});
10898            $pitem->{format} = {
10899                map {
10900                    my $name  = $_->{name};
10901                    my $title = $_->get_current_title;
10902                    ($name => {name => $name, title => $title});
10903                } @$scenarios
10904            };
10905        } elsif ($pitem->{task}) {
10906            my $tasks = Sympa::Task::get_tasks($list, $pitem->{task});
10907            $pitem->{format} = {map { ($_->{name} => $_) } @$tasks};
10908        } elsif ($pitem->{datasource}) {
10909            my $list_of_data_sources = $list->load_data_sources_list($robot);
10910            $pitem->{format} = $list_of_data_sources;
10911        }
10912    }
10913
10914    return ($pitem);
10915}
10916
10917# No longer used.
10918#sub _check_new_values;
10919
10920# DEPRECATED.
10921#sub _prepare_edit_form;
10922
10923# DEPRECATED.
10924#sub _prepare_data;
10925
10926# No longer used.
10927#sub _restrict_values;
10928
10929## NOT USED anymore (expect chinese)
10930#sub do_close_list_request;
10931
10932# in order to rename a list you must be list owner and you must be allowed to
10933# create new list
10934sub do_rename_list_request {
10935    wwslog('info', '');
10936
10937    my $result = Sympa::Scenario->new($robot, 'create_list')->authz(
10938        $param->{'auth_method'},
10939        {   'sender'      => $param->{'user'}{'email'},
10940            'remote_host' => $param->{'remote_host'},
10941            'remote_addr' => $param->{'remote_addr'}
10942        }
10943    );
10944    my $r_action;
10945    my $reason;
10946    if (ref($result) eq 'HASH') {
10947        $r_action = $result->{'action'};
10948        $reason   = $result->{'reason'};
10949    }
10950
10951    unless ($r_action =~ /do_it|listmaster/) {
10952        Sympa::WWW::Report::reject_report_web('auth', $reason, {},
10953            $param->{'action'}, $list);
10954        wwslog('info', 'Not owner');
10955        return undef;
10956    }
10957
10958    ## Super listmaster can move a list to another robot
10959    if (Sympa::is_listmaster('*', $param->{'user'}{'email'})) {
10960        $param->{'robots'} = {};
10961        foreach my $r (Sympa::List::get_robots()) {
10962            if ($r eq $robot) {
10963                $param->{'robots'}{$r} = 'selected="selected"';
10964            } else {
10965                $param->{'robots'}{$r} = '';
10966            }
10967        }
10968    } else {
10969        delete $param->{'robots'};
10970    }
10971
10972    return '1';
10973}
10974
10975# Compat. <= 6.2.20
10976sub do_copy_list {
10977    $in{'mode'} = 'copy';
10978    goto &do_move_list;    # "&" is required.
10979}
10980
10981# In order to rename a list you must be list owner and you must be allowed to
10982# create new list.
10983sub do_move_list {
10984    wwslog('info', '(%s, %s, mode=%s)',
10985        $in{'new_listname'}, $in{'new_robot'}, $in{'mode'});
10986
10987    unless ($in{'new_robot'} and Conf::valid_robot($in{'new_robot'})) {
10988        wwslog('err', 'Unknown robot %s', $robot);
10989        Sympa::WWW::Report::reject_report_web('user', 'unknown_robot',
10990            {new_robot => $in{'new_robot'}},
10991            $param->{action});
10992        return undef;
10993    }
10994
10995    $param->{'new_listname'} = $in{'new_listname'};
10996    $param->{'new_robot'}    = $in{'new_robot'};
10997    $param->{'mode'}         = $in{'mode'};
10998
10999    # Action confirmed?
11000    my $next_action = $session->confirm_action(
11001        'move_list', $in{'response_action'},
11002        arg             => $in{'new_listname'} . '@' . $in{'new_robot'},
11003        previous_action => ($in{'previous_action'} || 'admin')
11004    );
11005    return $next_action unless $next_action eq '1';
11006
11007    my $spindle = Sympa::Spindle::ProcessRequest->new(
11008        context      => $in{'new_robot'},
11009        action       => 'move_list',
11010        listname     => $in{'new_listname'},
11011        current_list => $list,
11012        mode         => $in{'mode'},
11013        sender       => $param->{'user'}{'email'},
11014        (   $param->{'user'}{'email'}
11015            ? (md5_check => 1)
11016            : ()
11017        ),
11018
11019        scenario_context => {
11020            sender      => $param->{'user'}{'email'},
11021            remote_host => $param->{'remote_host'},
11022            remote_addr => $param->{'remote_addr'},
11023        },
11024    );
11025
11026    unless ($spindle and $spindle->spin) {
11027        return 'rename_list_request';
11028    }
11029
11030    foreach my $report (@{$spindle->{stash} || []}) {
11031        if ($report->[1] eq 'notice') {
11032            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
11033                $param->{'action'});
11034        } else {
11035            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
11036                $param->{action});
11037        }
11038    }
11039    unless (@{$spindle->{stash} || []}) {
11040        Sympa::WWW::Report::notice_report_web('performed', {},
11041            $param->{'action'});
11042    }
11043
11044    if (grep { $_->[1] ne 'notice' } @{$spindle->{stash} || []}) {
11045        return 'rename_list_request';
11046    }
11047
11048    # Were aliases installed?
11049    if (grep { $_->[1] eq 'notice' and $_->[2] eq 'auto_aliases' }
11050        @{$spindle->{stash} || []}) {
11051        $param->{'auto_aliases'} = 1;
11052    } else {
11053        $param->{'auto_aliases'} = 0;
11054    }
11055
11056    # Switch to new list context.
11057    $list = Sympa::List->new($in{'new_listname'}, $in{'new_robot'});
11058    $robot = $list->{'domain'};
11059    $param->{'list'} = $in{'new_listname'};
11060
11061    if ($in{'new_robot'} eq $robot) {
11062        $param->{'redirect_to'} = Sympa::get_url(
11063            $list, 'admin',
11064            nomenu    => $param->{'nomenu'},
11065            authority => 'local'
11066        );
11067    } else {
11068        $param->{'redirect_to'} =
11069            Sympa::get_url($list, 'admin', nomenu => $param->{'nomenu'});
11070    }
11071
11072    return 1;
11073}
11074
11075sub do_purge_list {
11076    wwslog('info', '');
11077
11078    my @lists = grep {$_} map { Sympa::List->new($_, $robot) }
11079        grep {$_} split /\0/, $in{'selected_lists'};
11080    return 'get_closed_lists' unless @lists;
11081
11082    $param->{'selected_lists'} = [map { $_->{'name'} } @lists];
11083
11084    # Action confirmed?
11085    my $next_action = $session->confirm_action(
11086        'purge_list', $in{'response_action'},
11087        arg => join(',', @{$param->{'selected_lists'} || []}),
11088        previous_action => 'get_closed_lists',
11089    );
11090    return $next_action unless $next_action eq '1';
11091
11092    my $spindle = Sympa::Spindle::ProcessRequest->new(
11093        context      => $robot,
11094        action       => 'close_list',
11095        current_list => [@lists],
11096        mode         => 'purge',
11097        sender       => $param->{'user'}{'email'},
11098        (   $param->{'user'}{'email'}
11099            ? (md5_check => 1)
11100            : ()
11101        ),
11102
11103        scenario_context => {
11104            sender      => $param->{'user'}{'email'},
11105            remote_host => $param->{'remote_host'},
11106            remote_addr => $param->{'remote_addr'},
11107        },
11108    );
11109    unless ($spindle and $spindle->spin) {
11110        wwslog('err', 'Cannot purge lists');
11111        return 'get_closed_lists';
11112    }
11113
11114    foreach my $report (@{$spindle->{stash} || []}) {
11115        if ($report->[1] eq 'notice') {
11116            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
11117                $param->{'action'});
11118        } else {
11119            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
11120                $param->{action});
11121        }
11122    }
11123    unless (@{$spindle->{stash} || []}) {
11124        Sympa::WWW::Report::notice_report_web('performed', {},
11125            $param->{'action'});
11126    }
11127
11128    web_db_log(
11129        {   'parameters' => $in{'selected_lists'},
11130            'status'     => 'success'
11131        }
11132    );
11133
11134    return 'get_closed_lists';
11135}
11136
11137sub do_close_list {
11138    wwslog('info', '(%s, mode=%s)', $list, $in{'mode'});
11139    my $mode   = $in{'mode'};
11140    my $notify = !!$in{'notify'};
11141
11142    # Sanitize parameter: non-listmasters are allowed "close" mode only.
11143    $mode = 'close'
11144        unless Sympa::is_listmaster($list, $param->{'user'}{'email'});
11145    $mode = 'close'
11146        unless $mode and grep { $mode eq $_ } qw(close install);
11147
11148    $param->{'mode'}            = $mode;
11149    $param->{'previous_action'} = $in{'previous_action'} || 'admin';
11150    $param->{'notify'}          = $notify;
11151
11152    # Action confirmed?
11153    my $next_action = $session->confirm_action(
11154        $in{'action'}, $in{'response_action'},
11155        arg             => $list->{'name'},
11156        previous_action => ($in{'previous_action'} || 'admin')
11157    );
11158    return $next_action unless $next_action eq '1';
11159
11160    my $spindle = Sympa::Spindle::ProcessRequest->new(
11161        context      => $robot,
11162        action       => 'close_list',
11163        current_list => $list,
11164        mode         => $mode,
11165        notify       => $notify,
11166        sender       => $param->{'user'}{'email'},
11167        (   $param->{'user'}{'email'}
11168            ? (md5_check => 1)
11169            : ()
11170        ),
11171
11172        scenario_context => {
11173            sender      => $param->{'user'}{'email'},
11174            remote_host => $param->{'remote_host'},
11175            remote_addr => $param->{'remote_addr'},
11176        },
11177    );
11178    unless ($spindle and $spindle->spin) {
11179        wwslog('err', 'Cannot close list %s', $list);
11180        return $in{'previous_action'} || 'admin';
11181    }
11182
11183    foreach my $report (@{$spindle->{stash} || []}) {
11184        if ($report->[1] eq 'notice') {
11185            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
11186                $param->{'action'});
11187        } else {
11188            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
11189                $param->{action});
11190        }
11191    }
11192    unless (@{$spindle->{stash} || []}) {
11193        Sympa::WWW::Report::notice_report_web('performed', {},
11194            $param->{'action'});
11195    } elsif (not $spindle->success) {
11196        return $in{'previous_action'} || 'admin';
11197    }
11198
11199    web_db_log({'status' => 'success'});
11200
11201    if ($mode eq 'install') {
11202        return 'get_pending_lists';
11203    } else {
11204        return (
11205            Sympa::is_listmaster($list, $param->{'user'}{'email'})
11206            ? ($in{'previous_action'} || 'admin')
11207            : Conf::get_robot_conf($robot, 'default_home')
11208        );
11209    }
11210}
11211
11212# Old name: do_restore_list().
11213sub do_open_list {
11214    wwslog('info', '(mode=%s)', $in{'mode'});
11215    my $mode   = $in{'mode'};
11216    my $notify = !!$in{'notify'};
11217
11218    # Sanitize parameter.
11219    $mode = 'open'
11220        unless $mode and grep { $mode eq $_ } qw(open install);
11221
11222    $param->{'mode'}            = $mode;
11223    $param->{'previous_action'} = $in{'previous_action'} || 'admin';
11224    $param->{'notify'}          = $notify;
11225
11226    # Action confirmed?
11227    my $next_action = $session->confirm_action(
11228        $in{'action'}, $in{'response_action'},
11229        arg             => join(',', $list->{'name'}, $mode),
11230        previous_action => ($in{'previous_action'} || 'admin')
11231    );
11232    return $next_action unless $next_action eq '1';
11233
11234    my $spindle = Sympa::Spindle::ProcessRequest->new(
11235        context      => $robot,
11236        action       => 'open_list',
11237        current_list => $list,
11238        mode         => $mode,
11239        notify       => $notify,
11240        sender       => $param->{'user'}{'email'},
11241        (   $param->{'user'}{'email'}
11242            ? (md5_check => 1)
11243            : ()
11244        ),
11245
11246        scenario_context => {
11247            sender      => $param->{'user'}{'email'},
11248            remote_host => $param->{'remote_host'},
11249            remote_addr => $param->{'remote_addr'},
11250        },
11251    );
11252    unless ($spindle and $spindle->spin) {
11253        return $in{'previous_action'} || 'admin';
11254    }
11255
11256    foreach my $report (@{$spindle->{stash} || []}) {
11257        if ($report->[1] eq 'notice') {
11258            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
11259                $param->{'action'});
11260        } else {
11261            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
11262                $param->{action});
11263        }
11264    }
11265    unless (@{$spindle->{stash} || []}) {
11266        Sympa::WWW::Report::notice_report_web('performed', {},
11267            $param->{'action'});
11268    }
11269    unless ($spindle->success) {
11270        return $in{'previous_action'} || 'admin';
11271    }
11272
11273    web_db_log({'status' => 'success'});
11274
11275    if ($mode eq 'install') {
11276        return 'get_pending_lists';
11277    } else {
11278        return $in{'previous_action'} || 'admin';
11279    }
11280}
11281
11282# Moved to Sympa::WWW::SharedDocument::_load_desc_file().
11283#sub get_desc_file ($file, $ligne);
11284
11285sub do_show_cert {
11286    return 1;
11287}
11288
11289# Return true if the file in parameter can be overwrited
11290# false if it has changes since the parameter date_epoch
11291# DEPRECATED: No longer used.
11292#sub synchronize;
11293
11294# DEPRECATED.  Use Sympa::WWW::SharedDocument::get_privileges().
11295#sub d_access_control;
11296
11297# create the root shared document
11298sub do_d_admin {
11299    wwslog('info', '(%s, %s)', $in{'list'}, $in{'d_admin'});
11300
11301    my $shared_doc = Sympa::WWW::SharedDocument->new($list);
11302    my %access     = $shared_doc->get_privileges(
11303        mode             => 'edit',
11304        sender           => $param->{'user'}{'email'},
11305        auth_method      => $param->{'auth_method'},
11306        scenario_context => {
11307            sender      => $param->{'user'}{'email'},
11308            remote_host => $param->{'remote_host'},
11309            remote_addr => $param->{'remote_addr'}
11310        }
11311    );
11312    unless ($access{may}{edit}) {
11313        wwslog('info', 'Permission denied for %s', $param->{'user'}{'email'});
11314        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
11315            {}, $param->{'action'}, $list);
11316        web_db_log(
11317            {   'parameters' => '',
11318                'status'     => 'error',
11319                'error_type' => 'authorization'
11320            }
11321        );
11322        return undef;
11323    }
11324
11325    if ($in{'d_admin'} eq 'create') {
11326        unless ($shared_doc->create) {
11327            wwslog('info', 'Could not create the shared %s: %m', $shared_doc);
11328            Sympa::WWW::Report::reject_report_web('intern', 'create_shared',
11329                {},
11330                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
11331            web_db_log(
11332                {   'parameters' => '',
11333                    'status'     => 'error',
11334                    'error_type' => 'internal'
11335                }
11336            );
11337            return undef;
11338        }
11339
11340        return 'd_read';
11341    } elsif ($in{'d_admin'} eq 'restore') {
11342        unless ($shared_doc->restore) {
11343            wwslog('info', 'Couldnot restore the shared %s; %m', $shared_doc);
11344            Sympa::WWW::Report::reject_report_web('intern', 'restore_shared',
11345                {},
11346                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
11347            web_db_log(
11348                {   'parameters' => '',
11349                    'status'     => 'error',
11350                    'error_type' => 'internal'
11351                }
11352            );
11353            return undef;
11354        }
11355
11356        web_db_log(
11357            {   'parameters' => $in{'path'},
11358                'status'     => 'success'
11359            }
11360        );
11361        return 'd_read';
11362    } elsif ($in{'d_admin'} eq 'delete') {
11363        $param->{'d_admin'} = $in{'d_admin'};
11364
11365        # Action confirmed?
11366        my $next_action = $session->confirm_action(
11367            $in{'action'}, $in{'response_action'},
11368            arg             => $in{'d_admin'} . '/' . $list->{'name'},
11369            previous_action => 'admin'
11370        );
11371        return $next_action unless $next_action eq '1';
11372
11373        unless ($shared_doc->delete) {
11374            wwslog('info', 'Couldnot delete the shared %s: %m', $shared_doc);
11375            Sympa::WWW::Report::reject_report_web('intern', 'delete_shared',
11376                {},
11377                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
11378            web_db_log(
11379                {   'parameters' => $in{'path'},
11380                    'status'     => 'error',
11381                    'error_type' => 'internal'
11382                }
11383            );
11384            return undef;
11385        }
11386
11387        web_db_log(
11388            {   'parameters' => $in{'path'},
11389                'status'     => 'success'
11390            }
11391        );
11392    }
11393
11394    return 'admin';
11395}
11396
11397# Moved.  Use Sympa::WWW::SharedDocument::by_order().
11398#sub by_order;
11399
11400#*******************************************
11401# Function : do_d_read
11402# Description : reads a file or a directory
11403#******************************************
11404##
11405## Function do_d_read
11406sub do_d_read {
11407    wwslog('info', '(%s)', $in{'path'});
11408
11409    my $path = $in{'path'};
11410
11411    # Is list open ?
11412    unless ($list->{'admin'}{'status'} eq 'open') {
11413        Sympa::WWW::Report::reject_report_web('user', 'list_not_open',
11414            {'status' => $list->{'admin'}{'status'}},
11415            $param->{'action'}, $list);
11416        wwslog(
11417            'err',
11418            'Access denied for %s because list is not open',
11419            $param->{'user'}{'email'}
11420        );
11421        web_db_log(
11422            {   'parameters' => $in{'path'},
11423                'status'     => 'error',
11424                'error_type' => 'authorization'
11425            }
11426        );
11427        return undef;
11428    }
11429
11430    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
11431    # Document exists ?
11432    unless ($shared_doc and -r $shared_doc->{fs_path}) {
11433        wwslog('err', 'Unable to read %s: no such file or directory',
11434            $shared_doc);
11435        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
11436            {'path' => $path},
11437            $param->{'action'}, $list);
11438        web_db_log(
11439            {   'parameters' => $in{'path'},
11440                'status'     => 'error',
11441                'error_type' => 'internal'
11442            }
11443        );
11444        return undef;
11445    }
11446    $param->{'shared_doc'} = $shared_doc->as_hashref;
11447
11448    # Access control.
11449    my %access = $shared_doc->get_privileges(
11450        mode             => 'read,edit,control',
11451        sender           => $param->{'user'}{'email'},
11452        auth_method      => $param->{'auth_method'},
11453        scenario_context => {
11454            sender      => $param->{'user'}{'email'},
11455            remote_host => $param->{'remote_host'},
11456            remote_addr => $param->{'remote_addr'}
11457        }
11458    );
11459    my $may_read = $access{may}{read};
11460    unless ($may_read) {
11461        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{read},
11462            {}, $param->{'action'}, $list);
11463        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
11464        web_db_log(
11465            {   'parameters' => $in{'path'},
11466                'status'     => 'error',
11467                'error_type' => 'authorization'
11468            }
11469        );
11470        return undef;
11471    }
11472
11473    my $may_edit    = $access{may}{edit};
11474    my $may_control = $access{may}{control};
11475
11476    # File or directory?
11477
11478    if ($shared_doc->{type} eq 'url') {
11479        $param->{'redirect_to'} = $shared_doc->{url}
11480            if $shared_doc->{url}
11481            and $shared_doc->{url} =~ m{\Ahttps?://}i;
11482        return 1;
11483    } elsif ($shared_doc->{type} eq 'file') {
11484        $param->{'content_type'} = $shared_doc->{mime_type};
11485        $param->{'file'}         = $shared_doc->{fs_path};
11486        $param->{'bypass'}       = 1;
11487        return 1;
11488    }
11489
11490    # Directory
11491
11492    # verification of the URL (the path must have a slash at its end)
11493    #if ($ENV{'PATH_INFO'} !~ /\/$/) {
11494    #    $param->{'redirect_to'} = Sympa::get_url($list, 'd_read',
11495    #        nomenu => $param->{'nomenu'}, authority => 'local');
11496    #    return 1;
11497    #}
11498
11499    # To sort subdirs and files.
11500    my $order = $in{'order'} || 'order_by_doc';
11501    $param->{'order_by'} = $order;
11502
11503    my @children;
11504    if ($list->is_admin('actual_editor', $param->{'user'}{'email'})) {
11505        @children = $shared_doc->get_children(order_by => $order);
11506    } else {
11507        @children = grep {
11508            $_->{moderate} and $_->{owner} eq $param->{'user'}{'email'}
11509                or not $_->{moderate}
11510        } $shared_doc->get_children(order_by => $order);
11511    }
11512
11513    # Empty directory?
11514    $param->{'empty'} = !scalar @children;
11515
11516    # For the exception of index.html.
11517    # Name of the file "index.html" if exists in the directory read.
11518    my $indexhtml;
11519
11520    # Boolean : one of the subdirectories or files inside can be edited
11521    # -> normal mode of read -> d_read.tt2;
11522    my $normal_mode;
11523
11524    my $user = $param->{'user'}{'email'} || 'nobody';
11525
11526    my @children_hash = map {
11527        my $child      = $_;
11528        my $child_hash = $_->as_hashref;
11529
11530        # Case subdirectory
11531        if ($child->{type} eq 'directory') {
11532            if ($child->{scenario}) {
11533                # Check access permission for reading.
11534                my $result =
11535                    Sympa::Scenario->new($list, 'd_read',
11536                    name => $child->{scenario}{read})->authz(
11537                    $param->{'auth_method'},
11538                    {   'sender'      => $param->{'user'}{'email'},
11539                        'remote_host' => $param->{'remote_host'},
11540                        'remote_addr' => $param->{'remote_addr'},
11541                    }
11542                    );
11543                my $action;
11544                $action = $result->{'action'} if ref $result eq 'HASH';
11545
11546                if (   $user eq $child->{owner}
11547                    or $may_control
11548                    or $action =~ /\Ado_it\b/i) {
11549                    # If the file can be read, check for edit access &
11550                    # edit description files access.
11551                    # Only authenticated users can edit a file.
11552                    if ($param->{'user'}{'email'}) {
11553                        my $result =
11554                            Sympa::Scenario->new($list, 'd_edit',
11555                            name => $child->{scenario}{edit})->authz(
11556                            $param->{'auth_method'},
11557                            {   'sender'      => $param->{'user'}{'email'},
11558                                'remote_host' => $param->{'remote_host'},
11559                                'remote_addr' => $param->{'remote_addr'},
11560                            }
11561                            );
11562                        my $action_edit;
11563                        $action_edit = $result->{'action'}
11564                            if ref $result eq 'HASH';
11565                        $action_edit ||= '';
11566
11567                        # may_action_edit = 0, 0.5 or 1
11568                        my $may_action_edit =
11569                              ($action_edit =~ /\Ado_it\b/i)  ? 1
11570                            : ($action_edit =~ /\Aeditor\b/i) ? 0.5
11571                            :                                   0;
11572                        $may_action_edit =
11573                             !($may_action_edit and $may_edit) ? 0
11574                            : ($may_action_edit == 0.5 or $may_edit == 0.5)
11575                            ? 0.5
11576                            : 1;
11577                        if ($may_control or $user eq $child->{owner}) {
11578                            $child_hash->{may_edit} = 1;
11579                            # ...or = $may_action_edit ?
11580                            # If index.html, must know if something can be
11581                            # edit in the dir.
11582                            $normal_mode = 1;
11583                        } elsif ($may_action_edit) {
11584                            # $may_action_edit = 0.5 or 1
11585                            $child_hash->{may_edit} = $may_action_edit;
11586                            # If index.html, must know if something can be
11587                            # edit in the dir.
11588                            $normal_mode = 1;
11589                        }
11590                    }
11591
11592                    if ($may_control or $user eq $child->{owner}) {
11593                        $child_hash->{may_control} = 1;
11594                    }
11595                }
11596            } else {
11597                # No description file = no need to check access for read
11598                # access for edit and control
11599                if ($may_control) {
11600                    $child_hash->{may_edit} = 1;
11601                    # ...or = $may_action_edit ?
11602                    $normal_mode = 1;
11603                } elsif ($may_edit) {
11604                    # $may_action_edit = 1 or 0.5
11605                    $child_hash->{may_edit} = $may_edit;
11606                    $normal_mode = 1;
11607                }
11608
11609                if ($may_control) {
11610                    $child_hash->{may_control} = 1;
11611                }
11612            }
11613        } else {
11614            # case file
11615            my $may      = 1;
11616            my $def_desc = 0;
11617
11618            if ($child->{scenario}) {
11619                # a desc file was found
11620                $def_desc = 1;
11621
11622                my $result =
11623                    Sympa::Scenario->new($list, 'd_read',
11624                    name => $child->{scenario}{read})->authz(
11625                    $param->{'auth_method'},
11626                    {   'sender'      => $param->{'user'}{'email'},
11627                        'remote_host' => $param->{'remote_host'},
11628                        'remote_addr' => $param->{'remote_addr'},
11629                    }
11630                    );
11631                my $action;
11632                $action = $result->{'action'} if ref $result eq 'HASH';
11633                unless ($user eq $child->{owner}
11634                    or $may_control
11635                    or $action =~ /\Ado_it\b/i) {
11636                    $may = 0;
11637                }
11638            }
11639
11640            # If permission or no description file.
11641            if ($may) {
11642                # Exception of index.html.
11643                if ($child->{name} =~ /\Aindex[.]html?\z/i) {
11644                    $indexhtml = $child->{name};
11645                }
11646
11647                ## Access control for edit and control
11648                if ($def_desc) {
11649                    # Check access for edit and control the file.
11650                    # Only authenticated users can edit files.
11651
11652                    if ($param->{'user'}{'email'}) {
11653                        my $result =
11654                            Sympa::Scenario->new($list, 'd_edit',
11655                            name => $child->{scenario}{edit})->authz(
11656                            $param->{'auth_method'},
11657                            {   'sender'      => $param->{'user'}{'email'},
11658                                'remote_host' => $param->{'remote_host'},
11659                                'remote_addr' => $param->{'remote_addr'},
11660                            }
11661                            );
11662                        my $action_edit;
11663                        $action_edit = $result->{'action'}
11664                            if ref $result eq 'HASH';
11665                        $action_edit ||= '';
11666
11667                        # may_action_edit = 0, 0.5 or 1
11668                        my $may_action_edit =
11669                              ($action_edit =~ /\Ado_it\b/i)  ? 1
11670                            : ($action_edit =~ /\Aeditor\b/i) ? 0.5
11671                            :                                   0;
11672                        $may_action_edit =
11673                             !($may_action_edit and $may_edit) ? 0
11674                            : ($may_action_edit == 0.5 or $may_edit == 0.5)
11675                            ? 0.5
11676                            : 1;
11677                        if ($may_control or $user eq $child->{owner}) {
11678                            $normal_mode = 1;
11679                            $child_hash->{may_edit} = 1;
11680                            # ...or = $may_action_edit ?
11681                        } elsif ($may_action_edit) {
11682                            # $may_action_edit = 1 or 0.5
11683                            $normal_mode = 1;
11684                            $child_hash->{may_edit} = $may_action_edit;
11685                        }
11686
11687                        if ($user eq $child->{owner} or $may_control) {
11688                            $child_hash->{may_control} = 1;
11689                        }
11690                    } else {
11691                        if ($may_edit) {
11692                            $child_hash->{may_edit} = $may_edit;
11693                            $normal_mode = 1;
11694                        }
11695                        if ($may_control) {
11696                            $child_hash->{may_control} = 1;
11697                        }
11698                    }
11699                }
11700            }
11701        }
11702
11703        $child_hash;
11704    } @children;    # map {...}
11705
11706    # Exception : index.html
11707    if ($indexhtml) {
11708        unless ($normal_mode) {
11709            $param->{'content_type'} = 'text/html';
11710            $param->{'bypass'}       = 1;
11711            $param->{'file'} = $shared_doc->{fs_path} . '/' . $indexhtml;
11712            return 1;
11713        }
11714    }
11715
11716    # parameters for the template file
11717    $param->{'list'} = $list->{'name'};
11718
11719    $param->{'shared_doc'}{'may_edit'}    = $may_edit;
11720    $param->{'shared_doc'}{'may_control'} = $may_control;
11721
11722    $param->{'shared_doc'}{'children'} = \@children_hash
11723        if @children_hash;
11724
11725    # Show expert commands / user page.
11726
11727    # For the curent directory.
11728    unless ($may_edit or $may_control) {
11729        $param->{'has_dir_rights'} = 0;
11730    } else {
11731        $param->{'has_dir_rights'} = 1;
11732        if ($may_edit == 1) {    # (is_author || ! moderated)
11733            $param->{'total_edit'} = 1;
11734        }
11735    }
11736
11737    # Set the page mode
11738    if ($in{'show_expert_page'} and $param->{'has_dir_rights'}) {
11739        $session->{'shared_mode'} = 'expert';
11740        if ($param->{'user'}{'prefs'}{'shared_mode'} ne 'expert') {
11741            # update user pref  as soon as connected user change shared mode
11742            $param->{'user'}{'prefs'}{'shared_mode'} = 'expert';
11743            Sympa::User::update_global_user($param->{'user'}{'email'},
11744                {data => $param->{'user'}{'prefs'}});
11745        }
11746        $param->{'expert_page'} = 1;
11747
11748    } elsif ($in{'show_user_page'}) {
11749        $session->{'shared_mode'} = 'basic';
11750        if ($param->{'user'}{'prefs'}{'shared_mode'} ne 'basic') {
11751            # update user pref  as soon as connected user change shared mode
11752            $param->{'user'}{'prefs'}{'shared_mode'} = 'basic';
11753            Sympa::User::update_global_user($param->{'user'}{'email'},
11754                {data => $param->{'user'}{'prefs'}});
11755        }
11756        $param->{'expert_page'} = 0;
11757    } else {
11758        if (   $session->{'shared_mode'} eq 'expert'
11759            && $param->{'has_dir_rights'}) {
11760            $param->{'expert_page'} = 1;
11761        } else {
11762            $param->{'expert_page'} = 0;
11763        }
11764    }
11765
11766    web_db_log(
11767        {   'parameters' => $in{'path'},
11768            'status'     => 'success'
11769        }
11770    );
11771
11772    return 1;
11773}
11774
11775# Access to latest shared documents.
11776sub do_latest_d_read {
11777    wwslog('info', '(%s, %s, %s)', $in{'list'}, $in{'for'}, $in{'count'});
11778
11779    # Is list open?
11780    unless ($list->{'admin'}{'status'} eq 'open') {
11781        Sympa::WWW::Report::reject_report_web('user', 'list_not_open',
11782            {'status' => $list->{'admin'}{'status'}},
11783            $param->{'action'}, $list);
11784        wwslog(
11785            'err',
11786            'Access denied for %s because list is not open',
11787            $param->{'user'}{'email'}
11788        );
11789        web_db_log(
11790            {   'parameters' => $in{'path'},
11791                'status'     => 'error',
11792                'error_type' => 'authorization'
11793            }
11794        );
11795        return undef;
11796    }
11797
11798    my $shared_doc = Sympa::WWW::SharedDocument->new($list);
11799    # Shared exist?
11800    unless ($shared_doc and -r $shared_doc->{fs_path}) {
11801        wwslog('err',
11802            'Unable to read %s: no such file or directory', $shared_doc);
11803        Sympa::WWW::Report::reject_report_web('user', 'no_shared', {},
11804            $param->{'action'}, $list);
11805        return undef;
11806    }
11807    $param->{'shared_doc'} = $shared_doc->as_hashref;
11808
11809    # Access control.
11810    my %access = $shared_doc->get_privileges(
11811        mode             => 'read,control',
11812        sender           => $param->{'user'}{'email'},
11813        auth_method      => $param->{'auth_method'},
11814        scenario_context => {
11815            sender      => $param->{'user'}{'email'},
11816            remote_host => $param->{'remote_host'},
11817            remote_addr => $param->{'remote_addr'}
11818        }
11819    );
11820    unless ($access{may}{read}) {
11821        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{read},
11822            {}, $param->{'action'}, $list);
11823        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
11824        return undef;
11825    }
11826
11827    # Parameters of the query.
11828    my $today = time;
11829
11830    my $oldest_day;
11831    if (defined $in{'for'}) {
11832        $oldest_day = $today - (86400 * ($in{'for'}));
11833        $param->{'for'} = $in{'for'};
11834        unless ($oldest_day >= 0) {
11835            Sympa::WWW::Report::reject_report_web('user', 'nb_days_to_much',
11836                {'nb_days' => $in{'for'}},
11837                $param->{'action'}, $list);
11838            wwslog('err', 'Parameter "for" is too big"');
11839        }
11840    }
11841
11842    my $nb_doc;
11843    my $NB_DOC_MAX = 100;
11844    if (defined $in{'count'}) {
11845        if ($in{'count'} > $NB_DOC_MAX) {
11846            $in{'count'} = $NB_DOC_MAX;
11847        }
11848        $param->{'count'} = $in{'count'};
11849        $nb_doc = $in{'count'};
11850    } else {
11851        $nb_doc = $NB_DOC_MAX;
11852    }
11853
11854    my @children = sort { $b->{'date_epoch'} <=> $a->{'date_epoch'} }
11855        _latest_d_read($shared_doc, $oldest_day, $access{may}{control});
11856    $param->{'shared_doc'}{'children'} =
11857        [map { $_->as_hashref } splice @children, 0, $nb_doc];
11858
11859    return 1;
11860}
11861
11862# Browse a directory recursively and return documents younger than
11863# $oldest_day.
11864# Old name: directory_browsing() in wwsympa.fcgi.
11865sub _latest_d_read {
11866    wwslog('debug2', '(%s, %s, %s)', @_);
11867    my $shared_doc  = shift;
11868    my $oldest_day  = shift;
11869    my $may_control = shift;
11870
11871    my @result;
11872
11873    my $user = $param->{'user'}{'email'} || 'nobody';
11874
11875    foreach my $child ($shared_doc->get_children) {
11876        if ($child->{type} eq 'directory') {
11877            if ($child->{scenario}) {
11878                # Check access permission for reading.
11879                my $result =
11880                    Sympa::Scenario->new($list, 'd_read',
11881                    name => $child->{scenario}{read})->authz(
11882                    $param->{'auth_method'},
11883                    {   'sender'      => $param->{'user'}{'email'},
11884                        'remote_host' => $param->{'remote_host'},
11885                        'remote_addr' => $param->{'remote_addr'},
11886                    }
11887                    );
11888                my $action = $result->{'action'} if ref $result eq 'HASH';
11889                $action ||= '';
11890
11891                if (   $user eq $child->{owner}
11892                    or $may_control
11893                    or $action =~ /\Ado_it\b/i) {
11894                    push @result, _latest_d_read($child, $oldest_day);
11895                }
11896            }
11897        } else {
11898            next if $child->{date_epoch} < $oldest_day;
11899            # Exception of index.html.
11900            next if $child->{name} =~ /\Aindex[.]html?\z/i;
11901
11902            my $may = 1;
11903            if ($child->{scenario}) {
11904                my $result =
11905                    Sympa::Scenario->new($list, 'd_read',
11906                    name => $child->{scenario}{read})->authz(
11907                    $param->{'auth_method'},
11908                    {   'sender'      => $param->{'user'}{'email'},
11909                        'remote_host' => $param->{'remote_host'},
11910                        'remote_addr' => $param->{'remote_addr'},
11911                    }
11912                    );
11913                my $action = $result->{'action'} if ref $result eq 'HASH';
11914                $action ||= '';
11915
11916                unless ($user eq $child->{owner}
11917                    or $may_control
11918                    or $action =~ /\Ado_it\b/i) {
11919                    $may = 0;
11920                }
11921            }
11922            push @result, $child if $may;
11923        }
11924    }
11925
11926    return @result;
11927}
11928
11929#*******************************************
11930# Function : do_d_editfile
11931# Description : prepares the parameters to
11932#               edit a file
11933#*******************************************
11934
11935sub do_d_editfile {
11936    wwslog('info', '(%s)', $in{'path'});
11937
11938    my $path = $in{'path'};
11939
11940    # Is list open?
11941    unless ($list->{'admin'}{'status'} eq 'open') {
11942        Sympa::WWW::Report::reject_report_web('user', 'list_not_open',
11943            {'status' => $list->{'admin'}{'status'}},
11944            $param->{'action'}, $list);
11945        wwslog(
11946            'err',
11947            'Access denied for %s because list is not open',
11948            $param->{'user'}{'email'}
11949        );
11950        web_db_log(
11951            {   'parameters' => $in{'path'},
11952                'status'     => 'error',
11953                'error_type' => 'authorization'
11954            }
11955        );
11956        return undef;
11957    }
11958
11959    my $shared_doc =
11960        Sympa::WWW::SharedDocument->new($list, $path, allow_empty => 1);
11961    # Existing document? File?
11962    unless ($shared_doc
11963        and -r $shared_doc->{fs_path}
11964        and -w $shared_doc->{fs_path}
11965        and not(grep { $shared_doc->{type} eq $_ } qw(root directory))) {
11966        wwslog('err', 'Unable to read %s: no such file or directory', $path);
11967        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
11968            {'path' => $path},
11969            $param->{'action'}, $list);
11970        web_db_log(
11971            {   'parameters' => $in{'path'},
11972                'status'     => 'error',
11973                'error_type' => 'internal'
11974            }
11975        );
11976        return undef;
11977    }
11978    $param->{'shared_doc'} = $shared_doc->as_hashref;
11979
11980    # Access control.
11981    my %access = $shared_doc->get_privileges(
11982        mode             => 'edit,control',
11983        sender           => $param->{'user'}{'email'},
11984        auth_method      => $param->{'auth_method'},
11985        scenario_context => {
11986            sender      => $param->{'user'}{'email'},
11987            remote_host => $param->{'remote_host'},
11988            remote_addr => $param->{'remote_addr'}
11989        }
11990    );
11991    unless ($access{may}{edit}) {
11992        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
11993            {}, $param->{'action'}, $list);
11994        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
11995        web_db_log(
11996            {   'parameters' => $in{'path'},
11997                'status'     => 'error',
11998                'error_type' => 'authorization'
11999            }
12000        );
12001        return undef;
12002    }
12003
12004    ## End of controls
12005
12006    $param->{'list'} = $list->{'name'};
12007
12008    $param->{'shared_doc'}{'may_edit'}    = $access{may}{edit};
12009    $param->{'shared_doc'}{'may_control'} = $access{may}{control};
12010
12011    # Test if it's a text file.
12012    if (-T $shared_doc->{fs_path}) {    #FIXME:Better check
12013        $param->{'textfile'} = 1;
12014        if (open my $fh, '<', $shared_doc->{fs_path}) {
12015            $param->{'shared_doc'}{'content'} = do { local $RS; <$fh> };
12016            close $fh;
12017        }
12018    } else {
12019        $param->{'textfile'} = 0;
12020    }
12021
12022    web_db_log(
12023        {   'parameters' => $in{'path'},
12024            'status'     => 'success'
12025        }
12026    );
12027
12028    return 1;
12029}
12030
12031#*******************************************
12032# Function : do_d_properties
12033# Description : prepares the parameters to
12034#               change a file properties
12035#*******************************************
12036
12037sub do_d_properties {
12038    wwslog('info', '(%s)', $in{'path'});
12039
12040    my $path = $in{'path'};
12041
12042    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
12043    # Existing document? File?
12044    unless ($shared_doc
12045        and -r $shared_doc->{fs_path}
12046        and -w $shared_doc->{fs_path}
12047        and $shared_doc->{type} ne 'root') {
12048        wwslog('err', '%s: no such file or directory', $path);
12049        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
12050            {'path' => $path},
12051            $param->{'action'}, $list);
12052        web_db_log(
12053            {   'robot'        => $robot,
12054                'list'         => $list->{'name'},
12055                'action'       => $param->{'action'},
12056                'parameters'   => "$in{'path'}",
12057                'target_email' => "",
12058                'msg_id'       => '',
12059                'status'       => 'error',
12060                'error_type'   => 'internal',
12061                'user_email'   => $param->{'user'}{'email'},
12062            }
12063        );
12064        return undef;
12065    }
12066    $param->{'shared_doc'} = $shared_doc->as_hashref;
12067
12068    # Access control.
12069    my %access = $shared_doc->get_privileges(
12070        mode             => 'edit,control',
12071        sender           => $param->{'user'}{'email'},
12072        auth_method      => $param->{'auth_method'},
12073        scenario_context => {
12074            sender      => $param->{'user'}{'email'},
12075            remote_host => $param->{'remote_host'},
12076            remote_addr => $param->{'remote_addr'}
12077        }
12078    );
12079    unless ($access{may}{edit}) {
12080        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
12081            {}, $param->{'action'}, $list);
12082        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
12083        web_db_log(
12084            {   'parameters' => $in{'path'},
12085                'status'     => 'error',
12086                'error_type' => 'authorization'
12087            }
12088        );
12089        return undef;
12090    }
12091
12092    $param->{'list'} = $list->{'name'};
12093
12094    $param->{'shared_doc'}{'may_edit'}    = $access{may}{edit};
12095    $param->{'shared_doc'}{'may_control'} = $access{may}{control};
12096
12097    ##FIXME: Required?
12098    #$allow_absolute_path = 1;
12099
12100    web_db_log(
12101        {   'parameters' => $in{'path'},
12102            'status'     => 'success'
12103        }
12104    );
12105
12106    return 1;
12107}
12108
12109#*******************************************
12110# Function : do_d_describe
12111# Description : Saves the description of
12112#               the file
12113#******************************************
12114
12115sub do_d_describe {
12116    wwslog('info', '(%s, %s)', $in{'path'}, $in{'content'});
12117
12118    my $path = $in{'path'};
12119
12120    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
12121    # The description file of repository root doesn't exist.
12122    unless ($shared_doc
12123        and -r $shared_doc->{fs_path}
12124        and $shared_doc->{type} ne 'root') {
12125        Sympa::WWW::Report::reject_report_web('user', 'no_doc_to_describe',
12126            {'path' => $path},
12127            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12128        wwslog('info', 'Cannot describe %s', $path);
12129        web_db_log(
12130            {   'parameters' => $in{'path'},
12131                'status'     => 'error',
12132                'error_type' => 'no_file'
12133            }
12134        );
12135        return undef;
12136    }
12137    $param->{shared_doc} = $shared_doc->as_hashref;
12138
12139    # Access control.
12140    my %access = $shared_doc->get_privileges(
12141        mode             => 'edit',
12142        sender           => $param->{'user'}{'email'},
12143        auth_method      => $param->{'auth_method'},
12144        scenario_context => {
12145            sender      => $param->{'user'}{'email'},
12146            remote_host => $param->{'remote_host'},
12147            remote_addr => $param->{'remote_addr'}
12148        }
12149    );
12150    unless ($access{may}{edit}) {
12151        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
12152            {}, $param->{'action'}, $list);
12153        wwslog('info', 'Access denied for %s', $param->{'user'}{'email'});
12154        web_db_log(
12155            {   'parameters' => $in{'path'},
12156                'status'     => 'error',
12157                'error_type' => 'authorization'
12158            }
12159        );
12160        return undef;
12161    }
12162
12163    ## End of controls
12164
12165    if (defined $in{'content'} and $in{'content'} =~ /\S/) {
12166        $shared_doc->{title} = $in{'content'};
12167
12168        if (exists $shared_doc->{serial_desc}
12169            and defined $shared_doc->{serial_desc}) {
12170            # If description file already exists: Open it and modify it.
12171            # Synchronization
12172            unless ($shared_doc->{serial_desc} == $in{'serial'}) {
12173                Sympa::WWW::Report::reject_report_web('user',
12174                    'synchro_failed', {}, $param->{'action'}, $list);
12175                wwslog('info', 'Synchronization failed for description of %s',
12176                    $shared_doc);
12177                web_db_log(
12178                    {   'parameters' => $in{'path'},
12179                        'status'     => 'error',
12180                        'error_type' => 'internal'
12181                    }
12182                );
12183                return undef;
12184            }
12185        } else {
12186            $shared_doc->{scenario} = $access{scenario};
12187        }
12188
12189        # Fill the description file.
12190        unless ($shared_doc->save_description) {
12191            wwslog('info', 'Cannot save description of %s: %s',
12192                $shared_doc, $ERRNO);
12193            Sympa::WWW::Report::reject_report_web('intern',
12194                'cannot_open_file', {'path' => $path},
12195                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12196            web_db_log(
12197                {   'parameters' => $in{'path'},
12198                    'status'     => 'error',
12199                    'error_type' => 'internal'
12200                }
12201            );
12202            return undef;
12203        }
12204
12205        $in{'path'} = join '/', @{$shared_doc->{parent}->{paths}};
12206    }
12207
12208    web_db_log(
12209        {   'parameters' => $in{'path'},
12210            'status'     => 'success'
12211        }
12212    );
12213
12214    return 'd_read';
12215}
12216
12217#*******************************************
12218# Function : do_d_update
12219# Description : Overwrites existing file.
12220#******************************************
12221# Old names: do_d_savefile() and do_d_overwrite().
12222sub do_d_update {
12223    wwslog('info', '(%s, %s)', $in{'path'}, $in{'type'});
12224
12225    my $path = $in{'path'};
12226    my $type = $in{'type'} || 'file';
12227
12228    my $content;
12229    if ($type eq 'upload') {
12230        # Parameters of the uploaded file.
12231        my $fh = $query->upload('uploaded_file');
12232        if (defined $fh) {
12233            my $ioh = $fh->handle;
12234            $content = do { local $RS; <$ioh> };
12235        }
12236    } elsif ($type eq 'url') {
12237        $content = sprintf "%s\n", $in{'url'} if $in{'url'};
12238    } else {
12239        $content = $in{'content'};
12240    }
12241    unless (defined $content
12242        and ($type eq 'upload' and length $content or $content =~ /\S/)) {
12243        Sympa::WWW::Report::reject_report_web('user', 'no_content', {},
12244            $param->{'action'}, $list);
12245        wwslog('err', 'Cannot save file %s: no content', $path);
12246        web_db_log(
12247            {   'parameters' => $in{'path'},
12248                'status'     => 'error',
12249                'error_type' => 'missing_parameter'
12250            }
12251        );
12252        return undef;
12253    }
12254
12255    my $shared_doc =
12256        Sympa::WWW::SharedDocument->new($list, $path, allow_empty => 1);
12257    # Existing document? File?
12258    unless ($shared_doc
12259        and -r $shared_doc->{fs_path}
12260        and -w $shared_doc->{fs_path}
12261        and not(grep { $shared_doc->{type} eq $_ } qw(root directory))) {
12262        wwslog('err', 'Unable to read %s: no such file or directory', $path);
12263        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
12264            {'path' => $path},
12265            $param->{'action'}, $list);
12266        web_db_log(
12267            {   'parameters' => $in{'path'},
12268                'status'     => 'error',
12269                'error_type' => 'internal'
12270            }
12271        );
12272        return undef;
12273    }
12274    $param->{shared_doc} = $shared_doc->as_hashref;
12275
12276    # Access control.
12277    my %access = $shared_doc->get_privileges(
12278        mode             => 'edit',
12279        sender           => $param->{'user'}{'email'},
12280        auth_method      => $param->{'auth_method'},
12281        scenario_context => {
12282            sender      => $param->{'user'}{'email'},
12283            remote_host => $param->{'remote_host'},
12284            remote_addr => $param->{'remote_addr'}
12285        }
12286    );
12287    unless ($access{may}{edit}) {
12288        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
12289            {}, $param->{'action'}, $list);
12290        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
12291        web_db_log(
12292            {   'parameters' => $in{'path'},
12293                'status'     => 'error',
12294                'error_type' => 'authorization'
12295            }
12296        );
12297        return undef;
12298    }
12299
12300    # Synchronization
12301    unless ($type eq 'url') {    # Only for files.
12302        unless ($shared_doc->{date_epoch} == $in{'serial'}) {
12303            Sympa::WWW::Report::reject_report_web('user', 'synchro_failed',
12304                {}, $param->{'action'}, $list);
12305            wwslog('err', 'Synchronization failed for %s', $shared_doc);
12306            web_db_log(
12307                {   'parameters' => $in{'path'},
12308                    'status'     => 'error',
12309                    'error_type' => 'internal'
12310                }
12311            );
12312            return undef;
12313        }
12314    }
12315
12316    # Renaming of the old file
12317    # Isn't url ?
12318    rename $shared_doc->{fs_path}, $shared_doc->{fs_path} . '.old';
12319
12320    # Creation of the shared file
12321    my $ofh;
12322    unless (open $ofh, '>', $shared_doc->{fs_path}) {
12323        my $errno = $ERRNO;
12324        rename $shared_doc->{fs_path} . '.old', $shared_doc->{fs_path};
12325        Sympa::WWW::Report::reject_report_web(
12326            'user',
12327            'cannot_overwrite',
12328            {   'reason' => $errno,
12329                'path'   => $path
12330            },
12331            $param->{'action'},
12332            $list
12333        );
12334        wwslog('err', 'Cannot open for replace %s: %s', $shared_doc, $errno);
12335        web_db_log(
12336            {   'parameters' => $in{'path'},
12337                'status'     => 'error',
12338                'error_type' => 'internal'
12339            }
12340        );
12341        return undef;
12342    }
12343    print $ofh $content;
12344    close $ofh;
12345
12346    unlink $shared_doc->{fs_path} . '.old';
12347
12348    $shared_doc->{scenario} ||= $access{scenario};
12349    $shared_doc->{owner} = $param->{'user'}{'email'};
12350    $shared_doc->{date_epoch} =
12351        Sympa::Tools::File::get_mtime($shared_doc->{fs_path});
12352    $shared_doc->save_description;
12353
12354    $in{'list'} = $list->{'name'};
12355
12356    Sympa::WWW::Report::notice_report_web('save_success', {'path' => $path},
12357        $param->{'action'});
12358    web_db_log(
12359        {   'parameters' => $in{'path'},
12360            'status'     => 'success'
12361        }
12362    );
12363
12364    if ($in{'previous_action'}) {
12365        return $in{'previous_action'};
12366    } else {
12367        $in{'path'} = $param->{'path'} = join '/',
12368            @{$shared_doc->{parent}->{paths}};
12369        return 'd_read';
12370    }
12371}
12372
12373# Merged to do_d_update().
12374#sub do_d_overwrite;
12375
12376# Merged to do_d_create_child().
12377#sub do_d_upload;
12378
12379## Creation of a picture file
12380sub creation_picture_file {
12381    my $path  = shift;
12382    my $fname = shift;
12383
12384    unless (-d $path) {
12385        wwslog('notice', 'Create dir %s/', $path);
12386
12387        unless (Sympa::Tools::File::mkdir_all($path, 0755)) {
12388            wwslog('err', 'Unable to create dir %s/', $path);
12389            return undef;
12390        }
12391
12392        unless (open(FF, '>', $path . '/index.html')) {
12393            wwslog('err', 'Unable to create dir %s/index.html', $path);
12394        }
12395        chmod 0644, $path . '/index.html';
12396        close FF;
12397    }
12398
12399    my $fh = $query->upload('uploaded_file');
12400    unless (open FILE, '>:bytes', "$path/$fname") {
12401        Sympa::WWW::Report::reject_report_web('intern', 'cannot_upload',
12402            {'path' => "$path/$fname"},
12403            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12404        wwslog('err', 'Cannot open file %s/%s: %s', $path, $fname, $ERRNO);
12405        return undef;
12406    }
12407    while (<$fh>) {
12408        print FILE;
12409    }
12410    close FILE;
12411    chmod 0644, "$path/$fname";
12412}
12413
12414# No longer used (subroutine of deprecated do_d_upload()).
12415#sub creation_shared_file;
12416
12417# No longer used (subroutine of deprecated do_d_upload()).
12418#sub creation_desc_file;
12419
12420#*******************************************
12421# Function : do_d_unzip
12422# Description : unzip a file or a tree structure
12423#               from an uploaded zip file
12424#******************************************
12425
12426sub do_d_unzip {
12427    wwslog('info', '(%s, %s)', $in{'path'});
12428
12429    my $path = $in{'path'};
12430
12431    my $zip_name;
12432    my $fn = $in{'uploaded_file'};
12433    if (defined $fn) {
12434        # Guess client charset.
12435        $zip_name =
12436            Sympa::Tools::Text::guessed_to_utf8($fn,
12437            Sympa::Language::implicated_langs($language->get_lang));
12438        # Name without path.
12439        $zip_name = $1 if $zip_name =~ /([^\/\\]+)$/;
12440    }
12441    unless ($zip_name and $zip_name =~ /.+[.]zip\z/i) {
12442        Sympa::WWW::Report::reject_report_web(
12443            'user',
12444            'incorrect_name',
12445            {   'name'   => $zip_name,
12446                'reason' => "must have the '.zip' extension"
12447            },
12448            $param->{'action'},
12449            $list
12450        );
12451        wwslog('err', '(%s, %s) The file must have ".zip" extension',
12452            $path, $zip_name);
12453        web_db_log(
12454            {   'robot'        => $robot,
12455                'list'         => $list->{'name'},
12456                'action'       => $param->{'action'},
12457                'parameters'   => "$in{'path'}",
12458                'target_email' => "",
12459                'msg_id'       => '',
12460                'status'       => 'error',
12461                'error_type'   => 'bad_parameter',
12462                'user_email'   => $param->{'user'}{'email'},
12463            }
12464        );
12465        return undef;
12466    }
12467
12468    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
12469    # The file must be uploaded in a directory existing.
12470    unless ($shared_doc
12471        and -r $shared_doc->{fs_path}
12472        and -w $shared_doc->{fs_path}
12473        and grep { $shared_doc->{type} eq $_ } qw(root directory)) {
12474        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
12475            {'path' => $path},
12476            $param->{'action'}, $list);
12477        wwslog('err', '%s: Not a directory', $path);
12478        web_db_log(
12479            {   'robot'        => $robot,
12480                'list'         => $list->{'name'},
12481                'action'       => $param->{'action'},
12482                'parameters'   => "$in{'path'}",
12483                'target_email' => "",
12484                'msg_id'       => '',
12485                'status'       => 'error',
12486                'error_type'   => 'internal',
12487                'user_email'   => $param->{'user'}{'email'},
12488            }
12489        );
12490        return undef;
12491    }
12492    $param->{shared_doc} = $shared_doc->as_hashref;
12493
12494    # Access control for the directory where there is the uploading
12495    # only for (is_author || !moderated)
12496    my %access = $shared_doc->get_privileges(
12497        mode             => 'edit',
12498        sender           => $param->{'user'}{'email'},
12499        auth_method      => $param->{'auth_method'},
12500        scenario_context => {
12501            sender      => $param->{'user'}{'email'},
12502            remote_host => $param->{'remote_host'},
12503            remote_addr => $param->{'remote_addr'}
12504        }
12505    );
12506    unless ($access{may}{edit} and $access{may}{edit} == 1) {
12507        Sympa::WWW::Report::reject_report_web('auth',
12508            ($access{reason}{edit} || 'edit_moderated'),
12509            {}, $param->{'action'}, $list);
12510        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
12511        web_db_log(
12512            {   'robot'        => $robot,
12513                'list'         => $list->{'name'},
12514                'action'       => $param->{'action'},
12515                'parameters'   => "$in{'path'}",
12516                'target_email' => "",
12517                'msg_id'       => '',
12518                'status'       => 'error',
12519                'error_type'   => 'authorization',
12520                'user_email'   => $param->{'user'}{'email'},
12521            }
12522        );
12523        return undef;
12524    }
12525
12526    # Check quota.
12527    if ($list->{'admin'}{'shared_doc'}{'quota'}) {
12528        if (Sympa::WWW::SharedDocument->new($list)->get_size >=
12529            $list->{'admin'}{'shared_doc'}{'quota'} * 1024) {
12530            Sympa::WWW::Report::reject_report_web('user', 'shared_full', {},
12531                $param->{'action'}, $list);
12532            wwslog('err', 'Shared Quota exceeded for list %s', $list);
12533            web_db_log(
12534                {   'robot'        => $robot,
12535                    'list'         => $list->{'name'},
12536                    'action'       => $param->{'action'},
12537                    'parameters'   => "$in{'path'}",
12538                    'target_email' => "",
12539                    'msg_id'       => '',
12540                    'status'       => 'error',
12541                    'error_type'   => 'shared_full',
12542                    'user_email'   => $param->{'user'}{'email'},
12543                }
12544            );
12545            return undef;
12546        }
12547    }
12548
12549    # Uploaded of the file.zip
12550    my ($zip, $az);
12551    my $fh = $query->upload('uploaded_file');
12552    if (defined $fh) {
12553        my $ioh = $fh->handle;
12554        # The handle must know seek() and so on in addition to opened().
12555        # CGI derives handles from IO::Handle and/or File::Temp which lack
12556        # some of methods.  That's why destructive bless-ing is here.
12557        bless $ioh => 'IO::File';
12558        $zip = Archive::Zip->new();
12559        $az  = $zip->readFromFileHandle($ioh);
12560    }
12561    unless (defined $az and $az == Archive::Zip::AZ_OK()) {
12562        Sympa::WWW::Report::reject_report_web('intern', 'cannot_unzip',
12563            {name => $zip_name},
12564            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12565        wwslog('err', 'Unable to read the zip file: %s', $az);
12566        web_db_log(
12567            {   'robot'        => $robot,
12568                'list'         => $list->{'name'},
12569                'action'       => $param->{'action'},
12570                'parameters'   => $in{'path'},
12571                'target_email' => "",
12572                'msg_id'       => '',
12573                'status'       => 'error',
12574                'error_type'   => 'internal',
12575                'user_email'   => $param->{'user'}{'email'},
12576            }
12577        );
12578        return undef;
12579    }
12580
12581    my $status = 1;
12582    my %subpaths;
12583    my @langs = Sympa::Language::implicated_langs($language->get_lang);
12584    foreach my $member ($zip->members) {
12585        next if $member->isEncrypted;
12586
12587        my @subpaths = split m{/+},
12588            Sympa::Tools::Text::guessed_to_utf8($member->fileName, @langs);
12589        next unless @subpaths;
12590        my $name;
12591        unless ($member->isDirectory) {
12592            $name = pop @subpaths;
12593            $name = $language->gettext('New file')
12594                unless Sympa::WWW::SharedDocument::valid_name($name);
12595        }
12596        foreach my $p (@subpaths) {
12597            $p = $language->gettext('New directory')
12598                unless Sympa::WWW::SharedDocument::valid_name($p);
12599        }
12600        unless ($member->isDirectory) {
12601            push @subpaths, $name;
12602        }
12603
12604        # Does file alreay exist?
12605        if (Sympa::WWW::SharedDocument->new(
12606                $list, [@{$shared_doc->{paths}}, @subpaths]
12607            )
12608        ) {
12609            Sympa::WWW::Report::reject_report_web('user', 'doc_already_exist',
12610                {'name' => join('/', @subpaths)},
12611                $param->{'action'}, $list);
12612            wwslog(
12613                'err',
12614                'Can\'t create %s: file already exists',
12615                join('/', @subpaths)
12616            );
12617            web_db_log(
12618                {   'robot'        => $robot,
12619                    'list'         => $list->{'name'},
12620                    'action'       => $param->{'action'},
12621                    'parameters'   => join('/', @subpaths),
12622                    'target_email' => "",
12623                    'msg_id'       => '',
12624                    'status'       => 'error',
12625                    'error_type'   => 'file_already_exists',
12626                    'user_email'   => $param->{'user'}{'email'},
12627                }
12628            );
12629            return undef;
12630        }
12631
12632        $subpaths{$member->fileName} = [@subpaths];
12633    }
12634    foreach my $member ($zip->members) {
12635        next if $member->isEncrypted;
12636
12637        my $subpaths = $subpaths{$member->fileName};
12638        next unless $subpaths and @$subpaths;
12639
12640        my ($content, $az);
12641        unless ($member->isDirectory) {
12642            ($content, $az) = $member->contents;
12643            unless (defined $az and $az == Archive::Zip::AZ_OK()) {
12644                wwslog('err',
12645                    'Unable to extract member %s of the zip file: %s',
12646                    $member->fileName, $az);
12647                web_db_log(
12648                    {   'robot'        => $robot,
12649                        'list'         => $list->{'name'},
12650                        'action'       => $param->{'action'},
12651                        'parameters'   => $member->fileName,
12652                        'target_email' => "",
12653                        'msg_id'       => '',
12654                        'status'       => 'error',
12655                        'error_type'   => 'internal',
12656                        'user_email'   => $param->{'user'}{'email'},
12657                    }
12658                );
12659                $status = 0;
12660                next;
12661            }
12662        }
12663        unless (
12664            _d_create_descendant(
12665                $shared_doc, $subpaths,
12666                owner    => $param->{'user'}{'email'},
12667                scenario => $access{scenario},
12668                type     => ($member->isDirectory ? 'directory' : 'file'),
12669                ($member->isDirectory ? () : (content => $content))
12670            )
12671        ) {
12672            wwslog('err',
12673                'Unable to create member %s of the zip file as %s: %s',
12674                $member->fileName, join('/', @$subpaths));
12675            web_db_log(
12676                {   'robot'        => $robot,
12677                    'list'         => $list->{'name'},
12678                    'action'       => $param->{'action'},
12679                    'parameters'   => $member->fileName,
12680                    'target_email' => "",
12681                    'msg_id'       => '',
12682                    'status'       => 'error',
12683                    'error_type'   => 'internal',
12684                    'user_email'   => $param->{'user'}{'email'},
12685                }
12686            );
12687            $status = 0;
12688        }
12689    }
12690    unless ($status) {
12691        Sympa::WWW::Report::reject_report_web('intern', 'cannot_unzip',
12692            {name => $zip_name},
12693            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12694    }
12695
12696    $in{'list'} = $list->{'name'};
12697
12698    Sympa::WWW::Report::notice_report_web('unzip_success',
12699        {'path' => $zip_name},
12700        $param->{'action'});
12701    web_db_log(
12702        {   'robot'        => $robot,
12703            'list'         => $list->{'name'},
12704            'action'       => $param->{'action'},
12705            'parameters'   => "$in{'path'}",
12706            'target_email' => "",
12707            'msg_id'       => '',
12708            'status'       => 'success',
12709            'error_type'   => '',
12710            'user_email'   => $param->{'user'}{'email'},
12711        }
12712    );
12713    return 'd_read';
12714}
12715
12716sub _d_create_descendant {
12717    my $shared_doc = shift;
12718    my $subpaths   = shift;
12719    my %opts       = @_;
12720
12721    return $shared_doc unless @$subpaths;
12722
12723    my $parent_subpaths = [@$subpaths];
12724    my $new_name        = pop @$parent_subpaths;
12725    my $parent          = _d_create_descendant($shared_doc, $parent_subpaths,
12726        %opts, type => 'directory');
12727    return undef unless $parent;
12728
12729    my ($child) = $parent->get_children(name => $new_name);
12730    if ($child) {
12731        if ($opts{type} eq 'file') {
12732            # Duplicate file: Add a suffix (2), (3), ...
12733            my ($g, $alt_name);
12734            for ($g = 2; $child; $g++) {
12735                $alt_name = $new_name;
12736                $alt_name =~ s/((?:[.]\w+)+)\z/ ($g)$1/
12737                    or $alt_name = "$new_name ($g)";
12738                ($child) = $parent->get_children(name => $alt_name);
12739            }
12740            $new_name = $alt_name;
12741        } elsif ($child->{type} ne 'directory') {
12742            # Non-directory with the same name: Add a suffix (2), (3), ...
12743            my ($g, $alt_name);
12744            for ($g = 2; $child && $child->{type} ne 'directory'; $g++) {
12745                $alt_name = "$new_name ($g)";
12746                ($child) = $parent->get_children(name => $alt_name);
12747            }
12748            return $child if $child;
12749            $new_name = $alt_name;
12750        } else {
12751            # Directory already exists.
12752            return $child;
12753        }
12754    }
12755
12756    return $parent->create_child($new_name, %opts);
12757}
12758
12759# Unzip a shared file in the tmp directory.
12760# No longer used.
12761#sub d_unzip_shared_file;
12762
12763## Install file hierarchy from $tmp_dir directory to $shareddir/$path
12764## directory
12765# No longer used.
12766#sub d_install_file_hierarchy;
12767
12768## copy $dname from $from to $list->{shared}/$path if rights are ok
12769# No longer used.
12770#sub d_copy_rec_dir;
12771
12772## copy $from/$fname to $list->{shared}/$path if rights are ok
12773# No longer used.
12774#sub d_copy_file;
12775
12776## return information on file or dir : existing and edit rights for the user
12777## in $param
12778# No longer used.
12779#sub d_test_existing_and_rights;
12780
12781#*******************************************
12782# Function : do_d_delete
12783# Description : Delete an existing document
12784#               (file or directory)
12785#******************************************
12786
12787sub do_d_delete {
12788    wwslog('info', '(%s)', $in{'path'});
12789
12790    my $path = $in{'path'};
12791
12792    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
12793    # Document exists?
12794    unless ($shared_doc
12795        and -r $shared_doc->{fs_path}
12796        and $shared_doc->{type} ne 'root') {
12797        wwslog('err', '%s: no such file or directory', $path);
12798        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
12799            {'path' => $path},
12800            $param->{'action'}, $list);
12801        web_db_log(
12802            {   'robot'        => $robot,
12803                'list'         => $list->{'name'},
12804                'action'       => $param->{'action'},
12805                'parameters'   => "$in{'path'}",
12806                'target_email' => "",
12807                'msg_id'       => '',
12808                'status'       => 'error',
12809                'error_type'   => 'internal',
12810                'user_email'   => $param->{'user'}{'email'},
12811            }
12812        );
12813        return undef;
12814    }
12815    $param->{'shared_doc'} = $shared_doc->as_hashref;
12816
12817    # Access control.
12818    my %access;
12819    if ($shared_doc) {
12820        %access = $shared_doc->get_privileges(
12821            mode             => 'edit',
12822            sender           => $param->{'user'}{'email'},
12823            auth_method      => $param->{'auth_method'},
12824            scenario_context => {
12825                sender      => $param->{'user'}{'email'},
12826                remote_host => $param->{'remote_host'},
12827                remote_addr => $param->{'remote_addr'}
12828            }
12829        );
12830    }
12831    unless ($access{may}{edit}) {
12832        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
12833            {}, $param->{'action'}, $list);
12834        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
12835        web_db_log(
12836            {   'robot'        => $robot,
12837                'list'         => $list->{'name'},
12838                'action'       => $param->{'action'},
12839                'parameters'   => "$in{'path'}",
12840                'target_email' => "",
12841                'msg_id'       => '',
12842                'status'       => 'error',
12843                'error_type'   => 'authorization',
12844                'user_email'   => $param->{'user'}{'email'},
12845            }
12846        );
12847        return undef;
12848    }
12849
12850    # End of control
12851
12852    # Action confirmed?
12853    my $next_action = $session->confirm_action(
12854        $in{'action'}, $in{'response_action'},
12855        arg             => join('/', @{$shared_doc->{paths}}),
12856        previous_action => ($in{'previous_action'} || 'd_read')
12857    );
12858    return $next_action unless $next_action eq '1';
12859
12860    if ($shared_doc->{type} eq 'directory') {
12861        # Directory.
12862        unless ($shared_doc->rmdir) {
12863            my $errno = $ERRNO;
12864            Sympa::WWW::Report::reject_report_web('intern', 'erase_file',
12865                {'file' => $path},
12866                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12867            wwslog('err', 'Failed to erase %s: %s', $shared_doc, $errno);
12868            web_db_log(
12869                {   'robot'        => $robot,
12870                    'list'         => $list->{'name'},
12871                    'action'       => $param->{'action'},
12872                    'parameters'   => "$in{'path'}",
12873                    'target_email' => "",
12874                    'msg_id'       => '',
12875                    'status'       => 'error',
12876                    'error_type'   => 'internal',
12877                    'user_email'   => $param->{'user'}{'email'},
12878                }
12879            );
12880            return undef;
12881        }
12882    } else {
12883        # Removing of the document.
12884        unless ($shared_doc->unlink) {
12885            my $errno = $ERRNO;
12886            Sympa::WWW::Report::reject_report_web('intern', 'erase_file',
12887                {'file' => $path},
12888                $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
12889            wwslog('err', 'Failed to erase %s: %s', $shared_doc, $errno);
12890            web_db_log(
12891                {   'robot'        => $robot,
12892                    'list'         => $list->{'name'},
12893                    'action'       => $param->{'action'},
12894                    'parameters'   => "$in{'path'}",
12895                    'target_email' => "",
12896                    'msg_id'       => '',
12897                    'status'       => 'error',
12898                    'error_type'   => 'internal',
12899                    'user_email'   => $param->{'user'}{'email'},
12900                }
12901            );
12902            return undef;
12903        }
12904    }
12905    web_db_log(
12906        {   'robot'        => $robot,
12907            'list'         => $list->{'name'},
12908            'action'       => $param->{'action'},
12909            'parameters'   => "$in{'path'}",
12910            'target_email' => "",
12911            'msg_id'       => '',
12912            'status'       => 'success',
12913            'error_type'   => '',
12914            'user_email'   => $param->{'user'}{'email'},
12915        }
12916    );
12917
12918    web_db_stat_log();
12919
12920    $in{'list'} = $list->{'name'};
12921    $in{'path'} = join '/', @{$shared_doc->{parent}->{paths}};
12922    return 'd_read';
12923}
12924
12925#*******************************************
12926# Function : do_d_rename
12927# Description : Rename a document
12928#               (file or directory)
12929#******************************************
12930
12931sub do_d_rename {
12932    wwslog('info', '(%s, %s)', $in{'path'}, $in{'new_name'});
12933
12934    my $path = $in{'path'};
12935
12936    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
12937    # Document exists?
12938    unless ($shared_doc and -e $shared_doc->{fs_path}) {
12939        wwslog('err', '%s: no such file or directory', $path);
12940        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
12941            {'path' => $path},
12942            $param->{'action'}, $list);
12943        web_db_log(
12944            {   'robot'        => $robot,
12945                'list'         => $list->{'name'},
12946                'action'       => $param->{'action'},
12947                'parameters'   => "$in{'path'}",
12948                'target_email' => "",
12949                'msg_id'       => '',
12950                'status'       => 'error',
12951                'error_type'   => 'no_such_document',
12952                'user_email'   => $param->{'user'}{'email'},
12953            }
12954        );
12955        return undef;
12956    }
12957    $param->{'shared_doc'} = $shared_doc->as_hashref;
12958
12959    # Access control.
12960    my %access = $shared_doc->get_privileges(
12961        mode             => 'edit',
12962        sender           => $param->{'user'}{'email'},
12963        auth_method      => $param->{'auth_method'},
12964        scenario_context => {
12965            sender      => $param->{'user'}{'email'},
12966            remote_host => $param->{'remote_host'},
12967            remote_addr => $param->{'remote_addr'}
12968        }
12969    );
12970    unless ($access{may}{edit}) {
12971        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
12972            {}, $param->{'action'}, $list);
12973        wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
12974        web_db_log(
12975            {   'robot'        => $robot,
12976                'list'         => $list->{'name'},
12977                'action'       => $param->{'action'},
12978                'parameters'   => "$in{'path'}",
12979                'target_email' => "",
12980                'msg_id'       => '',
12981                'status'       => 'error',
12982                'error_type'   => 'authorization',
12983                'user_email'   => $param->{'user'}{'email'},
12984            }
12985        );
12986        return undef;
12987    }
12988
12989    unless ($shared_doc->rename($in{'new_name'})) {
12990        my $errno = $ERRNO;
12991        Sympa::WWW::Report::reject_report_web(
12992            'intern',
12993            'rename_file',
12994            {   'old' => join('/', $shared_doc->{paths}),
12995                'new' => $in{'new_name'}
12996            },
12997            $param->{'action'},
12998            $list,
12999            $param->{'user'}{'email'},
13000            $robot
13001        );
13002        wwslog('err', 'Failed to rename %s to %s: %s',
13003            $shared_doc, $in{'new_name'}, $errno);
13004        web_db_log(
13005            {   'robot'        => $robot,
13006                'list'         => $list->{'name'},
13007                'action'       => $param->{'action'},
13008                'parameters'   => "$in{'path'}",
13009                'target_email' => "",
13010                'msg_id'       => '',
13011                'status'       => 'error',
13012                'error_type'   => 'internal',
13013                'user_email'   => $param->{'user'}{'email'},
13014            }
13015        );
13016        return undef;
13017    }
13018
13019    web_db_log(
13020        {   'robot'        => $robot,
13021            'list'         => $list->{'name'},
13022            'action'       => $param->{'action'},
13023            'parameters'   => "$in{'path'}",
13024            'target_email' => "",
13025            'msg_id'       => '',
13026            'status'       => 'success',
13027            'error_type'   => '',
13028            'user_email'   => $param->{'user'}{'email'},
13029        }
13030    );
13031
13032    $in{'list'} = $list->{'name'};
13033
13034    $in{'path'} = join '/', @{$shared_doc->{parent}->{paths}};
13035    return 'd_read';
13036}
13037
13038#*******************************************
13039# Function : do_d_create_child
13040# Description : Creates a new file / directory
13041#******************************************
13042# Old names: do_d_create_dir() and do_d_upload().
13043sub do_d_create_child {
13044    wwslog('info', '(%s, %s, %s)', $in{'path'}, $in{'new_name'}, $in{'type'});
13045
13046    my $path     = $in{'path'};
13047    my $new_name = $in{'new_name'};
13048    my $type     = $in{'type'} || 'directory';
13049
13050    my $content;
13051    if ($type eq 'upload') {
13052        my $fh = $query->upload('uploaded_file');
13053        if (defined $fh) {
13054            my $ioh = $fh->handle;
13055            $content = do { local $RS; <$ioh> };
13056        }
13057        my $fn = $query->upload('uploaded_file');
13058        if (defined $fn) {
13059            # Guess client encoding.
13060            $new_name =
13061                Sympa::Tools::Text::guessed_to_utf8($fn,
13062                Sympa::Language::implicated_langs($language->get_lang));
13063            # Name without path.
13064            $new_name = $1 if $new_name =~ m{([^/\\]+)\z};
13065            # Avoid invalid names.
13066            $new_name = $language->gettext('New file')
13067                unless Sympa::WWW::SharedDocument::valid_name($new_name);
13068        }
13069    } elsif ($type eq 'url') {
13070        $content = sprintf "%s\n", $in{'url'} if $in{'url'};
13071
13072        $new_name = $language->gettext('New bookmark')
13073            unless Sympa::WWW::SharedDocument::valid_name($new_name);
13074        $new_name = $new_name . '.url';
13075    }
13076
13077    wwslog('info', '(%s, %s, %s)', $path, $new_name, $type);
13078
13079    $param->{'list'} = $list->{'name'};
13080
13081    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
13082    unless ($shared_doc
13083        and -r $shared_doc->{fs_path}
13084        and -w $shared_doc->{fs_path}
13085        and grep { $shared_doc->{type} eq $_ } qw(root directory)) {
13086        wwslog('err', 'Unable to read %s: no such directory', $path);
13087        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
13088            {'path' => $path},
13089            $param->{'action'}, $list);
13090        web_db_log(
13091            {   'parameters' => $in{'path'},
13092                'status'     => 'error',
13093                'error_type' => 'internal'
13094            }
13095        );
13096        return undef;
13097    }
13098    $param->{shared_doc} = $shared_doc->as_hashref;
13099
13100    # Access control.
13101    my %access = $shared_doc->get_privileges(
13102        mode             => 'edit,control',
13103        sender           => $param->{'user'}{'email'},
13104        auth_method      => $param->{'auth_method'},
13105        scenario_context => {
13106            sender      => $param->{'user'}{'email'},
13107            remote_host => $param->{'remote_host'},
13108            remote_addr => $param->{'remote_addr'}
13109        }
13110    );
13111
13112    if ($type eq 'directory') {    # only when (is_author or !moderated)
13113        unless ($access{may}{edit}) {
13114            Sympa::WWW::Report::reject_report_web('auth',
13115                $access{reason}{edit},
13116                {}, $param->{'action'}, $list);
13117            wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
13118            web_db_log(
13119                {   'robot'        => $robot,
13120                    'list'         => $list->{'name'},
13121                    'action'       => $param->{'action'},
13122                    'parameters'   => "$in{'new_name'}",
13123                    'target_email' => "",
13124                    'msg_id'       => '',
13125                    'status'       => 'error',
13126                    'error_type'   => 'authorization',
13127                    'user_email'   => $param->{'user'}{'email'},
13128                }
13129            );
13130            return undef;
13131        }
13132        if ($access{may}{edit} == 0.5) {
13133            Sympa::WWW::Report::reject_report_web('auth',
13134                'dir_edit_moderated', {}, $param->{'action'}, $list);
13135            wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
13136            web_db_log(
13137                {   'robot'        => $robot,
13138                    'list'         => $list->{'name'},
13139                    'action'       => $param->{'action'},
13140                    'parameters'   => "$in{'new_name'}",
13141                    'target_email' => "",
13142                    'msg_id'       => '',
13143                    'status'       => 'error',
13144                    'error_type'   => 'authorization',
13145                    'user_email'   => $param->{'user'}{'email'},
13146                }
13147            );
13148            return undef;
13149        }
13150    } else {
13151        unless ($access{may}{edit}) {
13152            Sympa::WWW::Report::reject_report_web('auth',
13153                $access{reason}{edit},
13154                {}, $param->{'action'}, $list);
13155            wwslog('err', 'Access denied for %s', $param->{'user'}{'email'});
13156            web_db_log(
13157                {   'robot'        => $robot,
13158                    'list'         => $list->{'name'},
13159                    'action'       => $param->{'action'},
13160                    'parameters'   => "$in{'new_name'}",
13161                    'target_email' => "",
13162                    'msg_id'       => '',
13163                    'status'       => 'error',
13164                    'error_type'   => 'authorization',
13165                    'user_email'   => $param->{'user'}{'email'},
13166                }
13167            );
13168            return undef;
13169        }
13170
13171        # Exception for index.html.
13172        if (    $type eq 'upload'
13173            and $new_name =~ /\Aindex[.]html?\z/i
13174            and not $access{may}{control}) {
13175            Sympa::WWW::Report::reject_report_web('user', 'index_html',
13176                {dir => $path, reason => 'd_access_control'},
13177                $param->{'action'}, $list);
13178            wwslog('err', 'Not authorized to upload a INDEX.HTML file in %s',
13179                $path);
13180            web_db_log(
13181                {   'robot'        => $robot,
13182                    'list'         => $list->{'name'},
13183                    'action'       => $param->{'action'},
13184                    'parameters'   => "$path,$new_name",
13185                    'target_email' => "",
13186                    'msg_id'       => '',
13187                    'status'       => 'error',
13188                    'error_type'   => 'authorization',
13189                    'user_email'   => $param->{'user'}{'email'},
13190                }
13191            );
13192            return undef;
13193        }
13194    }
13195
13196    my ($child) = $shared_doc->get_children(name => $new_name);
13197
13198    # The file mustn't already exist except if:
13199    # - it is uploaded,
13200    # - it is moderated and its author can erase it.
13201    if ($child) {
13202        if ($type eq 'upload') {
13203            # Add a suffix (2), (3), ...
13204            my ($g, $alt_name);
13205            for ($g = 2; $child; $g++) {
13206                $alt_name = $new_name;
13207                $alt_name =~ s/((?:[.]\w+)+)\z/ ($g)$1/
13208                    or $alt_name = "$new_name ($g)";
13209                $child = $shared_doc->get_children(name => $alt_name);
13210            }
13211            $new_name = $alt_name;
13212        } elsif (not $child->{moderate}
13213            or $child->{owner} ne $param->{'user'}{'email'}) {
13214            Sympa::WWW::Report::reject_report_web('user', 'doc_already_exist',
13215                {'name' => $path . '/' . $new_name},
13216                $param->{'action'}, $list);
13217            wwslog('err', 'Can\'t create %s/%s: file already exists',
13218                $path, $new_name);
13219            web_db_log(
13220                {   'robot'        => $robot,
13221                    'list'         => $list->{'name'},
13222                    'action'       => $param->{'action'},
13223                    'parameters'   => "$in{'new_name'}",
13224                    'target_email' => "",
13225                    'msg_id'       => '',
13226                    'status'       => 'error',
13227                    'error_type'   => 'file_already_exists',
13228                    'user_email'   => $param->{'user'}{'email'},
13229                }
13230            );
13231            return undef;
13232        }
13233    }
13234
13235    # Check quota.
13236    if ($type eq 'upload'    #FIXME:Check in other cases too.
13237        and $list->{'admin'}{'shared_doc'}{'quota'}
13238        and Sympa::WWW::SharedDocument->new($list)->get_size >=
13239        $list->{'admin'}{'shared_doc'}{'quota'} * 1024
13240    ) {
13241        Sympa::WWW::Report::reject_report_web('user', 'shared_full', {},
13242            $param->{'action'}, $list);
13243        wwslog('err', 'Shared Quota exceeded for list %s', $list);
13244        web_db_log(
13245            {   'robot'        => $robot,
13246                'list'         => $list->{'name'},
13247                'action'       => $param->{'action'},
13248                'parameters'   => "$path,$new_name",
13249                'target_email' => "",
13250                'msg_id'       => '',
13251                'status'       => 'error',
13252                'error_type'   => 'shared_full',
13253                'user_email'   => $param->{'user'}{'email'},
13254            }
13255        );
13256        return undef;
13257    }
13258
13259    # XSS Protection for HTML files.
13260    if ($type eq 'upload'    #FIXME:Check in other cases too.
13261        and $new_name =~ /[.]html?\z/i
13262    ) {
13263        my $sanitized_html =
13264            Sympa::HTMLSanitizer->new($robot)->sanitize_html($content);
13265        if (defined $sanitized_html) {
13266            $content = $sanitized_html;
13267        } else {
13268            $log->syslog('err', 'Unable to sanitize file %s', $new_name);
13269        }
13270    }
13271
13272    my $new_child = $shared_doc->create_child(
13273        $new_name,
13274        type     => ($type eq 'upload' ? 'file' : $type),
13275        moderate => ($access{may}{edit} == 0.5 && $type ne 'directory'),
13276        owner    => $param->{'user'}{'email'},
13277        scenario => $access{'scenario'},
13278        (($type eq 'upload' or $type eq 'url') ? (content => $content) : ())
13279    );
13280    unless ($new_child) {
13281        my $errno = $ERRNO;
13282        my $error_type;
13283        if ($errno == POSIX::EINVAL()) {
13284            # The name of the directory must be correct
13285            Sympa::WWW::Report::reject_report_web('user', 'incorrect_name',
13286                {'name' => $new_name},
13287                $param->{'action'}, $list);
13288            $error_type = 'bad_parameter';
13289        } else {
13290            Sympa::WWW::Report::reject_report_web('intern',
13291                'cannot_create_child', {'name' => $new_name},
13292                $param->{'action'}, $list);
13293            $error_type = 'intern';
13294        }
13295        wwslog('err', 'Unable to create directory %s: %s', $new_name, $errno);
13296        web_db_log(
13297            {   'robot'        => $robot,
13298                'list'         => $list->{'name'},
13299                'action'       => $param->{'action'},
13300                'parameters'   => "$in{'new_name'}",
13301                'target_email' => "",
13302                'msg_id'       => '',
13303                'status'       => 'error',
13304                'error_type'   => $error_type,
13305                'user_email'   => $param->{'user'}{'email'},
13306            }
13307        );
13308        return undef;
13309    }
13310
13311    # Moderation
13312    if ($access{may}{edit} == 0.5 and $type ne 'directory') {
13313        unless ($child and $child->{moderate}) {
13314            # Moderated at first time
13315            my @rcpt = $list->get_admins_email('receptive_editor');
13316            @rcpt = $list->get_admins_email('actual_editor') unless @rcpt;
13317            unless (@rcpt) {
13318                # Since shared document has already been marked moderated,
13319                # notification to editors should not fail. Fallback to
13320                # listmasters.
13321                $log->syslog(
13322                    'notice',
13323                    'No editor and owner defined at all in list %s; notification is sent to listmasters',
13324                    $list
13325                );
13326                @rcpt = Sympa::get_listmasters_email($list);
13327            }
13328
13329            Sympa::send_file(
13330                $list,
13331                'shared_moderate',
13332                \@rcpt,
13333                {   auto_submitted => 'auto-generated',
13334                    filename       => join('/', @{$new_child->{paths}}),
13335                    who            => $param->{'user'}{'email'},
13336                }
13337            );
13338        }
13339    }
13340
13341    web_db_log(
13342        {   'robot'        => $robot,
13343            'list'         => $list->{'name'},
13344            'action'       => $param->{'action'},
13345            'parameters'   => "$in{'new_name'}",
13346            'target_email' => "",
13347            'msg_id'       => '',
13348            'status'       => 'success',
13349            'error_type'   => '',
13350            'user_email'   => $param->{'user'}{'email'},
13351        }
13352    );
13353
13354    # web_db_stat_log : test before if the creation is a file or a directory.
13355    if ($type eq 'directory') {
13356        web_db_stat_log(operation => 'd_create_dir');
13357    } elsif ($type eq 'upload') {
13358        web_db_stat_log(
13359            operation => 'd_upload',
13360            parameter => length $content
13361        );
13362    } else {
13363        web_db_stat_log(operation => 'd_create_file');
13364    }
13365
13366    if ($type eq 'file') {
13367        $in{'path'} = join '/', @{$new_child->{paths}};
13368        return 'd_editfile';
13369    } else {
13370        return 'd_read';
13371    }
13372}
13373
13374############## Control
13375
13376#*******************************************
13377# Function : do_d_control
13378# Description : prepares the parameters
13379#               to edit access for a doc
13380#*******************************************
13381
13382sub do_d_control {
13383    wwslog('info', '%s', $in{'path'});
13384
13385    my $path = $in{'path'};
13386
13387    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
13388    # Existing document?
13389    unless ($shared_doc
13390        and -r $shared_doc->{fs_path}
13391        and $shared_doc->{type} ne 'root') {
13392        wwslog('err', '%s: no such file or directory', $path);
13393        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
13394            {'path' => $path},
13395            $param->{'action'}, $list);
13396        web_db_log(
13397            {   'robot'        => $robot,
13398                'list'         => $list->{'name'},
13399                'action'       => $param->{'action'},
13400                'parameters'   => "$in{'path'}",
13401                'target_email' => "",
13402                'msg_id'       => '',
13403                'status'       => 'error',
13404                'error_type'   => 'internal',
13405                'user_email'   => $param->{'user'}{'email'},
13406            }
13407        );
13408        return undef;
13409    }
13410    $param->{'shared_doc'} = $shared_doc->as_hashref;
13411
13412    # Access control.
13413    my %access = $shared_doc->get_privileges(
13414        mode             => 'edit,control',
13415        sender           => $param->{'user'}{'email'},
13416        auth_method      => $param->{'auth_method'},
13417        scenario_context => {
13418            sender      => $param->{'user'}{'email'},
13419            remote_host => $param->{'remote_host'},
13420            remote_addr => $param->{'remote_addr'}
13421        }
13422    );
13423    unless ($access{may}{control}) {
13424        Sympa::WWW::Report::reject_report_web('auth', $access{reason}{edit},
13425            {}, $param->{'action'}, $list);
13426        wwslog('info', 'Access denied for %s', $param->{'user'}{'email'});
13427        web_db_log(
13428            {   'robot'        => $robot,
13429                'list'         => $list->{'name'},
13430                'action'       => $param->{'action'},
13431                'parameters'   => "$in{'path'}",
13432                'target_email' => "",
13433                'msg_id'       => '',
13434                'status'       => 'error',
13435                'error_type'   => 'authorization',
13436                'user_email'   => $param->{'user'}{'email'},
13437            }
13438        );
13439        return undef;
13440    }
13441
13442    # Description of the file
13443    my $read;
13444    my $edit;
13445
13446    if ($shared_doc->{scenario}) {
13447        $read = $shared_doc->{scenario}{read};
13448        $edit = $shared_doc->{scenario}{edit};
13449    } else {
13450        $read = $access{'scenario'}{'read'};
13451        $edit = $access{'scenario'}{'edit'};
13452    }
13453
13454    # template parameters
13455    $param->{'list'} = $list->{'name'};
13456
13457    $param->{'shared_doc'}{'may_edit'}    = $access{may}{edit};
13458    $param->{'shared_doc'}{'may_control'} = $access{may}{control};
13459
13460    my $lang = $param->{'lang'};
13461
13462    # Only get required scenario attributes.
13463    # "web_title" is for compatibility to <= 6.2.38.
13464    my $scenarios = Sympa::Scenario::get_scenarios($list, 'd_read');
13465    $param->{'scenari_read'} = {
13466        map {
13467            my $name  = $_->{name};
13468            my $title = $_->get_current_title;
13469            ($name => {name => $name, title => $title, web_title => $title});
13470        } @$scenarios
13471    };
13472    $param->{'scenari_read'}{$read}{'selected'} = 'selected="selected"';
13473
13474    $scenarios = Sympa::Scenario::get_scenarios($list, 'd_edit');
13475    $param->{'scenari_edit'} = {
13476        map {
13477            my $name  = $_->{name};
13478            my $title = $_->get_current_title;
13479            ($name => {name => $name, title => $title, web_title => $title});
13480        } @$scenarios
13481    };
13482    $param->{'scenari_edit'}{$edit}{'selected'} = 'selected="selected"';
13483
13484    $param->{'set_owner'} = 1;
13485
13486    web_db_log(
13487        {   'robot'        => $robot,
13488            'list'         => $list->{'name'},
13489            'action'       => $param->{'action'},
13490            'parameters'   => "$in{'path'}",
13491            'target_email' => "",
13492            'msg_id'       => '',
13493            'status'       => 'success',
13494            'error_type'   => '',
13495            'user_email'   => $param->{'user'}{'email'},
13496        }
13497    );
13498    return 1;
13499}
13500
13501#*******************************************
13502# Function : do_d_change_access
13503# Description : Saves the description of
13504#               the file
13505#******************************************
13506
13507sub do_d_change_access {
13508    wwslog('info', '(%s)', $in{'path'});
13509
13510    my $path = $in{'path'};
13511
13512    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
13513    # The document to describe must already exist.
13514    unless ($shared_doc
13515        and -r $shared_doc->{fs_path}
13516        and $shared_doc->{type} ne 'root') {
13517        Sympa::WWW::Report::reject_report_web('user', 'no_doc_to_describe',
13518            {'path' => $path},
13519            $param->{'action'}, $list);
13520        wwslog('info', 'Unable to change access %s: No such document', $path);
13521        web_db_log(
13522            {   'robot'        => $robot,
13523                'list'         => $list->{'name'},
13524                'action'       => $param->{'action'},
13525                'parameters'   => "$in{'path'}",
13526                'target_email' => "",
13527                'msg_id'       => '',
13528                'status'       => 'error',
13529                'error_type'   => 'no_file',
13530                'user_email'   => $param->{'user'}{'email'},
13531            }
13532        );
13533        return undef;
13534    }
13535    $param->{'shared_doc'} = $shared_doc->as_hashref;
13536
13537    # Access control.
13538    my %access = $shared_doc->get_privileges(
13539        mode             => 'control',
13540        sender           => $param->{'user'}{'email'},
13541        auth_method      => $param->{'auth_method'},
13542        scenario_context => {
13543            sender      => $param->{'user'}{'email'},
13544            remote_host => $param->{'remote_host'},
13545            remote_addr => $param->{'remote_addr'}
13546        }
13547    );
13548    unless ($access{may}{control}) {
13549        Sympa::WWW::Report::reject_report_web('auth',
13550            'action_listmaster_or_privileged_owner_or_author',
13551            {}, $param->{'action'}, $list);
13552        wwslog(
13553            'info', 'Access denied for %s by %s',
13554            $path,  $param->{'user'}{'email'}
13555        );
13556        web_db_log(
13557            {   'robot'        => $robot,
13558                'list'         => $list->{'name'},
13559                'action'       => $param->{'action'},
13560                'parameters'   => "$in{'path'}",
13561                'target_email' => "",
13562                'msg_id'       => '',
13563                'status'       => 'error',
13564                'error_type'   => 'authorization',
13565                'user_email'   => $param->{'user'}{'email'},
13566            }
13567        );
13568        return undef;
13569    }
13570
13571    if (exists $shared_doc->{serial_desc}
13572        and defined $shared_doc->{serial_desc}) {
13573        # If description file already exists : open it and modify it.
13574        # Synchronization.
13575        unless ($shared_doc->{serial_desc} == $in{'serial'}) {
13576            Sympa::WWW::Report::reject_report_web('user', 'synchro_failed',
13577                {}, $param->{'action'}, $list);
13578            wwslog('info', 'Synchronization failed for %s', $shared_doc);
13579            web_db_log(
13580                {   'robot'        => $robot,
13581                    'list'         => $list->{'name'},
13582                    'action'       => $param->{'action'},
13583                    'parameters'   => "$in{'path'}",
13584                    'target_email' => "",
13585                    'msg_id'       => '',
13586                    'status'       => 'error',
13587                    'error_type'   => 'synchro_failed',
13588                    'user_email'   => $param->{'user'}{'email'},
13589                }
13590            );
13591            return undef;
13592        }
13593    } else {
13594        $shared_doc->{scenario} = {
13595            read => $access{scenario}{read},
13596            edit => $access{scenario}{edit}
13597        };
13598    }
13599
13600    $shared_doc->{scenario}{read} = $in{'read_access'}
13601        if $in{'read_access'};
13602    $shared_doc->{scenario}{edit} = $in{'edit_access'}
13603        if $in{'edit_access'};
13604
13605    unless ($shared_doc->save_description) {
13606        wwslog('info', 'Cannot open description of %s: %m', $shared_doc);
13607        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
13608            {'path' => $path},
13609            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
13610        web_db_log(
13611            {   'robot'        => $robot,
13612                'list'         => $list->{'name'},
13613                'action'       => $param->{'action'},
13614                'parameters'   => "$in{'path'}",
13615                'target_email' => "",
13616                'msg_id'       => '',
13617                'status'       => 'error',
13618                'error_type'   => 'internal',
13619                'user_email'   => $param->{'user'}{'email'},
13620            }
13621        );
13622        return undef;
13623    }
13624
13625    return 'd_control';
13626}
13627
13628sub do_d_set_owner {
13629    wwslog('info', '(%s, %s)', $in{'path'}, $in{'content'});
13630
13631    my $path = $in{'path'};
13632
13633    # The email must look like an email "somebody@somewhere".
13634    my $email = Sympa::Tools::Text::canonic_email($in{'content'})
13635        if $in{'content'};
13636    unless ($email and Sympa::Tools::Text::valid_email($email)) {
13637        Sympa::WWW::Report::reject_report_web('user', 'incorrect_email',
13638            {'email' => $in{'content'}},
13639            $param->{'action'}, $list);
13640        wwslog('info', '%s: incorrect email', $in{'content'});
13641        web_db_log(
13642            {   'robot'        => $robot,
13643                'list'         => $list->{'name'},
13644                'action'       => $param->{'action'},
13645                'parameters'   => $in{'path'},
13646                'target_email' => "",
13647                'msg_id'       => '',
13648                'status'       => 'error',
13649                'error_type'   => 'incorrect_email',
13650                'user_email'   => $param->{'user'}{'email'},
13651            }
13652        );
13653        return undef;
13654    }
13655
13656    my $shared_doc = Sympa::WWW::SharedDocument->new($list, $path);
13657    # The document to describe must already exist.
13658    unless ($shared_doc
13659        and -r $shared_doc->{fs_path}
13660        and $shared_doc->{type} ne 'root') {
13661        Sympa::WWW::Report::reject_report_web('user', 'no_doc_to_describe',
13662            {'path' => $path},
13663            $param->{'action'}, $list);
13664        wwslog('info', 'Unable to change access %s: No such document', $path);
13665        web_db_log(
13666            {   'robot'        => $robot,
13667                'list'         => $list->{'name'},
13668                'action'       => $param->{'action'},
13669                'parameters'   => "$in{'path'}",
13670                'target_email' => "",
13671                'msg_id'       => '',
13672                'status'       => 'error',
13673                'error_type'   => 'no_file',
13674                'user_email'   => $param->{'user'}{'email'},
13675            }
13676        );
13677        return undef;
13678    }
13679    $param->{'shared_doc'} = $shared_doc->as_hashref;
13680
13681    #XXX# Must be authorized to control father directory.
13682    #XXXmy $shared_doc = Sympa::WWW::SharedDocument->new($list, $1);
13683    my %access = $shared_doc->get_privileges(
13684        mode             => 'control',
13685        sender           => $param->{'user'}{'email'},
13686        auth_method      => $param->{'auth_method'},
13687        scenario_context => {
13688            sender      => $param->{'user'}{'email'},
13689            remote_host => $param->{'remote_host'},
13690            remote_addr => $param->{'remote_addr'}
13691        }
13692    );
13693    unless ($access{may}{control}) {
13694        Sympa::WWW::Report::reject_report_web('auth',
13695            'action_listmaster_or_privileged_owner_or_author',
13696            {}, $param->{'action'}, $list);
13697        wwslog('info', 'Access denied for %s', $param->{'user'}{'email'});
13698        web_db_log(
13699            {   'robot'        => $robot,
13700                'list'         => $list->{'name'},
13701                'action'       => $param->{'action'},
13702                'parameters'   => $in{'path'},
13703                'target_email' => "",
13704                'msg_id'       => '',
13705                'status'       => 'error',
13706                'error_type'   => 'authentication',
13707                'user_email'   => $param->{'user'}{'email'},
13708            }
13709        );
13710        return undef;
13711    }
13712
13713    if (exists $shared_doc->{serial_desc}
13714        and defined $shared_doc->{serial_desc}) {
13715        # If description file already exists : open it and modify it.
13716        # Synchronization.
13717        unless ($shared_doc->{serial_desc} == $in{'serial'}) {
13718            Sympa::WWW::Report::reject_report_web('user', 'synchro_failed',
13719                {}, $param->{'action'}, $list);
13720            wwslog('info', 'Synchronization failed for %s', $shared_doc);
13721            web_db_log(
13722                {   'robot'        => $robot,
13723                    'list'         => $list->{'name'},
13724                    'action'       => $param->{'action'},
13725                    'parameters'   => $in{'path'},
13726                    'target_email' => "",
13727                    'msg_id'       => '',
13728                    'status'       => 'error',
13729                    'error_type'   => 'synchro_failed',
13730                    'user_email'   => $param->{'user'}{'email'},
13731                }
13732            );
13733            return undef;
13734        }
13735    } else {
13736        $shared_doc->{scenario} = $access{scenario};
13737    }
13738
13739    $shared_doc->{owner} = $email;
13740
13741    unless ($shared_doc->save_description) {
13742        wwslog('info', 'Cannot save description of %s: %m', $shared_doc);
13743        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
13744            {'path' => $path},
13745            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
13746        web_db_log(
13747            {   'robot'        => $robot,
13748                'list'         => $list->{'name'},
13749                'action'       => $param->{'action'},
13750                'parameters'   => "$in{'content'}",
13751                'target_email' => "",
13752                'msg_id'       => '',
13753                'status'       => 'error',
13754                'error_type'   => 'internal',
13755                'user_email'   => $param->{'user'}{'email'},
13756            }
13757        );
13758        return undef;
13759    }
13760
13761    web_db_log(
13762        {   'robot'        => $robot,
13763            'list'         => $list->{'name'},
13764            'action'       => $param->{'action'},
13765            'parameters'   => $in{'path'},
13766            'target_email' => "",
13767            'msg_id'       => '',
13768            'status'       => 'success',
13769            'error_type'   => '',
13770            'user_email'   => $param->{'user'}{'email'},
13771        }
13772    );
13773
13774    # ONLY IF SET_OWNER can be performed even if not control of the parent
13775    # directory.
13776    unless ($access{may}{control}) {
13777        $in{'path'} = join '/', @{$shared_doc->{parent}->{paths}};
13778        return 'd_read';
13779    } else {
13780        return 'd_control';
13781    }
13782}
13783
13784## Protecting archives from Email Sniffers
13785# No longer used.
13786#sub do_arc_protect;
13787
13788####################################################
13789#  do_remind
13790####################################################
13791#  Sends a remind command to sympa.pl.
13792#
13793# IN : -
13794#
13795# OUT : 'loginrequest' | 'admin' | undef
13796#
13797#####################################################
13798sub do_remind {
13799    wwslog('info', '');
13800
13801    ## Access control
13802    return undef unless defined check_authz('do_remind', 'remind');
13803
13804    # Action confirmed?
13805    my $next_action = $session->confirm_action(
13806        $in{'action'}, $in{'response_action'},
13807        arg             => $list->{'name'},
13808        previous_action => ($in{'previous_action'} || 'admin')
13809    );
13810    return $next_action unless $next_action eq '1';
13811
13812    my $extention = time . "." . int(rand 9999);
13813    my $mail_command;
13814
13815    ## Sympa will require a confirmation
13816    my $result = Sympa::Scenario->new($list, 'remind')->authz(
13817        'smtp',
13818        {   'sender'      => $param->{'user'}{'email'},
13819            'remote_host' => $param->{'remote_host'},
13820            'remote_addr' => $param->{'remote_addr'}
13821        }
13822    );
13823    my $r_action;
13824    my $reason;
13825    if (ref($result) eq 'HASH') {
13826        $r_action = $result->{'action'};
13827        $reason   = $result->{'reason'};
13828    }
13829
13830    if ($r_action =~ /reject/i) {
13831        Sympa::WWW::Report::reject_report_web('auth', $reason, {},
13832            $param->{'action'}, $list);
13833        wwslog('info', 'Access denied for %s', $param->{'user'}{'email'});
13834        web_db_log(
13835            {   'robot'        => $robot,
13836                'list'         => $list->{'name'},
13837                'action'       => $param->{'action'},
13838                'parameters'   => "",
13839                'target_email' => "",
13840                'msg_id'       => '',
13841                'status'       => 'error',
13842                'error_type'   => 'authorization',
13843                'user_email'   => $param->{'user'}{'email'},
13844            }
13845        );
13846        return undef;
13847
13848    } else {
13849        $mail_command = sprintf "REMIND %s", $param->{'list'};
13850    }
13851
13852    # Commands are injected into incoming spool directly with "md5"
13853    # authentication level.
13854    my $time    = time;
13855    my $message = Sympa::Message->new(
13856        sprintf("\n\n%s\n", $mail_command),
13857        context         => $robot,
13858        envelope_sender => Sympa::get_address($robot, 'owner'),
13859        sender          => $param->{'user'}{'email'},
13860        md5_check       => 1,
13861        message_id      => sprintf('<%s@wwsympa>', $time)
13862    );
13863    $message->add_header('Content-Type', 'text/plain; Charset=utf-8');
13864
13865    unless (Sympa::Spool::Incoming->new->store($message)) {
13866        Sympa::WWW::Report::reject_report_web(
13867            'intern',
13868            'cannot_send_remind',
13869            {   'from'     => $param->{'user'}{'email'},
13870                'listname' => $list->{'name'}
13871            },
13872            $param->{'action'},
13873            $list,
13874            $param->{'user'}{'email'},
13875            $robot
13876        );
13877        wwslog('err', 'Failed to send message for command REMIND');
13878        web_db_log(
13879            {   'robot'        => $robot,
13880                'list'         => $list->{'name'},
13881                'action'       => $param->{'action'},
13882                'parameters'   => "",
13883                'target_email' => "",
13884                'msg_id'       => '',
13885                'status'       => 'error',
13886                'error_type'   => 'internal',
13887                'user_email'   => $param->{'user'}{'email'},
13888            }
13889        );
13890        return undef;
13891    }
13892
13893    Sympa::WWW::Report::notice_report_web('performed_soon', {},
13894        $param->{'action'});
13895    web_db_log(
13896        {   'robot'        => $robot,
13897            'list'         => $list->{'name'},
13898            'action'       => $param->{'action'},
13899            'parameters'   => "",
13900            'target_email' => "",
13901            'msg_id'       => '',
13902            'status'       => 'success',
13903            'error_type'   => '',
13904            'user_email'   => $param->{'user'}{'email'},
13905        }
13906    );
13907    return 'admin';
13908}
13909
13910# Load list certificate.
13911sub do_load_cert {
13912    wwslog('info', '(%s)', $param->{'list'});
13913
13914    my $cert = $list->get_cert('der');
13915    unless ($cert) {
13916        Sympa::WWW::Report::reject_report_web('user', 'missing_cert', {},
13917            $param->{'action'}, $list);
13918        wwslog('info', 'No cert for this list');
13919        return undef;
13920    }
13921
13922    # don't you just HATE it when every single browser seems to want a
13923    # different content-type for certificates? order is important, as
13924    # everybody calls themselves "mozilla", and opera identifies as
13925    # IE if told so (but Opera doesn't do S/MIME anyways, it seems)
13926    my ($ua, $ct) = ($ENV{HTTP_USER_AGENT}, 'application/x-x509-email-cert');
13927    if ($ua =~ /MSIE/) {
13928        $ct = 'application/pkix-cert';
13929    }
13930    $param->{'bypass'} = 'extreme';
13931    my $filename = sprintf '%s.cer', $list->get_id;
13932    printf "Content-Disposition: attachment; filename=\"%s\"\n", $filename;
13933    printf "Content-Type: %s\n\n%s", $ct, $cert;
13934    return 1;
13935}
13936
13937#*******************************************
13938# Function : do_upload_pictures
13939# Description : Creates a new pictures with a
13940#               uploaded file
13941#******************************************
13942
13943sub do_upload_pictures {
13944    # Parameters of the uploaded file (from suboptions.tt2)
13945    my $fn = $query->param('uploaded_file');
13946    wwslog('info', '(%s, %s)', $fn, $param->{'user'}{'email'});
13947
13948    # name of the file, without path
13949    my $fname;
13950    if ($fn =~ /([^\/\\]+)$/) {
13951        $fname = $1;
13952    }
13953
13954    # type of the file
13955    my $filetype;
13956    if ($fn =~ /\.(jpg|jpeg|png|gif)$/i) {
13957        $filetype = lc $1;
13958    } else {
13959        $filetype = undef;
13960    }
13961
13962    #uploaded file must have a name
13963    unless ($fname) {
13964        Sympa::WWW::Report::reject_report_web('user', 'no_name', {},
13965            $param->{'action'});
13966        wwslog('err', 'No file specified to upload');
13967        return 'suboptions';
13968    }
13969
13970    unless ($filetype) {
13971        Sympa::WWW::Report::reject_report_web(
13972            'user',
13973            'cannot_upload',
13974            {   'path'   => $fname,
13975                'reason' => "your file does not have an authorized format."
13976            },
13977            $param->{'action'}
13978        );
13979        wwslog('err', 'Unauthorized format');
13980        return 'suboptions';
13981    }
13982
13983    my $filename     = Digest::MD5::md5_hex($param->{'user'}{'email'});
13984    my $fullfilename = $filename . '.' . $filetype;
13985
13986    my @filetmp;
13987    # check if there is not already a file for the user with a different
13988    # extension
13989    foreach my $filetmp ($list->find_picture_paths($param->{'user'}{'email'}))
13990    {
13991        rename $filetmp, $filetmp . '.tmp';
13992        push @filetmp, $filetmp;
13993    }
13994
13995    my $picture_path = $list->get_picture_path($fullfilename);
13996    unless (creation_picture_file($list->get_picture_path, $fullfilename)) {
13997        Sympa::WWW::Report::reject_report_web('user', 'upload_failed',
13998            {'path' => $fullfilename},
13999            $param->{'action'});
14000        wwslog('err', 'Failed to create file %s', $picture_path);
14001        return 'suboptions';
14002    }
14003
14004    my ($size) = (stat $picture_path)[7];
14005    unless (Conf::get_robot_conf($robot, 'pictures_max_size') > $size) {
14006        unlink $picture_path;
14007        foreach my $filetmp (@filetmp) {
14008            rename $filetmp . '.tmp', $filetmp;
14009        }
14010        Sympa::WWW::Report::reject_report_web(
14011            'user',
14012            'cannot_upload',
14013            {   'path'   => $fullfilename,
14014                'reason' => "Your file exceeds the authorized size."
14015            },
14016            $param->{'action'}
14017        );
14018        wwslog('err', 'Failed to upload pictures');
14019        return 'suboptions';
14020    }
14021
14022    # message of success
14023    foreach my $filetmp (@filetmp) {
14024        unlink $filetmp . '.tmp';
14025    }
14026    wwslog('info', 'Upload of the pictures succeeded');
14027    return 'suboptions';
14028}
14029
14030## Delete a picture file
14031sub do_delete_pictures {
14032    wwslog('info', '(%s, %s, %s)', $param->{'list'}, $robot,
14033        $param->{'user'}{'email'});
14034
14035    my $email = $param->{'user'}{'email'};
14036
14037    #deleted file must exist
14038    unless ($list->find_picture_filenames($email)) {
14039        Sympa::WWW::Report::reject_report_web('user', 'no_name', {},
14040            $param->{'action'}, $list);
14041        wwslog('err', 'No file exists to delete');
14042        return 'suboptions';
14043    }
14044
14045    unless ($list->delete_list_member_picture($email)) {
14046        Sympa::WWW::Report::reject_report_web(
14047            'intern',
14048            'erase_file',
14049            {'file' => $list->find_picture_filenames($email)},
14050            $param->{'action'},
14051            $list,
14052            $param->{'user'}{'email'},
14053            $robot
14054        );
14055        wwslog(
14056            'err',
14057            'Failed to erase %s',
14058            $list->find_picture_filenames($email)
14059        );
14060        return undef;
14061    } else {
14062        wwslog('notice', 'File deleted successfully');
14063        return 'suboptions';
14064    }
14065}
14066
14067# No longer used: use do_move_user().
14068#sub do_change_email_request;
14069
14070# No longer used: use do_move_user().
14071#sub do_change_email;
14072
14073## Changes a user's email address in Sympa environment
14074sub do_move_user {
14075    wwslog('info', '(%s, %s)', $in{'current_email'}, $in{'email'});
14076
14077    my ($current_email, $email);
14078    if ($in{'old_email'} and $in{'new_email'}) {
14079        # Compatibility to 6.1.x or earlier.
14080        $current_email = Sympa::Tools::Text::canonic_email($in{'old_email'});
14081        $email         = Sympa::Tools::Text::canonic_email($in{'new_email'});
14082    } elsif ($in{'current_email'} and $in{'email'}) {
14083        $current_email =
14084            Sympa::Tools::Text::canonic_email($in{'current_email'});
14085        $email = Sympa::Tools::Text::canonic_email($in{'email'});
14086    }
14087    $param->{'current_email'} = $current_email;
14088    $param->{'email'}         = $email;
14089
14090    $param->{'previous_action'} = $in{'previous_action'} || 'pref';
14091
14092    unless (Sympa::Tools::Text::valid_email($current_email)
14093        and Sympa::Tools::Text::valid_email($email)) {
14094        return $in{'previous_action'} || 'pref';
14095    }
14096    # Prevent changing addresses of others unless user is listmaster.
14097    unless (Sympa::is_listmaster($robot, $param->{'user'}{'email'})
14098        or $param->{'user'}{'email'} eq $current_email) {
14099        return $in{'previous_action'} || 'pref';
14100    }
14101
14102    # Action confirmed?
14103    my $next_action = $session->confirm_action(
14104        $param->{'action'}, $in{'response_action'},
14105        arg             => "$current_email,$email",
14106        previous_action => ($in{'previous_action'} || 'pref'),
14107    );
14108    return $next_action unless $next_action eq '1';
14109
14110    # Do the move_user
14111    my $spindle = Sympa::Spindle::ProcessRequest->new(
14112        context          => $robot,
14113        action           => 'move_user',
14114        current_email    => $current_email,
14115        email            => $email,
14116        sender           => $param->{'user'}{'email'},
14117        md5_check        => 1,
14118        scenario_context => {
14119            sender        => $param->{'user'}{'email'},
14120            remote_host   => $param->{'remote_host'},
14121            remote_addr   => $param->{'remote_addr'},
14122            current_email => $current_email,
14123            email         => $email,
14124        }
14125    );
14126    unless ($spindle and $spindle->spin) {
14127        wwslog('err', 'Failed to change user email address');
14128        return undef;
14129    }
14130
14131    foreach my $report (@{$spindle->{stash} || []}) {
14132        if ($report->[1] eq 'notice') {
14133            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
14134                $param->{'action'});
14135        } else {
14136            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
14137                $param->{action});
14138        }
14139    }
14140    unless (@{$spindle->{stash} || []}) {
14141        Sympa::WWW::Report::notice_report_web('performed', {},
14142            $param->{'action'});
14143    }
14144
14145    return $in{'previous_action'} || 'pref';
14146}
14147
14148sub do_suspend {
14149    goto &do_suspend_request_action;    # "&" is required.
14150}
14151
14152####################################################
14153#  do_suspend_request
14154####################################################
14155#  Suspend a subscription to one or more lists     #
14156#  for a given period: start date and end date     #
14157#  (or unlimited). The user may at any time        #
14158#  stop the suspension.                            #
14159#                                                  #
14160#  IN : -                                          #
14161#  OUT : 'loginrequest'                            #
14162#      | 'info' | undef                            #
14163#                                                  #
14164####################################################
14165# We display in the table the lists of the subscriber and the state in
14166# which they are.
14167# reception : - nomail/digest/mail ||
14168#             - . suspended  From XX-XX-XXXX To XX-XX-XXXX
14169sub do_suspend_request {
14170    wwslog('info', '');
14171
14172    ## Sets the date of the field "start date" to "today"
14173    $param->{'d_day'} = POSIX::strftime('%d-%m-%Y', localtime time);
14174    _set_my_lists_info();
14175
14176    # Compatibility with Sympa <= 6.1b.1.
14177    $param->{'which_info'} = $param->{'which'};
14178    $param->{'suspend_list'} =
14179        [grep { $_->{'listsuspend'} } values %{$param->{'which'}}];
14180
14181    return 1;
14182}
14183
14184sub _set_my_lists_info {
14185    my $which = {};
14186
14187    # Set which_info unless in one list page
14188    if ($param->{'user'}{'email'} and ref $list ne 'Sympa::List') {
14189        my %get_which;
14190
14191        foreach my $role (qw(member owner editor)) {
14192            $get_which{$role} = Sympa::List::get_lists(
14193                $robot,
14194                'filter' => [
14195                    $role      => $param->{'user'}{'email'},
14196                    '! status' => 'closed|family_closed'
14197                ],
14198            );
14199        }
14200
14201        # Add lists information to 'which'
14202        foreach my $list (@{$get_which{member}}) {
14203            # Evaluate AuthZ scenario first
14204            my $result = Sympa::Scenario->new($list, 'visibility')->authz(
14205                $param->{'auth_method'},
14206                {   'sender'      => $param->{'user'}{'email'},
14207                    'remote_host' => $param->{'remote_host'},
14208                    'remote_addr' => $param->{'remote_addr'}
14209                }
14210            );
14211            next
14212                unless ref $result eq 'HASH'
14213                and $result->{'action'} eq 'do_it';
14214
14215            my $l = $list->{'name'};
14216            $which->{$l}{'subject'} = $list->{'admin'}{'subject'};
14217            $which->{$l}{'status'}  = $list->{'admin'}{'status'}; # new 6.2.46
14218            $which->{$l}{'is_subscriber'} = 1;    # New on 6.2b.2.
14219            # Compat. < 6.2b.2.
14220            $which->{$l}{'info'} = 1;
14221            # Compat. < 6.2.32 (Not used by default)
14222            $which->{$l}{'host'} = $list->{'domain'};
14223
14224            my $member_info =
14225                $list->get_list_member($param->{'user'}{'email'});
14226            my ($final_start_date, $final_end_date);
14227            if ($member_info->{'suspend'}) {
14228                if (defined $member_info->{'enddate'}
14229                    and $member_info->{'enddate'} < time) {
14230                    # If end date is < time, update the BDD by deleting the
14231                    # suspending's data
14232                    # FIXME: Is this required?
14233                    $list->restore_suspended_subscription(
14234                        $param->{'user'}{'email'});
14235                }
14236                $final_start_date =
14237                    $language->gettext_strftime("%d %b %Y",
14238                    localtime $member_info->{'startdate'})
14239                    if defined $member_info->{'startdate'};
14240                $final_end_date =
14241                    $language->gettext_strftime("%d %b %Y",
14242                    localtime $member_info->{'enddate'})
14243                    if defined $member_info->{'enddate'};
14244            }
14245
14246            $member_info->{'reception'}  ||= 'mail';
14247            $member_info->{'visibility'} ||= 'noconceal';
14248            foreach my $mode ($list->available_reception_mode) {
14249                if ($member_info->{'reception'} eq $mode) {
14250                    $param->{'reception'}{$list->{'name'}}{$mode}{'selected'}
14251                        = ' selected';
14252                } else {
14253                    $param->{'reception'}{$list->{'name'}}{$mode}{'selected'}
14254                        = '';
14255                }
14256            }
14257
14258            $which->{$l}{'listname'}      = $list->{'name'};
14259            $which->{$l}{'listdomain'}    = $list->{'domain'};
14260            $which->{$l}{'listreception'} = $member_info->{'reception'};
14261            $which->{$l}{'listsuspend'}   = $member_info->{'suspend'};
14262            $which->{$l}{'liststartdate'} = $final_start_date;
14263            $which->{$l}{'listenddate'}   = $final_end_date;
14264            $which->{$l}{'visibility'}    = $member_info->{'visibility'};
14265            $which->{$l}{'reception'} =
14266                $param->{'reception'}{$list->{'name'}};
14267            # Compat. < 6.2b.1.
14268            $which->{$l}{'display'} = $which->{$l}{'listsuspend'};
14269        }
14270        foreach my $list (@{$get_which{owner}}) {
14271            my $l = $list->{'name'};
14272
14273            $which->{$l}{'subject'} = $list->{'admin'}{'subject'};
14274            $which->{$l}{'status'}  = $list->{'admin'}{'status'}; # new 6.2.46
14275            $which->{$l}{'is_owner'} = 1;    # New on 6.2b.2.
14276            # Compat. < 6.2b.1.
14277            $which->{$l}{'info'}  = 1;
14278            $which->{$l}{'admin'} = 1;
14279            # Compat. < 6.2.32 (Not used by default)
14280            $which->{$l}{'host'} = $list->{'domain'};
14281        }
14282        foreach my $list (@{$get_which{editor}}) {
14283            my $l = $list->{'name'};
14284
14285            $which->{$l}{'subject'} = $list->{'admin'}{'subject'};
14286            $which->{$l}{'status'}  = $list->{'admin'}{'status'}; # new 6.2.46
14287            $which->{$l}{'is_editor'} = 1;    # New on 6.2b.2.
14288            # Compat. < 6.2b.1.
14289            $which->{$l}{'info'}  = 1;
14290            $which->{$l}{'admin'} = 1;
14291            # Compat. < 6.2.32 (Not used by default)
14292            $which->{$l}{'host'} = $list->{'domain'};
14293        }
14294    }
14295
14296    $param->{'which'} = $which;
14297}
14298
14299####################################################
14300#  do_suspend_request_action
14301####################################################
14302#  Suspend a subscription for lists.               #
14303#  Action from the suspend form.                   #
14304#                                                  #
14305#  IN : %in : HASH with the form's values          #
14306#  OUT : 'pref' : action                           #
14307#      | 'info' | undef                            #
14308####################################################
14309sub do_suspend_request_action {
14310    wwslog('info', '');
14311
14312    my $day1;
14313    my $month1;
14314    my $year1;
14315    my $day2;
14316    my $month2;
14317    my $year2;
14318    my @lists;
14319    my $data;
14320
14321    my $previous_action = $in{'previous_action'} || 'suspend_request';
14322
14323    if ($in{'sub_action'} eq 'suspendsave') {
14324
14325        # to retrieve the selected list
14326        @lists = split /\0/, $in{'listname'};
14327        my @list_selected;
14328        foreach my $list (@lists) {
14329            unless ($list eq '') {
14330                push @list_selected, $list;
14331            }
14332        }
14333
14334        if ($list_selected[0] eq '') {
14335            Sympa::WWW::Report::reject_report_web(
14336                'user',
14337                'missing_arg',
14338                {   'argument' =>
14339                        'must picked one or more list(s) you are subscribed'
14340                },
14341                $param->{'action'}
14342            );
14343            wwslog('info',
14344                'Must picked one or more list(s) you are subscribed');
14345            return $previous_action;
14346        }
14347
14348        if ($in{'date_deb'}) {
14349            ($day1, $month1, $year1) = split(/\-/, $in{'date_deb'});
14350            $month1 = $month1 - 1;
14351
14352            if (   ($day1 =~ /([0-9]*)/)
14353                && ($month1 =~ /([0-9]*)/)
14354                && ($year1 =~ /([0-9]*)/)) {
14355                if (   ((1 <= $day1) && ($day1 <= 31))
14356                    && ((0 <= $month1) && ($month1 <= 11))
14357                    && (1900 <= $year1)) {
14358                    ## Return an epoch date
14359                    $data->{'startdate'} =
14360                        Time::Local::timelocal(0, 0, 0, $day1, $month1,
14361                        $year1);
14362                } else {
14363                    Sympa::WWW::Report::reject_report_web('user',
14364                        'missing_arg',
14365                        {'argument' => 'Start Date doesn\'t exist.'},
14366                        $param->{'action'});
14367                    wwslog('info', 'Date doesn\'t exist');
14368                    return $previous_action;
14369                }
14370            } else {
14371                Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
14372                    {'argument' => 'Start Date doesn\'t exist.'},
14373                    $param->{'action'});
14374                wwslog('info', 'Date doesn\'t exist');
14375                return $previous_action;
14376            }
14377            ## Case 1 : Start date & End date (without indefinite)
14378            if (($in{'date_fin'}) && (!$in{'indefinite'})) {
14379                ($day2, $month2, $year2) = split(/\-/, $in{'date_fin'});
14380                $month2 = $month2 - 1;
14381
14382                if (   ($day2 =~ /([0-9]*)/)
14383                    && ($month2 =~ /([0-9]*)/)
14384                    && ($year2 =~ /([0-9]*)/)) {
14385                    if (   ((1 <= $day2) && ($day2 <= 31))
14386                        && ((0 <= $month2) && ($month2 <= 11))
14387                        && (1900 <= $year2)) {
14388                        ## Return an epoch date
14389                        $data->{'enddate'} =
14390                            Time::Local::timelocal(0, 0, 0, $day2, $month2,
14391                            $year2);
14392                    } else {
14393                        Sympa::WWW::Report::reject_report_web('user',
14394                            'missing_arg',
14395                            {'argument' => 'End Date doesn\'t exist.'},
14396                            $param->{'action'});
14397                        wwslog('info', 'Date doesn\'t exist');
14398                        return $previous_action;
14399                    }
14400                } else {
14401                    Sympa::WWW::Report::reject_report_web('user',
14402                        'missing_arg',
14403                        {'argument' => 'End Date doesn\'t exist.'},
14404                        $param->{'action'});
14405                    wwslog('info', 'Date doesn\'t exist');
14406                    return $previous_action;
14407                }
14408
14409                unless ($data->{'startdate'} <= $data->{'enddate'}) {
14410                    Sympa::WWW::Report::reject_report_web(
14411                        'user',
14412                        'missing_arg',
14413                        {   'argument' =>
14414                                'The start date must be less than the end date.'
14415                        },
14416                        $param->{'action'}
14417                    );
14418                    wwslog('info',
14419                        'The start date must be less than the end date.');
14420                    return $previous_action;
14421                }
14422                ## Case 2 : Start date & without indefinite (without end date)
14423            } elsif ((!$in{'date_fin'}) && ($in{'indefinite'})) {
14424                $data->{'enddate'} = undef;
14425            } else {
14426                Sympa::WWW::Report::reject_report_web(
14427                    'user',
14428                    'missing_arg',
14429                    {   'argument' =>
14430                            'Choose end date (dd/mm/yyyy) or indefinite end date'
14431                    },
14432                    $param->{'action'}
14433                );
14434                wwslog('info',
14435                    'Missing argument for the end date or syntax error : dd/mm/yyyy or must choose a end date or indefinite end date'
14436                );
14437                return $previous_action;
14438            }
14439        } else {
14440            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
14441                {'argument' => 'Miss start date (dd/mm/yyyy)'},
14442                $param->{'action'});
14443            wwslog('info',
14444                'Missing argument for the start date or syntax error : dd/mm/yyyy'
14445            );
14446            return $previous_action;
14447        }
14448
14449        ## Suspend subscription
14450        foreach my $list (@list_selected) {
14451            unless (
14452                Sympa::List::suspend_subscription(
14453                    $param->{'user'}{'email'},
14454                    $list, $data, $robot
14455                )
14456            ) {
14457                wwslog('info', 'Can\'t do List suspend_subscription');
14458                return $previous_action;
14459            }
14460        }
14461
14462        Sympa::WWW::Report::notice_report_web('performed', {},
14463            $in{'sub_action'});
14464    }
14465    ## Restore suspended subscription
14466    elsif ($in{'sub_action'} eq 'suspendstop') {
14467
14468        # to renew membership lists selected
14469        @lists = split /\0/, $in{'listname'};
14470        foreach my $line (@lists) {
14471            my $list = Sympa::List->new($line, $robot);
14472            next unless $list;
14473            $list->restore_suspended_subscription($param->{'user'}{'email'});
14474        }
14475
14476        if ($lists[0] eq '') {
14477            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
14478                {'argument' => 'must picked one or more list(s)'},
14479                $param->{'action'});
14480            wwslog('info', 'Must picked one or more list(s)');
14481            return $previous_action;
14482        }
14483        Sympa::WWW::Report::notice_report_web('performed', {},
14484            "Resume the subscription for the list(s)");
14485    } else {
14486        Sympa::WWW::Report::reject_report_web('user', 'unknown_action', {},
14487            $in{'sub_action'}, $list);
14488        wwslog('info', 'Unknown action %s', $in{'sub_action'});
14489        return undef;
14490    }
14491
14492    return $previous_action;
14493}
14494
14495####################################################
14496#  do_compose_mail
14497####################################################
14498sub do_compose_mail {
14499    wwslog('info', '(subaction=%s)', $in{'subaction'});
14500
14501    unless ($param->{'may_post'}) {
14502        Sympa::WWW::Report::reject_report_web('auth',
14503            $param->{'may_post_reason'},
14504            {}, $param->{'action'}, $list);
14505        wwslog('info', 'May not send message');
14506        return undef;
14507    }
14508
14509    if (Conf::get_robot_conf($robot, 'use_html_editor') eq 'on'
14510        and length(Conf::get_robot_conf($robot, 'html_editor_url') // '')) {
14511        $param->{'use_html_editor'} = 'on';
14512        my $html_editor_url = Conf::get_robot_conf($robot, 'html_editor_url');
14513        if ($html_editor_url =~ /^([-.\w]+:\/\/|\/)/i) {
14514            $param->{'html_editor_url'} = $html_editor_url;
14515        } else {
14516            $param->{'html_editor_url'} =
14517                Conf::get_robot_conf($robot, 'static_content_url') . '/'
14518                . $html_editor_url;
14519        }
14520        $param->{'html_editor_init'} =
14521            Conf::get_robot_conf($robot, 'html_editor_init');
14522    }
14523
14524    # Set the subaction to html_news_letter or undef
14525    $param->{'subaction'} = $in{'subaction'};
14526    if ($in{'to'}) {
14527        # In archive we hide email replacing @ by ' '. Here we must do the
14528        # reverse transformation
14529        $in{'to'} =~ s/ /\@/g;
14530        $param->{'to'} = $in{'to'};
14531    } else {
14532        $param->{'to'} = Sympa::get_address($list);
14533    }
14534    foreach my $recipient (split(',', $param->{'to'})) {
14535        (   $param->{'recipients'}{$recipient}{'local_to'},
14536            $param->{'recipients'}{$recipient}{'domain_to'}
14537        ) = split('@', $recipient);
14538    }
14539    # headers will be encoded later.
14540    #XXX$param->{'subject'}= &MIME::Words::encode_mimewords($in{'subject'});
14541    $param->{'subject'} = $in{'subject'};
14542    $param->{'in_reply_to'} =
14543        Sympa::Tools::Text::canonic_message_id($in{'in_reply_to'});
14544    $param->{'message_id'} = Sympa::unique_message_id($robot);
14545
14546    if ($list->is_there_msg_topic()) {
14547
14548        $param->{'request_topic'} = 1;
14549
14550        foreach my $top (@{$list->{'admin'}{'msg_topic'}}) {
14551            if ($top->{'name'}) {
14552                push(@{$param->{'available_topics'}}, $top);
14553            }
14554        }
14555        $param->{'topic_required'} = $list->is_msg_topic_tagging_required();
14556    }
14557
14558    #$param->{'merge_feature'} =
14559    #    Sympa::Tools::Data::smart_eq($list->{'admin'}{'merge_feature'}, 'on');
14560
14561    return 1;
14562}
14563
14564####################################################
14565#  do_send_mail
14566####################################################
14567#  Sends a message to a list by the Web interface
14568#  or an html page getting its url.
14569#
14570# IN : -
14571#
14572# OUT : 'loginrequest'
14573#      | 'info' | undef
14574#
14575####################################################
14576sub do_send_mail {
14577
14578    wwslog('info', '');
14579
14580    my $to;
14581
14582    # Send the message to the list or to the sender as clicking the send to
14583    # the list or to me.
14584    # First if : send to the list
14585    if ($in{'sub_action'} eq 'sendmailtolist') {
14586        # In archive we hide email replacing @ by ' '. Here we must do the
14587        # reverse transformation
14588        $in{'to'} =~ s/ /\@/g;
14589        $to = $in{'to'};
14590
14591        unless ($to) {
14592            unless ($param->{'list'}) {
14593                Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
14594                    {'argument' => 'list'},
14595                    $param->{'action'});
14596                wwslog('info', 'No list');
14597                web_db_log(
14598                    {   'robot'        => $robot,
14599                        'list'         => $list->{'name'},
14600                        'action'       => $param->{'action'},
14601                        'parameters'   => "",
14602                        'target_email' => "",
14603                        'msg_id'       => '',
14604                        'status'       => 'error',
14605                        'error_type'   => 'no_list',
14606                        'user_email'   => $param->{'user'}{'email'},
14607                    }
14608                );
14609                return undef;
14610            }
14611            $to = Sympa::get_address($list);
14612        }
14613        unless ($param->{'may_post'}) {
14614            Sympa::WWW::Report::reject_report_web('auth',
14615                $param->{'may_post_reason'},
14616                {}, $param->{'action'}, $list);
14617            wwslog('info', 'May not send message');
14618            web_db_log(
14619                {   'robot'        => $robot,
14620                    'list'         => $list->{'name'},
14621                    'action'       => $param->{'action'},
14622                    'parameters'   => "",
14623                    'target_email' => "",
14624                    'msg_id'       => '',
14625                    'status'       => 'error',
14626                    'error_type'   => 'authorization',
14627                    'user_email'   => $param->{'user'}{'email'},
14628                }
14629            );
14630            return undef;
14631        }
14632    }
14633
14634    # Determine user's character set.
14635    my $charset = Conf::lang2charset($language->get_lang);
14636
14637    # Take the sender mail
14638    my $from = $param->{'user'}{'email'};
14639
14640    # Send the mail to the sender. To test their message
14641    # Second if : send to the sender "send to me"
14642    if ($in{'sub_action'} eq 'sendmailtome') {
14643        #Set the sender mail to the addressee
14644        $to = $from;
14645    }
14646
14647    if (defined $param->{'subscriber'}) {
14648        $from =
14649            Sympa::Tools::Text::addrencode($from,
14650            $param->{'subscriber'}{'gecos'}, $charset);
14651    }
14652
14653    # Encode subject.
14654    my $encoded_subject = MIME::EncWords::encode_mimewords(
14655        Encode::decode_utf8($in{'subject'}),
14656        Charset     => $charset,
14657        Encoding    => 'A',
14658        Field       => 'Subject',
14659        Replacement => 'FALLBACK'
14660    ) if defined $in{'subject'} and $in{'subject'} =~ /\S/;
14661
14662    ##--------------- TOPICS --------------------
14663    my $list_topics;
14664    if ($list->is_there_msg_topic()) {
14665        my @msg_topics;
14666
14667        foreach my $msg_topic (@{$list->{'admin'}{'msg_topic'}}) {
14668            my $var_name = "topic_" . "$msg_topic->{'name'}";
14669            if ($in{"$var_name"}) {
14670                push @msg_topics, $msg_topic->{'name'};
14671            }
14672        }
14673
14674        $list_topics = join(',', @msg_topics);
14675    }
14676
14677    if (!$list_topics && $list->is_msg_topic_tagging_required()) {
14678        Sympa::WWW::Report::reject_report_web('user', 'msg_topic_missing', {},
14679            $param->{'action'});
14680        wwslog('info', 'Message(s) without topic but in a required list');
14681        web_db_log(
14682            {   'robot'        => $robot,
14683                'list'         => $list->{'name'},
14684                'action'       => $param->{'action'},
14685                'parameters'   => "",
14686                'target_email' => "",
14687                'msg_id'       => '',
14688                'status'       => 'error',
14689                'error_type'   => 'no_topic',
14690                'user_email'   => $param->{'user'}{'email'},
14691            }
14692        );
14693        return undef;
14694    }
14695
14696    # "In-Reply-To:" field, eliminating hostile characters.
14697    my $in_reply_to =
14698        Sympa::Tools::Text::canonic_message_id($in{'in_reply_to'});
14699    undef $in_reply_to if $in_reply_to and $in_reply_to =~ /[\s<>]/;
14700
14701    ##--------------- send an html page or a message -------------------
14702    my $message;
14703
14704    if ($in{'html_news_letter'}) {
14705        # url and uploaded_file should not be both empty -> missing argument
14706        unless ($in{'url'} =~ /\S/ or $in{'uploaded_file'} =~ /\S/) {
14707            Sympa::WWW::Report::reject_report_web('user',
14708                'missing_post_source', {}, $param->{'action'});
14709            wwslog('info', 'Missing URL and uploaded file');
14710            return 'compose_mail';
14711        }
14712
14713        # url and uploaded_file should not be both filled: we could not chooe
14714        # which one to use.
14715        if ($in{'url'} =~ /\S/ and $in{'uploaded_file'} =~ /\S/) {
14716            Sympa::WWW::Report::reject_report_web('user',
14717                'two_post_sources_defined', {}, $param->{'action'});
14718            wwslog(
14719                'info',
14720                'User specified both an URL (%s) and a file to upload (%s). Can\'t choose between them',
14721                $in{'url'},
14722                $in{'uploaded_file'}
14723            );
14724            return 'compose_mail';
14725        }
14726        my $page_source;
14727        if ($in{'uploaded_file'} =~ /\S/) {
14728            my $fh    = $query->upload('uploaded_file');
14729            my $ctype = $query->uploadInfo($fh)->{'Content-Type'}
14730                if $fh;
14731            unless ($ctype and lc $ctype eq 'text/html') {
14732                wwslog('err', 'Can\'t upload %s (%s)',
14733                    $in{'uploaded_file'}, $ctype || 'unknown type');
14734                Sympa::WWW::Report::reject_report_web(
14735                    'intern',
14736                    'cannot_upload',
14737                    {'path' => $in{'uploaded_file'}},
14738                    $param->{'action'},
14739                    $list,
14740                    $param->{'user'}{'email'},
14741                    $robot
14742                );
14743                web_db_log(
14744                    {   'robot'        => $robot,
14745                        'list'         => $list->{'name'},
14746                        'action'       => $param->{'action'},
14747                        'parameters'   => $in{'uploaded_file'},
14748                        'target_email' => "",
14749                        'msg_id'       => '',
14750                        'status'       => 'error',
14751                        'error_type'   => 'internal',
14752                        'user_email'   => $param->{'user'}{'email'},
14753                    }
14754                );
14755                return undef;
14756            }
14757
14758            #FIXME: Check the size!
14759            $page_source = do { local $RS; <$fh> };
14760            close $fh;
14761
14762            # If uploaded content looks like URL, escape it by newline.
14763            if ($page_source and $page_source =~ m{^[-\w]+://}) {
14764                $page_source = "\n$page_source";
14765            }
14766        } else {
14767            $page_source = $in{'url'};
14768        }
14769
14770        # Generate message from page source.
14771        # FIXME: Always UTF-8 is assumed: Pages by other charset are broken.
14772        my $mail_html = MIME::Lite::HTML->new(
14773            HTMLCharset    => 'utf-8',
14774            TextCharset    => 'utf-8',
14775            TextEncoding   => '8bit',
14776            HTMLEncoding   => '8bit',
14777            IncludeType    => 'cid',
14778            remove_jscript => '1',       #delete the scripts in the html
14779            'From'         => $from,
14780            'To'           => $to,
14781            'Message-Id' => $in{'message_id'},
14782            (   $in_reply_to ? ('In-Reply-To' => '<' . $in_reply_to . '>')
14783                : ()
14784            ),
14785            (     (defined $encoded_subject) ? ('Subject' => $encoded_subject)
14786                : ()
14787            ),
14788        );
14789        # Restrict protocols of URL entered _and_ URLs embedded in the pages.
14790        $mail_html->{_AGENT}
14791            ->protocols_allowed(['http', 'https', 'ftp', 'nntp']);
14792
14793        # parse return the MIME::Lite part to send
14794        my $part = eval { $mail_html->parse($page_source) };
14795        unless ($part) {
14796            my $error = join("\n", $mail_html->errstr) || 'Unknown error';
14797            Sympa::WWW::Report::reject_report_web('user', 'unable_to_parse',
14798                {error => $error},
14799                $param->{'action'});
14800            wwslog(
14801                'info',
14802                'A MIME part could not be created with the supplied data, %s, %s: %s',
14803                $in{'url'},
14804                $in{'uploaded_file'},
14805                $error
14806            );
14807            return undef;
14808        }
14809        $message = Sympa::Message->new($part->as_string, context => $list);
14810        $message->reformat_utf8_message([], 'utf-8');
14811    } else {
14812        ## Message body should not be empty
14813        if ($in{'body'} =~ /^\s*$/) {
14814            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
14815                {'argument' => 'body'},
14816                $param->{'action'});
14817            wwslog('info', 'Missing body');
14818            web_db_log(
14819                {   'robot'        => $robot,
14820                    'list'         => $list->{'name'},
14821                    'action'       => $param->{'action'},
14822                    'parameters'   => "",
14823                    'target_email' => "",
14824                    'msg_id'       => '',
14825                    'status'       => 'error',
14826                    'error_type'   => 'no_body',
14827                    'user_email'   => $param->{'user'}{'email'},
14828                }
14829            );
14830            return undef;
14831        }
14832
14833        my $msg_string = sprintf "From: %s\nTo: %s\nMessage-Id: %s\n",
14834            $from, $to, $in{'message_id'};
14835        $msg_string .= sprintf "In-Reply-To: <%s>\n", $in_reply_to
14836            if $in_reply_to;
14837        $msg_string .= sprintf "Subject: %s\n", $encoded_subject
14838            if defined $encoded_subject;
14839
14840        # Format current time.
14841        # If setting local timezone fails, fallback to UTC.
14842        my $date =
14843            (eval { DateTime->now(time_zone => 'local') } || DateTime->now)
14844            ->strftime('%a, %{day} %b %Y %H:%M:%S %z');
14845        $msg_string .= sprintf "Date: %s\n", $date;
14846
14847        if (Conf::get_robot_conf($robot, 'use_html_editor') eq 'on'
14848            and length(Conf::get_robot_conf($robot, 'html_editor_url') // ''))
14849        {
14850            $msg_string .= sprintf "Content-Type: text/html\n\n%s",
14851                $in{'body'};
14852        } else {
14853            $msg_string .= sprintf "Content-Type: text/plain\n\n%s",
14854                $in{'body'};
14855        }
14856        $msg_string =~ s/(?<!\n)\z/\n/;
14857
14858        $message = Sympa::Message->new($msg_string, context => $list);
14859        $message->reformat_utf8_message([], $charset);
14860    }
14861
14862    # Roughly check TT2 syntax for personalization.
14863    if (    'on' eq ($list->{'admin'}{'personalization_feature'} || 'off')
14864        and 'all' eq
14865        ($list->{'admin'}{'personalization'}{'web_apply_on'} || 'none')) {
14866        my $new_message = $message->dup;
14867        unless (defined $new_message->personalize($list)) {
14868            # FIXME: Get last_error of template object.
14869            Sympa::WWW::Report::reject_report_web('user', 'merge_failed',
14870                {'error' => 'Syntax error'},
14871                $param->{'action'});
14872            return 'compose_mail';
14873        }
14874    }
14875
14876    # - Message bound for list will be injected into incoming spool directly.
14877    #   In this case message will have "md5" authentication level.
14878    # - Message bound for user will be injected into bulk spool.
14879    #FIXME: Check destinations: they should be list, original sender, user or
14880    # other_email.
14881    my @to_list =
14882        grep { $_ eq Sympa::get_address($list) } split /\s*,\s*/, $to;
14883    my @to_user =
14884        grep {
14885                $_
14886            and $_ ne Sympa::get_address($list)
14887            and $_ ne $param->{'user'}{'email'}
14888        } split /\s*,\s*/, $to;
14889    my @to_me =
14890        grep {
14891                $_
14892            and $_ ne Sympa::get_address($list)
14893            and $_ eq $param->{'user'}{'email'}
14894        } split /\s*,\s*/, $to;
14895
14896    if (@to_me) {
14897        my $u_message = $message->dup;
14898
14899        # Since some users may send message to themselves to test message
14900        # decoration and/or personalization, add such processing.
14901        # - Add footer / header.
14902        $u_message->prepare_message_according_to_mode('mail', $list);
14903        # - Shelve personalization.
14904        $u_message->shelve_personalization(type => 'web');
14905
14906        $u_message->{envelope_sender} = Sympa::get_address($robot, 'owner');
14907        $u_message->{priority} =
14908            Conf::get_robot_conf($robot, 'sympa_priority');
14909
14910        unless (defined $bulk->store($u_message, [@to_me])) {
14911            Sympa::WWW::Report::reject_report_web(
14912                'intern',
14913                'cannot_send_mail',
14914                {   'from'     => $param->{'user'}{'email'},
14915                    'listname' => $list->{'name'}
14916                },
14917                $param->{'action'},
14918                $list,
14919                $param->{'user'}{'email'},
14920                $robot
14921            );
14922            wwslog('err', 'Failed to send message for %s', $to);
14923            web_db_log(
14924                {   'robot'        => $robot,
14925                    'list'         => $list->{'name'},
14926                    'action'       => $param->{'action'},
14927                    'parameters'   => $to,
14928                    'target_email' => "",
14929                    'msg_id'       => '',
14930                    'status'       => 'error',
14931                    'error_type'   => 'internal',
14932                    'user_email'   => $param->{'user'}{'email'},
14933                }
14934            );
14935            return undef;
14936        }
14937    }
14938
14939    if (@to_user) {
14940        my $u_message = $message->dup;
14941        # Set <sympa-request> address as envelope sender.
14942        $u_message->{envelope_sender} = Sympa::get_address($robot, 'owner');
14943        $u_message->{priority} =
14944            Conf::get_robot_conf($robot, 'sympa_priority');
14945
14946        unless (defined $bulk->store($u_message, [@to_user])) {
14947            Sympa::WWW::Report::reject_report_web(
14948                'intern',
14949                'cannot_send_mail',
14950                {   'from'     => $param->{'user'}{'email'},
14951                    'listname' => $list->{'name'}
14952                },
14953                $param->{'action'},
14954                $list,
14955                $param->{'user'}{'email'},
14956                $robot
14957            );
14958            wwslog('err', 'Failed to send message for %s', $to);
14959            web_db_log(
14960                {   'robot'        => $robot,
14961                    'list'         => $list->{'name'},
14962                    'action'       => $param->{'action'},
14963                    'parameters'   => $to,
14964                    'target_email' => "",
14965                    'msg_id'       => '',
14966                    'status'       => 'error',
14967                    'error_type'   => 'internal',
14968                    'user_email'   => $param->{'user'}{'email'},
14969                }
14970            );
14971            return undef;
14972        }
14973    }
14974
14975    if (@to_list and $in{'sub_action'} eq 'sendmailtolist') {
14976        # TAG
14977        if ($list_topics) {
14978            Sympa::Spool::Topic->new(
14979                topic  => $list_topics,
14980                method => 'sender'
14981            )->store($message);
14982        }
14983
14984        my $l_message = $message->dup;
14985
14986        # - Shelve personalization.
14987        $l_message->shelve_personalization(type => 'web');
14988
14989        $l_message->{envelope_sender} = $param->{'user'}{'email'};
14990        $l_message->{sender}          = $param->{'user'}{'email'};
14991        $l_message->{md5_check}       = 1;
14992
14993        unless (Sympa::Spool::Incoming->new->store($l_message)) {
14994            Sympa::WWW::Report::reject_report_web(
14995                'intern',
14996                'cannot_send_mail',
14997                {   'from'     => $param->{'user'}{'email'},
14998                    'listname' => $list->{'name'}
14999                },
15000                $param->{'action'},
15001                $list,
15002                $param->{'user'}{'email'},
15003                $robot
15004            );
15005            wwslog('err', 'Failed to send message for list %s', $list);
15006            web_db_log(
15007                {   'parameters' => join(',', @to_list),
15008                    'status'     => 'error',
15009                    'error_type' => 'internal'
15010                }
15011            );
15012            return undef;
15013        }
15014    }
15015
15016    Sympa::WWW::Report::notice_report_web('performed', {},
15017        $param->{'action'});
15018    web_db_log(
15019        {   'robot'        => $robot,
15020            'list'         => $list->{'name'},
15021            'action'       => $param->{'action'},
15022            'parameters'   => "",
15023            'target_email' => "",
15024            'msg_id'       => '',
15025            'status'       => 'success',
15026            'error_type'   => '',
15027            'user_email'   => $param->{'user'}{'email'},
15028        }
15029    );
15030
15031    if ($in{'sub_action'} eq 'sendmailtome') {
15032        $param->{'body'} = $in{'body'};
15033        return 'compose_mail';
15034    } else {
15035        return 'info';
15036    }
15037}
15038
15039####################################################
15040#  do_request_topic
15041####################################################
15042#  Web page for a sender to tag their mail in message
15043#  topic context.
15044#
15045# IN : -
15046#
15047# OUT : '1' | 'loginrequest' | undef
15048#
15049####################################################
15050sub do_request_topic {
15051    wwslog('info', '(%s)', $in{'authkey'});
15052
15053    unless ($list->is_there_msg_topic()) {
15054        Sympa::WWW::Report::reject_report_web('user', 'no_topic', {},
15055            $param->{'action'}, $list);
15056        wwslog('info', 'List without topic message');
15057        return undef;
15058    }
15059
15060    foreach my $top (@{$list->{'admin'}{'msg_topic'}}) {
15061        if ($top->{'name'}) {
15062            push(@{$param->{'available_topics'}}, $top);
15063        }
15064    }
15065
15066    $param->{'to'}      = Sympa::get_address($list);
15067    $param->{'authkey'} = $in{'authkey'};
15068
15069    my $spool_held =
15070        Sympa::Spool::Held->new(context => $list, authkey => $in{'authkey'});
15071    my ($message, $handle);
15072    while (1) {
15073        ($message, $handle) = $spool_held->next(no_lock => 1);
15074        last unless $handle;
15075        last if $message;
15076    }
15077    unless ($message) {
15078        Sympa::WWW::Report::reject_report_web('intern', 'already_confirmed',
15079            {key => $in{'authkey'}},
15080            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
15081        wwslog('notice', 'Cannot get message with key <%s> for list %s',
15082            $in{'authkey'}, $list);
15083        return undef;
15084    }
15085
15086    # headers will be encoded later.
15087    $param->{'subject'}    = $message->{'decoded_subject'};
15088    $param->{'from'}       = $message->get_decoded_header('From');
15089    $param->{'date'}       = $message->get_decoded_header('Date');
15090    $param->{'message_id'} = $message->{'message_id'};
15091    $param->{'body'}       = $message->get_plain_body;               #FIXME
15092
15093    $param->{'topic_required'} = $list->is_msg_topic_tagging_required();
15094
15095    return 1;
15096}
15097
15098####################################################
15099#  do_tag_topic_by_sender
15100####################################################
15101#  Tag a mail by its sender : tag the mail and
15102#  send a command CONFIRM for it
15103#
15104# IN : -
15105#
15106# OUT : 'loginrequest' | 'info' | undef
15107#
15108####################################################
15109sub do_tag_topic_by_sender {
15110    wwslog('info', '');
15111
15112    my $spool_held =
15113        Sympa::Spool::Held->new(context => $list, authkey => $in{'authkey'});
15114    my ($message, $handle);
15115    while (1) {
15116        ($message, $handle) = $spool_held->next(no_lock => 1);
15117        last unless $handle;
15118        last if $message;
15119    }
15120    unless ($message) {
15121        Sympa::WWW::Report::reject_report_web('intern', 'already_confirmed',
15122            {key => $in{'authkey'}},
15123            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
15124        wwslog('info', 'cannot get message with key <%s> for list %s',
15125            $in{'authkey'}, $list);
15126        return undef;
15127    }
15128    my $sender = $message->{'sender'};
15129
15130    unless ($list->is_there_msg_topic()) {
15131        Sympa::WWW::Report::reject_report_web('user', 'no_topic', {},
15132            $param->{'action'}, $list);
15133        wwslog('info', 'List without topic message');
15134        return undef;
15135    }
15136
15137    my @msg_topics;
15138    foreach my $msg_topic (@{$list->{'admin'}{'msg_topic'}}) {
15139        my $var_name = "topic_" . "$msg_topic->{'name'}";
15140        if ($in{"$var_name"}) {
15141            push @msg_topics, $msg_topic->{'name'};
15142        }
15143    }
15144    my $list_topics = join(',', @msg_topics);
15145
15146    if (!$list_topics && $list->is_msg_topic_tagging_required()) {
15147        Sympa::WWW::Report::reject_report_web('user', 'msg_topic_missing', {},
15148            $param->{'action'}, $list);
15149        wwslog('info', 'Message without topic but in a required list');
15150        return undef;
15151    }
15152
15153    # TAG
15154    Sympa::Spool::Topic->new(topic => $list_topics, method => 'sender')
15155        ->store($message);
15156
15157    ## CONFIRM
15158    # Commands are injected into incoming spool directly with "md5"
15159    # authentication level.
15160    my $time        = time;
15161    my $cmd_message = Sympa::Message->new(
15162        sprintf("\n\nQUIET CONFIRM %s\n", $in{'authkey'}),
15163        context         => $robot,
15164        envelope_sender => Sympa::get_address($robot, 'owner'),
15165        sender          => $sender,
15166        md5_check       => 1,
15167        message_id      => sprintf('<%s@wwsympa>', $time)
15168    );
15169    $cmd_message->add_header('Content-Type', 'text/plain; Charset=utf-8');
15170
15171    unless (Sympa::Spool::Incoming->new->store($cmd_message)) {
15172        Sympa::WWW::Report::reject_report_web(
15173            'intern',
15174            'cannot_send_mail',
15175            {   'from'     => $param->{'user'}{'email'},
15176                'listname' => $list->{'name'}
15177            },
15178            $param->{'action'},
15179            $list,
15180            $param->{'user'}{'email'},
15181            $robot
15182        );
15183        wwslog('err', 'Failed to send message to comfirm message %s',
15184            $message);
15185        return undef;
15186    }
15187
15188    Sympa::WWW::Report::notice_report_web('performed_soon', {},
15189        $param->{'action'});
15190    return 'info';
15191}
15192
15193sub do_search_user {
15194    wwslog('info', '');
15195
15196    if ($in{'email'} =~ /[<>\\\*\$]/) {
15197        Sympa::WWW::Report::reject_report_web('user', 'syntax_errors',
15198            {p_name => 'email'},
15199            $param->{'action'});
15200        wwslog('err', 'Syntax error');
15201        return undef;
15202    }
15203
15204    foreach my $role ('member', 'owner', 'editor') {
15205        foreach my $list (Sympa::List::get_which($in{'email'}, $robot, $role))
15206        {
15207            my $l = $list->{'name'};
15208
15209            next unless (defined $list);
15210            $param->{'which'}{$l}{'subject'} = $list->{'admin'}{'subject'};
15211            # Compat. < 6.2.32
15212            $param->{'which'}{$l}{'host'} = $list->{'domain'};
15213
15214            # show the requestor role not the requested one
15215            if (   $list->is_admin('owner', $param->{'user'}{'email'})
15216                or $list->is_admin('editor', $param->{'user'}{'email'})
15217                or Sympa::is_listmaster($list, $param->{'user'}{'email'})) {
15218                $param->{'which'}{$l}{'admin'} = 1;
15219            }
15220
15221            if ($role eq 'member') {
15222                $param->{'which'}{$l}{'is_member'}  = 1;
15223                $param->{'which'}{$l}{'subscribed'} = 1
15224                    if $list->{'user'}{'subscribed'};
15225                my @keys = qw(reception bounce topic);
15226                @{$param->{'which'}{$l}}{@keys} = @{$list->{'user'}}{@keys};
15227
15228                # Compat. <= 6.2.44
15229                $param->{'which'}{$l}{'included'} = 1
15230                    if defined $list->{'user'}{'inclusion'};
15231            } elsif ($role eq 'owner') {
15232                $param->{'which'}{$l}{'is_owner'} = 1;
15233            } elsif ($role eq 'editor') {
15234                $param->{'which'}{$l}{'is_editor'} = 1;
15235            }
15236        }
15237    }
15238
15239    $param->{'email'} = $in{'email'};
15240
15241    unless (defined $param->{'which'}) {
15242        Sympa::WWW::Report::reject_report_web('user', 'no_entry',
15243            {'email' => $in{'email'}},
15244            $param->{'action'});
15245        wwslog('info', 'No entry for %s', $in{'email'});
15246        return 'serveradmin';
15247    }
15248
15249    return 1;
15250}
15251
15252## Set language
15253sub do_set_lang {
15254    wwslog('info', '(%s)', $in{'lang'});
15255
15256    my $lang;
15257    if ($in{'lang'} and $lang = $language->set_lang($in{'lang'})) {
15258        $session->{'lang'} = $lang;
15259        $param->{'lang'}   = $lang;
15260        # compatibility: old-style locale.
15261        $param->{'locale'} = Sympa::Language::lang2oldlocale($lang);
15262        # compatibility: 6.1.
15263        $param->{'lang_tag'} = $lang;
15264
15265        #FIXME:Should users' language preferences be changed?
15266        if ($param->{'user'}{'email'}) {
15267            if (Sympa::User::is_global_user($param->{'user'}{'email'})) {
15268                unless (
15269                    Sympa::User::update_global_user(
15270                        $param->{'user'}{'email'},
15271                        {'lang' => $lang}
15272                    )
15273                ) {
15274                    Sympa::WWW::Report::reject_report_web(
15275                        'intern',
15276                        'update_user_db_failed',
15277                        {'user' => $param->{'user'}},
15278                        $param->{'action'},
15279                        '',
15280                        $param->{'user'}{'email'},
15281                        $robot
15282                    );
15283                    wwslog('info', 'Update failed');
15284                    web_db_log(
15285                        {   'robot'        => $robot,
15286                            'list'         => $list->{'name'},
15287                            'action'       => $param->{'action'},
15288                            'parameters'   => "$in{'lang'}",
15289                            'target_email' => "$param->{'user'}{'email'}",
15290                            'msg_id'       => '',
15291                            'status'       => 'error',
15292                            'error_type'   => 'internal',
15293                            'user_email'   => $param->{'user'}{'email'},
15294                        }
15295                    );
15296                    return undef;
15297                }
15298            } else {
15299                unless (
15300                    Sympa::User::add_global_user(
15301                        {   'email' => $param->{'user'}{'email'},
15302                            'lang'  => $lang
15303                        }
15304                    )
15305                ) {
15306                    Sympa::WWW::Report::reject_report_web(
15307                        'intern',
15308                        'add_user_db_failed',
15309                        {'user' => $param->{'user'}},
15310                        $param->{'action'},
15311                        '',
15312                        $param->{'user'}{'email'},
15313                        $robot
15314                    );
15315                    wwslog('info', 'Update failed');
15316                    web_db_log(
15317                        {   'robot'        => $robot,
15318                            'list'         => $list->{'name'},
15319                            'action'       => $param->{'action'},
15320                            'parameters'   => "$in{'lang'}",
15321                            'target_email' => "$param->{'user'}{'email'}",
15322                            'msg_id'       => '',
15323                            'status'       => 'error',
15324                            'error_type'   => 'internal',
15325                            'user_email'   => $param->{'user'}{'email'},
15326                        }
15327                    );
15328                    return undef;
15329                }
15330            }
15331        }
15332    }
15333
15334    if ($in{'previous_action'}) {
15335        ## Some actions don't make sense with GET method, redirecting to other
15336        ## functions
15337        if ($in{'previous_action'} eq 'arcsearch') {
15338            $in{'previous_action'} = 'arc';
15339        }
15340        $in{'list'} = $in{'previous_list'};
15341        return $in{'previous_action'};
15342    }
15343
15344    return Conf::get_robot_conf($robot, 'default_home');
15345}
15346## Function do_attach
15347sub do_attach {
15348    wwslog('info', '(%s, %s)', $in{'dir'}, $in{'file'});
15349
15350    # Avoid directory traversal.
15351    return undef if 0 <= index $in{'dir'}, '/' or 0 <= index $in{'file'}, '/';
15352
15353    ### Useful variables
15354
15355    # current list / current shared directory
15356    my $list_name = $list->{'name'};
15357
15358    # path of the urlized directory
15359    my $urlizeddir = $list->{'dir'} . '/urlized';
15360
15361    # document to read
15362    my $doc = $urlizeddir . '/' . $in{'dir'} . '/' . $in{'file'};
15363
15364    ### Document exist ?
15365    unless (-e "$doc") {
15366        wwslog('info', 'Unable to read %s: no such file or directory', $doc);
15367        Sympa::WWW::Report::reject_report_web('user', 'no_such_document',
15368            {'path' => $in{'dir'} . '/' . $in{'file'}},
15369            $param->{'action'}, $list);
15370        web_db_log(
15371            {   'robot'        => $robot,
15372                'list'         => $list->{'name'},
15373                'action'       => $param->{'action'},
15374                'parameters'   => "$in{'dir'},$in{'file'}",
15375                'target_email' => "",
15376                'msg_id'       => '',
15377                'status'       => 'error',
15378                'error_type'   => 'no_file',
15379                'user_email'   => $param->{'user'}{'email'},
15380            }
15381        );
15382        return undef;
15383    }
15384
15385    ### Document has non-size zero?
15386    unless (-s "$doc") {
15387        wwslog('info', 'Unable to read %s: empty document', $doc);
15388        Sympa::WWW::Report::reject_report_web('user', 'empty_document',
15389            {'path' => $in{'dir'} . '/' . $in{'file'}},
15390            $param->{'action'}, $list);
15391        web_db_log(
15392            {   'robot'        => $robot,
15393                'list'         => $list->{'name'},
15394                'action'       => $param->{'action'},
15395                'parameters'   => "$in{'dir'},$in{'file'}",
15396                'target_email' => "",
15397                'msg_id'       => '',
15398                'status'       => 'error',
15399                'error_type'   => 'empty_file',
15400                'user_email'   => $param->{'user'}{'email'},
15401            }
15402        );
15403        return undef;
15404    }
15405
15406    ## Access control
15407    return undef
15408        unless defined check_authz('do_attach', 'archive_web_access');
15409
15410    # parameters for the template file
15411    # view a file
15412    $param->{'file'}   = $doc;
15413    $param->{'bypass'} = 'asis';
15414    print "Content-Disposition: attachment\n";
15415
15416    ## File type
15417    if ($in{'file'} =~ /\.(\w+)$/) {
15418        $param->{'file_extension'} = $1;
15419    }
15420    web_db_log(
15421        {   'robot'        => $robot,
15422            'list'         => $list->{'name'},
15423            'action'       => $param->{'action'},
15424            'parameters'   => "$in{'dir'},$in{'file'}",
15425            'target_email' => "",
15426            'msg_id'       => '',
15427            'status'       => 'success',
15428            'error_type'   => '',
15429            'user_email'   => $param->{'user'}{'email'},
15430        }
15431    );
15432    return 1;
15433}
15434
15435sub do_subindex {
15436    wwslog('info', '');
15437
15438    my $spool_req =
15439        Sympa::Spool::Auth->new(context => $list, action => 'add');
15440    my @subscriptions;
15441    while (1) {
15442        my ($request, $handle) = $spool_req->next(no_lock => 1);
15443        last unless $handle;
15444        next unless $request;
15445
15446        push @subscriptions,
15447            {
15448            key   => $request->{keyauth},
15449            value => {
15450                custom_attribute => $request->{custom_attribute},
15451                date             => $language->gettext_strftime(
15452                    '%d %b %Y', localtime $request->{date}
15453                ),
15454                email => $request->{email},
15455                epoch => $request->{date},
15456                gecos => $request->{gecos},
15457            },
15458            };
15459    }
15460    $param->{'subscriptions'} = [@subscriptions];
15461
15462    web_db_log(
15463        {   'robot'        => $robot,
15464            'list'         => $list->{'name'},
15465            'action'       => $param->{'action'},
15466            'parameters'   => "",
15467            'target_email' => "",
15468            'msg_id'       => '',
15469            'status'       => 'success',
15470            'error_type'   => '',
15471            'user_email'   => $param->{'user'}{'email'},
15472        }
15473    );
15474    return 1;
15475}
15476
15477# By owner, declines held subscribe (add) requests.
15478# Old name: do_ignoresub().
15479sub do_decl_add {
15480    wwslog('info', '(%s)', $in{'id'});
15481
15482    my @ids = grep { $_ and /\A\w+\z/ } split /\0/, $in{'id'};
15483    return ($in{'previous_action'} || 'subindex') unless @ids;
15484
15485    $param->{'id'} = [@ids];
15486
15487    # Action confirmed?
15488    my $next_action = $session->confirm_action(
15489        $in{'action'}, $in{'response_action'},
15490        arg             => join(',', sort @ids),
15491        previous_action => ($in{'previous_action'} || 'subindex'),
15492    );
15493    return $next_action unless $next_action eq '1';
15494
15495    my $spindle = Sympa::Spindle::ProcessRequest->new(
15496        context          => $robot,
15497        action           => 'decl',
15498        keyauth          => [@ids],
15499        request          => {context => $list, action => 'add'},
15500        sender           => $param->{'user'}{'email'},
15501        scenario_context => {
15502            sender      => $param->{'user'}{'email'},
15503            remote_host => $param->{'remote_host'},
15504            remote_addr => $param->{'remote_addr'}
15505        },
15506    );
15507    unless ($spindle and $spindle->spin) {
15508        return ($in{'previous_action'} || 'subindex');
15509    }
15510
15511    foreach my $report (@{$spindle->{stash} || []}) {
15512        if ($report->[1] eq 'notice') {
15513            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
15514                $param->{'action'});
15515        } else {
15516            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
15517                $param->{action});
15518        }
15519    }
15520    unless (@{$spindle->{stash} || []}) {
15521        Sympa::WWW::Report::notice_report_web('performed', {},
15522            $param->{'action'});
15523    }
15524
15525    return ($in{'previous_action'} || 'subindex');
15526}
15527
15528sub do_sigindex {
15529    wwslog('info', '');
15530
15531    my $spool_req =
15532        Sympa::Spool::Auth->new(context => $list, action => 'del');
15533    my @signoffs;
15534    while (1) {
15535        my ($request, $handle) = $spool_req->next(no_lock => 1);
15536        last unless $handle;
15537        next unless $request;
15538
15539        push @signoffs,
15540            {
15541            key   => $request->{keyauth},
15542            value => {
15543                date => $language->gettext_strftime(
15544                    '%d %b %Y', localtime $request->{date}
15545                ),
15546                email => $request->{email},
15547                epoch => $request->{date},
15548            },
15549            };
15550    }
15551    $param->{'signoffs'} = [@signoffs];
15552
15553    web_db_log(
15554        {   'robot'        => $robot,
15555            'list'         => $list->{'name'},
15556            'action'       => $param->{'action'},
15557            'parameters'   => "",
15558            'target_email' => "",
15559            'msg_id'       => '',
15560            'status'       => 'success',
15561            'error_type'   => '',
15562            'user_email'   => $param->{'user'}{'email'},
15563        }
15564    );
15565    return 1;
15566}
15567
15568# By owner, declines held signoff (del) requests.
15569# Old name: do_ignoresig().
15570sub do_decl_del {
15571    wwslog('info', '(%s)', $in{'id'});
15572
15573    my @ids = grep { $_ and /\A\w+\z/ } split /\0/, $in{'id'};
15574    return ($in{'previous_action'} || 'sigindex') unless @ids;
15575
15576    $param->{'id'} = [@ids];
15577
15578    # Action confirmed?
15579    my $next_action = $session->confirm_action(
15580        $in{'action'}, $in{'response_action'},
15581        arg             => join(',', sort @ids),
15582        previous_action => ($in{'previous_action'} || 'sigindex'),
15583    );
15584    return $next_action unless $next_action eq '1';
15585
15586    my $spindle = Sympa::Spindle::ProcessRequest->new(
15587        context          => $robot,
15588        action           => 'decl',
15589        keyauth          => [@ids],
15590        request          => {context => $list, action => 'del'},
15591        sender           => $param->{'user'}{'email'},
15592        scenario_context => {
15593            sender      => $param->{'user'}{'email'},
15594            remote_host => $param->{'remote_host'},
15595            remote_addr => $param->{'remote_addr'}
15596        },
15597    );
15598    unless ($spindle and $spindle->spin) {
15599        return ($in{'previous_action'} || 'sigindex');
15600    }
15601
15602    foreach my $report (@{$spindle->{stash} || []}) {
15603        if ($report->[1] eq 'notice') {
15604            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
15605                $param->{'action'});
15606        } else {
15607            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
15608                $param->{action});
15609        }
15610    }
15611    unless (@{$spindle->{stash} || []}) {
15612        Sympa::WWW::Report::notice_report_web('performed', {},
15613            $param->{'action'});
15614    }
15615
15616    return ($in{'previous_action'} || 'sigindex');
15617}
15618
15619sub do_stats {
15620    wwslog('info', '');
15621
15622    $param->{'shared_size'} =
15623        int((Sympa::WWW::SharedDocument->new($list)->get_size + 512) / 1024);
15624    $param->{'arc_size'} =
15625        int((Sympa::Archive->new(context => $list)->get_size + 512) / 1024);
15626
15627    my $stats = {
15628        send_mail => {title => $language->gettext("Mail sending")},
15629        add_or_subscribe =>
15630            {title => $language->gettext("Subscription additions")},
15631        signoff => {title => $language->gettext("Unsubscription")},
15632        del     => {title => $language->gettext("Users deleted by admin")},
15633        auto_del =>
15634            {title => $language->gettext("Users deleted automatically")},
15635        d_upload      => {title => $language->gettext("File uploading")},
15636        d_create_file => {title => $language->gettext("File creation")},
15637        d_create_dir  => {title => $language->gettext("Directory creation")},
15638    };
15639
15640    foreach my $operation (keys %$stats) {
15641        my $data = $log->aggregate_daily_data($list, $operation);
15642        if (%{$data || {}}) {
15643            $stats->{$operation}{'stats_values'} = '[' . join(
15644                ',',
15645                map {
15646                    my $formatted_date =
15647                        $language->gettext_strftime('%d %b %Y', localtime $_);
15648                    $formatted_date =~ s/([\\\'])/\\$1/g;
15649                    sprintf "['%s',%d]", $formatted_date, $data->{$_}
15650                } sort keys %$data
15651            ) . ']';
15652        }
15653    }
15654    $param->{'stats'} = $stats;
15655
15656    return 1;
15657}
15658
15659sub _purge_subtopics {
15660    my ($robot, $topic_name, $topic) = @_;
15661
15662    if ($topic->{sub}) {
15663        my @names = (keys %{$topic->{sub}});
15664
15665        for my $name (@names) {
15666            my $result =
15667                Sympa::Scenario->new($robot, 'topics_visibility',
15668                name => $topic->{sub}{$name}->{visibility})->authz(
15669                $param->{'auth_method'},
15670                {   'topicname'   => join('/', $topic_name, $name),
15671                    'sender'      => $param->{'user'}{'email'},
15672                    'remote_host' => $param->{'remote_host'},
15673                    'remote_addr' => $param->{'remote_addr'}
15674                }
15675                );
15676
15677            my $action;
15678            $action = $result->{'action'} if (ref($result) eq 'HASH');
15679
15680            if ($action =~ /do_it/) {
15681                _purge_subtopics($robot, $topic->{sub}->{$name});
15682            } else {
15683                delete $topic->{sub}->{$name};
15684            }
15685        }
15686    }
15687}
15688
15689## setting the topics list for templates
15690sub export_topics {
15691
15692    my $robot = shift;
15693    wwslog('debug2', '(%s)', $robot);
15694    my %topics_orig = Sympa::Robot::load_topics($robot);
15695
15696    unless (%topics_orig) {
15697        wwslog('err', 'No topics defined');
15698        return undef;
15699    }
15700
15701    my $dup    = Sympa::Tools::Data::dup_var(\%topics_orig);
15702    my %topics = %$dup;
15703
15704    ## Remove existing topics
15705    $param->{'topics'} = undef;
15706
15707    my $total = 0;
15708    foreach my $t (
15709        sort { $topics{$a}{'order'} <=> $topics{$b}{'order'} }
15710        keys %topics
15711    ) {
15712        my $result =
15713            Sympa::Scenario->new($robot, 'topics_visibility',
15714            name => $topics{$t}->{visibility})->authz(
15715            $param->{'auth_method'},
15716            {   'topicname'   => $t,
15717                'sender'      => $param->{'user'}{'email'},
15718                'remote_host' => $param->{'remote_host'},
15719                'remote_addr' => $param->{'remote_addr'}
15720            }
15721            );
15722        my $action;
15723        $action = $result->{'action'} if (ref($result) eq 'HASH');
15724        next unless ($action =~ /do_it/);
15725
15726        # Purge concealed subtopics
15727        _purge_subtopics($robot, $t, $topics{$t});
15728
15729        my $current = $topics{$t};
15730        $current->{'id'} = $t;
15731
15732        ## For compatibility reasons
15733        $current->{'mod'}  = $total % 3;
15734        $current->{'mod2'} = $total % 2;
15735
15736        push @{$param->{'topics'}}, $current;
15737
15738        $total++;
15739    }
15740
15741    push @{$param->{'topics'}},
15742        {
15743        'id'  => 'topicsless',
15744        'mod' => $total,
15745        'sub' => {}
15746        };
15747
15748    $param->{'topics'}[int($total / 2)]{'next'} = 1;
15749}
15750
15751# manage blocklist
15752sub do_blocklist {
15753    wwslog('info', '(%s)', $param->{'list'});
15754
15755    unless ($param->{'list'}) {
15756        Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
15757            {'argument' => 'list'},
15758            $param->{'action'});
15759        wwslog('info', 'No list');
15760        web_db_log(
15761            {   'robot'        => $robot,
15762                'list'         => $list->{'name'},
15763                'action'       => $param->{'action'},
15764                'parameters'   => "$param->{'list'}",
15765                'target_email' => "",
15766                'msg_id'       => '',
15767                'status'       => 'error',
15768                'error_type'   => 'no_list',
15769                'user_email'   => $param->{'user'}{'email'},
15770            }
15771        );
15772        return undef;
15773    }
15774    unless ($param->{'is_owner'}
15775        || $param->{'is_editor'}
15776        || $param->{'is_listmaster'}) {
15777        wwslog('info', 'Not listmaster or list owner or list editor');
15778        web_db_log(
15779            {   'robot'        => $robot,
15780                'list'         => $list->{'name'},
15781                'action'       => $param->{'action'},
15782                'parameters'   => "$param->{'list'}",
15783                'target_email' => "",
15784                'msg_id'       => '',
15785                'status'       => 'error',
15786                'error_type'   => 'authorization',
15787                'user_email'   => $param->{'user'}{'email'},
15788            }
15789        );
15790        return undef;
15791    }
15792    my $file = $list->{'dir'} . '/search_filters/blocklist.txt';
15793    $param->{'rows'} = 0;
15794
15795    if (defined $in{'blocklist'}) {
15796        wwslog('info', 'Submit blocklist update');
15797        my $dir = $list->{'dir'} . '/search_filters';
15798        unless ((-d $dir) || mkdir($dir, 0755)) {
15799            Sympa::WWW::Report::reject_report_web('intern',
15800                'unable to create dir');
15801            wwslog('info', 'Unable to create dir %s', $dir);
15802            web_db_log(
15803                {   'robot'        => $robot,
15804                    'list'         => $list->{'name'},
15805                    'action'       => $param->{'action'},
15806                    'parameters'   => "$param->{'list'}",
15807                    'target_email' => "",
15808                    'msg_id'       => '',
15809                    'status'       => 'error',
15810                    'error_type'   => 'internal',
15811                    'user_email'   => $param->{'user'}{'email'},
15812                }
15813            );
15814        }
15815        my $file = $dir . '/blocklist.txt';
15816        my $ofh;
15817        unless (open $ofh, '>', $file) {
15818            Sympa::WWW::Report::reject_report_web('intern',
15819                'unable to create file');
15820            wwslog('info', 'Unable to create file %s', $file);
15821            web_db_log(
15822                {   'robot'        => $robot,
15823                    'list'         => $list->{'name'},
15824                    'action'       => $param->{'action'},
15825                    'parameters'   => "$param->{'list'}",
15826                    'target_email' => "",
15827                    'msg_id'       => '',
15828                    'status'       => 'error',
15829                    'error_type'   => 'internal',
15830                    'user_email'   => $param->{'user'}{'email'},
15831                }
15832            );
15833        }
15834        my @lines = split(/\r\n|\r|\n/, $in{'blocklist'});
15835        $param->{'ignored'} = 0;
15836        my $count =
15837            0;    # count utils lines in order to remove empty blocklist file
15838        foreach my $line (@lines) {
15839            if ($line =~ /\*.*\*/) {
15840                $param->{'ignored_linest'} .= $line . "\n";
15841                $param->{'ignored'} += 1;
15842            } else {
15843                print $ofh "$line\n";
15844                $param->{'blocklist'} .= $line . "\n";
15845                $param->{'rows'} += 1;
15846                $count += 1 unless ($line =~ /^\s*$/o || /^[\#\;]/o);
15847            }
15848        }
15849        close $ofh;
15850        if ($count == 0) {
15851            unless (unlink $file) {
15852                Sympa::WWW::Report::reject_report_web('intern',
15853                    'unable to remove empty blocklist file');
15854                wwslog('info', 'Unable to remove empty blocklist file %s',
15855                    $file);
15856                web_db_log(
15857                    {   'robot'        => $robot,
15858                        'list'         => $list->{'name'},
15859                        'action'       => $param->{'action'},
15860                        'parameters'   => "$param->{'list'}",
15861                        'target_email' => "",
15862                        'msg_id'       => '',
15863                        'status'       => 'error',
15864                        'error_type'   => 'internal',
15865                        'user_email'   => $param->{'user'}{'email'},
15866                    }
15867                );
15868            }
15869            wwslog('info', 'Removed empty blocklist file %s', $file);
15870        }
15871    } else {
15872        if (-f $file) {
15873            my $ifh;
15874            unless (open $ifh, $file) {
15875                Sympa::WWW::Report::reject_report_web(
15876                    'intern',
15877                    'unable to open file',
15878                    {'file' => $file},
15879                    $robot, $param->{'action'}, '', $param->{'user'}{'email'}
15880                );
15881                wwslog('err', 'Unable to read %s', $file);
15882                web_db_log(
15883                    {   'robot'        => $robot,
15884                        'list'         => $list->{'name'},
15885                        'action'       => $param->{'action'},
15886                        'parameters'   => "$param->{'list'}",
15887                        'target_email' => "",
15888                        'msg_id'       => '',
15889                        'status'       => 'error',
15890                        'error_type'   => 'internal',
15891                        'user_email'   => $param->{'user'}{'email'},
15892                    }
15893                );
15894            }
15895            while (<$ifh>) {
15896                $param->{'blocklist'} .= $_;
15897                $param->{'rows'} += 1;
15898            }
15899            close $ifh;
15900        }
15901    }
15902
15903    web_db_log(
15904        {   'robot'        => $robot,
15905            'list'         => $list->{'name'},
15906            'action'       => $param->{'action'},
15907            'parameters'   => "$param->{'list'}",
15908            'target_email' => "",
15909            'msg_id'       => '',
15910            'status'       => 'success',
15911            'error_type'   => '',
15912            'user_email'   => $param->{'user'}{'email'},
15913        }
15914    );
15915    return 1;
15916}
15917
15918# output in text/plain format a scenario
15919sub do_dump_scenario {
15920    wwslog('info', '(%s, %s)', $param->{'list'}, $in{'scenario_function'});
15921
15922    $in{'scenario_function'} ||= $in{'pname'};    # Compat. <= 6.2.38
15923
15924    my $scenario = Sympa::Scenario->new($list, $in{'scenario_function'});
15925    unless ($scenario) {
15926        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
15927            {}, $param->{'action'}, $list);
15928        wwslog('info', 'Failed to load scenario');
15929        return undef;
15930    }
15931    $param->{'dumped_scenario'}   = $scenario->to_string;
15932    $param->{'scenario_path'}     = $scenario->{file_path};
15933    $param->{'scenario_function'} = $scenario->{function};
15934    $param->{'scenario_name'}     = $scenario->{name};
15935
15936    $param->{'pname'} = $scenario->{function};    # Compat. <= 6.2.38
15937
15938    if ($in{'new_scenario_name'}) {
15939        # in this case it's a submit.
15940        my $scenario_dir = $list->{'dir'} . '/scenari';
15941        my $scenario_file =
15942              $scenario_dir . '/'
15943            . $in{'scenario_function'} . '.'
15944            . $in{'new_scenario_name'};
15945        if ($param->{'dumped_scenario'} eq $in{'new_scenario_content'}) {
15946            wwslog('info', 'Scenario unchanged');
15947            $param->{'result'} = 'unchanged';
15948            return 1;
15949        }
15950        unless (-d $scenario_dir) {
15951            unless (mkdir $scenario_dir, 0775) {
15952                wwslog('err', '%s: %s', $scenario_dir, $ERRNO);
15953                Sympa::WWW::Report::reject_report_web(
15954                    'intern',
15955                    'cannot_create_dir',
15956                    {   'file' => $scenario_dir,
15957                        $param->{'action'}, '', $param->{'user'}{'email'}
15958                    },
15959                    $robot
15960                );
15961                return undef;
15962            }
15963        }
15964        my $ofh;
15965        unless (open $ofh, '>', $scenario_file) {
15966            wwslog('info', '%s', $scenario_file);
15967            Sympa::WWW::Report::reject_report_web(
15968                'intern',
15969                'cannot_open_file',
15970                {   'file' => $scenario_file,
15971                    $param->{'action'}, '', $param->{'user'}{'email'}
15972                },
15973                $robot
15974            );
15975            return undef;
15976        }
15977        print $ofh $in{'new_scenario_content'};
15978        close $ofh;
15979        # load the new scenario in the list config.
15980        if ($in{'new_scenario_name'} eq $in{'scenario_name'}) {
15981            $param->{'result'} = 'success';
15982        } else {
15983            $param->{'result'} = 'success_new_name';
15984        }
15985    }
15986    return 1;
15987}
15988
15989# Subscribers' list
15990# Old name: do_dump().
15991sub do_export_member {
15992    wwslog('info', '(%s, %s, %s)', $param->{'list'}, $in{'format'},
15993        $in{'filter'});
15994
15995    # Access control
15996    return undef unless defined check_authz('do_export_member', 'review');
15997
15998    my $format = $in{'format'} || 'full';
15999    my $filter = $in{'filter'};
16000    $filter = '' unless defined $filter;
16001
16002    $param->{'bypass'} = 'extreme';
16003    printf "Content-Type: text/plain; Charset=\"UTF-8\"; name=\"%s.txt\"\n"
16004        . "Content-Disposition: attachment; filename=\"%s.txt\"\n"
16005        . "Content-Transfer-Encoding: 8BIT\n" . "\n",
16006        $list->get_id, $list->get_id;
16007
16008    if ($format eq 'bounce') {
16009        print '# '
16010            . join("\t",
16011            'Email',
16012            'Name',
16013            'Bounce score',
16014            'Bounce count',
16015            'First bounce',
16016            'Last bounce')
16017            . "\n";
16018    } elsif ($format eq 'light') {
16019        ;
16020    } elsif (defined($in{'filter'})) {
16021        printf "# Exported subscribers with search filter \"%s\"\n", $filter;
16022    }
16023    my $searchkey = Sympa::Tools::Text::foldcase($filter)
16024        if defined $filter and length $filter;
16025
16026    for (
16027        my $subscriber = _subscriber_first($list, type => $format);
16028        $subscriber;
16029        $subscriber = _subscriber_next($list, type => $format)
16030    ) {
16031        my $email = $subscriber->{email};
16032        my $gecos = $subscriber->{gecos};
16033        next unless defined $email and length $email;    # malformed record.
16034
16035        if (defined $searchkey and length $searchkey) {
16036            my $e = Sympa::Tools::Text::foldcase($email);
16037            my $g = Sympa::Tools::Text::foldcase($gecos);
16038            next
16039                unless 0 <= index $e, $searchkey
16040                or 0 <= index $g, $searchkey;
16041        }
16042
16043        if ($format eq 'bounce') {
16044            print join "\t",
16045                $email, $gecos,
16046                @{$subscriber}
16047                {qw(bounce_score bounce_count first_bounce last_bounce)};
16048            print "\n";
16049        } elsif ($format eq 'light') {
16050            print "$email\n";
16051        } else {
16052            print join "\t", $email, $gecos;
16053            print "\n";
16054        }
16055    }
16056
16057    return 1;
16058}
16059
16060sub _subscriber_first {
16061    my $list    = shift;
16062    my %options = @_;
16063
16064    if ($options{type} and $options{type} eq 'bounce') {
16065        my $i = $list->get_first_bouncing_list_member;
16066        $list->parse_list_member_bounce($i) if $i;
16067        return $i;
16068    } else {
16069        return $list->get_first_list_member;
16070    }
16071}
16072
16073sub _subscriber_next {
16074    my $list    = shift;
16075    my %options = @_;
16076
16077    if ($options{type} and $options{type} eq 'bounce') {
16078        my $i = $list->get_next_bouncing_list_member;
16079        $list->parse_list_member_bounce($i) if $i;
16080        return $i;
16081    } else {
16082        return $list->get_next_list_member;
16083    }
16084}
16085
16086## returns a mailto according to list spam protection parameter
16087# No longer used.
16088#sub mailto;
16089
16090## Returns a spam-protected form of email address
16091# DEPRECATED.  Use [%|obfuscate()%] in template.
16092#sub get_protected_email_address;
16093
16094## view logs stored in RDBMS
16095## this function as been writen in order to allow list owner and listmater to
16096## views logs
16097## of there robot or there is real problems with privacy policy and law in
16098## such services.
16099##
16100sub do_viewlogs {
16101    wwslog('info', '(%s)', $in{'page'});
16102
16103    $param->{'page'} = int($in{'page'}) || 1;
16104    $param->{'size'} = int($in{'size'}) || $Conf::Conf{'viewlogs_page_size'};
16105
16106    $param->{'total_results'} = 0;
16107
16108    my @dates = $log->get_log_date;
16109    ($param->{'date_from_formated'}, $param->{'date_to_formated'}) = @dates
16110        if @dates;
16111
16112    # Display and search parameters preparation.
16113    my $select = {
16114        robot => $robot,
16115        list  => $param->{'list'},
16116    };
16117    foreach my $p (qw(target_type target date_from date_to type ip sortby)) {
16118        $param->{$p}  = $in{$p};
16119        $select->{$p} = $in{$p};
16120    }
16121
16122    if ($in{'target_type'} or $in{'page'} or $in{'size'}) {
16123        #sending of search parameters for the query
16124        my $line = $log->get_first_db_log($select);
16125        while (defined $line->{'date'}) {
16126            $line->{'date'} = $language->gettext_strftime("%d %b %Y %H:%M:%S",
16127                localtime($line->{'date'}));
16128            # can be wrapped
16129            $line->{'parameters'} =~ s/,(?!\s)/, /g
16130                if $line->{'parameters'};
16131            push @{$param->{'log_entries'}}, $line;
16132            $line = $log->get_next_db_log();
16133        }
16134
16135        #display the number of rows of the query.
16136        $param->{'total_results'} = scalar @{$param->{'log_entries'} || []};
16137
16138        unless ($param->{'total_results'}) {
16139            #Sympa::WWW::Report::reject_report_web('user', 'no_logs', {},
16140            #    $param->{'action'});
16141            wwslog('info', 'No results');
16142            return 1;
16143        }
16144
16145        $param->{'total_page'} =
16146            int($param->{'total_results'} / $param->{'size'});
16147        $param->{'total_page'}++
16148            if ($param->{'total_results'} % $param->{'size'});
16149
16150        if ($param->{'page'} > $param->{'total_page'}) {
16151            Sympa::WWW::Report::reject_report_web('user', 'no_page',
16152                {'page' => $param->{'page'}},
16153                $param->{'action'});
16154            # $log->db_log('wwsympa', $param->{'user'}{'email'},
16155            #     $param->{'auth_method'}, $ip, 'review', $param->{'list'},
16156            #     $robot,'','out of pages');
16157            wwslog('info', 'No page %d', $param->{'page'});
16158            return undef;
16159        }
16160
16161        my $offset = 0;
16162        if ($param->{'page'} > 1) {
16163            $offset = (($param->{'page'} - 1) * $param->{'size'});
16164            $param->{'prev_page'} = $param->{'page'} - 1;
16165        }
16166
16167        unless (($offset + $param->{'size'}) >= $param->{'total_results'}) {
16168            $param->{'next_page'} = $param->{'page'} + 1;
16169        }
16170
16171        my $last = $offset + $param->{'size'};
16172        $last = $param->{'total_results'} - 1
16173            if ($last >= $param->{'total_results'});
16174        @{$param->{'log_entries'}} =
16175            @{$param->{'log_entries'}}[$offset .. $last];
16176    }
16177
16178    return 1;
16179}
16180
16181sub do_arc_manage {
16182    wwslog('info', '(%s)', $in{'list'});
16183
16184    # Access control
16185    return undef unless defined check_authz('do_arc', 'archive_web_access');
16186
16187    my $archive = Sympa::Archive->new(context => $list);
16188    $param->{'yyyymm'} = [reverse $archive->get_archives];
16189
16190    return 1;
16191}
16192
16193## create a zip file with archives from (list,month)
16194sub do_arc_download {
16195
16196    wwslog('info', '(%s)', $in{'list'});
16197
16198    ## Access control
16199    return undef unless defined check_authz('do_arc', 'archive_web_access');
16200
16201    ##zip file name:listname_archives.zip
16202    my $zip_file_name = $in{'list'} . '_archives.zip';
16203    my $zip_abs_file  = $Conf::Conf{'tmpdir'} . '/' . $zip_file_name;
16204    my $zip           = Archive::Zip->new();
16205
16206    #Search for months to put in zip
16207    unless (defined($in{'directories'})) {
16208        Sympa::WWW::Report::reject_report_web('user', 'select_month', {},
16209            $param->{'action'});
16210        wwslog('info', 'No archives specified');
16211        web_db_log(
16212            {   'robot'        => $robot,
16213                'list'         => $list->{'name'},
16214                'action'       => $param->{'action'},
16215                'parameters'   => "$in{'list'}",
16216                'target_email' => "",
16217                'msg_id'       => '',
16218                'status'       => 'error',
16219                'error_type'   => 'select_month',
16220                'user_email'   => $param->{'user'}{'email'},
16221            }
16222        );
16223        return 'arc_manage';
16224    }
16225
16226    my $archive = Sympa::Archive->new(context => $list);
16227
16228    # For each selected month
16229    foreach my $arc (split /\0/, $in{'directories'}) {
16230        # Check arc directory
16231        unless ($archive->select_archive($arc)) {
16232            Sympa::WWW::Report::reject_report_web(
16233                'intern',
16234                'arc_not_found',    #FIXME: Not implemented.
16235                {   'month'    => $arc,
16236                    'listname' => $in{'list'},
16237                },
16238                $param->{'action'},
16239                '',
16240                $param->{'user'}{'email'},
16241                $robot
16242            );
16243            wwslog('info', 'Archive %s not found', $arc);
16244            web_db_log(
16245                {   'robot'        => $robot,
16246                    'list'         => $list->{'name'},
16247                    'action'       => $param->{'action'},
16248                    'parameters'   => "$in{'list'}",
16249                    'target_email' => "",
16250                    'msg_id'       => '',
16251                    'status'       => 'error',
16252                    'error_type'   => 'internal',
16253                    'user_email'   => $param->{'user'}{'email'},
16254                }
16255            );
16256            next;
16257        }
16258
16259        $zip->addDirectory($archive->{directory}, $in{'list'} . '_' . $arc);
16260
16261        while (1) {
16262            my ($message, $handle) = $archive->next;
16263            last unless $handle;
16264            next unless $message;
16265
16266            unless (
16267                $zip->addString(
16268                    $message->as_string,
16269                    $in{'list'} . '_' . $arc . '/' . $handle->basename
16270                )
16271            ) {
16272                Sympa::WWW::Report::reject_report_web(
16273                    'intern',
16274                    'add_file_zip',
16275                    {'file' => $arc . '/' . $handle->basename},
16276                    $param->{'action'},
16277                    '',
16278                    $param->{'user'}{'email'},
16279                    $robot
16280                );
16281                wwslog('info', 'Failed to add %s file in %s to archive',
16282                    $handle->basename, $archive);
16283                web_db_log(
16284                    {   'robot'        => $robot,
16285                        'list'         => $list->{'name'},
16286                        'action'       => $param->{'action'},
16287                        'parameters'   => "$in{'list'}",
16288                        'target_email' => "",
16289                        'msg_id'       => '',
16290                        'status'       => 'error',
16291                        'error_type'   => 'internal',
16292                        'user_email'   => $param->{'user'}{'email'},
16293                    }
16294                );
16295                return undef;
16296            }
16297        }
16298
16299        ## create and fill a new folder in zip
16300        #$zip->addTree ($abs_dir, $in{'list'}.'_'.$dir);
16301    }
16302
16303    ## check if zip isn't empty
16304    if ($zip->numberOfMembers() == 0) {
16305        Sympa::WWW::Report::reject_report_web('intern',
16306            'inaccessible_archive', {'listname' => $in{'list'}},
16307            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
16308        wwslog('info', 'Empty directories');
16309        web_db_log(
16310            {   'robot'        => $robot,
16311                'list'         => $list->{'name'},
16312                'action'       => $param->{'action'},
16313                'parameters'   => "$in{'list'}",
16314                'target_email' => "",
16315                'msg_id'       => '',
16316                'status'       => 'error',
16317                'error_type'   => 'internal',
16318                'user_email'   => $param->{'user'}{'email'},
16319            }
16320        );
16321        return undef;
16322    }
16323    ##writing zip file
16324    unless ($zip->writeToFileNamed($zip_abs_file) == Archive::Zip::AZ_OK()) {
16325        Sympa::WWW::Report::reject_report_web('intern', 'write_file_zip',
16326            {'zipfile' => $zip_abs_file},
16327            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
16328        wwslog('info', 'Error while writing ZIP File %s', $zip_file_name);
16329        web_db_log(
16330            {   'robot'        => $robot,
16331                'list'         => $list->{'name'},
16332                'action'       => $param->{'action'},
16333                'parameters'   => "$in{'list'}",
16334                'target_email' => "",
16335                'msg_id'       => '',
16336                'status'       => 'error',
16337                'error_type'   => 'internal',
16338                'user_email'   => $param->{'user'}{'email'},
16339            }
16340        );
16341        return undef;
16342    }
16343
16344    ##Sending Zip to browser
16345    $param->{'bypass'} = 'extreme';
16346    printf(
16347        "Content-Type: application/zip;\nContent-disposition: attachment; filename=\"%s\";\n\n",
16348        $zip_file_name);
16349    ##MIME Header
16350    unless (open(ZIP, $zip_abs_file)) {
16351        Sympa::WWW::Report::reject_report_web('intern', 'cannot_open_file',
16352            {'file' => $zip_abs_file},
16353            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
16354        wwslog('info', 'Error while reading ZIP File %s', $zip_abs_file);
16355        web_db_log(
16356            {   'robot'        => $robot,
16357                'list'         => $list->{'name'},
16358                'action'       => $param->{'action'},
16359                'parameters'   => "$in{'list'}",
16360                'target_email' => "",
16361                'msg_id'       => '',
16362                'status'       => 'error',
16363                'error_type'   => 'internal',
16364                'user_email'   => $param->{'user'}{'email'},
16365            }
16366        );
16367        return undef;
16368    }
16369    print <ZIP>;
16370    close ZIP;
16371
16372    ## remove zip file from server disk
16373    unless (unlink($zip_abs_file)) {
16374        Sympa::WWW::Report::reject_report_web('intern', 'erase_file',
16375            {'file' => $zip_abs_file},
16376            $param->{'action'}, $list, $param->{'user'}{'email'}, $robot);
16377        wwslog('info', 'Error while unlinking File %s', $zip_abs_file);
16378        web_db_log(
16379            {   'robot'        => $robot,
16380                'list'         => $list->{'name'},
16381                'action'       => $param->{'action'},
16382                'parameters'   => "$in{'list'}",
16383                'target_email' => "",
16384                'msg_id'       => '',
16385                'status'       => 'error',
16386                'error_type'   => 'internal',
16387                'user_email'   => $param->{'user'}{'email'},
16388            }
16389        );
16390    }
16391    web_db_log(
16392        {   'robot'        => $robot,
16393            'list'         => $list->{'name'},
16394            'action'       => $param->{'action'},
16395            'parameters'   => "$in{'list'}",
16396            'target_email' => "",
16397            'msg_id'       => '',
16398            'status'       => 'success',
16399            'error_type'   => '',
16400            'user_email'   => $param->{'user'}{'email'},
16401        }
16402    );
16403    return 1;
16404}
16405
16406sub do_arc_delete {
16407    wwslog('info', '(%s)', $in{'list'});
16408
16409    # Access control
16410    return undef unless defined check_authz('do_arc', 'archive_web_access');
16411
16412    my @directories = sort split /\0/, ($in{'directories'} || '');
16413    unless (@directories) {
16414        Sympa::WWW::Report::reject_report_web('user', 'select_month', {},
16415            $param->{'action'});
16416        wwslog('info', 'No Archives months selected');
16417        web_db_log(
16418            {   'robot'        => $robot,
16419                'list'         => $list->{'name'},
16420                'action'       => $param->{'action'},
16421                'parameters'   => "$in{'list'}",
16422                'target_email' => "",
16423                'msg_id'       => '',
16424                'status'       => 'error',
16425                'error_type'   => 'select_month',
16426                'user_email'   => $param->{'user'}{'email'},
16427            }
16428        );
16429        return 'arc_manage';
16430    }
16431    $param->{'directories'} = [@directories];
16432
16433    # Action confirmed?
16434    my $next_action = $session->confirm_action(
16435        $in{'action'}, $in{'response_action'},
16436        arg             => join(',', @directories),
16437        previous_action => 'arc_manage'
16438    );
16439    return $next_action unless $next_action eq '1';
16440
16441    ## if user want to download archives before delete
16442    wwslog('notice', 'ZIP: %s', $in{'zip'});
16443    if ($in{'zip'} == 1) {
16444        do_arc_download();
16445    }
16446
16447    my $archive = Sympa::Archive->new(context => $list);
16448    foreach my $arc (@directories) {
16449        unless ($archive->purge_archive($arc)) {
16450            wwslog('info', 'Error while purging archive %s in %s',
16451                $arc, $archive);
16452        }
16453    }
16454
16455    Sympa::WWW::Report::notice_report_web('performed', {},
16456        $param->{'action'});
16457    web_db_log(
16458        {   'robot'        => $robot,
16459            'list'         => $list->{'name'},
16460            'action'       => $param->{'action'},
16461            'parameters'   => "$in{'list'}",
16462            'target_email' => "",
16463            'msg_id'       => '',
16464            'status'       => 'success',
16465            'error_type'   => '',
16466            'user_email'   => $param->{'user'}{'email'},
16467        }
16468    );
16469    return 'arc_manage';
16470}
16471
16472# DEPRECATED. No longer used.
16473#sub do_css;
16474
16475sub do_rss_request {
16476    wwslog('info', '');
16477
16478    if (ref $list eq 'Sympa::List') {
16479        my $result = Sympa::Scenario->new($list, 'visibility')->authz(
16480            $param->{'auth_method'},
16481            {   'sender'      => $param->{'user'}{'email'},
16482                'remote_host' => $param->{'remote_host'},
16483                'remote_addr' => $param->{'remote_addr'}
16484            }
16485        );
16486        my $sub_is;
16487        my $reason;
16488        if (ref $result eq 'HASH') {
16489            $sub_is = $result->{'action'};
16490            $reason = $result->{'reason'};
16491        }
16492        if ($sub_is =~ /\Areject\b/i) {
16493            wwslog(
16494                'info',
16495                'RSS not accessible because list %s is not visible to user %s',
16496                $list->get_id,
16497                $param->{'user'}{'email'}
16498            );
16499            web_db_log(
16500                {   'parameters' => $param->{'user'}{'email'},
16501                    'status'     => 'error',
16502                    'error_type' => 'authorization'
16503                }
16504            );
16505            return undef;
16506        }
16507    }
16508
16509    my %args;
16510    $in{'count'} ||= 20;
16511    $in{'for'}   ||= 10;
16512
16513    $args{count} = $in{'count'} if $in{'count'};
16514    $args{for}   = $in{'for'}   if $in{'for'};
16515
16516    if (ref $list eq 'Sympa::List') {
16517        $param->{'latest_arc_url'} =
16518            Sympa::get_url($list, 'rss/latest_arc', query => {%args});
16519        $param->{'latest_d_read_url'} =
16520            Sympa::get_url($list, 'rss/latest_d_read', query => {%args});
16521    }
16522    $param->{'active_lists_url'} =
16523        Sympa::get_url($robot, 'rss/active_lists', query => {%args});
16524    $param->{'latest_lists_url'} =
16525        Sympa::get_url($robot, 'rss/latest_lists', query => {%args});
16526
16527    $param->{'output'} = 1;
16528    return 1;
16529}
16530
16531sub do_wsdl {
16532    wwslog('info', '');
16533
16534    my $sympawsdl;
16535    unless ($sympawsdl = Sympa::search_fullpath($robot, 'sympa.wsdl')
16536        and -r $sympawsdl) {
16537        Sympa::WWW::Report::reject_report_web('intern', 'err_404', {},
16538            $param->{'action'});
16539        wwslog('err', 'Could not find sympa.wsdl');
16540        return undef;
16541    }
16542
16543    my $soap_url = Conf::get_robot_conf($robot, 'soap_url');
16544    unless (defined $soap_url) {
16545        Sympa::WWW::Report::reject_report_web('user', 'no_soap_service', {},
16546            $param->{'action'});
16547        wwslog('err',
16548            'No SOAP service was defined in sympa.conf (soap_url parameter)');
16549        return undef;
16550    }
16551
16552    $param->{'bypass'} = 'extreme';
16553    print "Content-type: text/xml\n\n";
16554
16555    $param->{'conf'}{'soap_url'} = $soap_url;
16556
16557    my $template = Sympa::Template->new($robot);
16558    $template->parse($param, 'sympa.wsdl', \*STDOUT);
16559
16560    return 1;
16561}
16562
16563## Synchronize list members with data sources
16564sub do_sync_include {
16565    wwslog('info', '(%s, %s)', $in{'list'}, $in{'role'});
16566
16567    my $role = $in{'role'} || 'member';    # Compat.<=6.2.54
16568    $in{'page'} = $role unless $role eq 'member';
16569
16570    $param->{'list'} = $list->{'name'};
16571    $param->{'role'} = $role;
16572    $param->{'page'} = $role unless $role eq 'member';
16573
16574    my $spindle = Sympa::Spindle::ProcessRequest->new(
16575        context          => $list,
16576        action           => 'include',
16577        role             => $role,
16578        sender           => $param->{'user'}{'email'},
16579        scenario_context => {skip => 1},
16580    );
16581    unless ($spindle and $spindle->spin) {
16582        wwslog('err', 'Failed to sync role %s of list %s with data sources',
16583            $role, $list);
16584        return undef;
16585    }
16586
16587    foreach my $report (@{$spindle->{stash} || []}) {
16588        if ($report->[1] eq 'notice') {
16589            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
16590                $param->{'action'});
16591        } else {
16592            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
16593                $param->{action});
16594        }
16595    }
16596    unless (@{$spindle->{stash} || []}) {
16597        Sympa::WWW::Report::notice_report_web('performed', {},
16598            $param->{'action'});
16599        web_db_log({'parameters' => $in{'email'}, 'status' => 'success'});
16600    }
16601
16602    return 'review';
16603}
16604
16605## Review lists from a family
16606sub do_review_family {
16607    wwslog('info', '');
16608
16609    my $family = Sympa::Family->new($in{'family_name'}, $robot);
16610    unless (defined $family) {
16611        Sympa::WWW::Report::reject_report_web('user', 'unknown_family',
16612            {'family' => $in{'family_name'}},
16613            $param->{'action'}, '', $param->{'user'}{'email'}, $robot);
16614        wwslog('err', 'Incorrect family %s', $in{'family_name'});
16615        return undef;
16616    }
16617
16618    my $all_lists = Sympa::List::get_lists($family);
16619    foreach my $flist (@{$all_lists || []}) {
16620        unless ($flist) {
16621            wwslog('err', 'Incorrect list');
16622            next;
16623        }
16624
16625        push @{$param->{'family_lists'}},
16626            {
16627            'name'   => $flist->{'name'},
16628            'status' => $flist->{'admin'}{'status'},
16629            'instantiation_date_epoch' =>
16630                $flist->{'admin'}{'latest_instantiation'}{'date_epoch'},
16631            'subject' => $flist->{'admin'}{'subject'},
16632            };
16633    }
16634
16635    return 1;
16636}
16637
16638# Get custom action file
16639sub _ca_get_file {
16640    my $custom_action = shift;
16641    my $robot         = shift;
16642    my $list          = shift;
16643
16644    my $file = Sympa::search_fullpath($list || $robot,
16645        $custom_action, subdir => 'custom_actions');
16646    return undef unless ($file);
16647
16648    _ca_add_file_path_to_tt2_include_path($file);
16649
16650    return $file;
16651}
16652
16653# Adds custom action path to tt2 path
16654sub _ca_add_file_path_to_tt2_include_path {
16655    my $file = shift;
16656    $file =~ s/\/[^\/]+$//;
16657    push @other_include_path, $file;
16658}
16659
16660# Process custom action
16661sub _ca_process {
16662    my $custom_action = shift;
16663    my $cap           = shift;
16664    my $robot         = shift;
16665    my $list          = shift;
16666
16667    my $file = _ca_get_file($custom_action . '.pm', $robot, $list);
16668    return undef unless ($file);
16669
16670    eval { require "$file"; };
16671    if ($EVAL_ERROR) {
16672        $log->syslog('err', 'Error requiring %s: %s (%s)',
16673            $custom_action, "$EVAL_ERROR", ref($EVAL_ERROR));
16674        return undef;
16675    }
16676
16677    unshift @{$cap}, $list if ($list);
16678    my $res;
16679    eval "\$res = " . $custom_action . "_plugin::process(\@{\$cap});";
16680    if ($EVAL_ERROR) {
16681        $log->syslog('err', 'Error evaluating %s: %s (%s)',
16682            $custom_action, "$EVAL_ERROR", ref($EVAL_ERROR));
16683        return undef;
16684    }
16685
16686    return $res;
16687}
16688
16689################################################################
16690## do_ca : executes a custom action
16691##
16692## IN:
16693##    - 'custom_action': ther name of the custom action (and subsequent tt2
16694##    file to use, see below)
16695##    - '@cap': an array of parameters.
16696##
16697## Custom actions are used to run specific code and/or display user defined
16698## templates.
16699## You can create a <your_action>.pm module under etc/custom_actions or etc/
16700## <robot>/custom_actions (<your_action>_plugin package) with a "process" sub
16701## to add custom processing.
16702## You can also create a <your_action>.tt2 file at the same place to display
16703## your template. You don't need the <head/> section or the <body/> tag.
16704## The HTML code in '<your_action>.tt2' can make use of the parameters this
16705## way: [% cap.1 %] for param1, [% cap.2 %] for param, and so on.
16706## If the module is not defined the template is displayed.
16707##
16708## You can even have a robot-common <your_action>.pm module with a specific
16709## <your_action>.tt2 for each robot as the file (.pm or .tt2) is conducted in
16710## this order :
16711##   - expl/<robot>/<list>/custom_actions (if list context and robot support)
16712##   - expl/<list>/custom_actions (if list context and no robot support)
16713##   - etc/<robot>/custom_actions (if robot support)
16714##   - etc/custom_actions
16715##
16716## Your custom action is reachable using URL:
16717## http://your-sympa-server-root-url/ca/your_action/param2/param2/param3/...
16718##
16719## The module process sub receive @cap entries as arguments
16720##
16721## The module process sub return value can be either :
16722## 	1 to parse and display the custom action related tt2
16723## 	<a global action name> to display its template
16724## 	ca:<other_custom_action> to parse and display another custom action
16725## 	related tt2
16726## 	a hash which entries will override $param ones, in case
16727## 	"custom_action" or "next_action" are present they act as described above.
16728##
16729###############################################################
16730sub do_ca {
16731    wwslog('info',
16732        'Custom action: %s (robot %s) with params: (%s, %s, %s, %s, %s)',
16733        $in{'custom_action'}, $robot, $in{'cap'});
16734
16735    my $custom_action = $in{'custom_action'};
16736    my $cap = [split '/', $in{'cap'}];
16737    $param->{'custom_action'} = $custom_action;
16738    $param->{'cap'}           = $cap;
16739
16740    my $res = _ca_process($custom_action, $cap, $robot);
16741
16742    if ($res) {
16743        my $next_action = 1;
16744        if (ref $res eq 'HASH') {
16745            for my $k (keys %$res) {
16746                $param->{$k} = $res->{$k};
16747            }
16748            $next_action = $res->{'custom_action'}
16749                if ($res->{'custom_action'});
16750            $next_action = $res->{'next_action'} if ($res->{'next_action'});
16751        } else {
16752            $next_action = scalar($res);
16753        }
16754
16755        return 1 if ($next_action =~ /^1$/);    # self tt2
16756
16757        if ($next_action =~ /^l?ca:(.+)$/) {    # other custom action tt2
16758            $param->{'custom_action'} = $1;
16759            _ca_get_file($1 . '.tt2', $robot);
16760            return 1;
16761        }
16762
16763        return $next_action;                    # global action
16764    }
16765
16766    my $file = _ca_get_file($custom_action . '.tt2', $robot);
16767    return 1 if ($file);
16768
16769    $log->syslog('err', 'Plugin not found: %s', $custom_action);
16770    return undef;
16771}
16772
16773################################################################
16774## do_ca : executes a custom action in list context
16775##
16776## IN:
16777##    - 'custom_action': ther name of the custom action (and subsequent tt2
16778##    file to use, see below)
16779##    - 'list': the nalme of the list (without the '@robot' part) in the
16780##    context of which the action is executed.
16781##    - '@lcap': an array of parameters.
16782##
16783## Custom actions are used to run specific code and/or display user defined
16784## templates.
16785## You can create a <your_action>.pm module under etc/custom_actions or etc/
16786## <robot>/custom_actions or expl(/<robot>)?/<list>/custom_actions
16787## (<your_action>_plugin package) with a "process" sub to add custom
16788## processing.
16789## You can also create a <your_action>.tt2 file at the same place to display
16790## your template. You don't need the <head/> section or the <body/> tag.
16791## The HTML code in '<your_action>.tt2' can make use of the parameters this
16792## way: [% cap.1 %] for param1, [% cap.2 %] for param, and so on.
16793## If the module is not defined the template is displayed.
16794##
16795## You can even have a robot-common <your_action>.pm module with a specific
16796## <your_action>.tt2 for each robot as the file (.pm or .tt2) is conducted in
16797## this order :
16798##   - expl/<robot>/<list>/custom_actions (if list context and robot support)
16799##   - expl/<list>/custom_actions (if list context and no robot support)
16800##   - etc/<robot>/custom_actions (if robot support)
16801##   - etc/custom_actions
16802##
16803## Your custom action is reachable using URL:
16804## http://your-sympa-server-root-url/lca/your_action/listname/param2/param2/param3/...
16805##
16806## The module process sub receive the List object and @cap entries as
16807## arguments
16808##
16809## The module process sub return value can be either :
16810## 	1 to parse and display the custom action related tt2
16811## 	<a global action name> to display its template
16812## 	ca:<other_custom_action> to parse and display another custom action
16813## 	related tt2
16814## 	a hash which entries will override $param ones, in case
16815## 	"custom_action" or "next_action" are present they act as described above.
16816##
16817###############################################################
16818sub do_lca {
16819    wwslog(
16820        'info',
16821        'List custom action: %s for list %s (robot %s) with params: (%s, %s, %s, %s, %s)',
16822        $in{'custom_action'},
16823        $in{'list'},
16824        $robot,
16825        $in{'lcap'}
16826    );
16827
16828    my $custom_action = $in{'custom_action'};
16829    my $cap = [split '/', $in{'cap'}];
16830    $param->{'custom_action'} = $custom_action;
16831    $param->{'cap'}           = $cap;
16832
16833    my $res = _ca_process($custom_action, $cap, $robot, $list);
16834
16835    if ($res) {
16836        my $next_action = 1;
16837        if (ref $res eq 'HASH') {
16838            for my $k (keys %$res) {
16839                $param->{$k} = $res->{$k};
16840            }
16841            $next_action = $res->{'custom_action'}
16842                if ($res->{'custom_action'});
16843            $next_action = $res->{'next_action'} if ($res->{'next_action'});
16844        } else {
16845            $next_action = scalar($res);
16846        }
16847
16848        return 1 if ($next_action =~ /^1$/);    # self tt2
16849
16850        if ($next_action =~ /^l?ca:(.+)$/) {    # other custom action tt2
16851            $param->{'custom_action'} = $1;
16852            _ca_get_file($1 . '.tt2', $robot, $list);
16853            return 1;
16854        }
16855
16856        return $next_action;                    # global action
16857    }
16858
16859    my $file = _ca_get_file($custom_action . '.tt2', $robot, $list);
16860    return 1 if ($file);
16861
16862    $log->syslog('err', 'Plugin not found: %s', $custom_action);
16863    return undef;
16864}
16865
16866## Prepare subscriber data to be prompted on the web interface
16867## Used by review, search,...
16868sub _prepare_subscriber {
16869    my $user              = shift;
16870    my $additional_fields = shift;
16871
16872    #FIXME: don't overwrite.
16873    $user->{'date'} =
16874        $language->gettext_strftime("%d %b %Y", localtime $user->{'date'});
16875    $user->{'update_date'} =
16876        $language->gettext_strftime("%d %b %Y",
16877        localtime $user->{'update_date'});
16878
16879    # Reception mode and topics.
16880    $user->{'reception'} ||= 'mail';
16881    if (($user->{'reception'} eq 'mail') && $user->{'topics'}) {
16882        $user->{'reception'} =
16883            $language->gettext_sprintf("topic (%s)", $user->{'topics'});
16884    }
16885
16886    $user->{'email'} =~ /\@(.+)$/;
16887    $user->{'domain'}       = $1;
16888    $user->{'pictures_url'} = $list->find_picture_url($user->{'email'});
16889
16890    if (@{$additional_fields}) {
16891        my @fields;
16892        foreach my $f (@{$additional_fields}) {
16893            push @fields, $user->{$f};
16894        }
16895        $user->{'additional'} = join ',', @fields;
16896    }
16897
16898    # Compat. <= 6.2.44
16899    if (defined $user->{'inclusion'}) {
16900        $user->{'included'} = 1;
16901        $user->{'sources'}  = $language->gettext('included');
16902    }
16903
16904    return 1;
16905}
16906
16907## Check authorizations to the current action
16908## used in common cases where actions fails unless result is 'do_it'
16909## It does not apply to actions that can be moderated
16910sub check_authz {
16911    my ($subname, $function) = @_;
16912
16913    my $result = Sympa::Scenario->new($list, $function)->authz(
16914        $param->{'auth_method'},
16915        {   'sender'      => $param->{'user'}{'email'} || 'nobody',
16916            'remote_host' => $param->{'remote_host'},
16917            'remote_addr' => $param->{'remote_addr'}
16918        }
16919    );
16920    my $r_action;
16921    my $reason;
16922    if (ref $result eq 'HASH') {
16923        $r_action = $result->{'action'};
16924        $reason   = $result->{'reason'};
16925    }
16926
16927    unless ($r_action =~ /do_it/i) {
16928        unless (prevent_visibility_bypass()) {
16929            Sympa::WWW::Report::reject_report_web('auth', $reason,
16930                {'login' => $param->{'need_login'}},
16931                $param->{'action'});
16932        }
16933        wwslog(
16934            'info',   'Access denied in %s for %s',
16935            $subname, $param->{'user'}{'email'}
16936        );
16937        return undef;
16938    }
16939
16940    return 1;
16941}
16942
16943sub get_server_details {
16944    ## All Robots are shown to super listmaster
16945    if (Sympa::is_listmaster('*', $param->{'user'}{'email'})) {
16946        $param->{'main_robot'} = 1;
16947
16948        # If there are two or more robots, 'robots' variable will be filled.
16949        my @robots = Sympa::List::get_robots();
16950        if (@robots and 1 < scalar @robots) {
16951            $param->{'robots'} = {
16952                map {
16953                    my $r = $_;
16954                    (   $r => {
16955                            (host => $r),    # Compat.<6.2.32
16956                            (   listmasters =>
16957                                    [Sympa::get_listmasters_email($r)]
16958                            ),
16959                            map { ($_ => Conf::get_robot_conf($r, $_)) }
16960                                qw(listmaster title wwsympa_url)
16961                        }
16962                        )
16963                } @robots
16964            };
16965        } else {
16966            # No virtual robots.
16967            delete $param->{'robots'};
16968        }
16969    }
16970
16971    ## Families
16972    my @families =
16973        sort map { $_->{'name'} } @{Sympa::Family::get_families($robot)};
16974    if (@families) {
16975        $param->{'families'} = \@families;
16976    }
16977}
16978
16979# Set Sympa parameters in $param->{'conf'}
16980# Never used.
16981#sub get_safe_robot_conf;
16982
16983sub do_maintenance {
16984    wwslog('notice', '');
16985    return 1;
16986}
16987
16988# Never used.
16989#sub do_automatic_lists_management_request;
16990
16991# Never used.
16992#sub do_automatic_lists_management;
16993
16994# Old name: do_automatic_lists_request().
16995sub do_create_automatic_list_request {
16996    wwslog('notice', 'Starting');
16997    # check authorization
16998    my $family;
16999    unless ($family = Sympa::Family->new($in{'family'}, $robot)) {
17000        wwslog('err',
17001            'Failed to instantiate family %s. This family does not exist',
17002            $in{'family'});
17003        return undef;
17004    }
17005    unless ($param->{'may_create_automatic_list'}{$family->{'name'}}) {
17006        Sympa::WWW::Report::reject_report_web('auth',
17007            "You are not allowed to create list in this family",
17008            {}, $param->{'action'});
17009        wwslog('err',
17010            'Access to automatic list creation form denied to user %s',
17011            $session->{'email'});
17012        return undef;
17013    }
17014
17015    $param->{'family'} = $family;
17016    return 1;
17017}
17018
17019# Old name: do_automatic_lists().
17020sub do_create_automatic_list {
17021    wwslog('notice', '(%s)', $in{'family'});
17022    my $family_name = $in{'family'};
17023
17024    # Automatic creation of a mailing list, based on a family.
17025    my $family;
17026    unless ($family = Sympa::Family->new($family_name, $robot)) {
17027        $log->syslog('err',
17028            'Failed to create the dynamic list: Family %s does not exist',
17029            $family_name);
17030        return undef;
17031    }
17032    $param->{'family'} = $family;
17033
17034    my $family_config =
17035        (Conf::get_robot_conf($robot, 'automatic_list_families') || {})
17036        ->{$family_name};
17037    my @list_name_parts;
17038    foreach my $input (keys %in) {
17039        next unless $input =~ /automatic_list_part_(\d+)/;
17040        $list_name_parts[$1] = $in{$input};
17041    }
17042    while (
17043        @list_name_parts
17044        and not(defined $list_name_parts[$#list_name_parts]
17045            and length $list_name_parts[$#list_name_parts])
17046    ) {
17047        pop @list_name_parts;
17048    }
17049    my $listname =
17050          $family_config->{'prefix'}
17051        . $family_config->{'prefix_separator'}
17052        . join($family_config->{'classes_separator'}, @list_name_parts);
17053
17054    my $spindle = Sympa::Spindle::ProcessRequest->new(
17055        context          => $family,
17056        action           => 'create_automatic_list',
17057        parameters       => {listname => $listname},
17058        abort_on_error   => 1,
17059        sender           => $param->{'user'}{'email'},
17060        md5_check        => 1,
17061        scenario_context => {
17062            sender             => $param->{'user'}{'email'},
17063            message            => undef,
17064            family             => $family,
17065            automatic_listname => $listname,
17066        },
17067    );
17068    unless ($spindle and $spindle->spin) {
17069        wwslog('err', 'Failed to create the dynamic list %s', $listname);
17070        return 'create_automatic_list_request';
17071    }
17072
17073    foreach my $report (@{$spindle->{stash} || []}) {
17074        if ($report->[1] eq 'notice') {
17075            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
17076                $param->{'action'});
17077        } elsif ($report->[1] eq 'user'
17078            and $report->[2] eq 'list_already_exists') {
17079            # Pass the list already exists.
17080            ;
17081        } else {
17082            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
17083                $param->{action});
17084        }
17085    }
17086    unless (@{$spindle->{stash} || []}) {
17087        Sympa::WWW::Report::notice_report_web('performed', {},
17088            $param->{'action'});
17089    } elsif (
17090        grep {
17091            $_->[1] eq 'user' and $_->[2] eq 'list_already_exists'
17092        } @{$spindle->{stash} || []}
17093    ) {
17094        ;
17095    } elsif (not $spindle->success) {
17096        $log->syslog('err', 'Failed to create the dynamic list %s',
17097            $listname);
17098        Sympa::send_notify_to_listmaster(
17099            $robot,
17100            'automatic_list_creation_failed',
17101            ["Failed to create the dynamic list $listname."]
17102        );
17103        return 'create_automatic_list_request';
17104    }
17105
17106    $list = Sympa::List->new($listname, $robot);
17107    $in{'list'} = $list ? $list->{'name'} : undef;
17108    return 'compose_mail';
17109}
17110
17111sub do_auth {
17112    wwslog('info', '(%s, %s, %s, %s)',
17113        $in{'id'}, $in{'heldaction'}, $in{'listname'}, $in{'email'});
17114
17115    my $keyauth    = $in{'id'};
17116    my $heldaction = $in{'heldaction'};
17117    my $listname   = $in{'listname'};
17118    my $email      = Sympa::Tools::Text::canonic_email($in{'email'});
17119
17120    my $default_home = Conf::get_robot_conf($robot, 'default_home');
17121    return $default_home
17122        unless $email and Sympa::Tools::Text::valid_email($email);
17123
17124    @{$param}{qw(id heldaction listname email)} =
17125        ($keyauth, $heldaction, $listname, $email);
17126
17127    my $spool_req = Sympa::Spool::Auth->new(
17128        context => $list,
17129        action  => $heldaction,
17130        keyauth => $keyauth
17131    );
17132    my ($request, $handle);
17133    while (1) {
17134        ($request, $handle) = $spool_req->next(no_lock => 1);
17135        last unless $handle;
17136        last if $request;
17137    }
17138    return $default_home
17139        unless $request and $handle;
17140
17141    $param->{'request'} =
17142        {map { (exists $request->{$_}) ? ($_ => $request->{$_}) : () }
17143            qw(listname mode email gecos)};
17144
17145    # Action confirmed?
17146    my $next_action = $session->confirm_action(
17147        $in{'action'}, $in{'response_action'},
17148        arg =>
17149            join(',', grep {$_} ($keyauth, $heldaction, $listname, $email)),
17150        previous_action => $default_home
17151    );
17152    return $next_action unless $next_action eq '1';
17153
17154    my $spindle = Sympa::Spindle::ProcessRequest->new(
17155        context          => $robot,
17156        action           => 'auth',
17157        keyauth          => $keyauth,
17158        sender           => $email,
17159        scenario_context => {
17160            sender      => $email,
17161            remote_host => $param->{'remote_host'},
17162            remote_addr => $param->{'remote_addr'}
17163        },
17164    );
17165    unless ($spindle and $spindle->spin) {
17166        return $default_home;
17167    }
17168
17169    foreach my $report (@{$spindle->{stash} || []}) {
17170        if ($report->[1] eq 'notice') {
17171            Sympa::WWW::Report::notice_report_web(@{$report}[2, 3],
17172                $param->{'action'});
17173        } else {
17174            Sympa::WWW::Report::reject_report_web(@{$report}[1 .. 3],
17175                $param->{action});
17176        }
17177    }
17178    unless (@{$spindle->{stash} || []}) {
17179        Sympa::WWW::Report::notice_report_web('performed', {},
17180            $param->{'action'});
17181    }
17182
17183    return $default_home;
17184}
17185
17186sub do_delete_account {
17187    if (Sympa::Tools::Data::smart_eq(
17188            Conf::get_robot_conf($robot, 'allow_account_deletion'), 'on'
17189        )
17190    ) {
17191        wwslog(
17192            'info',
17193            sprintf(
17194                'Account deletion: %s asked for its account to be deleted',
17195                $param->{'user'}->{'email'})
17196        );
17197
17198        # Show form if HTTP POST method not used.
17199        return 1 unless $ENV{'REQUEST_METHOD'} eq 'POST';
17200
17201        my $email =
17202            Sympa::Tools::Text::canonic_email($param->{'user'}->{'email'});
17203        my $passwd = delete $in{'passwd'};    # Clear it.
17204
17205        unless ($email) {
17206            Sympa::WWW::Report::reject_report_web('user', 'no_email', {},
17207                $param->{'action'});
17208            wwslog('info', 'No email');
17209            web_db_log(
17210                {   'parameters'   => $email,
17211                    'target_email' => $email,
17212                    'status'       => 'error',
17213                    'error_type'   => "no_email"
17214                }
17215            );
17216            return 'pref';
17217        }
17218
17219        unless ($session->{auth} eq 'classic') {
17220            Sympa::WWW::Report::reject_report_web('user',
17221                'no_classic_session', {}, $param->{'action'});
17222            wwslog('info', 'No classic session');
17223            web_db_log(
17224                {   'parameters'   => $email,
17225                    'target_email' => $email,
17226                    'status'       => 'error',
17227                    'error_type'   => "no_classic_session"
17228                }
17229            );
17230            return 'pref';
17231        }
17232
17233        my $next_action =
17234            $session->confirm_action($in{'action'}, $in{'response_action'},
17235            previous_action => 'pref');
17236
17237        unless ($passwd) {
17238            Sympa::WWW::Report::reject_report_web('user', 'missing_arg',
17239                {'argument' => 'passwd'},
17240                $param->{'action'});
17241            wwslog('info', 'Missing parameter passwd');
17242            web_db_log(
17243                {   'parameters'   => $email,
17244                    'target_email' => $email,
17245                    'status'       => 'error',
17246                    'error_type'   => "missing_parameter"
17247                }
17248            );
17249            return 'pref';
17250        }
17251
17252        my $data;
17253
17254        unless (($next_action eq '1')
17255            || ($data = Sympa::WWW::Auth::check_auth($robot, $email, $passwd))
17256        ) {
17257            $log->syslog('notice', 'Authentication failed');
17258            web_db_log(
17259                {   'parameters'   => $email,
17260                    'target_email' => $email,
17261                    'status'       => 'error',
17262                    'error_type'   => 'authentication'
17263                }
17264            );
17265            return 'pref';
17266        }
17267
17268        return $next_action unless $next_action eq '1';
17269
17270        $param->{'email'} = $email;
17271
17272        _set_my_lists_info();
17273
17274        my @only_owner;
17275        for my $list (sort keys %{$param->{'which'}}) {
17276            my $l = Sympa::List->new($list, $robot);
17277            # Unsubscribe
17278            $l->delete_list_member('users' => [$email])
17279                if $param->{'which'}->{$list}->{'is_subscriber'};
17280            # Remove from the editors
17281            $l->delete_list_admin('editor', $email)
17282                if $param->{'which'}->{$list}->{'is_editor'};
17283            # Remove from the owners
17284            if ($param->{'which'}->{$list}->{'is_owner'}) {
17285                my @admins = $l->get_admins('owner');
17286                if (scalar(@admins) > 1) {
17287                    $l->delete_list_admin('owner', $email);
17288
17289                    # Don't let a list without a privileged admin
17290                    my @privileged_admins =
17291                        $l->get_admins('privileged_owner');
17292                    unless (scalar(@privileged_admins)) {
17293                        @admins = $l->get_admins('owner');
17294                        for my $admin (@admins) {
17295                            $l->update_list_admin($admin->{email}, 'owner',
17296                                {profile => 'privileged'});
17297                        }
17298                    }
17299                } else {
17300                    wwslog(
17301                        'info',
17302                        sprintf(
17303                            'Account deletion: %s is the only owner of %s. The account will not be deleted.',
17304                            $email, $list
17305                        )
17306                    );
17307                    push @only_owner, $list;
17308                }
17309            }
17310        }
17311
17312        if (@only_owner) {
17313            Sympa::WWW::Report::reject_report_web('user', 'still_owner',
17314                {lists => join(', ', @only_owner)},
17315                $param->{'action'});
17316            return 'pref';
17317        }
17318
17319        my $user = Sympa::User->new($email);
17320        $user->expire;
17321
17322        wwslog(
17323            'info',
17324            sprintf('Account deletion: the account of %s has been deleted',
17325                $email)
17326        );
17327
17328        Sympa::WWW::Report::notice_report_web('account_deleted', {},
17329            $param->{'action'});
17330
17331        do_logout();
17332    } else {
17333        wwslog(
17334            'info',
17335            'Account deletion: %s asked for its account to be deleted but allow_account_deletion is not set to "on".',
17336            $param->{'user'}->{'email'}
17337        );
17338    }
17339}
17340
17341sub _is_action_disabled {
17342    my $action = shift;
17343
17344    unless (Conf::get_robot_conf($robot, 'shared_feature') eq 'on') {
17345        return 1
17346            if grep { $action eq $_ }
17347            qw(d_admin d_change_access d_control d_create_child d_delete
17348            d_describe d_editfile d_install_shared d_properties d_read
17349            d_reject_shared d_rename d_set_owner d_unzip d_update);
17350    }
17351
17352    return undef;
17353}
17354
17355sub prevent_visibility_bypass {
17356    wwslog('debug2', 'Starting');
17357    if (defined $list and ref $list eq 'Sympa::List') {
17358        my $result = Sympa::Scenario->new($list, 'visibility')->authz(
17359            $param->{'auth_method'},
17360            {   'sender'      => $param->{'user'}{'email'},
17361                'remote_host' => $param->{'remote_host'},
17362                'remote_addr' => $param->{'remote_addr'}
17363            }
17364        );
17365
17366        my $sub_is;
17367        my $reason;
17368        if (ref($result) eq 'HASH') {
17369            $sub_is = $result->{'action'};
17370            $reason = $result->{'reason'};
17371        }
17372        if ($sub_is =~ /reject/) {
17373            wwslog('info',
17374                'visibility: List must remain hidden. Returning "home" to prevent visibility bypass'
17375            );
17376            # The last resort. Never use default_home.
17377            return "home";
17378        } else {
17379            return undef;
17380        }
17381    }
17382    return undef;
17383}
17384
17385# No longer used.
17386#sub purely_closed;
17387
17388# Old name: tools::add_in_blacklist().
17389sub _add_in_blocklist {
17390    my $entry = shift;
17391    my $robot = shift;
17392    my $list  = shift;
17393
17394    $log->syslog('info', '(%s, %s, %s)', $entry, $robot, $list->{'name'});
17395    $entry = lc($entry);
17396    chomp $entry;
17397
17398    # robot blocklist not yet availible
17399    unless ($list) {
17400        $log->syslog('info',
17401            'Robot blocklist not yet availible, missing list parameter');
17402        return undef;
17403    }
17404    unless (($entry) && ($robot)) {
17405        $log->syslog('info', 'Missing parameters');
17406        return undef;
17407    }
17408    if ($entry =~ /\*.*\*/) {
17409        $log->syslog('info', 'Incorrect parameter %s', $entry);
17410        return undef;
17411    }
17412    my $dir = $list->{'dir'} . '/search_filters';
17413    unless ((-d $dir) || mkdir($dir, 0755)) {
17414        $log->syslog('info', 'Unable to create dir %s', $dir);
17415        return undef;
17416    }
17417    my $file = $dir . '/blocklist.txt';
17418
17419    my $fh;
17420    if (open $fh, '<', $file) {
17421        while (<$fh>) {
17422            next if (/^\s*$/o || /^[\#\;]/o);
17423            my $regexp = $_;
17424            chomp $regexp;
17425            $regexp =~ s/\*/.*/;
17426            $regexp = '^' . $regexp . '$';
17427            if ($entry =~ /$regexp/i) {
17428                $log->syslog('notice', '%s already in blocklist(%s)',
17429                    $entry, $_);
17430                return 0;
17431            }
17432        }
17433        close $fh;
17434    }
17435    unless (open $fh, '>>', $file) {
17436        $log->syslog('info', 'Append to file %s', $file);
17437        return undef;
17438    }
17439    print $fh "$entry\n";
17440    close $fh;
17441
17442}
17443
17444__END__
17445
17446=encoding utf-8
17447
17448=head1 NAME
17449
17450wwsympa, wwsympa.fcgi - WWSympa, Sympa's web interface
17451
17452=head1 DESCRIPTION
17453
17454This FastCGI script completely handles all aspects of the Sympa web interface.
17455
17456To know details on WWSympa, see Sympa Administration Manual:
17457L<https://sympa-community.github.io/manual/>.
17458
17459=head1 HISTORY
17460
17461WWSympa was initially written by:
17462
17463=over
17464
17465=item * Serge Aumont <sa AT cru.fr>
17466
17467=item * Olivier SalaE<252>n <os AT cru.fr>
17468
17469=back
17470
17471The first alpha version of WWSympa appeared on Sympa 2.3.4.
17472
17473=cut
17474