List.pm

# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014 GIP RENATER
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

package List;

use strict;
use warnings;
use Exporter;
use Encode;
use HTML::Entities qw(encode_entities);
use IO::Scalar;
use MIME::EncWords;
use MIME::Entity;
use MIME::Parser;
use POSIX qw(strftime);
use Storable;
use Time::Local qw(timelocal);

use Archive;
use Conf;
use Sympa::Constants;
use Datasource;
use Family;
use Fetch;
use Sympa::Language;
use LDAPSource;
use Sympa::ListDef;
use Sympa::LockedFile;
use Log;
use mail;
use Message;
use PlainDigest;
use Sympa::Regexps;
use Scenario;
use SDM;
use SQLSource;
use Task;
use tools;
use tt2;
use Sympa::User;
use WebAgent;

our @ISA = qw(Exporter);
our @EXPORT = qw(%list_of_lists);

my @sources_providing_listmembers = qw/
  include_file
  include_ldap_2level_query
  include_ldap_query  
  include_list
  include_remote_file
  include_remote_sympa_list  
  include_sql_query  
 /;

#XXX include_admin  
my @more_data_sources = qw/
  editor_include  
  owner_include
  /;

# All non-pluggable sources are in the admin user file
my %config_in_admin_user_file = map +($_ => 1), @sources_providing_listmembers;

# Language context
my $language = Sympa::Language->instance;

=encoding utf-8

=head1 CONSTRUCTOR

=item new( [PHRASE] )

 List->new();

Creates a new object which will be used for a list and
eventually loads the list if a name is given. Returns
a List object.

=back

=head1 METHODS

=over 4

=item load ( LIST )

Loads the indicated list into the object.

=item save ( LIST )

Saves the indicated list object to the disk files.

=item savestats ()

Saves updates the statistics file on disk.

=item update_stats( BYTES )

Updates the stats, argument is number of bytes, returns the next
sequence number. Does nothing if no stats.

=item send_sub_to_owner ( WHO, COMMENT )
Send a message to the list owners telling that someone
wanted to subscribe to the list.

=item send_to_editor ( MSG )
    
Send a Mail::Internet type object to the editor (for approval).

=item send_msg ( MSG )

Sends the Mail::Internet message to the list.

=item send_file ( FILE, USER, GECOS )

Sends the file to the USER. FILE may only be welcome for now.

=item delete_list_member ( ARRAY )

Delete the indicated users from the list.
 
=item delete_list_admin ( ROLE, ARRAY )

Delete the indicated admin user with the predefined role from the list.

=item get_cookie ()

Returns the cookie for a list, if available.

=item get_max_size ()

Returns the maximum allowed size for a message.

=item get_reply_to ()

Returns an array with the Reply-To values.

=item get_default_user_options ()

Returns a default option of the list for subscription.

=item get_total ()

Returns the number of subscribers to the list.


=item get_global_user ( USER )

Returns a hash with the information regarding the indicated
user.

=item get_list_member ( USER )

Returns a subscriber of the list.

=item get_list_admin ( ROLE, USER)

Return an admin user of the list with predefined role

=item get_first_list_member ()

Returns a hash to the first user on the list.

=item get_first_list_admin ( ROLE )

Returns a hash to the first admin user with predefined role on the list.

=item get_next_list_member ()

Returns a hash to the next users, until we reach the end of
the list.

=item get_next_list_admin ()

Returns a hash to the next admin users, until we reach the end of
the list.

=item update_list_member ( USER, HASHPTR )

Sets the new values given in the hash for the user.

=item update_list_admin ( USER, ROLE, HASHPTR )

Sets the new values given in the hash for the admin user.

=item add_list_member ( USER, HASHPTR )

Adds a new user to the list. May overwrite existing
entries.

=item add_admin_user ( USER, ROLE, HASHPTR )

Adds a new admin user to the list. May overwrite existing
entries.

=item is_list_member ( USER )

Returns true if the indicated user is member of the list.
 
=item am_i ( FUNCTION, USER )

Returns true is USER has FUNCTION (owner, editor) on the
list.

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

Chcks is USER may do the ACTION for the list. ACTION can be
one of following : send, review, index, getm add, del,
reconfirm, purge.

=item is_moderated ()

Returns true if the list is moderated.

=item archive_exist ( FILE )

Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

Send the indicated archive file to the user, if it exists.

=item archive_ls ()

Returns the list of available files, if any.

=item archive_msg ( MSG )

Archives the Mail::Internet message given as argument.

=item is_archived ()

Returns true is the list is configured to keep archives of
its messages.

=item get_stats ( OPTION )

Returns either a formatted printable strings or an array whith
the statistics. OPTION can be 'text' or 'array'.

=item print_info ( FDNAME )

Print the list information to the given file descriptor, or the
currently selected descriptor.

=cut

## Database and SQL statement handlers
my ($sth, @sth_stack);

my %list_cache;

