HTTP proxy サーバを作ってみよう

前へ << HTTP の並行アクセス モジュールをインストールしよう >> 次へ

HTTP proxy サーバ

IO::Socket、IO::Select モジュールを使って、個人用 HTTP proxy サーバを作ってみました。

User-Agent や Referer などの書き換え、コンテンツの書き換えを目的として作り始めましたが、 現時点では中継機能しか実装されていません。proxy の雛型としてどうぞ。

% ./http-proxy.pl
とすると、ポート 8080 を listen しますので、ブラウザの proxy 設定を localhost:8080 にしてください。なお、keep-alive と SSL は未対応で、 メソッドは GET・POST のみ実装されています。

http-proxy.pl

    1: #!/usr/local/bin/perl
    2: 
    3: # $Id: http-proxy.pl,v 1.2 2003/05/17 14:31:02 68user Exp $
    4: 
    5: require 5.000;
    6: 
    7: use strict;
    8: 
    9: use IO::Socket;
   10: use IO::Select;
   11: 
   12: # 接続する proxy。直接接続なら $real_proxy=''; とすること。
   13: my $real_proxy = 'proxy.hoge.co.jp:8080';
   14: 
   15: # $real_proxy を経由しないホスト名。正規表現で記述。
   16: my @noproxy_hosts = qw(localhost hoge\.co\.jp);
   17: 
   18: # proxy 用ポート番号
   19: my $listen_port = 8080;
   20: 
   21: my $sock_waiting = IO::Socket::INET->new(Listen    => SOMAXCONN,
   22:                                          LocalPort => $listen_port,
   23:                                          Proto     => 'tcp',
   24:                                          Reuse     => 1,
   25:                                          # 自サーバ以外からの接続を許すなら LocalAddr をコメントアウトする。
   26:                                          LocalAddr => 'localhost', 
   27:                                          );
   28: my $selecter = IO::Select->new;
   29: $selecter->add($sock_waiting);
   30: 
   31: my %conn_table;
   32: my %conn_table_rev;
   33: my %request;
   34: 
   35: #-------------------
   36: # SIGPIPE シグナルを受けても終了しないようにする。例えば、web サーバからの
   37: # レスポンスをブラウザに渡そうと print したが、それより前にブラウザの中止ボタンが
   38: # 押されていた、というときに SIGPIPE が飛んでくる。
   39: 
   40: $SIG{PIPE} = sub {
   41:     print "Caught SIGPIPE. But continue..\n";
   42: };
   43: 
   44: 
   45: while (1){
   46:     print "Begin select\n";
   47: 
   48:     my ($clients) = IO::Select->select($selecter, undef, undef, undef);
   49:     if ( @$clients == 0 ){
   50:         next;
   51:     }
   52: 
   53:     foreach my $sock (@$clients){
   54:         print "  socket_descripter=", $sock->fileno, "\n";
   55: 
   56:         if ( $sock == $sock_waiting ){
   57:             # ブラウザからの新しい接続あり
   58:             my $new_sock = $sock_waiting->accept;
   59:             $selecter->add($new_sock);
   60:             printf "    New client comes (%d).\n", $new_sock->fileno;
   61: 
   62:         } else {
   63: 
   64:             if ( $conn_table{$sock} ){
   65:                 # web サーバからのデータがあるか、web サーバとのコネクション切断
   66: 
   67:                 my $buf;
   68:                 my $read_len = sysread($sock, $buf, 10000);
   69:                 if ( $buf ){
   70:                     # web サーバからのデータあり
   71:                     print "  FROM Web server. Read OK ($read_len bytes).\n";
   72: 
   73:                     my $fn = $conn_table{$sock};
   74: 
   75:                     select($fn); $|=1; select(STDOUT);
   76: 
   77:                     print $fn $buf;
   78:                 } else {
   79:                     # web サーバとのコネクション切断
   80:                     print "  FROM Web server. Finished.\n";
   81:                     printf "    close(%d)\n", $conn_table{$sock}->fileno;
   82: 
   83:                     &remove_contable($conn_table{$sock});
   84: 
   85:                     shutdown($conn_table{$sock}, 2);
   86:                     shutdown($sock, 2);
   87: 
   88:                     $conn_table{$sock} = undef;
   89:                 }
   90:             } else {
   91:                 # ブラウザからのデータあり
   92:                 my $buf;
   93:                 sysread($sock, $buf, 10000);
   94:                     
   95:                 if ( $buf ){
   96:                     print "  FROM Browser. Read OK.\n";
   97:                     $request{$sock} .= $buf;
   98: 
   99:                     if ( $request{$sock} =~ m/\r\n\r\n|\n\n/ ){
  100:                         # 空行がある=完全なリクエストが送られてきた
  101:                         # POST のときには、あと Content-length の分だけ
  102:                         # 読まなければいけないが、未実装。
  103: 
  104:                         if ( $request{$sock} =~ m/^(POST|GET) / ){
  105:                             my ($host, $port, $new_req) = &parse_request($request{$sock});
  106: 
  107:                             printf "MAKE SOCKET TO $host:$port\n";
  108: 
  109:                             my $sock_connect = IO::Socket::INET->new(PeerAddr => $host,
  110:                                                                      PeerPort => $port,
  111:                                                                      Proto    => 'tcp',
  112:                                                                      );
  113:                             if ( ! $sock_connect ){
  114:                                 select($sock); $|=1; select(STDOUT);
  115:                                 print $sock "HTTP/1.0 500 cannot resolve.\r\n";
  116:                                 print $sock "\r\n";
  117:                                 print $sock "<html>\r\n";
  118:                                 print $sock "<body>\r\n";
  119:                                 print $sock "$host:$port cannot resolve.\r\n";
  120:                                 print $sock "</body>\r\n";
  121:                                 print $sock "</html>\r\n";
  122:                                 
  123:                                 &remove_contable($sock);
  124:                                 close($sock);
  125:                                 next;
  126:                             }
  127:                             $conn_table{$sock_connect} = $sock;
  128:                             $conn_table_rev{$sock} = $sock_connect;
  129:                             select($sock_connect); $|=1; select(STDOUT);
  130:                             
  131:                             print $sock_connect $new_req;
  132:                             $new_req =~ s/^/  /gm;
  133:                             print "  -- request start--\n";
  134:                             print $new_req;
  135:                             print "  -- request end--\n";
  136:                             $selecter->add($sock_connect);
  137:                         }
  138:                     } else {
  139:                         # 完全なリクエストが届かなかった (次回続きが送られてくることを期待)
  140:                         print "Wait continue request\n";
  141:                     }
  142:                 } else {
  143:                     # ブラウザからのコネクション切断。
  144:                     print "  FROM Browser. Finished.\n";
  145:                     &remove_contable($sock);
  146:                 }
  147:             }
  148:         }
  149:     }
  150: }
  151: 
  152: exit;
  153: 
  154: 
  155: #---------------------------------
  156: # コネクションが切断された場合、select 対象から外す。
  157: 
  158: sub remove_contable($){
  159:     my ($sock) = @_;
  160:     print "    delete ", $sock->fileno, "\n";
  161:     $conn_table_rev{$sock} = undef;
  162:     # %conn_table も undef しないとメモリリークすると思うが、
  163:     # 一回につき数十KB くらいなので、とりあえず放置。
  164:     $selecter->remove($sock);
  165:     $request{$sock} = undef;
  166: }
  167: 
  168: #---------------------------------
  169: # ヘッダの書き換え
  170: 
  171: sub override_header($\$) {
  172:     my ($header, $ref_value) = @_;
  173:     if ( $header =~ m/^User-Agent$/i ){
  174:         $$ref_value .= '';
  175:     }
  176: }
  177: 
  178: #---------------------------------
  179: # リクエストを解析し、実際の接続先やポート番号などを求める。
  180: #
  181: # 引数: HTTP リクエスト
  182: # 戻り値: 接続先ホスト名、接続先ポート番号、解析済リクエスト
  183: 
  184: sub parse_request($){
  185:     my ($req) = @_;
  186:     my $host;
  187:     my $port;
  188:     my $new_req = '';
  189: 
  190:     my $is_header = 1;
  191: 
  192:     foreach ( split(/\r\n|\n/, $req, -1) ){
  193:         if ( m|^([A-Z]+) [a-zA-Z]+://(.*?)/(.*?) (HTTP/\d\.\d)$|i ){
  194:             my $proto_ver;
  195:             my $path;
  196:             my $method;
  197:             ($method, $host, $path, $proto_ver) = ($1, $2, $3, $4);
  198: 
  199:             if ( &is_use_proxy($host) ){
  200:                 $new_req = "$_\r\n";
  201:                 ($host, $port) = $real_proxy =~ m/^(.*):(\d+)$/;
  202:             } else {
  203:                 if ( $host =~ s/:(\d+)$// ){
  204:                     $port = $1;
  205:                 } else {
  206:                     $port = 80;
  207:                 }
  208:                 $new_req = "$method /$path $proto_ver\r\n";
  209:             }
  210:         } elsif ( $is_header ){
  211:             if ( m/^(.*?):\s*(.*)$/s ){
  212:                 my ($header, $value) = ($1, $2);
  213:                 &override_header($header, \$value);
  214:                 $new_req .= "$header: $value\r\n";
  215:             } elsif ( $_ eq '' ){
  216:                 # ヘッダおしまい
  217:                 $new_req .= "\r\n";
  218:                 $is_header = 0;
  219:             }
  220:         } elsif ( ! $is_header ){
  221:             $new_req .= "$_";
  222:         }
  223:     }
  224: 
  225:     return ($host, $port, $new_req);
  226: }
  227: 
  228: #----------------------------------------------
  229: # 外部 proxy を経由するかどうか調べる。
  230: #
  231: #   引数: ホスト名
  232: #   戻り値: 1…proxy を経由する
  233: #           0…proxy を経由しない
  234: 
  235: sub is_use_proxy($){
  236:     my ($host) = @_;
  237: 
  238:     foreach ( @noproxy_hosts ){
  239:         if ( $host =~ m/.*$_.*/ ){
  240:             return 0;
  241:         }
  242:     }
  243:     if ( $real_proxy ){
  244:         return 1;
  245:     } else {
  246:         return 0;
  247:     }
  248: }
前へ << HTTP の並行アクセス モジュールをインストールしよう >> 次へ