cgiからhttpアクセスを行う


トップページで使っている、ニュースサイトのindexを貰ってきて表示するスクリプトに関する問い合わせが多い。
この手は使える人にだけ使って欲しいというか、コイツを改造して悪いことを行おうとするヤツが出てきても困るので詳細は説明しない。
以下のスクリプトは少し古いバージョンで、GETしたデータの加工部分は含まれていない。
企業内からも使用出来るようにproxy設定も可能だが、全ての環境で動作することを保証するものではない。


#! /usr/bin/perl
#
#Ver. 1.10
#
#proxyのリトライ回数を設定する。

$timeout = 1;
#総なめして1ループとして数える。

#loopx = 1;
#タイマを挿入してアクセス速度を落とす。
1=1秒となり、0の場合は最高速度になる。

$WAIT = 0;
#アクセス先のトップURL を設定する。

$top_url = 'http://www.hogehoge.com';
#アクセス元のページを設定する。

$ref_url = 'http://www.ahaaha.net/';
#データPOST形式の場合には、ここに送信データをセットする。

#ブランクにした場合にはGETが使用される。

$send_data = '';
#null(何も設定しなかった)場合はこのプログラムを設置したホストアドレスになる。

$SP_host = '';
#ユーザエージェントを設定する。
(ランダムに使用される)
@UA[0] = 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)';
@UA[1] = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; Q312461)';
@UA[2] = 'Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0; T312461)';
@UA[3] = 'Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)';
@UA[4] = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q312461)';
@UA[5] = 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; T312461)';
@UA[6] = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows 98; Q312461)';

