/lib/HTTPD/ADS/OpenProxyDetector.pm

https://github.com/gitpan/HTTPD-ADS · Perl · 142 lines · 86 code · 49 blank · 7 comment · 7 complexity · ab39052ae8ff8e7c1e651df71ecc5db1 MD5 · raw file

  1. package HTTPD::ADS::OpenProxyDetector;
  2. use strict;
  3. use LWP::UserAgent;
  4. BEGIN {
  5. use Exporter ();
  6. use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  7. $VERSION = 0.2;
  8. @ISA = qw (Exporter);
  9. #Give a hoot don't pollute, do not export more than needed by default
  10. @EXPORT = qw ();
  11. @EXPORT_OK = qw ();
  12. %EXPORT_TAGS = ();
  13. }
  14. ########################################### main pod documentation begin ##
  15. # Below is the stub of documentation for your module. You better edit it!
  16. =head1 NAME
  17. HTTPD::ADS::OpenProxyDetector - Determine if a ip address is an open proxy, log in database
  18. =head1 SYNOPSIS
  19. use HTTPD::ADS::OpenProxyDetector
  20. =head1 DESCRIPTION
  21. This module uses LWP to test the supplied IP address to see if it will
  22. promiscuosly proxy on port 80. Caution: this can have false alarms if
  23. you are on a network where you are supposed to go through a proxy,
  24. such as AOL -- but are you supposed to be running a webserver on such
  25. a network ?
  26. =head1 USAGE
  27. $test_result = HTTPD::ADS::OpenProxyDetector->test($ip);
  28. =head1 BUGS
  29. =head1 SUPPORT
  30. =head1 AUTHOR
  31. Dana Hudes
  32. CPAN ID: DHUDES
  33. dhudes@hudes.org
  34. http://www.hudes.org
  35. =head1 COPYRIGHT
  36. This program is free software licensed under the...
  37. The General Public License (GPL)
  38. Version 2, June 1991
  39. The full text of the license can be found in the
  40. LICENSE file included with this module.
  41. =head1 SEE ALSO
  42. HTTPD::ADS, LWP, perl(1).
  43. =cut
  44. ############################################# main pod documentation end ##
  45. ################################################ subroutine header begin ##
  46. =head2 test
  47. Usage : test($ip)
  48. Purpose : tries to fetch a known web page via the supplied ip as proxy.
  49. Returns : true (proxy fetch successful) or false (it failed to fetch)
  50. Argument : IPv4
  51. Throws : We should probably throw an exception if the ip address under test is unreachable
  52. Comments : Not all open proxies or compromised hosts listen on port 80 and their are other means
  53. than straightforward HTTP to communicate with zombies but this is a start.
  54. See Also : HTTPD::ADS::AbuseNotify for sending complaints about validated proxies and other abuse.
  55. =cut
  56. ################################################## subroutine header end ##
  57. sub new
  58. {
  59. my ($class, $ip) = @_;
  60. my $self = bless ({}, ref ($class) || $class);
  61. $self->test($ip);
  62. return ($self);
  63. }
  64. {
  65. my $response;
  66. sub get_response {
  67. return $response;
  68. }
  69. sub _set_response {
  70. my ($self,$param) = @_;
  71. $response = $param || die "OpenPrexyDetector - no response to store";
  72. }
  73. }
  74. sub test {
  75. my $self = shift;
  76. my $ip = shift || die "no ip address supplied to test";
  77. my $browser = LWP::UserAgent->new(timeout =>10, max_size =>2048, requests_redirectable => []);#fixme -- come back later and stuff in a fake agent name
  78. $browser->proxy("http","http://$ip");
  79. my $response = $browser->head("http://www.hudes.org/");
  80. $self->_set_response($response);
  81. return $response->code();
  82. }
  83. sub guilty {
  84. my $self = shift;
  85. #we should get an error if its not an open proxy; informational etc. is not the right thing....
  86. return ! ( ($self->get_response)->is_error);
  87. }
  88. sub code {
  89. my $self = shift;
  90. return ($self->get_response)->code();
  91. }
  92. 1; #this line is important and will help the module return a true value
  93. __END__