Question

我正在编辑一个用Perl下载文件的脚本。稍微研究一下，我设法找到了一个解决方案，但显然只适用于Chrome。坦率地说，我不能对FireFox采取任何脚本错误，所以我无法解决。这是我所做的改变：

my $content_length = $fsize;
my ($startrange, $endrange) = (0,$fsize-1);
if(defined $ENV{HTTP_RANGE} and $ENV{HTTP_RANGE}=~ /bytes\s*=\s*(\d+)-(\d+)?/) {
        ($startrange,$endrange) = ($1,$2 || $endrange);
        $content_length = $endrange-$startrange;
        print qq{HTTP/1.1 206 Partial Content\n};
        print qq{Accept-Ranges: bytes\n};
        my $operazioni = $startrange-$endrange/$fsize;
        print qq{Content-Range: bytes "$operazioni"\n};
        seek $in_fh, $startrange, 0;
}

但是，我带有整个代码：

#!/usr/bin/perl
use Config;
use HCE_MD5;
use CGI::Carp qw(fatalsToBrowser);
use CGI ':standard';
#my $code = (split('/',$ENV{REQUEST_URI}))[-2];
my $code = param('code');
my $fname = param('fname');
my $ff = param('ff');
my $hce = HCE_MD5->new($c->{dl_key},"vfp202e8");
my ($file_id,$file_code,$speed,$ip1,$ip2,$ip3,$ip4,$expire) = unpack("LA12SC4L", $hce->hce_block_decrypt(decode($code)) );
print("Content-type:text/html\n\nLink expired"),exit if time > $expire;
$speed||=500;
my $dx = sprintf("%05d",$file_id/$c->{files_per_folder});
my $ip="$ip1.$ip2.$ip3.$ip4";
$ip=~s/\.0$/.\\d+/;
$ip=~s/\.0\./.\\d+./;
$ip=~s/\.0\./.\\d+./;
$ip=~s/^0\./\\d+./;
print("Content-type:text/html\n\nNo file"),exit unless -f "$c->{upload_dir}/$dx/$fname";
my $fsize = -s "$c->{upload_dir}/$dx/$fname";
$|++;
open(my $in_fh,"$c->{upload_dir}/$dx/$fname") || die"Can't open source file";
my $content_length = $fsize;
my ($startrange, $endrange) = (0,$fsize-1);
if(defined $ENV{HTTP_RANGE} and $ENV{HTTP_RANGE}=~ /bytes\s*=\s*(\d+)-(\d+)?/) {
        ($startrange,$endrange) = ($1,$2 || $endrange);
        $content_length = $endrange-$startrange;
        print qq{HTTP/1.1 206 Partial Content\n};
        print qq{Accept-Ranges: bytes\n};
        my $operazioni = $startrange-$endrange/$fsize;
        print qq{Content-Range: bytes "$operazioni"\n};
        seek $in_fh, $startrange, 0;
}
print qq{Content-Type: application/octet-stream\n};
print qq{Content-length: $fsize\n};
print qq{Content-Disposition: attachment; filename="$ff"\n};
print qq{Content-Transfer-Encoding: binary\n\n};

$speed = int 1024*$speed/10;
my $buf;
while( read($in_fh, $buf, $speed) )
{
   print $buf;
   select(undef,undef,undef,0.1);
}

sub decode
{
        $_ = shift;
        my( $l );
        tr|a-z2-7|\0-\37|;
        $_=unpack('B*', $_);
        s/000(.....)/$1/g;
        $l=length;
        $_=substr($_, 0, $l & ~7) if $l & 7;
        $_=pack('B*', $_);
}

由于不同的浏览器可能会发送不同的请求吗？

由于

Perl简历下载仅适用于Chrome

0 个答案: