Mailer.pm 10.2 KB
Newer Older
1
2
3
4
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$

5
# Sympa - SYsteme de Multi-Postage Automatique
6
7
8
9
#
# 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
10
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11
12
13
14
15
16
17
18
19
20
21
22
#
# 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
23
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
root's avatar
root committed
24

25
package Sympa::Mailer;
root's avatar
root committed
26

27
use strict;
28
use warnings;
29
30
use base qw(Class::Singleton);

31
use English qw(-no_match_vars);
32
use POSIX qw();
33

root's avatar
root committed
34
use Conf;
35
use Sympa::Log;
36
use Sympa::Process;
37

38
39
my $log     = Sympa::Log->instance;
my $process = Sympa::Process->instance;
40

41
my $max_arg;
42
eval { $max_arg = POSIX::sysconf(POSIX::_SC_ARG_MAX()); };
43
if ($EVAL_ERROR) {
44
45
46
    $max_arg = 4096;
}

47
48
# Constructor for Class::Singleton.
sub _new_instance {
49
    my $class = shift;
50
51

    bless {
52
        _pids      => {},
53
54
        redundancy => 1,        # Process redundancy (used by bulk.pl).
        log_smtp   => undef,    # SMTP logging is enabled or not.
55
56
57
    } => $class;
}

58
59
#sub set_send_spool($spool_dir);
#DEPRECATED: No longer used.
root's avatar
root committed
60

61
#sub mail_file($robot, $filename, $rcpt, $data, $return_message_as_string);
62
##DEPRECATED: Use Sympa::Message::Template::new() & send_message().
root's avatar
root committed
63

64
#sub mail_message($message, $rcpt, [tag_as_last => 1]);
65
# DEPRECATED: this is now a subroutine of Sympa::List::distribute_msg().
root's avatar
root committed
66

67
68
#sub mail_forward($message, $from, $rcpt, $robot);
#DEPRECATED: This is no longer used.
root's avatar
root committed
69

70
71
# DEPRECATED.  Use Sympa::Process::reap_child().
#sub reaper;
72

73
#DEPRECATED.
74
#sub sendto;
75

76
# DEPRECATED.  Use Sympa::Mailer::store() or Sympa::Spool::Outgoing::store().
77
78
79
# Old name:
# mail::sending(), Sympa::Mail::sending(), Sympa::Mailer::send_message().
#sub send_message ($self, $message, $rcpt, %params);
80

