1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program.  If not, see <http://www.gnu.org/licenses/>.
24
25package Sympa::Mailer;
26
27use strict;
28use warnings;
29use base qw(Class::Singleton);
30
31use English qw(-no_match_vars);
32use POSIX qw();
33
34use Conf;
35use Sympa::Log;
36use Sympa::Process;
37
38my $log     = Sympa::Log->instance;
39my $process = Sympa::Process->instance;
40
41my $max_arg;
42eval { $max_arg = POSIX::sysconf(POSIX::_SC_ARG_MAX()); };
43if ($EVAL_ERROR) {
44    $max_arg = 4096;
45}
46
47# Constructor for Class::Singleton.
48sub _new_instance {
49    my $class = shift;
50
51    bless {
52        _pids      => {},
53        redundancy => 1,        # Process redundancy (used by bulk.pl).
54        log_smtp   => undef,    # SMTP logging is enabled or not.
55    } => $class;
56}
57
58#sub set_send_spool($spool_dir);
59#DEPRECATED: No longer used.
60
61#sub mail_file($robot, $filename, $rcpt, $data, $return_message_as_string);
62##DEPRECATED: Use Sympa::Message::Template::new() & send_message().
63
64#sub mail_message($message, $rcpt, [tag_as_last => 1]);
65# DEPRECATED: this is now a subroutine of Sympa::List::distribute_msg().
66
67#sub mail_forward($message, $from, $rcpt, $robot);
68#DEPRECATED: This is no longer used.
69
70# DEPRECATED.  Use Sympa::Process::reap_child().
71#sub reaper;
72
73#DEPRECATED.
74#sub sendto;
75
76# DEPRECATED.  Use Sympa::Mailer::store() or Sympa::Spool::Outgoing::store().
77# Old name:
78# mail::sending(), Sympa::Mail::sending(), Sympa::Mailer::send_message().
79#sub send_message ($self, $message, $rcpt, %params);
80
81sub store {
82    my $self    = shift;
83    my $message = shift;
84    my $rcpt    = shift;
85    my %params  = @_;
86
87    my $return_path = $message->{envelope_sender};
88    my $envid       = $params{envid};
89    my $tag         = $params{tag};
90    my $logging = (not defined $tag or $tag eq 's' or $tag eq 'z') ? 1 : 0;
91
92    my @all_rcpt;
93    unless (ref $rcpt) {
94        @all_rcpt = ($rcpt);
95    } elsif (ref $rcpt eq 'SCALAR') {
96        @all_rcpt = ($$rcpt);
97    } elsif (ref $rcpt eq 'ARRAY') {
98        @all_rcpt = @$rcpt;
99    }
100
101    # Stripping Return-Path: pseudo-header field.
102    my $msg_string = $message->as_string;
103    $msg_string =~ s/\AReturn-Path: (.*?)\n(?![ \t])//s;
104
105    my $sendmail = $Conf::Conf{'sendmail'};
106    my @sendmail_args = split /\s+/, $Conf::Conf{'sendmail_args'};
107    if (defined $envid and length $envid) {
108        # Postfix clone of sendmail command doesn't allow spaces between
109        # "-V" and envid.
110        # And as it denys "-V" with 2 characters, "0" are padded.
111        push @sendmail_args, '-N', 'success,delay,failure',
112            sprintf('-V%08s', $envid);
113    }
114    my $min_cmd_size =
115        length($sendmail) + 1 +
116        length(join ' ', @sendmail_args) + 1 +
117        length("-f $return_path --");
118    my $maxsmtp =
119        int($Conf::Conf{'maxsmtp'} / ($self->{redundancy} || 1)) || 1;
120
121    # Ignore SIGPIPE which may occur at the time of close().
122    local $SIG{PIPE} = 'IGNORE';
123
124    my $numsmtp = 0;
125    while (@all_rcpt) {
126        # Split rcpt by max length of command line (_SC_ARG_MAX).
127        my $cmd_size = $min_cmd_size + 1 + length($all_rcpt[0]);
128        my @rcpt     = (shift @all_rcpt);
129        while (@all_rcpt
130            and ($cmd_size += 1 + length($all_rcpt[0])) <= $max_arg) {
131            push @rcpt, (shift @all_rcpt);
132        }
133
134        # Get sendmail handle.
135
136        unless ($return_path) {
137            $log->syslog('err', 'Missing Return-Path');
138        }
139
140        # Check how many open smtp's we have, if too many wait for a few
141        # to terminate and then do our job.
142        $process->sync_child(hash => $self->{_pids});
143        $log->syslog('debug3', 'Open = %s', scalar keys %{$self->{_pids}});
144        while ($maxsmtp < scalar keys %{$self->{_pids}}) {
145            $log->syslog(
146                'info',
147                'Too many open SMTP (%s), calling reaper',
148                scalar keys %{$self->{_pids}}
149            );
150            # Blockng call to the reaper.
151            last if $process->wait_child < 0;
152            $process->sync_child(hash => $self->{_pids});
153        }
154
155        my ($pipein, $pipeout, $pid);
156        unless (pipe $pipein, $pipeout) {
157            die sprintf 'Unable to create a SMTP channel: %s', $ERRNO;
158            # No return
159        }
160        $pid = _safefork($message->get_id);
161        $self->{_pids}->{$pid} = 1;
162
163        unless ($pid) {    # _safefork() would die if fork() had failed.
164            # Child
165            close $pipeout;
166            open STDIN, '<&', $pipein;
167
168            # The '<>' means null sender.
169            # Terminate options by "--" to prevent addresses beginning with "-"
170            # being treated as options.
171            exec $sendmail, @sendmail_args, '-f',
172                ($return_path eq '<>' ? '' : $return_path), '--', @rcpt;
173
174            exit 1;    # Should never get there.
175        } else {
176            # Parent
177            if ($self->{log_smtp}) {
178                $log->syslog(
179                    'notice',
180                    'Forked process %d: %s %s -f \'%s\' -- %s',
181                    $pid,
182                    $sendmail,
183                    join(' ', @sendmail_args),
184                    $return_path,
185                    join(' ', @rcpt)
186                );
187            }
188            unless (close $pipein) {
189                $log->syslog('err', 'Could not close forked process %d',
190                    $pid);
191                return undef;
192            }
193            select undef, undef, undef, 0.3
194                if scalar keys %{$self->{_pids}} < $maxsmtp;
195        }
196
197        # Output to handle.
198
199        print $pipeout $msg_string;
200        unless (close $pipeout) {
201            $log->syslog('err', 'Failed to close pipe to process %d: %m',
202                $pid);
203            return undef;
204        }
205        $numsmtp++;
206    }
207
208    if ($logging) {
209        $log->syslog(
210            'notice',
211            'Done sending message %s for %s (priority %s) in %s seconds since scheduled expedition date',
212            $message,
213            $message->{context},
214            $message->{'priority'},
215            time() - $message->{'date'}
216        );
217    }
218
219    return $numsmtp;
220}
221
222# Old names: mail::smtpto(), Sympa::Mail::smtpto(),
223# Sympa::Mailer::get_sendmail_handle().
224# DEPRECATED: Merged into store().
225#sub _get_sendmail_handle;
226
227#This has never been used.
228#sub send_in_spool($rcpt, $robot, $sympa_email, $XSympaFrom);
229
230#DEPRECATED: Use Sympa::Message::reformat_utf8_message().
231#sub reformat_message($;$$);
232
233#DEPRECATED. Moved to Sympa::Message::_fix_utf8_parts as internal functioin.
234#sub fix_part;
235
236## Safefork does several tries before it gives up.
237## Do 3 trials and wait 10 seconds * $i between each.
238## Exit with a fatal error is fork failed after all
239## tests have been exhausted.
240# Old name: tools::safefork().
241# Note: Use store().
242sub _safefork {
243    my $tag = shift;
244
245    my $err;
246    for (my $i = 1; $i < 4; $i++) {
247        my $pid = $process->fork($tag);
248        return $pid if defined $pid;
249
250        $err = $ERRNO;
251        $log->syslog('err', 'Cannot create new process: %s', $err);
252        #FIXME:should send a mail to the listmaster
253        sleep(10 * $i);
254    }
255    die sprintf 'Exiting because cannot create new process for <%s>: %s',
256        $tag, $err;
257    # No return.
258}
259
2601;
261__END__
262
263=encoding utf-8
264
265=head1 NAME
266
267Sympa::Mailer - Store messages to sendmail
268
269=head1 SYNOPSIS
270
271  use Sympa::Mailer;
272  use Sympa::Process;
273  my $mailer = Sympa::Mailer->instance;
274  my $process = Sympa::Process->instance;
275
276  $mailer->store($message, ['user1@dom.ain', user2@other.dom.ain']);
277
278=head1 DESCRIPTION
279
280L<Sympa::Mailer> implements the class to invoke sendmail processes and
281store messages to them.
282
283=head2 Methods
284
285=over
286
287=item instance ( )
288
289I<Constructor>.
290Creates a singleton instance of L<Sympa::Mailer> object.
291
292Returns:
293
294A new L<Sympa::Mailer> instance, or I<undef> for failure.
295
296=item reaper ( [ blocking =E<gt> 1 ] )
297
298DEPRECATED.
299Use L<Sympa::Process/"reap_child">.
300
301I<Instance method>.
302Non blocking function called by: main loop of sympa, task_manager, bounced
303etc., just to clean the defuncts list by waiting to any processes and
304decrementing the counter.
305
306Parameter:
307
308=over
309
310=item blocking =E<gt> 1
311
312Operation would block.
313
314=back
315
316Returns:
317
318PID.
319
320=item store ( $message, $rcpt,
321[ envid =E<gt> $envid ], [ tag =E<gt> $tag ] )
322
323I<Instance method>.
324Makes a sendmail ready for the recipients given as argument, uses a file
325descriptor in the smtp table which can be imported by other parties.
326Before, waits for number of children process < number allowed by sympa.conf
327
328Parameters:
329
330=over
331
332=item $message
333
334Message to be sent.
335
336{envelope_sender} attribute of the message will be used as SMTP "MAIL FROM:"
337field.
338
339=item $rcpt
340
341Scalar, scalarref or arrayref, for SMTP "RCPT TO:" field.
342
343=item envid =E<gt> $envid
344
345An envelope ID of this message submission in notification table.
346See also L<Sympa::Tracking>.
347
348=item tag =E<gt> $tag
349
350TBD
351
352=back
353
354Returns:
355
356Filehandle on opened pipe to output SMTP "DATA" field.
357Otherwise C<undef>.
358
359=back
360
361=head2 Attributes
362
363L<Sympa::Mailer> instance may have following attributes:
364
365=over
366
367=item {log_smtp}
368
369If true value is set, each invocation of sendmail process will be logged.
370
371=item {redundancy}
372
373Positive integer.
374If set, maximum number of invocation of sendmail is divided by this value.
375
376=back
377
378=head1 SEE ALSO
379
380L<Sympa::Message>, L<Sympa::Process>,
381L<Sympa::Spool::Listmaster>, L<Sympa::Spool::Outgoing>.
382
383=head1 HISTORY
384
385L<Sympa::Mailer>, the rewrite of mail.pm, appeared on Sympa 6.2.
386
387=cut
388