为什么我用 Perl 编写的图像下载 CGI 脚本不起作用？答案

【问题标题】：Why is my image download CGI script written in Perl not working?为什么我用 Perl 编写的图像下载 CGI 脚本不起作用？
【发布时间】：2012-11-21 04:23:31
【问题描述】：

#!/usr/bin/perl 
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser); 
my $files_location; 
my $ID; 
my @fileholder;
$files_location = "C:\Users\user\Documents\hello\icon.png";
open(DLFILE, "<$files_location") ; 
@fileholder = <DLFILE>; 
close (DLFILE) ; 
print "Content-Type:application/x-download\n"; 
print "Content-Disposition:attachment;filename=$ID\n\n";
print @fileholder;

当我运行这个脚本时，它不是返回 icon.png 文件，而是返回 download.pl（上面给出的脚本的名称），里面有 no content它。有什么问题？

我目前正在使用的脚本。

#!C:\Perl64\bin\perl.exe -w 
use CGI qw(:standard);
use File::Copy qw( copy );
use File::Spec::Functions qw( catfile );
use constant IMG_DIR => catfile(qw(     D:\  ));
serve_logo(IMG_DIR);
sub serve_logo {
    my ($dir) = @_;

                my $cgi = CGI->new;

                my $file = "icon.png";
                #print $file;

                defined ($file)         or die "Invalid image name in CGI request\n";
                send_file($cgi, $dir, $file);


                return;
                }
sub send_file
  {
    my ($cgi, $dir, $file) = @_;
    my $path = catfile($dir, $file);
    open my $fh, '<:raw', $path         or die "Cannot open '$path': $!";
    print $cgi->header(         -type => 'application/octet-stream',         -attachment => $file,     ); 
    binmode STDOUT, ':raw';
     copy $fh => \*STDOUT, 8_192;      
    close $fh         or die "Cannot close '$path': $!";
    return;

}

【问题讨论】：

标签： perl cgi download

【解决方案1】：

有很多问题。第一个是您使用@fileholder = <DLFILE>; 来获取二进制文件。在 Windows 上，自动转换行尾会对该文件的内容造成严重破坏。

其他问题是：

您没有检查open 的返回值。我们甚至不知道open 是否成功。
您从不为$ID 赋值，这意味着您在回复中发送了"filename=\n\n"。
您正在使用二进制文件，使程序的内存占用与二进制文件的大小成正比。健壮的程序不会这样做。
您是 useing CGI.pm，但您既没有使用它，也没有阅读文档。
您使用的是裸字（即包全局）文件句柄。

然而，根本原因是open 失败了。为什么open 会失败？简单：

C:\temp> cat uu.pl
#!/usr/bin/env perl

使用严格；使用警告；

我的 $files_location = "C:\Users\user\Documents\hello\icon.png";
打印 "$files_location\n";

让我们尝试运行它，好吗？

C:\temp> uu
无法识别的转义 \D 在 C:\temp\uu.pl 第 5 行通过。
无法识别的转义 \h 在 C:\temp\uu.pl 第 5 行通过。
无法识别的转义 \i 在 C:\temp\uu.pl 第 5 行通过。
C:SERSSERDOCUMENTSHELLOICON.PNG

这是一个简短的脚本，说明了一种更好的方法：

use CGI qw(:standard);
use File::Copy qw( copy );
use File::Spec::Functions qw( catfile );

use constant IMG_DIR => catfile(qw(
    E:\ srv localhost images
));

serve_logo(IMG_DIR);

sub serve_logo {
    my ($dir) = @_;

    my %mapping = (
        'big' => 'logo-1600x1200px.png',
        'medium' => 'logo-800x600.png',
        'small' => 'logo-400x300.png',
        'thumb' => 'logo-200x150.jpg',
        'icon' => 'logo-32x32.gif',
    );

    my $cgi = CGI->new;

    my $file = $mapping{ $cgi->param('which') };
    defined ($file)
        or die "Invalid image name in CGI request\n";

    send_file($cgi, $dir, $file);

    return;
}

sub send_file {
    my ($cgi, $dir, $file) = @_;

    my $path = catfile($dir, $file);

    open my $fh, '<:raw', $path
        or die "Cannot open '$path': $!";

    print $cgi->header(
        -type => 'application/octet-stream',
        -attachment => $file,
    );

    binmode STDOUT, ':raw';

    copy $fh => \*STDOUT, 8_192;

    close $fh
        or die "Cannot close '$path': $!";

    return;
}

我还发了detailed explanation on my blog。

【讨论】：

sitepoint.com/file-download-script-perl 是我从哪里获得源代码的。对他来说似乎工作得很好。那么我将如何以稳健的方式下载这个二进制文件。任何教程。
嗯，对于工作的一些定义，你可能是对的。但是，这不是我对 working 的定义，很明显，它不起作用，或者你不会发布这个问题，对吧？我在这里错过了什么吗？那篇文章和其中包含的建议是废话。
看起来文本文件被复制但二进制文件没有。有错误。你知道如何克服这个问题，以便我能够下载所有类型的文件。
即使在上面的程序中，当我尝试打开一个 .png 文件时，它也会将内容打印到我的浏览器窗口中。即使我将此内容复制粘贴到文件中并重命名为 .png ，它也会显示无效文件。为什么会这样。
我已经编辑了我正在使用的脚本。当我打开浏览器窗口时，它会打印一些奇怪的字符。我做错了什么

【解决方案2】：

我花了一段时间才弄清楚出了什么问题，所以对于那些最终（像我一样）在提供大文件时遇到随机问题的人，这是我的建议：

避免使用 File::Copy，因为它为此目的存在漏洞。通过 CGI 提供数据时，syswrite 可能会在一段时间内返回 undef（$! 是“资源暂时不可用”）。

File::Copy 在这种情况下停止（返回 0，设置 $!），无法传输整个文件（或流）。

许多不同的选项可以解决这个问题，重试 syswrite，或使用阻塞套接字，但不确定哪个是最好的！

【讨论】：