#=============================================================================
# Doloforge::Command::Bulkmail : doloforge bulk email sending command-line tool
#
# This module sends bulk emails without any control of the kind mailing list
# managers do...
#
# Full help :
#   doloforge bulkmail --man
#
# Testing :
#   perl ./src/doloforge --config ./t/doloforge.yaml bulkmail --send --client internal --project sandbox --list list_format --text example/sandbox/bulkmail/lists/test_list/bulkmail.eml
#   perl ./src/doloforge --config ./t/doloforge.yaml bulkmail --send --recipients example/sandbox/bulkmail/lists/merge/recipients.txt --merge 'email,nom,prenom,ville' --text example/sandbox/bulkmail/lists/merge/bulkmail.eml
#   cat ./example/sandbox/bulkmail/lists/test_list/bulkmail.eml | sudo perl ./src/doloforge --config ./t/doloforge.yaml bulkmail --forward --recipient internal_sandbox_list_format@bulkmail.doloforge.net
# Real projects :
#   doloforge bulkmail --send --client uptime --project tuac --list newsletter_public --text bulkmail/lists/bulkmail.eml
#   echo Text | mail -s Test uptime_tuac_newsletter_public@bulkmail.doloforge.net
#   cat bulkmail/lists/bulkmail.eml | doloforge bulkmail --forward --recipient uptime_tuac_newsletter_public@bulkmail.doloforge.net
# TODO
#   * la commande "doloforge bulkmail" pourra vous sortir, pour toute liste de destinataires,
#     les NPAI "hard" et les non NPAI "hard", de manière à ce que vous puissiez les désabonner :
#       doloforge bulkmail --get-bounce --recipients maliste.csv
#       doloforge bulkmail --get-deliverable --recipients maliste.csv
#   * elle va filter automatiquement les NPAI "soft" lors du "--send", c'est à dire ne rien leur
#     envoyer, à l'instant ou vous faites l'envoi (ceci permet de lever les éventuels blocages
#     temporaires, et c'est pour ça que j'ai choisi une durée de 36h, supérieure aux 24h généralement
#     constatés des blacklistages automatiques)
#   * elle ne va pas s'occuper des désabonnements, mais pourra éventuellement, avec un paramètre
#     supplémentaire (genre "--remove-bounce" or so), retirer les NPAI "hard" des destinataires
#     (comme elle le fait pour les NPAI "soft"), ce qui vous évite de vous occuper des abonnements
#     à partir de "doloforge bulkmail --get-bounce"
#   * cf. /var/lib/doloforge/bulkmail/*
#       my $reportdir = "$self->{global}->{dir}->{varlib}/bulkmail/report";
#=============================================================================


package Doloforge::Command::Bulkmail;

use strict;

# This base class implements the constructor and help methods in a generic way.
use base qw(Doloforge::Command);

use POSIX;
use Mail::Bulkmail 3.00; # Bulkmail configuration file is read later, in order to create it's proper path...
use Mail::Bulkmail::Server;
use Text::Template;
use Mail::Mailer;
use File::Temp qw(tempfile tempdir);
use Cwd;
use Unix::Syslog qw(:macros);
use Data::Dumper;


#=============================================================================
=encoding utf8

=head1 NAME

Doloforge::Command::Bulkmail - doloforge bulk email sending command-line tool

=head1 SYNOPSIS

    # Send bulk emails from an MTA (Postfix):
    doloforge bulkmail --forward --recipient ${recipient}
    /usr/sbin/sendmail client_project_list_format@bulkmail.doloforge.net < /path/to/text.txt

    # Manually send to a configured list:
    doloforge bulkmail --send --client client --project project --list list_format --text /path/to/text.txt
    doloforge bulkmail --send --client client --project project --list list_format < /path/to/text.txt

    # Manually send to an unconfigured list:
    doloforge bulkmail --send --recipients /path/to/data.txt --text /path/to/text.txt
    doloforge bulkmail --send --recipients /path/to/data.txt < /path/to/text.txt

    # Same, with template merging:
    doloforge bulkmail --send --recipients /path/to/data.txt --text /path/to/text.tmpl --merge 'email,login,password'
    doloforge bulkmail --send --recipients /path/to/data.txt --template /path/to/text.tmpl --merge 'email,login,password'

    # Get the list of deliverable/ bounce emails, out of a list of recipients
    # Just replace --send/--forward with --get-bounce/--get-deliverable
    # The list is output on STDOUT: inject it in a file or so...
    doloforge bulkmail --get-bounce --recipients /path/to/data.txt --text /path/to/text.tmpl --merge 'email,login,password' > bounces.txt
    doloforge bulkmail --get-deliverable --recipients /path/to/data.txt > emailok.txt
    doloforge bulkmail --get-deliverable --client client --project project --list list_format > emailok.txt

    # Get a report of soft/hard bounces with counts; nearly the same as the other --get-*, except for the output format
    # File format is key=value with keys as nb_* and addr_*
    doloforge bulkmail --get-report --recipients /path/to/data.txt > report.txt

    # Other
    ... --keep-bounce ...
    #   * keep the hard bounce emails from the recipient list before sending/forwarding (soft bounces are always removed)
    ... --remove-bounce ...
    #   * remove the hard bounce emails from the recipient list before sending/forwarding (this is the default, so this option is mainly useless, except when removing hard bounces when forwarding, and not when sending to unconfigured lists)

    # Add the bulkmail service to an existing project:
    doloforge project --add --client internal --name sandbox --allowmod --services 'bulkmail'

    Special tuning may be needed in the project's YAML file, in the form:
      bulkmail:
        command: bulkmail/command/gen_recipients.pl
        cache: 7200
        lists:
          - list_format:
              recipients: bulkmail/list_format/recipients.txt
          - user_html
          - user_txt
          - list_dynamic:
              recipients: .../.../destinataires.txt
              fusion: [email, login, password]

    Configured lists with command calls will only work when run by root, because the command
    is run under the client UID.

    Measured performance on the doloforge.com platform is 30 emails per second (using two gateways).

