[usenet/usevote.git] / UVsendmail.pm

# UVsendmail: functions for sending mails
# Used by uvvote.pl, uvcfv.pl

package UVsendmail;

use strict;
use UVconfig;
use UVtemplate;
use MIME::Words;
use Text::Wrap qw(wrap $columns);

# Set columns for Text::Wrap
$columns = $config{rightmargin};

use vars qw($VERSION);

# Module version
$VERSION = "0.9";

my $num = 0;

##############################################################################
# generation of acknowledge and error mails (don't sends them out yet)       #
# each mail is saved in a different file and a control file containing       #
# filename and envelope-to address is generated.                             #
# Parameters: mail address, fixed part of subject and body of mail (strings) #
##############################################################################
 
sub mail {
  my ($addr, $subject, $text, $reference, $replyto) = @_;
 
  # address set?
  if ($addr) {
    # generate mail to sender
  
    my $template = UVtemplate->new();
    $template->setKey('from' => mimeencode($config{mailfrom}));
    $template->setKey('subject' => mimeencode("$config{votename} - $subject"));
    $template->setKey('address' => $addr);
    $template->setKey('reference' => $reference) if ($reference);
    $template->setKey('reply-to' => $replyto) if ($replyto);
    $template->setKey('usevote-version' => $usevote_version);

    my $message = $template->processTemplate($config{'tpl_mailheader'});
    $message .= "\n" . $text;

    # get envelope-to addresses
    my $envaddr = $addr;
    $envaddr .= " $config{mailcc}" if ($config{mailcc});

    my $mailfile = '';

    # search for file names
    do {
      $num++;
      $mailfile = "$config{tmpdir}/ack.$num";
    } while (-e $mailfile);
    
    # write mail in a file and append a line at the control file

    open (CONTROL, ">>$config{controlfile}") or print STDERR "\n\n",
      UVmessage::get("SENDMAIL_ERROPENCONTROL", (FILE => $config{controlfile})), "\n"; 
    print CONTROL "$mailfile\t$envaddr\n";
    close (CONTROL) or print STDERR "\n\n",
      UVmessage::get("SENDMAIL_ERRCLOSECONTROL", (FILE => $config{controlfile})), "\n";

    open (MAIL, ">$mailfile") or print STDERR "\n\n",
      UVmessage::get("SENDMAIL_ERROPENMAIL", (FILE => $config{controlfile})), "\n";
    print MAIL $message;
    close (MAIL) or print STDERR "\n\n",
      UVmessage::get("SENDMAIL_ERRCLOSEMAIL", (FILE => $config{controlfile})), "\n";

  }
}                                                                                      


##############################################################################
# Send previously generated acknowledge or error mails.                      #
# Depending on configuration mails are piped to your MTA or send via SMTP.   #
##############################################################################

