r18938 - in /branches/upstream/libhttp-proxy-perl/current: ./ 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:53:40 UTC 2008
Author: gregoa
Date: Sun Apr 20 18:53:39 2008
New Revision: 18938
URL: http://svn.debian.org/wsvn/?sc=1&rev=18938
Log:
[svn-upgrade] Integrating new upstream version, libhttp-proxy-perl (0.21)
Added:
branches/upstream/libhttp-proxy-perl/current/eg/flv.pl
branches/upstream/libhttp-proxy-perl/current/t/67save.t
Modified:
branches/upstream/libhttp-proxy-perl/current/Changes
branches/upstream/libhttp-proxy-perl/current/MANIFEST
branches/upstream/libhttp-proxy-perl/current/META.yml
branches/upstream/libhttp-proxy-perl/current/Makefile.PL
branches/upstream/libhttp-proxy-perl/current/eg/README
branches/upstream/libhttp-proxy-perl/current/eg/dragon.pl
branches/upstream/libhttp-proxy-perl/current/eg/proxy-auth.pl
branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm
branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm
branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/Legacy.pm
branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/ScoreBoard.pm
branches/upstream/libhttp-proxy-perl/current/t/22http.t
branches/upstream/libhttp-proxy-perl/current/t/22transparent.t
branches/upstream/libhttp-proxy-perl/current/t/90diveintomark.t
Modified: branches/upstream/libhttp-proxy-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/Changes?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/Changes (original)
+++ branches/upstream/libhttp-proxy-perl/current/Changes Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/MANIFEST?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/MANIFEST (original)
+++ branches/upstream/libhttp-proxy-perl/current/MANIFEST Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/META.yml?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/META.yml (original)
+++ branches/upstream/libhttp-proxy-perl/current/META.yml Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/Makefile.PL?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/Makefile.PL (original)
+++ branches/upstream/libhttp-proxy-perl/current/Makefile.PL Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/eg/README
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/eg/README?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/eg/README (original)
+++ branches/upstream/libhttp-proxy-perl/current/eg/README Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/eg/dragon.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/eg/dragon.pl?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/eg/dragon.pl (original)
+++ branches/upstream/libhttp-proxy-perl/current/eg/dragon.pl Sun Apr 20 18:53:39 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';
Added: branches/upstream/libhttp-proxy-perl/current/eg/flv.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/eg/flv.pl?rev=18938&op=file
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/eg/flv.pl (added)
+++ branches/upstream/libhttp-proxy-perl/current/eg/flv.pl Sun Apr 20 18:53:39 2008
@@ -1,0 +1,42 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use HTTP::Proxy;
+use HTTP::Proxy::BodyFilter::save;
+use Digest::MD5 qw( md5_hex);
+use POSIX qw( strftime );
+
+my $proxy = HTTP::Proxy->new(@ARGV);
+
+# a filter to save FLV files somewhere
+my $flv_filter = HTTP::Proxy::BodyFilter::save->new(
+ filename => sub {
+ my ($message) = @_;
+ my $uri = $message->request->uri;
+
+ # get the id, or fallback to some md5 hash
+ my ($id) = ( $uri->query || '' ) =~ /id=([^&;]+)/i;
+ $id = md5_hex($uri) unless $id;
+
+ # compute the filename (including the base site name)
+ my ($host) = $uri->host =~ /([^.]+\.[^.]+)$/;
+ my $file = strftime "flv/%Y-%m-%d/${host}_$id.flv", localtime;
+
+ # ignore it if we already have it
+ return if -e $file && -s $file == $message->content_length;
+
+ # otherwise, save
+ return $file;
+ },
+);
+
+# push the filter for all MIME types we want to catch
+for my $mime (qw( video/flv video/x-flv )) {
+ $proxy->push_filter(
+ mime => $mime,
+ response => $flv_filter,
+ );
+}
+
+$proxy->start;
+
Modified: branches/upstream/libhttp-proxy-perl/current/eg/proxy-auth.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/eg/proxy-auth.pl?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/eg/proxy-auth.pl (original)
+++ branches/upstream/libhttp-proxy-perl/current/eg/proxy-auth.pl Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm (original)
+++ branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm (original)
+++ branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/Legacy.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/Legacy.pm?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/Legacy.pm (original)
+++ branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/Legacy.pm Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/ScoreBoard.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/ScoreBoard.pm?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/ScoreBoard.pm (original)
+++ branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/Engine/ScoreBoard.pm Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/t/22http.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/t/22http.t?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/t/22http.t (original)
+++ branches/upstream/libhttp-proxy-perl/current/t/22http.t Sun Apr 20 18:53:39 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: branches/upstream/libhttp-proxy-perl/current/t/22transparent.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/t/22transparent.t?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/t/22transparent.t (original)
+++ branches/upstream/libhttp-proxy-perl/current/t/22transparent.t Sun Apr 20 18:53:39 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)" );
+ }
+ }
}
}
Added: branches/upstream/libhttp-proxy-perl/current/t/67save.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/t/67save.t?rev=18938&op=file
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/t/67save.t (added)
+++ branches/upstream/libhttp-proxy-perl/current/t/67save.t Sun Apr 20 18:53:39 2008
@@ -1,0 +1,205 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Proxy::BodyFilter::save;
+use File::Temp qw( tempdir );
+
+# a sandbox to play in
+my $dir = tempdir( CLEANUP => 1 );
+
+my @errors = (
+ [ [ keep_old => 1, timestamp => 1 ] =>
+ qr/^Can't timestamp and keep older files at the same time/
+ ],
+ [ [ status => 200 ] => qr/^status must be an array reference/ ],
+ [ [ status => [qw(200 007 )] ] =>
+ qr/status must contain only HTTP codes/
+ ],
+ [ [ filename => 'zlonk' ] => qr/^filename must be a code reference/ ],
+);
+my @data = (
+ 'recusandae veritatis illum quos tempor aut quidem',
+ 'necessitatibus lorem aperiam facere consequuntur incididunt similique'
+);
+my @d = ( prefix => $dir ); # defaults
+my @templates = (
+
+ # args, URL => filename
+ [ [@d], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html" ],
+ [ [ @d, multiple => 0 ],
+ 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html"
+ ],
+ [ [@d], 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/zok/awk.html.1" ],
+ [ [ @d, no_host => 1 ],
+ 'http://bam.fr/zok/awk.html' => "$dir/zok/awk.html"
+ ],
+ [ [ @d, no_dirs => 1 ],
+ 'http://bam.fr/zok/awk.html' => "$dir/bam.fr/awk.html"
+ ],
+ [ [ @d, no_host => 1, no_dirs => 1 ],
+ 'http://bam.fr/zok/awk.html' => "$dir/awk.html"
+ ],
+ [ [ @d, no_dirs => 1 ], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html"
+ ],
+ #[ [@d], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html" ],
+ [ [ template => "$dir/%p" ],
+ 'http://bam.fr/pow/zok.html' => "$dir/pow/zok.html"
+ ],
+ [ [ template => "$dir/%f" ],
+ 'http://bam.fr/pow/zok.html' => "$dir/zok.html"
+ ],
+ [ [ template => "$dir/%p" ],
+ 'http://bam.fr/zam.html?q=pow' => "$dir/zam.html"
+ ],
+ [ [ template => "$dir/%P" ],
+ 'http://bam.fr/zam.html?q=pow' => "$dir/zam.html?q=pow"
+ ],
+ [ [ @d, cut_dirs => 2 ],
+ 'http://bam.fr/a/b/c/d/e.html' => "$dir/bam.fr/c/d/e.html"
+ ],
+ [ [ @d, cut_dirs => 2, no_host => 1 ],
+ 'http://bam.fr/a/b/c/d/e.html' => "$dir/c/d/e.html"
+ ],
+ [ [ @d, cut_dirs => 5, no_host => 1 ],
+ 'http://bam.fr/a/b/c/d/e.html' => "$dir/e.html"
+ ],
+
+ # won't save
+ [ [ @d, keep_old => 1 ], 'http://bam.fr/zok/awk.html' => undef ],
+);
+my @responses = (
+ [ [@d], 'http://bam.fr/a.html' => 200, "$dir/bam.fr/a.html" ],
+ [ [@d], 'http://bam.fr/b.html' => 404, undef ],
+ [ [ @d, status => [ 200, 404 ] ],
+ 'http://bam.fr/c.html' => 404,
+ "$dir/bam.fr/c.html"
+ ],
+);
+
+plan tests => 2 * @errors #Â error checking
+ + 1 # simple test
+ + 7 * 2 # filename tests: 2 that save
+ + 5 * 2 # filename tests: 2 that don't
+ + 2 * @templates #Â all template tests
+ + 2 * @responses # all responses tests
+ ;
+
+# some variables
+my $proxy = HTTP::Proxy->new( port => 0 );
+my ( $filter, $data, $file, $buffer );
+
+#Â test the save filter
+# 1) errors in new
+for my $t (@errors) {
+ my ( $args, $regex ) = @$t;
+ ok( !eval { HTTP::Proxy::BodyFilter::save->new(@$args); 1; },
+ "new( @$args ) fails" );
+ like( $@, $regex, "Error matches $regex" );
+}
+
+# 2) code for filenames
+$filter = HTTP::Proxy::BodyFilter::save->new( filename => sub {$file} );
+$filter->proxy($proxy);
+
+# simple check
+ok( !$filter->will_modify, 'Filter does not modify content' );
+
+# loop on four requests
+# two that save, and two that won't
+for my $name ( qw( zlonk.pod kayo.html ), undef, '' ) {
+ $file = $name ? "$dir/$name" : $name;
+
+ my $req = HTTP::Request->new( GET => 'http://www.example.com/' );
+ ok( my $ok = eval {
+ $filter->begin($req);
+ 1;
+ },
+ 'Initialized filter without error'
+ );
+ diag $@ if !$ok;
+
+ if ($file) {
+ is( $filter->{_hpbf_save_filename}, $file, "Got filename ($file)" );
+ }
+ else {
+ ok( !$filter->{_hpbf_save_filename}, 'No filename' );
+ }
+
+ my $filter_fh;
+ if ($name) {
+ ok( $filter->{_hpbf_save_fh}->opened, 'Filehandle opened' );
+ $filter_fh = $filter->{_hpbf_save_fh};
+ }
+ else {
+ ok( !exists $filter->{_hpbf_save_fh}, 'No filehandle' );
+ }
+
+ # add some data
+ $buffer = '';
+ ok( eval {
+ $filter->filter( \$data[0], $req, '', \$buffer );
+ $filter->filter( \$data[1], $req, '', undef );
+ $filter->end();
+ 1;
+ },
+ 'Filtered data without error'
+ );
+ diag $@ if $@;
+
+ # file closed now
+ ok( !defined $filter->{_hpbf_save_fh}, 'No filehandle' );
+ if ($filter_fh) {
+ ok( !$filter_fh->opened, 'Filehandle closed' );
+
+ # check the data
+ open my $fh, $file or diag "Can't open $file: $!";
+ is( join( '', <$fh> ), join( '', @data ), 'All data saved' );
+ close $fh;
+ }
+
+}
+
+# 3) the multiple templating cases
+for my $t (@templates) {
+ my ( $args, $url, $filename ) = @$t;
+ my $filter = HTTP::Proxy::BodyFilter::save->new(@$args);
+ $filter->proxy($proxy);
+ my $req = HTTP::Request->new( GET => $url );
+
+ # filter initialisation
+ ok( my $ok = eval {
+ $filter->begin($req);
+ 1;
+ },
+ 'Initialized filter without error'
+ );
+ diag $@ if !$ok;
+ my $mesg = defined $filename ? "$url => $filename" : "Won't save $url";
+ is( $filter->{_hpbf_save_filename}, $filename, $mesg );
+}
+
+# 4) some cases that depend on the response
+for my $t (@responses) {
+ my ( $args, $url, $status, $filename ) = @$t;
+ my $filter = HTTP::Proxy::BodyFilter::save->new(@$args);
+ $filter->proxy($proxy);
+ my $res = HTTP::Response->new($status);
+ $res->request( HTTP::Request->new( GET => $url ) );
+
+ ok( my $ok = eval {
+ $filter->begin($res);
+ 1;
+ },
+ 'Initialized filter without error'
+ );
+ diag $@ if !$ok;
+ if ($filename) {
+ is( $filter->{_hpbf_save_filename},
+ $filename, "$url ($status) => $filename" );
+ }
+ else {
+ ok( !$filter->{_hpbf_save_filename},
+ "$url ($status) => No filename" );
+ }
+}
+
Modified: branches/upstream/libhttp-proxy-perl/current/t/90diveintomark.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhttp-proxy-perl/current/t/90diveintomark.t?rev=18938&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/t/90diveintomark.t (original)
+++ branches/upstream/libhttp-proxy-perl/current/t/90diveintomark.t Sun Apr 20 18:53:39 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