AnyEvent::HTTP::LWP::UserAgent with LWP::Authen::NTLM causes recusrive blocking wait?

sectokia has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks,

I am trying to use AnyEvent::HTTP:LWP::UserAgent with a server that requires NTLM authentication.

My problem is that it dies with:

AnyEvent::CondVar: recursive blocking wait attempted at C:/Strawberry/perl/site/lib/AnyEvent/HTTP/LWP/UserAgent.pm line 409.

Would this be a bug in the module? I had a look in the file but its over my head.

Code:

use AnyEvent::HTTP::LWP::UserAgent;
use AnyEvent;
use LWP::Authen::NTLM;
use Data::Dumper qw(Dumper);

my $ip = '10.0.0.14';
my $user = 'DOMAIN\\user';
my $pass = 'password';
my $port = '80';
 
my $url = 'http://'.$ip.'/example';
 
my $ua = AnyEvent::HTTP::LWP::UserAgent->new(keep_alive => 1);

# without this line it works... but obviously returns unauthorised
$ua->credentials($ip.":".$port,'',$user,$pass);

$ua->timeout(10);
my $cv = $ua->get_async($url);
$cv->cb(sub {
        my $r = shift->recv;
    print Dumper $r;
    });
$cv->recv;
[download]

Comment on AnyEvent::HTTP::LWP::UserAgent with LWP::Authen::NTLM causes recusrive blocking wait? Select or Download Code

Replies are listed 'Best First'.

Re: AnyEvent::HTTP::LWP::UserAgent with LWP::Authen::NTLM causes recusrive blocking wait?
by sectokia (Pilgrim) on Feb 09, 2021 at 01:05 UTC

package AnyEventHTTPGetNTLM;

use strict;
use warnings;

use AnyEvent;
use AnyEvent::HTTP;
use Authen::NTLM;

#
# AnyEventHTTPGetNTLM
#
# Uses AnyEvent::HTTP and Authen::NTLM to do an async HTTP GET on a NT
+LM protected server.
# Requires a hash ref as argument containing:
#  user => NTLM user name
#  pass => NTLM password
#  domain => NTLM domain
#  url => The URL to get
#  timeout => Time out of HTTP requests
#  cb => Call back subroutine, which will be called with result ($data
+, $headers) as arguments.
# 
# Returns object which must be kept in scope for callback.
# The objects 'cv' item is a condition var for the overall async opera
+tion.
#

sub new 
{
    my ($class,$args) = @_;
    
    my $self = $args;
    bless $self, $class;

    $self->{'cv'} = AnyEvent->condvar;
    $self->{'timeout'} = 10 if (!$self->{'timeout'});
    $self->{'sub'} = sub {
        my ($data, $headers) = @_;
        
        if (($headers->{'Status'} eq '401') && ($headers->{'www-authen
+ticate'} eq 'NTLM'))
        {
            ntlm_domain($self->{'domain'});
            ntlm_user($self->{'user'});
            ntlm_password($self->{'pass'});
            my $auth = "NTLM ".ntlm();
            ntlm_reset();
            
            $self->{'cv'}->begin;
            $self->{'phase1'} = http_request GET => $self->{'url'}, ti
+meout => $self->{'timeout'}, headers => {'Authorization' => $auth }, 
+presistent => 1, $self->{'sub'};
        }
        elsif (($headers->{'Status'} eq '401') && ($headers->{'www-aut
+henticate'} =~ m/^NTLM /))
        {
            my $challange = $headers->{'www-authenticate'};
            $challange =~ s/^NTLM //;
            ntlm();
            my $auth = "NTLM ".ntlm($challange);
            ntlm_reset();
                            
            $self->{'cv'}->begin;
            $self->{'phase2'} = http_request GET => $self->{'url'}, ti
+meout => $self->{'timeout'}, headers => {'Authorization' => $auth }, 
+persistent => 1, $self->{'sub'};            
        }
        else
        {
            $self->{'cb'}->($data,$headers);
        }
                
        $self->{'cv'}->end;
    };

    $self->{'cv'}->begin;
    $self->{'phase0'} = http_request GET => $self->{'url'}, timeout =>
+ $self->{'timeout'}, persistent => 1, $self->{'sub'};
    
    return $self;
}

1;
[download]

use AnyEventHTTPGetNTLM;
use Data::Dumper qw(Dumper);

my $async = new AnyEventHTTPGetNTLM({
    'domain' => 'myDomain',
    'user' => 'fred',
    'pass' => 'secret',
    'url' => 'http://example.com:999/getsomething',
    'timeout' => 10,
    'cb' => sub {
        my ($data,$headers) = @_;
        print Dumper $headers;
        print Dumper $data;
    },
});

$async->{'cv'}->recv;
[download]

[reply]
[d/l]
[select]


We don't bite newbies here... much
	PerlMonks