sub send {
  unless (-e $config{controlfile}) {
    print "\n", UVmessage::get("SENDMAIL_NOMAILS", (FILE => $config{controlfile})),
          "\n\n";
    return 0;
  }

  open (CONTROL, "<$config{controlfile}") or die "\n\n",
    UVmessage::get("SENDMAIL_ERROPENCONTROL", (FILE => $config{controlfile})), "\n";
  my @mailinfo = <CONTROL>;
  close (CONTROL);

  print UVmessage::get("SENDMAIL_SENDING"), "\n";

  if ($config{smtp}) {
    # send mails via SMTP
    use Net::SMTP;
    my $smtp = Net::SMTP->new("$config{smtpserver}:$config{smtpport}",
                              Hello => $config{smtphelo});
    die UVmessage::get("SENDMAIL_SMTP_CONNREFUSED") . "\n\n" unless ($smtp);
    if ($config{smtpauth}) {
      $smtp->auth($config{smtpuser}, $config{smtppass})
        or die UVmessage::get("SENDMAIL_SMTP_CONNREFUSED") . "\n" .
               $smtp->code() . ' ' . $smtp->message() . "\n";
    }

    my $errors = 0;
    my $missingfiles = 0;

    open (CONTROL, ">$config{controlfile}") or die  "\n\n",
      UVmessage::get("SENDMAIL_ERROPENCONTROL", (FILE => $config{controlfile})), "\n";

    foreach my $mail (@mailinfo) {

      chomp ($mail);
      next unless $mail;

      my ($file, $envelope) = split(/\t/, $mail);
      my $notfound = 0;
      open (MAIL, "<$file") or $notfound = 1;
      if ($notfound) {
        print STDERR UVmessage::get("SENDMAIL_ERRNOTFOUND") . "\n";
        $missingfiles++;
        next;
      }
      my $message = join('', <MAIL>);
      close (MAIL);

      next unless $message;

      $smtp->reset();
      $smtp->mail($config{envelopefrom});
      unless ($smtp->ok()) {
        print STDERR UVmessage::get("SENDMAIL_SMTP_INVRCPT", (RCPT => $envelope)),
                     "\n", $smtp->code(), ' ', $smtp->message(), "\n";
        $errors++;
        next;
      }
        
      my $onesent = 0;
      my $onefail = 0;
      foreach my $addr (split(/ +/, $envelope)) {
        $smtp->to($addr);
        if ($smtp->ok()) {
          $onesent = 1;
        } else {
          print CONTROL ($onefail ? " " : "$file\t");
          print CONTROL $addr;
          print STDERR UVmessage::get("SENDMAIL_SMTP_INVRCPT", (RCPT => $envelope)),
                       "\n", $smtp->code(), ' ', $smtp->message(), "\n";
          $errors++;
          $onefail = 1;
          next;
        }
      }

      print CONTROL "\n" if ($onefail);
      next unless $onesent;

      $smtp->data();
      if ($smtp->ok()) {
        $smtp->datasend($message);
        $smtp->dataend();
      }
      unless ($smtp->ok()) {
        print STDERR UVmessage::get("SENDMAIL_SMTP_INVRCPT", (RCPT => $envelope)),
                     "\n", $smtp->code(), ' ', $smtp->message(), "\n";
        $errors++;
        next; 
      }
      unlink ($file) unless ($onefail);
    }

    $smtp->quit();
    close (CONTROL) or die "\n\n",
      UVmessage::get("SENDMAIL_ERRCLOSECONTROL", (FILE => $config{controlfile})), "\n";

    if ($errors) {
      print STDERR "\n".wrap('', '', "$errors ".UVmessage::get("SENDMAIL_ERROCCURED"))."\n\n";
    }

    if ($missingfiles) {
      print STDERR wrap('', '', "$missingfiles " .
                   UVmessage::get("SENDMAIL_MISSINGFILES")), "\n\n";
    }

  } else {

    foreach my $mail (@mailinfo) {
      next unless $mail;
      chomp($mail);
      my ($file, @rcpt) = split(/\s+/, $mail);
      open (DOMAIL, ">>$config{domailfile}");
      print DOMAIL "$config{mailcmd} ";
      foreach my $rcpt (@rcpt) {
        print DOMAIL "'$rcpt' ";
      }
      print DOMAIL "<$file && rm $file ; $config{sleepcmd}\n";
      close (DOMAIL)
        or print STDERR "\n\n", UVmessage::get("SENDMAIL_ERRCLOSEDOMAIL"), "\n";
    }
    chmod(0700, $config{domailfile});
    system($config{domailfile});

  }

  opendir (DIR, $config{tmpdir});
  my @files = grep (/^ack\.\d+/, readdir (DIR));
  closedir (DIR);
  return 0 if (@files);

  unlink $config{controlfile} or print STDERR "\n\n",
    UVmessage::get("SENDMAIL_ERRDELCONTROL", (FILE => $config{controlfile})), "\n";

  unless ($config{smtp}) {
    unlink $config{domailfile} or print STDERR "\n\n",
      UVmessage::get("SENDMAIL_ERRDELCONTROL", (FILE => $config{domailfile})), "\n";
  }

}


##############################################################################
# Encodes a string for use in mail headers                                   #
#                                                                            #
# Parameters: $text = string to encode.                                      #
# Returns:  $newtext = encoded string.                                       #
##############################################################################
 
