r18940 - in /trunk/libhttp-proxy-perl: ./ debian/ eg/ lib/HTTP/ lib/HTTP/Proxy/BodyFilter/ lib/HTTP/Proxy/Engine/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Apr 20 18:58:34 UTC 2008
Author: gregoa
Date: Sun Apr 20 18:58:33 2008
New Revision: 18940
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=18940
Log:
New upstream release, fixes bug 'save filter "filename" parameter used
invalidly' (closes: #433951).
Added:
trunk/libhttp-proxy-perl/eg/flv.pl
- copied unchanged from r18939, branches/upstream/libhttp-proxy-perl/current/eg/flv.pl
trunk/libhttp-proxy-perl/t/67save.t
- copied unchanged from r18939, branches/upstream/libhttp-proxy-perl/current/t/67save.t
Modified:
trunk/libhttp-proxy-perl/Changes
trunk/libhttp-proxy-perl/MANIFEST
trunk/libhttp-proxy-perl/META.yml
trunk/libhttp-proxy-perl/Makefile.PL
trunk/libhttp-proxy-perl/debian/changelog
trunk/libhttp-proxy-perl/eg/README
trunk/libhttp-proxy-perl/eg/dragon.pl
trunk/libhttp-proxy-perl/eg/proxy-auth.pl
trunk/libhttp-proxy-perl/lib/HTTP/Proxy.pm
trunk/libhttp-proxy-perl/lib/HTTP/Proxy/BodyFilter/save.pm
trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/Legacy.pm
trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/ScoreBoard.pm
trunk/libhttp-proxy-perl/t/22http.t
trunk/libhttp-proxy-perl/t/22transparent.t
trunk/libhttp-proxy-perl/t/90diveintomark.t
Modified: trunk/libhttp-proxy-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/Changes?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/Changes (original)
+++ trunk/libhttp-proxy-perl/Changes Sun Apr 20 18:58:33 2008
@@ -1,4 +1,24 @@
Revision history for Perl extension HTTP::Proxy
+
+0.21 Sun Apr 20 04:34:47 CEST 2008
+ [ENHANCEMENTS]
+ - HTTP::Proxy::Engine::Legacy and HTTP::Proxy::Engine::ScoreBoard
+ log the number of remaining child processes (in addition to
+ their pids), thanks to Amos Shapira.
+ [FIXES]
+ - HTTP::Proxy::BodyFilter::save had a bug that prevented the
+ 'filename' parameter to be correctly used to compute the
+ filename to save to, and that made the proxy die the second
+ time the filter was called.
+ This fix allowed to close RT tickets #14548 (Max Maischein),
+ #18644 (Mark Tilford) and #33018 (Roland Stigge and Gunnar Wolf).
+ - HTTP::Proxy::BodyFilter::save had many other bugs, which the
+ test suite allowed to spot and fix.
+ [TESTS]
+ - t/67save.t provides 96% coverage of HTTP::Proxy::BodyFilter::save,
+ and helped fix many bugs in it.
+ [DOCUMENTATION]
+ - closed RT ticket #25295 (Matsuno Tokuhiro) with a doc patch.
0.20 Fri Aug 18 10:25:11 CEST 2006
[ENHANCEMENTS]
Modified: trunk/libhttp-proxy-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/MANIFEST?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/MANIFEST (original)
+++ trunk/libhttp-proxy-perl/MANIFEST Sun Apr 20 18:58:33 2008
@@ -5,6 +5,7 @@
eg/ayb.pl
eg/bork.pl
eg/dragon.pl
+eg/flv.pl
eg/fudd.pl
eg/https.pl
eg/javascript.pl
@@ -77,6 +78,7 @@
t/64lines.t
t/64tags.t
t/66htmlparser.t
+t/67save.t
t/71rot13.t
t/90diveintomark.t
t/README
Modified: trunk/libhttp-proxy-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/META.yml?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/META.yml (original)
+++ trunk/libhttp-proxy-perl/META.yml Sun Apr 20 18:58:33 2008
@@ -1,8 +1,48 @@
---- #YAML:1.0
+---
name: HTTP-Proxy
-version: 0.20
+version: 0.21
author:
- - Philippe "BooK" Bruhat <book at cpan.org>
+ - 'Philippe "BooK" Bruhat <book at cpan.org>'
abstract: A pure Perl HTTP proxy
license: perl
-generated_by: Module::Build version 0.2612, without YAML.pm
+requires:
+ HTTP::Daemon: 1.25
+ LWP::UserAgent: 2
+ Test::More: 0
+provides:
+ HTTP::Proxy:
+ file: lib/HTTP/Proxy.pm
+ version: 0.21
+ HTTP::Proxy::BodyFilter:
+ file: lib/HTTP/Proxy/BodyFilter.pm
+ HTTP::Proxy::BodyFilter::complete:
+ file: lib/HTTP/Proxy/BodyFilter/complete.pm
+ HTTP::Proxy::BodyFilter::htmlparser:
+ file: lib/HTTP/Proxy/BodyFilter/htmlparser.pm
+ HTTP::Proxy::BodyFilter::htmltext:
+ file: lib/HTTP/Proxy/BodyFilter/htmltext.pm
+ HTTP::Proxy::BodyFilter::lines:
+ file: lib/HTTP/Proxy/BodyFilter/lines.pm
+ HTTP::Proxy::BodyFilter::save:
+ file: lib/HTTP/Proxy/BodyFilter/save.pm
+ HTTP::Proxy::BodyFilter::simple:
+ file: lib/HTTP/Proxy/BodyFilter/simple.pm
+ HTTP::Proxy::BodyFilter::tags:
+ file: lib/HTTP/Proxy/BodyFilter/tags.pm
+ HTTP::Proxy::Engine:
+ file: lib/HTTP/Proxy/Engine.pm
+ HTTP::Proxy::Engine::Legacy:
+ file: lib/HTTP/Proxy/Engine/Legacy.pm
+ HTTP::Proxy::Engine::NoFork:
+ file: lib/HTTP/Proxy/Engine/NoFork.pm
+ HTTP::Proxy::Engine::ScoreBoard:
+ file: lib/HTTP/Proxy/Engine/ScoreBoard.pm
+ HTTP::Proxy::FilterStack:
+ file: lib/HTTP/Proxy/FilterStack.pm
+ HTTP::Proxy::HeaderFilter:
+ file: lib/HTTP/Proxy/HeaderFilter.pm
+ HTTP::Proxy::HeaderFilter::simple:
+ file: lib/HTTP/Proxy/HeaderFilter/simple.pm
+ HTTP::Proxy::HeaderFilter::standard:
+ file: lib/HTTP/Proxy/HeaderFilter/standard.pm
+generated_by: Module::Build version 0.26
Modified: trunk/libhttp-proxy-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/Makefile.PL?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/Makefile.PL (original)
+++ trunk/libhttp-proxy-perl/Makefile.PL Sun Apr 20 18:58:33 2008
@@ -4,9 +4,9 @@
NAME => 'HTTP::Proxy',
VERSION_FROM => 'lib/HTTP/Proxy.pm',
PREREQ_PM => {
- Test::More => 0,
- HTTP::Daemon => 1.25,
- LWP::UserAgent => 2,
+ 'Test::More' => 0,
+ 'HTTP::Daemon' => 1.25,
+ 'LWP::UserAgent' => 2,
},
PL_FILES => {},
ABSTRACT_FROM => 'lib/HTTP/Proxy.pm',
Modified: trunk/libhttp-proxy-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/debian/changelog?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/debian/changelog (original)
+++ trunk/libhttp-proxy-perl/debian/changelog Sun Apr 20 18:58:33 2008
@@ -1,4 +1,4 @@
-libhttp-proxy-perl (0.20-2) UNRELEASED; urgency=low
+libhttp-proxy-perl (0.21-1) UNRELEASED; urgency=low
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
field (source stanza); Homepage field (source stanza).
@@ -6,7 +6,10 @@
* Use dist-based URL in debian/watch.
* debian/rules: delete /usr/lib/perl5 only if it exists.
- -- gregor herrmann <gregor+debian at comodo.priv.at> Sat, 01 Dec 2007 18:54:56 +0100
+ * New upstream release, fixes bug 'save filter "filename" parameter used
+ invalidly' (closes: #433951).
+
+ -- gregor herrmann <gregoa at debian.org> Sun, 20 Apr 2008 20:54:15 +0200
libhttp-proxy-perl (0.20-1) unstable; urgency=low
Modified: trunk/libhttp-proxy-perl/eg/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/eg/README?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/eg/README (original)
+++ trunk/libhttp-proxy-perl/eg/README Sun Apr 20 18:58:33 2008
@@ -26,6 +26,7 @@
* leet.pl
* rot13.pl
* rainbow.pl
+ * fudd.pl
These filters do simple modifications of all HTML pages.
@@ -50,6 +51,8 @@
This filter outputs the request URI and the form parameters of
all POST requests.
+
+ Filter: HTTP::Proxy::HeaderFilter::simple
* logger.pl
@@ -131,3 +134,33 @@
Filter: HTTP::Proxy::HeaderFilter::simple
+ * switch.pl
+
+ Randomly switch proxies from a list given on the command line.
+
+ Filter: HTTP::Proxy::HeaderFilter::simple
+
+ * tracker.pl
+
+ This tracker proxy stores Referer, URL, CODE
+ and output them to STDOUT or the given file
+
+ Example output:
+ NULL http://www.perl.org/ 200
+ http://www.perl.org/ http://learn.perl.org/ 200
+
+ Filter: HTTP::Proxy::HeaderFilter::simple
+
+ * js.pl
+
+ Save JavaScript files as we browse them.
+
+ Filter: HTTP::Proxy::Body::save
+
+ * flv.pl
+
+ Saves all FLV files in the flv/ directory, with a computed
+ name (id taken from the URI, or MD5 hash of the URI).
+
+ Filter: HTTP::Proxy::Body::save
+
Modified: trunk/libhttp-proxy-perl/eg/dragon.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/eg/dragon.pl?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/eg/dragon.pl (original)
+++ trunk/libhttp-proxy-perl/eg/dragon.pl Sun Apr 20 18:58:33 2008
@@ -2,7 +2,7 @@
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use HTTP::Proxy::BodyFilter::simple;
-use HTTP::Proxy::BodyFilter::tags;
+use HTTP::Proxy::BodyFilter::complete;
use MIME::Base64;
use Fcntl ':flock';
use strict;
@@ -30,31 +30,16 @@
}
),
# count games
- response => HTTP::Proxy::BodyFilter::tags->new,
+ response => HTTP::Proxy::BodyFilter::complete->new(),
response => HTTP::Proxy::BodyFilter::simple->new(
- begin => sub { $seen_title = 0; },
filter => sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
- # pass everything until <TITLE> (included)
- if( !$seen_title ) {
- if( $$dataref =~ /<TITLE>/ ) {
- $seen_title++;
- $$dataref =~ s/(.*<TITLE>)(.*)/$1/s;
- $$buffer .= $2;
- }
- return;
- }
- # store the rest of the page
- if( defined $buffer ) {
- $$buffer = $$dataref;
- $$dataref = '';
- }
+ next if ! $$dataref;
+
# count the games and change the title
- else {
- my $n = 0; $n++ while $$dataref =~ /game\.php\?gid=\d+/g;
- my $s = $n > 1 ? "s" : ""; $n ||= "No";
- $$dataref =~ s!.*</TITLE>!Go - $n game$s pending</TITLE>!s;
- };
+ my $n = 0; $n++ while $$dataref =~ /game\.php\?gid=\d+/g;
+ my $s = $n > 1 ? "s" : ""; $n ||= "No";
+ $$dataref =~ s!<TITLE>.*?</TITLE>!<TITLE>$n go game$s pending</TITLE>!s;
},
),
);
@@ -65,7 +50,7 @@
$proxy->push_filter(
host => 'www.dragongoserver.net',
path => '^/game.php',
- response => HTTP::Proxy::BodyFilter::tags->new,
+ response => HTTP::Proxy::BodyFilter::complete->new(),
response => HTTP::Proxy::BodyFilter::simple->new(
sub {
my $msg = '&msg=yes';
Modified: trunk/libhttp-proxy-perl/eg/proxy-auth.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/eg/proxy-auth.pl?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/eg/proxy-auth.pl (original)
+++ trunk/libhttp-proxy-perl/eg/proxy-auth.pl Sun Apr 20 18:58:33 2008
@@ -17,11 +17,14 @@
request => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $request ) = @_;
- my $auth = $self->proxy->hop_headers->header('Proxy-Authorization')
- || "";
- # check the credentials
- if ( $auth ne $token ) {
+ # check the token against all credentials
+ my $ok = 0;
+ $_ eq $token && $ok++
+ for $self->proxy->hop_headers->header('Proxy-Authorization');
+
+ # no valid credential
+ if ( !$ok ) {
my $response = HTTP::Response->new(407);
$response->header(
Proxy_Authenticate => 'Basic realm="HTTP::Proxy"' );
Modified: trunk/libhttp-proxy-perl/lib/HTTP/Proxy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/lib/HTTP/Proxy.pm?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/lib/HTTP/Proxy.pm (original)
+++ trunk/libhttp-proxy-perl/lib/HTTP/Proxy.pm Sun Apr 20 18:58:33 2008
@@ -20,7 +20,7 @@
DATA CONNECT ENGINE ALL );
%EXPORT_TAGS = ( log => [@EXPORT_OK] ); # only one tag
-$VERSION = '0.20';
+$VERSION = '0.21';
my $CRLF = "\015\012"; # "\r\n" is not portable
@@ -856,8 +856,9 @@
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new(),
- response =>
- HTTP::Proxy::BodyFilter::simple->new( sub { s!(</?)i>!$1b>!ig } )
+ response => HTTP::Proxy::BodyFilter::simple->new(
+ sub { ${ $_[1] } =~ s!(</?)i>!$1b>!ig }
+ )
);
For more details regarding the creation of new filters, check the
Modified: trunk/libhttp-proxy-perl/lib/HTTP/Proxy/BodyFilter/save.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/lib/HTTP/Proxy/BodyFilter/save.pm?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/lib/HTTP/Proxy/BodyFilter/save.pm (original)
+++ trunk/libhttp-proxy-perl/lib/HTTP/Proxy/BodyFilter/save.pm Sun Apr 20 18:58:33 2008
@@ -37,14 +37,17 @@
croak "filename must be a code reference"
if defined $args{filename} && !UNIVERSAL::isa( $args{filename}, 'CODE' );
+ $self->{"_hpbf_save_filename_code"} = $args{filename};
$self->{"_hpbf_save_$_"} = $args{$_}
for qw( template no_host no_dirs cut_dirs prefix
- filename
multiple keep_old timestamp status );
}
sub begin {
my ( $self, $message ) = @_;
+
+ # internal data initialisation
+ delete @{$self}{qw( _hpbf_save_filename _hpbf_save_fh )};
my $uri = $message->isa( 'HTTP::Request' )
? $message->uri : $message->request->uri;
@@ -56,9 +59,9 @@
}
my $file = '';
- if( defined $self->{_hpbf_save_filename} ) {
+ if( defined $self->{_hpbf_save_filename_code} ) {
# use the user-provided callback
- $file = &{ $self->{_hpbf_save_filename} }->($message);
+ $file = $self->{_hpbf_save_filename_code}->($message);
unless ( defined $file and $file ne '' ) {
$self->proxy->log( HTTP::Proxy::FILTERS, "HTBF::save",
"Filter will not save $uri" );
@@ -69,7 +72,7 @@
# set the template variables from the URI
my @segs = $uri->path_segments; # starts with an empty string
shift @segs;
- splice(@segs, 1, $self->{_hpbf_save_cut_dirs} >= @segs
+ splice(@segs, 0, $self->{_hpbf_save_cut_dirs} >= @segs
? @segs - 1 : $self->{_hpbf_save_cut_dirs} );
my %vars = (
'%' => '%',
@@ -80,8 +83,10 @@
q => $uri->query,
);
pop @segs;
- $vars{d} = $self->{_hpbf_save_no_dirs} ? ''
- : File::Spec->catfile(@segs);
+ $vars{d}
+ = $self->{_hpbf_save_no_dirs} ? ''
+ : @segs ? File::Spec->catfile(@segs)
+ : '';
$vars{P} = $vars{p} . ( $vars{q} ? "?$vars{q}" : '' );
# create the filename
@@ -90,10 +95,6 @@
$file =~ s/%(.)/$vars{$1}/g;
}
$file = File::Spec->rel2abs( $file );
-
- # internal data initialisation
- $self->{_hpbf_save_filename} = "";
- $self->{_hpbf_save_fh} = undef;
# create the directory
my $dir = File::Spec->catdir( (File::Spec->splitpath($file))[ 0, 1 ] );
@@ -108,10 +109,23 @@
"Created directory $dir" );
}
+ # keep old file?
+ if ( -e $file ) {
+ if ( $self->{_hpbf_save_timestamp} ) {
+ # FIXME timestamp
+ }
+ elsif ( $self->{_hpbf_save_keep_old} ) {
+ $self->proxy->log( HTTP::Proxy::FILTERS, "HPBF::save",
+ "Skip saving $uri" );
+ delete $self->{_hpbf_save_fh}; # it's a closed filehandle
+ return;
+ }
+ }
+
# open and lock the file
my ( $ext, $n, $i ) = ( "", 0 );
- while( ! sysopen( $self->{_hpbf_save_fh}, "$file$ext",
- O_WRONLY | O_EXCL | O_CREAT ) ) {
+ my $flags = O_WRONLY | O_EXCL | O_CREAT;
+ while( ! sysopen( $self->{_hpbf_save_fh}, "$file$ext", $flags ) ) {
$self->proxy->log( HTTP::Proxy::ERROR, "HPBF::save",
"Too many errors opening $file$ext" ), return
if $i++ - $n == 10; # should be ok now
@@ -119,15 +133,8 @@
$ext = "." . ++$n while -e $file.$ext;
next;
}
- if( $self->{_hpbf_save_timestamp} ) {
- # FIXME timestamp
- } elsif( $self->{_hpbf_save_keep_old} ) {
- $self->proxy->log( HTTP::Proxy::FILTERS, "HPBF::save",
- "Skip saving $uri" );
- delete $self->{_hpbf_save_fh}; # it's a closed filehandle
- return;
- } else {
- unlink $file; # FIXME error ?
+ else {
+ $flags = O_WRONLY | O_CREAT;
}
}
@@ -154,6 +161,7 @@
# close file
if( $self->{_hpbf_save_fh} ) {
$self->{_hpbf_save_fh}->close; # FIXME error handling
+ delete $self->{_hpbf_save_fh};
}
}
@@ -296,8 +304,8 @@
With the B<multiple> option, saving the same file in the same directory
will result in the original copy of file being preserved and the second
-copy being named file.1. If that a file is saved yet again with the same
-name, the third copy will be named file.2, and so on.
+copy being named F<file.1>. If that a file is saved yet again with the same
+name, the third copy will be named F<file.2>, and so on.
Default is I<true>.
@@ -315,6 +323,8 @@
Default is I<false>.
+B<This option is not implemented.>
+
=item B<keep_old> => I<boolean>
The C<keep_old> option will prevent the file to be saved if a file
@@ -406,12 +416,21 @@
C<filename> option. Lucas Gonze provided a patch to make C<status>
actually work.
-Thanks to Max Maischein for detecting a bug in the paramerter validation
-for C<filename>.
+Thanks to Max Maischein for detecting a bug in the parameter validation
+for C<filename> (L<http://rt.cpan.org/Ticket/Display.html?id=14548>).
+
+Thanks to Mark Tilford, who found out that the
+C<filename> option was incorrectly used internally
+(L<http://rt.cpan.org/Ticket/Display.html?id=18644>).
+
+Thanks to Roland Stigge and Gunnar Wolf for
+reporting and forwarding Debian bug #433951 to CPAN RT
+(L<http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=433951>,
+L<http://rt.cpan.org/Ticket/Display.html?id=33018>).
=head1 COPYRIGHT
-Copyright 2004-2006, Philippe Bruhat.
+Copyright 2004-2008, Philippe Bruhat.
=head1 LICENSE
Modified: trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/Legacy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/Legacy.pm?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/Legacy.pm (original)
+++ trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/Legacy.pm Sun Apr 20 18:58:33 2008
@@ -94,7 +94,7 @@
@$kids = grep { $_ != $pid } @$kids;
$proxy->{conn}++; # Cannot use the interface for RO attributes
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS", "Reaped child process $pid" );
- $proxy->log( HTTP::Proxy::PROCESS, "PROCESS", "Remaining kids: @$kids" );
+ $proxy->log( HTTP::Proxy::PROCESS, "PROCESS", @$kids . " remaining kids: @$kids" );
}
}
Modified: trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/ScoreBoard.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/ScoreBoard.pm?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/ScoreBoard.pm (original)
+++ trunk/libhttp-proxy-perl/lib/HTTP/Proxy/Engine/ScoreBoard.pm Sun Apr 20 18:58:33 2008
@@ -82,8 +82,8 @@
$proxy->{conn}++; # Cannot use the interface for RO attributes
$proxy->log( HTTP::Proxy::PROCESS, 'PROCESS',
"Reaped child process $kid" );
- $proxy->log( HTTP::Proxy::PROCESS, 'PROCESS',
- "Remaining kids: @{[keys %$kids]}" );
+ $proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
+ keys(%$kids) . " remaining kids: @{[ keys %$kids ]}" );
delete $kids->{$kid};
}
@@ -164,7 +164,7 @@
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
"Reaped child process $pid" );
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
- "Remaining kids: @{[ keys %$kids ]}" );
+ keys(%$kids) . " remaining kids: @{[ keys %$kids ]}" );
}
# remove the temporary file
Modified: trunk/libhttp-proxy-perl/t/22http.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/t/22http.t?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/t/22http.t (original)
+++ trunk/libhttp-proxy-perl/t/22http.t Sun Apr 20 18:58:33 2008
@@ -1,13 +1,16 @@
use strict;
use vars qw( @requests );
+use Socket;
# here are all the requests the client will try
BEGIN {
@requests = (
- [ 'http://www.mongueurs.net/', 200 ],
- [ 'http://httpd.apache.org/docs', 301 ],
+
+ # host, expected code, shouldn't resolve
+ [ 'http://www.mongueurs.net/', 200 ],
+ [ 'http://httpd.apache.org/docs', 301 ],
[ 'http://www.google.com/testing/', 404 ],
- [ 'http://www.error.zzz/', qr/^5\d\d$/ ],
+ [ 'http://www.error.zzz/', qr/^5\d\d$/, 1 ],
);
}
@@ -27,7 +30,10 @@
$test->use_numbers(0);
$test->no_ending(1);
- my $proxy = HTTP::Proxy->new( port => 0, max_connections => scalar @requests );
+ my $proxy = HTTP::Proxy->new(
+ port => 0,
+ max_connections => scalar @requests,
+ );
$proxy->init; # required to access the url later
# fork a HTTP proxy
@@ -44,10 +50,29 @@
$ua->proxy( http => $proxy->url );
for (@requests) {
- my $req = HTTP::Request->new( GET => $_->[0] );
- my $rep = $ua->simple_request($req);
- my $sub = ref($_->[1]) ? \&like : \&is;
- $sub->( $rep->code, $_->[1], "Got an answer (@{[$rep->code]})" );
+ my ( $uri, $code, $dns_fail ) = @$_;
+ $uri = URI->new($uri);
+ $dns_fail &&= defined +( gethostbyname $uri->host )[4];
+
+ SKIP: {
+ if ($dns_fail) {
+
+ # contact the proxy anyway
+ $ua->simple_request(
+ HTTP::Request->new( GET => 'http://localhost/' ) );
+ skip "Our DNS shouldn't resolve " . $uri->host, 1;
+ }
+ else {
+
+ # the real test
+ my $req = HTTP::Request->new( GET => $uri );
+ my $rep = $ua->simple_request($req);
+ my $sub = ref( $_->[1] ) ? \&like : \&is;
+ $sub->(
+ $rep->code, $_->[1], "Got an answer (@{[$rep->code]})"
+ );
+ }
+ }
}
# make sure the kid is dead
Modified: trunk/libhttp-proxy-perl/t/22transparent.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/t/22transparent.t?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/t/22transparent.t (original)
+++ trunk/libhttp-proxy-perl/t/22transparent.t Sun Apr 20 18:58:33 2008
@@ -6,14 +6,17 @@
# here are all the requests the client will try
my @requests = (
+
+ #Â host, path, expected code, dns should fail
[ 'www.mongueurs.net', '/', 200 ],
[ 'httpd.apache.org', '/docs', 301 ],
[ 'www.google.com', '/testing/', 404 ],
- [ 'www.error.zzz', '/', 500 ],
+ [ 'www.error.zzz', '/', 500, 1 ],
);
-if( $^O eq 'MSWin32' ) {
- plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
+if ( $^O eq 'MSWin32' ) {
+ plan skip_all =>
+ "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
@@ -26,15 +29,20 @@
$test->use_numbers(0);
$test->no_ending(1);
-my $proxy = HTTP::Proxy->new( port => 9990, max_connections => @requests * $web_ok + 1 );
+my $proxy = HTTP::Proxy->new(
+ port => 0,
+ max_connections => @requests * $web_ok + 1,
+);
$proxy->init; # required to access the url later
# fork a HTTP proxy
my $pid = fork_proxy(
$proxy,
sub {
- is( $proxy->conn, @requests * $web_ok + 1,
- "Served the correct number of requests" );
+ is( $proxy->conn,
+ @requests * $web_ok + 1,
+ "Served the correct number of requests"
+ );
}
);
@@ -47,11 +55,22 @@
skip "Web does not seem to work", scalar @requests unless $web_ok;
for (@requests) {
- $content = bare_request(
- $_->[1], HTTP::Headers->new( Host => $_->[0]), $proxy
- );
- ($code) = $content =~ m!^HTTP/\d+\.\d+ (\d\d\d) !g;
- is( $code, $_->[2], "Got an answer (@{[$code]})" );
+ my ( $host, $path, $status, $dns_fail ) = @$_;
+ $dns_fail &&= defined +( gethostbyname $host )[4];
+
+ SKIP: {
+ if ($dns_fail) {
+ $content = bare_request( '/',
+ HTTP::Headers->new( Host => 'localhost' ), $proxy );
+ skip "Our DNS shouldn't resolve $host", 1;
+ }
+ else {
+ $content = bare_request( $path,
+ HTTP::Headers->new( Host => $host ), $proxy );
+ ($code) = $content =~ m!^HTTP/\d+\.\d+ (\d\d\d) !g;
+ is( $code, $status, "Got an answer ($code)" );
+ }
+ }
}
}
Modified: trunk/libhttp-proxy-perl/t/90diveintomark.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-proxy-perl/t/90diveintomark.t?rev=18940&op=diff
==============================================================================
--- trunk/libhttp-proxy-perl/t/90diveintomark.t (original)
+++ trunk/libhttp-proxy-perl/t/90diveintomark.t Sun Apr 20 18:58:33 2008
@@ -42,8 +42,11 @@
skip "$base is not available", $tests unless web_ok( $base );
# $tests + 2, because of the duplicate 401
- my $proxy =
- HTTP::Proxy->new( port => 0, max_keep_alive_requests => $tests + 2, max_connections => 1 );
+ my $proxy = HTTP::Proxy->new(
+ port => 0,
+ max_keep_alive_requests => $tests + 2,
+ max_connections => 1,
+ );
$proxy->init;
# the auto-authenticating client
More information about the Pkg-perl-cvs-commits
mailing list