## DB fields with numeric type
## We should not do quote() for these while inserting data
my %numeric_field = ('cookie_delay_user' => 1,
		     'bounce_score_subscriber' => 1,
		     'subscribed_subscriber' => 1,
		     'included_subscriber' => 1,
		     'subscribed_admin' => 1,
		     'included_admin' => 1,
		     'wrong_login_count' => 1,
		      );
		      

## List parameter values except for parameters below.
my %list_option = (

    # reply_to_header.apply
    'forced'  => {'gettext_id' => 'overwrite Reply-To: header field'},
    'respect' => {'gettext_id' => 'preserve existing header field'},

    # reply_to_header.value
    'sender' => {'gettext_id' => 'sender'},

    # reply_to_header.value, include_remote_sympa_list.cert
    'list' => {'gettext_id' => 'list'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1,
    # include_ldap_query.select, reply_to_header.value, dmarc_protection.mode
    'all' => {'gettext_id' => 'all'},

    # reply_to_header.value
    'other_email' => {'gettext_id' => 'other email address'},

    # msg_topic_keywords_apply_on
    'subject'          => {'gettext_id' => 'subject field'},
    'body'             => {'gettext_id' => 'message body'},
    'subject_and_body' => {'gettext_id' => 'subject and body'},

    # bouncers_level2.notification, bouncers_level2.action,
    # bouncers_level1.notification, bouncers_level1.action,
    # spam_protection, dkim_signature_apply_on, web_archive_spam_protection,
    # dmarc_protection.mode
    'none' => {'gettext_id' => 'do nothing'},

    # bouncers_level2.notification, bouncers_level1.notification,
    # welcome_return_path, remind_return_path, rfc2369_header_fields,
    # archive.access
    'owner' => {'gettext_id' => 'owner'},

    # bouncers_level2.notification, bouncers_level1.notification
    'listmaster' => {'gettext_id' => 'listmaster'},

    # bouncers_level2.action, bouncers_level1.action
    'remove_bouncers' => {'gettext_id' => 'remove bouncing users'},
    'notify_bouncers' => {'gettext_id' => 'send notify to bouncing users'},

    # pictures_feature, dkim_feature, merge_feature,
    # inclusion_notification_feature, tracking.delivery_status_notification,
    # tracking.message_delivery_notification
    'on'  => {'gettext_id' => 'enabled'},
    'off' => {'gettext_id' => 'disabled'},

    # include_remote_sympa_list.cert
    'robot' => {'gettext_id' => 'robot'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1,
    # include_ldap_query.select
    'first' => {'gettext_id' => 'first entry'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1
    'regex' => {'gettext_id' => 'entries matching regular expression'},

    # include_ldap_2level_query.scope2, include_ldap_2level_query.scope1,
    # include_ldap_query.scope
    'base' => {'gettext_id' => 'base'},
    'one'  => {'gettext_id' => 'one level'},
    'sub'  => {'gettext_id' => 'subtree'},

    # include_ldap_2level_query.use_ssl, include_ldap_query.use_ssl
    'yes' => {'gettext_id' => 'yes'},
    'no'  => {'gettext_id' => 'no'},

    # include_ldap_2level_query.ssl_version, include_ldap_query.ssl_version
    'sslv2' => {'gettext_id' => 'SSL version 2'},
    'sslv3' => {'gettext_id' => 'SSL version 3'},
    'tls'   => {'gettext_id' => 'TLS'},

    # editor.reception, owner_include.reception, owner.reception,
    # editor_include.reception
    'mail'   => {'gettext_id' => 'receive notification email'},
    'nomail' => {'gettext_id' => 'no notifications'},

    # editor.visibility, owner_include.visibility, owner.visibility,
    # editor_include.visibility
    'conceal'   => {'gettext_id' => 'concealed from list menu'},
    'noconceal' => {'gettext_id' => 'listed on the list menu'},

    # welcome_return_path, remind_return_path
    'unique' => {'gettext_id' => 'bounce management'},

    # owner_include.profile, owner.profile
    'privileged' => {'gettext_id' => 'privileged owner'},
    'normal'     => {'gettext_id' => 'normal owner'},

    # priority
    '0' => {'gettext_id' => '0 - highest priority'},
    '9' => {'gettext_id' => '9 - lowest priority'},
    'z' => {'gettext_id' => 'queue messages only'},

    # spam_protection, web_archive_spam_protection
    'at'         => {'gettext_id' => 'replace @ characters'},
    'javascript' => {'gettext_id' => 'use JavaScript'},

    # msg_topic_tagging
    'required_sender' => {'gettext_id' => 'required to post message'},
    'required_moderator' =>
	{'gettext_id' => 'required to distribute message'},

    # msg_topic_tagging, custom_attribute.optional
    'optional' => {'gettext_id' => 'optional'},

    # custom_attribute.optional
    'required' => {'gettext_id' => 'required'},

    # custom_attribute.type
    'string'  => {'gettext_id' => 'string'},
    'text'    => {'gettext_id' => 'multi-line text'},
    'integer' => {'gettext_id' => 'number'},
    'enum'    => {'gettext_id' => 'set of keywords'},

    # footer_type
    'mime'   => {'gettext_id' => 'add a new MIME part'},
    'append' => {'gettext_id' => 'append to message body'},

    # archive.access
    'open'    => {'gettext_id' => 'open'},
    'closed'  => {'gettext_id' => 'closed'},
    'private' => {'gettext_id' => 'subscribers only'},
    'public'  => {'gettext_id' => 'public'},

##    ## user_data_source
##    'database' => {'gettext_id' => 'RDBMS'},
##    'file'     => {'gettext_id' => 'include from local file'},
##    'include'  => {'gettext_id' => 'include from external source'},
##    'include2' => {'gettext_id' => 'general datasource'},

    # rfc2369_header_fields
    'help'        => {'gettext_id' => 'help'},
    'subscribe'   => {'gettext_id' => 'subscription'},
    'unsubscribe' => {'gettext_id' => 'unsubscription'},
    'post'        => {'gettext_id' => 'posting address'},
    'archive'     => {'gettext_id' => 'list archive'},

    # dkim_signature_apply_on
    'md5_authenticated_messages' =>
	{'gettext_id' => 'authenticated by password'},
    'smime_authenticated_messages' =>
	{'gettext_id' => 'authenticated by S/MIME signature'},
    'dkim_authenticated_messages' =>
	{'gettext_id' => 'authenticated by DKIM signature'},
    'editor_validated_messages' => {'gettext_id' => 'approved by editor'},
    'any'                       => {'gettext_id' => 'any messages'},

    # archive.period
    'day'     => {'gettext_id' => 'daily'},
    'week'    => {'gettext_id' => 'weekly'},
    'month'   => {'gettext_id' => 'monthly'},
    'quarter' => {'gettext_id' => 'quarterly'},
    'year'    => {'gettext_id' => 'yearly'},

    # web_archive_spam_protection
    'cookie' => {'gettext_id' => 'use HTTP cookie'},

    # verp_rate
    '100%' => {'gettext_id' => '100% - always'},
    '0%'   => {'gettext_id' => '0% - never'},

    # archive_crypted_msg
    'original'  => {'gettext_id' => 'original messages'},
    'decrypted' => {'gettext_id' => 'decrypted messages'},

    # tracking.message_delivery_notification
    'on_demand' => {'gettext_id' => 'on demand'},

    # dmarc_protection.mode
    'dkim_signature' => {'gettext_id' => 'DKIM signature exists'},
    'dmarc_any'      => {'gettext_id' => 'DMARC policy exists'},
    'dmarc_reject'   => {'gettext_id' => 'DMARC policy suggests rejection'},
    'dmarc_quarantine' => {'gettext_id' => 'DMARC policy suggests quarantine'},
    'domain_regex'   => {'gettext_id' => 'domain matching regular expression'},

    # dmarc_protection.phrase
    'display_name'   => {'gettext_id' => 'display name'},
    'name_and_email' => {'gettext_id' => 'display name and e-mail'},
    'name_via_list'  => {'gettext_id' => 'name "via Mailing List"'},
    'name_email_via_list' => {'gettext_id' => 'e-mail "via Mailing List"'},
);

## Values for subscriber reception mode.
my %reception_mode = (
    'mail'        => {'gettext_id' => 'standard (direct reception)'},
    'digest'      => {'gettext_id' => 'digest MIME format'},
    'digestplain' => {'gettext_id' => 'digest plain text format'},
    'summary'     => {'gettext_id' => 'summary mode'},
    'notice'      => {'gettext_id' => 'notice mode'},
    'txt'         => {'gettext_id' => 'text-only mode'},
    'html'        => {'gettext_id' => 'html-only mode'},
    'urlize'      => {'gettext_id' => 'urlize mode'},
    'nomail'      => {'gettext_id' => 'no mail'},
    'not_me'      => {'gettext_id' => 'you do not receive your own posts'}
);

## Values for subscriber visibility mode.
my %visibility_mode = (
    'noconceal' => {'gettext_id' => 'listed in the list review page'},
    'conceal'   => {'gettext_id' => 'concealed'}
);

## Values for list status.
my %list_status = (
    'open'          => {'gettext_id' => 'in operation'},
    'pending'       => {'gettext_id' => 'list not yet activated'},
    'error_config'  => {'gettext_id' => 'erroneous configuration'},
    'family_closed' => {'gettext_id' => 'closed family instance'},
    'closed'        => {'gettext_id' => 'closed list'},
);

## This is the generic hash which keeps all lists in memory.
my %list_of_lists = ();
my %list_of_robots = ();
our %list_of_topics = ();
my %edit_list_conf = ();

## Last modification times
my %mtime;

use DB_File;
$DB_BTREE->{compare} = \&_compare_addresses;

our %listmaster_messages_stack;

## Creates an object.
sub new {
    my($pkg, $name, $robot, $options) = @_;
    my $list={};
    &Log::do_log('debug2', 'List::new(%s, %s, %s)', $name, $robot, join('/',keys %$options));
    
    ## Allow robot in the name
    if ($name =~ /\@/) {
	my @parts = split /\@/, $name;
	$robot ||= $parts[1];
	$name = $parts[0];
    }

    ## Look for the list if no robot was provided
    $robot ||= &search_list_among_robots($name);

    unless ($robot) {
	&Log::do_log('err', 'Missing robot parameter, cannot create list object for %s',  $name) unless ($options->{'just_try'});
	return undef;
    }

    $options = {} unless (defined $options);

    ## Only process the list if the name is valid.
    my $listname_regexp = Sympa::Regexps::listname();
    unless ($name and ($name =~ /^($listname_regexp)$/io) ) {
	&Log::do_log('err', 'Incorrect listname "%s"',  $name) unless ($options->{'just_try'});
	return undef;
    }
    ## Lowercase the list name.
    $name = $1;
    $name =~ tr/A-Z/a-z/;
    
    ## Reject listnames with reserved list suffixes
    my $regx = &Conf::get_robot_conf($robot,'list_check_regexp');
    if ( $regx ) {
	if ($name =~ /^(\S+)-($regx)$/) {
	    &Log::do_log('err', 'Incorrect name: listname "%s" matches one of service aliases',  $name) unless ($options->{'just_try'});
	    return undef;
	}
    }

    my $status ;
    ## If list already in memory and not previously purged by another process
    if ($list_of_lists{$robot}{$name} and -d $list_of_lists{$robot}{$name}{'dir'}){
	# use the current list in memory and update it
	$list=$list_of_lists{$robot}{$name};
	
	$status = $list->load($name, $robot, $options);
    }else{
	# create a new object list
	bless $list, $pkg;

	$options->{'first_access'} = 1;
	$status = $list->load($name, $robot, $options);
    }   
    unless (defined $status) {
	return undef;
    }

    ## Config file was loaded or reloaded
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}||$list->{'admin'}{'ttl'};
    if (
	$status == 1
	&& (! $options->{'skip_sync_admin'}
	|| ($options->{'optional_sync_admin'} && $list->{'last_sync'} < time - $pertinent_ttl)
	|| $options->{'force_sync_admin'})
	)
    {
	## Update admin_table
	unless (defined $list->sync_include_admin()) {
	    &Log::do_log('err','List::new() : sync_include_admin_failed') unless ($options->{'just_try'});
	}
	if ($list->get_nb_owners() < 1 &&
	    $list->{'admin'}{'status'} ne 'error_config') {
	    &Log::do_log('err', 'The list "%s" has got no owner defined',$list->{'name'}) ;
	    $list->set_status_error_config('no_owner_defined',$list->{'name'});
	}
    }

    return $list;
}

## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
    
    unless ($listname) {
 	&Log::do_log('err', 'List::search_list_among_robots() : Missing list parameter');
 	return undef;
    }
    
    ## Search in default robot
    if (-d $Conf::Conf{'home'}.'/'.$listname) {
 	return $Conf::Conf{'domain'};
    }
    
     foreach my $r (keys %{$Conf::Conf{'robots'}}) {
	 if (-d $Conf::Conf{'home'}.'/'.$r.'/'.$listname) {
	     return $r;
	 }
     }
    
     return 0;
}

## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
    my ($self, $message, @param) = @_;
    &Log::do_log('debug3', 'List::set_status_error_config');

    unless ($self->{'admin'}{'status'} eq 'error_config'){
	$self->{'admin'}{'status'} = 'error_config';

	#my $host = &Conf::get_robot_conf($self->{'domain'}, 'host');
	## No more save config in error...
	#$self->save_config("listmaster\@$host");
	#$self->savestats();
	&Log::do_log('err', 'The list "%s" is set in status error_config',$self->{'name'});
	unless (&List::send_notify_to_listmaster($message, $self->{'domain'},\@param)) {
	    &Log::do_log('notice',"Unable to send notify '$message' to listmaster");
	};
    }
}

