| Subject: | Configure agent from httpd.conf, choose method |
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.