Apache-Sling
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Apache/Sling/Authn.pm view on Meta::CPAN
$authn->{'Type'} =
( defined $authn->{'Type'} ? $authn->{'Type'} : 'basic' );
# Apply basic authentication to the user agent if url, username and
# password are supplied:
if ( defined $authn->{'BaseURL'}
&& defined $authn->{'Username'}
&& defined $authn->{'Password'} )
{
if ( $authn->{'Type'} eq 'basic' ) {
my $success = $authn->basic_login();
if ( !$success ) {
if ( $authn->{'Verbose'} >= 1 ) {
Apache::Sling::Print::print_result($authn);
}
croak 'Basic Auth log in for user "'
. $authn->{'Username'}
. '" at URL "'
. $authn->{'BaseURL'}
. "\" was unsuccessful\n";
}
}
else {
croak 'Unsupported auth type: "' . $authn->{'Type'} . "\"\n";
}
if ( $authn->{'Verbose'} >= 1 ) {
Apache::Sling::Print::print_result($authn);
}
}
return 1;
}
#}}}
#{{{sub switch_user
sub switch_user {
my ( $authn, $new_username, $new_password, $type, $check_basic ) = @_;
if ( !defined $new_username ) {
croak 'New username to switch to not defined';
}
if ( !defined $new_password ) {
croak 'New password to use in switch not defined';
}
if ( ( $authn->{'Username'} !~ /^$new_username$/msx )
|| ( $authn->{'Password'} !~ /^$new_password$/msx ) )
{
my $old_username = $authn->{'Username'};
my $old_password = $authn->{'Password'};
my $old_type = $authn->{'Type'};
$authn->{'Username'} = $new_username;
$authn->{'Password'} = $new_password;
if ( defined $type ) {
$authn->{'Type'} = $type;
}
$check_basic = ( defined $check_basic ? $check_basic : 0 );
if ( $authn->{'Type'} eq 'basic' ) {
if ($check_basic) {
my $success = $authn->basic_login();
if ( !$success ) {
# Reset credentials:
$authn->{'Username'} = $old_username;
$authn->{'Password'} = $old_password;
$authn->{'Type'} = $old_type;
croak
"Basic Auth log in for user \"$new_username\" at URL \""
. $authn->{'BaseURL'}
. "\" was unsuccessful\n";
}
}
else {
$authn->{'Message'} = 'Fast User Switch completed!';
}
}
else {
# Reset credentials:
$authn->{'Username'} = $old_username;
$authn->{'Password'} = $old_password;
$authn->{'Type'} = $old_type;
croak "Unsupported auth type: \"$type\"\n";
}
}
else {
$authn->{'Message'} = 'User already active, no need to switch!';
}
if ( $authn->{'Verbose'} >= 1 ) {
Apache::Sling::Print::print_result($authn);
}
return 1;
}
#}}}
#{{{sub user_agent
sub user_agent {
my ( $class, $referer ) = @_;
my $lwp_user_agent = LWP::UserAgent->new( keep_alive => 1 );
push @{ $lwp_user_agent->requests_redirectable }, 'POST';
my $tmp_cookie_file_name;
$lwp_user_agent->cookie_jar( { file => \$tmp_cookie_file_name } );
if ( defined $referer ) {
$lwp_user_agent->default_header( 'Referer' => $referer );
}
return \$lwp_user_agent;
}
#}}}
1;
__END__
=head1 NAME
Apache::Sling::Authn - Authenticate to an Apache Sling instance.
=head1 ABSTRACT
Useful utility functions for general Authn functionality.
=head1 METHODS
=head2 new
Create, set up, and return an Authn object.
=head2 set_results
Set a suitable message and response object.
=head2 basic_login
Perform basic authentication for a user.
=head2 login_user
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.881 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )