#!/usr/pkg/bin/perl
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id: bulk.pl.in 12052 2015-03-13 06:12:04Z sikeda $

# 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, 2015 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/>.

use lib split(/:/, $ENV{SYMPALIB} || ''), '/usr/pkg/sympa/bin';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Pod::Usage;
use POSIX qw();

use Sympa;
use Sympa::Alarm;
use Sympa::Bulk;
use Conf;
use Sympa::Constants;
use Sympa::Crash;    # Show traceback.
use Sympa::DatabaseManager;
use Sympa::List;
use Sympa::Log;
use Sympa::Mailer;
use Sympa::Message;
use tools;
use Sympa::Tools::Daemon;
use Sympa::Tools::Data;
use Sympa::Tools::DKIM;
use Sympa::Tracking;

my $date_of_last_activity = time();
local $main::daemon_usage =
    'DAEMON_MASTER';    ## Default is to launch bulk as master daemon.

## Check options
##  --debug : sets the debug mode
##  --foreground : prevents the script from beeing daemonized
##  --mail : logs every sendmail calls
my %options;
unless (
    GetOptions(
        \%main::options, 'config|f=s',  'debug|d', 'foreground|F',
        'help|h',        'log_level=s', 'mail|m',  'version|v',
    )
    ) {
    pod2usage(-exitval => 1, -output => \*STDERR);
}
if ($main::options{'help'}) {
    pod2usage(0);
} elsif ($main::options{'version'}) {
    printf "Sympa %s\n", Sympa::Constants::VERSION;
    exit 0;
}

if ($main::options{'debug'}) {
    $main::options{'log_level'} = 2 unless $main::options{'log_level'};
    $main::options{'foreground'} = 1;
}

my $log = Sympa::Log->instance;
$log->{log_to_stderr} = 'all' if $main::options{'foreground'};

# Load sympa.conf
unless (Conf::load()) {
    die sprintf
        "Unable to load Sympa configuration, file %s or one of the virtual host robot.conf files contain errors. Exiting.\n",
        Conf::get_sympa_conf();
}

$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});

my $mailer = Sympa::Mailer->instance;

# Enable SMTP logging if required
my $default_log_smtp = $main::options{'mail'}
    || Sympa::Tools::Data::smart_eq($Conf::Conf{'log_smtp'}, 'on');
$mailer->{log_smtp} = $default_log_smtp;

# setting log_level using conf unless it is set by calling option
my $default_log_level;
if ($main::options{'log_level'}) {
    $default_log_level = $main::options{'log_level'};
    $log->{level} = $default_log_level;
    $log->syslog(
        'info',
        'Configuration file read, log level set using options: %s',
        $main::options{'log_level'}
    );
} else {
    $default_log_level = $Conf::Conf{'log_level'};
    $log->{level} = $default_log_level;
    $log->syslog(
        'info',
        'Configuration file read, default log level %s',
        $Conf::Conf{'log_level'}
    );
}

## Set the process as main bulk daemon by default.
my $is_main_bulk = 0;

## Put ourselves in background if not in debug mode.
unless ($main::options{'debug'} || $main::options{'foreground'}) {
    open(STDERR, ">> /dev/null");
    open(STDOUT, ">> /dev/null");
    if (open(TTY, "/dev/tty")) {
        close(TTY);
    }
    setpgrp 0, 0;
    my $child_pid = fork;
    if ($child_pid) {
        $log->syslog('info', 'Starting bulk master daemon, PID %s',
            $child_pid);
        exit 0;
    } elsif (not defined $child_pid) {
        die sprintf 'Cannot fork: %s', $ERRNO;
    }
}
$log->openlog($Conf::Conf{'syslog'}, $Conf::Conf{'log_socket_type'});
## If process is running in foreground, don't write STDERR to a dedicated file
my $options;
$options->{'stderr_to_tty'} = 1 if ($main::options{'foreground'});
$options->{'multiple_process'} = 0;

# Save the PID number
Sympa::Tools::Daemon::write_pid('bulk', $PID, $options);
unless ($options->{'stderr_to_tty'}) {
    Sympa::Tools::Daemon::direct_stderr_to_file(('pid' => $PID));
}
## Set the User ID & Group ID for the process
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];

## Required on FreeBSD to change ALL IDs(effective UID + real UID + saved UID)
POSIX::setuid((getpwnam(Sympa::Constants::USER))[2]);
POSIX::setgid((getgrnam(Sympa::Constants::GROUP))[2]);

## Check if the UID has correctly been set (useful on OS X)
unless (($GID == (getgrnam(Sympa::Constants::GROUP))[2])
    && ($UID == (getpwnam(Sympa::Constants::USER))[2])) {
    die
        "Failed to change process user ID and group ID. Note that on some OS Perl scripts can't change their real UID. In such circumstances Sympa should be run via sudo.\n";
}

## Sets the UMASK
umask(oct($Conf::Conf{'umask'}));

## Change to list root
unless (chdir($Conf::Conf{'home'})) {
    die sprintf 'Can\'t chdir to %s: %s', $Conf::Conf{'home'}, $!;
}

$log->syslog('notice', 'Bulk %s Started', Sympa::Constants::VERSION);

## Catch signals, in order to exit cleanly, whenever possible.
$SIG{'TERM'} = 'sigterm';
$SIG{'INT'}  = 'sigterm';
my $end = 0;

my $timeout         = $Conf::Conf{'bulk_wait_to_fork'};
my $last_check_date = 0;
my %created_children;

$options->{'multiple_process'} = 1;
$mailer->{redundancy} = $Conf::Conf{'bulk_max_count'} || 1;

my $bulk = Sympa::Bulk->new;

while (!$end) {
    # Enable SMTP logging if required.
    $mailer->{log_smtp} = $default_log_smtp;
    # setting log_level using conf unless it is set by calling option
    $log->{level} = $default_log_level;

    Sympa::List::init_list_cache();
    # Process grouped notifications
    Sympa::Alarm->instance->flush;

    my ($message, $handle);

    unless ($main::options{'foreground'}) {
        ##
        ## Create child bulks if too much packets are waiting to be sent in
        ## the bulk_mailer table.
        ## Only the main bulk process (DAEMON_MASTER) can create child
        ## processes
        ## Check if we need to run new child processes every
        ## 'bulk_wait_to_fork' (sympa.conf parameter) seconds
        if (   ($main::daemon_usage eq 'DAEMON_MASTER')
            && (time() - $last_check_date > $timeout)) {
            ## Clean up PID file (in case some child bulks would have died)
            my @actual_children =
                Sympa::Tools::Daemon::get_children_processes_list();
            my @remaining_children;
            my %dead_children = %created_children;
            foreach my $apid (@actual_children) {
                if (defined $dead_children{$apid}) {
                    push @remaining_children, $apid;
                    delete $dead_children{$apid};
                }
            }
            my @pids_leftover = keys %dead_children;
            if ($#pids_leftover > -1) {
                my @dc;
                $log->syslog('debug2',
                    'Some childs of current process disappeared. Checking whether they shut down cleanly or not.'
                );
                my $pids_in_pfile =
                    Sympa::Tools::Daemon::get_pids_in_pid_file('bulk');
                foreach my $fpid (@{$pids_in_pfile}) {
                    if (defined $dead_children{$fpid}) {
                        $log->syslog(
                            'err',
                            'The %s child exists in the PID file but is no longer running. Removing it and notyfying listmaster',
                            $fpid
                        );
                        my $pname = $0;
                        $pname =~ s/.*\/(\w+)/$1/;
                        Sympa::Tools::Daemon::send_crash_report(
                            ('pid' => $fpid, 'pname' => $pname));
                        Sympa::Tools::Daemon::remove_pid('bulk', $fpid,
                            $options);
                        delete $dead_children{$fpid};
                        push @dc, $fpid;
                    }
                }
            }
            my $pids_in_pfile =
                Sympa::Tools::Daemon::get_pids_in_pid_file('bulk');
            unless (defined($pids_in_pfile)) {
                Sympa::Tools::Daemon::write_pid('bulk', $PID, $options);
                close STDERR;
                Sympa::Tools::Daemon::direct_stderr_to_file(('pid' => $PID));
                $pids_in_pfile = [$PID];
            }
            # Start new processes if there remain at least
            # 'bulk_fork_threshold' packets to send in the bulk spool.
            if (my $r_packets = $bulk->too_much_remaining_packets()
                and scalar(@remaining_children) <
                $Conf::Conf{'bulk_max_count'}) {
                # Disconnect from database before fork to prevent DB handles
                # to be shared by different processes.  Sharing database
                # handles may crash bulk.pl.
                Sympa::DatabaseManager->disconnect;

                if ($Conf::Conf{'bulk_max_count'} > 1) {
                    $log->syslog(
                        'info',
                        'Important workload: %s packets to process. Creating %s child bulks to increase sending rate',
                        $r_packets,
                        $Conf::Conf{'bulk_max_count'} -
                            scalar(@remaining_children)
                    );
                    for my $process_count (
                        1 .. $Conf::Conf{'bulk_max_count'} -
                        scalar(@remaining_children)) {
                        $log->syslog('info', "Will fork: %s", $process_count);
                        my $child_pid = fork;
                        if ($child_pid) {
                            $log->syslog('info',
                                'Starting bulk child daemon, PID %s',
                                $child_pid);
                            # Saves the pid number
                            Sympa::Tools::Daemon::write_pid('bulk',
                                $child_pid, $options);
                            $created_children{$child_pid} = 1;
                            sleep 1;
                        } elsif (not defined $child_pid) {
                            $log->syslog('err', 'Cannot fork: %m');
                            last;
                        } else {
                            ## We're in a child bulk process
                            close STDERR;
                            Sympa::Tools::Daemon::direct_stderr_to_file(
                                ('pid' => $PID));
                            $date_of_last_activity = time();
                            $main::daemon_usage = 'DAEMON_SLAVE'; # child bulk
                            $log->openlog($Conf::Conf{'syslog'},
                                $Conf::Conf{'log_socket_type'});
                            $log->syslog('info',
                                'Bulk slave daemon started with PID %s',
                                $PID);
                            last;
                        }
                    }
                }

                # Restore persistent connection.
                Sympa::DatabaseManager->instance
                    or die 'Reconnecting database failed';
            }
            $last_check_date = time();
        }
    }
    ## If a child bulk process is running for long enough, stop it (if the
    ## number of remaining packets to send is reasonnable).
    if (    $main::daemon_usage eq 'DAEMON_SLAVE'
        and time() - $date_of_last_activity > $Conf::Conf{'bulk_lazytime'}
        and !(my $r_packets = $bulk->too_much_remaining_packets())) {
        $log->syslog('info',
            'Process %s didn\'t send any message since %s seconds, exiting',
            $PID, $Conf::Conf{'bulk_lazytime'});
        last;
    }

    ## Go through the bulk_mailer table and process messages
    ($message, $handle) = $bulk->next();
    if ($message and $handle) {
        # Get list/robot context.
        my ($list, $robot, $listname);
        if (ref($message->{context}) eq 'Sympa::List') {
            $list     = $message->{context};
            $robot    = $message->{context}->{'domain'};
            $listname = $list->{'name'};
        } elsif ($message->{context} and $message->{context} ne '*') {
            $robot = $message->{context};
        } else {
            $robot = '*';
        }

        if ($message->{serial} eq '0' or $message->{serial} eq 's') {
            $log->syslog(
                'notice',
                'Start sending message %s to %s (priority %s) (starting %s seconds after scheduled expedition date)',
                $message,
                $message->{context},
                $message->{'priority'},
                time() - $message->{'date'}
            );
            # trace_smime($message, 'init');
        }

        # Enable SMTP logging if required.
        $mailer->{log_smtp} = $main::options{'mail'}
            || Sympa::Tools::Data::smart_eq(
            Conf::get_robot_conf($robot, 'log_smtp'), 'on');
        # setting log_level using conf unless it is set by calling option
        $log->{level} = (
            defined $main::options{'log_level'}
            ? $main::options{'log_level'}
            : Conf::get_robot_conf($robot, 'log_level')
        );

        #HASH which will contain the attributes of the subscriber
        my $data;
        # Initialization of the HASH $data. It will be used by parse_tt2 to
        # personalized messages.
        # Note that message ID which can be anonymized should be taken from
        # message header instead of {message_id} attribute.
        my $msg_id = tools::clean_msg_id($message->get_header('Message-ID'));
        $data = {
            'messageid' => $msg_id,
            'listname'  => $listname,
            'robot'     => $robot,
            #XXX'to'        => $message->{rcpt}, #XXX Insecure
            'wwsympa_url' => Conf::get_robot_conf($robot, 'wwsympa_url'),
        };

        # Contain all the subscribers
        my @rcpts = @{$message->{rcpt}};
        ## Use an intermediate handler to encode to filesystem_encoding
        my $user;

        # Message transformation should be done in the folowing order:
        #  -1 headers modifications (done in sympa.pl)
        #  -2 DMARC protection
        #  -3 personalize (a.k.a. "merge")
        #  -4 S/MIME signing
        #  -5 S/MIME encryption
        #  -6 remove existing signature if altered
        #  -7 DKIM signing

        if ($message->{shelved}{dmarc_protect}) {
            $message->dmarc_protect;
        }

        my $dkim;
        if ($message->{shelved}{dkim_sign}) {
            $dkim =
                Sympa::Tools::DKIM::get_dkim_parameters($message->{context});
        }

        if (   $message->{shelved}{merge}
            or $message->{shelved}{smime_encrypt}
            or $message->{shelved}{tracking}) {
            # message needs personalization
            my $key;

            foreach my $rcpt (@rcpts) {
                my $new_message = $message->dup;

                my $envid;
                my $return_path;

                if (Sympa::Tools::Data::smart_eq(
                        $new_message->{shelved}{tracking}, qr/dsn|mdn/
                    )
                    ) {
                    # tracking by MDN required tracking by DSN to
                    my $msgid = $new_message->{'message_id'};
                    $envid = Sympa::Tracking::find_notification_id_by_message(
                        $rcpt, $msgid, $listname, $robot);
                    $return_path = $list->get_bounce_address($rcpt, $envid);
                    $new_message->replace_header(
                        'Disposition-Notification-To', $return_path)
                        if $new_message->{shelved}{tracking} =~ /mdn/;
                    # trace_smime($new_message, 'tracking');
                } elsif (
                    Sympa::Tools::Data::smart_eq(
                        $new_message->{shelved}{tracking}, 'w'
                    )
                    ) {
                    $return_path = $list->get_bounce_address($rcpt, 'w');
                } elsif (
                    Sympa::Tools::Data::smart_eq(
                        $new_message->{shelved}{tracking}, 'r'
                    )
                    ) {
                    $return_path = $list->get_bounce_address($rcpt, 'r');
                } elsif ($new_message->{shelved}{tracking}) {    # simple VERP
                    $return_path = $list->get_bounce_address($rcpt);
                } elsif ($new_message->{envelope_sender}) {
                    $return_path = $new_message->{envelope_sender};
                } elsif ($list) {
                    $return_path = $list->get_list_address('return_path');
                } else {
                    $return_path = Conf::get_robot_conf($robot, 'request');
                }

                if ($new_message->{shelved}{merge}) {
                    unless ($new_message->personalize($list, $rcpt)) {
                        $log->syslog('err', 'Erreur d appel personalize()');
                        Sympa::send_notify_to_listmaster($list, 'bulk_failed',
                            {'message_id' => $message->get_id});
                        # Quarantine packet into bad spool.
                        $bulk->quarantine($handle);
                        last;    # foreach $rcpt
                    }
                    delete $new_message->{shelved}{merge};
                }

                if ($new_message->{shelved}{smime_sign}) {
                    $new_message->smime_sign;
                    delete $new_message->{shelved}{smime_sign};
                }

                if ($new_message->{shelved}{smime_encrypt}) {
                    unless ($new_message->smime_encrypt($rcpt)) {
                        $log->syslog(
                            'err',
                            'Unable to encrypt message %s from %s for recipient %s',
                            $new_message,
                            $list,
                            $rcpt
                        );
                        # Quarantine packet into bad spool.
                        $bulk->quarantine($handle);
                        last;    # foreach $rcpt
                    }
                    delete $new_message->{shelved}{smime_encrypt};
                }

                if (Conf::get_robot_conf($robot, 'dkim_feature') eq 'on') {
                    $new_message->remove_invalid_dkim_signature;
                }
                if ($new_message->{shelved}{dkim_sign} and $dkim) {
                    # apply DKIM signature AFTER any other message
                    # transformation.
                    $new_message->dkim_sign(
                        'dkim_d'          => $dkim->{'d'},
                        'dkim_i'          => $dkim->{'i'},
                        'dkim_selector'   => $dkim->{'selector'},
                        'dkim_privatekey' => $dkim->{'private_key'},
                    );
                    delete $new_message->{shelved}{dkim_sign};
                }

                # trace_smime($new_message, 'dkim');

                $new_message->{envelope_sender} = $return_path;
                unless (
                    defined $mailer->store(
                        $new_message, $rcpt,
                        envid => $envid,
                        tag   => $new_message->{serial}
                    )
                    ) {
                    $log->syslog('err',
                        'Failed to store message %s into mailer',
                        $new_message);
                    $bulk->quarantine($handle);
                    undef $handle;
                    last;    # foreach my $rcpt (@rcpts)
                }
            }
        } else {
            # message doesn't need personalization, so can be sent by packet.
            my $new_message = $message->dup;

            my $return_path;

            if ($new_message->{envelope_sender}) {
                $return_path = $new_message->{envelope_sender};
            } elsif ($list) {
                $return_path = $list->get_list_address('return_path');
            } else {
                $return_path = Conf::get_robot_conf($robot, 'request');
            }

            if ($new_message->{shelved}{smime_sign}) {
                $new_message->smime_sign;
                delete $new_message->{shelved}{smime_sign};
            }

            if (Conf::get_robot_conf($robot, 'dkim_feature') eq 'on') {
                $new_message->remove_invalid_dkim_signature;
            }
            # Initial message
            if ($new_message->{shelved}{dkim_sign} and $dkim) {
                $new_message->dkim_sign(
                    'dkim_d'          => $dkim->{'d'},
                    'dkim_i'          => $dkim->{'i'},
                    'dkim_selector'   => $dkim->{'selector'},
                    'dkim_privatekey' => $dkim->{'private_key'},
                );
                delete $new_message->{shelved}{dkim_sign};
            }

            # trace_smime($new_message,'dkim 2');

            $new_message->{envelope_sender} = $return_path;
            unless (
                defined $mailer->store(
                    $new_message, [@rcpts], tag => $new_message->{serial}
                )
                ) {
                $log->syslog('err', 'Failed to store message %s into mailer',
                    $new_message);
                $bulk->quarantine($handle);
                undef $handle;
            }
        }

        ## Remove packet once it has been processed
        if ($handle) {
            unless ($bulk->remove($handle)) {
                $log->syslog('err', 'Failed to remove processed packet %s',
                    $message);
            }
        }

        $date_of_last_activity = time();
    } elsif ($handle) {
        $log->syslog('err', 'Cannot parse message <%s>',
            $handle->basename(1));
        $bulk->quarantine($handle);
        next;
    } else {
        ## Sleep for a while if bulk_mailer DB table is empty
        sleep $Conf::Conf{'bulk_sleep'};
    }
    $mailer->reaper();
}

