メメメモモ

プログラミング、筋トレ、ゲーム、etc

AnyEventを使ってProxyサーバを書いてみた・・・けど2

こっちで書いたプログラムをAnyEvent::Handleを使って書き直してみました。割と短くなりました。

use strict;
use warnings;

use AnyEvent;
use AnyEvent::Socket;
use AnyEvent::Handle;

my $proxy_port = 8080;

my %conn_table;
my %request;


my $cv = AnyEvent->condvar;

my $sig; $sig = AnyEvent->signal(
    signal => 'PIPE',
    cb => sub {
	warn "Caught SIGPIPE. But continue..";
    }
    );


# Proxyサーバのイベントループ
my $guard; $guard = tcp_server undef, $proxy_port, sub {
    my ($sock_cli, $host, $port) = @_;


    # ブラウザからのリクエストを読み込む

    my $hdl_cli; $hdl_cli = AnyEvent::Handle->new(
	fh => $sock_cli,
	on_error => sub { warn $_[2] },
	on_eof => sub {},
	on_read => sub {
	    my $request = $hdl_cli->{rbuf};
	    delete $hdl_cli->{rbuf};
	    if ( $request ) {
		$request{$sock_cli} .= $request;
		
		if ( $request =~ m/\r\n\r\n|\n\n/ ) {
		    if ( $request =~ m/^(POST|GET) /) {
			
			my ($host, $port, $new_req) = parse_request($request);


			# ブラウザからのリクエストをWebサーバに送る

			my $tcp_srv; $tcp_srv = tcp_connect $host, $port, sub {
			    my ($sock_srv) = @_;

			    my $hdl_srv; $hdl_srv = AnyEvent::Handle->new(
				fh => $sock_srv,
				on_error => sub { warn $_[2] },
				on_eof => sub {},
				on_read => sub {
				    # サーバからのレスポンスをブラウザに送る
				    my $res = $hdl_srv->{rbuf};
				    delete $hdl_srv->{rbuf};
				    if ($res) {
					$hdl_cli->push_write($res);
				    } else {
					undef $tcp_srv;
					undef $hdl_srv;
					undef $hdl_cli;
				    }
				},
				);
			    $hdl_srv->push_write($new_req);
			};
		    }
		}
	    }
	});
};

$cv->recv;


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 ( $host =~ s/:(\d+)$// ) {
		$port = $1;
	    } else {
		$port = 80;
	    }
	    $new_req = "$method /$path $proto_ver\r\n";
	    warn $new_req;
	} elsif ( $is_header ) {
	    if ( m/^(.*?):\s*(.*)$/s ) {
		my ($header, $value) = ($1, $2);
		$new_req .= "$header: $value\r\n";
	    } elsif ( $_ eq '' ) {
		$new_req .= "\r\n";
		$is_header = 0;
	    }
	} elsif ( ! $is_header ) {
	    $new_req .= "$_";
	}
    }

    return ($host, $port, $req);
}


ある程度動きますが、やはりエラーが出てしまうページがあります。
今のところ確認したエラーは下記のようなもの。

EV: error in callback (ignoring): AnyEvent::Handle: either an existing fh or the connect parameter must be specified

FLASHがあるページなどで起きている感じです。