パスワードを忘れた? アカウント作成

etsav (7596) の日記

2003 年 09 月 20 日
午前 04:30

LightBringer.pl

#! /usr/bin/perl

#
# LightBringer.pl
#
#   さくしゃ:  八刺秋巳 aka EtsAv
#   ひづけ:    2003年9月吉日
#
#   せつめい:
#       ほとんどな~んにもしない いーかげん ぱーそなる HTTP ぷろきしぃ。
#
#       ほとんどなんにもしないで要求・結果を素通しするけど、唯一、/.J に
#       アクセスすると、強制的にライトモードにしちゃうのです。ログインし
#       てなくても大丈夫。ホスト判定を変更したら本家にも使えちゃうのかも。
#
#       ぢつゎですね、あたしの移動中・実家での接続環境がナローバンドに戻っ
#       ちゃいましたのです〔涙〕。で、ライトモードを使いたかったのだけど、
#       細い回線で通常モードのあの重たい設定画面をいぢくるのゎ大変なので
#       す。逆に戻すのも面倒だし。で、ノート PC に仕込むつもりでいーかげ
#       んに組んでみまして。
#
#       なにしろいーかげんですから、TRY AT YOUR OWN RISK なのです。パーソ
#       ナルファイアウォールの内側で使うつもりなのでセキュリティーなんて
#       丸っきり考えてないし。
#
#       あと、UserAgent が取って来る結果も Select で多重化したかったんだ
#       けど、どーせ目的がナローバンド対策だから、まーいーか。
#

# いろいろ使わせて頂くのです ありがたや~
use IO::Select;
use LWP::UserAgent;
use HTTP::Daemon;

# 清く正しく美しく~
use strict;

#
# Configurables(いぢれる設定変数)
#
my $PORT = 8080; # listening port number

#
# Here We Go! (そぃぢゃいってみよ~かぁ!)
#
print "\nLight Bringer - a personal http proxy.\n\n";

# SIGPIPE を無視するのです
$SIG{PIPE} = sub { warn "SIGPIPE ignored.\n"; };

# でーもん様を召喚するのです
my $daemon = new HTTP::Daemon(LocalAddr => 'localhost',
                              LocalPort => $PORT);
die "Can't create an http daemon." if (!$daemon);
print "Listening to port $PORT; standing by.\n";

# えーじぇんとを雇うのです。
my $agent = LWP::UserAgent->new;
$agent->agent('LightBringer/0.1 ' . $agent->agent);

# 入力せれくたぁを作るのです
my $selector = IO::Select->new;

# まずゎでーもん様(≡listening socket)をせれくたぁに登録
$selector->add($daemon);

# <<< めいんるーぷ >>>
while (1)
{
    # 入力あるかなぁ?
    my @sockets = $selector->can_read;

    # <<< 入力のあるソケットそれぞれについて >>>
    foreach my $socket (@sockets)
    {
        # でーもん様に接続要求?
        if ($socket == $daemon)
        {
            # 新しいクライアント接続だ! 登録登録~
            my $client = $daemon->accept;
            $selector->add($client);
        }
        # んでなかったらクライアントからの入力で
        else
        {
            # クライアントからの要求がある?
            if (my $request = $socket->get_request)
            {
                # ホストが /.J だったりしたら
                my $uri = $request->uri;
                if ($uri->host eq "slashdot.jp")
                {
                    # 非ログイン時にゎこーしないとトップページがライトモー
                    # ドにならないの
                    $uri->path("/index.pl") if ($uri->path eq "/");

                    # らいともーど おん!
                    my %qform = $uri->query_form;
                    $qform{'light'} = '1';
                    $uri->query_form(%qform);
                }

                # リクエストを出して結果をクライアントに返すのです。
                my $response = $agent->request($request);
                $socket->send_response($response);
            }

            # せれくたぁ登録を抹消してクライアントからの接続を閉じるのです
            $selector->remove($socket);
            $socket->close;
            undef($socket);
        }
    }
    # >>> 入力のあるソケットそれぞれについて <<<

}
# >>> めいんるーぷ <<<

#
# おしまい
#
0;

この議論は賞味期限が切れたので、アーカイブ化されています。 新たにコメントを付けることはできません。

犯人はmoriwaka -- Anonymous Coward

処理中...