1package t::Utils;
2
3use strict;
4use Exporter ();
5use IO::Socket::INET;
6use vars qw( @ISA @EXPORT @EXPORT_OK );
7
8@ISA       = qw( Exporter );
9@EXPORT    = qw( &server_start &server_next &fork_proxy &web_ok &bare_request );
10@EXPORT_OK = @EXPORT;
11
12use HTTP::Daemon;
13use LWP::UserAgent;
14
15# start a simple server
16sub server_start {
17
18    # create a HTTP::Daemon (on an available port)
19    my $daemon = HTTP::Daemon->new(
20        LocalHost => 'localhost',
21        ReuseAddr => 1,
22      )
23      or die "Unable to start web server";
24    return $daemon;
25}
26
27# This must NOT be called in an OO fashion but this way:
28# server_next( $server, $coderef, ... );
29#
30# The optional coderef takes a HTTP::Request as its first argument
31# and returns a HTTP::Response. The rest of server_next() arguments
32# are passed to &$anwser;
33
34sub server_next {
35    my $daemon = shift;
36    my $answer = shift;
37
38    # get connection data
39    my $conn = $daemon->accept;
40    my $req  = $conn->get_request;
41
42    # compute some answer
43    my $rep;
44    if ( ref $answer eq 'CODE' ) {
45        $rep = $answer->( $req, @_ );
46    }
47    else {
48        $rep = HTTP::Response->new(
49            200, 'OK',
50            HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
51            sprintf( "You asked for <a href='%s'>%s</a>", ( $req->uri ) x 2 )
52        );
53    }
54
55    $conn->send_response($rep);
56    $conn->close;
57}
58
59# run a stand-alone proxy
60# the proxy accepts an optional coderef to run after serving all requests
61sub fork_proxy {
62    my $proxy = shift;
63    my $sub   = shift;
64
65    my $pid = fork;
66    die "Unable to fork proxy" if not defined $pid;
67
68    if ( $pid == 0 ) {
69        $0 .= " (proxy)";
70
71        # this is the http proxy
72        $proxy->start;
73        $sub->() if ( defined $sub and ref $sub eq 'CODE' );
74        exit 0;
75    }
76
77    # back to the parent
78    return $pid;
79}
80
81# check that the web connection is working
82sub web_ok {
83    my $ua = LWP::UserAgent->new( env_proxy => 1, timeout => 30 );
84    my $res =
85      $ua->request(
86        HTTP::Request->new( GET => shift||'http://www.google.com/intl/en/' ) );
87    return $res->is_success;
88}
89
90# send a simple request without LWP::UA
91# bare_request($url, $headers, $proxy)
92sub bare_request {
93    my ($url, $headers, $proxy) = @_;
94
95    # connect directly to the proxy
96    $proxy->url() =~ /:(\d+)/;
97    my $sock = IO::Socket::INET->new(
98        PeerAddr => 'localhost',
99        PeerPort => $1,
100        Proto    => 'tcp'
101      ) or do { warn "Can't connect to the proxy"; return ""; };
102
103    # send the request
104    print $sock "GET $url HTTP/1.0\015\012",
105                $headers->as_string( "\015\012" ), "\015\012";
106    my $content = join "", <$sock>;
107
108    # close the connection to the proxy
109    close $sock or warn "close: $!";
110    return $content;
111}
112
113package HTTP::Proxy;
114
115# return the requested internal filter stack
116# _filter_stack( body|header, request|response, HTTP::Message )
117sub _filter_stack {
118    my ( $self, $part, $mesg ) = splice( @_, 0, 3 );
119    die "No <$part><$mesg> filter stack"
120      unless $part =~ /^(?:header|body)$/
121      and $mesg =~ /^(?:request|response)$/;
122
123    for (@_) {
124        die "$_ is not a HTTP::Request or HTTP::Response"
125          unless ( ref $_ ) =~ /^HTTP::(Request|Response)$/;
126        $self->{ lc $1 } = $_;
127    }
128    $self->{response}->request( $self->{request} );
129    return $self->{$part}{$mesg};
130}
131
132