View | Details | Raw Unified | Return to bug 6874
Collapse All | Expand All

(-)a/C4/UploadedFiles.pm (+14 lines)
Lines 290-293 sub DelUploadedFile { Link Here
290
    return $retval;
290
    return $retval;
291
}
291
}
292
292
293
=head2 httpheaders
294
295
    httpheaders returns http headers for a retrievable upload
296
    Will be extended by report 14282
297
298
=cut
299
300
sub httpheaders {
301
    my $file= shift;
302
    return
303
        ( '-type' => 'application/octet-stream',
304
          '-attachment' => $file, );
305
}
306
293
1;
307
1;
(-)a/opac/opac-retrieve-file.pl (-16 / +6 lines)
Lines 27-47 my $input = new CGI; Link Here
27
27
28
my $id = $input->param('id');
28
my $id = $input->param('id');
29
my $file = C4::UploadedFiles::GetUploadedFile($id);
29
my $file = C4::UploadedFiles::GetUploadedFile($id);
30
exit 1 if not $file;
30
exit 1 if !$file || !-f $file->{filepath};
31
31
32
my $file_path = $file->{filepath};
32
open my $fh, '<', $file->{filepath} or die "Can't open file: $!";
33
33
print $input->header( C4::UploadedFiles::httpheaders( $file->{filename} ));
34
if( -f $file_path ) {
34
while(<$fh>) {
35
    open my $fh, '<', $file_path or die "Can't open file: $!";
35
    print $_;
36
    print $input->header(
37
        -type => "application/octet-stream",
38
        -attachment => $file->{filename}
39
    );
40
    while(<$fh>) {
41
        print $_;
42
    }
43
} else {
44
    exit 1;
45
}
36
}
46
37
close $fh;
47
exit 0;
(-)a/t/db_dependent/UploadedFiles.t (-2 / +5 lines)
Lines 3-9 Link Here
3
use Modern::Perl;
3
use Modern::Perl;
4
use File::Temp qw/ tempdir /;
4
use File::Temp qw/ tempdir /;
5
use Test::CGI::Multipart;
5
use Test::CGI::Multipart;
6
use Test::More tests => 17;
6
use Test::More tests => 18;
7
use Test::Warn;
7
use Test::Warn;
8
8
9
use t::lib::Mocks;
9
use t::lib::Mocks;
Lines 55-57 my $UploadResult; Link Here
55
warning_like { $UploadResult=C4::UploadedFiles::UploadFile($testfilename,'../',$testfile_fh->handle); } qr/^Filename or dirname contains '..'. Aborting upload/, "Expected warning for bad file upload.";
55
warning_like { $UploadResult=C4::UploadedFiles::UploadFile($testfilename,'../',$testfile_fh->handle); } qr/^Filename or dirname contains '..'. Aborting upload/, "Expected warning for bad file upload.";
56
is($UploadResult, undef, "UploadFile with dir containing \"..\" return undef");
56
is($UploadResult, undef, "UploadFile with dir containing \"..\" return undef");
57
is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without parameters returns undef');
57
is(C4::UploadedFiles::GetUploadedFile(), undef, 'GetUploadedFile without parameters returns undef');
58
- 
58
59
#trivial test for httpheaders
60
my @hdrs = C4::UploadedFiles::httpheaders('does_not_matter_yet');
61
is( @hdrs == 4 && $hdrs[1] =~ /application\/octet-stream/, 1, 'Simple test for httpheaders'); #TODO Will be extended on report 14282

Return to bug 6874