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 NTLM 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 operation. # 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-authenticate'} 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'}, timeout => $self->{'timeout'}, headers => {'Authorization' => $auth }, presistent => 1, $self->{'sub'}; } elsif (($headers->{'Status'} eq '401') && ($headers->{'www-authenticate'} =~ 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'}, timeout => $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; #### 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;