81
82
83
84
85
86
87
88
sub store {
    my $self    = shift;
    my $message = shift;
    my $rcpt    = shift;
    my %params  = @_;

    my $return_path = $message->{envelope_sender};
    my $envid       = $params{envid};
89
90
    my $tag         = $params{tag};
    my $logging = (not defined $tag or $tag eq 's' or $tag eq 'z') ? 1 : 0;
91

92
93
94
95
96
97
98
99
100
    my @all_rcpt;
    unless (ref $rcpt) {
        @all_rcpt = ($rcpt);
    } elsif (ref $rcpt eq 'SCALAR') {
        @all_rcpt = ($$rcpt);
    } elsif (ref $rcpt eq 'ARRAY') {
        @all_rcpt = @$rcpt;
    }

101
102
103
    # Stripping Return-Path: pseudo-header field.
    my $msg_string = $message->as_string;
    $msg_string =~ s/\AReturn-Path: (.*?)\n(?![ \t])//s;
104

105
106
107
108
109
    my $sendmail = $Conf::Conf{'sendmail'};
    my @sendmail_args = split /\s+/, $Conf::Conf{'sendmail_args'};
    if (defined $envid and length $envid) {
        # Postfix clone of sendmail command doesn't allow spaces between
        # "-V" and envid.
110
111
112
        # And as it denys "-V" with 2 characters, "0" are padded.
        push @sendmail_args, '-N', 'success,delay,failure',
            sprintf('-V%08s', $envid);
113
    }
114
    my $min_cmd_size =
115
116
117
118
119
120
        length($sendmail) + 1 +
        length(join ' ', @sendmail_args) + 1 +
        length("-f $return_path --");
    my $maxsmtp =
        int($Conf::Conf{'maxsmtp'} / ($self->{redundancy} || 1)) || 1;

121
122
123
    # Ignore SIGPIPE which may occur at the time of close().
    local $SIG{PIPE} = 'IGNORE';

124
125
126
127
    my $numsmtp = 0;
    while (@all_rcpt) {
        # Split rcpt by max length of command line (_SC_ARG_MAX).
        my $cmd_size = $min_cmd_size + 1 + length($all_rcpt[0]);
128
        my @rcpt     = (shift @all_rcpt);
129
130
131
132
133
        while (@all_rcpt
            and ($cmd_size += 1 + length($all_rcpt[0])) <= $max_arg) {
            push @rcpt, (shift @all_rcpt);
        }

134
135
136
        # Get sendmail handle.

        unless ($return_path) {
137
            $log->syslog('err', 'Missing Return-Path');
138
        }
139
140
141

        # Check how many open smtp's we have, if too many wait for a few
        # to terminate and then do our job.
142
        $process->sync_child(hash => $self->{_pids});
143
144
145
        $log->syslog('debug3', 'Open = %s', scalar keys %{$self->{_pids}});
        while ($maxsmtp < scalar keys %{$self->{_pids}}) {
            $log->syslog(
146
                'info',
147
148
149
150
                'Too many open SMTP (%s), calling reaper',
                scalar keys %{$self->{_pids}}
            );
            # Blockng call to the reaper.
151
152
            last if $process->wait_child < 0;
            $process->sync_child(hash => $self->{_pids});
153
154
155
156
157
158
159
        }

        my ($pipein, $pipeout, $pid);
        unless (pipe $pipein, $pipeout) {
            die sprintf 'Unable to create a SMTP channel: %s', $ERRNO;
            # No return
        }
160
161
        $pid = _safefork($message->get_id);
        $self->{_pids}->{$pid} = 1;
162
163
164
165
166
167
168
169
170
171
172
173

        unless ($pid) {    # _safefork() would die if fork() had failed.
            # Child
            close $pipeout;
            open STDIN, '<&', $pipein;

            # The '<>' means null sender.
            # Terminate options by "--" to prevent addresses beginning with "-"
            # being treated as options.
            exec $sendmail, @sendmail_args, '-f',
                ($return_path eq '<>' ? '' : $return_path), '--', @rcpt;

174
            exit 1;    # Should never get there.
175
176
177
        } else {
            # Parent
            if ($self->{log_smtp}) {
178
                $log->syslog(
179
180
181
182
183
184
185
186
187
188
                    'notice',
                    'Forked process %d: %s %s -f \'%s\' -- %s',
                    $pid,
                    $sendmail,
                    join(' ', @sendmail_args),
                    $return_path,
                    join(' ', @rcpt)
                );
            }
            unless (close $pipein) {
189
190
                $log->syslog('err', 'Could not close forked process %d',
                    $pid);
191
192
193
                return undef;
            }
            select undef, undef, undef, 0.3
194
                if scalar keys %{$self->{_pids}} < $maxsmtp;
195
196
197
198
        }

        # Output to handle.

199
200
        print $pipeout $msg_string;
        unless (close $pipeout) {
201
            $log->syslog('err', 'Failed to close pipe to process %d: %m',
202
                $pid);
203
204
205
            return undef;
        }
        $numsmtp++;
206
207
    }

208
    if ($logging) {
209
        $log->syslog(
210
211
212
213
214
215
216
217
218
            'notice',
            'Done sending message %s for %s (priority %s) in %s seconds since scheduled expedition date',
            $message,
            $message->{context},
            $message->{'priority'},
            time() - $message->{'date'}
        );
    }

219
    return $numsmtp;
220
221
}

222
223
# Old names: mail::smtpto(), Sympa::Mail::smtpto(),
# Sympa::Mailer::get_sendmail_handle().
224
225
# DEPRECATED: Merged into store().
#sub _get_sendmail_handle;
226

227
228
#This has never been used.
#sub send_in_spool($rcpt, $robot, $sympa_email, $XSympaFrom);
root's avatar
root committed
229

230
#DEPRECATED: Use Sympa::Message::reformat_utf8_message().
231
#sub reformat_message($;$$);
root's avatar
root committed
232

