| 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; |