Commit | Line | Data |
---|---|---|
ac7e2c54 TH |
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; |