#!/usr/local/bin/perl # $Id: http-proxy.pl,v 1.2 2003/05/17 14:31:02 68user Exp $ require 5.000; use strict; use IO::Socket; use IO::Select; # 接続する proxy。直接接続なら $real_proxy=''; とすること。 my $real_proxy = 'proxy.hoge.co.jp:8080'; # $real_proxy を経由しないホスト名。正規表現で記述。 my @noproxy_hosts = qw(localhost hoge\.co\.jp); # proxy 用ポート番号 my $listen_port = 8080; my $sock_waiting = IO::Socket::INET->new(Listen => SOMAXCONN, LocalPort => $listen_port, Proto => 'tcp', Reuse => 1, # 自サーバ以外からの接続を許すなら LocalAddr をコメントアウトする。 LocalAddr => 'localhost', ); my $selecter = IO::Select->new; $selecter->add($sock_waiting); my %conn_table; my %conn_table_rev; my %request; #------------------- # SIGPIPE シグナルを受けても終了しないようにする。例えば、web サーバからの # レスポンスをブラウザに渡そうと print したが、それより前にブラウザの中止ボタンが # 押されていた、というときに SIGPIPE が飛んでくる。 $SIG{PIPE} = sub { print "Caught SIGPIPE. But continue..\n"; }; while (1){ print "Begin select\n"; my ($clients) = IO::Select->select($selecter, undef, undef, undef); if ( @$clients == 0 ){ next; } foreach my $sock (@$clients){ print " socket_descripter=", $sock->fileno, "\n"; if ( $sock == $sock_waiting ){ # ブラウザからの新しい接続あり my $new_sock = $sock_waiting->accept; $selecter->add($new_sock); printf " New client comes (%d).\n", $new_sock->fileno; } else { if ( $conn_table{$sock} ){ # web サーバからのデータがあるか、web サーバとのコネクション切断 my $buf; my $read_len = sysread($sock, $buf, 10000); if ( $buf ){ # web サーバからのデータあり print " FROM Web server. Read OK ($read_len bytes).\n"; my $fn = $conn_table{$sock}; select($fn); $|=1; select(STDOUT); print $fn $buf; } else { # web サーバとのコネクション切断 print " FROM Web server. Finished.\n"; printf " close(%d)\n", $conn_table{$sock}->fileno; &remove_contable($conn_table{$sock}); shutdown($conn_table{$sock}, 2); shutdown($sock, 2); $conn_table{$sock} = undef; } } else { # ブラウザからのデータあり my $buf; sysread($sock, $buf, 10000); if ( $buf ){ print " FROM Browser. Read OK.\n"; $request{$sock} .= $buf; if ( $request{$sock} =~ m/\r\n\r\n|\n\n/ ){ # 空行がある＝完全なリクエストが送られてきた # POST のときには、あと Content-length の分だけ # 読まなければいけないが、未実装。 if ( $request{$sock} =~ m/^(POST|GET) / ){ my ($host, $port, $new_req) = &parse_request($request{$sock}); printf "MAKE SOCKET TO $host:$port\n"; my $sock_connect = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => 'tcp', ); if ( ! $sock_connect ){ select($sock); $|=1; select(STDOUT); print $sock "HTTP/1.0 500 cannot resolve.\r\n"; print $sock "\r\n"; print $sock "\r\n"; print $sock "\r\n"; print $sock "$host:$port cannot resolve.\r\n"; print $sock "\r\n"; print $sock "\r\n"; &remove_contable($sock); close($sock); next; } $conn_table{$sock_connect} = $sock; $conn_table_rev{$sock} = $sock_connect; select($sock_connect); $|=1; select(STDOUT); print $sock_connect $new_req; $new_req =~ s/^/ /gm; print " -- request start--\n"; print $new_req; print " -- request end--\n"; $selecter->add($sock_connect); } } else { # 完全なリクエストが届かなかった (次回続きが送られてくることを期待) print "Wait continue request\n"; } } else { # ブラウザからのコネクション切断。 print " FROM Browser. Finished.\n"; &remove_contable($sock); } } } } } exit; #--------------------------------- # コネクションが切断された場合、select 対象から外す。 sub remove_contable($){ my ($sock) = @_; print " delete ", $sock->fileno, "\n"; $conn_table_rev{$sock} = undef; # %conn_table も undef しないとメモリリークすると思うが、 # 一回につき数十KB くらいなので、とりあえず放置。 $selecter->remove($sock); $request{$sock} = undef; } #--------------------------------- # ヘッダの書き換え sub override_header($\$) { my ($header, $ref_value) = @_; if ( $header =~ m/^User-Agent$/i ){ $$ref_value .= ''; } } #--------------------------------- # リクエストを解析し、実際の接続先やポート番号などを求める。 # # 引数: HTTP リクエスト # 戻り値: 接続先ホスト名、接続先ポート番号、解析済リクエスト sub parse_request($){ my ($req) = @_; my $host; my $port; my $new_req = ''; my $is_header = 1; foreach ( split(/\r\n|\n/, $req, -1) ){ if ( m|^([A-Z]+) [a-zA-Z]+://(.*?)/(.*?) (HTTP/\d\.\d)$|i ){ my $proto_ver; my $path; my $method; ($method, $host, $path, $proto_ver) = ($1, $2, $3, $4); if ( &is_use_proxy($host) ){ $new_req = "$_\r\n"; ($host, $port) = $real_proxy =~ m/^(.*):(\d+)$/; } else { if ( $host =~ s/:(\d+)$// ){ $port = $1; } else { $port = 80; } $new_req = "$method /$path $proto_ver\r\n"; } } elsif ( $is_header ){ if ( m/^(.*?):\s*(.*)$/s ){ my ($header, $value) = ($1, $2); &override_header($header, \$value); $new_req .= "$header: $value\r\n"; } elsif ( $_ eq '' ){ # ヘッダおしまい $new_req .= "\r\n"; $is_header = 0; } } elsif ( ! $is_header ){ $new_req .= "$_"; } } return ($host, $port, $new_req); } #---------------------------------------------- # 外部 proxy を経由するかどうか調べる。 # # 引数: ホスト名 # 戻り値: 1…proxy を経由する # 0…proxy を経由しない sub is_use_proxy($){ my ($host) = @_; foreach ( @noproxy_hosts ){ if ( $host =~ m/.*$_.*/ ){ return 0; } } if ( $real_proxy ){ return 1; } else { return 0; } }