sub mimeencode {
  my ($text) = @_;
  my @words = split(/ /, $text);
  my $line = '';
  my @lines;
 
  foreach my $word (@words) {
    my $sameword = 0;
    $word =~ s/\n//g;
    my $encword;
    if ($word =~ /[\x7F-\xFF]/) {
      $encword = MIME::Words::encode_mimeword($word, 'Q', 'ISO-8859-1');
    } elsif (length($word) > 75) {
      $encword = MIME::Words::encode_mimeword($word, 'Q', 'us-ascii');
    } else {
      $encword = $word;
    }
 
    # no more than 75 chars per line allowed
    if (length($encword) > 75) {
      while ($encword) {
        if ($encword =~ /(^=\?[-\w]+\?\w\?)(.{55}.*?)((=.{2}|[^=]{3}).*\?=)$/) {
          addword($1 . $2 . '?=', \$line, \@lines, $sameword);
          $encword = $1 . $3;
        } else {
          addword($encword, \$line, \@lines, $sameword);
          $encword = '';
        }
        $sameword = 1;
      }
    } else {
      addword($encword, \$line, \@lines, $sameword);
    }
  }
 
  my $delim = (@lines) ? ' ' : '';
  push(@lines, $delim . $line) if ($line);
  return join('', @lines);
}
 

##############################################################################
# Adds a word to a MIME encoded string, inserts linefeed if necessary        #
#                                                                            #
# Parameters:                                                                #
#   $word = word to add                                                      #
#   $line = current line                                                     #
#   $lines = complete text (without current line)                            #
#   $sameword = boolean switch, indicates that this is another part of       #
#               the last word (for encoded words > 75 chars)                 #
##############################################################################
 
sub addword {
  my ($word, $line, $lines, $sameword) = @_;
 
  # If the passed fragment is a new word (and not another part of the
  # previous): Check if it is MIME encoded
  if (!$sameword && $word =~ /^(=\?[^\?]+?\?[QqBb]\?)(.+\?=[^\?]*)$/) {
 
    # Word is encoded, save without the MIME header
    # (e.g. "t=E4st?=" instead of "?iso-8859-1?q?t=E4st?=")
    my $charset = $1;
    my $newword = $2;

    if ($$line =~ /^(=\?[^\?]+\?[QqBb]\?)(.+)\?=$/) {
      # Previous word was encoded, too:
      # Delete the trailing "?=" and insert an underline character (=space)
      # (space between to encoded words is ignored)
      if ($1 eq $charset) {
        if (length($1.$2)+length($newword)>75) {
          my $delim = (@$lines) ? ' ' : '';
          push(@$lines, "$delim$1$2_?=\n");
          $$line = $word;
        } else {
          $$line = $1 . $2 . '_' . $newword;
        }
      } else {
        if (length("$$line $word")>75) {
          my $delim = (@$lines) ? ' ' : '';
	  push(@$lines, "$delim$1$2_?=\n");
          $$line = $word;
	} else {
          $$line = "$1$2_?= $word";
	}
      }
      return 0;
    }
  }

  # New word is not encoded: simply append it, but check for line length
  # and add a newline if necessary
  if (length($$line) > 0) {
    if (length($$line) + length($word) >= 75) {
      my $delim = (@$lines) ? ' ' : '';
      push(@$lines, "$delim$$line\n");
      $$line = $word;
    } else {
      $$line .= " $word";
    }
  } else {
    # line is empty
    $$line = $word;
  }
}