=head1 EMAIL FORMAT

    The email file sent to the recipients (/path/to/text.txt) above, must conform to the following
    rules:

    * must contain a From: and To: headers
    * must NOT contain a Sender: header
    * the following headers are simply removed: Date Received Delivered-To Return-Path DKIM-Signature X-Mozilla-Status X-Mozilla-Status2
    * the Date: header is replaced by the current date and time
    * the From: header is used as the return path in case of bounce (envelope sender), that will eventually be used as the Return-Path: header in the final destination
    * any Content-type: header must be typed using lowercase "t"
    * a Reply-To: header may be added; if not, the value of From: is taken for this header

=head1 BUGS

    The email text message must have a header named "Content-type", or else it will be added.
    If you provided a header named "Content-Type" with an uppercase "T", it will not be recognized,
    and the simpler "Content-type: text/plain" may be placed before it, turning your HTML email into
    a text-only email.

=head1 DESCRIPTION

Todo

=cut


#=============================================================================
# Method getOptions
#
# Accepted arguments from the command-line, in the form accepted by Getopt::Long.
# Options with no value that match method names of that package will be called as
# methods, with the decoded options as parameters.

sub getOptions {
    return (
        # actions :
        'forward',              # forward an email from inside an MTA (ie. Postfix), to the "recipients" list
        'send',                 # manually send an email from the command-line, to the "recipients" or configured list
        'get-bounce',           # get the list of bounce addresses, instead of sending emails ("recipients" or configured list)
        'get-deliverable',      # get the list of deliverable addresses, instead of sending emails ("recipients" or configured list)
        'get-report',           # get the list of soft/hard bounce addresses, and counts, instead of sending emails ("recipients" or configured list)
        # parameters :
        'recipient|r=s',        # email address, as know by the MTA, for the bulkmail list ("client_project_list_format@bulkmail.doloforge.net")
        'recipients|R=s',       # full path of the file containing the list of final recipients for the bulk email
        'client|c=s',           # the client the list belongs to (forms part of the path to the list recipients)
        'project|p=s',          # the project the list belongs to (forms part of the path to the list recipients)
        'list|l=s',             # name of the list to send emails to, which must be configured in the project's YAML file
        'text|template|t=s',    # name of the text file containing the email to send (it's also a template, when using the "merge" capability)
        'merge|m=s',            # name of the fields, present in the recipients list, and used in the text file, if it is a merging template (names are [.,:/] separated)
        'smtp|s=s',             # list of SMTP relays to use, instead of the configured ones (names are [.,:/] separated)
        'remove-bounce',        # remove the hard bounce emails from the recipient list before sending (soft bounces are always removed)
        'keep-bounce',          # contrary to the above... (used specially within the --forward method, which removes bounces by default)
        'dry-run',              # test the sending, without doing anything
    );
}


#=============================================================================
# Method forward
#
# Forward an email to the list, as called by an MTA. That is:
#   - the email text to forward is retreived from STDIN
#   - the recipient option is an email address, that must be split in order to get client, project and list IDs
#   - the MTA expects a return code 0 if everything is OK, or anything else in case of problem ($self->error takes care of this)

sub forward {
    my $self = shift;

    my ($option) = @_;

    # Split the email address in it's configured components
    my ($client_name, $project_name, $list_name) = ($option->{recipient} =~ qr($self->{config}->{emailsplit}));

    # If any of the 3 components is missing, just stop there
    $self->error("forward: the --recipient address does not match the configured emailsplit")
        unless ($client_name and $project_name and $list_name);

    # Get the text of the message to forward from the standard input
    my $text = join('', <STDIN>);

    # No --merge option while forwardning, but an heuristic based on <% ... %> presence inside the mail text
    my $merge = undef;
    $merge = [qw(email lib_person)] if ($text =~ m/<%.*%>/);

    # When forwarding, by default, consider the hard-bounce list for removal (ie. don't send as many emails as the recipient list contains)
    # This line is useful when the default is to keep bounces, which is not the case anymore, see sub _bulkmail below
    #$option->{'remove-bounce'} = 1 unless ($option->{'keep-bounce'});

    # Actually send the bulk emails in a forked process, in order to be sure to
    # run all code (merging with developer-provided template) and file creation (logs and traces) with the correct ID...
    # Changing ID also ensures that the forward is actually autorized.
    $self->run_sub(
        "$self->{name} forwarding for $client_name/$project_name, list $list_name",
        (getpwnam($client_name))[2,3], # convert the string uid of the client into it's numeric uid and gid
        sub {
            $self->_bulkmail($client_name, $project_name, $list_name, undef, $text, $merge, undef, $option);
        }
    );

    # Implicitly exit(1) in case any problem occured...
}


