diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen')
3 files changed, 0 insertions, 349 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm deleted file mode 100644 index 6af1441bdd..0000000000 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm +++ /dev/null @@ -1,86 +0,0 @@ -package LWP::Authen::Basic; - -use strict; - -our $VERSION = '6.61'; - -require Encode; -require MIME::Base64; - -sub auth_header { - my($class, $user, $pass, $request, $ua, $h) = @_; - - my $userpass = "$user:$pass"; - # https://tools.ietf.org/html/rfc7617#section-2.1 - my $charset = uc($h->{auth_param}->{charset} || ""); - $userpass = Encode::encode($charset, $userpass) - if ($charset eq "UTF-8"); - - return "Basic " . MIME::Base64::encode($userpass, ""); -} - -sub _reauth_requested { - return 0; -} - -sub authenticate -{ - my($class, $ua, $proxy, $auth_param, $response, - $request, $arg, $size) = @_; - - my $realm = $auth_param->{realm} || ""; - my $url = $proxy ? $request->{proxy} : $request->uri_canonical; - return $response unless $url; - my $host_port = $url->host_port; - my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization"; - - my @m = $proxy ? (m_proxy => $url) : (m_host_port => $host_port); - push(@m, realm => $realm); - - my $h = $ua->get_my_handler("request_prepare", @m, sub { - $_[0]{callback} = sub { - my($req, $ua, $h) = @_; - my($user, $pass) = $ua->credentials($host_port, $h->{realm}); - if (defined $user) { - my $auth_value = $class->auth_header($user, $pass, $req, $ua, $h); - $req->header($auth_header => $auth_value); - } - }; - }); - $h->{auth_param} = $auth_param; - - my $reauth_requested - = $class->_reauth_requested($auth_param, $ua, $request, $auth_header); - if ( !$proxy - && (!$request->header($auth_header) || $reauth_requested) - && $ua->credentials($host_port, $realm)) - { - # we can make sure this handler applies and retry - add_path($h, $url->path) - unless $reauth_requested; # Do not clobber up path list for retries - return $ua->request($request->clone, $arg, $size, $response); - } - - my($user, $pass) = $ua->get_basic_credentials($realm, $url, $proxy); - unless (defined $user and defined $pass) { - $ua->set_my_handler("request_prepare", undef, @m); # delete handler - return $response; - } - - # check that the password has changed - my ($olduser, $oldpass) = $ua->credentials($host_port, $realm); - return $response if (defined $olduser and defined $oldpass and - $user eq $olduser and $pass eq $oldpass); - - $ua->credentials($host_port, $realm, $user, $pass); - add_path($h, $url->path) unless $proxy; - return $ua->request($request->clone, $arg, $size, $response); -} - -sub add_path { - my($h, $path) = @_; - $path =~ s,[^/]+\z,,; - push(@{$h->{m_path_prefix}}, $path); -} - -1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm deleted file mode 100644 index bb1d9ae3c8..0000000000 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm +++ /dev/null @@ -1,80 +0,0 @@ -package LWP::Authen::Digest; - -use strict; -use parent 'LWP::Authen::Basic'; - -our $VERSION = '6.61'; - -require Digest::MD5; - -sub _reauth_requested { - my ($class, $auth_param, $ua, $request, $auth_header) = @_; - my $ret = defined($$auth_param{stale}) && lc($$auth_param{stale}) eq 'true'; - if ($ret) { - my $hdr = $request->header($auth_header); - $hdr =~ tr/,/;/; # "," is used to separate auth-params!! - ($hdr) = HTTP::Headers::Util::split_header_words($hdr); - my $nonce = {@$hdr}->{nonce}; - delete $$ua{authen_md5_nonce_count}{$nonce}; - } - return $ret; -} - -sub auth_header { - my($class, $user, $pass, $request, $ua, $h) = @_; - - my $auth_param = $h->{auth_param}; - - my $nc = sprintf "%08X", ++$ua->{authen_md5_nonce_count}{$auth_param->{nonce}}; - my $cnonce = sprintf "%8x", time; - - my $uri = $request->uri->path_query; - $uri = "/" unless length $uri; - - my $md5 = Digest::MD5->new; - - my(@digest); - $md5->add(join(":", $user, $auth_param->{realm}, $pass)); - push(@digest, $md5->hexdigest); - $md5->reset; - - push(@digest, $auth_param->{nonce}); - - if ($auth_param->{qop}) { - push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop}); - } - - $md5->add(join(":", $request->method, $uri)); - push(@digest, $md5->hexdigest); - $md5->reset; - - $md5->add(join(":", @digest)); - my($digest) = $md5->hexdigest; - $md5->reset; - - my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); - @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); - - if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) { - @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); - } - - my(@order) = qw(username realm qop algorithm uri nonce nc cnonce response opaque); - my @pairs; - for (@order) { - next unless defined $resp{$_}; - - # RFC2617 says that qop-value and nc-value should be unquoted. - if ( $_ eq 'qop' || $_ eq 'nc' ) { - push(@pairs, "$_=" . $resp{$_}); - } - else { - push(@pairs, "$_=" . qq("$resp{$_}")); - } - } - - my $auth_value = "Digest " . join(", ", @pairs); - return $auth_value; -} - -1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm deleted file mode 100644 index de745af6ac..0000000000 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm +++ /dev/null @@ -1,183 +0,0 @@ -package LWP::Authen::Ntlm; - -use strict; - -our $VERSION = '6.61'; - -use Authen::NTLM "1.02"; -use MIME::Base64 "2.12"; - -sub authenticate { - my($class, $ua, $proxy, $auth_param, $response, - $request, $arg, $size) = @_; - - my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm}, - $request->uri, $proxy); - - unless(defined $user and defined $pass) { - return $response; - } - - if (!$ua->conn_cache()) { - warn "The keep_alive option must be enabled for NTLM authentication to work. NTLM authentication aborted.\n"; - return $response; - } - - my($domain, $username) = split(/\\/, $user); - - ntlm_domain($domain); - ntlm_user($username); - ntlm_password($pass); - - my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization"; - - # my ($challenge) = $response->header('WWW-Authenticate'); - my $challenge; - foreach ($response->header('WWW-Authenticate')) { - last if /^NTLM/ && ($challenge=$_); - } - - if ($challenge eq 'NTLM') { - # First phase, send handshake - my $auth_value = "NTLM " . ntlm(); - ntlm_reset(); - - # Need to check this isn't a repeated fail! - my $r = $response; - my $retry_count = 0; - while ($r) { - my $auth = $r->request->header($auth_header); - ++$retry_count if ($auth && $auth eq $auth_value); - if ($retry_count > 2) { - # here we know this failed before - $response->header("Client-Warning" => - "Credentials for '$user' failed before"); - return $response; - } - $r = $r->previous; - } - - my $referral = $request->clone; - $referral->header($auth_header => $auth_value); - return $ua->request($referral, $arg, $size, $response); - } - - else { - # Second phase, use the response challenge (unless non-401 code - # was returned, in which case, we just send back the response - # object, as is - my $auth_value; - if ($response->code ne '401') { - return $response; - } - else { - my $challenge; - foreach ($response->header('WWW-Authenticate')) { - last if /^NTLM/ && ($challenge=$_); - } - $challenge =~ s/^NTLM //; - ntlm(); - $auth_value = "NTLM " . ntlm($challenge); - ntlm_reset(); - } - - my $referral = $request->clone; - $referral->header($auth_header => $auth_value); - my $response2 = $ua->request($referral, $arg, $size, $response); - return $response2; - } -} - -1; -__END__ - -=pod - -=head1 NAME - -LWP::Authen::Ntlm - Library for enabling NTLM authentication (Microsoft) in LWP - -=head1 SYNOPSIS - - use LWP::UserAgent; - use HTTP::Request::Common; - my $url = 'http://www.company.com/protected_page.html'; - - # Set up the ntlm client and then the base64 encoded ntlm handshake message - my $ua = LWP::UserAgent->new(keep_alive=>1); - $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword'); - - $request = GET $url; - print "--Performing request now...-----------\n"; - $response = $ua->request($request); - print "--Done with request-------------------\n"; - - if ($response->is_success) {print "It worked!->" . $response->code . "\n"} - else {print "It didn't work!->" . $response->code . "\n"} - -=head1 DESCRIPTION - -L<LWP::Authen::Ntlm> allows LWP to authenticate against servers that are using the -NTLM authentication scheme popularized by Microsoft. This type of authentication is -common on intranets of Microsoft-centric organizations. - -The module takes advantage of the Authen::NTLM module by Mark Bush. Since there -is also another Authen::NTLM module available from CPAN by Yee Man Chan with an -entirely different interface, it is necessary to ensure that you have the correct -NTLM module. - -In addition, there have been problems with incompatibilities between different -versions of L<Mime::Base64>, which Bush's L<Authen::NTLM> makes use of. Therefore, it is -necessary to ensure that your Mime::Base64 module supports exporting of the -C<encode_base64> and C<decode_base64> functions. - -=head1 USAGE - -The module is used indirectly through LWP, rather than including it directly in your -code. The LWP system will invoke the NTLM authentication when it encounters the -authentication scheme while attempting to retrieve a URL from a server. In order -for the NTLM authentication to work, you must have a few things set up in your -code prior to attempting to retrieve the URL: - -=over 4 - -=item * - -Enable persistent HTTP connections - -To do this, pass the C<< "keep_alive=>1" >> option to the L<LWP::UserAgent> when creating it, like this: - - my $ua = LWP::UserAgent->new(keep_alive=>1); - -=item * - -Set the credentials on the UserAgent object - -The credentials must be set like this: - - $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword'); - -Note that you cannot use the L<HTTP::Request> object's C<authorization_basic()> method to set -the credentials. Note, too, that the C<'www.company.com:80'> portion only sets credentials -on the specified port AND it is case-sensitive (this is due to the way LWP is coded, and -has nothing to do with LWP::Authen::Ntlm) - -=back - -=head1 AVAILABILITY - -General queries regarding LWP should be made to the LWP Mailing List. - -Questions specific to LWP::Authen::Ntlm can be forwarded to jtillman@bigfoot.com - -=head1 COPYRIGHT - -Copyright (c) 2002 James Tillman. All rights reserved. This -program is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - -=head1 SEE ALSO - -L<LWP>, L<LWP::UserAgent>, L<lwpcook>. - -=cut |