summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm86
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm80
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm183
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