# Purge grouped notifications
Sympa::Alarm->instance->flush(purge => 1);

$log->syslog('notice', 'Bulk exited normally due to signal');
Sympa::Tools::Daemon::remove_pid('bulk', $PID, $options);

exit(0);

## When we catch signal, just change the value of the loop
## variable.
sub sigterm {
    my ($sig) = @_;
    $log->syslog('notice',
        'Signal %s received, still processing current task', $sig);
    $end = 1;
}

sub trace_smime {
    my $message = shift;
    my $where   = shift;

    my $result = $message->check_smime_signature;
    return if defined $result and $result == 0;

    unless ($result) {
        $log->syslog('debug', 'Signature S/MIME NOT OK (%s)', $where);
    } else {
        $log->syslog('debug', 'Signature S/MIME OK (%s)', $where);
    }
}

__END__

=encoding utf-8

=head1 NAME 

bulk, bulk.pl - Daemon for Submitting Bulk Content to SMTP Engine

=head1 SYNOPSIS

S<B<bulk.pl> [ B<--foreground> ] [ B<--debug> ]>

=head1 DESCRIPTION 

This daemon must be run along with Sympa.  It regularly checks the
content of bulk spool and submit the messages it finds in it to the
sendmail engine.  Several daemon should be used on deferent server for huge
traffic.

=head1 OPTIONS

=over 4

=item B<-d>, B<--debug>

Sets the debug mode

=item B<-f>, B<--config=>I<file>

Force bulk to use an alternative configuration file instead
of F</usr/pkg/etc/sympa/sympa.conf>.

=item B<-F>, B<--foreground>

Prevents the script from being daemonized

=item B<-h>, B<--help>

Prints this help message.

=item B<--log_level=>I<level>

Set log level.

=item B<-m>, B<--mail>

Logs every sendmail calls.

=back

=head1 FILES

F</var/sympa/run/bulk.pid> this file contains the process IDs
of F<bulk.pl>.

=head1 MORE DOCUMENTATION

The full documentation in HTML and PDF formats can be
found in L<http://www.sympa.org/manual/>.

The mailing lists (with web archives) can be accessed at
L<http://listes.renater.fr/sympa/lists/informatique/sympa>.

=head1 BUGS

Report bugs to Sympa bug tracker.
See L<http://www.sympa.org/tracking>.

=head1 SEE ALSO

L<sympa_msg(8)>, L<sendmail(8)>

=cut