## set the list in status family_closed and send a notify to owners
sub set_status_family_closed {
    my ($self, $message, @param) = @_;
    &Log::do_log('debug2', 'List::set_status_family_closed');
    
    unless ($self->{'admin'}{'status'} eq 'family_closed'){
	
	my $host = &Conf::get_robot_conf($self->{'domain'}, 'host');	
	
	unless ($self->close_list("listmaster\@$host",'family_closed')) {
	    &Log::do_log('err','Impossible to set the list %s in status family_closed');
	    return undef;
	}
	&Log::do_log('info', 'The list "%s" is set in status family_closed',$self->{'name'});
	unless ($self->send_notify_to_owner($message,\@param)){
	    &Log::do_log('err','Impossible to send notify to owner informing status family_closed for the list %s',$self->{'name'});
	}
# messages : close_list
    }
    return 1;
}

## Saves the statistics data to disk.
sub savestats {
    my $self = shift;
    &Log::do_log('debug2', 'List::savestats');
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $dir = $self->{'dir'};
    return undef unless ($list_of_lists{$self->{'domain'}}{$name});

    unless (ref($self->{'stats'}) eq 'ARRAY') {
	Log::do_log('err', 'incorrect parameter');
	return undef;
    }

    ## Lock file
    my $lock_fh = Sympa::LockedFile->new($dir . '/stats', 2, '>');
    unless ($lock_fh) {
	Log::do_log('err','Could not create new lock');
	return undef;
    }   

    printf $lock_fh "%d %.0f %.0f %.0f %d %d %d\n",
	@{$self->{'stats'}}, $self->{'total'}, $self->{'last_sync'},
	$self->{'last_sync_admin_user'};

    ## Release the lock
    unless ($lock_fh->close) {
	return undef;
    }

    ## Changed on disk
    $self->{'mtime'}[2] = time;

    return 1;
}

