root/lang/perl/Moxy/trunk/lib/Moxy/Server/HTTPProxy.pm @ 2891

Revision 2891, 3.9 kB (checked in by tokuhirom, 5 years ago)

lang/perl/Moxy: import Moxy.

Line 
1package Moxy::Server::HTTPProxy;
2use strict;
3use warnings;
4use utf8;
5use Encode;
6use HTTP::Proxy ':log';
7use HTTP::Proxy::BodyFilter::simple;
8use HTTP::Proxy::HeaderFilter::simple;
9use HTTP::Proxy::BodyFilter::complete;
10
11sub new {
12    my ($class, $context, $config) = @_;
13    my $self = bless {config => $config}, $class;
14
15    my $proxy = HTTP::Proxy->new(
16        port        => $config->{port},
17        host        => $config->{host} || "localhost",
18        max_clients => $config->{max_clients},
19    );
20
21    if ($config->{logmask}) {
22        my $mask = 0; # this is bitmask.
23        for my $const ( @{$config->{logmask}} ) {
24            $mask |= HTTP::Proxy->$const;
25        }
26        $proxy->logmask($mask);
27    }
28
29    $proxy->push_filter(
30        mime     => undef,
31        response => HTTP::Proxy::BodyFilter::complete->new,
32        request  => HTTP::Proxy::HeaderFilter::simple->new(
33            sub {
34                my ($user, $pass) = $_[0]->proxy->hop_headers->proxy_authorization_basic();
35                if ($user) {
36                    $_[0]->proxy->stash(user => $user);
37                } else {
38                    my $response = HTTP::Response->new( 407, 'Moxy Authentication required' );
39                    $response->header('Proxy-Authenticate' => 'Basic realm="Moxy(password is dummy)"');
40                    return $_[0]->proxy->response($response);
41                }
42
43                $context->run_hook(
44                    'request_filter_process_agent',
45                    {   request => $_[2], # HTTP::Request object
46                        filter  => $_[0], # filter object itself
47                    }
48                );
49
50                my $agent = $context->get_ua_info($_[1]->header('User-Agent'));
51                my $carrier = $agent->{agent} ? HTTP::MobileAgent->new($agent->{agent})->carrier : 'N';
52
53                for my $hook ('request_filter', "request_filter_$carrier") {
54                    $context->run_hook(
55                        $hook,
56                        {   request => $_[2], # HTTP::Request object
57                            filter  => $_[0], # filter object itself
58                            agent   => $agent,
59                        }
60                    );
61                }
62            }
63        ),
64        response => HTTP::Proxy::BodyFilter::simple->new(
65            sub {
66                my $agent = $context->get_ua_info($_[2]->request->header('User-Agent'));
67                my $carrier = $agent->{agent} ? HTTP::MobileAgent->new($agent->{agent})->carrier : 'N';
68
69                for my $hook ('response_filter', "response_filter_$carrier") {
70                    $context->run_hook(
71                        $hook,
72                        {   response    => $_[2], # HTTP::Response object
73                            content_ref => $_[1], # response body's scalarref.
74                            filter      => $_[0], # filter object itself.
75                            agent       => $agent,
76                        }
77                    );
78                }
79            }
80        ),
81        response => HTTP::Proxy::HeaderFilter::simple->new(
82            sub {
83                my $agent = $context->get_ua_info($_[2]->request->header('User-Agent'));
84                my $carrier = $agent->{agent} ? HTTP::MobileAgent->new($agent->{agent})->carrier : 'N';
85
86                for my $hook ('response_filter_header', "response_filter_header_$carrier") {
87                    $context->run_hook(
88                        $hook,
89                        {   response    => $_[2],
90                            content_ref => $_[1],
91                            filter      => $_[0],
92                            agent       => $agent,
93                        }
94                    );
95                }
96            }
97        ),
98    );
99
100    $self->{proxy} = $proxy;
101
102    return $self;
103}
104
105sub run {
106    my ($self, $context) = @_;
107
108    my $proxy = $self->{proxy};
109
110    $context->log(info => sprintf("Moxy running at http://%s:%d/\n", $proxy->host, $proxy->port));
111
112    $proxy->start;
113}
114
1151;
Note: See TracBrowser for help on using the browser.