Perl从这个脚本继续下载

时间:2013-03-04 16:26:12

标签: perl http-headers download

我有这个基于Perl的下载脚本。 我想知道如何确保当用户使用此脚本下载文件时,可以暂停和恢复下载(下载可恢复)。 这是代码:

#!/usr/bin/perl
use XFSConfig;
use HCE_MD5;
use CGI::Carp qw(fatalsToBrowser);

my $code = (split('/',$ENV{REQUEST_URI}))[-2];

my $hce = HCE_MD5->new($c->{dl_key},"XFileSharingPRO");
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/$file_code";
print("Content-type:text/html\n\nWrong IP"),exit if $ip && $ENV{REMOTE_ADDR}!~/^$ip/;
my $fsize = -s "$c->{upload_dir}/$dx/$file_code";
$|++;
open(my $in_fh,"$c->{upload_dir}/$dx/$file_code") || die"Can't open source file";

# unless($ENV{HTTP_ACCEPT_CHARSET}=~/utf-8/i)
# {
#    $fname =~ s/([^A-Za-z0-9\-_.!~*'() ])/ uc sprintf "%%%02x",ord $1 /eg;
#    $fname =~ tr/ /+/;
# }
print qq{Content-Type: application/octet-stream\n};
print qq{Content-length: $fsize\n};
#print qq{Content-Disposition: attachment; filename="$fname"\n};
print qq{Content-Disposition: attachment\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*', $_);
}

由于

1 个答案:

答案 0 :(得分:1)

要暂停和恢复下载,您应该处理http范围标题。 看看http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.35