[Tokyo.pm] HTTP::Winder

[ｔａｇｕｔｉ]

久々登場、田口と申します。

「PAUSEの使いかた」は大よそ落着かと思いますが、
この件でメールしたくなりました。一応、スレッドは別で。

HTTP::Proxyってモジュール、CPANに出てるの、知ってます?

たまたま私、Proxyに近いことがやりたくてこれを参考に、
というか継承してプログラムを作成しました。
オブジェクト指向のモジュールは作成したことが無かったので
出来ばえのほうは良くわかりません。

作者にメール送ったんですが、Host unknownで返ってきました。
ホームページも繋がらないし。
これって怪しい人なんですかねー。
そう言えば、DAIBAさんっていうのも、ある意味．．．

HTTP::Winderを作成したきっかけは、こうです。
今運営しているサイトを何人かの人にデモする必要が出てきた
のですが、このサイトはパスワードがかかっています。
数人にメールでURLを教えたいのですが、パスワードは教えたくない。
現行のシステムを触りたくない。
パスワードを追加するProxyを作成して、そのProxyを
設定して閲覧するようにしてもいいんですが、ブラウザーにProxyを
設定するのはなんか面倒（と言われそう）。
それで関係者には、
"http://hostname:nnnn/hoo/bar.htm"
をメールで教えて、
同じサーバーにポートnnnnをリスンし、ユーザーとパスワードを
追加してリクエストを
"http://hostname/hoo/bar.htm"
に出すものを作成しようと考えました。
本当は別のサーバーにしたかったのですが、それはやり方が良く
判りませんでした。
"TCP tunnel"に似たようなものを作りたかったのですが。
で、こうゆうプログラムのことを何と呼ぶか判りますか?
これもProxyでしょうか?
良く判らないので私はWinderとつけました。本当はSidewinderと
したかったのですが、それだと長いので。(^_^;
ストレートに80番に行くのではなく、別ポートに来たリクエストを
巻きついて（絡み付いて）80番に飛ばすもの、という意味です。

ここのML、添付ファイル禁止ですか。
モジュールとサンプルのスクリプトを掲載します。

------------------------------------------ SampleWinder.pl
#!/usr/bin/perl
use HTTP::Winder;
use strict;
print STDERR "=== Winder :8000 ===\n";
my $winder_cb = sub {
	my ($req) = shift;
	$req = $$req;
	$req->authorization_basic('scott', 'tiger');
};
my $winder = HTTP::Winder->new(verbose=>1,
	host=>"myServer",
	callback=>$winder_cb);
$winder->start;
------------------------------------------ 
------------------------------------------ HTTP::Winder.pm
package HTTP::Winder;

use base ("HTTP::Proxy");
use HTTP::Daemon;
use LWP::UserAgent;
use LWP::ConnCache;
use Data::Dumper;
use POSIX qw(WNOHANG);
use Fcntl ':flock';
use Carp;

use strict;
use vars qw( $VERSION $AUTOLOAD );

$VERSION = 0.01;

sub new {
    my $class = shift;
    my $self = {
        agent    => undef,
        daemon   => undef,
        callback => undef,
        host     => 'localhost',
        maxchild => 16,
        maxconn  => 0,
        logfh    => *STDERR,
        port     => 8000,
        verbose  => 0,
        @_,
    };

    # non modifiable defaults
    %$self = ( %$self, conn => 0 );
    return bless $self, $class;
}

sub start {
    my $self = shift;
    $self->init;
    $SIG{CHLD} = sub { do {} while waitpid(-1, WNOHANG) > 0 };
    my $daemon = $self->daemon;
    while ( my $conn = $daemon->accept ) {
        my $child = fork;
        if ( !defined $child ) {
            # This could use a Retry-After: header...
            $conn->send_error( 503, "IpRedir cannot fork" );
            $self->log( 0,          "Cannot fork" );
            next;
        }
        if ($child) {    # the parent process
            $conn->close;	# maybe...
            undef $conn;	# maybe...
            $self->log( 3, "Forked child process $child" );
        }
        else {
            # the child process handles the connection
            $self->process($conn);
            $conn->close;
            undef $conn;
            exit;    # let's die!
        }
    }
    $self->log( 0, "Done " . $self->conn . " connection(s)" );
    return $self->conn;
}

sub process {
    my ( $self, $conn ) = @_;
    while ( my $req = $conn->get_request() ) {
        unless ( defined $req ) {
            $self->log( 0, "Getting request failed:", $conn->reason );
            return;
        }
	    my $callback = $self->{callback};
		my $reqhost  = $req->header('host');
		my $requrl   = $req->url();
		print STDERR "Winder> reqhost=$reqhost, requrl=$requrl\n";
		&$callback(\$req) if (defined $callback);
		$reqhost =~ s/:\d+//;
		$req->header('host', $reqhost);
		$req->url('http://' . $reqhost . $requrl);
        $self->log( 1, "($$) Request: " . $req->uri );
        $self->log( 5, "($$) Request: " . $req->headers->as_string );
		# handle the Connection: header from the request
        my $res = $self->agent->simple_request($req);
        $conn->print( $res->as_string );
        $self->log( 1, "($$) Response: " . $res->status_line );
        $self->log( 5, "($$) Response: " . $res->headers->as_string );
		last;
    }
}

1;
------------------------------------------ 

Hirosi Taguti
taguti ＠ secom-sis.co.jp