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