Add "bdsg_confirm" to UVconf.pm
[usenet/usevote.git] / 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;
This page took 0.018325 seconds and 3 git commands to generate.