## msg count.
sub increment_msg_count {
    my $self = shift;
    &Log::do_log('debug2', "List::increment_msg_count($self->{'name'})");
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/msg_count";
    
    my %count ; 
    if (open(MSG_COUNT, $file)) {	
	while (<MSG_COUNT>){
	    if ($_ =~ /^(\d+)\s(\d+)$/) {
		$count{$1} = $2;	
	    }
	}
	close MSG_COUNT ;
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
	$count{$today}++;
    }else{
	$count{$today} = 1;
    }
    
    unless (open(MSG_COUNT, ">$file.$$")) {
	&Log::do_log('err', "Unable to create '%s.%s' : %s", $file,$$, $!);
	return undef;
    }
    foreach my $key (sort {$a <=> $b} keys %count) {
	printf MSG_COUNT "%d\t%d\n",$key,$count{$key} ;
    }
    close MSG_COUNT ;
    
    unless (rename("$file.$$", $file)) {
	&Log::do_log('err', "Unable to write '%s' : %s", $file, $!);
	return undef;
    }
    return 1;
}

# Returns the number of messages sent to the list
sub get_msg_count {
    my $self = shift;
    &Log::do_log('debug3', "Getting the number of messages for list %s",$self->{'name'});

    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/stats";
    
    my $count = 0 ;
    if (open(MSG_COUNT, $file)) {	
	while (<MSG_COUNT>){
	    if ($_ =~ /^(\d+)\s+(.*)$/) {
		$count=$1;	
	    }
	}
	close MSG_COUNT ;
    }

    return $count;

}
## last date of distribution message .
sub get_latest_distribution_date {
    my $self = shift;
    &Log::do_log('debug3', "List::latest_distribution_date($self->{'name'})");
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/msg_count";
    
    my %count ; 
    my $latest_date = 0 ; 
    unless (open(MSG_COUNT, $file)) {
	&Log::do_log('debug2',"get_latest_distribution_date: unable to open $file");
	return undef ;
    }

    while (<MSG_COUNT>){
	if ($_ =~ /^(\d+)\s(\d+)$/) {
	    $latest_date = $1 if ($1 > $latest_date);
	}
    }
    close MSG_COUNT ;

    return undef if ($latest_date == 0); 
    return $latest_date ;
}