233
#DEPRECATED. Moved to Sympa::Message::_fix_utf8_parts as internal functioin.
234
#sub fix_part;
235

236
237
238
239
240
## Safefork does several tries before it gives up.
## Do 3 trials and wait 10 seconds * $i between each.
## Exit with a fatal error is fork failed after all
## tests have been exhausted.
# Old name: tools::safefork().
241
# Note: Use store().
242
sub _safefork {
243
244
    my $tag = shift;

245
    my $err;
246
    for (my $i = 1; $i < 4; $i++) {
247
        my $pid = $process->fork($tag);
248
249
250
        return $pid if defined $pid;

        $err = $ERRNO;
251
        $log->syslog('err', 'Cannot create new process: %s', $err);
252
253
254
        #FIXME:should send a mail to the listmaster
        sleep(10 * $i);
    }
255
256
    die sprintf 'Exiting because cannot create new process for <%s>: %s',
        $tag, $err;
257
258
259
    # No return.
}

260
1;
261
262
263
264
265
266
267
268
__END__

=encoding utf-8

=head1 NAME

Sympa::Mailer - Store messages to sendmail

269
270
271
=head1 SYNOPSIS

  use Sympa::Mailer;
272
  use Sympa::Process;
273
  my $mailer = Sympa::Mailer->instance;
274
  my $process = Sympa::Process->instance;
275
276
277

  $mailer->store($message, ['user1@dom.ain', user2@other.dom.ain']);

278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
=head1 DESCRIPTION

L<Sympa::Mailer> implements the class to invoke sendmail processes and
store messages to them.

=head2 Methods

=over

=item instance ( )

I<Constructor>.
Creates a singleton instance of L<Sympa::Mailer> object.

Returns:

A new L<Sympa::Mailer> instance, or I<undef> for failure.

296
=item reaper ( [ blocking =E<gt> 1 ] )
297

298
DEPRECATED.
299
300
Use L<Sympa::Process/"reap_child">.

301
302
303
304
305
306
307
308
309
I<Instance method>.
Non blocking function called by: main loop of sympa, task_manager, bounced
etc., just to clean the defuncts list by waiting to any processes and
decrementing the counter.

Parameter:

=over

310
=item blocking =E<gt> 1
311

312
Operation would block.
313
314
315
316
317
318
319

=back

Returns:

PID.

320
=item store ( $message, $rcpt,
321
[ envid =E<gt> $envid ], [ tag =E<gt> $tag ] )
322
323
324
325
326
327
328
329
330
331
332
333
334
335

I<Instance method>.
Makes a sendmail ready for the recipients given as argument, uses a file
descriptor in the smtp table which can be imported by other parties.
Before, waits for number of children process < number allowed by sympa.conf

Parameters:

=over

=item $message

Message to be sent.

336
337
{envelope_sender} attribute of the message will be used as SMTP "MAIL FROM:"
field.
338
339
340
341
342

=item $rcpt

Scalar, scalarref or arrayref, for SMTP "RCPT TO:" field.

343
=item envid =E<gt> $envid
344
345
346
347

An envelope ID of this message submission in notification table.
See also L<Sympa::Tracking>.

348
=item tag =E<gt> $tag
349
350
351

TBD

352
353
354
355
=back

Returns:

sikeda's avatar
sikeda committed
356
Filehandle on opened pipe to output SMTP "DATA" field.
357
358
359
360
Otherwise C<undef>.

=back

361
362
=head2 Attributes

363
L<Sympa::Mailer> instance may have following attributes:
364
365
366
367
368

=over

=item {log_smtp}

sikeda's avatar
sikeda committed
369
If true value is set, each invocation of sendmail process will be logged.
370
371
372

=item {redundancy}

373
Positive integer.
sikeda's avatar
sikeda committed
374
If set, maximum number of invocation of sendmail is divided by this value.
375
376
377

=back

378
379
=head1 SEE ALSO

380
381
L<Sympa::Message>, L<Sympa::Process>,
L<Sympa::Spool::Listmaster>, L<Sympa::Spool::Outgoing>.
382
383
384
385
386
387

=head1 HISTORY

L<Sympa::Mailer>, the rewrite of mail.pm, appeared on Sympa 6.2.

=cut