HTTP-Proxy-0.304/ 0000755 0001750 0001750 00000000000 12537671053 012075 5 ustar book book HTTP-Proxy-0.304/Changes 0000644 0001750 0001750 00000046342 12537671053 013401 0 ustar book book Revision history for Perl extension HTTP::Proxy
0.304 Tue Jun 16 2015
[FIXES]
- fix RT #105177 (Slaven Rezic and Gregor Herrmann), regarding Via: header
[TEST]
- improvement on the fix for t/23connect.t (thanks to e477),
but that does not seem to be enough
- fix RT #71771 (test using HTML::Parser)
0.303 Wed Apr 29 2015
[FIXES]
- closed RT #90414 (Vincenzo Buttazzo), fixing HTTPS data transfer
- closed RT #62950 (Slaven Rezic), adding the port to the Via: header
[DOCUMENTATION]
- added many more contributors in the META file
[TEST]
- fixed t/23connect.t
0.302 Sat Jan 31 2015
[DOCUMENTATION]
- fix RT #85632 (Ashley Pond V)
- multiple documentation fixes (Ashley Pond V)
- list git contributors in the META file
[PACKAGING]
- switch to Dist::Zilla for maintaining the distribution
0.301 Sun Aug 3 2014
[TEST]
- fix t/02pod-coverage.t to skip HTTP::Proxy::Engine::Threaded
when running under an unthreaded Perl (Masahiro Nagano (KAZEBURO))
- fix t/01pod.t and t/02pod-coverage.t to only run under
RELEASE_TESTING (thanks to Masahiro Nagano (KAZEBURO))
0.300 Sun Apr 7 2013
[IMPROVEMENTS]
- Downgrade a disconnect message from ERROR to SOCKET debug level
in order to reduce the amount of runtime log output. Disconnects
are /very/ common in HTTP, and shoudn't be considered errors.
(thanks to Salve J. Nilsen)
[TEST]
- include t/90httpstatus.t in the MANIFEST
- fix t/67save.t to not try to create files with a "?" in
their name under MSWin32
0.29 Tue Mar 19 2013
[TEST]
- fix t/50hopbyhop.t to open the proxy on a random port,
and avoid failures when port 8080 is "already in use"
0.28 Thu Mar 14 2013
[FIXES]
- the Accept-Encoding header removal code was broken in the previous
version. Now the header will be removed as soon as a body filter
is configured for the proxy.
[TEST]
- use File::Spec in the test suite to compute portable file names,
to avoid some test failures, like
http://www.cpantesters.org/cpan/report/856ca676-6bf5-1014-bfa1-9d8aa3912248
0.27 Fri Mar 8 2013
[IMPROVEMENTS]
- in HTTP::Proxy::HeaderFilter::standard, now remove the Accept-Encoding header
only when we know we'll actually look at the response body
[TESTS]
- use httpstat.us to test HTTP statuses
0.26 Wed Feb 6 2013
[IMPROVEMENTS]
- remove a "Use of "goto" to jump into a construct is deprecated"
warning (Tom Hukins)
[DOCUMENTATION]
- fix RT #77685 (Tom Hukins)
- improved the number of links to other modules from the documentation
[TEST]
- fix RT #71771 (Tom Hukins)
- fix test failures in POD tests (Tom Hukins)
0.25 Sun Jul 3 00:28:10 CEST 2011
[ENHANCEMENTS]
- new Engine: HTTP::Proxy::Engine::Threaded, by Angelos Karageorgiou
[FIXES]
- Correctly call eod() when the response has no body
(closed RT ticket #48310)
0.24 Tue Jul 21 21:28:02 CEST 2009
[ENHANCEMENTS]
- When a short-circuit response was send, the next response
would not be filtered at all. This has been fixed.
[FIXES]
- yet another fix for t/23connect, proposed by Marek Rouchal
(closed RT ticket #38995) [test skipped for now]
- HTTP::Headers::Util's split_header_words() returns lower case
tokens/keys since October 6, 2008. Fix by Maurice Aubrey.
(closed RT tickets #43249, #43622)
0.23 Thu Sep 4 02:29:47 CEST 2008
[ENHANCEMENTS]
- HTTP::Proxy::BodyFilter::save had an issue with cygwin because
of an incorrect use of File::Spec's catdir(). This is fixed.
- CONNECT requests are now forwarded to the upstream proxy, if there
is one. Errors from the upstream proxy are relayed to the client.
[TESTS]
- t/23connect.t does not use sysread() anymore. This time the test
should pass about everywhere.
0.22 Thu May 1 00:18:38 CEST 2008
[TESTS]
- increased test coverage
- t/23connect.t doesn't need an Internet connection any more,
thus closing RT ticket #19653.
- t/67complete.t tests HTTP::Proxy::BodyFilter::complete
[DOCUMENTATION]
- closed RT ticket #33465 (Jimbo), by explaining in a little
more detail how HTTP::Proxy::BodyFilter::complete works.
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.
- fixed t/22http.t and t/22transparent.t not to break when the
DNS wrongly resolves an invalid address.
[DOCUMENTATION]
- closed RT ticket #25295 (Matsuno Tokuhiro) with a doc patch.
0.20 Fri Aug 18 10:25:11 CEST 2006
[ENHANCEMENTS]
- Added a will_modify() method to HTTP::Proxy::BodyFilter, that
lets the proxy know if a filter may modify the content length,
thus closing RT ticket #21051 (Chris Dolan)
- If no filter in the current stack will modify the content length,
then the header is not removed
[FIXES]
- closed RT tickets #3184 and #20251 (chunked encoding was enforced
while transfering data between a client and server using
different versions of HTTP, causing unwanted garbage to appear
in the data)
- removed useless "ERROR: Getting request failed:" messages
when there are simply "No more requests from this connection"
[INTERNALS]
- Removed the HTTP::Proxy::FilterStack class from inside HTTP::Proxy
and put it in its own module file
- renamed HTTP::Proxy::FilterStack::active() as will_modify() for
consistency reasons
[TESTS]
- updated t/22http.t and t/23connect.t following Ken Williams'
recommandations in RT ticket #19986
[DOCUMENTATION]
- patched a small inconsistency in HTTP::Proxy::BodyFilter's
documentation (and closed RT ticket #20303)
- fully documented HTTP::Proxy::FilterStack
0.19 Fri Apr 28 19:55:41 CEST 2006
[ENHANCEMENTS]
- HTTP::Proxy::HeaderFilter::simple now lets one define an
end() method as well
[FIXES]
- HTTP::Proxy::(Body|Header)Filter::simple now provide a default
filter() that does nothing if their constructor is not given one
(thanks to Merijn Brand)
- close RT ticket #14548 by correcting the 'filename' check
in HTTP::Proxy::BodyFilter::save (Max Maischein)
- ERROR messages are always logged (Mark Tilford)
[TESTS]
- more tests for log() and logmask() in t/11log.t
0.18 Sun Mar 19 23:49:38 CET 2006
[ENHANCEMENTS]
- the new known_methods() method can return all method
names know to HTTP::Proxy (can be helpful with the
method parameter of push_filter())
[FIXES]
- close RT ticket #14898 by using a per-parent lockfile for
HTTP::Proxy::Engine::ScoreBoard (Chris Dolan)
- close RT ticket #18243 by adding missing DeltaV methods
(Stephen Steneker)
[EXAMPLES]
- eg/perlmonks.pl - redirect perlmonks.com to perlmonks.org
0.17 Wed Sep 28 23:25:17 CEST 2005
[ENHANCEMENTS]
- Thanks to Randal Schwartz, a new HTTP::Proxy::Engine::ScoreBoard
engine is available. I've benchmarked a twofold speed increase.
This engine is still beta, you must enable it by hand.
0.16 Thu Sep 1 19:13:55 CEST 2005
[ENHANCEMENTS]
- the new HTTP::Proxy::Engine class and its subclasses
now handle the life and death of child processes
- the Content-Length header is now removed only if body
filters will be applied on the response body
- HTTP::Proxy now supports some Apache-like attributes
(start_servers, max_clients, max_requests_per_child,
min_spare_servers, max_spare_servers, keep_alive,
max_keep_alive_requests, keep_alive_timeout)
- added support for ALL WebDAV/DeltaV methods
- the query argument to push_filter(), added in 0.14, should
now work (thanks to Simon Cozens for spotting the problem)
- the proxy now has a stash, which is a hash where filters can
store data (possibly to share it). (Requested by Mark Fowler)
Warning: since the proxy forks for each TCP connection, the
data is only shared between filters in the same child process.
[DEPRECATION]
- the maxchild, maxconn and maxserve accessors are now
deprecated. They will disappear in the future:
+ maxchild has no replacement (should be handled by the engine)
+ maxconn becomes max_connections
+ maxserve becomes max_keep_alive_requests
- Information regarding the way the engine should behave
must passed in the constructor or directly to the engine
[NEW METHODS]
- $proxy->engine() return the HTTP::Proxy::Engine instance
- $proxy->new_connection() increase the TCP connections counter
(should only be used by HTTP::Proxy::Engine object)
[FIXES]
- Makefile.PL was not playing nice with Build.PL in the
previous distributions. This has been fixed. Sorry for the
inconvenience
- no more annoying "getsockname() on closed socket GEN0"
warnings (they appeared in 0.14)
[Win32 SUPPORT]
- Win32 is now supported! badly supported, but supported...
- until someone writes a decent engine for Win32, the default
Win32 engine will be HTTP::Proxy::Engine::NoFork, which
can only handle a single TCP connection at a time
[EXAMPLES]
- eg/yahoogroups.pl - removes ad interruptions from Yahoo! Groups
- eg/https.pl - peek/poke at encrypted web pages
- eg/logger.pl - improved the logger script
0.15 Tue Apr 5 21:17:40 CEST 2005
[ENHANCEMENTS]
- added support for WebDAV methods (requested by Christian Laursen)
- The filter selection is based on the original request and response,
as it should
- improved kwalitee
[DEPRECATION]
- the start() method is no longer supported in HTTP::Proxy::BodyFilter
subclasses. Use begin() instead.
[EXAMPLES]
- eg/pdf.pl - save \.pdf files and send a HTML confirmation instead
(idea by Emmanuel Di Prétoro)
0.14 Tue Mar 29 11:40:51 CEST 2005
[ANNOUNCE]
- It's been more than a year since last release, which is bad.
I now plan to release new versions more often, maybe about
once a month, or when there are big changes.
[DEPRECATION]
- the start() method of HTTP::Proxy::Bodyfilter subclasses
is renamed begin(), since it now has an end() counterpart.
(On a related note, I improve my English. Be sure to check out
http://www.landgren.net/perl/lt-2004.html for details)
- start() in filters is therefore declared deprecated, an error
message is logged. The start() method will not be called any
more as from 0.15.
- the FILTER constant is now named FILTERS. FILTER will disappear
in 0.15 as well.
[ENHANCEMENTS]
- subclasses of HTTP::Proxy::BodyFilter can now have a
finalisation method, named end()
- the start^Wbegin() method of HTTP::Proxy::BodyFilter subclasses
now receive the message as an argument
- new built-in filter: HTTP::Proxy::BodyFilter::save
that can save the message body to a file while browsing
- new built-in filter: HTTP::Proxy::BodyFilter::complete
that stores the message body in memory and passes it on to the
next filters only when it's complete
- logs have cleaner prefixes and the pid is always shown
- should work under 5.005_03 (Thanks to Mathieu Arnold)
- transparent proxying support (mostly to please Martin Zdila
and Paul Makepeace)
- push_filter() should now accept the query parameter
[FIXES]
- the FILTER constant is now named FILTERS
[BUGS]
- the proxy does not work under Win32, except if you force
maxchild to 0 (no forking at all).
- t/20dummy.t (and a few others) hanged under Win32
+ Ken Hirsch proposed a patch for HTTP::Daemon
(and a workaround for HTTP::Proxy's daemon object)
+ Bruno De Fraine tracked down the problem to the fork()
emulation by Windows threads under Win32 that lead to
a deadlock.
=> both explanations cover the same problem, which I haven't
been able to correct yet
- all the tests that fork a proxy and a server are therefore
skipped under Win32. This is ugly, and will change in the future.
[EXAMPLES]
- eg/rfc.pl - save rfc\d+\.txt files as we browse them
- eg/js.pl - save \.js files as we browse them
- eg/dragon.pl - enhance the Dragon Go Server web site
- eg/fudd.pl - make the web tawk wike Ewmer J. Fudd
- eg/switch.pl - switch proxies as you browse
- Changed all the examples so that they can take HTTP::Proxy::new()
parameters on the command-line (so, call them with logmask 3,
for example)
[DOCUMENTATION]
- documentation for the filter initialisation methods
- removed all references to the so-called "store-and-forward"
mechanism (see HTTP::Proxy::BodyFilter::complete)
0.13 Wed Mar 3 17:36:31 CET 2004
[ENHANCEMENTS]
- CONNECT support (but only transparently...)
- the client_headers() method (similar to hop_headers()) give
the filters access to the proxy's LWP::UA Client-* headers
- filters are applied on all supported methods by default
[FIXES]
- removed everything regarding control() and control_regex(),
which were not used and confusing
[TESTS]
- tests for CONNECT support
- tests for SSL support (not working yet)
[EXAMPLES]
- eg/adblock.pl - a very simple adblocker
- eg/trim.pl - trims whitespace from HTML pages
- eg/javascript.pl - add any text right after
[DOCUMENTATION]
- separate COPYRIGHT and LICENSE sections in all man pages
0.12 Thu Jan 22 23:54:03 CET 2004
[ENHANCEMENTS]
- send the error message to the client when the Proxy agent dies
(usually because of a filter error)
- the proxy now sends a X-Forwarded-For header by default
(and the proxy method x_forwarded_for can toggle this)
- the proxy method client_socket() gives access to the socket
connected to the current client (the example in Changes for 0.10
was wrong: one can get the IP address of the connected agent from
inside a filter with $self->proxy->client_socket->peerhost)
[FIXES]
- do not block simultaneous connections when not forking
- clean up the filter chain after the body-request filters
- ensure the filter stack is reinitialised between requests
[TESTS]
- tests for X-Forwarded-For
- test the proxy against http://diveintomark.org/tests/client/http/
[EXAMPLES]
- eg/post.pl - outputs the URI and parameters of all POST requests
- eg/logger.pl - outputs details of GET and POST requests
0.11 Fri Jan 2 17:02:08 CET 2004
[ENHANCEMENTS]
- setting maxchild to 0 prevents forking (Jim Cromie)
- filters can now match on the query string
- hop-by-hop headers and Max-Forwards headers are correctly supported
- new mutators added to HTTP::Proxy: via, hop_headers, request,
response
- filters can now answer in place of the server, which allows
for authorisation filters, cache (?) filters, etc.
- new examples scripts: proxy-auth.pl
[FIXES]
- push_filter() now correctly supports several match criteria
[TESTS]
- all the Via: header tests are now in t/50via.t
- t/50standard.t now checks headers for several request types
- new tests:
+ t/51simple2.t - check response header filters with an actual proxy
+ t/61simple2.t - check response body filters with an actual proxy
[INTERNALS]
- new method _send_response_headers
0.10 Wed Nov 19 01:36:59 CET 2003
*** MAJOR INTERFACE CHANGES ***
- new base classes HTTP::Proxy::HeaderFilter and
HTTP::Proxy::BodyFilter
- some useful built-in filter classes:
HTTP::Proxy::BodyFilter::htmlparser
HTTP::Proxy::BodyFilter::htmltext
HTTP::Proxy::BodyFilter::lines
HTTP::Proxy::BodyFilter::simple
HTTP::Proxy::BodyFilter::tags
HTTP::Proxy::HeaderFilter::simple
HTTP::Proxy::HeaderFilter::standard
- tests for the internal class HTTP::Proxy::FilterStack
- tests for the built-in filters
- the examples are up-to-date with the new interface
- new/enhanced accessors:
+ the proxy host() attribute becomes actually useful: by default,
the proxy is only usable by local user-agents (the socket
is bound to localhost)
+ the filters proxy() accessor gives access to the proxy itself.
For example, one can get the IP address of the agent connected
to the proxy from inside a filter ($self->proxy->daemon->peerhost)
- many documentation changes
This version is NOT compatible with the previous ones
regarding the way filters work.
*** MAJOR INTERFACE CHANGES ***
0.09 Fri Aug 15 21:12:17 CEST 2003
- maxserve is now correctly handled
- corrected a bug in the t/20keepalive.t test file that
made the tests fail on some machines
0.08 Thu Mar 13 01:41:42 CET 2003
- cleaned up support for filters
- added support for "buffering" filters
and a new HTTP::Proxy::FilterStack class
- added an anonymiser script (eg/anonymiser.pl)
- the tests won't break if a local proxy is configured
- the interfaces are very likely to change soon
0.07 Tue Feb 18 22:30:43 CET 2003
- the proxy now supports persistent connexions (Yay!)
- and tests to check for it
- and a new timeout accessor
0.06 Mon Feb 17 00:21:37 CET 2003
- better forking system and better reaping of zombies
(thanks to David Landgren and Stéphane Payrard)
Still won't work under Windows, though :-(
- replaced verbose() by logmask(), so as to fine-tune
the logging system
- put some of the test functions in a test module (t::Utils)
0.05 Tue Feb 4 00:47:23 CET 2003
- explicitly refuse CONNECT
- better support for TRACE method
- support the Via: Header (a MUST in RFC 2616)
- filters, but this needs more work
0.04 Sat Nov 30 12:19:22 CET 2002
- accept connection from other hosts
- better ftp support (no test yet)
- basic gopher support (no test yet)
- better HTTP error handling
- use CRLF in HTTP headers
0.03 Fri Nov 29 11:17:36 CET 2002
- url() method gives a url to reach the proxy
- new 'control' attribute defines the control URL
- better subprocess management by preforking child processes
(thanks to Eric Cholet)
- a children handles only one request at a time, for better
performance (this means we only do HTTP/1.0 for now)
- correctly handle the Proxy-Connection and Connection headers
0.02 Thu Oct 24 23:45:08 CEST 2002
- the system now forks to handle several connections
- but needs better test suites
0.01 Tue Oct 1 11:54:07 CEST 2002
- original version
HTTP-Proxy-0.304/LICENSE 0000644 0001750 0001750 00000043713 12537671053 013112 0 ustar book book This software is copyright (c) 2015 by Philippe Bruhat (BooK).
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Terms of the Perl programming language system itself
a) the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or
b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
This software is Copyright (c) 2015 by Philippe Bruhat (BooK).
This is free software, licensed under:
The GNU General Public License, Version 1, February 1989
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
Copyright (C) 19yy
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!
--- The Artistic License 1.0 ---
This software is Copyright (c) 2015 by Philippe Bruhat (BooK).
This is free software, licensed under:
The Artistic License 1.0
The Artistic License
Preamble
The intent of this document is to state the conditions under which a Package
may be copied, such that the Copyright Holder maintains some semblance of
artistic control over the development of the package, while giving the users of
the package the right to use and distribute the Package in a more-or-less
customary fashion, plus the right to make reasonable modifications.
Definitions:
- "Package" refers to the collection of files distributed by the Copyright
Holder, and derivatives of that collection of files created through
textual modification.
- "Standard Version" refers to such a Package if it has not been modified,
or has been modified in accordance with the wishes of the Copyright
Holder.
- "Copyright Holder" is whoever is named in the copyright or copyrights for
the package.
- "You" is you, if you're thinking about copying or distributing this Package.
- "Reasonable copying fee" is whatever you can justify on the basis of media
cost, duplication charges, time of people involved, and so on. (You will
not be required to justify it to the Copyright Holder, but only to the
computing community at large as a market that must bear the fee.)
- "Freely Available" means that no fee is charged for the item itself, though
there may be fees involved in handling the item. It also means that
recipients of the item may redistribute it under the same conditions they
received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or an
equivalent medium, or placing the modifications on a major archive site
such as ftp.uu.net, or by allowing the Copyright Holder to include your
modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict with
standard executables, which must also be provided, and provide a separate
manual page for each non-standard executable that clearly documents how it
differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or executable
form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where to
get the Standard Version.
b) accompany the distribution with the machine-readable source of the Package
with your modifications.
c) accompany any non-standard executables with their corresponding Standard
Version executables, giving the non-standard executables non-standard
names, and clearly documenting the differences in manual pages (or
equivalent), together with instructions on where to get the Standard
Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this Package. You
may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.
6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.
7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.
8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
HTTP-Proxy-0.304/eg/ 0000755 0001750 0001750 00000000000 12537671053 012470 5 ustar book book HTTP-Proxy-0.304/eg/dragon.pl 0000755 0001750 0001750 00000004102 12537671053 014277 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::complete;
use MIME::Base64;
use Fcntl ':flock';
use strict;
# the proxy
my $proxy = HTTP::Proxy->new( @ARGV );
# the status page:
# - auto-refresh (quickly at first, then more slowly)
# - count the number of games and modify the title
my $seen_title;
$proxy->push_filter(
host => 'www.dragongoserver.net',
path => '^/status.php',
# auto-refresh
response => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $response ) = @_;
($response->request->uri->query || '') =~ /reload=(\d+)/;
my $n = ($1 || 0) + 1;
my $delay = $n < 5 ? 30 : $n < 15 ? 60 : $n < 25 ? 300 : 3600;
$headers->push_header( Refresh => "$delay;url="
. $response->request->uri->path
. "?reload=$n" );
}
),
# count games
response => HTTP::Proxy::BodyFilter::complete->new(),
response => HTTP::Proxy::BodyFilter::simple->new(
filter => sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
next if ! $$dataref;
# count the games and change the title
my $n = 0; $n++ while $$dataref =~ /game\.php\?gid=\d+/g;
my $s = $n > 1 ? "s" : ""; $n ||= "No";
$$dataref =~ s!.*?!$n go game$s pending!s;
},
),
);
# the game page:
# - remove the Message: textarea
# - add a link to make it appear when needed
$proxy->push_filter(
host => 'www.dragongoserver.net',
path => '^/game.php',
response => HTTP::Proxy::BodyFilter::complete->new(),
response => HTTP::Proxy::BodyFilter::simple->new(
sub {
my $msg = '&msg=yes';
my $uri = $_[2]->request->uri;
if( $uri =~ s/$msg//o ) { $msg = ''; }
else { ${$_[1]} =~ s|(?textarea.*>)||; }
${$_[1]} =~ s|(Message:)|$1|;
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/proxy.pl 0000755 0001750 0001750 00000000206 12537671053 014207 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use strict;
# a very simple proxy
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->start;
HTTP-Proxy-0.304/eg/outline.pl 0000755 0001750 0001750 00000002145 12537671053 014511 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::htmlparser;
use HTML::Parser;
use strict;
my $parser = HTML::Parser->new( api_version => 3 );
$parser->handler(
start_document => sub { my $self = shift; $self->{print} = 1 },
"self"
);
$parser->handler(
start => sub {
my ( $self, $tag, $text ) = @_;
$self->{print} = 1 if $tag =~ /^h\d/;
$self->{output} .= $text if $self->{print};
$self->{print} = 0 if $tag eq 'body';
},
"self,tagname,text"
);
$parser->handler(
end => sub {
my ( $self, $tag, $text ) = @_;
$self->{print} = 1 if $tag eq 'body';
$self->{output} .= $text if $self->{print};
$self->{print} = 0 if $tag =~ /^h\d/;
},
"self,tagname,text"
);
$parser->handler(
default => sub {
my ( $self, $text ) = @_;
$self->{output} .= $text if $self->{print};
},
"self,text"
);
my $filter = HTTP::Proxy::BodyFilter::htmlparser->new( $parser, rw => 1 );
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter( mime => 'text/html', response => $filter );
$proxy->start;
HTTP-Proxy-0.304/eg/rot13.pl 0000755 0001750 0001750 00000003377 12537671053 014012 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::htmltext;
use strict;
my $proxy = HTTP::Proxy->new(@ARGV);
my %noaccent = (
Agrave => 'A', Aacute => 'A', Acirc => 'A', Atilde => 'A',
Auml => 'A', Aring => 'A', AElig => 'AE', Ccedil => 'C',
Egrave => 'E', Eacute => 'E', Ecirc => 'E', Euml => 'E',
Igrave => 'I', Iacute => 'I', Icirc => 'I', Iuml => 'I',
Ntilde => 'N', Ograve => 'O', Oacute => 'O', Ocirc => 'O',
Otile => 'O', Ouml => 'O', Oslash => 'O', Ugrave => 'U',
Uacute => 'U', Ucirc => 'U', Uuml => 'U', Yacute => 'Y',
agrave => 'a', aacute => 'a', acirc => 'a', atilde => 'a',
auml => 'a', aring => 'a', aelig => 'ae', ccedil => 'c',
egrave => 'e', eacute => 'e', ecirc => 'e', euml => 'e',
igrave => 'i', iacute => 'i', icirc => 'i', iuml => 'i',
ntilde => 'n', ograve => 'o', oacute => 'o', ocirc => 'o',
otile => 'o', ouml => 'o', oslash => 'o', ugrave => 'u',
uacute => 'u', ucirc => 'u', uuml => 'u', yacute => 'y',
'yuml' => 'y', 'Æ' => 'AE', 'æ' => 'ae',
);
my $re = join '|', sort keys %noaccent;
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new, # protect tags
response => HTTP::Proxy::BodyFilter::simple->new( # remove accents
sub { ${ $_[1] } =~ s/&($re);/$noaccent{$1}/go; }
),
response => HTTP::Proxy::BodyFilter::htmltext->new( # rot13
sub {
tr{ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöøùúûüýÿ}
{AAAAAACEEEEIIIINOOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuyy};
tr/a-zA-z/n-za-mN-ZA-M/;
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/js.pl 0000755 0001750 0001750 00000000551 12537671053 013445 0 ustar book book use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::save;
my $proxy = HTTP::Proxy->new(@ARGV);
# save javascript files as we browse them
$proxy->push_filter(
path => qr!/.js$!,
response => HTTP::Proxy::BodyFilter::save->new(
template => '%f',
prefix => 'javascript',
multiple => 0,
keep_old => 1,
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/proxy-auth.pl 0000755 0001750 0001750 00000002014 12537671053 015145 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::HeaderFilter::simple;
use MIME::Base64 qw( encode_base64 );
use strict;
# the encoded user:password pair
# login: http
# passwd: proxy
my $token = "Basic " . encode_base64( "http:proxy", '' );
# a very simple proxy that requires authentication
my $proxy = HTTP::Proxy->new(@ARGV);
# the authentication filter
$proxy->push_filter(
request => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $request ) = @_;
# 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"' );
$self->proxy->response($response);
}
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/leet.pl 0000755 0001750 0001750 00000001756 12537671053 013772 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::htmltext;
use strict;
# a very simple proxy
my $proxy = HTTP::Proxy->new( @ARGV );
my %leet = (
a => [qw( 4 /-\ @ )],
b => ['|3'],
c => [qw! c ( < [ !],
e => [qw( e 3 )],
g => [qw( g 6 )],
h => [qw! h |-| )-( !],
k => [qw( k |< ]{ )],
i => ['i', '!'],
l => [ 'l', "1", "|" ],
m => [ 'm', "|V|", "|\\/|" ],
n => ["|\\|"],
o => ['o', "0"],
s => [ "5", "Z" ],
t => [ "7", "+" ],
u => [qw( u \_/ )],
v => [qw( v \/ )],
w => [qw( vv `// )],
'y' => ['j', '`/'],
z => ["2"],
);
# but a complicated filter
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new,
response => HTTP::Proxy::BodyFilter::htmltext->new(
sub {
s/([a-zA-Z])/$leet{lc $1}[rand @{$leet{lc $1}}]||$1/ge;
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/adblock.pl 0000755 0001750 0001750 00000002014 12537671053 014424 0 ustar book book #!/usr/bin/perl -w
use strict;
use HTTP::Proxy qw( :log );
use HTTP::Proxy::HeaderFilter::simple;
use vars qw( $re );
# this is a very simple ad blocker
# a full-fledged ad blocker should be a module
# this dot is *not* a web bug ;-)
my $no = HTTP::Response->new( 200 );
$no->content_type('text/plain');
$no->content('.');
my $filter = HTTP::Proxy::HeaderFilter::simple->new( sub {
my ( $self, $headers, $message ) = @_;
$self->proxy->response( $no ) if $message->uri->host =~ /$re/o;
} );
my $proxy = HTTP::Proxy->new( @ARGV );
$proxy->push_filter( request => $filter );
$proxy->start;
# a short and basic list
BEGIN {
$re = join '|', map { quotemeta } qw(
ads.wanadooregie.com
cybermonitor.com
doubleclick.com
adfu.blockstackers.com
bannerswap.com
click2net.com
clickxchange.com
dimeclicks.com
fastclick.net
mediacharger.com
mediaplex.com
myaffiliateprogram.com
netads.hotwired.com
valueclick.com
);
}
HTTP-Proxy-0.304/eg/tracker.pl 0000755 0001750 0001750 00000001627 12537671053 014471 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use Fcntl ':flock';
use strict;
# this is a tracker proxy that 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
#
my $file = shift || '-';
open OUT, ">> $file" or die "Can't open $file: $!";
my $proxy = HTTP::Proxy->new( @ARGV ); # pass the args you want
$proxy->push_filter(
response => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $message ) = @_;
flock( OUT, LOCK_EX );
print OUT join( " ",
$message->request->headers->header( 'Referer' ) || 'NULL',
$message->request->uri,
$message->code ), $/;
flock( OUT, LOCK_UN );
}
)
);
$proxy->start;
END { close OUT; }
HTTP-Proxy-0.304/eg/logger.pl 0000755 0001750 0001750 00000006006 12537671053 014311 0 ustar book book #!/usr/bin/perl -w
use strict;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use HTTP::Proxy::BodyFilter::simple;
use CGI::Util qw( unescape );
# get the command-line parameters
my %args = (
peek => [],
header => [],
mime => 'text/*',
);
{
my $args = '(' . join( '|', keys %args ) . ')';
for ( my $i = 0 ; $i < @ARGV ; $i += 2 ) {
if ( $ARGV[$i] =~ /$args/o ) {
if ( ref $args{$1} ) {
push @{ $args{$1} }, $ARGV[ $i + 1 ];
}
else {
$args{$1} = $ARGV[ $i + 1 ];
}
splice( @ARGV, $i, 2 );
redo if $i < @ARGV;
}
}
}
# the headers we want to see
my @srv_hdr = (
qw( Content-Type Set-Cookie Set-Cookie2 WWW-Authenticate Location ),
@{ $args{header} }
);
my @clt_hdr =
( qw( Cookie Cookie2 Referer Referrer Authorization ), @{ $args{header} } );
# NOTE: Body request filters always receive the request body in one pass
my $post_filter = HTTP::Proxy::BodyFilter::simple->new(
begin => sub { $_[0]->{binary} = 0; },
filter => sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
print STDOUT "\n", $message->method, " ", $message->uri, "\n";
print_headers( $message, @clt_hdr );
if ( $self->{binary} || $$dataref =~ /\0/ ) {
$self->{binary} = 1;
print STDOUT " (not printing binary data)\n";
return;
}
# this is from CGI.pm, method parse_params()
my (@pairs) = split( /[&;]/, $$dataref );
for (@pairs) {
my ( $param, $value ) = split( '=', $_, 2 );
$param = unescape($param);
$value = unescape($value);
printf STDOUT " %-20s => %s\n", $param, $value;
}
}
);
my $get_filter = HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $message ) = @_;
my $req = $message->request;
if ( $req->method ne 'POST' ) {
print STDOUT "\n", $req->method, " ", $req->uri, "\n";
print_headers( $req, @clt_hdr );
}
print STDOUT $message->status_line, "\n";
print_headers( $message, @srv_hdr );
}
);
sub print_headers {
my $message = shift;
for my $h (@_) {
if ( $message->header($h) ) {
print STDOUT " $h: $_\n" for ( $message->header($h) );
}
}
}
# create and start the proxy
my $proxy = HTTP::Proxy->new(@ARGV);
# if we want to look at SOME sites
if (@{$args{peek}}) {
for (@{$args{peek}}) {
$proxy->push_filter(
host => $_,
method => 'POST',
request => $post_filter
);
$proxy->push_filter(
host => $_,
response => $get_filter,
mime => $args{mime},
);
}
}
# otherwise, peek at all sites
else {
$proxy->push_filter(
method => 'POST',
request => $post_filter
);
$proxy->push_filter( response => $get_filter, mime => $args{mime} );
}
$proxy->start;
HTTP-Proxy-0.304/eg/rainbow.pl 0000755 0001750 0001750 00000004155 12537671053 014476 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::htmltext;
use strict;
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new, # protect tags
response => HTTP::Proxy::BodyFilter::simple->new( # rainbow entities
sub { ${ $_[1] } =~ s/(&[#\w]+;)/rainbow($1)/eg; }
),
response => HTTP::Proxy::BodyFilter::htmltext->new( # rainbow text
sub { s/(\S)/rainbow($1)/eg; }
)
);
sub rainbow {
return sprintf qq{%s}, next_color(), shift;
}
# the following code courtesy David 'grinder' Landgren
# but adapted for our needs
use constant PI_2 => 3.14159265359 * 2;
my @PRIMES = qw/11 13 17 19 23 29 31 37 41 43 47 53 59/;
my $red = rand() * PI_2;
my $green = rand() * PI_2;
my $blue = rand() * PI_2;
my $rdelta = PI_2 / $PRIMES[ rand scalar @PRIMES ];
my $gdelta = PI_2 / $PRIMES[ rand scalar @PRIMES ];
my $bdelta = PI_2 / $PRIMES[ rand scalar @PRIMES ];
my ( $rp, $gp, $bp ) = ( sin $red, sin $green, sin $blue );
my ( $rq, $gq, $bq ) = qw/ 0 0 0/;
my ( $rr, $gr, $br ) = qw/ 0 0 0/;
$proxy->start;
sub next_color {
my $rs = sin( $red += $rdelta );
my $rc = $rs * 120 + 120;
my $gs = sin( $green += $gdelta );
my $gc = $gs * 120 + 120;
my $bs = sin( $blue += $bdelta );
my $bc = $bs * 120 + 120;
$rq = $rp <=> $rs;
$gq = $gp <=> $gs;
$bq = $bp <=> $bs;
$rp = $rs;
$gp = $gs;
$bp = $bs;
$rdelta = PI_2 / $PRIMES[ rand scalar @PRIMES ]
if ( $rr == 1 and $rq < 1 and $rs < 1 );
$gdelta = PI_2 / $PRIMES[ rand scalar @PRIMES ]
if ( $gr == 1 and $gq < 1 and $gs < 1 );
$bdelta = PI_2 / $PRIMES[ rand scalar @PRIMES ]
if ( $br == 1 and $bq < 1 and $bs < 1 );
$rr = $rq;
$gr = $gq;
$br = $bq;
$rc = ( $rc < 0 ) ? 0 : ( $rc > 255 ) ? 255 : $rc;
$gc = ( $gc < 0 ) ? 0 : ( $gc > 255 ) ? 255 : $gc;
$bc = ( $bc < 0 ) ? 0 : ( $bc > 255 ) ? 255 : $bc;
return sprintf( "#%02x%02x%02x", $rc, $gc, $bc );
}
HTTP-Proxy-0.304/eg/flv.pl 0000755 0001750 0001750 00000002112 12537671053 013613 0 ustar book book #!/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;
HTTP-Proxy-0.304/eg/https.pl 0000511 0001750 0001750 00000005023 12537671053 014160 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use HTTP::Proxy::BodyFilter::htmlparser;
use HTTP::Proxy::BodyFilter::htmltext;
use HTML::Parser;
use strict;
# where to find URI in tag attributes
# (it actually a little more complicated, since some tags can have
# several attributes that require an URI)
my %links = (
a => 'href',
area => 'href',
base => 'href',
link => 'href',
frame => 'src',
iframe => 'src',
img => 'src',
input => 'src',
script => 'src',
form => 'action',
body => 'background',
);
my $re_tags = join '|', sort keys %links;
my $hrefparser = HTML::Parser->new( api_version => 3 );
# turn all https:// links to http://this_is_ssl links
$hrefparser->handler(
start => sub {
my ( $self, $tag, $attr, $attrseq, $text ) = @_;
if ( $tag =~ /^($re_tags)$/o
&& exists $attr->{$links{$1}}
&& substr( $attr->{$links{$1}}, 0, 8 ) eq "https://" )
{
$attr->{$links{$1}} =~ s!^https://!http://this_is_ssl.!;
$text = "<$tag "
. join( ' ', map { qq($_="$attr->{$_}") } @$attrseq ) . ">";
}
$self->{output} .= $text;
},
"self,tagname,attr,attrseq,text"
);
# by default copy everything
$hrefparser->handler(
default => sub {
my ( $self, $text ) = @_;
$self->{output} .= $text;
},
"self,text"
);
# the proxy itself
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter(
mime => 'text/html',
response =>
HTTP::Proxy::BodyFilter::htmlparser->new( $hrefparser, rw => 1 ),
);
# detect https requests
$proxy->push_filter(
request => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $message ) = @_;
# find out the actual https site
my $uri = $message->uri;
if ( $uri =~ m!^http://this_is_ssl\.! ) {
$uri->scheme("https");
my $host = $uri->host;
$host =~ s!^this_is_ssl\.!!;
$uri->host($host);
}
}
),
response => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $message ) = @_;
# modify Location: headers in the response
my $location = $headers->header( 'Location' );
if( $location =~ m!^https://! ) {
$location =~ s!^https://!http://this_is_ssl.!;
$headers->header( Location => $location );
}
}
),
);
$proxy->start;
HTTP-Proxy-0.304/eg/perlmonks.pl 0000755 0001750 0001750 00000001745 12537671053 015051 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::HeaderFilter::simple;
use strict;
# a very simple proxy
my $proxy = HTTP::Proxy->new(@ARGV);
# this filter redirects all requests to perlmonks.org
my $filter = HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $message ) = @_;
# modify the host part of the request
$self->proxy()->log( ERROR, "FOO", $message->uri() );
$message->uri()->host('perlmonks.org');
# create a new redirect response
my $res = HTTP::Response->new(
301,
'Moved to perlmonks.org',
[ Location => $message->uri() ]
);
# and make the proxy send it back to the client
$self->proxy()->response($res);
}
);
# put this filter on perlmonks.com and www.perlmonks.org
$proxy->push_filter( host => 'perlmonks.com', request => $filter );
$proxy->push_filter( host => 'www.perlmonks.org', request => $filter );
$proxy->start();
HTTP-Proxy-0.304/eg/switch.pl 0000755 0001750 0001750 00000000700 12537671053 014326 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
# call this proxy as
# eg/switch.pl proxy http://proxy1:port/,http://proxy2:port/
my %args = @ARGV;
my @proxy = split/,/, $args{proxy};
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter(
request => HTTP::Proxy::HeaderFilter::simple->new(
sub {
shift->proxy->agent->proxy( http => $proxy[ rand @proxy ] );
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/anonymiser.pl 0000755 0001750 0001750 00000001061 12537671053 015212 0 ustar book book #!/usr/bin/perl -w
# yeah, I know, I write UK English ;-)
use HTTP::Proxy qw( :log );
use HTTP::Proxy::HeaderFilter::simple;
use strict;
# a very simple proxy
my $proxy = HTTP::Proxy->new( @ARGV );
# the anonymising filter
$proxy->push_filter(
mime => undef,
request => HTTP::Proxy::HeaderFilter::simple->new(
sub { $_[1]->remove_header(qw( User-Agent From Referer Cookie Cookie2 )) }
),
response => HTTP::Proxy::HeaderFilter::simple->new(
sub { $_[1]->remove_header(qw( Set-Cookie Set-Cookie2 )) }
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/yahoogroups.pl 0000755 0001750 0001750 00000003045 12537671053 015411 0 ustar book book #!/usr/bin/perl -w
use strict;
use HTTP::Proxy qw( :log );
use HTTP::Proxy::HeaderFilter::simple;
use CGI::Util qw( unescape );
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter(
host => 'groups.yahoo.com',
response => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $message ) = @_;
my $location;
# ads start by redirecting to 'interrupt'
return
unless ( $location = $headers->header('Location') )
&& $location =~ m!/interrupt\?!;
# fetch the ad page (we need the cookie)
# use a new request to avoid modifying the original one
$self->proxy->log( FILTERS, "YAHOOGROUPS",
"Ad interrupt detected: fetching $location" );
my $r = $self->proxy->agent->simple_request(
HTTP::Request->new(
GET => $location,
$message->request->headers # headers are cloned
)
);
# redirect to our original destination
# which was stored in the 'done' parameter
# and pass the cookie along
$location = unescape($location);
$location =~ s|^(http://[^/]*).*done=([^&]*).*$|$1$2|;
$headers->header( Location => $location );
$headers->header( Set_Cookie => $r->header('Set_Cookie') );
$self->proxy->log( FILTERS, "YAHOOGROUPS",
"Set-Cookie: " . $r->header('Set_Cookie') );
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/pdf.pl 0000755 0001750 0001750 00000002660 12537671053 013605 0 ustar book book #!/usr/bin/perl
#
# Saves all PDF files, and just confirm saving to the client
# (the PDF file never arrives to the client, but is replaced by
# a simple HTML file)
#
# Based on a request by Emmanuel Di Prétoro
#
use strict;
use warnings;
use HTTP::Proxy qw ( :log );
use HTTP::Proxy::BodyFilter::save;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::HeaderFilter::simple;
my $proxy = HTTP::Proxy->new( @ARGV );
my $saved;
$proxy->push_filter(
# you should probably restrict this to certain hosts as well
path => qr/\.pdf$/,
mime => 'application/pdf',
# save the PDF
response => HTTP::Proxy::BodyFilter::save->new(
template => "%f",
prefix => 'pdf'
),
# send a HTML message instead
response => HTTP::Proxy::BodyFilter::simple->new(
begin => sub {
my ( $self, $message ) = @_; # for information, saorge
$saved = 0;
},
filter => sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
$$dataref = $saved++ ? ""
: sprintf 'Saving PDF file. Go back
',
$message->request->header('referer');
}
),
# change the response Content-Type
response => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $response ) = @_;
$headers->content_type('text/html');
}
),
);
$proxy->start;
HTTP-Proxy-0.304/eg/trim.pl 0000755 0001750 0001750 00000001050 12537671053 013777 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::lines;
use HTTP::Proxy::BodyFilter::simple;
use strict;
my $proxy = HTTP::Proxy->new(@ARGV);
# a simple proxy that trims whitespace in HTML
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::lines->new(),
response => HTTP::Proxy::BodyFilter::simple->new(
sub {
my ($self, $dataref ) = @_;
$$dataref =~ s/^\s+//m; # multi-line data
$$dataref =~ s/\s+$//m;
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/javascript.pl 0000755 0001750 0001750 00000001645 12537671053 015204 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy;
use HTML::Parser;
use HTTP::Proxy::BodyFilter::htmlparser;
# define the filter (the most difficult part)
# filters not using HTML::Parser are much simpler :-)
my $parser = HTML::Parser->new( api_version => 3 );
$parser->handler(
start => sub {
my ( $self, $tag, $text ) = @_;
$self->{output} .= $text;
$self->{output} .= "YOUR JAVASCRIPT HERE" if $tag eq 'body';
},
"self,tagname,text"
);
$parser->handler(
default => sub {
my ($self, $text) = @_;
$self->{output} .= $text;
},
"self,text"
);
# this is a read-write filter (rw => 1)
# that is the reason why we had to copy everything into $self->{output}
my $filter = HTTP::Proxy::BodyFilter::htmlparser->new( $parser, rw => 1 );
# create and launch the proxy
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter( response => $filter, mime => 'text/html' );
$proxy->start();
HTTP-Proxy-0.304/eg/fudd.pl 0000755 0001750 0001750 00000000663 12537671053 013757 0 ustar book book #!/usr/bin/perl -w
# based on Google's Elmer Fudd preference setting
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::htmltext;
use strict;
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new,
response => HTTP::Proxy::BodyFilter::htmltext->new(
sub { y/r/w/; s/l(?=\w)/w/g }
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/README 0000644 0001750 0001750 00000010015 12537671053 013345 0 ustar book book The eg/ directory holds a few example proxies.
All scripts accept HTTP::Proxy constructor key/value pairs on the
command-line. Example: ./proxy.pl port 3128 host 0.0.0.0
* proxy.pl
A very simple proxy.
Filter: none
* anonymiser.pl
A simple anonymizing proxy, similar in functionnality to the one
shown by Randal L. Schwartz in his WebTechniques #11 column.
http://www.stonehenge.com/merlyn/WebTechniques/col11.html
Filter: HTTP::Proxy::HeaderFilter::simple
* proxy-auth.pl
A very simple proxy, with Basic authentication.
Filter: HTTP::Proxy::HeaderFilter::simple
* leet.pl
* rot13.pl
* rainbow.pl
* fudd.pl
These filters do simple modifications of all HTML pages.
Filters: HTTP::Proxy::BodyFilter::tags
HTTP::Proxy::BodyFilter::simple
HTTP::Proxy::BodyFilter::htmltext
* bork.pl
This ffiltir elsu duis simpli mudiffixeshuns uff ell HTML pegis.
Bork bork bork !
* outline.pl
* ayb.pl
These proxy do more complicated modifications of HTML pages, and
require a HTML::Parser object to do so. All you tag are belong to us.
Filter: HTTP::Proxy::BodyFilter::htmlparser
* post.pl
This filter outputs the request URI and the form parameters of
all POST requests.
Filter: HTTP::Proxy::HeaderFilter::simple
* logger.pl
This filter outputs the important information out of GET and POST
requests: method, URI, cookies, content-type (text/*) and POST
request parameters.
Filter: HTTP::Proxy::HeaderFilter::simple
* adblock.pl
This is a very simple proxy that block ad sites.
Filters: HTTP::Proxy::HeaderFilter::simple
HTTP::Proxy::BodyFilter::simple
* trim.pl
A simple proxy that trims lines of HTML text.
Filters: HTTP::Proxy::BodyFilter::lines
HTTP::Proxy::BodyFilter::simple
* javascript.pl
A proxy that adds anything/javascript at the beginning of a HTML page.
(right after the tag)
Filter: HTTP::Proxy::BodyFilter::htmlparser
* rfc.pl
A proxy that automatically saves the files named rfc\d+\.txt to
a file of the same name in the rfc/ directory.
Filter: HTTP::Proxy::BodyFilter::save
* dragon.pl
A proxy that removes some of the shortcomings of the Dragon Go
Server website (http://www.dragongoserver.net/)
Filters: HTTP::Proxy::HeaderFilter::simple
HTTP::Proxy::BodyFilter::simple
HTTP::Proxy::BodyFilter::tags
* pdf.pl
Save all PDF files in the pdf/ directory, and replace it with a
HTML message saying "PDF file saved."
Filters: HTTP::Proxy::HeaderFilter::simple
HTTP::Proxy::Body::simple
HTTP::Proxy::Body::save
* yahoogroups.pl
Removes the advertisment interruptions from Yahoo! Groups
Filter: HTTP::Proxy::HeaderFilter::simple
* https.pl
Modify https:// links to http:// links that the proxy will
recognise. The proxy will download the pages using SSL and
will then be able to modify them with its filter stacks.
Filters: HTTP::Proxy::HeaderFilter::simple
HTTP::Proxy::BodyFilter::htmlparser
* perlmonks.pl
Redirect all requests to perlmonks.com and perlmonks.org
to perlmonks.org, thus keeping connection information intact
(all cookies will point to a single web site).
This code was used as a starting point for the "Rewrite the web"
hack in Perl Hacks (O'Reilly 2006).
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
HTTP-Proxy-0.304/eg/bork.pl 0000755 0001750 0001750 00000004256 12537671053 013774 0 ustar book book #!/usr/bin/perl -w
# script kindly offered by glb (Eric Cassagnard)
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::htmltext;
use strict;
my $proxy = HTTP::Proxy->new(@ARGV);
my %noaccent = (
Agrave => 'A', Aacute => 'A', Acirc => 'A', Atilde => 'A',
Auml => 'A', Aring => 'A', AElig => 'AE', Ccedil => 'C',
Egrave => 'E', Eacute => 'E', Ecirc => 'E', Euml => 'E',
Igrave => 'I', Iacute => 'I', Icirc => 'I', Iuml => 'I',
Ntilde => 'N', Ograve => 'O', Oacute => 'O', Ocirc => 'O',
Otile => 'O', Ouml => 'O', Oslash => 'O', Ugrave => 'U',
Uacute => 'U', Ucirc => 'U', Uuml => 'U', Yacute => 'Y',
agrave => 'a', aacute => 'a', acirc => 'a', atilde => 'a',
auml => 'a', aring => 'a', aelig => 'ae', ccedil => 'c',
egrave => 'e', eacute => 'e', ecirc => 'e', euml => 'e',
igrave => 'i', iacute => 'i', icirc => 'i', iuml => 'i',
ntilde => 'n', ograve => 'o', oacute => 'o', ocirc => 'o',
otile => 'o', ouml => 'o', oslash => 'o', ugrave => 'u',
uacute => 'u', ucirc => 'u', uuml => 'u', yacute => 'y',
'yuml' => 'y', 'Æ' => 'AE', 'æ' => 'ae',
);
my $re = join '|', sort keys %noaccent;
my %sounds = (
an => 'un', An => 'Un', au => 'oo', Au => 'Oo', a => 'e',
A => 'E', ew => 'oo', e => 'e-a', e => 'i', E => 'I',
f => 'ff', ir => 'ur', ow => 'oo', o => 'oo', O => 'Oo',
o => 'u', the => 'zee', The => 'Zee', th => 't', tion => 'shun',
u => 'oo', U => 'Oo', v => 'f', V => 'F', w => 'v',
W => 'V' );
my $sc = join '|', sort keys %sounds;
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new,
response => HTTP::Proxy::BodyFilter::simple->new(
sub { ${ $_[ 1 ] } =~ s/&($re);/$noaccent{$1}/go; }
),
response => HTTP::Proxy::BodyFilter::htmltext->new(
sub {
tr{ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöøùúûüýÿ}
{AAAAAACEEEEIIIINOOOOOOUUUUYaaaaaaceeeeiiiinoooooouuuuyy};
s/($sc)/$sounds{$1}/go;
s/([?!]+)/$1 Bork bork bork !/go ;
s/(\.+)(\s|$)/$1 Bork bork bork ! /go ;
}
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/post.pl 0000755 0001750 0001750 00000001524 12537671053 014017 0 ustar book book #!/usr/bin/perl -w
use strict;
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::simple;
use CGI::Util qw( unescape );
# NOTE: Body request filters always receive the request body in one pass
my $filter = HTTP::Proxy::BodyFilter::simple->new(
sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
print STDOUT $message->method, " ", $message->uri, "\n";
# this is from CGI.pm, method parse_params
my (@pairs) = split ( /[&;]/, $$dataref );
for (@pairs) {
my ( $param, $value ) = split ( '=', $_, 2 );
$param = unescape($param);
$value = unescape($value);
printf STDOUT " %-30s => %s\n", $param, $value;
}
}
);
my $proxy = HTTP::Proxy->new(@ARGV);
$proxy->push_filter( method => 'POST', request => $filter );
$proxy->start;
HTTP-Proxy-0.304/eg/rfc.pl 0000755 0001750 0001750 00000000573 12537671053 013607 0 ustar book book use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::save;
my $proxy = HTTP::Proxy->new(@ARGV);
# save RFC files as we browse them
$proxy->push_filter(
path => qr!/rfc\d+.txt!,
mime => 'text/plain',
response => HTTP::Proxy::BodyFilter::save->new(
template => '%f',
prefix => 'rfc',
multiple => 0,
keep_old => 1,
)
);
$proxy->start;
HTTP-Proxy-0.304/eg/ayb.pl 0000755 0001750 0001750 00000003531 12537671053 013605 0 ustar book book #!/usr/bin/perl -w
use HTTP::Proxy qw( :log );
use HTTP::Proxy::BodyFilter::htmlparser;
use HTML::Parser;
use strict;
# the proxy
my $proxy = HTTP::Proxy->new( @ARGV );
# all your base...
my @ayb = grep { !/^$/ } split/$/m, << 'AYB';
In A.D. 2101
War was beginning.
What happen ?
Somebody set up us the bomb.
We get signal.
What !
Main screen turn on.
It's You !!
How are you gentlemen !!
All your base are belong to us.
You are on the way to destruction.
What you say !!
You have no chance to survive make your time.
HA HA HA HA ....
Take off every 'zig' !!
You know what you doing.
Move 'zig'.
For great justice.
AYB
# the AYB parser
# replaces heading content with the AYB text
my $parser = HTML::Parser->new( api_version => 3 );
$parser->handler(
start_document => sub {
my $self = shift;
$self->{ayb} = 0;
$self->{i} = int rand @ayb;
},
"self"
);
$parser->handler(
start => sub {
my ( $self, $tag, $attr, $text ) = @_;
$self->{ayb} = 1 if $tag =~ /^h\d/;
if( $tag eq 'img' ) {
$attr->{src} = 'http://home.uchicago.edu/~obmontoy/cats.jpg';
$text = "<$tag "
. join(' ', map { qq($_="$attr->{$_}") } keys %$attr )
. ">";
}
$self->{output} .= $text;
},
"self,tagname,attr,text"
);
$parser->handler(
end => sub {
my ( $self, $tag, $text ) = @_;
if( $tag =~ /^h\d/ ) {
$self->{ayb} = 0;
}
$self->{output} .= $text;
},
"self,tagname,text"
);
$parser->handler(
default => sub {
my ( $self, $text ) = @_;
$self->{output} .= $self->{ayb} ? $ayb[($self->{i} += 1 ) %= @ayb] : $text;
},
"self,text"
);
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::htmlparser->new( $parser, rw => 1 ),
);
$proxy->start;
HTTP-Proxy-0.304/t/ 0000755 0001750 0001750 00000000000 12537671053 012340 5 ustar book book HTTP-Proxy-0.304/t/61simple2.t 0000644 0001750 0001750 00000003632 12537671053 014253 0 ustar book book use Test::More tests => 4;
use strict;
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::simple;
use t::Utils;
# test configuration
my $test = Test::Builder->new;
$test->use_numbers(0);
$test->no_ending(1);
# create the filter
my $sub = sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
$$dataref =~ s/test/foo/g;
};
my $filter = HTTP::Proxy::BodyFilter::simple->new($sub);
# create the proxy
my $proxy = HTTP::Proxy->new(
port => 0,
max_clients => 0,
max_keep_alive_requests => 1,
max_connections => 1,
);
$proxy->init;
$proxy->agent->protocols_allowed(undef);
$proxy->push_filter( response => $filter, scheme => 'file', mime => 'text/*' );
my $url = $proxy->url;
# fork the proxy
my @pids;
{
$^W = 0; # warning due to the absence of a host in the file URL
push @pids, fork_proxy($proxy);
}
# check that the correct transformation is applied
my $ua = LWP::UserAgent->new();
$ua->proxy( file => $url );
my $response = $ua->request( HTTP::Request->new( GET => 'file:t/test.html' ) );
my $file;
{
local $/ = undef;
open F, "t/test.html" or diag "Unable to open t/test.html";
$file = ;
close F;
}
$file =~ s/test/foo/g;
is( $response->content, $file, "The proxy applied the transformation" );
# push another filter
$sub = sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
$$dataref =~ s/Test/Bar/g;
};
$filter = HTTP::Proxy::BodyFilter::simple->new(
filter => $sub,
begin => sub { ok( 1, "begin() called" ) },
end => sub { ok( 1, "end() called" ) },
);
$proxy->push_filter( response => $filter, scheme => 'file', mime => 'text/*' );
# fork the modified proxy
push @pids, fork_proxy($proxy);
$response = $ua->request( HTTP::Request->new( GET => 'file:t/test.html' ) );
$file =~ s/Test/Bar/g;
is( $response->content, $file, "The proxy applied two transformations" );
# wait for kids
wait for @pids;
HTTP-Proxy-0.304/t/90httpstatus.t 0000644 0001750 0001750 00000002627 12537671053 015130 0 ustar book book # good place for web client tests:
# http://diveintomark.org/tests/client/http/
use strict;
my @url;
my $tests;
BEGIN {
@url = (
map ( [ "$_" => 0 + $_ ], 200 .. 206, 300, 304, 306 ),
map ( [ "$_" => 0 + $_, 200 ], 301 .. 303, 305, 307 ),
map ( [ "$_" => 0 + $_ ], 400 .. 418, 500 .. 505 ),
);
$tests += @$_ - 1 for @url;
}
use Test::More;
use HTTP::Proxy;
use HTTP::Request::Common;
use t::Utils;
my $base = 'http://httpstat.us';
plan tests => $tests;
SKIP:
{
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,
max_connections => 1,
);
$proxy->init;
my $ua = LWP::UserAgent->new( keep_alive => 1 );
$ua->proxy( http => $proxy->url );
# fork the proxy
my $pid = fork_proxy($proxy);
# check all those pages
for (@url) {
my ( $doc, $status, $status2 ) = @$_;
my $res = $ua->simple_request( GET "$base/$doc" );
is( $res->code, $status, "$doc => $status " . $res->message );
# redirection
if ( $res->is_redirect && $status2 ) {
$res = $ua->simple_request( GET $res->header('Location') );
is( $res->code, $status2, "$doc => $status2 (redirect)" );
}
}
# wait for the proxy
wait;
}
HTTP-Proxy-0.304/t/67save.t 0000644 0001750 0001750 00000014730 12537671053 013645 0 ustar book book use strict;
use warnings;
use Test::More;
use HTTP::Proxy::BodyFilter::save;
use File::Temp qw( tempdir );
use File::Spec::Functions;
# 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' =>
catfile( $dir, qw(bam.fr zok awk.html) )
],
[ [ @d, multiple => 0 ],
'http://bam.fr/zok/awk.html' =>
catfile( $dir, qw(bam.fr zok awk.html) )
],
[ [@d],
'http://bam.fr/zok/awk.html' =>
catfile( $dir, qw(bam.fr zok awk.html.1) )
],
[ [ @d, no_host => 1 ],
'http://bam.fr/zok/awk.html' => catfile( $dir, qw(zok awk.html ) )
],
[ [ @d, no_dirs => 1 ],
'http://bam.fr/zok/awk.html' => catfile( $dir, qw(bam.fr awk.html) )
],
[ [ @d, no_host => 1, no_dirs => 1 ],
'http://bam.fr/zok/awk.html' => catfile( $dir, 'awk.html' )
],
[ [ @d, no_dirs => 1 ],
'http://bam.fr/zok/' => catfile( $dir, qw(bam.fr index.html) )
],
#[ [@d], 'http://bam.fr/zok/' => "$dir/bam.fr/index.html" ],
[ [ template => "$dir/%p" ],
'http://bam.fr/pow/zok.html' => catfile( $dir, qw(pow zok.html) )
],
[ [ template => "$dir/%f" ],
'http://bam.fr/pow/zok.html' => catfile( $dir, 'zok.html' )
],
[ [ template => "$dir/%p" ],
'http://bam.fr/zam.html?q=pow' => catfile( $dir, 'zam.html' )
],
# Win32 does not accept '?' in file names
( [ [ template => "$dir/%P" ],
'http://bam.fr/zam.html?q=pow' =>
catfile( $dir, 'zam.html?q=pow' )
]
) x ( $^O ne 'MSWin32' ),
[ [ @d, cut_dirs => 2 ],
'http://bam.fr/a/b/c/d/e.html' =>
catfile( $dir, qw(bam.fr c d e.html) )
],
[ [ @d, cut_dirs => 2, no_host => 1 ],
'http://bam.fr/a/b/c/d/e.html' => catfile( $dir, qw(c d e.html) )
],
[ [ @d, cut_dirs => 5, no_host => 1 ],
'http://bam.fr/a/b/c/d/e.html' => catfile( $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,
catfile( $dir, qw(bam.fr a.html) )
],
[ [@d], 'http://bam.fr/b.html' => 404, undef ],
[ [ @d, status => [ 200, 404 ] ],
'http://bam.fr/c.html' => 404,
catfile( $dir, qw(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 ? catfile( $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" );
}
}
HTTP-Proxy-0.304/t/test.html 0000644 0001750 0001750 00000000502 12537671053 014202 0 ustar book book
This is an HTML test file
Test title
Test sub-title
This is a test paragraph,
with bold and emphasised
text.
Another test
# some source code
$a++
HTTP-Proxy-0.304/t/51simple.t 0000644 0001750 0001750 00000001550 12537671053 014165 0 ustar book book use Test::More tests => 3;
use strict;
use HTTP::Proxy::HeaderFilter::simple;
use HTTP::Headers;
my ( $filter, $sub, $h );
# error checking
eval { $filter = HTTP::Proxy::HeaderFilter::simple->new() };
like( $@, qr/^Constructor called without argument/, "Need at least one arg" );
eval { $filter = HTTP::Proxy::HeaderFilter::simple->new('foo') };
like( $@, qr/^Single parameter must be a CODE /, "Must pass a coderef" );
$sub = sub {
my ( $self, $headers, $message ) = @_;
$headers->header( User_Agent => 'Foo/1.0' );
};
$filter = HTTP::Proxy::HeaderFilter::simple->new($sub);
# test the filter
$h = HTTP::Headers->new(
Date => 'Thu, 03 Feb 1994 00:00:00 GMT',
Content_Type => 'text/html; version=3.2',
Content_Base => 'http://www.perl.org/'
);
$filter->filter( $h, undef );
is( $h->header('User-Agent'), 'Foo/1.0', "Header modified" );
HTTP-Proxy-0.304/t/11log.t 0000644 0001750 0001750 00000002151 12537671053 013447 0 ustar book book use Test::More;
use HTTP::Proxy qw(:log);
use strict;
my %mask = (
CONNECT => CONNECT,
DATA => DATA,
ENGINE => ENGINE,
ERROR => ERROR,
FILTERS => FILTERS,
HEADERS => HEADERS,
PROCESS => PROCESS,
PROXY => PROXY,
SOCKET => SOCKET,
STATUS => STATUS,
);
# try all combinations
my @tests = (
[ NONE, qw( ERROR ) ],
[ PROXY, qw( ERROR PROXY ) ],
[ STATUS | SOCKET, qw( ERROR SOCKET STATUS ) ],
[ DATA | STATUS | SOCKET, qw( DATA ERROR SOCKET STATUS ) ],
[ ALL, qw( CONNECT DATA ENGINE ERROR FILTERS
HEADERS PROCESS PROXY SOCKET STATUS )
],
);
my $t;
$t += @$_ - 1 for @tests;
plan tests => $t;
# communicate with a pipe
pipe my ( $rh, $wh );
select( ( select($wh), $| = 1 )[0] );
# the proxy logs error to the pipe
my $proxy = HTTP::Proxy->new( logfh => $wh );
for (@tests) {
my ( $mask, @msgs ) = @$_;
$proxy->logmask($mask);
$proxy->log( $mask{$_}, 'TEST', $_ ) for sort keys %mask;
like( <$rh>, qr/TEST: $_$/, "mask $mask: $_ message" ) for @msgs;
}
close $wh;
print for <$rh>;
HTTP-Proxy-0.304/t/22http.t 0000644 0001750 0001750 00000003740 12537671053 013654 0 ustar book book use strict;
use vars qw( @requests );
use Socket;
# here are all the requests the client will try
BEGIN {
@requests = (
# 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/', '5..', 1 ],
);
}
use Test::More tests => @requests + 1;
use t::Utils;
use LWP::UserAgent;
use HTTP::Proxy;
# we skip the tests if the network is not available
SKIP: {
skip "Web does not seem to work", @requests + 1 unless web_ok();
my $test = Test::Builder->new;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
my $proxy = HTTP::Proxy->new(
port => 0,
max_connections => scalar @requests,
);
$proxy->init; # required to access the url later
# fork a HTTP proxy
my $pid = fork_proxy(
$proxy,
sub {
ok( $proxy->conn == @requests,
"Served the correct number of requests" );
}
);
# run a client
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );
for (@requests) {
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);
like(
$rep->code, qr/^$code$/, "Got an answer (@{[$rep->code]})"
);
}
}
}
# make sure the kid is dead
wait;
}
HTTP-Proxy-0.304/t/40push_filters.t 0000644 0001750 0001750 00000003633 12537671053 015405 0 ustar book book use strict;
use Test::More tests => 11;
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter;
use HTTP::Proxy::HeaderFilter;
# test the basic filter methods
my $proxy = HTTP::Proxy->new( port => 0 );
# test the errors
eval { $proxy->push_filter( 1 ); };
like( $@, qr/^Odd number of arguments/, "Bad number of parameter" );
eval { $proxy->push_filter( response => 1 ); };
like( $@, qr/^Not a Filter reference for filter queue/, "Bad parameter" );
eval { $proxy->push_filter( typo => sub { } ); };
like( $@, qr/^'typo' is not a filter stack/, "Unknown filter stack" );
eval { $proxy->push_filter( mime => 'text', response => sub { } ); };
like( $@, qr/^Invalid MIME/, "Bad MIME type" );
eval { $proxy->push_filter( method => 'FOO', response => sub { } ); };
like( $@, qr/^Invalid method: FOO/, "Invalid method: " );
eval { $proxy->push_filter( scheme => 'rstp', response => sub { } ); };
like( $@, qr/^Unsupported scheme/, "Unsupported scheme" );
# test correct working
my $filter = HTTP::Proxy::HeaderFilter->new;
eval { $proxy->push_filter( response => $filter ); };
is( $@, '', "Accept a HeaderFilter");
{
package Foo;
use base qw( HTTP::Proxy::HeaderFilter );
}
$filter = Foo->new;
eval { $proxy->push_filter( response => $filter ); };
is( $@, '', "Accept an object derived from HeaderFilter");
# test multiple match criteria
eval {
$proxy->push_filter(
response => $filter,
mime => 'text/*',
scheme => 'http',
method => 'GET'
);
};
is( $@, "", "Support several match criteria" );
# test pushing multiple filters at once
# this test breaks encapsulation
$proxy = HTTP::Proxy->new( port => 0 );
$filter = HTTP::Proxy::BodyFilter->new;
my $filter2 = HTTP::Proxy::BodyFilter->new;
$proxy->push_filter( response => $filter, response => $filter2 );
is( $proxy->{body}{response}{filters}[0][1], $filter, "First filter");
is( $proxy->{body}{response}{filters}[1][1], $filter2, "Second filter");
HTTP-Proxy-0.304/t/Utils.pm 0000644 0001750 0001750 00000006452 12537671053 014005 0 ustar book book package t::Utils;
use strict;
use Exporter ();
use IO::Socket::INET;
use vars qw( @ISA @EXPORT @EXPORT_OK );
@ISA = qw( Exporter );
@EXPORT = qw( &server_start &server_next &fork_proxy &web_ok &bare_request );
@EXPORT_OK = @EXPORT;
use HTTP::Daemon;
use LWP::UserAgent;
# start a simple server
sub server_start {
# create a HTTP::Daemon (on an available port)
my $daemon = HTTP::Daemon->new(
LocalHost => 'localhost',
ReuseAddr => 1,
)
or die "Unable to start web server";
return $daemon;
}
# This must NOT be called in an OO fashion but this way:
# server_next( $server, $coderef, ... );
#
# The optional coderef takes a HTTP::Request as its first argument
# and returns a HTTP::Response. The rest of server_next() arguments
# are passed to &$anwser;
sub server_next {
my $daemon = shift;
my $answer = shift;
# get connection data
my $conn = $daemon->accept;
my $req = $conn->get_request;
# compute some answer
my $rep;
if ( ref $answer eq 'CODE' ) {
$rep = $answer->( $req, @_ );
}
else {
$rep = HTTP::Response->new(
200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
sprintf( "You asked for %s", ( $req->uri ) x 2 )
);
}
$conn->send_response($rep);
$conn->close;
}
# run a stand-alone proxy
# the proxy accepts an optional coderef to run after serving all requests
sub fork_proxy {
my $proxy = shift;
my $sub = shift;
my $pid = fork;
die "Unable to fork proxy" if not defined $pid;
if ( $pid == 0 ) {
$0 .= " (proxy)";
# this is the http proxy
$proxy->start;
$sub->() if ( defined $sub and ref $sub eq 'CODE' );
exit 0;
}
# back to the parent
return $pid;
}
# check that the web connection is working
sub web_ok {
my $ua = LWP::UserAgent->new( env_proxy => 1, timeout => 30 );
my $res =
$ua->request(
HTTP::Request->new( GET => shift||'http://www.google.com/intl/en/' ) );
return $res->is_success;
}
# send a simple request without LWP::UA
# bare_request($url, $headers, $proxy)
sub bare_request {
my ($url, $headers, $proxy) = @_;
# connect directly to the proxy
$proxy->url() =~ /:(\d+)/;
my $sock = IO::Socket::INET->new(
PeerAddr => 'localhost',
PeerPort => $1,
Proto => 'tcp'
) or do { warn "Can't connect to the proxy"; return ""; };
# send the request
print $sock "GET $url HTTP/1.0\015\012",
$headers->as_string( "\015\012" ), "\015\012";
my $content = join "", <$sock>;
# close the connection to the proxy
close $sock or warn "close: $!";
return $content;
}
package HTTP::Proxy;
# return the requested internal filter stack
# _filter_stack( body|header, request|response, HTTP::Message )
sub _filter_stack {
my ( $self, $part, $mesg ) = splice( @_, 0, 3 );
die "No <$part><$mesg> filter stack"
unless $part =~ /^(?:header|body)$/
and $mesg =~ /^(?:request|response)$/;
for (@_) {
die "$_ is not a HTTP::Request or HTTP::Response"
unless ( ref $_ ) =~ /^HTTP::(Request|Response)$/;
$self->{ lc $1 } = $_;
}
$self->{response}->request( $self->{request} );
return $self->{$part}{$mesg};
}
HTTP-Proxy-0.304/t/23https.t 0000644 0001750 0001750 00000004573 12537671053 014045 0 ustar book book use Test::More skip_all => "Can't make this work with Crypt::SSLeay";
use strict;
use t::Utils;
use HTTP::Proxy;
use LWP::UserAgent;
# test CONNECT
my $test = Test::Builder->new;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
SKIP: {
eval "require Crypt::SSLeay;"
skip "Crypt::SSLeay not installed", 1 if $@;
my $proxy = HTTP::Proxy->new( port => 0, maxconn => 1, logmask => 63 );
# Excerpts from the Crypt::SSLeay documentation
# ---------------------------------------------
# LWP::UserAgent and Crypt::SSLeay have their own versions of proxy support.
#
# At the time of this writing, libwww v5.6 seems to proxy https requests
# fine with an Apache mod_proxy server. It sends a line like:
#
# GET https://www.nodeworks.com HTTP/1.1
#
# to the proxy server, which is not the CONNECT request that some
# proxies would expect, so this may not work with other proxy servers
# than mod_proxy. The CONNECT method is used by Crypt::SSLeay's internal
# proxy support.
#
# For native Crypt::SSLeay proxy support of https requests, you need to
# set an environment variable HTTPS_PROXY to your proxy server & port, as in:
#
# # PROXY SUPPORT
# $ENV{HTTPS_PROXY} = 'http://proxy_hostname_or_ip:port';
# $ENV{HTTPS_PROXY} = '127.0.0.1:8080';
#
# Use of the HTTPS_PROXY environment variable in this way is similar to
# LWP::UserAgent->env_proxy() usage, but calling that method will likely
# override or break the Crypt::SSLeay support, so do not mix the two.
#$proxy->agent( LWP::UserAgent->new ); # no env_proxy
$proxy->init; # required to access the url later
# fork a HTTP proxy
my $pid = fork_proxy(
$proxy,
sub {
ok( $proxy->conn == 1,
"Served the correct number of requests" );
}
);
# run a client
my $ua = LWP::UserAgent->new; # no env_proxy
$ENV{HTTPS_PROXY} = $proxy->url; # to be used by Crypt::SSLeay
#$ENV{HTTPS_DEBUG} = 1;
my $req = HTTP::Request->new( GET => "https://www.gandi.net/");
my $res = $ua->request($req);
#print $res->status_line,$/,$res->headers->as_string; #500 ??
# make sure the kid is dead
wait;
}
# tests with lwp-request:
# HTTPS_PROXY=http://localhost:8080/ \
# HTTPS_DEBUG=1 \
# lwp-request -P -des https://www.nodeworks.com/
#
# -P prevents lwp-request to call env_proxy() on its agent,
# so that Crypt::SSLeay can use the HTTPS_PROXY environment variable
HTTP-Proxy-0.304/t/64tags.t 0000644 0001750 0001750 00000002034 12537671053 013634 0 ustar book book use Test::More tests => 14;
use strict;
use HTTP::Proxy::BodyFilter::tags;
my $filter = HTTP::Proxy::BodyFilter::tags->new();
# test the filter
for (
[ 'foo bar', '', 'foo bar', '' ],
[ 'foo', '', 'foo', '' ],
[ '>', '', '>', '' ],
[ '>foo', '', '>foo', '' ],
[ '>foofoo', 'foofoo --> > <>><', '', ' > <>>', '<'],
# the following fails because of the implementation of the tags.pm
# a stronger implementation requires parsing
# [ 'xfilter( \$data, undef, undef,
( defined $buffer ? \$buffer : undef ) );
is( $data, $_->[2], "Correct data" );
is( $buffer, $_->[3], "Correct buffer" );
}
HTTP-Proxy-0.304/t/22transparent.t 0000644 0001750 0001750 00000004077 12537671053 015242 0 ustar book book use strict;
use Test::More;
use t::Utils;
use LWP::UserAgent;
use HTTP::Proxy;
# 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', '/', '5..', 1 ],
);
if ( $^O eq 'MSWin32' ) {
plan skip_all =>
"This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
# we skip the tests if the network is not available
my $web_ok = web_ok();
plan tests => @requests + 2;
# this is to work around tests in forked processes
my $test = Test::Builder->new;
$test->use_numbers(0);
$test->no_ending(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"
);
}
);
# no Host: header
my $content = bare_request( '/', HTTP::Headers->new(), $proxy );
my ($code) = $content =~ m!^HTTP/\d+\.\d+ (\d\d\d) !g;
is( $code, 400, "Relative URL and no Host: Bad Request" );
SKIP: {
skip "Web does not seem to work", scalar @requests unless $web_ok;
for (@requests) {
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;
like( $code, qr/^$status$/, "Got an answer ($code)" );
}
}
}
}
# make sure the kid is dead
wait;
HTTP-Proxy-0.304/t/16stash.t 0000644 0001750 0001750 00000001474 12537671053 014024 0 ustar book book use strict;
use Test::More tests => 7;
use HTTP::Proxy;
my $proxy;
$proxy = HTTP::Proxy->new;
is_deeply( $proxy->stash, {}, "Empty stash by default" );
$proxy = HTTP::Proxy->new( stash => { clunk => 'slosh', plop => 'biff' } );
is( $proxy->stash('clunk'), 'slosh', "get clunk from stash" );
is( $proxy->stash('plop'), 'biff', "get plop from stash" );
is_deeply(
$proxy->stash,
{ clunk => 'slosh', plop => 'biff' },
"the whole hash"
);
is( $proxy->stash( clunk => 'sock' ), 'sock', "set returns the new value" );
is( $proxy->stash('clunk'), 'sock', "the new value is set" );
my $h = $proxy->stash;
%$h = ( thwack => 'spla_a_t', rip => 'uggh', zowie => 'thwape' );
is_deeply(
$proxy->stash,
{ thwack => 'spla_a_t', rip => 'uggh', zowie => 'thwape' },
"stash() is a reference to the stash itself"
);
HTTP-Proxy-0.304/t/00-report-prereqs.t 0000644 0001750 0001750 00000012731 12537671053 015740 0 ustar book book #!perl
use strict;
use warnings;
# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.021
use Test::More tests => 1;
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
(?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
)
)/x;
# hide optional CPAN::Meta modules from prereq scanner
# and check if they are available
my $cpan_meta = "CPAN::Meta";
my $cpan_meta_pre = "CPAN::Meta::Prereqs";
my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
# Verify requirements?
my $DO_VERIFY_PREREQS = 1;
sub _max {
my $max = shift;
$max = ( $_ > $max ) ? $_ : $max for @_;
return $max;
}
sub _merge_prereqs {
my ($collector, $prereqs) = @_;
# CPAN::Meta::Prereqs object
if (ref $collector eq $cpan_meta_pre) {
return $collector->with_merged_prereqs(
CPAN::Meta::Prereqs->new( $prereqs )
);
}
# Raw hashrefs
for my $phase ( keys %$prereqs ) {
for my $type ( keys %{ $prereqs->{$phase} } ) {
for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
$collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
}
}
}
return $collector;
}
my @include = qw(
);
my @exclude = qw(
);
# Add static prereqs to the included modules list
my $static_prereqs = do 't/00-report-prereqs.dd';
# Merge all prereqs (either with ::Prereqs or a hashref)
my $full_prereqs = _merge_prereqs(
( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
if ( $source && $HAS_CPAN_META ) {
if ( my $meta = eval { CPAN::Meta->load_file($source) } ) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
}
else {
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
}
for my $phase ( qw(configure build test runtime develop other) ) {
next unless $req_hash->{$phase};
next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
for my $type ( qw(requires recommends suggests conflicts modules) ) {
next unless $req_hash->{$phase}{$type};
my $title = ucfirst($phase).' '.ucfirst($type);
my @reports = [qw/Module Want Have/];
for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
next if $mod eq 'perl';
next if grep { $_ eq $mod } @exclude;
my $file = $mod;
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( @dep_errors ) {
diag join("\n",
"\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
"The following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass;
# vim: ts=4 sts=4 sw=4 et:
HTTP-Proxy-0.304/t/50via.t 0000644 0001750 0001750 00000004434 12537671053 013456 0 ustar book book use strict;
use Test::More;
use LWP::UserAgent;
use HTTP::Proxy;
use t::Utils; # some helper functions for the server
if( $^O eq 'MSWin32' ) {
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
plan tests => 4;
my $test = Test::Builder->new;
my @pids;
# this is a rather long test suite just to test that
# $proxy->via() works ok
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
# create a HTTP::Daemon (on an available port)
my $server = server_start();
# create and fork the proxy
# the proxy itself will not fork
my $proxy = HTTP::Proxy->new( port => 0, max_connections => 1, max_clients => 0 );
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
push @pids, fork_proxy($proxy);
# fork the HTTP server
my $pid = fork;
die "Unable to fork web server" if not defined $pid;
if ( $pid == 0 ) {
# the answer method
my $answer1 = sub {
my ( $req, $data ) = @_;
isnt( $req->headers->header('Via'), undef, "Server says Via: header added" );
return HTTP::Response->new(
200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
"Headers checked."
);
};
my $answer2 = sub {
my ( $req, $data ) = @_;
is( $req->headers->header('Via'), undef, "Server says no Via: header added" );
return HTTP::Response->new(
200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
"Headers checked."
);
};
# let's return some files when asked for them
server_next( $server, $answer1 );
server_next( $server, $answer2 );
exit 0;
}
push @pids, $pid;
# run a client
my ( $req, $res );
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );
# send a Proxy-Connection header
$req = HTTP::Request->new( GET => $server->url );
$res = $ua->simple_request($req);
isnt( $res->headers->header('Via'), undef, "Client says Via: header added" );
# create and fork the proxy
$proxy->via('');
push @pids, fork_proxy($proxy);
$res = $ua->simple_request($req);
is( $res->headers->header('Via'), undef, "Client says no Via: header added" );
# make sure both kids are dead
wait for @pids;
HTTP-Proxy-0.304/t/51simple2.t 0000644 0001750 0001750 00000002603 12537671053 014247 0 ustar book book use Test::More tests => 2;
use strict;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use t::Utils;
# create the filter
my $sub = sub {
my ( $self, $headers, $message) = @_;
$headers->header( X_Foo => 'Bar' );
};
my $filter = HTTP::Proxy::HeaderFilter::simple->new($sub);
# create the proxy
my $proxy = HTTP::Proxy->new(
port => 0,
max_clients => 0,
max_connections => 2,
);
# prepare the proxy and server
$proxy->init;
$proxy->agent->proxy( http => "" );
$proxy->push_filter( response => $filter );
my $url = $proxy->url;
my $server = server_start();
my $serverurl = $server->url;
# fork the proxy
my @pids;
push @pids, fork_proxy($proxy);
# fork the HTTP server
my $pid = fork;
die "Unable to fork web server" if not defined $pid;
if ( $pid == 0 ) {
server_next($server) for 1 .. 2;
exit 0;
}
push @pids, $pid;
#
# check that the correct transformation is applied
#
# for GET requests
my $ua = LWP::UserAgent->new();
$ua->proxy( http => $url );
my $response = $ua->request( HTTP::Request->new( GET => $serverurl ) );
is( $response->header( "X-Foo" ), "Bar", "Proxy applied the transformation" );
# for HEAD requests
$ua = LWP::UserAgent->new();
$ua->proxy( http => $url );
$response = $ua->request( HTTP::Request->new( HEAD => $serverurl ) );
is( $response->header( "X-Foo" ), "Bar", "Proxy applied the transformation" );
# wait for kids
wait for @pids;
HTTP-Proxy-0.304/t/20keepalive.t 0000644 0001750 0001750 00000005237 12537671053 014643 0 ustar book book use strict;
use Test::More;
# here are all the requests the client will try
my @requests = (
'single.txt', ( 'file1.txt', 'directory/file2.txt', 'ooh.cgi?q=query' ) x 2
);
if( $^O eq 'MSWin32' ) {
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
plan tests => 3 * @requests + 1;
use LWP::UserAgent;
use HTTP::Proxy;
use t::Utils; # some helper functions for the server
my $test = Test::Builder->new;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
# create a HTTP::Daemon (on an available port)
my $server = server_start();
# create a HTTP::Proxy
my $proxy = HTTP::Proxy->new(
port => 0,
max_keep_alive_requests => 3, # no more than 3 requests per connection
max_connections => 3, # no more than 3 connections
);
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
# fork the HTTP server
my @pids;
my $pid = fork;
die "Unable to fork web server" if not defined $pid;
if ( $pid == 0 ) {
# the answer method
my $answer = sub {
my $req = shift;
my $data = shift;
my $re = quotemeta $data;
like( $req->uri, qr/$re/, "The daemon got what it expected" );
return HTTP::Response->new( 200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
"Here is $data." );
};
# let's return some files when asked for them
server_next( $server, $answer, $_ ) for @requests;
exit 0;
}
# back in the parent
push @pids, $pid; # remember the kid
# fork a HTTP proxy
fork_proxy(
$proxy, sub {
is( $proxy->conn, 3,
"The proxy served the correct number of connections" );
}
);
# back in the parent
push @pids, $pid; # remember the kid
# some variables
my ( $ua, $res, $re );
# the first connection will be closed by the client
$ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );
my $req = shift @requests;
$res =
$ua->simple_request(
HTTP::Request->new( GET => $server->url . $req ) );
ok( $res->is_success, "Got an answer (@{[$res->status_line]})" );
$re = quotemeta $req;
like( $res->content, qr/$re/, "The client got what it expected" );
# the other connections (keep-alive)
$ua = LWP::UserAgent->new( keep_alive => 1 );
$ua->proxy( http => $proxy->url );
for (@requests) {
$res =
$ua->simple_request( HTTP::Request->new( GET => $server->url . $_ ) );
ok( $res->is_success, "Got an answer (@{[$res->status_line]})" );
$re = quotemeta;
like( $res->content, qr/$re/, "The client got what it expected" );
}
# make sure both kids are dead
wait for @pids;
HTTP-Proxy-0.304/t/50standard.t 0000644 0001750 0001750 00000011310 12537671053 014466 0 ustar book book use strict;
use Test::More;
use LWP::UserAgent;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use t::Utils; # some helper functions for the server
if( $^O eq 'MSWin32' ) {
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
plan tests => 13;
my $test = Test::Builder->new;
my @pids;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
# create a HTTP::Daemon (on an available port)
my $server = server_start();
# create and fork the proxy
my $proxy = HTTP::Proxy->new( port => 0, max_connections => 5 );
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
push @pids, fork_proxy($proxy);
# fork the HTTP server
my $pid = fork;
die "Unable to fork web server" if not defined $pid;
if ( $pid == 0 ) {
my $res = HTTP::Response->new(
200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
"Here is some data."
);
# let's return some files when asked for them
server_next($server) for 1 .. 3;
server_next($server,
sub {
my $req = shift;
SKIP: {
skip 'FreeBSD jail does not treat localhost as 127.0.0.1', 1
if ($^O eq 'freebsd' && `sysctl -n security.jail.jailed` == 1);
is( $req->header("X-Forwarded-For"), '127.0.0.1',
"The daemon got X-Forwarded-For" );
}
return $res;
}
);
server_next( $server,
sub {
my $req = shift;
is( $req->header("X-Forwarded-For"), undef,
"The daemon didn't get X-Forwarded-For" );
return $res;
}
);
exit 0;
}
push @pids, $pid;
# run a client
my ( $req, $res );
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );
#
# check that we have single Date and Server headers
#
# for GET requests
$req = HTTP::Request->new( GET => $server->url . "headers" );
$res = $ua->simple_request($req);
my @date = $res->headers->header('Date');
is( scalar @date, 1, "A single Date: header for GET request" );
my @server = $res->headers->header('Server');
is( scalar @server, 1, "A single Server: header for GET request" );
# for HEAD requests
$req = HTTP::Request->new( HEAD => $server->url . "headers-head" );
$res = $ua->simple_request($req);
@date = $res->headers->header('Date');
is( scalar @date, 1, "A single Date: header for HEAD request" );
@server = $res->headers->header('Server');
is( scalar @server, 1, "A single Server: header for HEAD request" );
# for direct proxy responses
$ua->proxy( file => $proxy->url );
$req = HTTP::Request->new( GET => "file:///etc/passwd" );
$res = $ua->simple_request($req);
@date = $res->headers->header('Date');
is( scalar @date, 1, "A single Date: header for direct proxy response" );
@server = $res->headers->header('Server');
is( scalar @server, 1, "A single Server: header for direct proxy response" );
# check the Server: header
like( $server[0], qr!HTTP::Proxy/\d+\.\d+!, "Correct server name for direct proxy response" );
# we cannot use a LWP user-agent to check
# that the LWP Client-* headers are removed
use IO::Socket::INET;
# connect directly to the proxy
$proxy->url() =~ /:(\d+)/;
my $sock = IO::Socket::INET->new(
PeerAddr => 'localhost',
PeerPort => $1,
Proto => 'tcp'
) or diag "Can't connect to the proxy";
# send the request
my $url = $server->url;
$url =~ m!http://([^:]*)!;
print $sock "GET $url HTTP/1.0\015\012Host: $1\015\012\015\012";
# fetch and count the Client-* response headers
my @client = grep { /^Client-/ } <$sock>;
is( scalar @client, 0, "No Client-* headers sent by the proxy" );
# close the connection to the proxy
close $sock or diag "close: $!";
# X-Forwarded-For (test in the server)
$req = HTTP::Request->new( HEAD => $server->url . "x-forwarded-for" );
$res = $ua->simple_request($req);
is( $res->header( 'X-Forwarded-For' ), undef, "No X-Forwarded-For sent back" );
# yet another proxy
$proxy = HTTP::Proxy->new( port => 0, max_connections => 1, x_forwarded_for => 0 );
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
$proxy->push_filter( response => HTTP::Proxy::HeaderFilter::simple->new(
sub { is( $_[0]->proxy->client_headers->header("Client-Response-Num"), 1,
"Client headers" ); } ) );
push @pids, fork_proxy($proxy);
# X-Forwarded-For (test in the server)
$ua->proxy( http => $proxy->url );
$req = HTTP::Request->new( HEAD => $server->url . "x-forwarded-for" );
$res = $ua->simple_request($req);
is( $res->header( 'X-Forwarded-For' ), undef, "No X-Forwarded-For sent back" );
# make sure both kids are dead
wait for @pids;
HTTP-Proxy-0.304/t/18engine.t 0000644 0001750 0001750 00000004066 12537671053 014151 0 ustar book book use Test::More;
use HTTP::Proxy::Engine;
plan tests => 18;
my $e;
my $p = bless {}, "HTTP::Proxy";
$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy );
isa_ok( $e, 'HTTP::Proxy::Engine::Legacy' );
# use the default engine for $^O
eval { HTTP::Proxy::Engine->new() };
isa_ok( $e, 'HTTP::Proxy::Engine' );
eval { HTTP::Proxy::Engine->new( engine => Legacy ) };
like( $@, qr/^No proxy defined/, "proxy required" );
eval { HTTP::Proxy::Engine->new( proxy => "P", engine => Legacy ) };
like( $@, qr/^P is not a HTTP::Proxy object/, "REAL proxy required" );
# direct engine creation
# HTTP::Proxy::Engine::Legacy was required before
$e = HTTP::Proxy::Engine::Legacy->new( proxy => $p );
isa_ok( $e, 'HTTP::Proxy::Engine::Legacy' );
eval { HTTP::Proxy::Engine::Legacy->new() };
like( $@, qr/^No proxy defined/, "proxy required" );
eval { HTTP::Proxy::Engine::Legacy->new( proxy => "P" ) };
like( $@, qr/^P is not a HTTP::Proxy object/, "REAL proxy required" );
# non-existent engine
eval { HTTP::Proxy::Engine->new( proxy => $p, engine => Bonk ) };
like(
$@,
qr/^Can't locate HTTP.+?Proxy.+?Engine.+?Bonk\.pm in \@INC/,
"Engine Bonk does not exist"
);
# check the base accessor
$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy );
is( $e->proxy, $p, "proxy() get" );
# check subclasses accessors
$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy, select => 2 );
is( $e->select, 2, "subclass get()" );
is( $e->select(4), 4, "subclass set()" );
is( $e->select, 4, "subclass get()" );
$e = HTTP::Proxy::Engine::Legacy->new( proxy => $p, select => 3 );
is( $e->select, 3, "subclass get()" );
is( $e->select(4), 4, "subclass set()" );
is( $e->select, 4, "subclass get()" );
# but where is the code?
is( *{HTTP::Proxy::Engine::select}{CODE},
undef, "code not in the base class" );
is( ref *{HTTP::Proxy::Engine::select}{CODE},
'', "code not in the base class" );
my $c = \&HTTP::Proxy::Engine::Legacy::select; # remove "used only once" warning
is( ref *{HTTP::Proxy::Engine::Legacy::select}{CODE},
'CODE', "code in the subclass" );
HTTP-Proxy-0.304/t/release-distmeta.t 0000644 0001750 0001750 00000000430 12537671053 015752 0 ustar book book #!perl
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
# This file was automatically generated by Dist::Zilla::Plugin::MetaTests.
use Test::CPAN::Meta;
meta_yaml_ok();
HTTP-Proxy-0.304/t/00basic.t 0000644 0001750 0001750 00000000657 12537671053 013756 0 ustar book book use vars qw( @modules );
BEGIN {
use Config;
use File::Find;
use vars qw( @modules );
find( sub { push @modules, $File::Find::name if /\.pm$/ }, 'blib/lib' );
}
use Test::More tests => scalar @modules;
for ( sort map { s!/!::!g; s/\.pm$//; s/^blib::lib:://; $_ } @modules ) {
SKIP:
{
skip "$^X is not a threaded Perl", 1
if /Thread/ && !$Config{usethreads};
use_ok($_);
}
}
HTTP-Proxy-0.304/t/66htmlparser.t 0000644 0001750 0001750 00000003361 12537671053 015065 0 ustar book book use strict;
use Test::More;
BEGIN {
if ( eval "use HTML::Parser; 1;" ) {
plan tests => 5;
}
else {
plan skip_all => 'HTML::Parser not installed';
}
}
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::htmlparser;
my @results = (
[
'Test
\nfoo
bar
',
'Test
\nfoo
bar
',
{ start => 4, end => 3 }
],
[
'Test
\nfoo
bar
',
'
',
{ start => 4, end => 3 }
],
);
my $filter;
my $count;
# bad initialisation
eval { $filter = HTTP::Proxy::BodyFilter::htmlparser->new("foo"); };
like( $@, qr/^First parameter must be a HTML::Parser/, "Test constructor" );
my $p = HTML::Parser->new;
$p->handler( start => \&start, "self,text" );
$p->handler( end => \&end, "self,text" );
$p->handler( start_document => \&start_document, "" );
# the handlers
sub start_document { $count = {} }
sub start { $count->{start}++; $_[0]->{output} .= $_[1] }
sub end { $count->{end}++; $_[0]->{output} .= $_[1] }
# read-only filter
my $data = shift @results;
$filter = HTTP::Proxy::BodyFilter::htmlparser->new($p);
$filter->filter( \$data->[0], undef, undef, undef );
is_deeply( $data->[0], $data->[1], "Data not modified" );
is_deeply( $data->[2], $count, "Correct number of start and end events" );
# read-write filter (yeah, it's the same)
$data = shift @results;
$filter = HTTP::Proxy::BodyFilter::htmlparser->new( $p, rw => 1 );
$filter->filter( \$data->[0], undef, undef, undef );
is_deeply( $data->[0], $data->[1], "Data modified" );
is_deeply( $data->[2], $count, "Correct number of start and end events" );
HTTP-Proxy-0.304/t/17fstack.t 0000644 0001750 0001750 00000003225 12537671053 014152 0 ustar book book use Test::More tests => 11;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter;
use HTTP::Proxy::BodyFilter;
my $stack;
my $hf = [ sub { 1 }, HTTP::Proxy::HeaderFilter->new() ];
my $hf2 = [ sub { 1 }, HTTP::Proxy::HeaderFilter->new() ];
my $bf = [ sub { 1 }, HTTP::Proxy::BodyFilter->new() ];
# test general stack workings
$stack = HTTP::Proxy::FilterStack->new();
# all, push
is_deeply( [ $stack->all ], [], "FilterStack is empty" );
$stack->push($hf);
is_deeply( [ $stack->all ], [ $hf ], "FilterStack has one element" );
$stack->push($hf2, $hf);
is_deeply( [ $stack->all ], [ $hf, $hf2, $hf ], "FilterStack has three elements" );
# insert
$stack->insert(1, $hf2);
is_deeply( [ $stack->all ], [ $hf, $hf2, $hf2, $hf ], "FilterStack is correct");
is( scalar $stack->all, 4, "Correct in scalar context too");
# remove
my $elem = $stack->remove(1);
is( $elem, $hf2, "Got back what was in the stack");
# check insertion in header FilterStack
eval { $stack->push( $bf ); };
like( $@, qr/is not a HTTP::Proxy::HeaderFilter/, "Incorrect Filter class" );
eval { $stack->insert( 0, $bf ); };
like( $@, qr/is not a HTTP::Proxy::HeaderFilter/, "Incorrect Filter class" );
{
package Foo;
use base qw( HTTP::Proxy::HeaderFilter );
}
my $foo = [ sub { 1 }, Foo->new() ];
eval { $stack->push( $foo ); };
is( $@, '', "Can push derived Filters" );
# same test for body FilterStack
my $bstack = HTTP::Proxy::FilterStack->new(1);
eval { $bstack->push( $hf ); };
like( $@, qr/is not a HTTP::Proxy::BodyFilter/, "Incorrect Filter class" );
eval { $bstack->insert( 0, $hf ); };
like( $@, qr/is not a HTTP::Proxy::BodyFilter/, "Incorrect Filter class" );
# current
# filter
# filter_last
HTTP-Proxy-0.304/t/release-pod-syntax.t 0000644 0001750 0001750 00000000456 12537671053 016256 0 ustar book book #!perl
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
use Test::More;
use Test::Pod 1.41;
all_pod_files_ok();
HTTP-Proxy-0.304/t/00-report-prereqs.dd 0000644 0001750 0001750 00000005362 12537671053 016066 0 ustar book book do { my $x = {
'configure' => {
'requires' => {
'ExtUtils::MakeMaker' => '0'
}
},
'develop' => {
'requires' => {
'Pod::Coverage::TrustPod' => '0',
'Test::CPAN::Meta' => '0',
'Test::Pod' => '1.41',
'Test::Pod::Coverage' => '1.08'
}
},
'runtime' => {
'requires' => {
'Carp' => '0',
'Exporter' => '0',
'Fcntl' => '0',
'File::Path' => '0',
'File::Spec' => '0',
'File::Temp' => '0',
'HTTP::Daemon' => '0',
'HTTP::Date' => '0',
'HTTP::Headers::Util' => '0',
'IO::Handle' => '0',
'IO::Select' => '0',
'LWP::ConnCache' => '0',
'LWP::UserAgent' => '0',
'POSIX' => '0',
'Socket' => '0',
'Sys::Hostname' => '0',
'constant' => '0',
'strict' => '0',
'vars' => '0'
}
},
'test' => {
'recommends' => {
'CPAN::Meta' => '2.120900'
},
'requires' => {
'ExtUtils::MakeMaker' => '0',
'File::Find' => '0',
'File::Spec' => '0',
'File::Spec::Functions' => '0',
'HTML::Parser' => '3',
'HTTP::Headers' => '0',
'HTTP::Request' => '0',
'HTTP::Request::Common' => '0',
'IO::Socket::INET' => '0',
'Test::More' => '0',
'base' => '0',
'warnings' => '0'
}
}
};
$x;
} HTTP-Proxy-0.304/t/71rot13.t 0000644 0001750 0001750 00000002634 12537671053 013652 0 ustar book book use Test::More tests => 4;
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::htmltext;
use t::Utils;
use strict;
# a very simple proxy
my $proxy = HTTP::Proxy->new( port => 0 );
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::tags->new,
response => HTTP::Proxy::BodyFilter::htmltext->new(
sub { tr/a-zA-z/n-za-mN-ZA-M/ }
)
);
# get and test the filter stack
my $stack = $proxy->_filter_stack(
body => 'response',
HTTP::Request->new( GET => 'http://foo.com/bar.html' ),
HTTP::Response->new(
200, "OK", HTTP::Headers->new( 'Content-Type' => 'text/html' )
)
);
for (
[ "abc", "nop" ],
[ "100 € is expensive", "100 € vf rkcrafvir" ],
[ " <-- here ", " <-- urer " ],
[
qq'\n foo',
qq'\n sbb',
],
)
{
my $data = "$_->[0]";
$stack->select_filters( $proxy->{response} );
$stack->filter( \$data, $proxy->{response}, undef );
is( $data, $_->[1], "Correct data transformation" );
}
HTTP-Proxy-0.304/t/64lines.t 0000644 0001750 0001750 00000003507 12537671053 014016 0 ustar book book use Test::More tests => 33;
use strict;
use HTTP::Proxy::BodyFilter::lines;
my $filter;
# error checking
eval { $filter = HTTP::Proxy::BodyFilter::lines->new( undef ) };
like( $@, qr/slurp mode is not supported/, "No slurp mode" );
eval { $filter = HTTP::Proxy::BodyFilter::lines->new( \'foo' ) };
like( $@, qr/"foo" is not numeric/, "Records must be numeric" );
eval { $filter = HTTP::Proxy::BodyFilter::lines->new( \0 ) };
like( $@, qr/Records of size 0/, "Records must be != 0" );
# test the filter
for (
HTTP::Proxy::BodyFilter::lines->new(),
[ "\n\n\nfoo\n", "", "\n\n\nfoo\n", "" ],
[ "foo\nbar", "", "foo\n", "bar" ],
[ "foo\nbar\nbaz", "", "foo\nbar\n", "baz" ],
[ "", "", "", "" ],
[ "foo\nbar\nbaz", undef, "foo\nbar\nbaz", undef ],
HTTP::Proxy::BodyFilter::lines->new('%'),
[ "\n\n%\nfoo\n", "", "\n\n%", "\nfoo\n" ],
[ "foo\%bar", "", 'foo%', "bar" ],
[ "foo\n\%bar\nbaz", "", "foo\n\%", "bar\nbaz" ],
[ "foo\nbar\%baz", undef, "foo\nbar\%baz", undef ],
HTTP::Proxy::BodyFilter::lines->new(""),
[ "foo\nbar\n\nbaz", "", "foo\nbar\n\n", "baz" ],
[ "foo\nbar\n\n", "", "", "foo\nbar\n\n" ],
[ "foo\nbar\n\n", undef, "foo\nbar\n\n", undef ],
HTTP::Proxy::BodyFilter::lines->new( \10 ),
[ '01234567890123', "", "0123456789", "0123" ],
[ '0123456789' x 2, "", "0123456789" x 2, "" ],
[ '01234567890123', undef, "01234567890123", undef ],
)
{
$filter = $_, next if ref eq 'HTTP::Proxy::BodyFilter::lines';
my ( $data, $buffer ) = @$_[ 0, 1 ];
$filter->filter( \$data, undef, undef,
( defined $buffer ? \$buffer : undef ) );
is( $data, $_->[2], "Correct data" );
is( $buffer, $_->[3], "Correct buffer" );
}
HTTP-Proxy-0.304/t/50hopbyhop.t 0000644 0001750 0001750 00000007675 12537671053 014541 0 ustar book book use strict;
use Test::More tests => 28;
use HTTP::Proxy;
# objects
my $proxy = HTTP::Proxy->new( port => 0 );
$proxy->init; # needed to setup the filter stacks
my $filter = HTTP::Proxy::HeaderFilter::standard->new;
# a few hacks because we aren't actually connected
$filter->proxy($proxy);
{
package MockSocket;
use vars qw( @ISA );
@ISA = qw( IO::Socket::INET );
# needed by HTTP::Proxy::HeaderFilter::standard
sub peerhost { "1.2.3.4"; }
}
$proxy->{client_socket} = MockSocket->new();
# the dummy request
my $req = HTTP::Request->new( GET => 'http://www.example.com/' );
$req->header(
Proxy_Connection => 'Keep-Alive',
Connection => 'Foo, Bar',
Foo => 'foofoo',
Bar => 'barbar',
User_Agent => 'Foo/1.0'
);
$filter->filter( $req->headers, $req );
# hop-by-hop
is( $proxy->hop_headers->header('proxy-connection'),
'Keep-Alive', "Hop-by-hop Proxy-Connection" );
is( $proxy->hop_headers->header('connection'),
'Foo, Bar', "Hop-by-hop Connection" );
is( $proxy->hop_headers->header('Foo'), 'foofoo', "Hop-by-hop Foo" );
is( $proxy->hop_headers->header('Bar'), 'barbar', "Hop-by-hop Bar" );
# end-to-end
is( $req->header('user-agent'), 'Foo/1.0', "End-to-end User-Agent" );
is( $req->header('proxy-connection'), undef, "Connection header removed" );
is( $req->header('connection'), undef, "Connection header removed" );
is( $req->header('Foo'), undef, "Connection header removed" );
is( $req->header('Bar'), undef, "Connection header removed" );
# yet another test
$req = HTTP::Request->new( GET => 'http://www.example.com/' );
$req->push_header( Proxy_Connection => 'Keep-Alive' );
$req->push_header( Connection => 'Foo' );
$req->push_header( Connection => 'Bar' );
$req->push_header( Foo => 'foofoo' );
$req->push_header( Bar => 'barbar' );
$req->push_header( User_Agent => 'Foo/1.0' );
$filter->filter( $req->headers, $req );
# hop-by-hop
is( $proxy->hop_headers->header('proxy-connection'),
'Keep-Alive', "Hop-by-hop Proxy-Connection" );
is( $proxy->hop_headers->header('connection'),
'Foo, Bar', "Hop-by-hop Connection" );
is( $proxy->hop_headers->header('Foo'), 'foofoo', "Hop-by-hop Foo" );
is( $proxy->hop_headers->header('Bar'), 'barbar', "Hop-by-hop Bar" );
# end-to-end
is( $req->header('user-agent'), 'Foo/1.0', "End-to-end User-Agent" );
is( $req->header('proxy-connection'), undef, "Connection header removed" );
is( $req->header('connection'), undef, "Connection header removed" );
is( $req->header('Foo'), undef, "Connection header removed" );
is( $req->header('Bar'), undef, "Connection header removed" );
# a final test
$req = HTTP::Request->new( GET => 'http://www.example.com/' );
$req->push_header( Proxy_Connection => 'Keep-Alive' );
$req->push_header( Connection => 'Foo, Bar' );
$req->push_header( Connection => 'Baz' );
$req->push_header( Foo => 'foofoo' );
$req->push_header( Bar => 'barbar' );
$req->push_header( Baz => 'bazbaz' );
$req->push_header( User_Agent => 'Foo/1.0' );
$filter->filter( $req->headers, $req );
# hop-by-hop
is( $proxy->hop_headers->header('proxy-connection'),
'Keep-Alive', "Hop-by-hop Proxy-Connection" );
is( $proxy->hop_headers->header('connection'),
'Foo, Bar, Baz', "Hop-by-hop Connection" );
is( $proxy->hop_headers->header('Foo'), 'foofoo', "Hop-by-hop Foo" );
is( $proxy->hop_headers->header('Bar'), 'barbar', "Hop-by-hop Bar" );
is( $proxy->hop_headers->header('Baz'), 'bazbaz', "Hop-by-hop Baz" );
# end-to-end
is( $req->header('user-agent'), 'Foo/1.0', "End-to-end User-Agent" );
is( $req->header('proxy-connection'), undef, "Connection header removed" );
is( $req->header('connection'), undef, "Connection header removed" );
is( $req->header('Foo'), undef, "Connection header removed" );
is( $req->header('Bar'), undef, "Connection header removed" );
HTTP-Proxy-0.304/t/67complete.t 0000644 0001750 0001750 00000003044 12537671053 014513 0 ustar book book use strict;
use warnings;
use Test::More;
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::complete;
use HTTP::Proxy::BodyFilter::simple;
my @data = (
'miny hollers the let tiger catch meeny a he him',
'joy beamish flame gyre o blade came callay jaws vorpal',
'xvi vigor nvi Bvi trived Elvis levee viper e3 PVIC',
'Wizzle Hunny_Bee Alexander_Beetle Owl Woozle Eeyore Backson',
'necessitatibus lorem aperiam facere consequuntur incididunt similique'
);
my $full = join '', @data;
plan tests => 1 + @data;
# some variables
my $proxy = HTTP::Proxy->new( port => 0 );
$proxy->push_filter(
response => HTTP::Proxy::BodyFilter::complete->new(),
response => HTTP::Proxy::BodyFilter::simple->new(
sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
if ( defined $buffer ) {
is( $$dataref, '', 'Empty chunk of data' );
}
else {
is( $$dataref, $full, 'Full data in one big chunk' );
}
}
),
);
# set up a fake request/response set
my $res =
HTTP::Response->new( 200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/html' ), 'dummy' );
$res->request( HTTP::Request->new( GET => 'http://www.example.com/' ) );
$proxy->request( $res->request );
$proxy->response($res);
# run the data through the filters
$proxy->{body}{response}->select_filters($res);
for my $data (@data) {
$proxy->{body}{response}->filter( \$data, $res, '' );
}
# finalize
my $data = '';
$proxy->{body}{response}->filter_last( \$data, $res, '' );
HTTP-Proxy-0.304/t/10init.t 0000644 0001750 0001750 00000001572 12537671053 013636 0 ustar book book use Test::More tests => 8;
use HTTP::Proxy;
my ( $proxy, $agent, $daemon );
# individual methods
$proxy = HTTP::Proxy->new( port => 0 );
is( $proxy->agent, undef, 'agent undefined at startup' );
is( $proxy->daemon, undef, 'daemon undefined at startup' );
# private methods (should we test them?)
$agent = $proxy->_init_agent;
$daemon = $proxy->_init_daemon;
isa_ok( $agent, 'LWP::UserAgent', 'init_agent' );
isa_ok( $daemon, 'HTTP::Daemon', 'init_daemon' );
# this is ugly
$daemon = undef;
# combined init method
$proxy = HTTP::Proxy->new( port => 0 );
$proxy->init;
isa_ok( $proxy->agent, 'LWP::UserAgent', 'init agent' );
isa_ok( $proxy->daemon, 'HTTP::Daemon', 'init daemon' );
# basic checks on the agent
$agent = $proxy->agent;
ok( ! $agent->is_protocol_supported('mailto'), "Can't mailto" );
ok( ! $agent->is_protocol_supported('file'), "Can't access local files" );
HTTP-Proxy-0.304/t/15deprecated.t 0000644 0001750 0001750 00000003332 12537671053 014774 0 ustar book book use strict;
use Test::More;
use File::Spec;
use HTTP::Proxy;
my $errfile = File::Spec->catfile( 't', 'stderr.out' );
my @deprecated = (
[ maxchild => qr/^maxchild is deprecated, please use max_clients/ ],
[ maxconn => qr/^maxconn is deprecated, please use max_connections/ ],
[
maxserve =>
qr/^maxserve is deprecated, please use max_keep_alive_requests/
],
);
plan tests => 4 * @deprecated;
# check the warnings
open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
open STDERR, '>', $errfile or die "Can't redirect STDERR: $!";
select STDERR;
$| = 1; # make unbuffered
# call the deprecated methods
my $p1 = HTTP::Proxy->new(
maxchild => 1,
maxconn => 3,
maxserve => 5,
);
my $p2 = HTTP::Proxy->new();
$p2->maxchild(9);
$p2->maxconn(8);
$p2->maxserve(7);
# get the old STDERR back
open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
# read the stderr log
open my $fh, $errfile or die "Can't open $errfile: $!";
my @err = sort <$fh>;
close $fh or diag "Can't close $errfile: $!";
# run the tests
for (@deprecated) {
like( shift @err, $_->[1], "$_->[0] is deprecated" );
like( shift @err, $_->[1], "$_->[0] is deprecated" );
}
diag $_ for @err;
unlink $errfile or diag "Can't unlink $errfile: $!";
# check that the real method was called
is( $p1->max_clients, 1, "max_clients called for maxchild" );
is( $p1->max_connections, 3, "max_connections called for maxconn" );
is( $p1->max_keep_alive_requests, 5, "max_keep_alive_requests called for maxserve" );
is( $p2->max_clients, 9, "max_clients called for maxchild" );
is( $p2->max_connections, 8, "max_connections called for maxconn" );
is( $p2->max_keep_alive_requests, 7, "max_keep_alive_requests called for maxserve" );
HTTP-Proxy-0.304/t/42will_modify.t 0000644 0001750 0001750 00000003422 12537671053 015212 0 ustar book book use strict;
use Test::More;
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::tags;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::complete;
use HTTP::Proxy::BodyFilter::htmltext;
use HTTP::Proxy::BodyFilter::lines;
use HTTP::Proxy::BodyFilter::save;
use HTTP::Request;
my @idem_filters = qw( complete lines save tags );
plan tests => 2 + @idem_filters;
my $proxy = HTTP::Proxy->new( port => 0 );
my $req = HTTP::Request->new( GET => 'http://www.vronk.com/' );
my $res = HTTP::Response->new( 200 );
$res->request( $req );
$res->content_type( 'text/html' );
$proxy->request( $req );
$proxy->response( $res );
# basic values
for my $filter (@idem_filters) {
$req->uri("http://www.$filter.com/");
$proxy->push_filter(
response => "HTTP::Proxy::BodyFilter::$filter"->new );
$proxy->{body}{response}->select_filters($res);
is( $proxy->{body}{response}->will_modify($res),
0, qq{Filter $filter won't change a thing} );
}
# change the request info
$req->uri( 'http://www.zlonk.com/' );
# filters that don't modify anything
$proxy->push_filter(
host => 'zlonk.com',
response => HTTP::Proxy::BodyFilter::tags->new(),
response => HTTP::Proxy::BodyFilter::complete->new(),
);
$proxy->{body}{response}->select_filters( $res );
ok( !$proxy->{body}{response}->will_modify(),
q{Filters won't change a thing}
);
# simulate end of connection
$proxy->{body}{response}->eod();
# add a filter that will change stuff
$proxy->push_filter(
host => 'zlonk.com',
response => HTTP::Proxy::BodyFilter::simple->new( sub {} ),
);
$proxy->{body}{response}->select_filters( $res );
ok( $proxy->{body}{response}->will_modify( $res ),
q{Filters admit they will change something}
);
unlink( 'www.zlonk.com' ); # cleanup file created by HPBF::save
HTTP-Proxy-0.304/t/20dummy.t 0000644 0001750 0001750 00000004256 12537671053 014031 0 ustar book book use Test::More;
use strict;
# here are all the requests the client will try
my @requests = qw(
file1.txt
directory/file2.txt
ooh.cgi?q=query
);
if( $^O eq 'MSWin32' ) {
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
plan tests => 3 * @requests + 1;
use LWP::UserAgent;
use HTTP::Proxy;
use t::Utils; # some helper functions for the server
my $test = Test::Builder->new;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
# create a HTTP::Daemon (on an available port)
my $server = server_start();
my $serverurl = $server->url;
my $proxy = HTTP::Proxy->new( port => 0, max_connections => scalar @requests );
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
my $proxyurl = $proxy->url;
# fork the HTTP server
my @pids;
my $pid = fork;
die "Unable to fork web server" if not defined $pid;
if ( $pid == 0 ) {
# the answer method
my $answer = sub {
my $req = shift;
my $data = shift;
my $re = quotemeta $data;
like( $req->uri, qr/$re/, "The daemon got what it expected" );
return HTTP::Response->new(
200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
"Here is $data."
);
};
# let's return some files when asked for them
server_next( $server, $answer, $_ ) for @requests;
exit 0;
}
# back in the parent
push @pids, $pid; # remember the kid
# fork a HTTP proxy
$pid = fork_proxy(
$proxy,
sub {
is( $proxy->conn, scalar @requests,
"The proxy served the correct number of connections" );
}
);
# back in the parent
push @pids, $pid; # remember the kid
# run a client
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxyurl );
for (@requests) {
my $req = HTTP::Request->new( GET => $serverurl . $_ );
my $rep = $ua->simple_request($req);
ok( $rep->is_success, "Got an answer (@{[$rep->status_line]})" );
my $re = quotemeta;
like( $rep->content, qr/$re/, "The client got what it expected" );
}
# make sure both kids are dead
wait for @pids;
HTTP-Proxy-0.304/t/61simple.t 0000644 0001750 0001750 00000003404 12537671053 014166 0 ustar book book use Test::More tests => 14;
use strict;
use HTTP::Proxy::BodyFilter::simple;
my ( $filter, $sub );
# error checking
eval { $filter = HTTP::Proxy::BodyFilter::simple->new() };
like( $@, qr/^Constructor called without argument/, "Need at least one arg" );
eval { $filter = HTTP::Proxy::BodyFilter::simple->new("foo") };
like( $@, qr/^Single parameter must be a CODE reference/, "Single coderef" );
eval { $filter = HTTP::Proxy::BodyFilter::simple->new( filter => "foo" ) };
like( $@, qr/^Parameter to filter must be a CODE reference/, "Need coderef" );
eval { $filter = HTTP::Proxy::BodyFilter::simple->new( typo => sub { } ); };
like( $@, qr/Unkown method typo/, "Incorrect method name" );
for (qw( filter begin end )) {
eval {
$filter = HTTP::Proxy::BodyFilter::simple->new( $_ => sub { } );
};
is( $@, '', "Accept $_" );
}
$sub = sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
$$dataref =~ s/foo/bar/g;
};
$filter = HTTP::Proxy::BodyFilter::simple->new($sub);
is( $filter->can('filter'), $sub, "filter() runs the correct filter" );
ok( $filter->will_modify(), 'will_modify() defaults to true' );
# will_modify()
$filter = HTTP::Proxy::BodyFilter::simple->new( filter => $sub,
will_modify => 42 );
is( $filter->will_modify(), 42, 'will_modify() returns the given data' );
# test the filter
for (
[ "\nfoo\n", "", "\nbar\n", "" ],
HTTP::Proxy::BodyFilter::simple->new( end => sub {} ),
[ "\nfoo\n", "", "\nfoo\n", "" ],
)
{
$filter = $_, next if ref $_ eq 'HTTP::Proxy::BodyFilter::simple';
my ( $data, $buffer ) = @$_[ 0, 1 ];
$filter->filter( \$data, undef, undef,
( defined $buffer ? \$buffer : undef ) );
is( $data, $_->[2], "Correct data" );
is( $buffer, $_->[3], "Correct buffer" );
}
HTTP-Proxy-0.304/t/15accessors.t 0000644 0001750 0001750 00000005660 12537671053 014667 0 ustar book book use Test::More;
use HTTP::Proxy qw( :log );
my $proxy;
$proxy = HTTP::Proxy->new;
#
# default values
#
my %meth = (
agent => undef,
chunk => 4096,
daemon => undef,
host => 'localhost',
logfh => *main::STDERR,
max_connections => 0,
max_keep_alive_requests => 10,
port => 8080,
request => undef,
response => undef,
hop_headers => undef,
logmask => 0,
x_forwarded_for => 1,
conn => 0,
client_socket => undef,
# loop is not used/internal for now
);
plan tests => 16 + keys %meth;
for my $key ( sort keys %meth ) {
no strict 'refs';
is( $proxy->$key(), $meth{$key}, "$key has the correct default" );
}
like( $proxy->via(), qr!\(HTTP::Proxy/$HTTP::Proxy::VERSION\)$!,
"via has the correct default");
{
my $my_via_proxy = HTTP::Proxy->new( via => 'VIA!VIA!VIA!' );
is( $my_via_proxy->via(), 'VIA!VIA!VIA!', 'custom via' );
}
# test deprecated accessors
$proxy = HTTP::Proxy->new( maxserve => 127, maxconn => 255 );
is( $proxy->max_keep_alive_requests, 127, "deprecated maxserve");
is( $proxy->max_connections, 255, "deprecated maxconn");
#
# test generated accessors (they're all the same)
#
is( $proxy->port(8888), $meth{port}, "Set return the previous value" );
is( $proxy->port, 8888, "Set works" );
#
# other accessors
#
$proxy->max_clients( 666 );
is( $proxy->engine->max_clients, 666, "max_clients correctly delegated" );
# check the url() method
$proxy->port(0);
# this spits a (normal) warning, but we clean it away
{
local *OLDERR;
# swap errputs
open OLDERR, ">&STDERR" or die "Could not duplicate STDERR: $!";
close STDERR;
# the actual test
is( $proxy->url, undef, "We do not have a url yet" );
# put things back to normal
close STDERR;
open STDERR, ">&OLDERR" or die "Could not duplicate OLDERR: $!";
close OLDERR;
}
$proxy->_init_daemon;
ok( $proxy->url =~ '^$http://' . $proxy->host . ':\d+/$', "url looks good" );
# check the timeout
$proxy->_init_agent;
is( $proxy->agent->timeout, 60, "Default agent timeout of 60 secs" );
is( $proxy->timeout(120), 60, "timeout() returns the old value" );
is( $proxy->agent->timeout, 120, "New agent timeout value of 120 secs" );
#
# the known_methods() method
#
my @all = $proxy->known_methods();
my @http = $proxy->known_methods('HTTP');
is_deeply(
\@http,
[ $proxy->known_methods('http') ],
'known_methods() is case insensitive'
);
my %dav = map { $_ => 1 } $proxy->known_methods('webdav');
my %delta = map { $_ => 1 } $proxy->known_methods('DelTaV');
is( scalar grep( { $dav{$_} } @http ), scalar @http, 'WebDAV contains HTTP' );
is( scalar grep( { $delta{$_} } keys %dav ),
scalar keys %dav,
'DeltaV contains WebDAV'
);
my %all = ( %dav, %delta, map { $_ => 1 } @http );
is_deeply(
[ sort keys %all ],
[ sort @all ],
'know_methods() returns all methods'
);
HTTP-Proxy-0.304/t/23connect.t 0000644 0001750 0001750 00000004136 12537671053 014327 0 ustar book book use Test::More;
use strict;
use t::Utils;
use HTTP::Proxy;
use LWP::UserAgent;
use IO::Socket::INET;
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0"
if $^O eq 'MSWin32';
# make sure we inherit no upstream proxy
delete $ENV{$_} for qw( http_proxy HTTP_PROXY https_proxy HTTPS_PROXY );
# test CONNECT
my $test = Test::Builder->new;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
# fork a local server that'll print a banner on connection
my $host;
my $banner = "President_of_Earth Barbarella Professor_Ping Stomoxys Dildano\n";
{
my $server = IO::Socket::INET->new( Listen => 1 );
plan 'skip_all', "Couldn't create local server" if !defined $server;
$host = 'localhost:' . $server->sockport;
my $pid = fork;
plan 'skip_all', "Couldn't fork" if !defined $pid;
if ( !$pid ) {
my $sock = $server->accept;
$sock->print($banner);
$sock->close;
exit;
}
}
plan tests => 4;
{
my $proxy = HTTP::Proxy->new( port => 0, max_connections => 1 );
$proxy->init; # required to access the url later
# fork a HTTP proxy
my $pid = fork_proxy(
$proxy,
sub {
ok( $proxy->conn == 1, "Served the correct number of requests" );
}
);
# run a client
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );
my $req = HTTP::Request->new( CONNECT => "http://$host/" );
my $res = $ua->request($req);
my $sock = $res->{client_socket};
if ( !$sock->blocking ) {
diag("socket is non blocking, switching to blocking mode");
$sock->blocking(1);
}
# what does the proxy say?
is( $res->code, 200, "The proxy accepts CONNECT requests" );
# read a line
my $read;
eval {
local $SIG{ALRM} = sub { die 'timeout' };
alarm 30;
$read = <$sock>;
};
ok( $read, "Read some data from the socket" );
is( $read, $banner, "CONNECTed to the TCP server and got the banner" );
close $sock;
# make sure the kids are dead
wait for 1 .. 2;
}
HTTP-Proxy-0.304/t/README 0000644 0001750 0001750 00000005764 12537671053 013234 0 ustar book book README file for the HTTP::Proxy tests
* Helper modules
HTTP::Proxy can test itself without using the network,
thanks to the HTTP::Daemon module.
But since I want to test the proxy against "real" servers,
I also need to test it with an internet connection.
localhost tests work as follows:
- a HTTP::Daemon is created and forked, that will serve
a certain number of simple requests
- a HTTP::Proxy is created and forked
- a LWP::UserAgent is created and connects to the proxy
- each of those process can run its own tests independantly,
thanks to Test::More
The t/Utils.pm files (use t::Utils in some test files) exports
several functions:
- server_start()
starts a new HTTP::Daemon
- server_next( [ \&answer ] )
returns the next response from the server (accepts a coderef)
- fork_proxy( $proxy, [ \&end ] )
fork a proxy server passed as an argument, with an optionnel
subroutine to run at the end
- web_ok()
test if the actual WWW is available for testing
- bare_request( $url, $headers, $proxy )
send a simple request through the proxy without LWP::UA
return a string containing the full response
* Test categories
The tests are prefixed with a number, which indicates several categories:
0x - Basic tests
t/00basic.t - use HTTP::Proxy works
t/01pod.t - the POD is correct
t/05new.t - the HTTP::Proxy constructor
1x - Minimal functionnality tests
t/10init.t - the proxy initialisation
t/11log.t - the log() and logmask() methods
t/15accessors.t - the proxy accessors
t/17fstack.t - the internal HTTP::Proxy::FilterStack object
2x - Network protocols test
t/20dummy.t - tests against a dummy web server
t/20keepalive.t - test the keep-alive connections
t/22http.t - test actual HTTP servers
t/22transparent.t - test transparent proxying
t/23connect.t - test CONNECT to a ssh server
t/23https.t - test CONNECT for SSL
3x - (Reserved for future use)
4x - Filter-related functions
t/40push_filters.t - the push_filter method
5x - Internal header filters
t/50hopbyhop.t - check hop-by-hop headers removal
t/50standard.t - check other headers removal
t/50via.t - check the Via: headers
t/51simple.t - HTTP::Proxy::HeaderFilter::simple
t/51simple2.t - HTTP::Proxy::HeaderFilter::simple with a real proxy
6x - Internal body filters
t/61simple.t - HTTP::Proxy::BodyFilter::simple
t/61simple2.t - HTTP::Proxy::BodyFilter::simple with a real proxy
t/64htmltext.t - HTTP::Proxy::BodyFilter::htmltext
t/64lines.t - HTTP::Proxy::BodyFilter::lines
t/64tags.t - HTTP::Proxy::BodyFilter::tags
t/66htmlparser.t - HTTP::Proxy::BodyFilter::htmlparser
7x - Complex filter chains
t/71rot13.t - a simple ROT13 filter set
8x - (Reserved for future use)
9x - miscellaneous tests
t/90diveintomark.t - test the proxy against a lot of status codes
HTTP-Proxy-0.304/t/05new.t 0000644 0001750 0001750 00000001523 12537671053 013464 0 ustar book book use Test::More tests => 10;
use HTTP::Proxy qw( :log );
my $proxy;
$proxy = HTTP::Proxy->new;
# check for defaults
is( $proxy->logmask, NONE, 'Default log mask' );
is( $proxy->port, 8080, 'Default port' );
is( $proxy->host, 'localhost', 'Default host' );
is( $proxy->agent, undef, 'Default agent' );
# new with arguments
$proxy = HTTP::Proxy->new(
port => 3128,
host => 'foo',
logmask => STATUS,
);
is( $proxy->port, 3128, 'port set by new' );
is( $proxy->logmask, STATUS, 'verbosity set by new' );
is( $proxy->host, 'foo', 'host set by new' );
# check the accessors
is( $proxy->logmask(NONE), STATUS, 'logmask accessor' );
is( $proxy->logmask, NONE, 'logmask changed by accessor' );
# check a read-only accessor
my $conn = $proxy->conn;
$proxy->conn( $conn + 100 );
is( $proxy->conn, $conn, 'read-only attribute' );
HTTP-Proxy-0.304/t/41filters.t 0000644 0001750 0001750 00000000705 12537671053 014344 0 ustar book book use Test::More tests => 2;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter;
use HTTP::Proxy::BodyFilter;
my $proxy = HTTP::Proxy->new( port => 0 );
my $filter = HTTP::Proxy::HeaderFilter->new;
$proxy->push_filter( request => $filter );
is( $filter->proxy, $proxy, "The HeaderFilter knows its proxy" );
$filter = HTTP::Proxy::BodyFilter->new;
$proxy->push_filter( response => $filter );
is( $filter->proxy, $proxy, "The BodyFilter knows its proxy" );
HTTP-Proxy-0.304/t/64htmltext.t 0000644 0001750 0001750 00000002723 12537671053 014554 0 ustar book book use strict;
use vars qw( @tokens );
BEGIN {
@tokens = (
"\n", "\n",
"\nVous Etes Perdu ?\n", "\n",
"\n", "\n",
"Perdu sur l'Internet ?", "\n",
"Pas de panique, on va vous aider", "\n",
" * ", "<-",
"---- vous ", "tes ici",
"\n", "\n",
"\n\n"
);
}
use Test::More tests => 2 + scalar @tokens;
use HTTP::Proxy::BodyFilter::htmltext;
# the tests are in the HTTP::Proxy::BodyFilter::htmltext callback
my $sub = sub { is( $_, shift (@tokens), "Correct text token matched" ); };
my $data =
qq{\n\n\nVous Etes Perdu ?\n\n\n\nPerdu sur l'Internet ?
\nPas de panique, on va vous aider
\n * <----- vous êtes ici
\n\n\n\n};
my $result = $data;
# test the filter's parser
my $filter = HTTP::Proxy::BodyFilter::htmltext->new($sub);
$filter->filter( \$data, undef, undef, undef );
is( $data, $result, "Text data not modified" );
# test the result data when modified
$result = $data = "This is a test.
\nYes, a test
\n";
$result =~ s/test/foobar/g;
$filter = HTTP::Proxy::BodyFilter::htmltext->new( sub { s/test/foobar/g } );
$filter->filter( \$data, undef, undef, undef );
is( $data, $result, "Text data correctly transformed" );
HTTP-Proxy-0.304/t/release-pod-coverage.t 0000644 0001750 0001750 00000000572 12537671053 016522 0 ustar book book #!perl
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests.
use Test::Pod::Coverage 1.08;
use Pod::Coverage::TrustPod;
all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' });
HTTP-Proxy-0.304/META.yml 0000644 0001750 0001750 00000004173 12537671053 013353 0 ustar book book ---
abstract: 'A pure Perl HTTP proxy'
author:
- 'Philippe Bruhat (BooK) '
build_requires:
ExtUtils::MakeMaker: '0'
File::Find: '0'
File::Spec: '0'
File::Spec::Functions: '0'
HTML::Parser: '3'
HTTP::Headers: '0'
HTTP::Request: '0'
HTTP::Request::Common: '0'
IO::Socket::INET: '0'
Test::More: '0'
base: '0'
warnings: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'Dist::Zilla version 5.034, CPAN::Meta::Converter version 2.150001'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: HTTP-Proxy
requires:
Carp: '0'
Exporter: '0'
Fcntl: '0'
File::Path: '0'
File::Spec: '0'
File::Temp: '0'
HTTP::Daemon: '0'
HTTP::Date: '0'
HTTP::Headers::Util: '0'
IO::Handle: '0'
IO::Select: '0'
LWP::ConnCache: '0'
LWP::UserAgent: '0'
POSIX: '0'
Socket: '0'
Sys::Hostname: '0'
constant: '0'
strict: '0'
vars: '0'
resources:
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTTP-Proxy
repository: http://github.com/book/HTTP-Proxy.git
version: '0.304'
x_contributors:
- e477
- 'Vincenzo Buttazzo '
- 'Slaven Rezic '
- 'Tom Hukins '
- 'Salve J. Nilsen '
- 'Masahiro Nagano '
- 'Ashley Pond V '
- 'Angelos Karageorgiou '
- 'Gregor Herrmann '
- 'Maurice Aubrey'
- 'Marek Rouchal '
- Jimbo
- 'Roland Stigge'
- 'Gunnar Wolf '
- 'Matsuno Tokuhiro '
- 'Ken Williams '
- 'Max Maischein '
- 'Mark Tilford'
- 'Chris Dolan '
- 'Randal L. Schwartz '
- 'Simon Cozens '
- 'Christian Laursen'
- 'Emmanuel Di Prétoro '
- 'Mathieu Arnold '
- 'Paul Makepeace '
- 'Martin Zdila'
- 'Jim Cromie '
- 'Stéphane Payrard '
- 'David Landgren '
- 'Éric Cholet '
HTTP-Proxy-0.304/META.json 0000644 0001750 0001750 00000006720 12537671053 013523 0 ustar book book {
"abstract" : "A pure Perl HTTP proxy",
"author" : [
"Philippe Bruhat (BooK) "
],
"dynamic_config" : 0,
"generated_by" : "Dist::Zilla version 5.034, CPAN::Meta::Converter version 2.150001",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "HTTP-Proxy",
"prereqs" : {
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"develop" : {
"requires" : {
"Pod::Coverage::TrustPod" : "0",
"Test::CPAN::Meta" : "0",
"Test::Pod" : "1.41",
"Test::Pod::Coverage" : "1.08"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Exporter" : "0",
"Fcntl" : "0",
"File::Path" : "0",
"File::Spec" : "0",
"File::Temp" : "0",
"HTTP::Daemon" : "0",
"HTTP::Date" : "0",
"HTTP::Headers::Util" : "0",
"IO::Handle" : "0",
"IO::Select" : "0",
"LWP::ConnCache" : "0",
"LWP::UserAgent" : "0",
"POSIX" : "0",
"Socket" : "0",
"Sys::Hostname" : "0",
"constant" : "0",
"strict" : "0",
"vars" : "0"
}
},
"test" : {
"recommends" : {
"CPAN::Meta" : "2.120900"
},
"requires" : {
"ExtUtils::MakeMaker" : "0",
"File::Find" : "0",
"File::Spec" : "0",
"File::Spec::Functions" : "0",
"HTML::Parser" : "3",
"HTTP::Headers" : "0",
"HTTP::Request" : "0",
"HTTP::Request::Common" : "0",
"IO::Socket::INET" : "0",
"Test::More" : "0",
"base" : "0",
"warnings" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"mailto" : "bug-http-proxy@rt.cpan.org",
"web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTTP-Proxy"
},
"repository" : {
"type" : "git",
"url" : "http://github.com/book/HTTP-Proxy.git",
"web" : "http://github.com/book/HTTP-Proxy"
}
},
"version" : "0.304",
"x_contributors" : [
"e477",
"Vincenzo Buttazzo ",
"Slaven Rezic ",
"Tom Hukins ",
"Salve J. Nilsen ",
"Masahiro Nagano ",
"Ashley Pond V ",
"Angelos Karageorgiou ",
"Gregor Herrmann ",
"Maurice Aubrey",
"Marek Rouchal ",
"Jimbo",
"Roland Stigge",
"Gunnar Wolf ",
"Matsuno Tokuhiro ",
"Ken Williams ",
"Max Maischein ",
"Mark Tilford",
"Chris Dolan ",
"Randal L. Schwartz ",
"Simon Cozens ",
"Christian Laursen",
"Emmanuel Di Prétoro ",
"Mathieu Arnold ",
"Paul Makepeace ",
"Martin Zdila",
"Jim Cromie ",
"Stéphane Payrard ",
"David Landgren ",
"Éric Cholet "
]
}
HTTP-Proxy-0.304/dist.ini 0000644 0001750 0001750 00000004343 12537671053 013545 0 ustar book book name = HTTP-Proxy
author = Philippe Bruhat (BooK)
license = Perl_5
copyright_holder = Philippe Bruhat (BooK)
; copyright_year = 2002-2015
[PkgVersion]
[@Filter]
-bundle = @Basic
-remove = Readme
[PruneFiles]
filename = setup
filename = TODO
match = \.patch$
match = mess/.*
match = cover_db
match = html/.*
[AutoPrereqs]
[Prereqs / TestRequires]
HTML::Parser = 3
[Test::ReportPrereqs]
[MetaResources]
repository.web = http://github.com/book/HTTP-Proxy
repository.url = http://github.com/book/HTTP-Proxy.git
repository.type = git
bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTTP-Proxy
bugtracker.mailto = bug-http-proxy@rt.cpan.org
[MetaJSON]
[MetaTests]
[PodSyntaxTests]
[PodCoverageTests]
[NextRelease]
format = %v %{EEE MMM d yyyy}d
[@Git]
changelog = Changes
commit_msg = Changes for version %v
tag_format = v%v
tag_message = %N v%v
push_to = origin
push_to = github
[Git::NextVersion]
[Meta::Contributors]
contributor = e477
contributor = Vincenzo Buttazzo
contributor = Slaven Rezic
contributor = Tom Hukins
contributor = Salve J. Nilsen
contributor = Masahiro Nagano
contributor = Ashley Pond V
contributor = Angelos Karageorgiou
contributor = Gregor Herrmann
contributor = Maurice Aubrey
contributor = Marek Rouchal
contributor = Jimbo
contributor = Roland Stigge
contributor = Gunnar Wolf
contributor = Matsuno Tokuhiro
contributor = Ken Williams
contributor = Max Maischein
contributor = Mark Tilford
contributor = Chris Dolan
contributor = Randal L. Schwartz
contributor = Simon Cozens
contributor = Christian Laursen
contributor = Emmanuel Di Prétoro
contributor = Mathieu Arnold
contributor = Paul Makepeace
contributor = Martin Zdila
contributor = Jim Cromie
contributor = Stéphane Payrard
contributor = David Landgren
contributor = Éric Cholet
HTTP-Proxy-0.304/MANIFEST 0000644 0001750 0001750 00000003221 12537671053 013224 0 ustar book book # This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.034.
Changes
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
dist.ini
eg/README
eg/adblock.pl
eg/anonymiser.pl
eg/ayb.pl
eg/bork.pl
eg/dragon.pl
eg/flv.pl
eg/fudd.pl
eg/https.pl
eg/javascript.pl
eg/js.pl
eg/leet.pl
eg/logger.pl
eg/outline.pl
eg/pdf.pl
eg/perlmonks.pl
eg/post.pl
eg/proxy-auth.pl
eg/proxy.pl
eg/rainbow.pl
eg/rfc.pl
eg/rot13.pl
eg/switch.pl
eg/tracker.pl
eg/trim.pl
eg/yahoogroups.pl
lib/HTTP/Proxy.pm
lib/HTTP/Proxy/BodyFilter.pm
lib/HTTP/Proxy/BodyFilter/complete.pm
lib/HTTP/Proxy/BodyFilter/htmlparser.pm
lib/HTTP/Proxy/BodyFilter/htmltext.pm
lib/HTTP/Proxy/BodyFilter/lines.pm
lib/HTTP/Proxy/BodyFilter/save.pm
lib/HTTP/Proxy/BodyFilter/simple.pm
lib/HTTP/Proxy/BodyFilter/tags.pm
lib/HTTP/Proxy/Engine.pm
lib/HTTP/Proxy/Engine/Legacy.pm
lib/HTTP/Proxy/Engine/NoFork.pm
lib/HTTP/Proxy/Engine/ScoreBoard.pm
lib/HTTP/Proxy/Engine/Threaded.pm
lib/HTTP/Proxy/FilterStack.pm
lib/HTTP/Proxy/HeaderFilter.pm
lib/HTTP/Proxy/HeaderFilter/simple.pm
lib/HTTP/Proxy/HeaderFilter/standard.pm
t/00-report-prereqs.dd
t/00-report-prereqs.t
t/00basic.t
t/05new.t
t/10init.t
t/11log.t
t/15accessors.t
t/15deprecated.t
t/16stash.t
t/17fstack.t
t/18engine.t
t/20dummy.t
t/20keepalive.t
t/22http.t
t/22transparent.t
t/23connect.t
t/23https.t
t/40push_filters.t
t/41filters.t
t/42will_modify.t
t/50hopbyhop.t
t/50standard.t
t/50via.t
t/51simple.t
t/51simple2.t
t/61simple.t
t/61simple2.t
t/64htmltext.t
t/64lines.t
t/64tags.t
t/66htmlparser.t
t/67complete.t
t/67save.t
t/71rot13.t
t/90httpstatus.t
t/README
t/Utils.pm
t/release-distmeta.t
t/release-pod-coverage.t
t/release-pod-syntax.t
t/test.html
HTTP-Proxy-0.304/Makefile.PL 0000644 0001750 0001750 00000004405 12537671053 014052 0 ustar book book # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.034.
use strict;
use warnings;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
"ABSTRACT" => "A pure Perl HTTP proxy",
"AUTHOR" => "Philippe Bruhat (BooK) ",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
},
"DISTNAME" => "HTTP-Proxy",
"EXE_FILES" => [],
"LICENSE" => "perl",
"NAME" => "HTTP::Proxy",
"PREREQ_PM" => {
"Carp" => 0,
"Exporter" => 0,
"Fcntl" => 0,
"File::Path" => 0,
"File::Spec" => 0,
"File::Temp" => 0,
"HTTP::Daemon" => 0,
"HTTP::Date" => 0,
"HTTP::Headers::Util" => 0,
"IO::Handle" => 0,
"IO::Select" => 0,
"LWP::ConnCache" => 0,
"LWP::UserAgent" => 0,
"POSIX" => 0,
"Socket" => 0,
"Sys::Hostname" => 0,
"constant" => 0,
"strict" => 0,
"vars" => 0
},
"TEST_REQUIRES" => {
"ExtUtils::MakeMaker" => 0,
"File::Find" => 0,
"File::Spec" => 0,
"File::Spec::Functions" => 0,
"HTML::Parser" => 3,
"HTTP::Headers" => 0,
"HTTP::Request" => 0,
"HTTP::Request::Common" => 0,
"IO::Socket::INET" => 0,
"Test::More" => 0,
"base" => 0,
"warnings" => 0
},
"VERSION" => "0.304",
"test" => {
"TESTS" => "t/*.t"
}
);
my %FallbackPrereqs = (
"Carp" => 0,
"Exporter" => 0,
"ExtUtils::MakeMaker" => 0,
"Fcntl" => 0,
"File::Find" => 0,
"File::Path" => 0,
"File::Spec" => 0,
"File::Spec::Functions" => 0,
"File::Temp" => 0,
"HTML::Parser" => 3,
"HTTP::Daemon" => 0,
"HTTP::Date" => 0,
"HTTP::Headers" => 0,
"HTTP::Headers::Util" => 0,
"HTTP::Request" => 0,
"HTTP::Request::Common" => 0,
"IO::Handle" => 0,
"IO::Select" => 0,
"IO::Socket::INET" => 0,
"LWP::ConnCache" => 0,
"LWP::UserAgent" => 0,
"POSIX" => 0,
"Socket" => 0,
"Sys::Hostname" => 0,
"Test::More" => 0,
"base" => 0,
"constant" => 0,
"strict" => 0,
"vars" => 0,
"warnings" => 0
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
delete $WriteMakefileArgs{TEST_REQUIRES};
delete $WriteMakefileArgs{BUILD_REQUIRES};
$WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
HTTP-Proxy-0.304/lib/ 0000755 0001750 0001750 00000000000 12537671053 012643 5 ustar book book HTTP-Proxy-0.304/lib/HTTP/ 0000755 0001750 0001750 00000000000 12537671053 013422 5 ustar book book HTTP-Proxy-0.304/lib/HTTP/Proxy/ 0000755 0001750 0001750 00000000000 12537671053 014543 5 ustar book book HTTP-Proxy-0.304/lib/HTTP/Proxy/Engine/ 0000755 0001750 0001750 00000000000 12537671053 015750 5 ustar book book HTTP-Proxy-0.304/lib/HTTP/Proxy/Engine/ScoreBoard.pm 0000644 0001750 0001750 00000020210 12537671053 020324 0 ustar book book package HTTP::Proxy::Engine::ScoreBoard;
$HTTP::Proxy::Engine::ScoreBoard::VERSION = '0.304';
use strict;
use POSIX ":sys_wait_h"; # WNOHANG
use Fcntl qw(LOCK_UN LOCK_EX);
use IO::Handle;
use File::Temp;
use HTTP::Proxy;
our @ISA = qw( HTTP::Proxy::Engine );
our %defaults = (
start_servers => 4, # start this many, and don't go below
max_clients => 12, # don't go above
max_requests_per_child => 250, # just in case there's a leak
min_spare_servers => 1, # minimum idle (if 0, never start new)
max_spare_servers => 12, # maximum idle (should be "single browser max")
verify_delay => 60, # minimum time between kids verification
);
__PACKAGE__->make_accessors(
qw(
kids select status_read status_write scoreboard tempfile
verify_live_kids_time last_active_time last_fork_time
),
keys %defaults
);
sub start {
my $self = shift;
$self->kids( {} );
# set up the communication pipe
$self->status_read( IO::Handle->new() );
$self->status_write( IO::Handle->new() );
pipe( $self->status_read(), $self->status_write() )
or die "Can't create pipe: $!";
$self->status_write()->autoflush(1);
$self->select( IO::Select->new( $self->status_read() ) );
setpgrp; # set as group leader
# scoreboard information
$self->verify_live_kids_time( time );
$self->last_active_time( time );
$self->last_fork_time( time );
$self->scoreboard( '' );
# lockfile information
$self->tempfile(
File::Temp->new( UNLINK => 0, TEMPLATE => 'http-proxy-XXXX' ) );
$self->proxy()->log( HTTP::Proxy::ENGINE, "ENGINE",
"Using " . $self->tempfile()->filename() . " as lockfile" );
}
my %status = ( A => 'Acccept', B => 'Busy', I => 'Idle' );
sub run {
my $self = shift;
my $proxy = $self->proxy();
my $kids = $self->kids();
## first phase: update scoreboard
if ( $self->select()->can_read(1) ) {
$self->status_read()->sysread( my $buf, 50 ) > 0 # read first 10 changes
or die "bad read"; # FIXME
while ( length $buf ) {
my ( $pid, $status ) = unpack "NA", substr( $buf, 0, 5, "" );
$proxy->log( HTTP::Proxy::ENGINE, 'ENGINE',
"Child process $pid updated to $status ($status{$status})" );
$kids->{$pid} = $status;
}
$self->last_active_time(time);
}
{
my $new = join "", values %$kids;
if ( $new ne $self->scoreboard() ) {
$proxy->log( HTTP::Proxy::ENGINE, 'ENGINE', "ScoreBoard = $new" );
$self->scoreboard($new);
}
}
## second phase: delete dead kids
while ( ( my $kid = waitpid( -1, WNOHANG ) ) > 0 ) {
$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",
keys(%$kids) . " remaining kids: @{[ keys %$kids ]}" );
delete $kids->{$kid};
}
## third phase: verify live kids
if ( time > $self->verify_live_kids_time() + $self->verify_delay() ) {
for my $kid ( keys %$kids ) {
next if kill 0, $kid;
# shouldn't happen normally
$proxy->log( HTTP::Proxy::ERROR, "ENGINE",
"Child process $kid found missing" );
delete $kids->{$kid};
}
$self->verify_live_kids_time(time);
}
## fourth phase: launch kids
my @idlers = grep $kids->{$_} eq "I", keys %$kids;
if (
(
@idlers < $self->min_spare_servers() # not enough idlers
or keys %$kids < $self->start_servers() # not enough overall
)
and keys %$kids < $self->max_clients() # not too many please
and time > $self->last_fork_time() # not too fast please
)
{
my $child = fork();
if ( !defined $child ) {
$proxy->log( HTTP::Proxy::ERROR, "PROCESS", "Cannot fork" );
}
else {
if ($child) {
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
"Forked child process $child" );
$kids->{$child} = "I";
$self->last_fork_time(time);
}
else { # child process
$self->_run_child();
exit; # we're done
}
}
}
elsif (
(
@idlers > $self->max_spare_servers() # too many idlers
or @idlers > $self->min_spare_servers() # too many lazy idlers
and time > $self->last_active_time + $self->verify_delay()
)
and keys %$kids > $self->start_servers() # not too few please
)
{
my $victim = $idlers[ rand @idlers ];
$proxy->log( HTTP::Proxy::ENGINE, "ENGINE",
"Killing idle child process $victim" );
kill INT => $victim; # pick one at random
$self->last_active_time(time);
}
}
sub stop {
my $self = shift;
my $kids = $self->kids();
my $proxy = $self->proxy();
kill 'INT' => keys %$kids;
# wait for remaining children
while (%$kids) {
my $pid = waitpid( -1, WNOHANG );
next unless $pid;
$proxy->{conn}++; # WRONG for this engine!
delete $kids->{$pid};
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
"Reaped child process $pid" );
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
keys(%$kids) . " remaining kids: @{[ keys %$kids ]}" );
}
# remove the temporary file
unlink $self->tempfile()->filename() or do {
$proxy->log( HTTP::Proxy::ERROR, "ERROR",
"Can't unlink @{[ $self->tempfile()->filename() ]}: $!" );
};
}
sub _run_child {
my $self = shift;
my $proxy = $self->proxy();
my $daemon = $proxy->daemon();
my $status_write = $self->status_write();
open my $lockfh, $self->tempfile()->filename() or do {
$proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot open lock file: $!" );
exit;
};
my $did = 0; # processed count
while ( ++$did <= $self->max_requests_per_child() ) {
flock $lockfh, LOCK_EX or do {
$proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot get flock: $!" );
exit;
};
last unless $proxy->loop();
5 == syswrite $status_write, pack "NA", $$, "A" # go accept
or $proxy->log( HTTP::Proxy::ERROR, "ERROR", "status A: short write");
my $slave = $daemon->accept() or do {
$proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot accept: $!");
exit;
};
flock $lockfh, LOCK_UN or do {
$proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot unflock: $!" );
exit;
};
5 == syswrite $status_write, pack "NA", $$, "B" # go busy
or $proxy->log( HTTP::Proxy::ERROR, "ERROR", "status B: short write");
$slave->autoflush(1);
$proxy->serve_connections($slave); # the real work is done here
close $slave;
5 == syswrite $status_write, pack "NA", $$, "I" # go idle
or $proxy->log( HTTP::Proxy::ERROR, "ERROR", "status I: short write");
}
}
1;
__END__
=head1 NAME
HTTP::Proxy::Engine::ScoreBoard - A scoreboard-based HTTP::Proxy engine
=head1 SYNOPSIS
my $proxy = HTTP::Proxy->new( engine => 'ScoreBoard' );
=head1 DESCRIPTION
This module provides a scoreboard-based engine to L.
=head1 METHODS
The module defines the following methods, used by L main loop:
=over 4
=item start()
Initialise the engine.
=item run()
Implements the forking logic: a new process is forked for each new
incoming TCP connection.
=item stop()
Reap remaining child processes.
=back
=head1 SEE ALSO
L, L.
=head1 AUTHOR
Philippe "BooK" Bruhat, C<< >>.
Many thanks to Randal L. Schwartz for his help in implementing this module.
=head1 COPYRIGHT
Copyright 2005-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/Engine/Legacy.pm 0000644 0001750 0001750 00000010262 12537671053 017513 0 ustar book book package HTTP::Proxy::Engine::Legacy;
$HTTP::Proxy::Engine::Legacy::VERSION = '0.304';
use strict;
use POSIX 'WNOHANG';
use HTTP::Proxy;
our @ISA = qw( HTTP::Proxy::Engine );
our %defaults = (
max_clients => 12,
);
__PACKAGE__->make_accessors( qw( kids select ), keys %defaults );
sub start {
my $self = shift;
$self->kids( [] );
$self->select( IO::Select->new( $self->proxy->daemon ) );
}
sub run {
my $self = shift;
my $proxy = $self->proxy;
my $kids = $self->kids;
# check for new connections
my @ready = $self->select->can_read(1);
for my $fh (@ready) { # there's only one, anyway
# single-process proxy (useful for debugging)
if ( $self->max_clients == 0 ) {
$proxy->max_keep_alive_requests(1); # do not block simultaneous connections
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
"No fork allowed, serving the connection" );
$proxy->serve_connections($fh->accept);
$proxy->new_connection;
next;
}
if ( @$kids >= $self->max_clients ) {
$proxy->log( HTTP::Proxy::ERROR, "PROCESS",
"Too many child process, serving the connection" );
$proxy->serve_connections($fh->accept);
$proxy->new_connection;
next;
}
# accept the new connection
my $conn = $fh->accept;
my $child = fork;
if ( !defined $child ) {
$conn->close;
$proxy->log( HTTP::Proxy::ERROR, "PROCESS", "Cannot fork" );
$self->max_clients( $self->max_clients - 1 )
if $self->max_clients > @$kids;
next;
}
# the parent process
if ($child) {
$conn->close;
$proxy->log( HTTP::Proxy::PROCESS, "PROCESS", "Forked child process $child" );
push @$kids, $child;
}
# the child process handles the whole connection
else {
$SIG{INT} = 'DEFAULT';
$proxy->serve_connections($conn);
exit; # let's die!
}
}
$self->reap_zombies if @$kids;
}
sub stop {
my $self = shift;
my $kids = $self->kids;
# wait for remaining children
# EOLOOP
kill INT => @$kids;
$self->reap_zombies while @$kids;
}
# private reaper sub
sub reap_zombies {
my $self = shift;
my $kids = $self->kids;
my $proxy = $self->proxy;
while (1) {
my $pid = waitpid( -1, WNOHANG );
last if $pid == 0 || $pid == -1; # AS/Win32 returns negative PIDs
@$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", @$kids . " remaining kids: @$kids" );
}
}
1;
__END__
=head1 NAME
HTTP::Proxy::Engine::Legacy - The "older" HTTP::Proxy engine
=head1 SYNOPSIS
my $proxy = HTTP::Proxy->new( engine => 'Legacy' );
=head1 DESCRIPTION
This engine reproduces the older child creation algorithm of L.
Angelos Karageorgiou C<< >> reports:
I with the following trick:>
max_keep_alive_requests(1);
max_clients(120);
$HTTP::VERSION(1.0); # just in case
I
Id requests!>
=head1 METHODS
The module defines the following methods, used by L main loop:
=over 4
=item start()
Initialise the engine.
=item run()
Implements the forking logic: a new process is forked for each new
incoming TCP connection.
=item stop()
Reap remaining child processes.
=back
The following method is used by the engine internally:
=over 4
=item reap_zombies()
Process the dead child processes.
=back
=head1 SEE ALSO
L, L.
=head1 AUTHOR
Philippe "BooK" Bruhat, C<< >>.
=head1 COPYRIGHT
Copyright 2005-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/Engine/NoFork.pm 0000644 0001750 0001750 00000002705 12537671053 017510 0 ustar book book package HTTP::Proxy::Engine::NoFork;
$HTTP::Proxy::Engine::NoFork::VERSION = '0.304';
use strict;
our @ISA = qw( HTTP::Proxy::Engine );
__PACKAGE__->make_accessors( 'select' );
sub start {
my $self = shift;
my $proxy = $self->proxy;
$self->select( IO::Select->new( $proxy->daemon ) );
# clients will not block the proxy by keeping the connection open
$proxy->max_keep_alive_requests( 1 );
}
sub run {
my $self = shift;
my $proxy = $self->proxy;
# check for new connections
for my $fh ( $self->select->can_read() ) { # there's only one, anyway
# single-process proxy
$proxy->serve_connections( $fh->accept );
$proxy->new_connection;
}
}
1;
__END__
=head1 NAME
HTTP::Proxy::Engine::NoFork - A basic, non forking HTTP::Proxy engine
=head1 SYNOPSIS
use HTTP::Proxy;
my $proxy = HTTP::Proxy->new( engine => 'NoFork' );
=head1 DESCRIPTION
The L engine runs the proxy without forking.
=head1 METHODS
=over 4
=item start()
Initialise the engine.
=item run()
Implements the non-forking logic by calling C<< $proxy->serve_requests() >>
directly.
=back
=head1 SEE ALSO
L, L.
=head1 AUTHOR
Philippe "BooK" Bruhat, C<< >>.
=head1 COPYRIGHT
Copyright 2005-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/Engine/Threaded.pm 0000644 0001750 0001750 00000004746 12537671053 020041 0 ustar book book package HTTP::Proxy::Engine::Threaded;
$HTTP::Proxy::Engine::Threaded::VERSION = '0.304';
use strict;
use HTTP::Proxy;
my $can_use_threads;
BEGIN {
$can_use_threads = eval 'use threads; 1';
}
# A massive hack of Engine::Fork to use the threads stuff
# Basically created to work under win32 so that the filters
# can share global caches among themselves
# Angelos Karageorgiou angelos@unix.gr
our @ISA = qw( HTTP::Proxy::Engine );
our %defaults = (
max_clients => 60,
);
__PACKAGE__->make_accessors( qw( kids select ), keys %defaults );
sub new {
die "This Perl not built to support threads"
if !$can_use_threads;
shift->SUPER::new(@_);
}
sub start {
my $self = shift;
$self->kids( [] );
$self->select( IO::Select->new( $self->proxy->daemon ) );
}
sub run {
my $self = shift;
my $proxy = $self->proxy;
my $kids = $self->kids;
# check for new connections
my @ready = $self->select->can_read(1);
for my $fh (@ready) { # there's only one, anyway
# single-process proxy (useful for debugging)
# accept the new connection
my $conn = $fh->accept;
my $child=threads->new(\&_worker,$proxy,$conn);
if ( !defined $child ) {
$conn->close;
$proxy->log( HTTP::Proxy::ERROR, "PROCESS", "Cannot spawn thread" );
next;
}
$child->detach();
}
}
sub stop {
my $self = shift;
my $kids = $self->kids;
# not needed
}
sub _worker {
my $proxy=shift;
my $conn=shift;
$proxy->serve_connections($conn);
$conn->close();
return;
}
1;
__END__
=head1 NAME
HTTP::Proxy::Engine::Threaded - A scoreboard-based HTTP::Proxy engine
=head1 SYNOPSIS
my $proxy = HTTP::Proxy->new( engine => 'Threaded' );
=head1 DESCRIPTION
This module provides a threaded engine to L.
=head1 METHODS
The module defines the following methods, used by L main loop:
=over 4
=item start()
Initialize the engine.
=item run()
Implements the forking logic: a new process is forked for each new
incoming TCP connection.
=item stop()
Reap remaining child processes.
=back
=head1 SEE ALSO
L, L.
=head1 AUTHORS
Angelos Karageorgiou C<< >>. (Actual code)
Philippe "BooK" Bruhat, C<< >>. (Documentation)
=head1 COPYRIGHT
Copyright 2010-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/BodyFilter.pm 0000644 0001750 0001750 00000017020 12537671053 017144 0 ustar book book package HTTP::Proxy::BodyFilter;
$HTTP::Proxy::BodyFilter::VERSION = '0.304';
use strict;
use Carp;
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->init(@_) if $self->can('init');
return $self;
}
sub proxy {
my ( $self, $new ) = @_;
return $new ? $self->{_hpbf_proxy} = $new : $self->{_hpbf_proxy};
}
sub filter {
croak "HTTP::Proxy::HeaderFilter cannot be used as a filter";
}
sub will_modify { 1 } # by default, we expect the filter to modify data
1;
__END__
=head1 NAME
HTTP::Proxy::BodyFilter - A base class for HTTP messages body filters
=head1 SYNOPSIS
package MyFilter;
use base qw( HTTP::Proxy::BodyFilter );
# a simple modification, that may break things
sub filter {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
$$dataref =~ s/PERL/Perl/g;
}
1;
=head1 DESCRIPTION
The L class is used to create filters for
HTTP request/response body data.
=head2 Creating a BodyFilter
A BodyFilter is just a derived class that implements some methods
called by the proxy. Of all the methods presented below, only
C B be defined in the derived class.
=over 4
=item filter()
The signature of the filter() method is the following:
sub filter {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
...
}
where C<$self> is the filter object, C<$dataref> is a reference to the chunk
of body data received,
C<$message> is a reference to either a L or a L
object, and C<$protocol> is a reference to the L protocol object.
Note that this subroutine signature looks a lot like that of the call-
backs of L (except that C<$message> is either a L
or a L object).
C<$buffer> is a reference to a buffer where some of the unprocessed data
can be stored for the next time the filter will be called (see L for details). Thanks to the
built-in HTTP::Proxy::BodyFilter::* filters, this is rarely needed.
It is possible to access the headers of the message with
C<< $message->headers() >>. This L object is the one
that was sent to the client
(if the filter is on the response stack) or origin server (if the filter
is on the request stack). Modifying it in the C method is useless,
since the headers have already been sent.
Since C<$dataref> is a I to the data string, the referent
can be modified and the changes will be transmitted through the
filters that follows, until the data reaches its recipient.
A L object is a blessed hash, and the base class
reserves only hash keys that start with C<_hpbf>.
=item new()
The constructor is defined for all subclasses. Initialisation tasks
(if any) for subclasses should be done in the C method (see below).
=item init()
This method is called by the C constructeur to perform all
initisalisation tasks. It's called once in the filter lifetime.
It receives all the parameters passed to C.
=item begin()
Some filters might require initialisation before they are able to handle
the data. If a C method is defined in your subclass, the proxy
will call it before sending data to the C method.
It's called once per HTTP message handled by the filter, before data
processing begins.
The method signature is as follows:
sub begin {
my ( $self, $message ) = @_
...
}
=item end()
Some filters might require finalisation after they are finished handling
the data. If a C method is defined in your subclass, the proxy
will call it after it has finished sending data to the C method.
It's called once per HTTP message handled by the filter, after all data
processing is done.
This method does not expect any parameters.
=item will_modify()
This method return a boolean value that indicate if the filter will
modify the body data on the fly.
The default implementation returns a I value.
=back
=head2 Using a buffer to store data for a later use
Some filters cannot handle arbitrary data: for example a filter that
basically lowercases tag name will apply a simple regex
such as C\s*(\w+)([^E]*)E/E\L$1\E$2E/g>.
But the filter will fail is the chunk of data contains a tag
that is cut before the final C>.
It would be extremely complicated and error-prone to let each filter
(and its author) do its own buffering, so the L architecture
handles this too. The proxy passes to each filter, each time it is called,
a reference to an empty string (C<$buffer> in the above signature) that
the filter can use to store some data for next run.
When the reference is C, it means that the filter cannot
store any data, because this is the very last run, needed to gather
all the data left in all buffers.
It is recommended to store as little data as possible in the buffer,
so as to avoid (badly) reproducing what L
does.
In particular, you have to remember that all the data that remains in
the buffer after the last piece of data is received from the origin
server will be sent back to your filter in one big piece.
=head2 The store and forward approach
L implements a I mechanism, for those filters
which need to have the whole message body to work. It's enabled simply by
pushing the L filter on the filter stack.
The data is stored in memory by the "complete" filter, which passes it
on to the following filter once the full message body has been received.
=head2 Standard BodyFilters
Standard L classes are lowercase.
The following BodyFilters are included in the L distribution:
=over 4
=item lines
This filter makes sure that the next filter in the filter chain will
only receive complete lines. The "chunks" of data received by the
following filters with either end with C<\n> or will be the last
piece of data for the current HTTP message body.
=item htmltext
This class lets you create a filter that runs a given code reference
against text included in a HTML document (outside CscriptE>
and CstyleE> tags). HTML entities are not included in the text.
=item htmlparser
Creates a filter from a HTML::Parser object.
=item simple
This class lets you create a simple body filter from a code reference.
=item save
Store the message body to a file.
=item complete
This filter stores the whole message body in memory, thus allowing
some actions to be taken only when the full page has been received
by the proxy.
=item tags
The L filter makes sure that the next filter
in the filter chain will only receive complete tags. The current
implementation is not 100% perfect, though.
=back
Please read each filter's documentation for more details about their use.
=head1 USEFUL METHODS FOR SUBCLASSES
Some methods are available to filters, so that they can eventually use
the little knowledge they might have of HTTP::Proxy's internals. They
mostly are accessors.
=over 4
=item proxy()
Gets a reference to the L objects that owns the filter.
This gives access to some of the proxy methods.
=back
=head1 AUTHOR
Philippe "BooK" Bruhat, Ebook@cpan.orgE.
=head1 SEE ALSO
L, L.
=head1 COPYRIGHT
Copyright 2003-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/HeaderFilter/ 0000755 0001750 0001750 00000000000 12537671053 017101 5 ustar book book HTTP-Proxy-0.304/lib/HTTP/Proxy/HeaderFilter/simple.pm 0000644 0001750 0001750 00000006211 12537671053 020730 0 ustar book book package HTTP::Proxy::HeaderFilter::simple;
$HTTP::Proxy::HeaderFilter::simple::VERSION = '0.304';
use strict;
use Carp;
use HTTP::Proxy::HeaderFilter;
use vars qw( @ISA );
@ISA = qw( HTTP::Proxy::HeaderFilter );
my $methods = join '|', qw( begin filter end );
$methods = qr/^(?:$methods)$/;
sub init {
my $self = shift;
croak "Constructor called without argument" unless @_;
if ( @_ == 1 ) {
croak "Single parameter must be a CODE reference"
unless ref $_[0] eq 'CODE';
$self->{_filter} = $_[0];
}
else {
$self->{_filter} = sub { }; # default
while (@_) {
my ( $name, $code ) = splice @_, 0, 2;
# basic error checking
croak "Parameter to $name must be a CODE reference"
unless ref $code eq 'CODE';
croak "Unkown method $name" unless $name =~ $methods;
$self->{"_$name"} = $code;
}
}
}
# transparently call the actual methods
sub begin { goto &{ $_[0]{_begin} }; }
sub filter { goto &{ $_[0]{_filter} }; }
sub end { goto &{ $_[0]{_end} }; }
sub can {
my ( $self, $method ) = @_;
return $method =~ $methods
? $self->{"_$method"}
: UNIVERSAL::can( $self, $method );
}
1;
__END__
=head1 NAME
HTTP::Proxy::HeaderFilter::simple - A class for creating simple filters
=head1 SYNOPSIS
use HTTP::Proxy::HeaderFilter::simple;
# a simple User-Agent filter
my $filter = HTTP::Proxy::HeaderFilter::simple->new(
sub { $_[1]->header( User_Agent => 'foobar/1.0' ); }
);
$proxy->push_filter( request => $filter );
=head1 DESCRIPTION
L can create BodyFilter without going
through the hassle of creating a full-fledged class. Simply pass
a code reference to the C method of your filter to the constructor,
and you'll get the adequate filter.
=head2 Constructor calling convention
The constructor is called with a single code reference.
The code reference must conform to the standard C signature
for header filters:
sub filter { my ( $self, $headers, $message) = @_; ... }
This code reference is used for the C method.
=head1 METHODS
This filter "factory" defines the standard L
methods, but those are only, erm, "proxies" to the actual CODE references
passed to the constructor. These "proxy" methods are:
=over 4
=item filter()
=item begin()
=item end()
=back
Two other methods are actually L methods,
and are called automatically:
=over 4
=item init()
Initalise the filter instance with the code references passed to the
constructor.
=item can()
Return the actual code reference that will be run, and not the "proxy"
methods. If called with any other name than C and C,
it calls C instead.
=back
=head1 SEE ALSO
L, L.
=head1 AUTHOR
Philippe "BooK" Bruhat, Ebook@cpan.orgE.
=head1 COPYRIGHT
Copyright 2003-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/HeaderFilter/standard.pm 0000644 0001750 0001750 00000010666 12537671053 021250 0 ustar book book package HTTP::Proxy::HeaderFilter::standard;
$HTTP::Proxy::HeaderFilter::standard::VERSION = '0.304';
use strict;
use HTTP::Proxy;
use HTTP::Headers::Util qw( split_header_words );
use HTTP::Proxy::HeaderFilter;
use vars qw( @ISA );
@ISA = qw( HTTP::Proxy::HeaderFilter );
# known hop-by-hop headers
my @hopbyhop =
qw( Connection Keep-Alive Proxy-Authenticate Proxy-Authorization
TE Trailers Transfer-Encoding Upgrade Proxy-Connection Public );
# standard proxy header filter (RFC 2616)
sub filter {
my ( $self, $headers, $message ) = @_;
# the Via: header
my $via = $message->protocol() || '';
if ( $self->proxy->via and $via =~ s!HTTP/!! ) {
$via .= " " . $self->proxy->via;
$headers->header(
Via => join ', ',
$message->headers->header('Via') || (), $via
);
}
# the X-Forwarded-For header
$headers->push_header(
X_Forwarded_For => $self->proxy->client_socket->peerhost )
if $message->isa( 'HTTP::Request' ) && $self->proxy->x_forwarded_for;
# make a list of hop-by-hop headers
my %h2h = map { (lc) => 1 } @hopbyhop;
my $hop = HTTP::Headers->new();
my $client = HTTP::Headers->new();
$h2h{ lc $_->[0] } = 1
for map { split_header_words($_) } $headers->header('Connection');
# hop-by-hop headers are set aside
# as well as LWP::UserAgent Client-* headers
$headers->scan(
sub {
my ( $k, $v ) = @_;
if ( $h2h{lc $k} ) {
$hop->push_header( $k => $v );
$headers->remove_header($k);
}
if( $k =~ /^Client-/ ) {
$client->push_header( $k => $v );
$headers->remove_header($k);
}
}
);
# set the hop-by-hop and client headers in the proxy
# only the end-to-end headers are left in the message
$self->proxy->hop_headers($hop);
$self->proxy->client_headers($client);
# handle Max-Forwards
if ( $message->isa('HTTP::Request')
and defined $headers->header('Max-Forwards') ) {
my ( $max, $method ) =
( $headers->header('Max-Forwards'), $message->method );
if ( $max == 0 ) {
# answer directly TRACE ou OPTIONS
if ( $method eq 'TRACE' ) {
my $response =
HTTP::Response->new( 200, 'OK',
HTTP::Headers->new( Content_Type => 'message/http'
, Content_Length => 0),
$message->as_string );
$self->proxy->response($response);
}
elsif ( $method eq 'OPTIONS' ) {
my $response = HTTP::Response->new(200);
$response->header( Allow => join ', ', @HTTP::Proxy::METHODS );
$self->proxy->response($response);
}
}
# The Max-Forwards header field MAY be ignored for all
# other methods defined by this specification (RFC 2616)
elsif ( $method =~ /^(?:TRACE|OPTIONS)/ ) {
$headers->header( 'Max-Forwards' => --$max );
}
}
# no encoding accepted (gzip, compress, deflate)
# if we plan to do anything with the response body
$headers->remove_header( 'Accept-Encoding' )
if @{ $self->proxy->{body}{response}{filters} };
}
1;
__END__
=head1 NAME
HTTP::Proxy::HeaderFilter::standard - An internal filter to respect RFC2616
=head1 DESCRIPTION
This is an internal filter used by HTTP::Proxy to enforce behaviour
compliant with RFC 2616.
=head1 METHOD
This filter implements a single method that is called automatically:
=over 4
=item filter()
Enforce RFC 2616-compliant behaviour, by adding the C and
C headers (except when the proxy was instructed not
to add them), decrementing the C header and removing
the hop-by-hop and L headers.
Note that the filter will automatically remove the C
headers if the proxy has at least one L filter.
(This is to ensure that the filters will receive uncompressed data.)
=back
=head1 SEE ALSO
L, L, RFC 2616.
=head1 AUTHOR
Philippe "BooK" Bruhat, Ebook@cpan.orgE.
Thanks to Gisle Aas, for directions regarding the handling of the
hop-by-hop headers.
=head1 COPYRIGHT
Copyright 2003-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/Engine.pm 0000644 0001750 0001750 00000010065 12537671053 016310 0 ustar book book package HTTP::Proxy::Engine;
$HTTP::Proxy::Engine::VERSION = '0.304';
use strict;
use Carp;
my %engines = (
MSWin32 => 'NoFork',
default => 'Legacy',
);
# required accessors
__PACKAGE__->make_accessors( qw( max_clients ));
sub new {
my $class = shift;
my %params = @_;
# the front-end
if ( $class eq 'HTTP::Proxy::Engine' ) {
my $engine = delete $params{engine};
$engine = $engines{$^O} || $engines{default}
unless defined $engine;
$class = "HTTP::Proxy::Engine::$engine";
eval "require $class";
croak $@ if $@;
}
# some error checking
croak "No proxy defined"
unless exists $params{proxy};
croak "$params{proxy} is not a HTTP::Proxy object"
unless UNIVERSAL::isa( $params{proxy}, 'HTTP::Proxy' );
# so we are an actual engine
no strict 'refs';
return bless {
%{"$class\::defaults"},
%params
}, $class;
}
# run() should be defined in subclasses
sub run {
my $self = shift;
my $class = ref $self;
croak "$class doesn't define a run() method";
}
sub proxy { $_[0]{proxy} }
# class method
sub make_accessors {
my $class = shift;
for my $attr (@_) {
no strict 'refs';
*{"$class\::$attr"} = sub {
$_[0]{$attr} = $_[1] if defined $_[1];
$_[0]{$attr};
};
}
}
1;
__END__
=head1 NAME
HTTP::Proxy::Engine - Generic child process manager engine for HTTP::Proxy
=head1 SYNOPSIS
use HTTP::Proxy;
# use the default engine for your system
my $proxy = HTTP::Proxy->new();
# choose one
my $proxy = HTTP::Proxy->new( engine => 'Old' );
=head1 DESCRIPTION
The L class is a front-end to actual proxy
engine classes.
The role of an engine is to implement the main fork+serve loop
with all the required bookkeeping. This is also a good way to
test various implementation and/or try out new algorithms
without too much difficulties.
=head1 METHODS
=over 4
=item new()
Create a new engine. The parameter C is used to decide which
kind of engine will be created. Other parameters are passed to the
underlying engine.
This method also implement the subclasses constructor (they obviously
do not need the C parameter).
=back
=head1 CREATING YOUR OWN ENGINE
It is possible to create one's own engine, by creating
a simple subclass of L with the following
methods:
=over 4
=item start()
This method should handle any initialisation required when the
engine starts.
=item run()
This method is the main loop of the master process.
It defines how child processes are forked, checked and killed.
The engine MUST have a run() method, and it will be called again
and again until the proxy exits.
C<< $self->proxy->daemon >> returns the listening socket that can C
connections. The child must call C<< $self->proxy->serve_connections() >>
on the returned socket to handle actual TCP connections.
=item stop()
This optional method should handle any cleanup procedures when the
engine stops (typically when the main proxy process is killed).
=back
A subclass may also define a C<%defaults> hash (with C) that
contains the default values for the fields used internaly.
=head1 METHODS PROVIDED TO SUBCLASSES
L provides the following methods to its
subclasses:
=over 4
=item proxy()
Return the L object that runs the engine.
=item max_clients()
Get or set the maximum number of TCP clients, that is to say
the maximum number of forked child process.
Some engines may understand a value of C<0> as I.
This is what L does.
=item make_accessors( @names )
Create accessors named after C<@names> in the subclass package.
All accessors are read/write. This is a utility method.
B
=back
=head1 AUTHOR
Philippe "BooK" Bruhat, C<< >>.
=head1 COPYRIGHT
Copyright 2005-2015, Philippe Bruhat.
=head1 LICENSE
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
=cut
HTTP-Proxy-0.304/lib/HTTP/Proxy/BodyFilter/ 0000755 0001750 0001750 00000000000 12537671053 016606 5 ustar book book HTTP-Proxy-0.304/lib/HTTP/Proxy/BodyFilter/htmlparser.pm 0000644 0001750 0001750 00000007624 12537671053 021336 0 ustar book book package HTTP::Proxy::BodyFilter::htmlparser;
$HTTP::Proxy::BodyFilter::htmlparser::VERSION = '0.304';
use strict;
use Carp;
use HTTP::Proxy::BodyFilter;
use vars qw( @ISA );
@ISA = qw( HTTP::Proxy::BodyFilter );
sub init {
croak "First parameter must be a HTML::Parser object"
unless $_[1]->isa('HTML::Parser');
my $self = shift;
$self->{_parser} = shift;
my %args = (@_);
$self->{rw} = delete $args{rw};
}
sub filter {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
@{ $self->{_parser} }{qw( output message protocol )} =
( "", $message, $protocol );
$self->{_parser}->parse($$dataref);
$self->{_parser}->eof if not defined $buffer; # last chunk
$$dataref = $self->{_parser}{output} if $self->{rw};
}
sub will_modify { $_[0]->{rw} }
1;
__END__
=head1 NAME
HTTP::Proxy::BodyFilter::htmlparser - Filter using HTML::Parser
=head1 SYNOPSIS
use HTTP::Proxy::BodyFilter::htmlparser;
# $parser is a HTML::Parser object
$proxy->push_filter(
mime => 'text/html',
response => HTTP::Proxy::BodyFilter::htmlparser->new( $parser );
);
=head1 DESCRIPTION
The L lets you create a
filter based on the L object of your choice.
This filter takes a L object as an argument to its constructor.
The filter is either read-only or read-write. A read-only filter will
not allow you to change the data on the fly. If you request a read-write
filter, you'll have to rewrite the response-body completely.
With a read-write filter, you B recreate the whole body data. This
is mainly due to the fact that the L has its own buffering
system, and that there is no easy way to correlate the data that triggered
the L event and its original position in the chunk sent by the
origin server. See below for details.
Note that a simple filter that modify the HTML text (not the tags) can
be created more easily with L.
=head2 Creating a HTML::Parser that rewrites pages
A read-write filter is declared by passing C 1> to the constructor:
HTTP::Proxy::BodyFilter::htmlparser->new( $parser, rw => 1 );
To be able to modify the body of a message, a filter created with
L must rewrite it completely. The
L object can update a special attribute named C