## Update the stats struct 
## Input  : num of bytes of msg
## Output : num of msgs sent
sub update_stats {
    my($self, $bytes) = @_;
    &Log::do_log('debug2', 'List::update_stats(%d)', $bytes);

    my $stats = $self->{'stats'};
    $stats->[0]++;
    $stats->[1] += $self->{'total'};
    $stats->[2] += $bytes;
    $stats->[3] += $bytes * $self->{'total'};

    ## Update 'msg_count' file, used for bounces management
    $self->increment_msg_count();

    return $stats->[0];
}

## Extract a set of rcpt for which verp must be use from a rcpt_tab.
## Input  :  percent : the rate of subscribers that must be threaded using verp
##           xseq    : the message sequence number
##           @rcpt   : a tab of emails
## return :  a tab of rcpt for which rcpt must be use depending on the message sequence number, this way every subscriber is "verped" from time to time
##           input table @rcpt is spliced : rcpt for which verp must be used are extracted from this table
sub extract_verp_rcpt {
    my $percent = shift;
    my $xseq = shift;
    my $refrcpt = shift;
    my $refrcptverp = shift;

    &Log::do_log('debug','&extract_verp(%s,%s,%s,%s)',$percent,$xseq,$refrcpt,$refrcptverp)  ;

    my @result;

    if ($percent ne '0%') {
	my $nbpart ; 
	if ( $percent =~ /^(\d+)\%/ ) {
	    $nbpart = 100/$1;  
	}
	else {
	    &Log::do_log ('err', 'Wrong format for parameter extract_verp: %s. Can\'t process VERP.',$percent);
	    return undef;
	}
	
	my $modulo = $xseq % $nbpart ;
	my $lenght = int (($#{$refrcpt} + 1) / $nbpart) + 1;
	
	@result = splice @$refrcpt, $lenght*$modulo, $lenght ;
    }
    foreach my $verprcpt (@$refrcptverp) {
	push @result, $verprcpt;
    }
    return ( @result ) ;
}



## Dumps a copy of lists to disk, in text format
sub dump {
    my $self = shift;
    &Log::do_log('debug2', 'List::dump(%s)', $self->{'name'});

    unless (defined $self) {
	&Log::do_log('err','Unknown list');
	return undef;
    }

    my $user_file_name = "$self->{'dir'}/subscribers.db.dump";

    unless ($self->_save_list_members_file($user_file_name)) {
	&Log::do_log('err', 'Failed to save file %s', $user_file_name);
	return undef;
    }
    
    $self->{'mtime'} = [ (stat("$self->{'dir'}/config"))[9], (stat("$self->{'dir'}/subscribers"))[9], (stat("$self->{'dir'}/stats"))[9] ];

    return 1;
}

## Saves the configuration file to disk
sub save_config {
    my ($self, $email) = @_;
    &Log::do_log('debug3', 'List::save_config(%s,%s)', $self->{'name'}, $email);

    return undef 
	unless ($self);

    my $config_file_name = "$self->{'dir'}/config";

    ## Lock file
    my $lock_fh = Sympa::LockedFile->new($config_file_name, 5, '+<');
    unless ($lock_fh) {
	Log::do_log('err', 'Could not create new lock');
	return undef;
    }

    my $name = $self->{'name'};    
    my $old_serial = $self->{'admin'}{'serial'};
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";

    ## Update management info
    $self->{'admin'}{'serial'}++;
    $self->{'admin'}{'update'} = {
	'email' => $email,
	'date_epoch' => time,
	'date' => $language->gettext_strftime(
	    "%d %b %Y at %H:%M:%S", localtime time),
    };

    unless ($self->_save_list_config_file($config_file_name, $old_config_file_name)) {
	&Log::do_log('info', 'unable to save config file %s', $config_file_name);
	$lock_fh->close();
	return undef;
    }
    
    ## Also update the binary version of the data structure
    if (&Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq 'binary_file') {
	eval {&Storable::store($self->{'admin'},"$self->{'dir'}/config.bin")};
	if ($@) {
	    &Log::do_log('err', 'Failed to save the binary config %s. error: %s', "$self->{'dir'}/config.bin",$@);
	}
    }

#    $self->{'mtime'}[0] = (stat("$list->{'dir'}/config"))[9];
    
    ## Release the lock
    unless ($lock_fh->close()) {
	return undef;
    }

    if ($SDM::use_db) {
        unless (&_update_list_db) {
            &Log::do_log('err', "Unable to update list_table");
        }
    }

    return 1;
}

## Loads the administrative data for a list
sub load {
    my ($self, $name, $robot, $options) = @_;
    &Log::do_log('debug2', 'List::load(%s, %s, %s)', $name, $robot, join('/',keys %$options));
    
    my $users;

    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {

	## Search robot if none was provided
	unless ($robot) {
	    foreach my $r (keys %{$Conf::Conf{'robots'}}) {
		if (-d "$Conf::Conf{'home'}/$r/$name") {
		    $robot=$r;
		    last;
		}
	    }
	    
	    ## Try default robot
	    unless ($robot) {
		if (-d "$Conf::Conf{'home'}/$name") {
		    $robot = $Conf::Conf{'domain'};
		}
	    }
	}
	
	if ($robot && (-d "$Conf::Conf{'home'}/$robot")) {
	    $self->{'dir'} = "$Conf::Conf{'home'}/$robot/$name";
	}elsif (lc($robot) eq lc($Conf::Conf{'domain'})) {
	    $self->{'dir'} = "$Conf::Conf{'home'}/$name";
	}else {
	    &Log::do_log('err', 'No such robot (virtual domain) %s', $robot) unless ($options->{'just_try'});
	    return undef ;
	}
	
	$self->{'domain'} = $robot ;

	# default list host is robot domain
	$self->{'admin'}{'host'} ||= $self->{'domain'};
	$self->{'name'}  = $name ;
    }

    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
	&Log::do_log('debug2', 'Missing directory (%s) or config file for %s', $self->{'dir'}, $name) unless ($options->{'just_try'});
	return undef ;
    }

    my ($m1, $m2, $m3) = (0, 0, 0);
    ($m1, $m2, $m3) = @{$self->{'mtime'}} if (defined $self->{'mtime'});

    my $time_config = (stat("$self->{'dir'}/config"))[9];
    my $time_config_bin = (stat("$self->{'dir'}/config.bin"))[9];
    my $time_subscribers; 
    my $time_stats = (stat("$self->{'dir'}/stats"))[9];
    my $config_reloaded = 0;
    my $admin;
    
    if (&Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq 'binary_file' &&
	$time_config_bin > $self->{'mtime'}->[0] &&
	$time_config <= $time_config_bin &&
	! $options->{'reload_config'}) { 

	## Get a shared lock on config file first 
	my $lock_fh =
	    Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '<');
	unless ($lock_fh) {
	    Log::do_log('err', 'Could not create new lock');
	    return undef;
	}

	## Load a binary version of the data structure
	## unless config is more recent than config.bin
	eval {$admin = &Storable::retrieve("$self->{'dir'}/config.bin")};
	if ($@) {
	    &Log::do_log('err', 'Failed to load the binary config %s, error: %s', "$self->{'dir'}/config.bin",$@);
	    $lock_fh->close();
	    return undef;
	}	    

	$config_reloaded = 1;
	$m1 = $time_config_bin;
	$lock_fh->close();

    }elsif ($self->{'name'} ne $name || $time_config > $self->{'mtime'}->[0] ||
	    $options->{'reload_config'}) {	
	$admin = _load_list_config_file($self->{'dir'}, $self->{'domain'}, 'config');

	## Get a shared lock on config file first 
	my $lock_fh =
	    Sympa::LockedFile->new($self->{'dir'} . '/config', 5, '+<');
	unless ($lock_fh) {
	    Log::do_log('err','Could not create new lock');
	    return undef;
	}

	## update the binary version of the data structure
	if (&Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq 'binary_file') {
	    eval {&Storable::store($admin,"$self->{'dir'}/config.bin")};
	    if ($@) {
		&Log::do_log('err', 'Failed to save the binary config %s. error: %s', "$self->{'dir'}/config.bin",$@);
	    }
	}

	$config_reloaded = 1;
 	unless (defined $admin) {
 	    &Log::do_log('err', 'Impossible to load list config file for list % set in status error_config',$self->{'name'});
 	    $self->set_status_error_config('load_admin_file_error',$self->{'name'});
	    $lock_fh->close();
 	    return undef;	    
 	}

	$m1 = $time_config;
	$lock_fh->close();
    }
    
    ## If config was reloaded...
    if ($admin) {
 	$self->{'admin'} = $admin;
 	
 	## check param_constraint.conf if belongs to a family and the config has been loaded
 	if (defined $admin->{'family_name'} && ($admin->{'status'} ne 'error_config')) {
 	    my $family;
 	    unless ($family = $self->get_family()) {
 		&Log::do_log('err', 'Impossible to get list %s family : %s. The list is set in status error_config',$self->{'name'},$self->{'admin'}{'family_name'});
 		$self->set_status_error_config('no_list_family',$self->{'name'}, $admin->{'family_name'});
		return undef;
 	    }  
 	    my $error = $family->check_param_constraint($self);
 	    unless($error) {
 		&Log::do_log('err', 'Impossible to check parameters constraint for list % set in status error_config',$self->{'name'});
 		$self->set_status_error_config('no_check_rules_family',$self->{'name'}, $family->{'name'});
 	    }
	    if (ref($error) eq 'ARRAY') {
 		&Log::do_log('err', 'The list "%s" does not respect the rules from its family %s',$self->{'name'}, $family->{'name'});
 		$self->set_status_error_config('no_respect_rules_family',$self->{'name'}, $family->{'name'});
 	    }
 	}
     } 

    $self->{'as_x509_cert'} = 1  if ((-r "$self->{'dir'}/cert.pem") || (-r "$self->{'dir'}/cert.pem.enc"));

   ## Load stats file if first new() or stats file changed
    my ($stats, $total);
    if (! $self->{'mtime'}[2] || ($time_stats > $self->{'mtime'}[2])) {
	($stats, $total, $self->{'last_sync'}, $self->{'last_sync_admin_user'}) = _load_stats_file("$self->{'dir'}/stats");
	$m3 = $time_stats;

	$self->{'stats'} = $stats if (defined $stats);	
	$self->{'total'} = $total if (defined $total);	
    }
    
    $self->{'users'} = $users->{'users'} if ($users);
    $self->{'ref'}   = $users->{'ref'} if ($users);
    
    if ($users && defined($users->{'total'})) {
	$self->{'total'} = $users->{'total'};
    }

    ## We have updated %users, Total may have changed
    if ($m2 > $self->{'mtime'}[1]) {
	$self->savestats();
    }

    $self->{'mtime'} = [ $m1, $m2, $m3];

    $list_of_lists{$self->{'domain'}}{$name} = $self;
    return $config_reloaded;
}

