UVsendmail.pm

   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;