欢迎光临
我们一直在努力

一个支持HTTP续传下载的PERL程序-CGI教程,CGI文档

建站超值云服务器,限时71元/月

#!/usr/bin/perl
use io::socket;

if ($#argv <= 0) {
  print stderr "usage: getright <url> <filename>\n\n";
  print stderr "     <url>: eg. http://www.server.dom:port/path/file.ext\n";
  print stderr "<filename>: eg. filename.ext\n";
  exit(0);
} else {
  open(file, "+>>".$argv[1]) or die "cannot open $argv[1] for append: $!";
  ($length = sysseek(file,0,2)) =~ s!.*([0-9]+).*!$1!g;
  print stderr "attempting to resume $argv[1] from byte: $length\n";
}

if ($argv[0] =~ m!^ (?:http://)? (.*?) (?:\:([0-9]+))? (/.*)$!x)
  { ($server,$port,$path) = ($1, $2 || 80, $3); }

print "[$server] [$port] [$path]\n";

$socket = io::socket::inet->new(peeraddr => $server,
                                peerport => $port,
                                proto    => tcp,
                                type     => sock_stream) or die "cannot connect: $!";

print $socket "get $path http/1.0\n";
print $socket "host: $server\n";
print $socket "range: bytes=$length-\n";
print $socket "connection: close\n\n";

if (!(($reply = <$socket>) =~ /http\/1.[01] 206 partial content/)) {
  $reply =~ s!(.*)\r\n!$1!;
  print stderr "failed [$reply]\n";
  print stderr "invalid url/unrecognized reply/resume not supported.\n";
  close($socket); exit(0);
} else {
  print stderr "received valid http reply.\n";
}

while (($mime = <$socket>) =~ /\w+: /) {
  if ($mime =~ /content\-range\:\sbytes\s([0-9]+)\-([0-9]+)\/([0-9]+)/)
    { ($start,$finish,$filesize) = ($1, $2, $3); }
  if ($mime =~ /content\-length\:\s([0-9]+)/) { $total = $1; }
}

print stderr "receiving data: ";
while ($data = <$socket>) {
  $recieved += length($data);
  $percentage= int((($start+$recieved) / $filesize) * 100);
  print stderr $percentage."%"."\b"x(length($percentage)+1);
  print file $data;
}

print stderr "100%\n";
close(file);
close($socket);

# example http return header:
#
#          http/1.1 206 partial content
#          date: wed, 15 nov 1995 06:25:24 gmt
#          last-modified: wed, 15 nov 1995 04:58:08 gmt
#          content-range: bytes 21010-47021/47022
#          content-length: 26012
#          content-type: image/gif

赞(0)
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com 特别注意:本站所有转载文章言论不代表本站观点! 本站所提供的图片等素材,版权归原作者所有,如需使用,请与原作者联系。未经允许不得转载:IDC资讯中心 » 一个支持HTTP续传下载的PERL程序-CGI教程,CGI文档
分享到: 更多 (0)