Sharedwww / cgi-bin / openwebmail / openwebmail-send.plOpen in CoCalc
Author: William A. Stein
1
#!/usr/bin/perl
2
#
3
# openwebmail-send.pl - mail composing and sending program
4
#
5
6
use vars qw($SCRIPT_DIR);
7
if ( $0 =~ m!^(\S*)/[\w\d\-\.]+\.pl! ) { $SCRIPT_DIR=$1 }
8
if ($SCRIPT_DIR eq '' && open(F, '/etc/openwebmail/openwebmail_path.conf')) {
9
$_=<F>; close(F); if ( $_=~/^(\S*)/) { $SCRIPT_DIR=$1 }
10
}
11
if ($SCRIPT_DIR eq '') { print "Content-type: text/html\n\nSCRIPT_DIR not set in /etc/openwebmail/openwebmail_path.conf !\n"; exit 0; }
12
push (@INC, $SCRIPT_DIR);
13
14
foreach (qw(ENV BASH_ENV CDPATH IFS TERM)) {delete $ENV{$_}}; $ENV{PATH}='/bin:/usr/bin'; # secure ENV
15
umask(0002); # make sure the openwebmail group can write
16
17
use strict;
18
use Fcntl qw(:DEFAULT :flock);
19
use CGI qw(-private_tempfiles :standard);
20
use CGI::Carp qw(fatalsToBrowser carpout);
21
use MIME::Base64;
22
use MIME::QuotedPrint;
23
use Net::SMTP;
24
25
require "modules/dbm.pl";
26
require "modules/suid.pl";
27
require "modules/filelock.pl";
28
require "modules/tool.pl";
29
require "modules/datetime.pl";
30
require "modules/lang.pl";
31
require "modules/mime.pl";
32
require "modules/mailparse.pl";
33
require "modules/htmltext.pl";
34
require "modules/htmlrender.pl";
35
require "modules/enriched.pl";
36
require "modules/tnef.pl";
37
require "auth/auth.pl";
38
require "quota/quota.pl";
39
require "shares/ow-shared.pl";
40
require "shares/iconv.pl";
41
require "shares/maildb.pl";
42
require "shares/getmessage.pl";
43
require "shares/lockget.pl";
44
45
# common globals
46
use vars qw(%config %config_raw);
47
use vars qw($thissession);
48
use vars qw($loginname $logindomain $loginuser);
49
use vars qw($domain $user $userrealname $uuid $ugid $homedir);
50
use vars qw(%prefs %style %icontext);
51
use vars qw($quotausage $quotalimit);
52
53
# extern vars
54
use vars qw(%lang_folders %lang_sizes %lang_wdbutton %lang_text %lang_err
55
%lang_prioritylabels %lang_msgformatlabels); # defined in lang/xy
56
use vars qw(%charset_convlist); # defined in iconv.pl
57
use vars qw($_OFFSET $_FROM $_TO $_DATE $_SUBJECT $_CONTENT_TYPE $_STATUS
58
$_SIZE $_REFERENCES $_CHARSET $_HEADERSIZE $_HEADERCHKSUM); # defined in maildb.pl
59
60
# local globals
61
use vars qw($folder $messageid $mymessageid);
62
use vars qw($sort $page);
63
use vars qw($searchtype $keyword);
64
use vars qw($escapedfolder $escapedmessageid $escapedkeyword);
65
66
########## MAIN ##################################################
67
openwebmail_requestbegin();
68
$SIG{PIPE}=\&openwebmail_exit; # for user stop
69
$SIG{TERM}=\&openwebmail_exit; # for user stop
70
71
userenv_init();
72
73
if (!$config{'enable_webmail'}) {
74
openwebmailerror(__FILE__, __LINE__, "$lang_text{'webmail'} $lang_err{'access_denied'}");
75
}
76
77
$folder = param('folder') || 'INBOX';
78
$messageid = param('message_id')||''; # the orig message to reply/forward
79
$mymessageid = param('mymessageid')||''; # msg we are editing
80
$page = param('page') || 1;
81
$sort = param('sort') || $prefs{'sort'} || 'date';
82
$searchtype = param('searchtype') || 'subject';
83
$keyword = param('keyword') || '';
84
85
$escapedfolder = ow::tool::escapeURL($folder);
86
$escapedmessageid = ow::tool::escapeURL($messageid);
87
$escapedkeyword = ow::tool::escapeURL($keyword);
88
89
my $action = param('action')||'';
90
if ($action eq "replyreceipt") {
91
replyreceipt();
92
} elsif ($action eq "composemessage") {
93
composemessage();
94
} elsif ($action eq "sendmessage") {
95
sendmessage();
96
} else {
97
openwebmailerror(__FILE__, __LINE__, "Action $lang_err{'has_illegal_chars'}");
98
}
99
100
openwebmail_requestend();
101
########## END MAIN ##############################################
102
103
########## REPLYRECEIPT ##########################################
104
sub replyreceipt {
105
my $html='';
106
my ($folderfile, $folderdb)=get_folderpath_folderdb($user, $folder);
107
my @attr;
108
my %FDB;
109
110
ow::dbm::open(\%FDB, $folderdb, LOCK_SH) or
111
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_locksh'} $folderdb");
112
@attr=string2msgattr($FDB{$messageid});
113
ow::dbm::close(\%FDB, $folderdb);
114
115
if ($attr[$_SIZE]>0) {
116
my $header;
117
118
# get message header
119
open (FOLDER, "+<$folderfile") or
120
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $folderfile! ($!)");
121
seek (FOLDER, $attr[$_OFFSET], 0) or
122
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_seek'} $folderfile! ($!)");
123
$header="";
124
while (<FOLDER>) {
125
last if ($_ eq "\n" && $header=~/\n$/);
126
$header.=$_;
127
}
128
close(FOLDER);
129
130
# get notification-to
131
if ($header=~/^Disposition-Notification-To:\s?(.*?)$/im ) {
132
my $to=$1;
133
my $from=$prefs{'email'};
134
my $date=ow::datetime::dateserial2datefield(ow::datetime::gmtime2dateserial(), $prefs{'timeoffset'}, $prefs{'daylightsaving'});
135
my %userfrom=get_userfrom($logindomain, $loginuser, $user, $userrealname, dotpath('from.book'));
136
foreach (keys %userfrom) {
137
if ($header=~/$_/) {
138
$from=$_; last;
139
}
140
}
141
my $realname=$userfrom{$from};
142
$realname =~ s/['"]/ /g; # Get rid of shell escape attempts
143
$from =~ s/['"]/ /g; # Get rid of shell escape attempts
144
145
my @recipients=();
146
foreach (ow::tool::str2list($to,0)) {
147
my $addr=(ow::tool::email2nameaddr($_))[1];
148
next if ($addr eq "" || $addr=~/\s/);
149
push (@recipients, $addr);
150
}
151
152
$mymessageid=fakemessageid($from) if ($mymessageid eq '');
153
154
my $smtp;
155
my $timeout=120; $timeout=180 if ($#recipients>=1); # more than 1 recipient
156
$smtp=Net::SMTP->new($config{'smtpserver'},
157
Port => $config{'smtpport'},
158
Timeout => $timeout,
159
Hello => ${$config{'domainnames'}}[0]) or
160
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} SMTP server $config{'smtpserver'}:$config{'smtpport'}!");
161
162
# SMTP SASL authentication (PLAIN only)
163
if ($config{'smtpauth'}) {
164
my $auth = $smtp->supports("AUTH");
165
$smtp->auth($config{'smtpauth_username'}, $config{'smtpauth_password'}) or
166
openwebmailerror(__FILE__, __LINE__, "$lang_err{'network_server_error'}!<br>($config{'smtpserver'} - ".$smtp->message.")");
167
}
168
169
$smtp->mail($from);
170
my @ok=$smtp->recipient(@recipients, { SkipBad => 1 });
171
if ($#ok<0) {
172
$smtp->close();
173
openwebmailerror(__FILE__, __LINE__, "$lang_err{'sendmail_error'}!");
174
}
175
176
$smtp->data();
177
178
my $s;
179
180
if ($realname ne '') {
181
$s .= "From: ".ow::mime::encode_mimewords(qq|"$realname" <$from>|, ('Charset'=>$prefs{'charset'}))."\n";
182
} else {
183
$s .= "From: ".ow::mime::encode_mimewords(qq|$from|, ('Charset'=>$prefs{'charset'}))."\n";
184
}
185
$s .= "To: ".ow::mime::encode_mimewords($to, ('Charset'=>$prefs{'charset'}))."\n";
186
$s .= "Reply-To: ".ow::mime::encode_mimewords($prefs{'replyto'}, ('Charset'=>$prefs{'charset'}))."\n" if ($prefs{'replyto'});
187
188
# reply with english if sender has different charset than us
189
my $is_samecharset=0;
190
$is_samecharset=1 if ( $attr[$_CONTENT_TYPE]=~/charset="?\Q$prefs{'charset'}\E"?/i);
191
192
if ($is_samecharset) {
193
$s .= "Subject: ".ow::mime::encode_mimewords("$lang_text{'read'} - $attr[$_SUBJECT]",('Charset'=>$prefs{'charset'}))."\n";
194
} else {
195
$s .= "Subject: ".ow::mime::encode_mimewords("Read - $attr[$_SUBJECT]", ('Charset'=>$prefs{'charset'}))."\n";
196
}
197
$s .= "Date: $date\n".
198
"Message-Id: $mymessageid\n".
199
safexheaders($config{'xheaders'}).
200
"MIME-Version: 1.0\n";
201
if ($is_samecharset) {
202
$s .= "Content-Type: text/plain; charset=$prefs{'charset'}\n\n".
203
"$lang_text{'yourmsg'}\n\n".
204
" $lang_text{'to'}: $attr[$_TO]\n".
205
" $lang_text{'subject'}: $attr[$_SUBJECT]\n".
206
" $lang_text{'delivered'}: ".
207
ow::datetime::dateserial2str($attr[$_DATE],
208
$prefs{'timeoffset'}, $prefs{'daylightsaving'},
209
$prefs{'dateformat'}, $prefs{'hourformat'}).
210
"\n\n".
211
"$lang_text{'wasreadon1'} ".
212
ow::datetime::dateserial2str(ow::datetime::gmtime2dateserial(),
213
$prefs{'timeoffset'}, $prefs{'daylightsaving'},
214
$prefs{'dateformat'}, $prefs{'hourformat'}).
215
" $lang_text{'wasreadon2'}\n\n";
216
} else {
217
$s .= "Content-Type: text/plain; charset=iso-8859-1\n\n".
218
"Your message\n\n".
219
" To: $attr[$_TO]\n".
220
" Subject: $attr[$_SUBJECT]\n".
221
" Delivered: ".
222
ow::datetime::dateserial2str($attr[$_DATE],
223
$prefs{'timeoffset'}, $prefs{'daylightsaving'},
224
$prefs{'dateformat'}, $prefs{'hourformat'}).
225
"\n\n".
226
"was read on".
227
ow::datetime::dateserial2str(ow::datetime::gmtime2dateserial(),
228
$prefs{'timeoffset'}, $prefs{'daylightsaving'},
229
$prefs{'dateformat'}, $prefs{'hourformat'});
230
".\n\n";
231
}
232
$s .= str2str($config{'mailfooter'}, "text")."\n" if ($config{'mailfooter'}=~/[^\s]/);
233
234
if (!$smtp->datasend($s) || !$smtp->dataend()) {
235
$smtp->close();
236
openwebmailerror(__FILE__, __LINE__, "$lang_err{'sendmail_error'}!");
237
}
238
$smtp->quit();
239
}
240
241
# close the window that is processing confirm-reading-receipt
242
$html=qq|<script language="JavaScript">\n|.
243
qq|<!--\n|.
244
qq|window.close();\n|.
245
qq|//-->\n|.
246
qq|</script>\n|;
247
} else {
248
my $msgidstr = ow::htmltext::str2html($messageid);
249
$html="What the heck? Message $msgidstr seems to be gone!";
250
}
251
httpprint([], [htmlheader(), $html, htmlfooter(1)]);
252
}
253
########## END REPLYRECEIPT ######################################
254
255
########## COMPOSEMESSAGE ########################################
256
# 9 composetype: reply, replyall, forward, editdraft,
257
# forwardasorig (resent to another with exactly same msg),
258
# forwardasatt (orig msg as an att),
259
# continue(used after adding attachment),
260
# sendto(newmail with dest user),
261
# none(newmail)
262
use vars qw($_htmlarea_css_cache);
263
sub composemessage {
264
my %message;
265
my $attnumber;
266
my $from ='';
267
my $to = param('to') || '';
268
my $cc = param('cc') || '';
269
my $bcc = param('bcc') || '';
270
my $replyto = param('replyto') || '';
271
my $subject = param('subject') || '';
272
my $body = param('body') || '';
273
my $inreplyto = param('inreplyto') || '';
274
my $references = param('references') || '';
275
my $priority = param('priority') || 'normal'; # normal/urgent/non-urgent
276
my $statname = param('statname') || '';
277
my $composetype = param('composetype')||'';
278
279
my @forwardids=();
280
if ($composetype eq 'forwardids' || $composetype eq 'forwardids_delete') {
281
# parameter passed with file from openwebmail-main.pl
282
open (FORWARDIDS, "$config{'ow_sessionsdir'}/$thissession-forwardids");
283
while(<FORWARDIDS>) {
284
chomp(); push(@forwardids, $_);
285
}
286
close(FORWARDIDS);
287
unlink("$config{'ow_sessionsdir'}/$thissession-forwardids");
288
}
289
290
my %userfrom=get_userfrom($logindomain, $loginuser, $user, $userrealname, dotpath('from.book'));
291
if ( defined(param('from')) ) {
292
$from=param('from')||'';
293
} elsif ($userfrom{$prefs{'email'}} ne "") {
294
$from=qq|"$userfrom{$prefs{'email'}}" <$prefs{'email'}>|;
295
} else {
296
$from=qq|$prefs{'email'}|;
297
}
298
299
# msgformat is text, html or both
300
my $msgformat = param('msgformat') || $prefs{'msgformat'} || 'text';
301
my $newmsgformat = param('newmsgformat') || $msgformat;
302
if (!htmlarea_compatible()) {
303
$msgformat = $newmsgformat = 'text';
304
}
305
306
# composecharset is the charset choosed by user for current composing
307
my $composecharset= $prefs{'charset'};
308
foreach (values %ow::lang::languagecharsets, keys %charset_convlist) {
309
if ($_ eq param('composecharset')) {
310
$composecharset=$_; last;
311
}
312
}
313
314
# convfrom is the charset choosed by user in last reading message
315
my $convfrom=param('convfrom')||'';
316
if ($convfrom =~/^none\.(.*)$/) {
317
my $cf=$1;
318
foreach (values %ow::lang::languagecharsets) {
319
if ($_ eq $cf) {
320
$composecharset=$_; last;
321
}
322
}
323
}
324
325
326
my ($attfiles_totalsize, $r_attfiles);
327
if ( param('deleteattfile') ne '' ) { # user click 'del' link
328
my $deleteattfile=param('deleteattfile');
329
330
$deleteattfile =~ s/\///g; # just in case someone gets tricky ...
331
$deleteattfile=ow::tool::untaint($deleteattfile);
332
# only allow to delete attfiles belongs the $thissession
333
if ($deleteattfile=~/^\Q$thissession\E/) {
334
unlink ("$config{'ow_sessionsdir'}/$deleteattfile");
335
}
336
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
337
338
} elsif (defined(param('addbutton')) || # user press 'add' button
339
param('webdisksel') ) { # file selected from webdisk
340
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
341
342
no strict 'refs'; # for $attchment, which is fname and fhandle of the upload
343
344
my $attachment = param('attachment') ||'';
345
my $webdisksel = param('webdisksel') ||'';
346
my ($attname, $attcontenttype);
347
if ($webdisksel || $attachment) {
348
if ($attachment) {
349
# Convert :: back to the ' like it should be.
350
$attname = $attachment;
351
$attname =~ s/::/'/g;
352
# Trim the path info from the filename
353
if ($composecharset eq 'big5' || $composecharset eq 'gb2312') {
354
$attname = ow::tool::zh_dospath2fname($attname); # dos path
355
} else {
356
$attname =~ s|^.*\\||; # dos path
357
}
358
$attname =~ s|^.*/||; # unix path
359
$attname =~ s|^.*:||; # mac path and dos drive
360
361
if (defined(uploadInfo($attachment))) {
362
# my %info=%{uploadInfo($attachment)};
363
$attcontenttype = ${uploadInfo($attachment)}{'Content-Type'} || 'application/octet-stream';
364
} else {
365
$attcontenttype = 'application/octet-stream';
366
}
367
368
} elsif ($webdisksel && $config{'enable_webdisk'}) {
369
my $webdiskrootdir=ow::tool::untaint($homedir.absolute_vpath("/", $config{'webdisk_rootpath'}));
370
my $vpath=absolute_vpath('/', $webdisksel);
371
my $err=verify_vpath($webdiskrootdir, $vpath);
372
openwebmailerror(__FILE__, __LINE__, $err) if ($err);
373
openwebmailerror(__FILE__, __LINE__, "$lang_text{'file'} $vpath $lang_err{'doesnt_exist'}") if (!-f "$webdiskrootdir/$vpath");
374
375
$attachment=do { local *FH };
376
open($attachment, "$webdiskrootdir/$vpath") or
377
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $lang_text{'webdisk'} $vpath! ($!)");
378
$attname=$vpath; $attname=~s|/$||; $attname=~s|^.*/||;
379
$attcontenttype=ow::tool::ext2contenttype($vpath);
380
}
381
382
if ($attachment) {
383
if ( ($config{'attlimit'}) &&
384
( ($attfiles_totalsize + (-s $attachment)) > ($config{'attlimit'}*1024) ) ) {
385
close($attachment);
386
openwebmailerror(__FILE__, __LINE__, "$lang_err{'att_overlimit'} $config{'attlimit'} $lang_sizes{'kb'}!");
387
}
388
my $attserial = time();
389
open (ATTFILE, ">$config{'ow_sessionsdir'}/$thissession-att$attserial");
390
print ATTFILE qq|Content-Type: $attcontenttype;\n|.
391
qq|\tname="|.ow::mime::encode_mimewords($attname, ('Charset'=>$composecharset)).qq|"\n|.
392
qq|Content-Id: <att$attserial>\n|.
393
qq|Content-Disposition: attachment; filename="|.ow::mime::encode_mimewords($attname, ('Charset'=>$composecharset)).qq|"\n|.
394
qq|Content-Transfer-Encoding: base64\n\n|;
395
my ($buff, $attsize);
396
while (read($attachment, $buff, 400*57)) {
397
$buff=encode_base64($buff);
398
$attsize += length($buff);
399
print ATTFILE $buff;
400
}
401
close ATTFILE;
402
close($attachment); # close tmpfile created by CGI.pm
403
404
push(@{$r_attfiles}, { 'content-id' => "att$attserial",
405
name => $attname,
406
namecharset => $composecharset,
407
file => "$thissession-att$attserial",
408
size => $attsize} );
409
$attfiles_totalsize+=$attsize;
410
}
411
}
412
413
# usr press 'send' button but no receiver, keep editing
414
} elsif ( defined(param('sendbutton')) &&
415
param('to') eq '' && param('cc') eq '' && param('bcc') eq '' ) {
416
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
417
418
} elsif ($newmsgformat ne $msgformat) { # chnage msg format between text & html
419
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
420
421
} elsif (param('convto') ne "") {
422
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
423
424
} else { # this is new message, remove previous aged attachments
425
deleteattachments();
426
}
427
428
if ($composetype eq "reply" || $composetype eq "replyall" ||
429
$composetype eq "forward" || $composetype eq "forwardasorig" ||
430
$composetype eq "editdraft" ) {
431
if ($composetype eq "forward" || $composetype eq "forwardasorig" ||
432
$composetype eq "editdraft") {
433
%message = %{&getmessage($user, $folder, $messageid, "all")};
434
} else {
435
%message = %{&getmessage($user, $folder, $messageid, "")};
436
}
437
438
# make the $body(text version) $bodyhtml(html version) for new mesage
439
# from original mesage for different contenttype
440
441
# we try to reserve the bdy in its original format so no info would be lost
442
# if user browser is compatible with htmlarea for html msg composing
443
my $bodyformat='text'; # text or html
444
445
# handle the messages generated if sendmail is set up to send MIME error reports
446
if ($message{'content-type'} =~ /^multipart\/report/i) {
447
foreach my $attnumber (0 .. $#{$message{attachment}}) {
448
if (defined(${${$message{attachment}[$attnumber]}{r_content}})) {
449
$body .= ${${$message{attachment}[$attnumber]}{r_content}};
450
shift @{$message{attachment}};
451
}
452
}
453
} elsif ($message{'content-type'} =~ /^multipart/i) {
454
# If the first attachment is text,
455
# assume it's the body of a message in multi-part format
456
if ( defined(%{$message{attachment}[0]}) &&
457
${$message{attachment}[0]}{'content-type'} =~ /^text/i ) {
458
if (${$message{attachment}[0]}{'content-transfer-encoding'} =~ /^quoted-printable/i) {
459
$body = decode_qp(${${$message{attachment}[0]}{r_content}});
460
} elsif (${$message{attachment}[0]}{'content-transfer-encoding'} =~ /^base64/i) {
461
$body = decode_base64(${${$message{attachment}[0]}{r_content}});
462
} elsif (${$message{attachment}[0]}{'content-transfer-encoding'} =~ /^x-uuencode/i) {
463
$body = ow::mime::uudecode(${${$message{attachment}[0]}{r_content}});
464
} else {
465
$body = ${${$message{attachment}[0]}{r_content}};
466
}
467
if (${$message{attachment}[0]}{'content-type'} =~ /^text\/html/i) {
468
$bodyformat='html';
469
} elsif (${$message{attachment}[0]}{'content-type'} =~ /^text\/enriched/i) {
470
$body= ow::enriched::enriched2html($body);
471
$bodyformat='html';
472
}
473
474
# handle mail with both text and html version
475
# rename html to other name so if user in text compose mode,
476
# the modified/forwarded text won't be overridden by html again
477
if ( defined(%{$message{attachment}[1]}) &&
478
${$message{attachment}[1]}{boundary} eq ${$message{attachment}[0]}{boundary} ) {
479
# rename html attachment in the same alternative group
480
if ( (${$message{attachment}[0]}{subtype}=~/alternative/i &&
481
${$message{attachment}[1]}{subtype}=~/alternative/i &&
482
${$message{attachment}[1]}{'content-type'}=~/^text/i &&
483
${$message{attachment}[1]}{filename}=~/^Unknown\./ ) ||
484
# rename next if this=unknow.txt and next=unknow.html
485
(${$message{attachment}[0]}{'content-type'}=~/^text\/(?:plain|enriched)/i &&
486
${$message{attachment}[0]}{filename}=~/^Unknown\./ &&
487
${$message{attachment}[1]}{'content-type'}=~/^text\/(?:html|enriched)/i &&
488
${$message{attachment}[1]}{filename}=~/^Unknown\./ ) ) {
489
if ($msgformat ne 'text' && $bodyformat eq 'text' ) {
490
if (${$message{attachment}[1]}{'content-transfer-encoding'} =~ /^quoted-printable/i) {
491
$body = decode_qp(${${$message{attachment}[1]}{r_content}});
492
} elsif (${$message{attachment}[1]}{'content-transfer-encoding'} =~ /^base64/i) {
493
$body = decode_base64(${${$message{attachment}[1]}{r_content}});
494
} elsif (${$message{attachment}[0]}{'content-transfer-encoding'} =~ /^x-uuencode/i) {
495
$body = ow::mime::uudecode(${${$message{attachment}[1]}{r_content}});
496
} else {
497
$body = ${${$message{attachment}[1]}{r_content}};
498
}
499
if (${$message{attachment}[1]}{'content-type'}=~/^text\/enriched/i) {
500
$body=ow::enriched::enriched2html($body);
501
}
502
$bodyformat='html';
503
# remove 1 attachment from the message's attachemnt list for html
504
shift @{$message{attachment}};
505
} else {
506
${$message{attachment}[1]}{filename}=~s/^Unknown/Original/;
507
${$message{attachment}[1]}{header}=~s!^Content-Type: \s*text/(?:html|enriched);!Content-Type: text/$1;\n name="OriginalMsg.htm";!i;
508
}
509
}
510
}
511
# remove 1 attachment from the message's attachemnt list for text
512
shift @{$message{attachment}};
513
} else {
514
$body = '';
515
}
516
} else {
517
$body = $message{'body'} || '';
518
# handle mail programs that send the body encoded
519
if ($message{'content-type'} =~ /^text/i) {
520
if ($message{'content-transfer-encoding'} =~ /^quoted-printable/i) {
521
$body= decode_qp($body);
522
} elsif ($message{'content-transfer-encoding'} =~ /^base64/i) {
523
$body= decode_base64($body);
524
} elsif ($message{'content-transfer-encoding'} =~ /^x-uuencode/i) {
525
$body= ow::mime::uudecode($body);
526
}
527
}
528
if ($message{'content-type'} =~ /^text\/html/i) {
529
$bodyformat='html';
530
} elsif ($message{'content-type'} =~ /^text\/enriched/i) {
531
$body= ow::enriched::enriched2html($body);
532
$bodyformat='html';
533
}
534
}
535
536
# carry attachments from old mesage to the new one
537
if ($composetype eq "forward" || $composetype eq "forwardasorig" ||
538
$composetype eq "editdraft") {
539
if (defined(${$message{attachment}[0]}{header})) {
540
my $attserial=time(); $attserial=ow::tool::untaint($attserial);
541
foreach my $attnumber (0 .. $#{$message{attachment}}) {
542
my $r_attachment=$message{attachment}[$attnumber];
543
$attserial++;
544
if (${$r_attachment}{header} ne "" &&
545
defined(${$r_attachment}{r_content}) ) {
546
my ($attheader, $r_content)=(${$r_attachment}{header}, ${$r_attachment}{r_content});
547
548
if (${$r_attachment}{'content-type'}=~/^application\/ms\-tnef/i) {
549
my ($arc_attheader, $arc_r_content)=tnefatt2archive($r_attachment, $convfrom, $composecharset);
550
($attheader, $r_content)=($arc_attheader, $arc_r_content) if ($arc_attheader ne '');
551
}
552
open (ATTFILE, ">$config{'ow_sessionsdir'}/$thissession-att$attserial") or
553
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}/$thissession-att$attserial! ($!)");
554
print ATTFILE $attheader, "\n", ${$r_content};
555
close ATTFILE;
556
}
557
}
558
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
559
}
560
}
561
562
if ($bodyformat eq 'html') {
563
$body = ow::htmlrender::html4nobase($body);
564
if ($composetype ne "editdraft" && $composetype ne "forwardasorig") {
565
$body = ow::htmlrender::html4disablejs($body) if ($prefs{'disablejs'});
566
$body = ow::htmlrender::html4disableembcode($body) if ($prefs{'disableembcode'});
567
$body = ow::htmlrender::html4disableemblink($body, $prefs{'disableemblink'}, "$config{'ow_htmlurl'}/images/backgrounds/Transparent.gif") if ($prefs{'disableemblink'} ne 'none');
568
}
569
$body = ow::htmlrender::html4attfiles($body, $r_attfiles, "$config{'ow_cgiurl'}/openwebmail-viewatt.pl", "action=viewattfile&amp;sessionid=$thissession");
570
$body = ow::htmlrender::html2block($body);
571
}
572
573
if ($msgformat eq 'auto') {
574
$msgformat=$bodyformat;
575
$msgformat='both' if ($msgformat eq 'html');
576
577
my $showhtmlastext=$prefs{'showhtmlastext'};
578
$showhtmlastext=param('showhtmlastext') if (defined(param('showhtmlastext')));
579
$msgformat='text' if ($showhtmlastext);
580
}
581
582
if ($bodyformat eq 'text' && $msgformat ne 'text') {
583
$body=ow::htmltext::text2html($body);
584
} elsif ($bodyformat ne 'text' && $msgformat eq 'text') {
585
$body=ow::htmltext::html2text($body);
586
}
587
588
my $fromemail=$prefs{'email'};
589
foreach (keys %userfrom) {
590
if ($composetype eq "editdraft") {
591
if ($message{'from'}=~/$_/) {
592
$fromemail=$_; last;
593
}
594
} else { # reply/replyall/forward/forwardasatt/forwardasorig
595
if ($message{'to'}=~/$_/ || $message{'cc'}=~/$_/ ) {
596
$fromemail=$_; last;
597
}
598
}
599
}
600
if ($userfrom{$fromemail} ne '') {
601
$from=qq|"$userfrom{$fromemail}" <$fromemail>|;
602
} else {
603
$from=qq|$fromemail|;
604
}
605
606
607
if ($composetype eq "reply" || $composetype eq "replyall") {
608
$subject = $message{'subject'} || '';
609
$subject = "Re: " . $subject unless ($subject =~ /^re:/i);
610
if (defined($message{'reply-to'}) && $message{'reply-to'}=~/[^\s]/) {
611
$to = $message{'reply-to'} || '';
612
} else {
613
$to = $message{'from'} || '';
614
}
615
616
if ($composetype eq "replyall") {
617
my $toaddr=(ow::tool::email2nameaddr($to))[1];
618
my @recv=();
619
foreach my $email (ow::tool::str2list($message{'to'},0)) {
620
my $addr=(ow::tool::email2nameaddr($email))[1];
621
next if ($addr eq $fromemail || $addr eq $toaddr ||
622
$addr=~/^\s*$/ || $addr=~/undisclosed\-recipients:\s?;?/i );
623
push(@recv, $email);
624
}
625
$to .= "," . join(',', @recv) if ($#recv>=0);
626
627
@recv=();
628
foreach my $email (ow::tool::str2list($message{'cc'},0)) {
629
my $addr=(ow::tool::email2nameaddr($email))[1];
630
next if ($addr eq $fromemail || $addr eq $toaddr ||
631
$addr=~/^\s*$/ || $addr=~/undisclosed\-recipients:\s?;?/i );
632
push(@recv, $email);
633
}
634
$cc = join(',', @recv) if ($#recv>=0);
635
}
636
637
if ($msgformat eq 'text') {
638
# reparagraph orig msg for better look in compose window
639
$body=reparagraph($body, $prefs{'editcolumns'}-8) if ($prefs{'reparagraphorigmsg'});
640
# remove odds space or blank lines from body
641
$body =~ s/(?: *\r?\n){2,}/\n\n/g;
642
$body =~ s/^\s+//; $body =~ s/\s+$//;
643
$body =~ s/\n/\n\> /g; $body = "> ".$body if ($body =~ /[^\s]/);
644
} else {
645
# remove all reference to inline attachments
646
# because we don't carry them from original message when replying
647
$body=~s/<[^\<\>]*?(?:background|src)\s*=[^\<\>]*?cid:[^\<\>]*?>//sig;
648
649
# replace <p> with <br> to strip blank lines
650
$body =~ s!<(?:p|p [^\<\>]*?)>!<br>!gi; $body =~ s!</p>!!gi;
651
652
# replace <div> with <br> to strip layer and add blank lines
653
$body =~ s!<(?:div|div [^\<\>]*?)>!<br>!gi; $body =~ s!</div>!!gi;
654
655
$body =~ s!<br ?/?>(?:\s*<br ?/?>)+!<br><br>!gis;
656
$body =~ s!^(?:\s*<br ?/?>)*!!gi; $body =~ s!(?:<br ?/?>\s*)*$!!gi;
657
$body =~ s!(<br ?/?>|<div>|<div [^\<\>]*?>)!$1&gt; !gis; $body = '&gt; '.$body;
658
}
659
660
if ($prefs{replywithorigmsg} eq 'at_beginning') {
661
my $h="On $message{'date'}, ".(ow::tool::email2nameaddr($message{'from'}))[0]." wrote";
662
if ($msgformat eq 'text') {
663
$body = $h."\n".$body if ($body=~/[^\s]/);
664
} else {
665
$body = '<b>'.ow::htmltext::text2html($h).'</b><br>'.$body;
666
}
667
} elsif ($prefs{replywithorigmsg} eq 'at_end') {
668
my $h="From: $message{'from'}\n".
669
"To: $message{'to'}\n";
670
$h .= "Cc: $message{'cc'}\n" if ($message{'cc'} ne "");
671
$h .= "Sent: $message{'date'}\n".
672
"Subject: $message{'subject'}\n";
673
if ($msgformat eq 'text') {
674
$body = "---------- Original Message -----------\n".
675
"$h\n$body\n".
676
"------- End of Original Message -------\n";
677
} else {
678
$body = "<b>---------- Original Message -----------</b><br>\n".
679
ow::htmltext::text2html($h)."<br>$body<br>".
680
"<b>------- End of Original Message -------</b><br>\n";
681
}
682
}
683
684
if (is_convertable($convfrom, $composecharset) ) {
685
($body, $subject, $to, $cc)=iconv($convfrom, $composecharset, $body,$subject,$to,$cc);
686
}
687
688
$replyto = $prefs{'replyto'} if (defined($prefs{'replyto'}));
689
$inreplyto = $message{'message-id'};
690
if ( $message{'references'} ne "" ) {
691
$references = $message{'references'}." ".$message{'message-id'};
692
} elsif ( $message{'in-reply-to'} ne "" ) {
693
$references = $message{'in-reply-to'}." ".$message{'message-id'};
694
} else {
695
$references = $message{'message-id'};
696
}
697
698
my $origbody=$body;
699
700
my $stationery;
701
if ($config{'enable_stationery'} && $statname ne '') {
702
my $statbookfile=dotpath('stationery.book');
703
my ($name,$content,%stationery);
704
if ( -f $statbookfile ) {
705
open (STATBOOK, $statbookfile) or
706
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $statbookfile! ($!)");
707
while (<STATBOOK>) {
708
($name, $content) = split(/\@\@\@/, $_, 2);
709
chomp($name); chomp($content);
710
$stationery{ow::tool::escapeURL($name)} = ow::tool::unescapeURL($content);
711
}
712
close (STATBOOK) or openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_close'} $statbookfile! ($!)");
713
}
714
$stationery = $stationery{$statname};
715
}
716
717
my $n="\n"; $n="<br>" if ($msgformat ne 'text');
718
if ($stationery=~/[^\s]/) {
719
$body = str2str($stationery, $msgformat).$n;
720
} else {
721
$body = $n.$n;
722
}
723
$body.= str2str($prefs{'signature'}, $msgformat).$n if ($prefs{'signature'}=~/[^\s]/);
724
725
if ($prefs{replywithorigmsg} eq 'at_beginning') {
726
$body = $origbody.$n.$body;
727
} elsif ($prefs{replywithorigmsg} eq 'at_end') {
728
$body = $body.$n.$origbody;
729
}
730
731
} elsif ($composetype eq "forward") {
732
$subject = $message{'subject'} || '';
733
$subject = "Fw: " . $subject unless ($subject =~ /^fw:/i);
734
735
my $h="From: $message{'from'}\n".
736
"To: $message{'to'}\n";
737
$h .= "Cc: $message{'cc'}\n" if ($message{'cc'} ne "");
738
$h .= "Sent: $message{'date'}\n".
739
"Subject: $message{'subject'}\n";
740
741
if ($msgformat eq 'text') {
742
# remove odds space or blank lines from body
743
$body =~ s/( *\r?\n){2,}/\n\n/g; $body =~ s/^\s+//; $body =~ s/\s+$//;
744
$body = "\n".
745
"---------- Forwarded Message -----------\n".
746
"$h\n$body\n".
747
"------- End of Forwarded Message -------\n";
748
} else {
749
$body =~ s/<br>(\s*<br>)+/<br><br>/gis;
750
$body = "<br>\n".
751
"<b>---------- Forwarded Message -----------</b><br>\n".
752
ow::htmltext::text2html($h)."<br>$body<br>".
753
"<b>------- End of Forwarded Message -------</b><br>\n";
754
}
755
756
if (is_convertable($convfrom, $composecharset) ) {
757
($body, $subject)=iconv($convfrom, $composecharset, $body,$subject);
758
}
759
760
my $n="\n"; $n="<br>" if ($msgformat ne 'text');
761
$body .= $n.$n;
762
$body .= str2str($prefs{'signature'}, $msgformat).$n if ($prefs{'signature'}=~/[^\s]/);
763
764
$replyto = $prefs{'replyto'} if (defined($prefs{'replyto'}));
765
$inreplyto = $message{'message-id'};
766
if ( $message{'references'} ne "" ) {
767
$references = $message{'references'}." ".$message{'message-id'};
768
} elsif ( $message{'in-reply-to'} ne "" ) {
769
$references = $message{'in-reply-to'}." ".$message{'message-id'};
770
} else {
771
$references = $message{'message-id'};
772
}
773
774
} elsif ($composetype eq "forwardasorig") {
775
$subject = $message{'subject'} || '';
776
$replyto = $message{'from'};
777
if (is_convertable($convfrom, $composecharset) ) {
778
($body, $subject, $replyto)=iconv($convfrom, $composecharset, $body,$subject,$replyto);
779
}
780
781
$references = $message{'references'};
782
$priority = $message{'priority'} if (defined($message{'priority'}));
783
784
# remove odds space or blank lines from body
785
if ($msgformat eq 'text') {
786
$body =~ s/( *\r?\n){2,}/\n\n/g; $body =~ s/^\s+//; $body =~ s/\s+$//;
787
} else {
788
$body =~ s/<br>(\s*<br>)+/<br><br>/gis;
789
}
790
791
} elsif ($composetype eq "editdraft") {
792
$subject = $message{'subject'} || '';
793
$to = $message{'to'} if (defined($message{'to'}));
794
$cc = $message{'cc'} if (defined($message{'cc'}));
795
$bcc = $message{'bcc'} if (defined($message{'bcc'}));
796
$replyto = $message{'reply-to'} if (defined($message{'reply-to'}));
797
if (is_convertable($convfrom, $composecharset) ) {
798
($body, $subject, $to, $cc, $bcc, $replyto)=iconv($convfrom, $composecharset, $body,$subject,$to,$cc,$bcc,$replyto);
799
}
800
801
$inreplyto = $message{'in-reply-to'};
802
$references = $message{'references'};
803
$priority = $message{'priority'} if (defined($message{'priority'}));
804
$replyto = $prefs{'replyto'} if ($replyto eq '' && defined($prefs{'replyto'}));
805
806
# we prefer to use the messageid in a draft message if available
807
$mymessageid = $messageid if ($messageid);
808
}
809
810
} elsif ($composetype eq 'forwardasatt') {
811
$msgformat='text' if ($msgformat eq 'auto');
812
813
my ($folderfile, $folderdb)=get_folderpath_folderdb($user, $folder);
814
ow::filelock::lock($folderfile, LOCK_SH|LOCK_NB) or
815
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_locksh'} $folderfile!");
816
if (update_folderindex($folderfile, $folderdb)<0) {
817
ow::filelock::lock($folderfile, LOCK_UN);
818
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_updatedb'} $folderdb");
819
}
820
821
my @attr=get_message_attributes($messageid, $folderdb);
822
openwebmailerror(__FILE__, __LINE__, "$folderdb $messageid $lang_err{'doesnt_exist'}") if ($#attr<0);
823
824
my $fromemail=$prefs{'email'};
825
foreach (keys %userfrom) {
826
if ($attr[$_TO]=~/$_/) {
827
$fromemail=$_; last;
828
}
829
}
830
if ($userfrom{$fromemail} ne '') {
831
$from=qq|"$userfrom{$fromemail}" <$fromemail>|;
832
} else {
833
$from=qq|$fromemail|;
834
}
835
836
open(FOLDER, "$folderfile");
837
my $attserial=time(); $attserial=ow::tool::untaint($attserial);
838
open (ATTFILE, ">$config{'ow_sessionsdir'}/$thissession-att$attserial") or
839
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}/$thissession-att$attserial! ($!)");
840
print ATTFILE qq|Content-Type: message/rfc822;\n|,
841
qq|Content-Transfer-Encoding: 8bit\n|,
842
qq|Content-Disposition: attachment; filename="Forward.msg"\n|,
843
qq|Content-Description: $attr[$_SUBJECT]\n\n|;
844
845
# copy message to be forwarded
846
my $left=$attr[$_SIZE];
847
seek(FOLDER, $attr[$_OFFSET], 0);
848
849
# do not copy 1st line if it is the 'From ' delimiter
850
$_ = <FOLDER>; print ATTFILE $_ if (!/^From /); $left-=length($_);
851
852
# copy other lines with the 'From ' delimiter escaped
853
while ($left>0) {
854
$_ = <FOLDER>; s/^From />From /;
855
print ATTFILE $_; $left-=length($_);
856
}
857
858
close(ATTFILE);
859
close(FOLDER);
860
861
ow::filelock::lock($folderfile, LOCK_UN);
862
863
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
864
865
$subject = $attr[$_SUBJECT];
866
$subject = "Fw: " . $subject unless ($subject =~ /^fw:/i);
867
if (is_convertable($attr[$_CHARSET], $composecharset) ) {
868
($subject)=iconv($attr[$_CHARSET], $composecharset, $subject);
869
}
870
871
$inreplyto = $message{'message-id'};
872
if ( $message{'references'} ne "" ) {
873
$references = $message{'references'}." ".$message{'message-id'};
874
} elsif ( $message{'in-reply-to'} ne "" ) {
875
$references = $message{'in-reply-to'}." ".$message{'message-id'};
876
} else {
877
$references = $message{'message-id'};
878
}
879
$replyto = $prefs{'replyto'} if (defined($prefs{'replyto'}));
880
881
my $n="\n"; $n="<br>" if ($msgformat ne 'text');
882
$body = $n."# Message forwarded as attachment".$n.$n;
883
$body .= str2str($prefs{'signature'}, $msgformat).$n if ($prefs{'signature'}=~/[^\s]/);
884
885
} elsif ($composetype eq 'forwardids' || $composetype eq 'forwardids_delete') {
886
$msgformat='text' if ($msgformat eq 'auto');
887
888
my ($folderfile, $folderdb)=get_folderpath_folderdb($user, $folder);
889
ow::filelock::lock($folderfile, LOCK_SH|LOCK_NB) or
890
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_locksh'} $folderfile!");
891
892
if (update_folderindex($folderfile, $folderdb)<0) {
893
ow::filelock::lock($folderfile, LOCK_UN);
894
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_updatedb'} $folderdb");
895
}
896
897
open(FOLDER, "$folderfile");
898
my $attserial=time(); $attserial=ow::tool::untaint($attserial);
899
for (my $i=0; $i<=$#forwardids; $i++) {
900
$attserial++;
901
my @attr=get_message_attributes($forwardids[$i], $folderdb);
902
open (ATTFILE, ">$config{'ow_sessionsdir'}/$thissession-att$attserial") or
903
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}/$thissession-att$attserial! ($!)");
904
print ATTFILE qq|Content-Type: message/rfc822;\n|,
905
qq|Content-Transfer-Encoding: 8bit\n|,
906
qq|Content-Disposition: attachment; filename="Forward$i.msg"\n|,
907
qq|Content-Description: $attr[$_SUBJECT]\n\n|;
908
909
# copy message to be forwarded
910
my $left=$attr[$_SIZE];
911
seek(FOLDER, $attr[$_OFFSET], 0);
912
913
# do not copy 1st line if it is the 'From ' delimiter
914
$_ = <FOLDER>; print ATTFILE $_ if (!/^From /); $left-=length($_);
915
916
# copy other lines with the 'From ' delimiter escaped
917
while ($left>0) {
918
$_ = <FOLDER>; s/^From />From /;
919
print ATTFILE $_; $left-=length($_);
920
}
921
922
close(ATTFILE);
923
}
924
close(FOLDER);
925
926
# delete the forwarded messages if required
927
if ($composetype eq 'forwardids_delete') {
928
my $deleted=operate_message_with_ids('delete', \@forwardids, $folderfile, $folderdb);
929
folder_zapmessages($folderfile, $folderdb) if ($deleted>0);
930
}
931
ow::filelock::lock($folderfile, LOCK_UN);
932
933
($attfiles_totalsize, $r_attfiles) = getattfilesinfo();
934
935
$subject = "Fw: ";
936
$replyto = $prefs{'replyto'} if (defined($prefs{'replyto'}));
937
938
my $n="\n"; $n="<br>" if ($msgformat ne 'text');
939
if ($#forwardids>0) {
940
$body = $n."# Messages forwarded as attachment".$n.$n;
941
} else {
942
$body = $n."# Message forwarded as attachment".$n.$n;
943
}
944
$body .= str2str($prefs{'signature'}, $msgformat).$n if ($prefs{'signature'}=~/[^\s]/);
945
946
} elsif ($composetype eq 'continue') {
947
$msgformat='text' if ($msgformat eq 'auto');
948
$newmsgformat='text' if ($newmsgformat eq 'auto');
949
950
my $convto=param('convto')||'';
951
$convto = $composecharset if ($convto eq 'none');
952
if ($composecharset ne $convto && is_convertable($composecharset, $convto) ) {
953
($body, $subject, $from, $to, $cc, $bcc, $replyto)=iconv($composecharset, $convto,
954
$body,$subject,$from,$to,$cc,$bcc,$replyto);
955
}
956
foreach (values %ow::lang::languagecharsets, keys %charset_convlist) {
957
if ($_ eq $convto) {
958
$composecharset=$_; last;
959
}
960
}
961
962
if ( $msgformat eq 'text' && $newmsgformat ne 'text') {
963
# default font size to 2 for html msg crecation
964
$body=qq|<font size=2>|.ow::htmltext::text2html($body).qq|</font>|;
965
} elsif ($msgformat ne 'text' && $newmsgformat eq 'text' ) {
966
$body=ow::htmltext::html2text($body);
967
}
968
$msgformat=$newmsgformat;
969
970
} else { # sendto or newmail
971
$msgformat='text' if ($msgformat eq 'auto');
972
$replyto = $prefs{'replyto'} if (defined($prefs{'replyto'}));
973
974
my $n="\n"; $n="<br>" if ($msgformat ne 'text');
975
$body=$n.$n.str2str($prefs{'signature'}, $msgformat).$n if ($prefs{'signature'}=~/[^\s]/);
976
977
}
978
979
# remove tail blank line and space
980
$body=~s/\s+$/\n/s;
981
982
if ($msgformat eq 'text') {
983
# text area would eat leading \n, so we add it back here
984
$body="\n".$body;
985
} else {
986
# insert \n for long lines to keep them short
987
# so the width of html message composer can always fit within screen resolution
988
$body =~ s!([^\n\r]{1,80})( |&nbsp;)!$1$2\n!ig;
989
# default font size to 2 for html msg crecation
990
$body=qq|<font size=2>$body\n</font>| if ($composetype ne 'continue');
991
}
992
993
my ($html, $temphtml, @tmp);
994
995
if ($composecharset ne $prefs{'charset'}) {
996
@tmp=($prefs{'language'}, $prefs{'charset'});
997
($prefs{'language'}, $prefs{'charset'})=('en', $composecharset);
998
loadlang($prefs{'language'});
999
}
1000
$html = applystyle(readtemplate("composemessage.template"));
1001
if ($#tmp>=1) {
1002
($prefs{'language'}, $prefs{'charset'})=@tmp;
1003
}
1004
1005
my $compose_caller=param('compose_caller')||'';
1006
my $urlparm="sessionid=$thissession&amp;folder=$escapedfolder&amp;page=$page&amp;sort=$sort&amp;keyword=$escapedkeyword&amp;searchtype=$searchtype";
1007
if ($compose_caller eq "read") {
1008
$temphtml = iconlink("backtofolder.gif", "$lang_text{'backto'} ".($lang_folders{$folder}||$folder),
1009
qq|accesskey="B" href="$config{'ow_cgiurl'}/openwebmail-read.pl?$urlparm&amp;action=readmessage&amp;message_id=$escapedmessageid&amp;headers=$prefs{'headers'}&amp;attmode=simple"|);
1010
} elsif ($compose_caller eq "abook") {
1011
$temphtml = iconlink("backtofolder.gif", "$lang_text{'backto'} $lang_text{'addressbook'}",
1012
qq|accesskey="B" href="$config{'ow_cgiurl'}/openwebmail-abook.pl?action=editaddresses&amp;$urlparm"|). qq|\n|;
1013
} else { # main
1014
$temphtml = iconlink("backtofolder.gif", "$lang_text{'backto'} ".($lang_folders{$folder}||$folder),
1015
qq|accesskey="B" href="$config{'ow_cgiurl'}/openwebmail-main.pl?action=listmessages&amp;$urlparm"|). qq|\n|;
1016
}
1017
1018
$temphtml .= qq|&nbsp;\n|;
1019
1020
# this refresh button is actually the same as add button,
1021
# because we need to post the request to keep user input data in the submission
1022
$temphtml .= iconlink("refresh.gif", $lang_text{'refresh'}, qq|accesskey="R" href="javascript:document.composeform.addbutton.click();"|);
1023
1024
$html =~ s/\@\@\@BACKTOFOLDER\@\@\@/$temphtml/;
1025
1026
$temphtml = start_multipart_form(-name=>'composeform').
1027
ow::tool::hiddens(action=>'sendmessage',
1028
sessionid=>$thissession,
1029
composetype=>'continue',
1030
deleteattfile=>'',
1031
inreplyto=>$inreplyto,
1032
references=>$references,
1033
composecharset=>$composecharset,
1034
compose_caller=>$compose_caller,
1035
folder=>$folder,
1036
sort=>$sort,
1037
page=>$page,
1038
searchtype=>$searchtype,
1039
keyword=>$keyword,
1040
session_noupdate=>0);
1041
$temphtml .= ow::tool::hiddens(message_id=>param('message_id')) if (param('message_id'));
1042
$mymessageid=fakemessageid((ow::tool::email2nameaddr($from))[1]) if ($mymessageid eq '');
1043
$temphtml .= ow::tool::hiddens(mymessageid=>$mymessageid);
1044
my $show_phonekbd=param('show_phonekbd')||0; # for big5 charset input
1045
$temphtml .= ow::tool::hiddens(show_phonekbd=>$show_phonekbd);
1046
$html =~ s/\@\@\@STARTCOMPOSEFORM\@\@\@/$temphtml/;
1047
1048
my @fromlist=();
1049
foreach (sort_emails_by_domainnames($config{'domainnames'}, keys %userfrom)) {
1050
if ($userfrom{$_} ne '') {
1051
push(@fromlist, qq|"$userfrom{$_}" <$_>|);
1052
} else {
1053
push(@fromlist, qq|$_|);
1054
}
1055
}
1056
$temphtml = popup_menu(-name=>'from',
1057
-values=>\@fromlist,
1058
-default=>$from,
1059
-accesskey=>'F',
1060
-override=>'1');
1061
$html =~ s/\@\@\@FROMMENU\@\@\@/$temphtml/;
1062
1063
my @prioritylist=("urgent", "normal", "non-urgent");
1064
$temphtml = popup_menu(-name=>'priority',
1065
-values=>\@prioritylist,
1066
-default=>$priority || 'normal',
1067
-labels=>\%lang_prioritylabels,
1068
-override=>'1');
1069
$html =~ s/\@\@\@PRIORITYMENU\@\@\@/$temphtml/;
1070
1071
# charset conversion menu
1072
my %ctlabels=( 'none' => "$composecharset *" );
1073
my @ctlist=('none');
1074
my %allsets=();
1075
foreach (values %ow::lang::languagecharsets, keys %charset_convlist) {
1076
$allsets{$_}=1 if (!defined($allsets{$_}));
1077
}
1078
delete $allsets{$composecharset};
1079
1080
if (defined($charset_convlist{$composecharset})) {
1081
foreach my $ct (sort @{$charset_convlist{$composecharset}}) {
1082
if (is_convertable($composecharset, $ct)) {
1083
$ctlabels{$ct}="$composecharset > $ct";
1084
push(@ctlist, $ct);
1085
delete $allsets{$ct};
1086
}
1087
}
1088
}
1089
push(@ctlist, sort keys %allsets);
1090
1091
$temphtml = popup_menu(-name=>'convto',
1092
-values=>\@ctlist,
1093
-labels=>\%ctlabels,
1094
-default=>'none',
1095
-onChange=>'javascript:bodygethtml(); submit();',
1096
-accesskey=>'I',
1097
-override=>'1');
1098
$html =~ s/\@\@\@CONVTOMENU\@\@\@/$temphtml/;
1099
1100
$temphtml = textfield(-name=>'to',
1101
-default=>$to,
1102
-size=>'70',
1103
-accesskey=>'T',
1104
-override=>'1').
1105
qq|\n |.iconlink("addrbook.s.gif", $lang_text{'addressbook'}, qq|href="javascript:GoAddressWindow('to')"|);
1106
$html =~ s/\@\@\@TOFIELD\@\@\@/$temphtml/;
1107
1108
$temphtml = textfield(-name=>'cc',
1109
-default=>$cc,
1110
-size=>'70',
1111
-accesskey=>'C',
1112
-override=>'1').
1113
qq|\n |.iconlink("addrbook.s.gif", $lang_text{'addressbook'}, qq|href="javascript:GoAddressWindow('cc')"|);
1114
$html =~ s/\@\@\@CCFIELD\@\@\@/$temphtml/;
1115
1116
$temphtml = textfield(-name=>'bcc',
1117
-default=>$bcc,
1118
-size=>'70',
1119
-override=>'1').
1120
qq|\n |.iconlink("addrbook.s.gif", $lang_text{'addressbook'}, qq|href="javascript:GoAddressWindow('bcc')"|);
1121
$html =~ s/\@\@\@BCCFIELD\@\@\@/$temphtml/;
1122
1123
$temphtml = textfield(-name=>'replyto',
1124
-default=>$replyto,
1125
-size=>'45',
1126
-accesskey=>'R',
1127
-override=>'1');
1128
$html =~ s/\@\@\@REPLYTOFIELD\@\@\@/$temphtml/;
1129
1130
$temphtml = checkbox(-name=>'confirmreading',
1131
-value=>'1',
1132
-label=>'');
1133
$html =~ s/\@\@\@CONFIRMREADINGCHECKBOX\@\@\@/$temphtml/;
1134
1135
# table of attachment list
1136
my $htmlarea_attlist_js;
1137
1138
if ($#{$r_attfiles}>=0) {
1139
$temphtml = "<table cellspacing='0' cellpadding='0' width='70%'><tr valign='bottom'>\n";
1140
1141
$temphtml .= "<td><table cellspacing='0' cellpadding='0'>\n";
1142
for (my $i=0; $i<=$#{$r_attfiles}; $i++) {
1143
my $blank="";
1144
if (${${$r_attfiles}[$i]}{name}=~/\.(?:txt|jpg|jpeg|gif|png|bmp)$/i) {
1145
$blank="target=_blank";
1146
}
1147
if (${${$r_attfiles}[$i]}{namecharset} &&
1148
is_convertable(${${$r_attfiles}[$i]}{namecharset}, $composecharset) ) {
1149
(${${$r_attfiles}[$i]}{name})=iconv(${${$r_attfiles}[$i]}{namecharset}, $composecharset,
1150
${${$r_attfiles}[$i]}{name});
1151
}
1152
my $attsize=${${$r_attfiles}[$i]}{size};
1153
if ($attsize > 1024) {
1154
$attsize=int($attsize/1024)."$lang_sizes{'kb'}";
1155
} else {
1156
$attsize= $attsize."$lang_sizes{'byte'}";
1157
}
1158
1159
my $attlink=qq|$config{'ow_cgiurl'}/openwebmail-viewatt.pl/|.
1160
ow::tool::escapeURL(${${$r_attfiles}[$i]}{name}).
1161
qq|?sessionid=$thissession&amp;action=viewattfile&amp;|.
1162
qq|attfile=|.ow::tool::escapeURL(${${$r_attfiles}[$i]}{file});
1163
$temphtml .= qq|<tr valign=top>|.
1164
qq|<td><a href="$attlink" $blank><em>${${$r_attfiles}[$i]}{name}</em></a></td>|.
1165
qq|<td nowrap align='right'>&nbsp; $attsize &nbsp;</td>|.
1166
qq|<td nowrap>|.
1167
qq|<a href="javascript:DeleteAttFile('${${$r_attfiles}[$i]}{file}')">[$lang_text{'delete'}]</a>\n|;
1168
if ($config{'enable_webdisk'} && !$config{'webdisk_readonly'}) {
1169
$temphtml .= qq|<a href=#here title="$lang_text{'savefile_towd'}" onClick="window.open('$config{'ow_cgiurl'}/openwebmail-webdisk.pl?action=sel_saveattfile&amp;sessionid=$thissession&amp;attfile=${${$r_attfiles}[$i]}{file}&amp;attname=|.
1170
ow::tool::escapeURL(${${$r_attfiles}[$i]}{name}).qq|', '_blank','width=500,height=330,scrollbars=yes,resizable=yes,location=no'); return false;">[$lang_text{'webdisk'}]</a>|;
1171
}
1172
if (${${$r_attfiles}[$i]}{name}=~/\.(?:doc|dot)$/i) {
1173
$temphtml .= qq|<a href="$attlink&amp;wordpreview=1" title="MS Word $lang_wdbutton{'preview'}" target="_blank">[$lang_wdbutton{'preview'}]</a>|;
1174
}
1175
$temphtml .= qq|</td></tr>\n|;
1176
1177
if ($attlink !~ m!^https?://!) {
1178
if ($ENV{'HTTPS'}=~/on/i || $ENV{'SERVER_PORT'}==443) {
1179
$attlink="https://$ENV{'HTTP_HOST'}$attlink";
1180
} else {
1181
$attlink="http://$ENV{'HTTP_HOST'}$attlink";
1182
}
1183
}
1184
$htmlarea_attlist_js.=qq|,\n| if ($htmlarea_attlist_js);
1185
$htmlarea_attlist_js.=qq|"${${$r_attfiles}[$i]}{name}": "$attlink"|;
1186
}
1187
$temphtml .= "</table></td>\n";
1188
1189
$temphtml .= "<td align='right' nowrap>\n";
1190
if ( $attfiles_totalsize ) {
1191
$temphtml .= "<em>" . int($attfiles_totalsize/1024) . $lang_sizes{'kb'};
1192
$temphtml .= " $lang_text{'of'} $config{'attlimit'} $lang_sizes{'kb'}" if ( $config{'attlimit'} );
1193
$temphtml .= "</em>";
1194
}
1195
$temphtml .= "</td>";
1196
1197
$temphtml .= "</tr></table>\n";
1198
} else {
1199
$temphtml="";
1200
}
1201
1202
$temphtml .= filefield(-name=>'attachment',
1203
-default=>'',
1204
-size=>'45',
1205
-accesskey=>'A',
1206
-override=>'1');
1207
$temphtml .= submit(-name=>'addbutton',
1208
-OnClick=>'bodygethtml()',
1209
-value=>$lang_text{'add'});
1210
$temphtml .= "&nbsp;";
1211
if ($config{'enable_webdisk'}) {
1212
$temphtml .= ow::tool::hiddens(webdisksel=>'')."\n ".
1213
iconlink("webdisk.s.gif", $lang_text{'webdisk'}, qq|href="#" onClick="bodygethtml(); window.open('$config{ow_cgiurl}/openwebmail-webdisk.pl?sessionid=$thissession&amp;action=sel_addattachment', '_addatt','width=500,height=330,scrollbars=yes,resizable=yes,location=no'); return false;"|);
1214
}
1215
$html =~ s/\@\@\@ATTACHMENTFIELD\@\@\@/$temphtml/;
1216
1217
$temphtml = textfield(-name=>'subject',
1218
-default=>$subject,
1219
-size=>'45',
1220
-accesskey=>'S',
1221
-override=>'1');
1222
$html =~ s/\@\@\@SUBJECTFIELD\@\@\@/$temphtml/;
1223
1224
my $backupsent=$prefs{'backupsentmsg'};
1225
if (defined(param('backupsent'))) {
1226
$backupsent=param('backupsent')||0;
1227
}
1228
$temphtml = checkbox(-name=>'backupsentmsg',
1229
-value=>'1',
1230
-checked=>$backupsent,
1231
-label=>'');
1232
$html =~ s/\@\@\@BACKUPSENTMSGCHECKBOX\@\@\@/$temphtml/;
1233
1234
$temphtml = qq|<table width="100%" cellspacing="1" cellpadding="0" border="0">|;
1235
1236
if ($show_phonekbd) { # for big5 input
1237
$temphtml.=qq|<tr><td colspan="3"><a href="javascript:document.composeform.show_phonekbd.value=0; bodygethtml(); document.composeform.submit();">\n|.
1238
qq|<IMG SRC="$config{'ow_htmlurl'}/images/phonekbd.gif" border="0" align="absmiddle" alt="����"></a></td></tr>\n|;
1239
}
1240
1241
$temphtml.=qq|<tr valign=top><td width="2"></td><td>\n|;
1242
if ($msgformat eq 'text') {
1243
$temphtml .= textarea(-name=>'body',
1244
-id=>'body',
1245
-default=>$body,
1246
-rows=>$prefs{'editrows'}||'20',
1247
-columns=>$prefs{'editcolumns'}||'78',
1248
-wrap=>'hard', # incompatible with htmlarea
1249
-accesskey=>'M', # msg area
1250
-override=>'1');
1251
} else {
1252
$temphtml .= textarea(-name=>'body',
1253
-id=>'body',
1254
-default=>$body,
1255
-rows=>$prefs{'editrows'}||'20',
1256
-columns=>$prefs{'editcolumns'}||'78',
1257
-style=>'width:100%',
1258
-accesskey=>'M', # msg area
1259
-override=>'1');
1260
}
1261
$temphtml .= qq|</td><td width="2"></td></tr></table>\n|;
1262
$html =~ s/\@\@\@BODYAREA\@\@\@/$temphtml/;
1263
1264
1265
# 4 buttons: send, savedraft, spellcheck, cancel, 1 menu: msgformat
1266
1267
$temphtml=qq|<table cellspacing="2" cellpadding="2" border="0"><tr>|;
1268
1269
$temphtml.=qq|<td align="center">|.
1270
submit(-name=>'sendbutton',
1271
-value=>$lang_text{'send'},
1272
-onClick=>'bodygethtml(); return sendcheck();',
1273
-accesskey=>'G', # send, outGoing
1274
-override=>'1').
1275
qq|</td>\n|;
1276
1277
$temphtml.=qq|<td align="center">|.
1278
submit(-name=>'savedraftbutton',
1279
-value=>$lang_text{'savedraft'},
1280
-onClick=>'bodygethtml();',
1281
-accesskey=>'W', # savedraft, Write
1282
-override=>'1').
1283
qq|</td>\n|;
1284
1285
if ($config{'enable_spellcheck'}) {
1286
my $chkname=(split(/\s/, $config{'spellcheck'}))[0]; $chkname=~s|^.*/||;
1287
$temphtml.=qq|<td nowrap align="center">|.
1288
qq|<!--spellcheckstart-->\n|.
1289
qq|<table cellpadding="0" cellspacing="0"><tr><td>|.
1290
popup_menu(-name=>'dictionary2',
1291
-values=>$config{'spellcheck_dictionaries'},
1292
-default=>$prefs{'dictionary'},
1293
-onChange=>"JavaScript:document.spellcheckform.dictionary.value=this.value;",
1294
-override=>'1').
1295
qq|</td><td>|.
1296
button(-name=>'spellcheckbutton',
1297
-value=> $lang_text{'spellcheck'},
1298
-title=> $chkname,
1299
-onClick=>'spellcheck(); document.spellcheckform.submit();',
1300
-override=>'1').
1301
qq|</td></tr></table>|.
1302
qq|<!--spellcheckend-->\n|.
1303
qq|</td>\n|;
1304
}
1305
1306
$temphtml.=qq|<td align="center">\n|.
1307
qq|<!--newmsgformatstart-->\n|.
1308
qq|<table cellspacing="1" cellpadding="1" border="0"><tr>|.
1309
qq|<td nowrap align="right">&nbsp;$lang_text{'msgformat'}</td><td>|;
1310
if (htmlarea_compatible()) {
1311
$temphtml.=popup_menu(-name=>'newmsgformat',
1312
-values=>['text', 'html', 'both'],
1313
-default=>$msgformat,
1314
-labels=>\%lang_msgformatlabels,
1315
-onChange => "return msgfmtchangeconfirm();",
1316
-override=>'1');
1317
} else {
1318
$temphtml.=popup_menu(-name=>'newmsgformat',
1319
-values=>['text'],
1320
-labels=>\%lang_msgformatlabels,
1321
-onClick => "msgfmthelp();",
1322
-override=>'1');
1323
}
1324
$temphtml.=ow::tool::hiddens(msgformat=>$msgformat).
1325
qq|</td></tr></table>\n|.
1326
qq|<!--newmsgformatend-->\n|.
1327
qq|</td>\n|;
1328
1329
$temphtml.=qq|<td align="center">|.
1330
button(-name=>'cancelbutton',
1331
-value=> $lang_text{'cancel'},
1332
-onClick=>'document.cancelform.submit();',
1333
-override=>'1').
1334
qq|</td>\n|;
1335
1336
$temphtml.=qq|<td>|.
1337
qq|<!--kbdiconstart-->\n|;
1338
if ($composecharset eq 'big5' && $show_phonekbd==0) { # for big5 input
1339
$temphtml.=qq|<a href="javascript:document.composeform.show_phonekbd.value=1; bodygethtml(); document.composeform.submit();">\n|.
1340
qq|<IMG SRC="$config{'ow_htmlurl'}/images/kbd.gif" border="0" align="absmiddle" alt="��ܪ`����L"></a>\n|;
1341
}
1342
$temphtml.=qq|<!--kbdiconend-->\n|.
1343
qq|</td>\n|;
1344
1345
$temphtml.=qq|</tr></table>\n|;
1346
1347
if ($prefs{'sendbuttonposition'} eq 'after') {
1348
$html =~ s/\@\@\@BUTTONSBEFORE\@\@\@//;
1349
$html =~ s/\@\@\@BUTTONSAFTER\@\@\@/$temphtml/;
1350
} elsif ($prefs{'sendbuttonposition'} eq 'both') {
1351
$html =~ s/\@\@\@BUTTONSBEFORE\@\@\@/$temphtml/;
1352
$temphtml =~ s|<!--spellcheckstart-->|<!--|;
1353
$temphtml =~ s|<!--spellcheckend-->|-->|;
1354
$temphtml =~ s|<!--newmsgformatstart-->|<!--|;
1355
$temphtml =~ s|<!--newmsgformatend-->|-->|;
1356
$temphtml =~ s|<!--kbdiconstart-->|<!--|;
1357
$temphtml =~ s|<!--kbdiconend-->|-->|;
1358
$html =~ s/\@\@\@BUTTONSAFTER\@\@\@/$temphtml/;
1359
} else {
1360
$html =~ s/\@\@\@BUTTONSBEFORE\@\@\@/$temphtml/;
1361
$html =~ s/\@\@\@BUTTONSAFTER\@\@\@//;
1362
}
1363
1364
if ($config{'enable_spellcheck'}) {
1365
# spellcheck form
1366
$temphtml = start_form(-action=>"$config{'ow_cgiurl'}/openwebmail-spell.pl",
1367
-name=>'spellcheckform',
1368
-target=>'_spellcheck').
1369
ow::tool::hiddens(sessionid=>$thissession,
1370
htmlmode=>($msgformat ne 'text'),
1371
form=>'',
1372
field=>'',
1373
string=>'',
1374
dictionary=>$prefs{'dictionary'});
1375
$html =~ s/\@\@\@STARTSPELLCHECKFORM\@\@\@/$temphtml/;
1376
} else {
1377
$html =~ s/\@\@\@STARTSPELLCHECKFORM\@\@\@.*?\@\@\@ENDFORM\@\@\@//s;
1378
}
1379
1380
# cancel form
1381
if (param('message_id')) {
1382
$temphtml = start_form(-action=>"$config{'ow_cgiurl'}/openwebmail-read.pl",
1383
-name=>'cancelform').
1384
ow::tool::hiddens(action=>'readmessage',
1385
message_id=>param('message_id')||'',
1386
headers=>$prefs{'headers'} || 'simple');
1387
} else {
1388
$temphtml = start_form(-action=>"$config{'ow_cgiurl'}/openwebmail-main.pl",
1389
-name=>'cancelform').
1390
ow::tool::hiddens(action=>'listmessages');
1391
}
1392
$temphtml .= ow::tool::hiddens(sessionid=>$thissession,
1393
folder=>$folder,
1394
sort=>$sort,
1395
page=>$page,
1396
searchtype=>$searchtype,
1397
keyword=>$keyword);
1398
$html =~ s/\@\@\@STARTCANCELFORM\@\@\@/$temphtml/;
1399
1400
$temphtml = end_form();
1401
$html =~ s/\@\@\@ENDFORM\@\@\@/$temphtml/g;
1402
1403
my $abook_width = $prefs{'abook_width'};
1404
$abook_width = 'screen.availWidth' if ($abook_width eq 'max');
1405
$html =~ s/\@\@\@ABOOKWIDTH\@\@\@/$abook_width/;
1406
1407
my $abook_height = $prefs{'abook_height'};
1408
$abook_height = 'screen.availHeight' if ($abook_height eq 'max');
1409
$html =~ s/\@\@\@ABOOKHEIGHT\@\@\@/$abook_height/;
1410
1411
my $abook_searchtype = $prefs{'abook_defaultfilter'}?ow::tool::escapeURL($prefs{'abook_defaultsearchtype'}):'';
1412
$html =~ s/\@\@\@ABOOKSEARCHTYPE\@\@\@/$abook_searchtype/;
1413
1414
my $abook_keyword = $prefs{'abook_defaultfilter'}?ow::tool::escapeURL($prefs{'abook_defaultkeyword'}):'';
1415
$html =~ s/\@\@\@ABOOKKEYWORD\@\@\@/$abook_keyword/;
1416
1417
# load css and js for html editor
1418
if ($msgformat ne 'text') {
1419
if ($_htmlarea_css_cache eq '') {
1420
open(F, "$config{'ow_htmldir'}/javascript/htmlarea.openwebmail/htmlarea.css") or
1421
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_htmldir'}/javascript/htmlarea.openwebmail/htmlarea.css! ($!)");
1422
local $/; undef $/; $_htmlarea_css_cache=<F>; # read whole file in once
1423
close(F);
1424
}
1425
my $css=$_htmlarea_css_cache; $css=~s/\@\@\@BGCOLOR\@\@\@/$style{'window_light'}/g; $css=~s/"//g;
1426
my $lang=$prefs{'language'}; $lang='en' if ($composecharset ne $prefs{'charset'});
1427
my $direction="ltr"; $direction="rtl" if ($composecharset eq $prefs{'charset'} && $ow::lang::RTL{$prefs{'language'}});
1428
$html= qq|<script language="JavaScript" src="$config{'ow_htmlurl'}/javascript/htmlarea.openwebmail/htmlarea.js"></script>\n|.
1429
qq|<script language="JavaScript" src="$config{'ow_htmlurl'}/javascript/htmlarea.openwebmail/dialog.js"></script>\n|.
1430
qq|<script language="JavaScript" src="$config{'ow_htmlurl'}/javascript/htmlarea.openwebmail/popups/$lang/htmlarea-lang.js"></script>\n|.
1431
$html.
1432
qq|<style type="text/css">\n$css\n</style>\n|.
1433
qq|<script language="JavaScript">\n<!--\n|.
1434
qq| var editor=new HTMLArea("body");\n|.
1435
qq| editor.config.editorURL = "$config{'ow_htmlurl'}/javascript/htmlarea.openwebmail/";\n|.
1436
qq| editor.config.imgURL = "images/";\n|.
1437
qq| editor.config.popupURL = "popups/$lang/";\n|.
1438
qq| editor.config.bodyDirection = "$direction";\n|.
1439
qq| editor.config.attlist = {\n$htmlarea_attlist_js};\n|.
1440
qq| editor.config.attlist = {\n$htmlarea_attlist_js};\n|.
1441
qq| editor.generate();\n|.
1442
qq|//-->\n</script>\n|;
1443
}
1444
1445
@tmp=();
1446
if ($composecharset ne $prefs{'charset'}) {
1447
@tmp=($prefs{'language'}, $prefs{'charset'});
1448
($prefs{'language'}, $prefs{'charset'})=('en', $composecharset);
1449
}
1450
my $session_noupdate=param('session_noupdate')||'';
1451
if (defined(param('savedraftbutton')) && !$session_noupdate) {
1452
# savedraft from user clicking, show show some msg for notifitcaiton
1453
my $msg=qq|<font size="-1">$lang_text{'draftsaved'}</font>|;
1454
$msg=~s/\@\@\@SUBJECT\@\@\@/$subject/;
1455
$html.= readtemplate('showmsg.js').
1456
qq|<script language="JavaScript">\n<!--\n|.
1457
qq|showmsg('$prefs{charset}', '$lang_text{savedraft}', '$msg', '$lang_text{"close"}', '_savedraft', 300, 100, 5);\n|.
1458
qq|//-->\n</script>\n|;
1459
}
1460
if (defined(param('savedraftbutton')) && $session_noupdate) {
1461
# this is auto savedraft triggered by timeoutwarning,
1462
# timeoutwarning js code is not required any more
1463
httpprint([], [htmlheader(), $html, htmlfooter(1)]);
1464
} else {
1465
# load timeoutchk.js and plugin jscode
1466
# which will be triggered when timeoutwarning shows up.
1467
my $jscode=qq|document.composeform.session_noupdate.value=1;|.
1468
qq|document.composeform.savedraftbutton.click();|;
1469
httpprint([], [htmlheader(), $html, htmlfooter(2, $jscode)]);
1470
}
1471
if ($#tmp>=1) {
1472
($prefs{'language'}, $prefs{'charset'})[email protected];
1473
}
1474
return;
1475
}
1476
########## END COMPOSEMESSAGE ####################################
1477
1478
########## SENDMESSAGE ###########################################
1479
sub sendmessage {
1480
no strict 'refs'; # for $attchment, which is fname and fhandle of the upload
1481
# goto composemessage if !savedraft && !send
1482
if ( !defined(param('savedraftbutton')) &&
1483
!(defined(param('sendbutton')) && (param('to')||param('cc')||param('bcc'))) ) {
1484
return(composemessage());
1485
}
1486
1487
my %userfrom=get_userfrom($logindomain, $loginuser, $user, $userrealname, dotpath('from.book'));
1488
my ($realname, $from);
1489
if (param('from')) {
1490
# use _email2nameaddr since it may return null name
1491
($realname, $from)=ow::tool::_email2nameaddr(param('from'));
1492
} else {
1493
($realname, $from)=($userfrom{$prefs{'email'}}, $prefs{'email'});
1494
}
1495
$from =~ s/['"]/ /g; # Get rid of shell escape attempts
1496
$realname =~ s/['"]/ /g; # Get rid of shell escape attempts
1497
1498
my $dateserial=ow::datetime::gmtime2dateserial();
1499
my $date=ow::datetime::dateserial2datefield($dateserial, $prefs{'timeoffset'}, $prefs{'daylightsaving'});
1500
1501
my $folder = param('folder')||'';
1502
my $to = param('to')||'';
1503
my $cc = param('cc')||'';
1504
my $bcc = param('bcc')||'';
1505
my $replyto = param('replyto')||'';
1506
my $subject = param('subject') || 'N/A';
1507
my $inreplyto = param('inreplyto')||'';
1508
my $references = param('references')||'';
1509
my $composecharset = param('composecharset') || $prefs{'charset'};
1510
my $priority = param('priority')||'';
1511
my $confirmreading = param('confirmreading')||'';
1512
my $msgformat = param('msgformat')||'';
1513
my $body = param('body')||'';
1514
1515
$mymessageid= fakemessageid($from) if ($mymessageid eq '');
1516
1517
my ($attfiles_totalsize, $r_attfiles)=getattfilesinfo();
1518
1519
$body =~ s/\r//g; # strip ^M characters from message. How annoying!
1520
if ($msgformat ne 'text') { # replace links to attfiles with their cid
1521
$body = ow::htmlrender::html4attfiles_link2cid($body, $r_attfiles, "$config{'ow_cgiurl'}/openwebmail-viewatt.pl");
1522
}
1523
1524
my $attachment = param('attachment');
1525
my $attheader;
1526
if ( $attachment ) {
1527
if ( ($config{'attlimit'}) && ( ( $attfiles_totalsize + (-s $attachment) ) > ($config{'attlimit'} * 1024) ) ) {
1528
openwebmailerror(__FILE__, __LINE__, "$lang_err{'att_overlimit'} $config{'attlimit'} $lang_sizes{'kb'}!");
1529
}
1530
my $attcontenttype;
1531
if (defined(uploadInfo($attachment))) {
1532
$attcontenttype = ${uploadInfo($attachment)}{'Content-Type'} || 'application/octet-stream';
1533
} else {
1534
$attcontenttype = 'application/octet-stream';
1535
}
1536
my $attname = $attachment;
1537
# Convert :: back to the ' like it should be.
1538
$attname =~ s/::/'/g;
1539
# Trim the path info from the filename
1540
if ($composecharset eq 'big5' || $composecharset eq 'gb2312') {
1541
$attname = ow::tool::zh_dospath2fname($attname); # dos path
1542
} else {
1543
$attname =~ s|^.*\\||; # dos path
1544
}
1545
$attname =~ s|^.*/||; # unix path
1546
$attname =~ s|^.*:||; # mac path and dos drive
1547
1548
$attheader = qq|Content-Type: $attcontenttype;\n|.
1549
qq|\tname="|.ow::mime::encode_mimewords($attname, ('Charset'=>$composecharset)).qq|"\n|.
1550
qq|Content-Disposition: attachment; filename="|.ow::mime::encode_mimewords($attname, ('Charset'=>$composecharset)).qq|"\n|.
1551
qq|Content-Transfer-Encoding: base64\n|;
1552
}
1553
1554
# convert message to prefs{'sendcharset'}
1555
if ($prefs{'sendcharset'} ne 'sameascomposing' &&
1556
is_convertable($composecharset, $prefs{'sendcharset'}) ) {
1557
($from,$replyto,$to,$cc,$subject,$body)=iconv($composecharset, $prefs{'sendcharset'},
1558
$from,$replyto,$to,$cc,$subject,$body);
1559
$composecharset=$prefs{'sendcharset'};
1560
}
1561
1562
# form html body to a complete html;
1563
if ($msgformat ne 'text') {
1564
$body=qq|<HTML>\n<HEAD>\n|.
1565
qq|<META content="text/html; charset=$composecharset" http-equiv=Content-Type>\n|.
1566
qq|<META content="OPENWEBMAIL" name=GENERATOR>\n|.
1567
qq|</HEAD>\n<BODY bgColor=#ffffff>\n|.
1568
$body.
1569
qq|\n</BODY>\n</HTML>\n|;
1570
}
1571
1572
my $do_send=1;
1573
my $senderrstr="";
1574
my $senderr=0;
1575
1576
my $do_save=1;
1577
my $saveerrstr="";
1578
my $saveerr=0;
1579
1580
my $smtp;
1581
my $smtperrfile="/tmp/.openwebmail.smtperr.$$";
1582
local (*STDERR); # localize stderr to a new global variable
1583
1584
my ($savefolder, $savefile, $savedb);
1585
my $messagestart=0;
1586
my $messagesize=0;
1587
my $messageheader='';
1588
my $folderhandle=do { local *FH };
1589
1590
if (defined(param('savedraftbutton'))) { # save msg to draft folder
1591
$savefolder = 'saved-drafts';
1592
$do_send=0;
1593
$do_save=0 if ($quotalimit>0 && $quotausage>=$quotalimit);
1594
} else { # save msg to sent folder && send
1595
$savefolder = 'sent-mail';
1596
$do_save=0 if (($quotalimit>0 && $quotausage>=$quotalimit) || param('backupsentmsg')==0 );
1597
}
1598
1599
if ($do_send) {
1600
my @recipients=();
1601
foreach my $recv ($to, $cc, $bcc) {
1602
next if ($recv eq "");
1603
foreach (ow::tool::str2list($recv,0)) {
1604
my $addr=(ow::tool::email2nameaddr($_))[1];
1605
next if ($addr eq "" || $addr=~/\s/);
1606
push (@recipients, $addr);
1607
}
1608
}
1609
foreach my $email (@recipients) { # validate receiver email
1610
matchlist_fromtail('allowed_receiverdomain', $email) or
1611
openwebmailerror(__FILE__, __LINE__, $lang_err{'disallowed_receiverdomain'}." ( $email )");
1612
}
1613
1614
# redirect stderr to smtperrfile
1615
$smtperrfile=ow::tool::untaint($smtperrfile);
1616
open(STDERR, ">$smtperrfile");
1617
select(STDERR); local $| = 1; select(STDOUT);
1618
1619
my $timeout=120; $timeout=180 if ($#recipients>=1); # more than 1 recipient
1620
if ( !($smtp=Net::SMTP->new($config{'smtpserver'},
1621
Port => $config{'smtpport'},
1622
Timeout => $timeout,
1623
Hello => ${$config{'domainnames'}}[0],
1624
Debug=>1)) ) {
1625
$senderr++;
1626
$senderrstr="$lang_err{'couldnt_open'} SMTP server $config{'smtpserver'}:$config{'smtpport'}!";
1627
writelog("send message error - couldn't open SMTP server $config{'smtpserver'}:$config{'smtpport'}");
1628
writehistory("send message error - couldn't open SMTP server $config{'smtpserver'}:$config{'smtpport'}");
1629
}
1630
1631
# SMTP SASL authentication (PLAIN only)
1632
if ($config{'smtpauth'} && !$senderr) {
1633
my $auth = $smtp->supports("AUTH");
1634
if (! $smtp->auth($config{'smtpauth_username'}, $config{'smtpauth_password'}) ) {
1635
$senderr++;
1636
$senderrstr="$lang_err{'network_server_error'}!<br>($config{'smtpserver'} - ".$smtp->message.")";
1637
writelog("send message error - SMTP server $config{'smtpserver'} error - ".$smtp->message);
1638
writehistory("send message error - SMTP server $config{'smtpserver'} error - ".$smtp->message);
1639
}
1640
}
1641
1642
$smtp->mail($from) or $senderr++ if (!$senderr);
1643
if (!$senderr) {
1644
my @ok=$smtp->recipient(@recipients, { SkipBad => 1 });
1645
$senderr++ if ($#ok<0);
1646
}
1647
$smtp->data() or $senderr++ if (!$senderr);
1648
1649
# save message to draft if smtp error, Dattola Filippo 06/20/2002
1650
if ($senderr && (!$quotalimit||$quotausage<$quotalimit)) {
1651
$do_save = 1;
1652
$savefolder = 'saved-drafts';
1653
}
1654
}
1655
1656
if ($do_save) {
1657
($savefile, $savedb)=get_folderpath_folderdb($user, $savefolder);
1658
1659
if ( ! -f $savefile) {
1660
if (open ($folderhandle, ">$savefile")) {
1661
close ($folderhandle);
1662
} else {
1663
$saveerrstr="$lang_err{'couldnt_open'} $savefile!";
1664
$saveerr++;
1665
$do_save=0;
1666
}
1667
}
1668
1669
if (!$saveerr && ow::filelock::lock($savefile, LOCK_EX)) {
1670
if (update_folderindex($savefile, $savedb)<0) {
1671
ow::filelock::lock($savefile, LOCK_UN);
1672
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_updatedb'} $savedb");
1673
}
1674
1675
my $oldmsgfound=0;
1676
my $oldsubject='';
1677
my %FDB;
1678
ow::dbm::open(\%FDB, $savedb, LOCK_SH) or
1679
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_locksh'} $savedb");
1680
if (defined($FDB{$mymessageid})) {
1681
$oldmsgfound=1;
1682
$oldsubject=(string2msgattr($FDB{$mymessageid}))[$_SUBJECT];
1683
}
1684
ow::dbm::close(\%FDB, $savedb);
1685
1686
if ($oldmsgfound) {
1687
if ($savefolder eq 'saved-drafts' && $subject eq $oldsubject) {
1688
# remove old draft if the subject is the same
1689
if (operate_message_with_ids("delete", [$mymessageid], $savefile, $savedb)>0) {
1690
folder_zapmessages($savefile, $savedb);
1691
} else {
1692
$mymessageid=fakemessageid($from); # use another id if remove failed
1693
}
1694
} else {
1695
# change mymessageid to ensure messageid is unique in one folder
1696
# note: this new mymessageid will be used by composemessage later
1697
$mymessageid=fakemessageid($from);
1698
}
1699
}
1700
1701
if (open ($folderhandle, "+<$savefile") ) {
1702
$messagestart=(stat($folderhandle))[7];
1703
seek($folderhandle, $messagestart, 0); # seek end manually to cover tell() bug in perl 5.8
1704
} else {
1705
$saveerrstr="$lang_err{'couldnt_open'} $savefile!";
1706
$saveerr++;
1707
$do_save=0;
1708
}
1709
1710
} else {
1711
$saveerrstr="$lang_err{'couldnt_lock'} $savefile!";
1712
$saveerr++;
1713
$do_save=0;
1714
}
1715
}
1716
1717
# nothing to do, return error msg immediately
1718
if ($do_send==0 && $do_save==0) {
1719
if ($saveerr) {
1720
openwebmailerror(__FILE__, __LINE__, $saveerrstr);
1721
} else {
1722
print redirect(-location=>"$config{'ow_cgiurl'}/openwebmail-main.pl?action=listmessages&sessionid=$thissession&sort=$sort&folder=$escapedfolder&page=$page");
1723
}
1724
}
1725
1726
my $s;
1727
1728
# Add a 'From ' as delimeter for local saved msg
1729
$s = "From $user ";
1730
if ($config{'delimiter_use_GMT'}) {
1731
$s.=ow::datetime::dateserial2delimiter(ow::datetime::gmtime2dateserial(), "", $prefs{'daylightsaving'})."\n";
1732
} else {
1733
# use server localtime for delimiter
1734
$s.=ow::datetime::dateserial2delimiter(ow::datetime::gmtime2dateserial(), ow::datetime::gettimeoffset(), $prefs{'daylightsaving'})."\n";
1735
}
1736
print $folderhandle $s or $saveerr++ if ($do_save && !$saveerr);
1737
$messageheader.=$s;
1738
1739
if ($realname ne '') {
1740
$s = "From: ".ow::mime::encode_mimewords(qq|"$realname" <$from>|, ('Charset'=>$composecharset))."\n";
1741
} else {
1742
$s = "From: ".ow::mime::encode_mimewords(qq|$from|, ('Charset'=>$composecharset))."\n";
1743
}
1744
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1745
$messageheader.=$s;
1746
1747
if ($to ne '') {
1748
$s = "To: ".ow::mime::encode_mimewords(folding($to), ('Charset'=>$composecharset))."\n";
1749
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1750
$messageheader.=$s;
1751
} elsif ($bcc ne '' && $cc eq '') { # recipients in Bcc only, To and Cc are null
1752
$s = "To: undisclosed-recipients: ;\n";
1753
print $folderhandle $s or $saveerr++ if ($do_save && !$saveerr);
1754
$messageheader.=$s;
1755
}
1756
1757
if ($cc ne '') {
1758
$s = "Cc: ".ow::mime::encode_mimewords(folding($cc), ('Charset'=>$composecharset))."\n";
1759
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1760
$messageheader.=$s;
1761
}
1762
if ($bcc ne '') { # put bcc header in folderfile only, not in outgoing msg
1763
$s = "Bcc: ".ow::mime::encode_mimewords(folding($bcc), ('Charset'=>$composecharset))."\n";
1764
print $folderhandle $s or $saveerr++ if ($do_save && !$saveerr);
1765
$messageheader.=$s;
1766
}
1767
1768
$s = "";
1769
$s .= "Reply-To: ".ow::mime::encode_mimewords($replyto, ('Charset'=>$composecharset))."\n" if ($replyto);
1770
$s .= "Subject: ".ow::mime::encode_mimewords($subject, ('Charset'=>$composecharset))."\n";
1771
$s .= "Date: $date\n";
1772
$s .= "Message-Id: $mymessageid\n";
1773
$s .= "In-Reply-To: $inreplyto\n" if ($inreplyto);
1774
$s .= "References: $references\n" if ($references);
1775
$s .= "Priority: $priority\n" if ($priority && $priority ne 'normal');
1776
$s .= safexheaders($config{'xheaders'});
1777
if ($confirmreading) {
1778
if ($replyto ne '') {
1779
$s .= "X-Confirm-Reading-To: ".ow::mime::encode_mimewords($replyto, ('Charset'=>$composecharset))."\n";
1780
$s .= "Disposition-Notification-To: ".ow::mime::encode_mimewords($replyto, ('Charset'=>$composecharset))."\n";
1781
} else {
1782
$s .= "X-Confirm-Reading-To: $from\n";
1783
$s .= "Disposition-Notification-To: $from\n";
1784
}
1785
}
1786
$s .= "MIME-Version: 1.0\n";
1787
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1788
$messageheader.=$s;
1789
1790
my $contenttype;
1791
my $boundary = "----=OPENWEBMAIL_ATT_" . rand();
1792
my $boundary2 = "----=OPENWEBMAIL_ATT_" . rand();
1793
my $boundary3 = "----=OPENWEBMAIL_ATT_" . rand();
1794
1795
my (@related, @mixed);
1796
foreach my $r_att (@{$r_attfiles}) {
1797
if (${$r_att}{'referencecount'}>0 && $msgformat ne "text") {
1798
push(@related, $r_att);
1799
} else {
1800
${$r_att}{'referencecount'}=0;
1801
push(@mixed, $r_att);
1802
}
1803
}
1804
1805
if ($attachment || $#mixed>=0 ) {
1806
# HAS MIXED ATTACHMENT
1807
$contenttype="multipart/mixed;";
1808
1809
$s=qq|Content-Type: multipart/mixed;\n|.
1810
qq|\tboundary="$boundary"\n|;
1811
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1812
print $folderhandle "Status: R\n" or $saveerr++ if ($do_save && !$saveerr);
1813
$messageheader.=$s."Status: R\n";
1814
1815
dump_str(qq|\nThis is a multi-part message in MIME format.\n|,
1816
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1817
1818
if ($#related>=0) { # has related att, has mixed att
1819
if ($msgformat eq 'html') {
1820
dump_str(qq|\n--$boundary\n|.
1821
qq|Content-Type: multipart/related;\n|.
1822
qq|\ttype="text/html";\n|.
1823
qq|\tboundary="$boundary2"\n|,
1824
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1825
1826
dump_bodyhtml(\$body, $boundary2, $composecharset, $msgformat,
1827
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1828
dump_atts(\@related, $boundary2, $composecharset,
1829
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1830
1831
} elsif ($msgformat eq "both") {
1832
$contenttype="multipart/related;";
1833
1834
dump_str(qq|\n--$boundary\n|.
1835
qq|Content-Type: multipart/related;\n|.
1836
qq|\ttype="multipart/alternative";\n|.
1837
qq|\tboundary="$boundary2"\n|,
1838
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1839
1840
dump_str(qq|\n--$boundary2\n|.
1841
qq|Content-Type: multipart/alternative;\n|.
1842
qq|\tboundary="$boundary3"\n|,
1843
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1844
1845
dump_bodytext(\$body, $boundary3, $composecharset, $msgformat,
1846
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1847
dump_bodyhtml(\$body, $boundary3, $composecharset, $msgformat,
1848
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1849
1850
dump_str(qq|\n--$boundary3--\n|,
1851
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1852
1853
dump_atts(\@related, $boundary2, $composecharset,
1854
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1855
}
1856
1857
dump_str(qq|\n--$boundary2--\n|,
1858
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1859
1860
} else { # no related att, has mixed att
1861
if ($msgformat eq 'text') {
1862
dump_bodytext(\$body, $boundary, $composecharset, $msgformat,
1863
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1864
1865
} elsif ($msgformat eq 'html') {
1866
dump_bodyhtml(\$body, $boundary, $composecharset, $msgformat,
1867
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1868
1869
} elsif ($msgformat eq 'both') {
1870
dump_str(qq|\n--$boundary\n|.
1871
qq|Content-Type: multipart/alternative;\n|.
1872
qq|\tboundary="$boundary2"\n|,
1873
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1874
1875
dump_bodytext(\$body, $boundary2, $composecharset, $msgformat,
1876
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1877
dump_bodyhtml(\$body, $boundary2, $composecharset, $msgformat,
1878
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1879
1880
dump_str(qq|\n--$boundary2--\n|,
1881
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1882
}
1883
}
1884
1885
dump_atts(\@mixed, $boundary, $composecharset,
1886
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1887
1888
if ($attachment) {
1889
dump_str(qq|\n--$boundary\n$attheader\n|,
1890
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1891
while (read($attachment, $s, 400*57)) { # attachmet fh to uploadfile stored by CGI.pm
1892
dump_str(encode_base64($s),
1893
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1894
}
1895
close($attachment); # close tmpfile created by CGI.pm
1896
}
1897
1898
dump_str(qq|\n--$boundary--\n|,
1899
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1900
1901
} else {
1902
# NO MIXED ATTACHMENT
1903
if ($#related>=0) { # has related att, no mixed att, !attachment param
1904
1905
if ($msgformat eq 'html') {
1906
$contenttype="multipart/related;";
1907
1908
$s=qq|Content-Type: multipart/related;\n|.
1909
qq|\ttype="text/html";\n|.
1910
qq|\tboundary="$boundary"\n|;
1911
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1912
print $folderhandle "Status: R\n" or $saveerr++ if ($do_save && !$saveerr);
1913
$messageheader.=$s."Status: R\n";
1914
1915
dump_str(qq|\nThis is a multi-part message in MIME format.\n|,
1916
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1917
1918
dump_bodyhtml(\$body, $boundary, $composecharset, $msgformat,
1919
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1920
dump_atts(\@related, $boundary, $composecharset,
1921
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1922
1923
} elsif ($msgformat eq "both") {
1924
$contenttype="multipart/related;";
1925
1926
$s=qq|Content-Type: multipart/related;\n|.
1927
qq|\ttype="multipart/alternative";\n|.
1928
qq|\tboundary="$boundary"\n|;
1929
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1930
print $folderhandle "Status: R\n" or $saveerr++ if ($do_save && !$saveerr);
1931
$messageheader.=$s."Status: R\n";
1932
1933
dump_str(qq|\nThis is a multi-part message in MIME format.\n|,
1934
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1935
1936
dump_str(qq|\n--$boundary\n|.
1937
qq|Content-Type: multipart/alternative;\n|.
1938
qq|\tboundary="$boundary2"\n|,
1939
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1940
1941
dump_bodytext(\$body, $boundary2, $composecharset, $msgformat,
1942
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1943
dump_bodyhtml(\$body, $boundary2, $composecharset, $msgformat,
1944
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1945
1946
dump_str(qq|\n--$boundary2--\n|,
1947
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1948
1949
dump_atts(\@related, $boundary, $composecharset,
1950
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1951
}
1952
1953
dump_str(qq|\n--$boundary--\n|,
1954
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1955
1956
} else { # no related att, no mixed att, !attachment param
1957
if ($msgformat eq 'text') {
1958
$contenttype="text/plain; charset=$composecharset";
1959
1960
$s=qq|Content-Type: text/plain;\n|.
1961
qq|\tcharset=$composecharset\n|;
1962
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1963
print $folderhandle "Status: R\n" or $saveerr++ if ($do_save && !$saveerr);
1964
$messageheader.=$s."Status: R\n";
1965
1966
$smtp->datasend("\n$body\n") or $senderr++ if ($do_send && !$senderr);
1967
$body=~s/^From />From /gm;
1968
print $folderhandle "\n$body\n" or $saveerr++ if ($do_save && !$saveerr);
1969
if ( $config{'mailfooter'}=~/[^\s]/) {
1970
$s=str2str($config{'mailfooter'}, $msgformat)."\n";
1971
$smtp->datasend($s) or $senderr++ if ($do_send && !$senderr);
1972
}
1973
1974
} elsif ($msgformat eq 'html') {
1975
$contenttype="text/html; charset=$composecharset";
1976
1977
$s=qq|Content-Type: text/html;\n|.
1978
qq|\tcharset=$composecharset\n|.
1979
qq|Content-Transfer-Encoding: quoted-printable\n|;
1980
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1981
print $folderhandle "Status: R\n" or $saveerr++ if ($do_save && !$saveerr);
1982
$messageheader.=$s."Status: R\n";
1983
1984
$s = qq|\n|.encode_qp($body).qq|\n|;
1985
$smtp->datasend($s) or $senderr++ if ($do_send && !$senderr);
1986
$s=~s/^From />From /gm;
1987
print $folderhandle $s or $saveerr++ if ($do_save && !$saveerr);
1988
if ( $config{'mailfooter'}=~/[^\s]/) {
1989
$s=encode_qp(str2str($config{'mailfooter'}, $msgformat))."\n";
1990
$smtp->datasend($s) or $senderr++ if ($do_send && !$senderr);
1991
}
1992
1993
} elsif ($msgformat eq 'both') {
1994
$contenttype="multipart/alternative;";
1995
1996
$s=qq|Content-Type: multipart/alternative;\n|.
1997
qq|\tboundary="$boundary"\n|;
1998
dump_str($s, $smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
1999
print $folderhandle "Status: R\n" or $saveerr++ if ($do_save && !$saveerr);
2000
$messageheader.=$s."Status: R\n";
2001
2002
dump_str(qq|\nThis is a multi-part message in MIME format.\n|,
2003
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
2004
2005
dump_bodytext(\$body, $boundary, $composecharset, $msgformat,
2006
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
2007
dump_bodyhtml(\$body, $boundary, $composecharset, $msgformat,
2008
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
2009
2010
dump_str(qq|\n--$boundary--\n|,
2011
$smtp, $folderhandle, $do_send, $do_save, \$senderr, \$saveerr);
2012
}
2013
}
2014
}
2015
2016
# terminate this message
2017
$smtp->dataend() or $senderr++ if ($do_send && !$senderr);
2018
# ensure a blank line between messages for local saved msgs
2019
print $folderhandle "\n" or $saveerr++ if ($do_save && !$saveerr);
2020
2021
if ($do_send) {
2022
if (!$senderr) {
2023
$smtp->quit();
2024
close(STDERR);
2025
my @r;
2026
push(@r, "to=$to") if ($to);
2027
push(@r, "cc=$cc") if ($cc);
2028
push(@r, "bcc=$bcc") if ($bcc);
2029
writelog("send message - subject=$subject - ".join(', ', @r));
2030
writehistory("send message - subject=$subject - ".join(', ', @r));
2031
} else {
2032
$smtp->close() if ($smtp); # close smtp if it was sucessfully opened
2033
if ($senderrstr eq "") {
2034
my $smtperr=readsmtperr($smtperrfile);
2035
$senderrstr= qq|$lang_err{'sendmail_error'}!|.
2036
qq|<form>|.
2037
textarea(-name=>'smtperror',
2038
-default=>$smtperr,
2039
-rows=>'5',
2040
-columns=>'72',
2041
-wrap=>'soft',
2042
-override=>'1').
2043
qq|</form>|;
2044
$smtperr=~s/\n/\n /gs; $smtperr=~s/\s+$//;
2045
writelog("send message error - smtp error ...\n $smtperr");
2046
writehistory("send message error - smtp error");
2047
}
2048
}
2049
close(STDERR);
2050
unlink($smtperrfile);
2051
}
2052
2053
if ($do_save) {
2054
if (!$saveerr) {
2055
close($folderhandle);
2056
$messagesize=(stat($savefile))[7] - $messagestart;
2057
2058
my @attr;
2059
$attr[$_OFFSET]=$messagestart;
2060
2061
$attr[$_TO]=$to;
2062
$attr[$_TO]=$cc if ($attr[$_TO] eq '');
2063
$attr[$_TO]=$bcc if ($attr[$_TO] eq '');
2064
# some dbm(ex:ndbm on solaris) can only has value shorter than 1024 byte,
2065
# so we cut $_to to 256 byte to make dbm happy
2066
if (length($attr[$_TO]) >256) {
2067
$attr[$_TO]=substr($attr[$_TO], 0, 252)."...";
2068
}
2069
2070
if ($realname) {
2071
$attr[$_FROM]=qq|"$realname" <$from>|;
2072
} else {
2073
$attr[$_FROM]=qq|$from|;
2074
}
2075
$attr[$_DATE]=$dateserial;
2076
$attr[$_SUBJECT]=$subject;
2077
$attr[$_CONTENT_TYPE]=$contenttype;
2078
2079
$attr[$_STATUS]="R";
2080
$attr[$_STATUS].="I" if ($priority eq 'urgent');
2081
# flags used by openwebmail internally
2082
$attr[$_STATUS].="T" if ($attachment || $#{$r_attfiles}>=0 );
2083
2084
$attr[$_REFERENCES]=$references;
2085
$attr[$_CHARSET]=$composecharset;
2086
$attr[$_SIZE]=$messagesize;
2087
$attr[$_HEADERSIZE]=length($messageheader);
2088
$attr[$_HEADERCHKSUM]=ow::tool::calc_checksum(\$messageheader);
2089
2090
my %FDB;
2091
ow::dbm::open(\%FDB, $savedb, LOCK_EX) or
2092
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_lock'} $savedb");
2093
$FDB{$mymessageid}=msgattr2string(@attr);
2094
$FDB{'ALLMESSAGES'}++;
2095
$FDB{'METAINFO'}=ow::tool::metainfo($savefile);
2096
$FDB{'LSTMTIME'}=time();
2097
ow::dbm::close(\%FDB, $savedb);
2098
} else {
2099
truncate($folderhandle, $messagestart);
2100
close($folderhandle);
2101
2102
my %FDB;
2103
ow::dbm::open(\%FDB, $savedb, LOCK_EX) or
2104
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_lock'} $savedb");
2105
$FDB{'METAINFO'}=ow::tool::metainfo($savefile);
2106
$FDB{'LSTMTIME'}=time();
2107
ow::dbm::close(\%FDB, $savedb);
2108
}
2109
2110
ow::filelock::lock($savefile, LOCK_UN);
2111
}
2112
2113
# status update(mark referenced message as answered) and folderdb update
2114
#
2115
# this must be done AFTER the above do_savefolder block
2116
# since the start of the savemessage would be changed by status_update
2117
# if the savedmessage is on the same folder as the answered message
2118
if ($do_send && !$senderr && $inreplyto) {
2119
my @checkfolders=();
2120
2121
# if current folder is sent/draft folder,
2122
# we try to find orig msg from other folders
2123
# Or we just check the current folder
2124
if ($folder eq "sent-mail" || $folder eq "saved-drafts" ) {
2125
my (@validfolders, $inboxusage, $folderusage);
2126
getfolders(\@validfolders, \$inboxusage, \$folderusage);
2127
foreach (@validfolders) {
2128
if ($_ ne "sent-mail" || $_ ne "saved-drafts" ) {
2129
push(@checkfolders, $_);
2130
}
2131
}
2132
} else {
2133
push(@checkfolders, $folder);
2134
}
2135
2136
# identify where the original message is
2137
foreach my $foldername (@checkfolders) {
2138
my ($folderfile, $folderdb)=get_folderpath_folderdb($user, $foldername);
2139
my (%FDB, $oldstatus, $found);
2140
2141
ow::dbm::open(\%FDB, $folderdb, LOCK_EX) or
2142
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_lock'} $folderdb");
2143
if (defined($FDB{$inreplyto})) {
2144
$oldstatus = (string2msgattr($FDB{$inreplyto}))[$_STATUS];
2145
$found=1;
2146
}
2147
ow::dbm::close(\%FDB, $folderdb);
2148
2149
if ( $found ) {
2150
if ($oldstatus !~ /a/i) {
2151
# try to mark answered if get filelock
2152
if (ow::filelock::lock($folderfile, LOCK_EX)) {
2153
update_message_status($inreplyto, $oldstatus."A", $folderdb, $folderfile);
2154
ow::filelock::lock($folderfile, LOCK_UN);
2155
}
2156
}
2157
last;
2158
}
2159
}
2160
}
2161
2162
if ($senderr) {
2163
openwebmailerror(__FILE__, __LINE__, $senderrstr);
2164
} elsif ($saveerr) {
2165
openwebmailerror(__FILE__, __LINE__, $saveerrstr);
2166
} else {
2167
if (defined(param('sendbutton'))) {
2168
# delete attachments only if no error,
2169
# in case user trys resend, attachments could be available
2170
deleteattachments();
2171
2172
my $sentsubject=$subject||'N/A';
2173
if (is_convertable($composecharset, $prefs{'charset'}) ) {
2174
($sentsubject)=iconv($composecharset, $prefs{'charset'}, $sentsubject);
2175
}
2176
$sentsubject=ow::tool::escapeURL($sentsubject);
2177
print redirect(-location=>"$config{'ow_cgiurl'}/openwebmail-main.pl?action=listmessages&sessionid=$thissession&sort=$sort&folder=$escapedfolder&page=$page&sentsubject=$sentsubject");
2178
} else {
2179
# save draft, call getfolders to recalc used quota
2180
if ($quotalimit>0 && $quotausage+$messagesize>$quotalimit) {
2181
$quotausage=(ow::quota::get_usage_limit(\%config, $user, $homedir, 1))[2];
2182
}
2183
return(composemessage());
2184
}
2185
}
2186
}
2187
2188
# convert filename in attheader to same charset as message itself when sending
2189
sub _convert_attfilename {
2190
my ($prefix, $name, $postfix, $targetcharset)=@_;
2191
my $origcharset;
2192
$origcharset=$1 if ($name =~ m{=\?([^?]*)\?[bq]\?[^?]+\?=}xi);
2193
return($prefix.$name.$postfix) if ($origcharset eq '' || $origcharset eq $targetcharset);
2194
2195
if (is_convertable($origcharset, $targetcharset)) {
2196
$name=ow::mime::decode_mimewords($name);
2197
($name)=iconv($origcharset, $targetcharset, $name);
2198
$name=ow::mime::encode_mimewords($name, ('Charset'=>$targetcharset));
2199
}
2200
return($prefix.$name.$postfix);
2201
}
2202
2203
sub dump_str {
2204
my ($s, $smtp, $folderhandle, $do_send, $do_save, $r_senderr, $r_saveerr)=@_;
2205
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2206
print $folderhandle $s or ${$r_saveerr}++ if ($do_save && !${$r_saveerr});
2207
}
2208
2209
sub dump_bodytext {
2210
my ($r_body, $boundary, $composecharset, $msgformat,
2211
$smtp, $folderhandle, $do_send, $do_save, $r_senderr, $r_saveerr)=@_;
2212
2213
my $s = qq|\n--$boundary\n|.
2214
qq|Content-Type: text/plain;\n|.
2215
qq|\tcharset=$composecharset\n\n|;
2216
if ($msgformat eq "text") {
2217
$s.=${$r_body}.qq|\n|;
2218
} else {
2219
$s.=ow::htmltext::html2text(${$r_body}).qq|\n|;
2220
}
2221
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2222
2223
$s=~s/^From / From/gm;
2224
print $folderhandle $s or ${$r_saveerr}++ if ($do_save && !${$r_saveerr});
2225
2226
if ( $config{'mailfooter'}=~/[^\s]/) {
2227
$s=str2str($config{'mailfooter'}, $msgformat)."\n";
2228
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2229
}
2230
}
2231
2232
sub dump_bodyhtml {
2233
my ($r_body, $boundary, $composecharset, $msgformat,
2234
$smtp, $folderhandle, $do_send, $do_save, $r_senderr, $r_saveerr)=@_;
2235
2236
my $s = qq|\n--$boundary\n|.
2237
qq|Content-Type: text/html;\n|.
2238
qq|\tcharset=$composecharset\n|.
2239
qq|Content-Transfer-Encoding: quoted-printable\n\n|;
2240
if ($msgformat eq "text") {
2241
$s.=encode_qp(ow::htmltext::text2html(${$r_body})).qq|\n|;
2242
} else {
2243
$s.=encode_qp(${$r_body}).qq|\n|;
2244
}
2245
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2246
2247
$s=~s/^From / From/gm;
2248
print $folderhandle $s or ${$r_saveerr}++ if ($do_save && !${$r_saveerr});
2249
2250
if ( $config{'mailfooter'}=~/[^\s]/) {
2251
$s=encode_qp(str2str($config{'mailfooter'}, $msgformat))."\n";
2252
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2253
}
2254
}
2255
2256
sub dump_atts {
2257
my ($r_atts, $boundary, $composecharset,
2258
$smtp, $folderhandle, $do_send, $do_save, $r_senderr, $r_saveerr)=@_;
2259
my $s;
2260
2261
foreach my $r_att (@{$r_atts}) {
2262
$smtp->datasend("\n--$boundary\n") or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2263
print $folderhandle "\n--$boundary\n" or ${$r_saveerr}++ if ($do_save && !${$r_saveerr});
2264
2265
my $attfile="$config{ow_sessionsdir}/${$r_att}{file}";
2266
my $referenced=${$r_att}{referencecount};
2267
2268
open(ATTFILE, $attfile);
2269
# print attheader line by line
2270
while (defined($s = <ATTFILE>)) {
2271
if ($s =~ /^Content\-Id: <?att\d\d\d\d\d\d\d\d/ && !$referenced) {
2272
# remove contentid from attheader if it was set by openwebmail but not referenced,
2273
# since outlook will treat an attachment as invalid
2274
# if it has content-id but not been referenced
2275
next;
2276
}
2277
$s =~ s/^(.+name="?)([^"]+)("?.*)$/_convert_attfilename($1, $2, $3, $composecharset)/ie;
2278
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2279
print $folderhandle $s or ${$r_saveerr}++ if ($do_save && !${$r_saveerr});
2280
last if ($s =~ /^\s+$/ );
2281
}
2282
# print attbody block by block
2283
while (read(ATTFILE, $s, 32768)) {
2284
$smtp->datasend($s) or ${$r_senderr}++ if ($do_send && !${$r_senderr});
2285
print $folderhandle $s or ${$r_saveerr}++ if ($do_save && !${$r_saveerr});
2286
}
2287
close(ATTFILE);
2288
}
2289
return;
2290
}
2291
2292
########## END SENDMESSAGE #######################################
2293
2294
########## GET_TEXT_HTML #########################################
2295
sub str2str {
2296
my ($str, $format)=@_;
2297
my $is_html; $is_html=1 if ($str=~/(?:<br>|<p>|<a .*>|<font .*>|<table .*>)/is);
2298
if ($format eq 'text') {
2299
return ow::htmltext::html2text($str) if ($is_html)
2300
} else {
2301
return ow::htmltext::text2html($str) if (!$is_html);
2302
}
2303
return $str;
2304
}
2305
########## END GET_TEXT_HTML #####################################
2306
2307
########## GETATTLISTINFO ########################################
2308
sub getattfilesinfo {
2309
my (@attfiles, @sessfiles);
2310
my $totalsize = 0;
2311
2312
opendir(SESSIONSDIR, "$config{'ow_sessionsdir'}") or
2313
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}! ($!)");
2314
@sessfiles=readdir(SESSIONSDIR);
2315
closedir(SESSIONSDIR);
2316
2317
foreach my $currentfile (@sessfiles) {
2318
if ($currentfile =~ /^(\Q$thissession\E\-att\d+)$/) {
2319
my (%att, $attheader);
2320
2321
push(@attfiles, \%att);
2322
$att{file}=$1;
2323
2324
local $/="\n\n"; # read whole file until blank line
2325
open (ATTFILE, "$config{'ow_sessionsdir'}/$currentfile");
2326
$attheader=<ATTFILE>;
2327
close (ATTFILE);
2328
2329
$att{'content-type'}='application/octet-stream'; # assume attachment is binary
2330
ow::mailparse::parse_header(\$attheader, \%att);
2331
$att{'content-id'}=~s/^\s*\<(.+)\>\s*$/$1/;
2332
2333
($att{name}, $att{namecharset})=
2334
ow::mailparse::get_filename_charset($att{'content-type'}, $att{'content-disposition'});
2335
$att{name}=~s/Unknown/attachment_$#attfiles/;
2336
$att{size}=(-s "$config{'ow_sessionsdir'}/$currentfile");
2337
2338
$totalsize += $att{size};
2339
}
2340
}
2341
2342
return ($totalsize, \@attfiles);
2343
}
2344
########## END GETATTLISTINFO ####################################
2345
2346
########## DELETEATTACHMENTS #####################################
2347
sub deleteattachments {
2348
my (@delfiles, @sessfiles);
2349
2350
opendir(SESSIONSDIR, "$config{'ow_sessionsdir'}") or
2351
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}! ($!)");
2352
@sessfiles=readdir(SESSIONSDIR);
2353
closedir(SESSIONSDIR);
2354
2355
foreach my $attfile (@sessfiles) {
2356
if ($attfile =~ /^(\Q$thissession\E\-att\d+)$/) {
2357
$attfile = $1;
2358
push(@delfiles, "$config{'ow_sessionsdir'}/$attfile");
2359
}
2360
}
2361
unlink(@delfiles) if ($#delfiles>=0);
2362
}
2363
########## END DELETEATTACHMENTS #################################
2364
2365
########## FOLDING ###############################################
2366
# folding the to, cc, bcc field in case it violates the 998 char limit
2367
# defined in RFC 2822 2.2.3
2368
sub folding {
2369
return($_[0]) if (length($_[0])<960);
2370
2371
my ($folding, $line)=('', '');
2372
foreach my $token (ow::tool::str2list($_[0],0)) {
2373
if (length($line)+length($token) <960) {
2374
$line.=",$token";
2375
} else {
2376
$folding.="$line,\n ";
2377
$line=$token;
2378
}
2379
}
2380
$folding.=$line;
2381
2382
$folding=~s/^,//;
2383
return($folding);
2384
}
2385
########## END FOLDING ###########################################
2386
2387
########## REPARAGRAPH ###########################################
2388
sub reparagraph {
2389
my @lines=split(/\n/, $_[0]);
2390
my $maxlen=$_[1];
2391
my ($text,$left) = ('','');
2392
2393
foreach my $line (@lines) {
2394
if ($left eq "" && length($line) < $maxlen) {
2395
$text.="$line\n";
2396
} elsif ($line=~/^\s*$/ || # newline
2397
$line=~/^>/ || # previous orig
2398
$line=~/^#/ || # comment line
2399
$line=~/^\s*[\-=#]+\s*$/ || # dash line
2400
$line=~/^\s*[\-=#]{3,}/ ) { # dash line
2401
$text.= "$left\n" if ($left ne "");
2402
$text.= "$line\n";
2403
$left="";
2404
} else {
2405
if ($line=~/^\s*\(/ ||
2406
$line=~/^\s*\d\d?[\.:]/ ||
2407
$line=~/^\s*[A-Za-z][\.:]/ ||
2408
$line=~/\d\d:\d\d:\d\d/ ||
2409
$line=~/�G/) {
2410
$text.= "$left\n";
2411
$left=$line;
2412
} else {
2413
if ($left=~/ $/ || $line=~/^ / || $left eq "" || $line eq "") {
2414
$left.=$line;
2415
} else {
2416
$left.=" ".$line;
2417
}
2418
}
2419
2420
while ( length($left)>$maxlen ) {
2421
my $furthersplit=0;
2422
for (my $len=$maxlen-2; $len>2; $len-=2) {
2423
if ($left =~ /^(.{$len}.*?[\s\,\)\-])(.*)$/) {
2424
if (length($1) < $maxlen) {
2425
$text.="$1\n"; $left=$2;
2426
$furthersplit=1;
2427
last;
2428
}
2429
} else {
2430
$text.="$left\n"; $left="";
2431
last;
2432
}
2433
}
2434
last if ($furthersplit==0);
2435
}
2436
2437
}
2438
}
2439
$text.="$left\n" if ($left ne "");
2440
return($text);
2441
}
2442
########## END REPARAGRAPH #######################################
2443
2444
########## FAKEMESSGAEID #########################################
2445
sub fakemessageid {
2446
my $postfix=$_[0];
2447
my $fakedid = ow::datetime::gmtime2dateserial().'.M'.int(rand()*100000);
2448
if ($postfix =~ /@(.*)$/) {
2449
return("<$fakedid".'@'."$1>");
2450
} else {
2451
return("<$fakedid".'@'."$postfix>");
2452
}
2453
}
2454
########## END FAKEMESSGAEID #####################################
2455
2456
########## READSMTPERR ###########################################
2457
sub readsmtperr {
2458
my ($content, $linecount)=('', 0);
2459
2460
open(F, $_[0]);
2461
while (<F>) {
2462
s/\s*$//;
2463
if (/(>>>.*$)/ || /(<<<.*$)/) {
2464
$content.="$1\n";
2465
$linecount++;
2466
if ($linecount==50) {
2467
my $snip=(-s $_[0])-512-tell(F);
2468
if ($snip>512) {
2469
seek(F, $snip, 1);
2470
$_=<F>;
2471
$snip+=length($_);
2472
$content.="\n $snip bytes snipped ...\n\n";
2473
}
2474
}
2475
}
2476
}
2477
close(F);
2478
return($content);
2479
}
2480
########## END READSMTPERR #######################################
2481
2482
########## HTMLAREA_COMPATIBLE ###################################
2483
sub htmlarea_compatible {
2484
my $u=$ENV{'HTTP_USER_AGENT'};
2485
if ( $u=~m!Mozilla/4.0! &&
2486
$u=~m!compatible;! &&
2487
$u=~m!Windows! &&
2488
$u=~m!MSIE ([\d\.]+)! ) {
2489
return 1 if ($1>=5.5); # MSIE>=5.5 on windows platform
2490
}
2491
if ( $u=~m!Mozilla/5.0! &&
2492
$u!~m!compatible;!) {
2493
if ($u!~m!(?:Phoenix|Galeon|Firebird)/! &&
2494
$u=~m!rv:([\d\.]+)! ) {
2495
return 1 if ($1 ge "1.3"); # full Mozilla>=1.3 on all plaform
2496
}
2497
if ($u=~m!Firebird/([\d\.]+)!) {
2498
return 1 if ($1 ge "0.6.1"); # Firebird>=0.6.1 on all plaform
2499
}
2500
}
2501
return 0;
2502
}
2503
########## END HTMLAREA_COMPATIBLE ###############################
2504
2505
########## TNEFATT2ARCHIVE #######################################
2506
sub tnefatt2archive {
2507
my ($r_attachment, $convfrom, $composecharset)=@_;
2508
my $tnefbin=ow::tool::findbin('tnef');
2509
return('') if ($tnefbin eq '');
2510
2511
my $content;
2512
if (${$r_attachment}{'content-transfer-encoding'} =~ /^base64$/i) {
2513
$content = decode_base64(${${$r_attachment}{r_content}});
2514
} elsif (${$r_attachment}{'content-transfer-encoding'} =~ /^quoted-printable$/i) {
2515
$content = decode_qp(${${$r_attachment}{r_content}});
2516
} else { ## Guessing it's 7-bit, at least sending SOMETHING back! :)
2517
$content = ${${$r_attachment}{r_content}};
2518
}
2519
my ($arcname, $r_arcdata, @arcfilelist)=ow::tnef::get_tnef_archive($tnefbin, ${$r_attachment}{filename}, \$content);
2520
return('') if ($arcname eq '');
2521
2522
my $arccontenttype=ow::tool::ext2contenttype($arcname);
2523
my $arcdescription=join(', ', @arcfilelist);
2524
2525
# convfrom is the charset choosed by user in message reading
2526
# we convert att attributes from convfrom to current composecharset
2527
if (is_convertable($convfrom, $composecharset) ) {
2528
($arcname, $arcdescription)=iconv($convfrom, $composecharset, $arcname, $arcdescription);
2529
$arcname=ow::mime::encode_mimewords($arcname, ('Charset'=>$composecharset));
2530
$arcdescription=ow::mime::encode_mimewords($arcdescription, ('Charset'=>$composecharset));
2531
} else {
2532
$arcname=ow::mime::encode_mimewords($arcname, ('Charset'=>${$r_attachment}{charset}));
2533
$arcdescription=ow::mime::encode_mimewords($arcdescription, ('Charset'=>${$r_attachment}{charset}));
2534
}
2535
2536
my $attheader = qq|Content-Type: $arccontenttype;\n|.
2537
qq|\tname="$arcname"\n|.
2538
qq|Content-Disposition: attachment; filename="$arcname"\n|.
2539
qq|Content-Transfer-Encoding: base64\n|;
2540
$attheader.= qq|Content-Description: $arcdescription\n| if ($#arcfilelist>0);
2541
2542
$content=encode_base64(${$r_arcdata});
2543
return($attheader, \$content);
2544
}
2545
########## TNEFATT2ARCHIVE #######################################
2546