Skip Menu |
 

This queue is for tickets about the Authen-Simple-HTTP CPAN distribution.

Report information
The Basics
Id: 26468
Status: new
Priority: 0/
Queue: Authen-Simple-HTTP

People
Owner: Nobody in particular
Requestors: GIFF [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)

Attachments


Subject: Configure agent from httpd.conf, choose method
Download (untitled) / with headers
text/plain 1.4k
Here's another patch. This adds two features to Authen::Simple::HTTP. First, it takes a string argument agentclass, which can be set in httpd.conf. It describes how the agent should be created. Here's an excerpt from the docs: If the class name is alone, the object will be created by calling its constructor new. If it is followed by a space but no opening parentheses, the remainder of the string will be treated as a space-seperated list of arguments to be passed to the constructor C<new>. If it is followed by a space, an optional constructor name, then a parenthesized string, the object will be created by calling the named constructor, or new if no constructor is named, and processing the remainder of the string as arguments to the constructor with eval. Mostly all of this allows you to create an agent from your httpd.conf file. All of these will create an agent with keep_alive turned off: PerlSetVar AuthenSimpleMyHTTP_agentclass "LWP::UserAgent new(keep_alive => 1)" PerlSetVar AuthenSimpleMyHTTP_agentclass "LWP::UserAgent (keep_alive => 1)" PerlSetVar AuthenSimpleMyHTTP_agentclass "LWP::UserAgent keep_alive 1" Second, it creates a string argument "method" which controls the method to use in testing the authentication. It defaults to "head", but can be set to "get". Both of these changes were necessary to authenticate to a quirky backend Web server, which did not work with cookies enabled, and also did not respond properly to HEAD requests.
Subject: authen-simple-httpd-sg.patch
--- HTTP.pm 2007-04-17 23:29:56.000000000 -0400 +++ MyHTTP.pm 2007-04-18 01:01:47.000000000 -0400 @@ -23,9 +23,58 @@ timeout => 30 ), optional => 1 - } + }, + agentclass => { + type => Params::Validate::SCALAR, + optional => 1 + }, + method => { + type => Params::Validate::SCALAR, + default => 'head' + }, }); +our %agentclass_loaded; +our %agent_cache; + +sub init +{ + my $class = shift; + my $self = $class->SUPER::init(@_); + if ($self->agentclass) { + if ($agent_cache{$self->agentclass}) { + $self->agent($agent_cache{$self->agentclass}); + } else { + my($agentclass,$args)=split(' ',$self->agentclass,2); + if (!$agentclass_loaded{$agentclass}) { + eval "use $agentclass;"; + if ($@) { + die "Error including '@{[$self->agentclass]}': $@"; + } + } + if ($args =~ /^\s*(\w*)\s*\((.*)\)\s*$/) + { + if ($1 eq '') { $args = "new$args"; } + my $dothis = "\$self->agent($agentclass->$args);"; + eval $dothis; + if ($@) { + die "Error executing '$dothis': $@"; + } + } + else + { + $self->agent($agentclass->new(split(' ',$args))); + } + $agent_cache{$self->agentclass}=$self->agent; + } + } + + if (!$self->agent->can($self->method)) { + die "Invalid method '@{[$self->method]}' for '${[$self->agent]}'\n"; + } + $self; +} + sub check { my ( $self, $username, $password ) = @_; @@ -36,6 +85,7 @@ my $override = sprintf '%s::get_basic_credentials', ref $self->agent; my $response = undef; my $url = $self->url; + my $method = $self->method; # First make sure we receive a challenge @@ -47,7 +97,7 @@ return ( undef, undef ); }; - $response = $self->agent->head($url); + $response = $self->agent->$method($url); } if ( my $warning = $response->header('Client-Warning') ) { @@ -76,7 +126,7 @@ return ( $username, $password ); }; - $response = $self->agent->head($url); + $response = $self->agent->$method($url); } if ( $response->code == 401 ) { @@ -171,8 +221,35 @@ log => Log::Log4perl->get_logger('Authen::Simple::HTTP') +=item * agentclass + +String describing the class of an agent to be created and used. + +If the class name is alone, the object will be created by calling its +constructor C<new>. If it is followed by a space but no opening +parentheses, the remainder of the string will be treated as a +space-seperated list of arguments to be passed to the constructor +C<new>. If it is followed by a space, an optional constructor name, +then a parenthesized string, the object will be created by calling the +named constructor, or C<new> if no constructor is named, and +processing the remainder of the string as arguments to the constructor +with C<eval>. + +Mostly all of this allows you to create an agent from your httpd.conf +file. All of these will create an agent with keep_alive turned off: + + PerlSetVar AuthenSimpleMyHTTP_agentclass "LWP::UserAgent new(keep_alive => 1)" + PerlSetVar AuthenSimpleMyHTTP_agentclass "LWP::UserAgent (keep_alive => 1)" + PerlSetVar AuthenSimpleMyHTTP_agentclass "LWP::UserAgent keep_alive 1" + + =back +=item * method + +The method to use for the request, generally C<head> or C<get>. +Default is C<head>. + =item * authenticate( $username, $password ) Returns true on success and false on failure.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.