## Return a list of hash's owners and their param
sub get_owners {
    my($self) = @_;
    &Log::do_log('debug3', 'List::get_owners(%s)', $self->{'name'});
  
    my $owners = ();

    # owners are in the admin_table ; they might come from an include data source
    for (my $owner = $self->get_first_list_admin('owner'); $owner; $owner = $self->get_next_list_admin()) {
	push(@{$owners},$owner);
    } 

    return $owners;
}

sub get_nb_owners {
    my($self) = @_;
    &Log::do_log('debug3', 'List::get_nb_owners(%s)', $self->{'name'});
    
    my $resul = 0;
    my $owners = $self->get_owners;

    if (defined $owners) {
	$resul = $#{$owners} + 1;
    }
    return $resul;
}

## Return a hash of list's editors and their param(empty if there isn't any editor)
sub get_editors {
    my($self) = @_;
    &Log::do_log('debug3', 'List::get_editors(%s)', $self->{'name'});
  
    my $editors = ();

    # editors are in the admin_table ; they might come from an include data source
    for (my $editor = $self->get_first_list_admin('editor'); $editor; $editor = $self->get_next_list_admin()) {
	push(@{$editors},$editor);
    } 

    return $editors;
}


## Returns an array of owners' email addresses
sub get_owners_email {
    my($self,$param) = @_;
    &Log::do_log('debug3', 'List::get_owners_email(%s,%s)', $self->{'name'}, $param -> {'ignore_nomail'});
    
    my @rcpt;
    my $owners = ();

    $owners = $self->get_owners();

    if ($param -> {'ignore_nomail'}) {
	foreach my $o (@{$owners}) {
	    push (@rcpt, lc($o->{'email'}));
	}
    }
    else {
	foreach my $o (@{$owners}) {
	    next if ($o->{'reception'} eq 'nomail');
	    push (@rcpt, lc($o->{'email'}));
	}
    }
    unless (@rcpt) {
	&Log::do_log('notice','Warning : no owner found for list %s', $self->{'name'} );
    }
    return @rcpt;
}