#proxyサーバに対するタイムアウト時間を設定する。
(秒)
$P_timeout = 15;
#
$listfile = $ARGV[0];
$Acc = 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, owerpoint, */*';
$Acl = 'ja';
$Ace = 'gzip, deflate';
$Ach = 'iso-8859-5, unicode-1-1;q=0.8';
#jcode.plを使用する場合には1を設定する
$use_jcode = 1;
#デバッグ用表示を行うか?
$dcode = 0;
#受信ヘッダ表示を行うか?
$gcode = 0;
#受信テキスト表示を行うか?
$rcode = 0;
#送信データ表示を行う?
$spri = 0;
#proxyを使用するか?
$pcode = 0;

if (($pcode eq 1 ) && ($listfile eq '')){
   print "Error! No proxy list file\n";
}
$send_len = length($send_data);
use Socket;
if($use_jcode){
   require 'jcode.pl';
}
while ($loopx > $j){
   if ($pcode){
      if ($WAIT ne 0){
         sleep($WAIT);
      }
      &list_read;
   }else{
      $top_dir = substr($top_url, 0, rindex($top_url, '/')+1);
      &parse_url;
      eval {
         local $SIG{ALRM} = sub { die "time out" };
         alarm($P_timeout);
         &get_html_text ($open_file);
         alarm(0);
      };
      alarm(0);
      if ($@ =~ /time out/){
         if($dcode){
            print "TIME OUT \r\n";
         }
      }

   }
   $j ++ ;
}
exit();


sub list_read{
   open(READ,"$listfile");
   @list = (READ,"$listfile");
   $max = @list;
   close(READ);
   if ($dcode){
      print "max=$max\r\n";
      print "data=@list";
   }
   $i = -1;
   while($max-1 > $i){
      $i ++ ;
      $number = int(rand($max-1));
      ($proxy,$pport) = split(/ /,$list[$number],2);
      if ($dcode){
         print "count=$i\r\n";
         print "Number=$number\r\n";
         print "proxy=$proxy , port=$pport\r\n";
      }
      $top_dir = substr($top_url, 0, rindex($top_url, '/')+1);
      &parse_url;
      &get_html_text ($open_file);
      if ($WAIT ne 0){
         sleep($WAIT);
      }
   }
   if ($dcode){ print "Complate\r\n"; }
}

sub parse_url{
   $open_file = $top_url;
   $open_dir = substr($open_file, 0, rindex($open_file, '/')+1);
}
sub get_html_text ($) {
   my ($url) = @_;
   $intext = '';
   local (*IN);
   return '' if ($url eq '');
   my ($h, $d, $server, $files) = split(/\//, $url, 4);
   $file = "/";
   $file .= $files;
   if ($dcode){
      print "-----------------\r\n";
      print "h=$h\r\n";
      print "-----------------\r\n";
      print "d=$d\r\n";
      print "-----------------\r\n";
      print "Target URL=$server\r\n";
   }

   my ($server, $port)= split(/\ /, $server);
      if ($port eq ''){$port = 80;}
      if ($pcode){
         if ($pport ne ''){ $port=$pport };
         $host = $server;
         $server = $proxy;
         $file = $top_url;
      }
      if ($SP_host ne ''){
         $host = $SP_host;
      }
      if ($dcode){
         print "-----------------\r\n";
         print "Server=$server\r\n";
         print "-----------------\r\n";
         print "Port=$port";
         print "-----------------\r\n";
         print "File=$file\r\n";
         print "-----------------\r\n";
      }

      eval{
         local $SIG{ALRM} = sub { die "S time out"};
         alarm($P_timeout);
         $send_timeout = 0;

         $remote_address = sockaddr_in($port, inet_aton($server));
         $proto = getprotobyname('tcp');
         socket(IN,PF_INET,SOCK_STREAM,$proto) || die "Socket $!";
         my $c = 0;
         $error = '';

         do {
            if ($dcode){
               print "Wait(result)\r\n";
            }
            $result = connect(IN, $remote_address);
            if ($dcode){
               print "********Access********$c Result=$result\r\n";
            }
            if ($c++ >= $timeout) {
               if($dcode){
                  &print_error( 'Connection time out' );
               }
            }
            if ($result != 1) { sleep(1); }
         } while ($result != 1);
      };
      alarm(0);
      if ($@ =~ /S time out/){
         $send_timeout = 1;
      } else {
         $send_timeout = 0;
      }
      if (($dcode) && ($send_timeout eq 1)){
         print "Send Time Out-->skipped\n";
      }
      if (($error eq "") && ($send_timeout eq 0 )){
         $UAnumber = int(rand(6));
         $SUA = @UA[$UAnumber];
         eval{
            local $SIG{ALRM} = sub { die "time out"};
            alarm($P_timeout);
            select((select(IN), $| = 1)[0]);
            if ($send_data eq ''){
               print IN "GET $file HTTP/1.1\r\n";
            }else{
               print IN "POST $file HTTP/1.1\r\n";
            }
            print IN "Referer $ref_url\r\n";
            print IN "Host $server\r\n";
            print IN "Accept $Acc\r\n";
            print IN "Accept-Language $Acl\r\n";
            print IN "Accept-Encoding $Ace\r\n";
            print IN "Accept-Charset $Ach\r\n";
            print IN "User-Agent $SUA\r\n";
            print IN "Connection keep-alive\n";
            print IN "Content-Type application/x-www-form-urlencoded\n";
            if ($send_data ne ''){
               print IN "Content-Length $send_len\n";
               print IN "\r\n";
               print IN "$send_data\n";
            }
            print IN "\r\n";
            alarm(0);
         };
         if ($spri){
            if ($send_data eq ''){
               print "GET $file HTTP/1.1\r\n";
            }else{
               print "POST $file HTTP/1.1\r\n";
            }
            print "Referer $ref_url\r\n";
            print "Host $server\r\n";
            print "Accept $Acc\r\n";
            print "Accept-Language $Acl\r\n";
            print "Accept-Encoding $Ace\r\n";
            print "Accept-Charset $Ach\r\n";
            print "User-Agent $SUA\r\n";
            print "Connection keep-alive\n";
            print "Content-Type application/x-www-form-urlencoded\n";
            if ($send_data ne ''){
               print "Content-Length $send_len\n";
               print "\r\n";
               print "$send_data\n";  
            }
            print "\r\n";
         }

         if ($dcode){
            if ($@ =~ /time out/){
               print ">>>>>>>>>Send Timeout<<<<<<<<<<<\n";
            }
         }
         eval {
            local $SIG{ALRM} = sub { die "time out"};
            alarm($P_timeout);
            while (<IN>) {
               $inhead .= $_ ;
               if ($gcode){
                  print;
               }
               m/^\r\n$/ && last;
            }
            while(<IN>){
               # s/\n//g;
               $intext .= $_ ;
            }
            close(IN);
            alarm(0);
         };
         alarm(0);
         if ($dcode){
            if ($@ =~ /time out/){
               print "...........Response timeout...\n";
            }
         }
         if($use_jcode){
            jcode convert( \$intext , 'sjis' ) ;
         }
         if ($rcode){
            print $intext;
         }
      }
}

sub print_error($) {
   print "@_";
   $error = 1;
   $result = 1;
}
sub print($) {
   if($dcode){
      print "@_\n";
   }
}