バイナリファイルを低負荷でダウンロードさせる PERL スクリプト

よく、バイナリファイルを出力するScriptで以下のようなのが紹介されています。

if( -e $filename ){
  $fsize = -s $filename;
  print "Content-Type: application/octet-stream\n";
  print "Content-Disposition: attachment; filename=$rfile\n";
  print "Content-Length: ".$fsize."\n\n";
  open PIC,$filename;
  binmode (PIC);
  print <PIC>;
  close (PIC);
}

でも、これだと、でっかいファイルの場合負荷がかかってしまいますよね･ω･
しかも、相手が途中でファイルの転送を取りやめても処理が続きます。

use Time::HiRes qw(sleep);

if( -e $filename ){
  $fsize = -s $filename;
  print "Content-Type: application/octet-stream\n";
  print "Content-Disposition: attachment; filename=$rfile\n";
  print "Content-Length: ".$fsize."\n\n";
  open PIC,$filename;
  binmode (PIC);
  for(my $fsz=0;$fsz<$fsize;$fsz+=1024*16){
    my $buf;
    read PIC, $buf,1024*16;
    my $res=print $buf;
    if( $res != 1 ){
      last;
    }
    sleep(0.1);
  }
  close (PIC);
}

修正版のコード。
16kバイトごとに 相手が、途中で切断してないかチェックを入れて last で抜ける処理にしてみました･ω･

print が処理に失敗しなければ 1を返すのを利用しています。

  my $pref=$query{'file'};
  my $ra=$ENV{'REMOTE_ADDR'};
  my $mm=`ps uxe| grep $pref |grep -v "ps uxe" |grep "dl\x2ecgi"|grep $ra |wc -l| cut -d" " -f1`;
  if ($mm > 1 ){
     print "Content-Type: text/html\n\n";
     print "にゃあ！<BR>";
     exit;
  }

おまけ
同じサーバーから同じデータに アクセスしてないかチェックする処理。
変数 file が同一のデータに アクセスしてる同じリモートサーバーがあったら、ダウンロードさせずに抜けさせます。
"dl\x2ecgi" はCGI名で dl.cgi のことです。 

関連サイト：
UNIX & Linux の標準出力で得たデータを、Ｃ言語のローカル変数に取り込むには？

おすすめ

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です