1
# smtp.pm - This module does the SMTP job, it does send messages
2
# RCS Identication ; $Revision: 1.23 $ ; $Date: 2004/01/15 16:25:03 $
4
# Sympa - SYsteme de Multi-Postage Automatique
5
# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des Universites
6
# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
8
# This program is free software; you can redistribute it and/or modify
9
# it under the terms of the GNU General Public License as published by
10
# the Free Software Foundation; either version 2 of the License, or
11
# (at your option) any later version.
13
# This program is distributed in the hope that it will be useful,
14
# but WITHOUT ANY WARRANTY; without even the implied warranty of
15
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
# GNU General Public License for more details.
18
# You should have received a copy of the GNU General Public License
19
# along with this program; if not, write to the Free Software
20
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
34
## RCS identification.
35
#my $id = '@(#)$Id: smtp.pm,v 1.23 2004/01/15 16:25:03 salaun Exp $';
38
my $fh = 'fh0000000000'; ## File handle for the stream.
40
my $max_arg = eval { &POSIX::_SC_ARG_MAX; };
43
print STDERR Msg(11, 1,'Your system is not POSIX P1003.1 compliant, or it does not define
44
the _SC_ARG_MAX constant in its POSIX library. You will need to manually edit
45
smtp.pm and configure $max_arg
48
$max_arg = POSIX::sysconf($max_arg);
53
## Reaper - Non blocking function called by the main loop, just to
54
## clean the defuncts list by waiting to any processes and decrementing
60
$block = 1 unless (defined($block));
61
while (($i = waitpid(-1, $block ? &POSIX::WNOHANG : 0)) > 0) {
63
if (!defined($pid{$i})) {
64
&do_log('debug2', "Reaper waited $i, unknown process to me");
70
&do_log('debug2', "Reaper unwaited pids : %s\nOpen = %s\n", join(' ', sort keys %pid), $opensmtp);
74
## Makes a sendmail ready for the recipients given as
75
## argument, uses a file descriptor in the smtp table
76
## which can be imported by other parties.
78
my($from, $rcpt, $sign_mode) = @_;
81
&do_log('err', 'Missing Return-Path in smtp::smtpto()');
84
if (ref($rcpt) eq 'SCALAR') {
85
do_log('debug2', 'smtp::smtpto(%s, %s, %s )', $from, $$rcpt,$sign_mode);
87
do_log('debug2', 'smtp::smtpto(%s, %s, %s)', $from, join(',', @{$rcpt}), $sign_mode);
92
## Escape "-" at beginning of recepient addresses
93
## prevent sendmail from taking it as argument
95
if (ref($rcpt) eq 'SCALAR') {
99
foreach my $i (0..$#emails) {
100
$rcpt->[$i] =~ s/^-/\\-/;
104
## Check how many open smtp's we have, if too many wait for a few
105
## to terminate and then do our job.
107
do_log('debug3',"Open = $opensmtp");
108
while ($opensmtp > $Conf{'maxsmtp'}) {
109
do_log('debug3',"Smtpto: too many open SMTP ($opensmtp), calling reaper" );
110
last if (&reaper(0) == -1); ## Blocking call to the reaper.
113
*IN = ++$fh; *OUT = ++$fh;
116
if (!pipe(IN, OUT)) {
117
fatal_err(Msg(11, 2, "Can't create a pipe in smtpto: %m")); ## No return
119
$pid = &tools::safefork();
125
if (ref($rcpt) eq 'SCALAR') {
126
exec $Conf{'sendmail'}, split(/\s+/,$Conf{'sendmail_args'}), '-f', $from, $$rcpt;
128
exec $Conf{'sendmail'}, split(/\s+/,$Conf{'sendmail_args'}), '-f', $from, @$rcpt;
130
exit 1; ## Should never get there.
132
if ($main::options{'mail'}) {
133
$str = "safefork: $Conf{'sendmail'} $Conf{'sendmail_args'} -f $from ";
134
if (ref($rcpt) eq 'SCALAR') {
137
$str .= join(' ', @$rcpt);
139
do_log('notice', $str);
143
select(undef, undef,undef, 0.3) if ($opensmtp < $Conf{'maxsmtp'});
144
return("smtp::$fh"); ## Symbol for the write descriptor.
148
## Makes a sendmail ready for the recipients given as
149
## argument, uses a file descriptor in the smtp table
150
## which can be imported by other parties.
153
my $temporary_file = shift;
155
do_log('debug2', 'smtp::smime_sign (%s)', $from);
157
exec "$Conf{'openssl'} smime -sign -signer cert.pem -inkey private_key -out $temporary_file";
158
exit 1; ## Should never get there.
163
my($msg_header, $msg_body, $from, $rcpt, $encrypt) = @_;
164
do_log('debug2', 'smtp::sendto(%s, %s, %s)', $from, $rcpt, $encrypt);
168
## Encode subject before sending
169
$msg_header->replace('Subject', MIME::Words::encode_mimewords($msg_header->get('Subject')));
171
if ($encrypt eq 'smime_crypted') {
173
if (ref($rcpt) eq 'SCALAR') {
174
$email = lc ($$rcpt) ;
178
do_log('err',"incorrect call for encrypt with $#rcpts recipient(s)");
181
$email = lc ($rcpt->[0]);
183
$msg = &tools::smime_encrypt ($msg_header, $msg_body, $email);
185
$msg = $msg_header->as_string . "\n" . $msg_body;
189
*SMTP = &smtpto($from, $rcpt);
199
my($message, $from, @rcpt) = @_;
200
do_log('debug2', 'smtp::mailto(from: %s, , file:%s, %s, %d rcpt)', $from, $message->{'filename'}, $message->{'smime_crypted'}, $#rcpt+1);
202
my($i, $j, $nrcpt, $size, @sendto);
205
## If message contain a footer or header added by Sympa use the object message else
206
## Extract body from original file to preserve signature
207
my ($msg_body, $msg_header);
209
$msg_header = $message->{'msg'}->head;
211
if ($message->{'altered'}) {
212
$msg_body = $message->{'msg'}->body_as_string;
214
}elsif ($message->{'smime_crypted'}) {
215
$msg_body = ${$message->{'msg_as_string'}};
218
## Get body from original file
219
unless (open MSG, $message->{'filename'}) {
220
do_log ('notice',"Unable to open %s:%s",$message->{'filename'},$!);
228
$in_header = 0 if (/^$/);
234
## if the message must be crypted, we need to send it using one smtp session for each rcpt
235
if ($message->{'smime_crypted'}){
237
while (defined ($i = shift(@rcpt))) {
238
&sendto($msg_header, $msg_body, $from, [$i], $message->{'smime_crypted'});
245
while (defined ($i = shift(@rcpt))) {
246
my @k = reverse(split(/[\.@]/, $i));
247
my @l = reverse(split(/[\.@]/, $j));
248
if ($j && $#sendto >= $Conf{'avg'} && lc("$k[0] $k[1]") ne lc("$l[0] $l[1]")) {
249
&sendto($msg_header, $msg_body, $from, \@sendto);
254
if ($#sendto >= 0 && (($size + length($i)) > $max_arg || $nrcpt >= $Conf{'nrcpt'})) {
255
&sendto($msg_header, $msg_body, $from, \@sendto);
260
$nrcpt++; $size += length($i) + 5;
265
&sendto($msg_header, $msg_body, $from, \@sendto) if ($#sendto >= 0);
added
removed
src/smtp.pm