## Returns an array of editors' email addresses
#  or owners if there isn't any editors'email adress
sub get_editors_email {
    my($self,$param) = @_;
    &Log::do_log('debug3', 'List::get_editors_email(%s,%s)', $self->{'name'}, $param -> {'ignore_nomail'});
    
    my @rcpt;
    my $editors = ();

    $editors = $self->get_editors();

    if ($param -> {'ignore_nomail'}) {
	foreach my $e (@{$editors}) {
	    push (@rcpt, lc($e->{'email'}));
	}
    }
    else {
	foreach my $e (@{$editors}) {
	    next if ($e->{'reception'} eq 'nomail');
	    push (@rcpt, lc($e->{'email'}));
	}
    }
    unless (@rcpt) {
	&Log::do_log('notice','Warning : no editor found for list %s, getting owners', $self->{'name'} );
	@rcpt = $self->get_owners_email($param);
    }
    return @rcpt;
}

## Returns an object Family if the list belongs to a family
#  or undef
sub get_family {
    my $self = shift;
    &Log::do_log('debug3', 'List::get_family(%s)', $self->{'name'});
    
    if (ref($self->{'family'}) eq 'Family') {
	return $self->{'family'};
    }

    my $family_name;
    my $robot = $self->{'domain'};

    unless (defined $self->{'admin'}{'family_name'}) {
	&Log::do_log('err', 'List::get_family(%s) : this list has not got any family', $self->{'name'});
	return undef;
    }
        
    $family_name = $self->{'admin'}{'family_name'};
	    
    my $family;
    unless ($family = new Family($family_name,$robot) ) {
	&Log::do_log('err', 'List::get_family(%s) : new Family(%s) impossible', $self->{'name'},$family_name);
	return undef;
    }
  	
    $self->{'family'} = $family;
    return $family;
}

## return the config_changes hash
## Used ONLY with lists belonging to a family.
sub get_config_changes {
    my $self = shift;
    &Log::do_log('debug3', 'List::get_config_changes(%s)', $self->{'name'});
    
    unless ($self->{'admin'}{'family_name'}) {
	&Log::do_log('err', 'List::get_config_changes(%s) is called but there is no family_name for this list.',$self->{'name'});
	return undef;
    }
    
    ## load config_changes
    my $time_file = (stat("$self->{'dir'}/config_changes"))[9];
    unless (defined $self->{'config_changes'} && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
	unless ($self->{'config_changes'} = $self->_load_config_changes_file()) {
	    &Log::do_log('err','Impossible to load file config_changes from list %s',$self->{'name'});
	    return undef;
	}
    }
    return $self->{'config_changes'};
}


## update file config_changes if the list belongs to a family by
#  writing the $what(file or param) name 
sub update_config_changes {
    my $self = shift;
    my $what = shift;
    # one param or a ref on array of param
    my $name = shift;
    &Log::do_log('debug2', 'List::update_config_changes(%s,%s)', $self->{'name'},$what);
    
    unless ($self->{'admin'}{'family_name'}) {