#=============================================================================
# Method send
#
# Send a message to the list, from the command-line:
#   - the email text to send is stored in a file
#   - the client, project and list names are fully identified, defining the list of final recipients (retrived from a file or a command)
#   - or a list of recipients is passed to the command, which will not have any use of client, project and list name...

sub send {
    my $self = shift;

    my ($option) = @_;

    # Get all identification from the options.
    # A full list identification is either a trio of client+project+list, or a single recipients file.
    my ($client_name, $project_name, $list_name, $recipients) = ($option->{client}, $option->{project}, $option->{list}, $option->{recipients});

    # If any of the 3 components is missing, just stop there
    if ($recipients) {
        $self->error("Options --client, --project, --list are fobidden when passing a --recipients file name")
            if ($client_name or $project_name or $list_name);
    } else {
        $self->error("Missing one of --client, --project, --list, or missing a single --recipients")
            unless ($client_name and $project_name and $list_name);
    }

    # Get the text of the message from the named file, or standard input
    my $text_file = $option->{text} || '-';
    open(TEXT, "<$text_file") or $self->error("Cannot open message text file $text_file: $!");
    my $text = join('', <TEXT>);
    close(TEXT);

    # Retreive the merging info from the command line (--merge), or undef if not present
    my $merge = undef;
    $merge = [qw(email lib_person)] if ($text =~ m/<%.*%>/);
    $merge = [split(/[\.,:\/]/, $option->{merge})] if ($option->{merge});

    # Actually send the bulk emails...
    $self->_bulkmail($client_name, $project_name, $list_name, $recipients, $text, $merge, undef, $option);
}


#=============================================================================
# Method get-bounce/get-deliverable
#
# Join the list of recipients (configured or not) with the hard bounces list,
# and output the sub-list of bounce or deliverable emails.
# From the command-line:
#   - the client, project and list names are fully identified, defining the list of final recipients (retrived from a file or a command)
#   - or a list of recipients is passed to the command, which will not have any use of client, project and list name...

sub get_bounce {
    my $self = shift;

    my ($option) = @_;

    # Get all identification from the options.
    # A full list identification is either a trio of client+project+list, or a single recipients file.
    my ($client_name, $project_name, $list_name, $recipients) = ($option->{client}, $option->{project}, $option->{list}, $option->{recipients});

    # If any of the 3 components is missing, just stop there
    if ($recipients) {
        $self->error("Options --client, --project, --list are fobidden when passing a --recipients file name")
            if ($client_name or $project_name or $list_name);
    } else {
        $self->error("Missing one of --client, --project, --list, or missing a single --recipients")
            unless ($client_name and $project_name and $list_name);
    }

    # Retreive the merging info from the command line (--merge), or undef if not present
    # This is necessary to optionnaly parse the --recipients file
    my $merge = undef;
    push(@$merge, split(/[\.,:\/]/, $option->{merge})) if ($option->{merge});

    # Actually send the bulk emails...
    $self->_bulkmail($client_name, $project_name, $list_name, $recipients, undef, $merge, 1, $option);
}

use vars qw(*get_deliverable *get_report);
*get_deliverable = \&get_bounce;
*get_report = \&get_bounce;


#=============================================================================
# Method _bulkmail
#
# Generic method to send a bulk email. It must receive the client, project, list
# and text to forward, and will do enerything needed to send the bulk emails...