1;
Commit	Line	Data
	1	# UVsendmail: functions for sending mails
	2	# Used by uvvote.pl, uvcfv.pl
	3
	4	package UVsendmail;
	5
	6	use strict;
	7	use UVconfig;
	8	use UVtemplate;
	9	use MIME::Words;
	10	use Text::Wrap qw(wrap $columns);
	11
	12	# Set columns for Text::Wrap
	13	$columns = $config{rightmargin};
	14
	15	use vars qw($VERSION);
	16
	17	# Module version
	18	$VERSION = "0.9";
	19
	20	my $num = 0;
	21
	22	##############################################################################
	23	# generation of acknowledge and error mails (don't sends them out yet) #
	24	# each mail is saved in a different file and a control file containing #
	25	# filename and envelope-to address is generated. #
	26	# Parameters: mail address, fixed part of subject and body of mail (strings) #
	27	##############################################################################
	28
	29	sub mail {
	30	my ($addr, $subject, $text, $reference, $replyto) = @_;
	31
	32	# address set?
	33	if ($addr) {
	34	# generate mail to sender
	35
	36	my $template = UVtemplate->new();
	37	$template->setKey('from' => mimeencode($config{mailfrom}));
	38	$template->setKey('subject' => mimeencode("$config{votename} - $subject"));
	39	$template->setKey('address' => $addr);
	40	$template->setKey('reference' => $reference) if ($reference);
	41	$template->setKey('reply-to' => $replyto) if ($replyto);
	42	$template->setKey('usevote-version' => $usevote_version);
	43
	44	my $message = $template->processTemplate($config{'tpl_mailheader'});
	45	$message .= "\n" . $text;
	46
	47	# get envelope-to addresses
	48	my $envaddr = $addr;
	49	$envaddr .= " $config{mailcc}" if ($config{mailcc});
	50
	51	my $mailfile = '';
	52
	53	# search for file names
	54	do {
	55	$num++;
	56	$mailfile = "$config{tmpdir}/ack.$num";
	57	} while (-e $mailfile);
	58
	59	# write mail in a file and append a line at the control file
	60
	61	open (CONTROL, ">>$config{controlfile}") or print STDERR "\n\n",
	62	UVmessage::get("SENDMAIL_ERROPENCONTROL", (FILE => $config{controlfile})), "\n";
	63	print CONTROL "$mailfile\t$envaddr\n";
	64	close (CONTROL) or print STDERR "\n\n",
	65	UVmessage::get("SENDMAIL_ERRCLOSECONTROL", (FILE => $config{controlfile})), "\n";
	66
	67	open (MAIL, ">$mailfile") or print STDERR "\n\n",
	68	UVmessage::get("SENDMAIL_ERROPENMAIL", (FILE => $config{controlfile})), "\n";
	69	print MAIL $message;
	70	close (MAIL) or print STDERR "\n\n",
	71	UVmessage::get("SENDMAIL_ERRCLOSEMAIL", (FILE => $config{controlfile})), "\n";
	72
	73	}
	74	}
	75
	76
	77	##############################################################################
	78	# Send previously generated acknowledge or error mails. #
	79	# Depending on configuration mails are piped to your MTA or send via SMTP. #
	80	##############################################################################
	81
	82	sub send {
	83	unless (-e $config{controlfile}) {
	84	print "\n", UVmessage::get("SENDMAIL_NOMAILS", (FILE => $config{controlfile})),
	85	"\n\n";
	86	return 0;
	87	}
	88
	89	open (CONTROL, "<$config{controlfile}") or die "\n\n",
	90	UVmessage::get("SENDMAIL_ERROPENCONTROL", (FILE => $config{controlfile})), "\n";
	91	my @mailinfo = <CONTROL>;
	92	close (CONTROL);
	93
	94	print UVmessage::get("SENDMAIL_SENDING"), "\n";
	95
	96	if ($config{smtp}) {
	97	# send mails via SMTP
	98	use Net::SMTP;
	99	my $smtp = Net::SMTP->new("$config{smtpserver}:$config{smtpport}",
	100	Hello => $config{smtphelo});
	101	die UVmessage::get("SENDMAIL_SMTP_CONNREFUSED") . "\n\n" unless ($smtp);
	102	if ($config{smtpauth}) {
	103	$smtp->auth($config{smtpuser}, $config{smtppass})
	104	or die UVmessage::get("SENDMAIL_SMTP_CONNREFUSED") . "\n" .
	105	$smtp->code() . ' ' . $smtp->message() . "\n";
	106	}
	107
	108	my $errors = 0;
	109	my $missingfiles = 0;
	110
	111	open (CONTROL, ">$config{controlfile}") or die "\n\n",
	112	UVmessage::get("SENDMAIL_ERROPENCONTROL", (FILE => $config{controlfile})), "\n";
	113
	114	foreach my $mail (@mailinfo) {
	115
	116	chomp ($mail);
	117	next unless $mail;
	118
	119	my ($file, $envelope) = split(/\t/, $mail);
	120	my $notfound = 0;
	121	open (MAIL, "<$file") or $notfound = 1;
	122	if ($notfound) {
	123	print STDERR UVmessage::get("SENDMAIL_ERRNOTFOUND") . "\n";
	124	$missingfiles++;
	125	next;
	126	}
	127	my $message = join('', <MAIL>);
	128	close (MAIL);
	129
	130	next unless $message;
	131
	132	$smtp->reset();
	133	$smtp->mail($config{envelopefrom});
	134	unless ($smtp->ok()) {
	135	print STDERR UVmessage::get("SENDMAIL_SMTP_INVRCPT", (RCPT => $envelope)),
	136	"\n", $smtp->code(), ' ', $smtp->message(), "\n";
	137	$errors++;
	138	next;
	139	}
	140
	141	my $onesent = 0;
	142	my $onefail = 0;
	143	foreach my $addr (split(/ +/, $envelope)) {
	144	$smtp->to($addr);
	145	if ($smtp->ok()) {
	146	$onesent = 1;
	147	} else {
	148	print CONTROL ($onefail ? " " : "$file\t");
	149	print CONTROL $addr;
	150	print STDERR UVmessage::get("SENDMAIL_SMTP_INVRCPT", (RCPT => $envelope)),
	151	"\n", $smtp->code(), ' ', $smtp->message(), "\n";
	152	$errors++;
	153	$onefail = 1;
	154	next;
	155	}
	156	}
	157
	158	print CONTROL "\n" if ($onefail);
	159	next unless $onesent;
	160
	161	$smtp->data();
	162	if ($smtp->ok()) {
	163	$smtp->datasend($message);
	164	$smtp->dataend();
	165	}
	166	unless ($smtp->ok()) {
	167	print STDERR UVmessage::get("SENDMAIL_SMTP_INVRCPT", (RCPT => $envelope)),
	168	"\n", $smtp->code(), ' ', $smtp->message(), "\n";
	169	$errors++;
	170	next;
	171	}
	172	unlink ($file) unless ($onefail);
	173	}
	174
	175	$smtp->quit();
	176	close (CONTROL) or die "\n\n",
	177	UVmessage::get("SENDMAIL_ERRCLOSECONTROL", (FILE => $config{controlfile})), "\n";
	178
	179	if ($errors) {
	180	print STDERR "\n".wrap('', '', "$errors ".UVmessage::get("SENDMAIL_ERROCCURED"))."\n\n";
	181	}
	182
	183	if ($missingfiles) {
	184	print STDERR wrap('', '', "$missingfiles " .
	185	UVmessage::get("SENDMAIL_MISSINGFILES")), "\n\n";
	186	}
	187
	188	} else {
	189
	190	foreach my $mail (@mailinfo) {
	191	next unless $mail;
	192	chomp($mail);
	193	my ($file, @rcpt) = split(/\s+/, $mail);
	194	open (DOMAIL, ">>$config{domailfile}");
	195	print DOMAIL "$config{mailcmd} ";
	196	foreach my $rcpt (@rcpt) {
	197	print DOMAIL "'$rcpt' ";
	198	}
	199	print DOMAIL "<$file && rm $file ; $config{sleepcmd}\n";
	200	close (DOMAIL)
	201	or print STDERR "\n\n", UVmessage::get("SENDMAIL_ERRCLOSEDOMAIL"), "\n";
	202	}
	203	chmod(0700, $config{domailfile});
	204	system($config{domailfile});
	205
	206	}
	207
	208	opendir (DIR, $config{tmpdir});
	209	my @files = grep (/^ack\.\d+/, readdir (DIR));
	210	closedir (DIR);
	211	return 0 if (@files);
	212
	213	unlink $config{controlfile} or print STDERR "\n\n",
	214	UVmessage::get("SENDMAIL_ERRDELCONTROL", (FILE => $config{controlfile})), "\n";
	215
	216	unless ($config{smtp}) {
	217	unlink $config{domailfile} or print STDERR "\n\n",
	218	UVmessage::get("SENDMAIL_ERRDELCONTROL", (FILE => $config{domailfile})), "\n";
	219	}
	220
	221	}
	222
	223
	224	##############################################################################
	225	# Encodes a string for use in mail headers #
	226	# #
	227	# Parameters: $text = string to encode. #
	228	# Returns: $newtext = encoded string. #
	229	##############################################################################
	230
	231	sub mimeencode {
	232	my ($text) = @_;
	233	my @words = split(/ /, $text);
	234	my $line = '';
	235	my @lines;
	236
	237	foreach my $word (@words) {
	238	my $sameword = 0;
	239	$word =~ s/\n//g;
	240	my $encword;
	241	if ($word =~ /[\x7F-\xFF]/) {
	242	$encword = MIME::Words::encode_mimeword($word, 'Q', 'ISO-8859-1');
	243	} elsif (length($word) > 75) {
	244	$encword = MIME::Words::encode_mimeword($word, 'Q', 'us-ascii');
	245	} else {
	246	$encword = $word;
	247	}
	248
	249	# no more than 75 chars per line allowed
	250	if (length($encword) > 75) {
	251	while ($encword) {
	252	if ($encword =~ /(^=\?[-\w]+\?\w\?)(.{55}.?)((=.{2}\|[^=]{3}).\?=)$/) {
	253	addword($1 . $2 . '?=', \$line, \@lines, $sameword);
	254	$encword = $1 . $3;
	255	} else {
	256	addword($encword, \$line, \@lines, $sameword);
	257	$encword = '';
	258	}
	259	$sameword = 1;
	260	}
	261	} else {
	262	addword($encword, \$line, \@lines, $sameword);
	263	}
	264	}
	265
	266	my $delim = (@lines) ? ' ' : '';
	267	push(@lines, $delim . $line) if ($line);
	268	return join('', @lines);
	269	}
	270
	271
	272	##############################################################################
	273	# Adds a word to a MIME encoded string, inserts linefeed if necessary #
	274	# #
	275	# Parameters: #
	276	# $word = word to add #
	277	# $line = current line #
	278	# $lines = complete text (without current line) #
	279	# $sameword = boolean switch, indicates that this is another part of #
	280	# the last word (for encoded words > 75 chars) #
	281	##############################################################################
	282
	283	sub addword {
	284	my ($word, $line, $lines, $sameword) = @_;
	285
	286	# If the passed fragment is a new word (and not another part of the
	287	# previous): Check if it is MIME encoded
	288	if (!$sameword && $word =~ /^(=\?[^\?]+?\?[QqBb]\?)(.+\?=[^\?]*)$/) {
	289
	290	# Word is encoded, save without the MIME header
	291	# (e.g. "t=E4st?=" instead of "?iso-8859-1?q?t=E4st?=")
	292	my $charset = $1;
	293	my $newword = $2;
	294
	295	if ($$line =~ /^(=\?[^\?]+\?[QqBb]\?)(.+)\?=$/) {
	296	# Previous word was encoded, too:
	297	# Delete the trailing "?=" and insert an underline character (=space)
	298	# (space between to encoded words is ignored)
	299	if ($1 eq $charset) {
	300	if (length($1.$2)+length($newword)>75) {
	301	my $delim = (@$lines) ? ' ' : '';
	302	push(@$lines, "$delim$1$2_?=\n");
	303	$$line = $word;
	304	} else {
	305	$$line = $1 . $2 . '_' . $newword;
	306	}
	307	} else {
	308	if (length("$$line $word")>75) {
	309	my $delim = (@$lines) ? ' ' : '';
	310	push(@$lines, "$delim$1$2_?=\n");
	311	$$line = $word;
	312	} else {
	313	$$line = "$1$2_?= $word";
	314	}
	315	}
	316	return 0;
	317	}
	318	}
	319
	320	# New word is not encoded: simply append it, but check for line length
	321	# and add a newline if necessary
	322	if (length($$line) > 0) {
	323	if (length($$line) + length($word) >= 75) {
	324	my $delim = (@$lines) ? ' ' : '';
	325	push(@$lines, "$delim$$line\n");
	326	$$line = $word;
	327	} else {
	328	$$line .= " $word";
	329	}
	330	} else {
	331	# line is empty
	332	$$line = $word;
	333	}
	334	}
	335
	336	1;