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