sub _bulkmail {
    my $self = shift;

    my ($client_name, $project_name, $list_name, $recipients, $text, $merge, $get_list, $option) = @_;

    # From now on, the messages will be prefixed by a proper timestamp...
    $self->show_timestamps();
    my $dry_run = $option->{'dry-run'};
    my ($nb_mail, $nb_bad, $nb_soft_bounce, $nb_hard_bounce) = (0, 0, 0, 0);
    my $textsize = length($text);
    $self->info("Preparing ".($get_list ? ($option->{'get-report'} ? 'report of' : 'list of '.($option->{'get-bounce'} ? 'bounce' : 'deliverable')).' emails for ' : ($dry_run ? 'dry-run ' : 'to send ').($merge ? 'merge' : 'bulk')." emailing for ").($recipients ? "unconfigured recipients file $recipients" : "client $client_name project $project_name list $list_name"));

    # Create a temporary debugging directory, holding the email contents, Bulkmail object dump, etc...
    my $debugdir = tempdir("bulkmail-XXXXXX", TMPDIR => 1);
    # Allow client-group to read the temporary directory, as it will help log-parsing (tempdir is hardcoded with mode 0700)
    # Also allow other to read it, as the dolomede/dolodrome/cron scripts work on behalf of the dolodrome clients
    chmod(0755, $debugdir);
    $self->info("Debugging files located in $debugdir");
    if ($text) {
        open(TEXT, ">$debugdir/text") or $self->error("Cannot write debug message file $debugdir/text: $!");
        print TEXT $text;
        close(TEXT);
    }

    # If the emails contains a Sender: header, that will trigger weird behaviour from Mail::Bulkmail (lose the envelope sender in all but the first SMTP transaction)
    # So we need to warn if there is such a header
    $self->error("Email text should not contain a Sender: header (check $debugdir/text and remove it)")
        if ($text =~ m/^Sender: /m);

    # Get the envelope sender from the Doloforge configuration (bounces will be caught by that single inbox, for easy processing)
    my $sender = $self->{global}->{envelope_sender};
    $sender =~ s/(^.*<|>.*$)//g; # regexp copied from /usr/share/perl5/Mail/Util.pm

    # Get the names of SMTP relays from the global conf or the arguments
    my $smtp = undef;
    if ($option->{smtp}) {
        push(@$smtp, split(/[\.,:\/]/, $option->{smtp}));
    } else {
        push(@$smtp, @{$self->{global}->{smtprelays}});
    }

    # Get the list of addresses to send the e-mail to: either a simple recipients file, or a command to run
    my ($command, $project, $client);
    # Only try to get the recipients list from the project config if it was not passed on the command-line
    unless ($recipients) {
        # FIXME : find a cleaner way to retreive a project's or client's config (Doloforge::Object::Factory ???)
        $project = (&Doloforge::Command::Factory('Project', $self->{global}))->_list('active', $client_name, $project_name)->{"$client_name/$project_name"};
        $client = (&Doloforge::Command::Factory('Client', $self->{global}))->_list('active', $client_name)->{$client_name};
        #print Data::Dumper->Dump([$client, $project, $self, ($project->{services}->{$self->{name}}->{lists})], [qw(client project self lists)]);

        my $config = $project->{services}->{$self->{name}};
        $self->error("List $list_name for client $client_name project $project_name does not exist")
            unless ($config->{anylist} or exists($config->{lists}->{$list_name}));

        # The "recipients" or "command" entries at the "lists/[name]" in the config take precedence over the same entries at the service level
        # ie. with the following config:
        #   bulkmail:
        #     command: "global command"
        #     recipients: "global recipients"
        #     lists:
        #       - list_format:
        #           command: "list command"
        #           recipients: "list recipients"
        # ...the entries are selected in the following order, the first being used:
        #   "list recipients", "list command", "global recipients", "global command"
        if (exists($config->{lists}->{$list_name}) and exists($config->{lists}->{$list_name}->{recipients})) {
            $recipients = "$self->{global}->{dir}->{shared}/$project->{client}/$project->{name}/$config->{lists}->{$list_name}->{recipients}";
        } elsif (exists($config->{lists}->{$list_name}) and exists($config->{lists}->{$list_name}->{command})) {
            $command = $config->{lists}->{$list_name}->{command};
        } elsif (exists($config->{recipients})) {
            $recipients = "$self->{global}->{dir}->{shared}/$project->{client}/$project->{name}/$config->{recipients}";
        } elsif (exists($config->{command})) {
            $command = $config->{command};
        } else {
            $self->error("List $list_name for client $client_name project $project_name have no 'recipients' or 'command'");
        }
    }

    # Check and log what we discovered so far, be it from command-line, or project configuration
    if ($recipients) {
        # Make the recipients file path absolute if it was not the case, and keep a link to it
        $recipients = cwd . "/$recipients" unless ($recipients =~ m/^\//);
        symlink($recipients, "$debugdir/recipients");
        # It's no use going further if the file is not readable by the effective user ID
        $self->error("Recipients file $recipients is not readable")
            unless (-r $recipients);
        $self->info("Using file $recipients as the recipients list");
    } elsif ($command) {
        # If the command was defined, first run it and get the recipients file out of it...
        # The command will receive the file name to write as last argument. STDOUT/ERR is directed to the webmaster via email.
        # The command will run only if the current user is root, because run_job() calls setuid/setgid()
        # The recipient file is temporary, and won't be stored in the project directory tree or debug dir, because the job is run by the doloforge ID
        # Create a temporary file and get its file handle, which Mail::Bulkmail is happy to receive...
#        my ($filename);
        # FIXME : set UNLINK => 1
        # FIXME : add an order by domain (after job finish, and maybe also within the provided file above)
#        ($recipients, $filename) = tempfile("recipients-XXXXXX", DIR => File::Spec->tmpdir, UNLINK => 0);
# TODO FIXME : we're already running as a client UID !!!
        # As we create the file as root, and its mode is 0600, we need to allow the client ID to write to it. The best secure way is to chown...
#        chown(scalar(getpwnam($client_name)), -1, $filename);

#        $self->info("Running command $command output to file $filename as a recipients list");
#        symlink($filename, "$debugdir/recipients");
        $recipients = "$debugdir/recipients";
        $self->info("Running command $command output to file $recipients as a recipients list");
# FIXME : already running under the correct UID, if forwarding and using a command
#        $self->run_job($client, $project, $command, [$list_name, $filename]);
        $self->run_job($client, $project, $command, [$list_name, $recipients]);
    }

    # Read the bounces files, in order to avoid sending to addresses that WILL just trigger grey- or black-listing
    my $bounce_soft = $self->_read_report_bounce('soft');
    my $bounce_hard = $self->_read_report_bounce('hard') if ($get_list or not $option->{'keep-bounce'}); # or $option->{'remove-bounce'});
    # Keep a list of bad/hard_bounce/soft_bounce recipients emails
    my (@recipients_bad, @recipients_hard, @recipients_soft);

    unless ($get_list) {
        #-----------------------------------------------------------------------------
        # Sending a bulk emailing, ie. the same text to every recipient
        if (not defined($merge)) {
            # Make Mail::Bulkmail read it's Doloforge config file
            $self->info("Reading $self->{global}->{dir}->{conf}/bulkmail.conf");
            Mail::Bulkmail->conf_files("$self->{global}->{dir}->{conf}/bulkmail.conf");

            # Create a list of hashes containing a single "Smtp" key, from the list of scalars found in "smtp"
            my @server_defs = map { Smtp => $_ }, @$smtp;

            # Create the evil emailer object. All methods are called within the new() call, in order to get proper error handling...
            # Mail::Bulkmail(3pm): "the constructor will fail with an error if your attribute calls return undef"
            my $bulk = Mail::Bulkmail->new(
                servers => Mail::Bulkmail::Server->create_all_servers(@server_defs),    # ad-hoc list of SMTP relays
                headers_from_message => 1,                                              # the headers are already part of the message, which came from SMTP...
                Message => $text,                                                       # Full email text, already encoded in whatever correct format, containing all necessary headers
                LIST => $recipients,                                                    # Name of the file or filehandle containing the list of recipients
                ERRFILE => sub {                                                        # This is a block which is called by Mail::Bulkmail::Object to log errors
                    my ($bulk, $mesg) = @_;                                             #   Mail::Bulkmail instance, message text
                    my $code = $bulk->errcode;                                          #   error code, as in "MBnnn"
                    if (($code eq 'MB007') or ($code eq 'MB018')) {
                        $self->debug($mesg);                                            #   Doloforge debugging for bad/bounce ($self is declared at the top of sub _bulkmail {}, this is the Doloforge::Base object; "Cannot log to file w/o file" is always output at the beginning)
                    } else {
                        $self->error($mesg);                                            #   standard Doloforge logging for every other type of error
                    }
                },
                BAD => sub {                                                            # This is a block which us called by Mail::Bulkmail when stumbling on a wrongly formatted email
                    my ($bulk, $to) = @_;                                               #   Mail::Bulkmail instance, bad email address
                    if ($bulk->isBanned($to)) {
                        $nb_soft_bounce++, push(@recipients_soft, $to)                  #   if this is just a SOFT bounce, don't consider new BAD address that will eventually become a HARD bounce
                            if (exists($bounce_soft->{$to}));
                        $nb_hard_bounce++, push(@recipients_hard, $to)                  #   if this is already a HARD bounce, don't consider new BAD address
                            if (exists($bounce_hard->{$to}));
                    } else {
                        $self->tosyslog(LOG_MAIL, LOG_NOTICE, "Mail::Bulkmail invalid recipient address <%s>", $to);
                        $nb_bad++;                                                      #   log the email address to syslog ("mail.notice" level, forwarded by sysklogd to the central server), and count the bad recipient
                        push(@recipients_bad, $to);
                    }
                },
                banned => [keys(%$bounce_soft), keys(%$bounce_hard)],                   # Soft bounces are passed as a list of "banned" addresses, used temporarily
            ) or $self->error(Mail::Bulkmail->error());

            # Avoid the following errors, by forcing the Sender to be defined...
            #   Use of uninitialized value in substitution (s///) at /usr/share/perl5/Mail/Bulkmail.pm line 1781, <HANDLE1> line 17.
            #   Use of uninitialized value in concatenation (.) or string at /usr/share/perl5/Mail/Bulkmail.pm line 2210, <HANDLE1> line 17.
            # If the Sender: header is defined in the original email, bulkmail will lose it at the second SMTP transaction.
            # So we just force it here, because Bulkmail will somehow lose it for all but the first SMTP sending:
            #   Oct 29 13:13:15 argon postfix/qmgr[4014]: 53B411C9C: from=<nicolas@huillard.net>, size=1072, nrcpt=1 (queue active)
            #   Oct 29 13:13:15 argon postfix/qmgr[4014]: 818301D45: from=<>, size=1073, nrcpt=1 (queue active)
            # By forcing it here, the SMTP chat remains OK :
            #   Oct 29 13:16:01 argon postfix/qmgr[4014]: CCA311BA0: from=<nicolas@huillard.net>, size=1072, nrcpt=1 (queue active)
            #   Oct 29 13:16:01 argon postfix/qmgr[4014]: D14BC1DF2: from=<nicolas@huillard.net>, size=1073, nrcpt=1 (queue active)
            # The header must NOT be part of the original email text for this to work. If there is a Sender: header, the SMTP chats will NEVER be fully OK...
            #$bulk->Sender($bulk->header('Return-Path') || $bulk->From());
            #$bulk->Sender($bulk->From()) unless (defined($bulk->Sender()));
            $bulk->Sender($sender) unless (defined($bulk->Sender()));

            # To: is never actually used as-is (this is more or less the hidden forwarded address, as in client_project_newsletter@bulkmail.domain.tld)
            # ...so why not change it to the same as From:...
            # FIXME : should be set in the $text, and replaced only if it is still the @bulkmail.domain.tld form (a cautious sender will send to the envelope recipient @bulkmail.domain.tld, with a To: header using a user-friendly name)
            $bulk->To($bulk->From());

            # These headers from the original email are duplicated, or superflous, etc.
            map { delete $bulk->header()->{$_} } qw(Date Received Delivered-To Return-Path DKIM-Signature X-Mozilla-Status X-Mozilla-Status2);

            # Keep debug info
            open(DUMPER, ">$debugdir/Bulkmail") or $self->error("Cannot write debug dump file $debugdir/Bulkmail: $!");
            print DUMPER Data::Dumper->Dump([$bulk, $client_name, $project_name, $list_name, $smtp], [qw(bulk client_name project_name list_name smtp)]);
            close(DUMPER);

            # Now send the mails...
            $self->info("Sending bulk emailing"); # for client $client_name project $project_name list $list_name");
            unless ($dry_run) {
                $bulk->bulkmail() or $self->error(Mail::Bulkmail->error());
            #} else {
                # ...or send a single one:
                #$bulk->mail($self->{global}->{email});
            }

            # Always display that final message
            # Magic way of adding $bulk->server->[*]->{_sent_messages}, and creating a string looking like "[hostname]=[number], ..."
            my $nb_mail_details = join(', ', (map { $nb_mail += $_->{_sent_messages}; $_->{Smtp}.'='.$_->{_sent_messages}; } @{$bulk->servers}));

        #-----------------------------------------------------------------------------
        # Sending a merge emailing, ie. a template merged with personal data to each recipient
        } else {
            # Create the objects used to merge the email template, and send the result using SMTP
            my $template = new Text::Template(-type => 'STRING', -source => $text, -delimiters => [ '<%', '%>' ]);

            # FIXME : there is a bug inside Mail::Mailer (in fact Net::SMTP), when the SMTP server says the recipient address does not exist, and Net::SMTP doesn't abort
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 220 xpw2.x-perteam.net ESMTP Postfix (Debian/GNU)
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> EHLO localhost.localdomain
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-xpw2.x-perteam.net
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-PIPELINING
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-SIZE 10240000
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-ETRN
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-STARTTLS
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-ENHANCEDSTATUSCODES
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250-8BITMIME
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250 DSN
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> MAIL FROM:<nhuillard@dolomede.fr>
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 250 2.1.0 Ok
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> RCPT TO:<toto@huillard.net>
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 550 5.1.1 <toto@huillard.net>: Recipient address rejected: User unknown in virtual mailbox table
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> DATA
            #   Net::SMTP=GLOB(0x8a2e5f0)<<< 554 5.5.1 Error: no valid recipients
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> Subject: Test de message Mail::Bulkmail
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> MIME-Version: 1.0
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> Content-type: text/plain; charset=ISO-8859-1; format=flowed
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> X-Mailer: Mail::Mailer[v1.74] Net::SMTP[v2.29]
            #   Net::SMTP=GLOB(0x8a2e5f0): Relais brisé (pipe) at /usr/share/perl5/Mail/Mailer/smtp.pm line 85
            #   Net::SMTP=GLOB(0x8a2e5f0)>>> To: toto@huillard.net
            my $mailer = new Mail::Mailer('smtp', Server => $smtp->[0], Hello => $self->{global}->{domainname}, Debug => 0);

            # This ENV variable is used by Mail::Util, as the envelope sender address :
            #   WARNING: When not supplied via the environment variable, <mailaddress> looks at various configuration files
            #   and other environmental data. Although this seems to be smart behavior, this is not predictable enough (IMHO)
            #   to be used. Please set the MAILADDRESS explicitly, and do not trust on the "automatic detection", even when
            #   that produces a correct address (on the moment).
            $ENV{MAILADDRESS} = $sender;

            $self->info("Sending merge emailing to SMTP relay '".$smtp->[0]."'"); # for client $client_name project $project_name list $list_name");

            # Open the recipient list file, used as the data for merging
            open(LIST, $recipients) or $self->error("Can't open recipients file $recipients: $!");
            while (<LIST>) {
                s/[\r\n]+$//; # remove trailing CR/LFs, whatever the exact order and count (matches Unix, DOS and Mac formats; better than chomp() or chop())
                my @fields = split(';', $_);

                # For each recipient field, create the data hash value, named from the "merge" argument
                # Missing names in the merge argument discards the corresponding data field
                #   merge = "email,name,,city"
                #   will create $data->{...} from the first, second and fourth fields, discarding the third
                my $data = undef;
                for (my $i = 0; $i <= $#$merge; $i++) {
                    $data->{$merge->[$i]} = $fields[$i] if ($merge->[$i]);
                }

                # Get the recipient email address from the properly named field, or the first one if none was properly named
                my $to = $data->{email} || $data->{mail} || $data->{$merge->[0]};
                # 20190710/NH : @for.paris does not pass this test, because the TLD is 5 characters long (see below) ; RFC 1035 apparently says domain names must be less than 63 characters, thus TLD too...
                #if ($to !~ m/^([_a-zA-Z0-9-]+(\.[_a-zA-Z0-9-]+)*@([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9])(\.([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9]))*\.(([0-9]{1,3})|([a-zA-Z]{2,3})|(aero|coop|info|museum|name)))$/) {
                if ($to !~ m/^(?:[_a-zA-Z0-9-]+(?:\.[_a-zA-Z0-9-]+)*@[a-zA-Z0-9\-]+(?:\.[a-zA-Z0-9\-]+)*\.(?:[a-zA-Z]{2,63}))$/) {
                    $self->debug("Invalid recipient address $to");
                    $self->tosyslog(LOG_MAIL, LOG_NOTICE, "Mail::Mailer invalid recipient address <%s>", $to);
                    $nb_bad++; # Log the email address to syslog ("mail.notice" level, forwarded by sysklogd to the central server), and count the bad recipient
                    push(@recipients_bad, $to);
                    next;
                }

                # Don't send to the soft bounces addresses
                if (exists($bounce_soft->{$to})) {
                    $self->debug("Soft-bounce recipient address $to");
                    $nb_soft_bounce++;
                    push(@recipients_soft, $to);
                    next;
                }

                # Don't send to the hard bounces addresses either...
                if (exists($bounce_hard->{$to})) {
                    $self->debug("Hard-bounce recipient address $to");
                    $nb_hard_bounce++;
                    push(@recipients_hard, $to);
                    next;
                }

                # Merge the template with the data for each recipient
                $text = $template->fill_in(
                    -package => 'Doloforge::Command::Bulkmail::Template',
                    -hash => $data,
                );
                # Sanity check
                $self->error("A problem occured while merging the template, stopping the mailing: $Text::Template::ERROR")
                    if ($text eq '');

                # Split the SMTP headers from the message body
                my %headers = ();
                my ($head, $body) = split(/\r?\n\r?\n/, $text, 2);

                unless ($body) {
                    # If the split didn't create 2 parts, that's because there is no headers, thus we'll ignore them
                    $body = $head;
                } else {
                    # Convert the headers into a hash, for header keys matching ([-\w]+):
                    # Values are allowed to wrap on the next line, which is unwrapped below
                    $head =~ s/[\r\n]+\s+//g;
                    foreach (split("\n", $head)) {
                        chomp;
                        if (my ($key, $val) = (m/^([-\w]+):\s*(.*)$/)) {
                            $headers{$key} = $val;
                        }
                    }
                }
                #print (Data::Dumper->Dump([$_, \@fields, $data, $to, $mailaddress],['_', 'fields', 'data', 'to', 'mailaddress']));

                # These headers from the original email are duplicated, or superflous, etc.
                map { delete $headers{$_} } qw(Received Delivered-To Return-Path DKIM-Signature X-Mozilla-Status X-Mozilla-Status2);
                $headers{To} = $to;

                # Build and send each email
                $self->debug("Valid recipient: '$to'");
                unless ($dry_run) {
                    $mailer->open(\%headers);
                    print $mailer $body;
                    $mailer->close;
                }
                $nb_mail++;
            }
            close(LIST);
        }

        # Always display that final message
        $self->info("Done ".($dry_run ? 'dry-run ' : 'sending ').($merge ? 'merge' : 'bulk')." emailing: $nb_mail emails sent, $nb_bad bad, $nb_soft_bounce soft, $nb_hard_bounce hard, size $textsize bytes, for stage=$self->{global}->{stage}, client=$client_name, project=$project_name, list=$list_name, recipients=$recipients, trace=$debugdir, user=".scalar(getpwuid($>)));

        # Prepare the report data, and store it temporarily in the debug dir
        my @report_keys = ('date', 'user', 'action', 'type', 'nb_mail', 'nb_bad', 'nb_soft_bounce', 'nb_hard_bounce', 'textsize', 'client_name', 'project_name', 'list_name', 'recipients', 'debugdir'),
        my @report_vals = ($self->now(), scalar(getpwuid($>)), ($dry_run ? 'dry-run' : 'send'), ($merge ? 'merge' : 'bulk'), $nb_mail, $nb_bad, $nb_soft_bounce, $nb_hard_bounce, $textsize, $client_name, $project_name, $list_name, $recipients, $debugdir);
        open(TEXT, ">>$debugdir/report") or $self->error("Cannot write bulkmail report file $debugdir/report: $!");
        for (my $i = 0; $i <= $#report_keys; $i++) {
            print TEXT "$report_keys[$i]=$report_vals[$i]\n";
        }
        # Add the @recipients_* statuses
        foreach (@recipients_bad) {
            print TEXT "addr_bad=$_\n";
        }
        foreach (@recipients_soft) {
            print TEXT "addr_soft_bounce=$_\n";
        }
        foreach (@recipients_hard) {
            print TEXT "addr_hard_bounce=$_\n";
        }
        close(TEXT);
        if ($command) {
            # If the command was defined, run it a second time to give it the report, which it could store in the DB if it wants to.
            $self->info("Running command $command input from $debugdir/report as a summary report");
            $self->run_job($client, $project, $command, [$list_name, '/dev/null', "$debugdir/report"]);
        }

        # Log the things done up to now, in $client/$project/bulkmail/_logs/ or .doloforge/bulkmail/_logs/ (if project was not identified)
        my $reportdir = (($client_name and $project_name) ? "$self->{global}->{dir}->{shared}/$client_name/$project_name/$self->{name}/_logs" : "$self->{global}->{dir}->{shared}/.doloforge/$self->{name}/_logs");
        if (-d $reportdir and -w $reportdir) {
            my $reportfile = 'bulkmail.'.$self->date().'.'.getpwuid($>).'.log';
            open(TEXT, ">>$reportdir/$reportfile") or $self->error("Cannot write bulkmail report file $reportdir/$reportfile: $!");
            print TEXT join("\t", @report_keys), "\n" if (-z "$reportdir/$reportfile");
            print TEXT join("\t", @report_vals), "\n";
            close(TEXT);
        } else {
            $self->warn("Missing or non-writable $reportdir report directory");
        }

    #-----------------------------------------------------------------------------
    # Ouput the list of deliverables or bounces from the known list
    } else {
        # Open the recipient list file, and compare with the hashes
        open(LIST, $recipients) or $self->error("Can't open recipients file $recipients: $!");
        open(TEXT, ">>$debugdir/report") or $self->error("Cannot write bulkmail report file $debugdir/report: $!");
        my ($nb_report_ok, $nb_report_soft, $nb_report_hard) = (0, 0, 0);
        while (<LIST>) {
            my $to;
            s/[\r\n]+$//; # remove trailing CR/LFs, whatever the exact order and count (matches Unix, DOS and Mac formats; better than chomp() or chop())
            if ($merge) {
                my @fields = split(';', $_);

                # For each recipient field, create the data hash value, named from the "merge" argument
                # Missing names in the merge argument discards the corresponding data field
                #   merge = "email,name,,city"
                #   will create $data->{...} from the first, second and fourth fields, discarding the third
                my $data = undef;
                for (my $i = 0; $i <= $#$merge; $i++) {
                    $data->{$merge->[$i]} = $fields[$i] if ($merge->[$i]);
                }

                # Get the recipient email address from the properly named field, or the first one if none was properly named
                $to = $data->{email} || $data->{mail} || $data->{$merge->[0]};
            } else {
                $to = $_;
            }

            # Print if exists (in hard bounce list) and bounces wanted
            # Print if does not exists (in hard bounce list) and deliverables wanted
            print "$to\n" if ((exists($bounce_hard->{$to}) and $option->{'get-bounce'}) or (not exists($bounce_hard->{$to}) and $option->{'get-deliverable'}));
            #print "$to\n" unless (exists($bounce_hard->{$to}) xor $option->{'get-bounce'});

            # Report format, including mode data in a different format (see also $debugdir/report above)
            if ($option->{'get-report'}) {
                if (exists($bounce_hard->{$to})) {
                    $nb_report_hard++;
                    print "addr_report_hard=$to\n";
                    print TEXT "addr_report_hard=$to\n";
                } elsif (exists($bounce_soft->{$to})) {
                    $nb_report_soft++;
                    print "addr_report_soft=$to\n";
                    print TEXT "addr_report_soft=$to\n";
                } else {
                    $nb_report_ok++;
                }
            }
        }
        close(LIST);

        # Final counts for the report format
        if ($option->{'get-report'}) {
            print "nb_report_hard=$nb_report_hard\n";
            print "nb_report_soft=$nb_report_soft\n";
            print "nb_report_ok=$nb_report_ok\n";
            print TEXT "nb_report_hard=$nb_report_hard\n";
            print TEXT "nb_report_soft=$nb_report_soft\n";
            print TEXT "nb_report_ok=$nb_report_ok\n";
        }
        close(TEXT);
    }
}


#=============================================================================
# Method _read_report_bounce
#
# Get the report bounce files from file, into memory, for internal usage.
# Pass 'hard' or 'soft' as the first argument to read the said bounce file.

sub _read_report_bounce {
    my $self = shift;

    my ($type) = @_;
    my $bounce;
    #my $reportdir = "$self->{global}->{dir}->{varlib}/bulkmail/report";
    my $reportdir = "$self->{global}->{dir}->{shared}/.doloforge/bulkmail/report";

    open(BOUNCE, "<$reportdir/bounce_$type.csv") or $self->error("Can't open bounce file $reportdir/bounce_$type.csv for reading: $!");
    while (<BOUNCE>) {
        s/[\r\n]+$//; # remove trailing CR/LFs, whatever the exact order and count (matches Unix, DOS and Mac formats; better than chomp() or chop())
        $bounce->{$_} = undef;
    }
    close(BOUNCE);

    return ($bounce);
}



#========================================================================================
# Package where the templates evaluation take place
# The encoding functions can be used to encode the subject of the emails

package Doloforge::Command::Bulkmail::Template;

use MIME::Base64;
use MIME::QuotedPrint;
use vars qw(*enc_qp *enc_base64);

*enc_qp = \&encode_qp;
*enc_base64 = \&encode_base64;



1;
__END__

=head1 AUTHOR

Nicolas Huillard <F<nicolas@huillard.net>>, Dolomède

=head1 SEE ALSO

doloforge(1)

=cut
