Sharedwww / cgi-bin / openwebmail / openwebmail-viewatt.plOpen in CoCalc
Author: William A. Stein
1
#!/usr/bin/perl
2
#
3
# openwebmail-viewatt.pl - attachment reading 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
24
require "modules/dbm.pl";
25
require "modules/suid.pl";
26
require "modules/filelock.pl";
27
require "modules/tool.pl";
28
require "modules/datetime.pl";
29
require "modules/lang.pl";
30
require "modules/mime.pl";
31
require "modules/mailparse.pl";
32
require "modules/tnef.pl";
33
require "modules/htmltext.pl";
34
require "modules/htmlrender.pl";
35
require "modules/execute.pl";
36
require "auth/auth.pl";
37
require "quota/quota.pl";
38
require "shares/ow-shared.pl";
39
require "shares/iconv.pl";
40
require "shares/maildb.pl";
41
require "shares/lockget.pl";
42
43
# common globals
44
use vars qw(%config %config_raw);
45
use vars qw($thissession);
46
use vars qw($domain $user $userrealname $uuid $ugid $homedir);
47
use vars qw(%prefs %style);
48
use vars qw($quotausage $quotalimit);
49
50
# extern vars
51
use vars qw(%lang_wdbutton %lang_text %lang_err); # defined in lang/xy
52
use vars qw($_SUBJECT $_CHARSET); # defined in maildb.pl
53
54
# local global
55
use vars qw($folder);
56
use vars qw($sort $page);
57
use vars qw($searchtype $keyword);
58
use vars qw($escapedkeyword);
59
60
########## MAIN ##################################################
61
openwebmail_requestbegin();
62
$SIG{PIPE}=\&openwebmail_exit; # for user stop
63
$SIG{TERM}=\&openwebmail_exit; # for user stop
64
65
userenv_init();
66
67
if (!$config{'enable_webmail'}) {
68
openwebmailerror(__FILE__, __LINE__, "$lang_text{'webmail'} $lang_err{'access_denied'}");
69
}
70
71
$folder = param('folder') || 'INBOX';
72
$page = param('page') || 1;
73
$sort = param('sort') || $prefs{'sort'} || 'date';
74
$keyword = param('keyword') || '';
75
$searchtype = param('searchtype') || 'subject';
76
77
$escapedkeyword = ow::tool::escapeURL($keyword);
78
79
my $action = param('action')||'';
80
if ($action eq "viewattachment") {
81
viewattachment();
82
} elsif ($action eq "saveattachment" && $config{'enable_webdisk'}) {
83
saveattachment();
84
} elsif ($action eq "viewattfile") {
85
viewattfile();
86
} elsif ($action eq "saveattfile" && $config{'enable_webdisk'}) {
87
saveattfile();
88
} else {
89
openwebmailerror(__FILE__, __LINE__, "Action $lang_err{'has_illegal_chars'}");
90
}
91
92
openwebmail_requestend();
93
########## END MAIN ##############################################
94
95
########## VIEWATTACHMENT/SAVEATTACHMENT #########################
96
sub viewattachment { # view attachments inside a message
97
my $messageid = param('message_id')||'';
98
my $nodeid = param('attachment_nodeid');
99
my $wordpreview=param('wordpreview')||0;
100
101
my ($attfilename, $length, $r_attheader, $r_attbody)=getattachment($folder, $messageid, $nodeid, $wordpreview);
102
103
if (${$r_attheader}=~m!Content-Type: text/!i && $length>512 &&
104
is_http_compression_enabled()) {
105
my $zattbody=Compress::Zlib::memGzip($r_attbody); undef(${$r_attbody}); undef($r_attbody);
106
my $zlen=length($zattbody);
107
my $zattheader=qq|Content-Encoding: gzip\n|.
108
qq|Vary: Accept-Encoding\n|.
109
${$r_attheader};
110
$zattheader=~s!Content\-Length: .*?\n!Content-Length: $zlen\n!ims;
111
print $zattheader, "\n", $zattbody;
112
} else {
113
print ${$r_attheader}, "\n", ${$r_attbody};
114
}
115
return;
116
}
117
118
sub saveattachment { # save attachments inside a message to webdisk
119
my $messageid = param('message_id')||'';
120
my $nodeid = param('attachment_nodeid');
121
my $webdisksel=param('webdisksel')||'';
122
123
my ($attfilename, $length, $r_attheader, $r_attbody)=getattachment($folder, $messageid, $nodeid);
124
savefile2webdisk($attfilename, $length, $r_attbody, $webdisksel);
125
}
126
127
sub getattachment {
128
my ($folder, $messageid, $nodeid, $wordpreview)=@_;
129
my ($folderfile, $folderdb)=get_folderpath_folderdb($user, $folder);
130
my $folderhandle=do { local *FH };
131
my ($msgsize, $errmsg, $block);
132
133
($msgsize, $errmsg)=lockget_message_block($messageid, $folderfile, $folderdb, \$block);
134
if ( $msgsize<=0 ) {
135
openwebmailerror(__FILE__, __LINE__, "What the heck? Message ".ow::htmltext::str2html($messageid)." seems to be gone!");
136
}
137
138
my @attr=get_message_attributes($messageid, $folderdb);
139
my $convfrom=param('convfrom')||'';
140
if ($convfrom eq "") {
141
if ( is_convertable($attr[$_CHARSET], $prefs{'charset'}) ) {
142
$convfrom=lc($attr[$_CHARSET]);
143
} else {
144
$convfrom='none.prefscharset';
145
}
146
}
147
148
if ( $nodeid eq 'all' ) {
149
# return whole msg as an message/rfc822 object
150
my $subject = $attr[$_SUBJECT];
151
if (is_convertable($convfrom, $prefs{'charset'}) ) {
152
($subject)=iconv($convfrom, $prefs{'charset'}, $subject);
153
}
154
$subject =~ s/\s+/_/g;
155
156
my $length = length($block);
157
my $attheader=qq|Content-Length: $length\n|.
158
qq|Connection: close\n|.
159
qq|Content-Type: message/rfc822; name="$subject.msg"\n|;
160
161
# disposition:attachment default to save
162
if ( $ENV{'HTTP_USER_AGENT'}=~/MSIE 5.5/ ) { # ie5.5 is broken with content-disposition: attachment
163
$attheader.=qq|Content-Disposition: filename="$subject.msg"\n|;
164
} else {
165
$attheader.=qq|Content-Disposition: attachment; filename="$subject.msg"\n|;
166
}
167
168
# allow cache for msg in folder other than saved-drafts
169
if ($folder ne 'saved-drafts') {
170
$attheader.=qq|Expires: |.CGI::expires('+900s').qq|\n|.
171
qq|Cache-Control: private,max-age=900\n|;
172
}
173
174
return("$subject.msg", $length, \$attheader, \$block);
175
176
} else {
177
# return a specific attachment
178
my ($header, $body, $r_attachments)=ow::mailparse::parse_rfc822block(\$block, "0", $nodeid);
179
undef($block);
180
181
my $r_attachment;
182
for (my $i=0; $i<=$#{$r_attachments}; $i++) {
183
if ( ${${$r_attachments}[$i]}{nodeid} eq $nodeid ) {
184
$r_attachment=${$r_attachments}[$i];
185
}
186
}
187
if (defined($r_attachment)) {
188
my $charset=${$r_attachment}{filenamecharset}||
189
${$r_attachment}{charset}||
190
$convfrom||
191
$attr[$_CHARSET];
192
my $contenttype = ${$r_attachment}{'content-type'};
193
my $filename = ${$r_attachment}{filename}; $filename=~s/\s$//;
194
my $content;
195
if (${$r_attachment}{'content-transfer-encoding'} =~ /^base64$/i) {
196
$content = decode_base64(${${$r_attachment}{r_content}});
197
} elsif (${$r_attachment}{'content-transfer-encoding'} =~ /^quoted-printable$/i) {
198
$content = decode_qp(${${$r_attachment}{r_content}});
199
} elsif (${$r_attachment}{'content-transfer-encoding'} =~ /^x-uuencode$/i) {
200
$content = ow::mime::uudecode(${${$r_attachment}{r_content}});
201
} else { ## Guessing it's 7-bit, at least sending SOMETHING back! :)
202
$content = ${${$r_attachment}{r_content}};
203
}
204
205
if ($contenttype =~ m#^application/ms\-tnef#) { # try to convery tnef -> zip/tgz/tar
206
my $tnefbin=ow::tool::findbin('tnef');
207
if ($tnefbin ne '') {
208
my ($arcname, $r_arcdata)=ow::tnef::get_tnef_archive($tnefbin, $filename, \$content);
209
if ($arcname ne '') { # tnef extraction and conversion successed
210
$filename=$arcname;
211
$contenttype=ow::tool::ext2contenttype($filename);
212
$content=${$r_arcdata};
213
}
214
}
215
}
216
217
if ($contenttype =~ m#^text/html#i ) { # try to rendering html
218
my $escapedfolder = ow::tool::escapeURL($folder);
219
my $escapedmessageid = ow::tool::escapeURL($messageid);
220
$content = ow::htmlrender::html4nobase($content);
221
# $content = ow::htmlrender::html4link($content);
222
$content = ow::htmlrender::html4disablejs($content) if ($prefs{'disablejs'});
223
$content = ow::htmlrender::html4disableembcode($content) if ($prefs{'disableembcode'});
224
$content = ow::htmlrender::html4disableemblink($content, $prefs{'disableemblink'}, "$config{'ow_htmlurl'}/images/backgrounds/Transparent.gif") if ($prefs{'disableemblink'} ne 'none');
225
$content = ow::htmlrender::html4attachments($content, $r_attachments, "$config{'ow_cgiurl'}/openwebmail-viewatt.pl", "action=viewattachment&amp;sessionid=$thissession&amp;message_id=$escapedmessageid&amp;folder=$escapedfolder");
226
# $content = ow::htmlrender::html4mailto($content, "$config{'ow_cgiurl'}/openwebmail-send.pl", "action=composemessage&amp;sort=$sort&amp;keyword=$escapedkeyword&amp;searchtype=$searchtype&amp;folder=$escapedfolder&amp;page=$page&amp;sessionid=$thissession&amp;composetype=sendto");
227
}
228
229
if (is_convertable($charset, $prefs{'charset'})) {
230
($filename)=iconv($charset, $prefs{'charset'}, $filename);
231
}
232
# remove char disallowed in some fs
233
if ($prefs{'charset'} eq 'big5' || $prefs{'charset'} eq 'gb2312') {
234
$filename = ow::tool::zh_dospath2fname($filename, '_'); # dos path
235
} else {
236
$filename =~ s|\\|_|; # dos path
237
}
238
$filename =~ s|^.*/||; # unix path
239
$filename =~ s|^.*:||; # mac path and dos drive
240
$filename=safedlname($filename);
241
242
# we change the filename of an attachment
243
# from *.exe, *.com *.bat, *.pif, *.lnk, *.scr to *.file
244
# if its contenttype is not application/octet-stream
245
# to avoid this attachment is referenced by html and executed directly ie
246
if ( $filename =~ /\.(?:exe|com|bat|pif|lnk|scr)$/i &&
247
$contenttype !~ /application\/octet\-stream/i &&
248
$contenttype !~ /application\/x\-msdownload/i ) {
249
$filename="$filename.file";
250
}
251
252
if ( $contenttype =~ /application\/octet\-stream/i &&
253
$filename =~ /\.(jpg|jpeg|gif|png|bmp)$/i ) {
254
# change contenttype of image to make it directly displayed by browser
255
$contenttype="image/".lc($1);
256
} elsif ($contenttype =~ /^message\//i) {
257
# set message contenttype to text/plain for easy view
258
$contenttype = "text/plain";
259
}
260
261
if ($wordpreview && $filename =~ /\.(?:doc|dot)$/i && # in wordpreview mode?
262
msword2html(\$content)) {
263
$contenttype="text/html";
264
}
265
266
my $length=length($content);
267
my $attheader=qq|Content-Length: $length\n|.
268
qq|Connection: close\n|.
269
qq|Content-Type: $contenttype; name="$filename"\n|;
270
if ($contenttype =~ /^text/i) {
271
$attheader.=qq|Content-Disposition: inline; filename="$filename"\n|;
272
} else {
273
# disposition:attachment default to save
274
if ( $ENV{'HTTP_USER_AGENT'}=~/MSIE 5.5/ ) { # ie5.5 is broken with content-disposition: attachment
275
$attheader.=qq|Content-Disposition: filename="$filename"\n|;
276
} else {
277
$attheader.=qq|Content-Disposition: attachment; filename="$filename"\n|;
278
}
279
}
280
281
# allow cache for msg attachment in folder other than saved-drafts
282
if ($folder ne 'saved-drafts') {
283
$attheader.=qq|Expires: |.CGI::expires('+900s').qq|\n|.
284
qq|Cache-Control: private,max-age=900\n|;
285
}
286
287
# use undef to free memory before attachment transfer
288
undef %{$r_attachment}; undef $r_attachment;
289
undef @{$r_attachments}; undef $r_attachments;
290
291
return($filename, $length, \$attheader, \$content);
292
} else {
293
openwebmailerror(__FILE__, __LINE__, "What the heck? Message ".ow::htmltext::str2html($messageid)." $nodeid seems to be gone!");
294
}
295
}
296
# never reach
297
}
298
########## END VIEWATTACHMENT ####################################
299
300
########## VIEWATTFILE/SAVEATTFILE ###############################
301
sub viewattfile { # view attachments uploaded to $config{'ow_sessionsdir'}
302
my $attfile=param('attfile')||''; $attfile =~ s/\///g; # just in case someone gets tricky ...
303
my $wordpreview=param('wordpreview')||0;
304
my ($attfilename, $length, $r_attheader, $r_attbody)=getattfile($attfile, $wordpreview);
305
306
if (${$r_attheader}=~m!Content-Type: text/!i && $length>512 &&
307
is_http_compression_enabled()) {
308
my $zattbody=Compress::Zlib::memGzip($r_attbody); undef(${$r_attbody}); undef($r_attbody);
309
my $zlen=length($zattbody);
310
my $zattheader=qq|Content-Encoding: gzip\n|.
311
qq|Vary: Accept-Encoding\n|.
312
${$r_attheader};
313
$zattheader=~s!Content\-Length: .*?\n!Content-Length: $zlen\n!ims;
314
print $zattheader, "\n", $zattbody;
315
} else {
316
print ${$r_attheader}, "\n", ${$r_attbody};
317
}
318
return;
319
}
320
321
sub saveattfile { # save attachments uploaded to $config{'pw_sessiondir'} to webdisk
322
my $attfile=param('attfile')||'';
323
my $webdisksel=param('webdisksel')||'';
324
325
my ($attfilename, $length, $r_attheader, $r_attbody)=getattfile($attfile);
326
savefile2webdisk($attfilename, $length, $r_attbody, $webdisksel);
327
}
328
329
sub getattfile {
330
my ($attfile, $wordpreview)=@_;
331
332
# only allow to view attfiles belongs the $thissession
333
if ($attfile!~/^\Q$thissession\E/ || !-f "$config{'ow_sessionsdir'}/$attfile") {
334
openwebmailerror(__FILE__, __LINE__, "What the heck? Attfile $config{'ow_sessionsdir'}/$attfile seems to be gone!");
335
}
336
337
my (%att, $attheader, $attcontent);
338
open(ATTFILE, "$config{'ow_sessionsdir'}/$attfile") or
339
openwebmailerror(__FILE__, __LINE__, "$lang_err{'couldnt_open'} $config{'ow_sessionsdir'}/$attfile! ($!)");
340
local $/="\n\n"; $attheader=<ATTFILE>; # read until 1st blank line
341
undef $/; $attcontent=<ATTFILE>; # read until file end
342
close(ATTFILE);
343
344
$att{'content-type'}='application/octet-stream'; # assume att is binary
345
ow::mailparse::parse_header(\$attheader, \%att);
346
($att{filename}, $att{filenamecharset})=
347
ow::mailparse::get_filename_charset($att{'content-type'}, $att{'content-disposition'});
348
349
if ($att{'content-transfer-encoding'} =~ /^base64$/i) {
350
$attcontent = decode_base64($attcontent);
351
} elsif ($att{'content-transfer-encoding'} =~ /^quoted-printable$/i) {
352
$attcontent = decode_qp($attcontent);
353
} elsif ($att{'content-transfer-encoding'} =~ /^x-uuencode$/i) {
354
$attcontent = ow::mime::uudecode($attcontent);
355
}
356
357
if ($wordpreview && $att{filename} =~ /\.(?:doc|dot)$/i && # in wordpreview mode?
358
msword2html(\$attcontent)) {
359
$attheader=~s!$att{'content-type'}!text/html!;
360
$att{'content-type'}="text/html";
361
}
362
363
# rebuild attheader for download, disposition:inline means default to open
364
my $length = length($attcontent);
365
$attheader= qq|Content-Length: $length\n|.
366
qq|Connection: close\n|.
367
qq|Content-Type: $att{'content-type'}; name="$att{filename}"\n|.
368
qq|Content-Disposition: inline; filename="$att{filename}"\n|;
369
# allow cache for attfile since its filename is based on times()
370
$attheader.=qq|Expires: |.CGI::expires('+900s').qq|\n|.
371
qq|Cache-Control: private,max-age=900\n|;
372
373
return($att{filename}, $length, \$attheader, \$attcontent);
374
}
375
########## END VIEWATTATTFILE ####################################
376
377
########## SAVEFILE2WEBDISK ######################################
378
sub savefile2webdisk {
379
my ($filename, $length, $r_content, $webdisksel)=@_;
380
381
if ($quotalimit>0 && $quotausage+$length/1024>$quotalimit) {
382
$quotausage=(ow::quota::get_usage_limit(\%config, $user, $homedir, 1))[2]; # get uptodate quotausage
383
if ($quotausage + $length/1024 > $quotalimit) {
384
autoclosewindow($lang_text{'quotahit'}, $lang_err{'quotahit_alert'});
385
}
386
}
387
388
my $webdiskrootdir=ow::tool::untaint($homedir.absolute_vpath("/", $config{'webdisk_rootpath'}));
389
my $vpath=absolute_vpath('/', $webdisksel);
390
my $err=verify_vpath($webdiskrootdir, $vpath);
391
openwebmailerror(__FILE__, __LINE__, $err) if ($err);
392
393
if (-d "$webdiskrootdir/$vpath") { # use choose a dirname, save att with its original name
394
$vpath=absolute_vpath($vpath, $filename);
395
$err=verify_vpath($webdiskrootdir, $vpath);
396
openwebmailerror(__FILE__, __LINE__, $err) if ($err);
397
}
398
$vpath=ow::tool::untaint($vpath);
399
400
if (!open(F, ">$webdiskrootdir/$vpath") ) {
401
autoclosewindow($lang_text{'savefile'}, "$lang_text{'savefile'} $lang_text{'failed'} ($vpath: $!)");
402
}
403
ow::filelock::lock("$webdiskrootdir/$vpath", LOCK_EX) or
404
autoclosewindow($lang_text{'savefile'}, "$lang_err{'couldnt_lock'} $webdiskrootdir/$vpath!");
405
print F ${$r_content};
406
close(F);
407
chmod(0644, "$webdiskrootdir/$vpath");
408
ow::filelock::lock("$webdiskrootdir/$vpath", LOCK_UN);
409
410
writelog("save attachment - $vpath");
411
writehistory("save attachment - $vpath");
412
413
autoclosewindow($lang_text{'savefile'}, "$lang_text{'savefile'} $lang_text{'succeeded'} ($vpath)");
414
}
415
########## END SAVEFILE2WEBDISK ##################################
416
417
########## MSWORD2HTML ###########################################
418
sub msword2html {
419
my $r_content=$_[0];
420
my $antiwordbin=ow::tool::findbin('antiword');
421
return 0 if ($antiwordbin eq '');
422
423
my $tmpfile=ow::tool::untaint("/tmp/.msword2html.tmpfile.$$");
424
my $err=0;
425
open(F, ">$tmpfile") or return 0;
426
print F ${$r_content} or $err++;
427
close(F);
428
if ($err) {
429
unlink($tmpfile);
430
return 0;
431
}
432
my ($stdout, $stderr, $exit, $sig)=ow::execute::execute($antiwordbin, '-m', 'UTF-8.txt', $tmpfile);
433
unlink($tmpfile);
434
return 0 if ($exit||$sig);
435
436
my $charset=$prefs{'charset'};
437
if (is_convertable('utf-8', $prefs{'charset'}) ) {
438
($stdout)=iconv('utf-8', $prefs{'charset'}, $stdout);
439
} else {
440
$charset='utf-8';
441
}
442
${$r_content}=qq|<html><head><meta http-equiv="Content-Type" content="text/html; charset=$charset">\n|.
443
qq|<title>MS Word $lang_wdbutton{'preview'}</title></head>\n|.
444
qq|<body><pre>\n$stdout\n</pre></body></html>\n|;
445
return 1;
446
}
447
########## MSWORD2HTML ###########################################
448