(tl)perl 5.26.1 from siep

git-svn-id: svn://tug.org/texlive/trunk@46882 c570f23f-e606-0410-a88d-b1316a301751

14 files changed, 84 insertions, 54 deletions

diff --git a/Master/tlpkg/tlperl/lib/File/Copy.pm b/Master/tlpkg/tlperl/lib/File/Copy.pm
index 842bd31cefe..47e6429771a 100644
--- a/Master/tlpkg/tlperl/lib/File/Copy.pm
+++ b/Master/tlpkg/tlperl/lib/File/Copy.pm
@@ -22,7 +22,7 @@ sub syscopy;
 sub cp;
 sub mv;
 
-$VERSION = '2.31';
+$VERSION = '2.32';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -479,6 +479,11 @@ from the input filespec, then all timestamps other than the
 revision date are propagated.  If this parameter is not supplied,
 it defaults to 0.
 
+C<rmscopy> is VMS specific and cannot be exported; it must be
+referenced by its full name, e.g.:
+
+  File::Copy::rmscopy($from, $to) or die $!;
+
 Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
 it sets C<$!>, deletes the output file, and returns 0.
 
diff --git a/Master/tlpkg/tlperl/lib/File/Fetch.pm b/Master/tlpkg/tlperl/lib/File/Fetch.pm
index de2ab123363..acfa442841a 100644
--- a/Master/tlpkg/tlperl/lib/File/Fetch.pm
+++ b/Master/tlpkg/tlperl/lib/File/Fetch.pm
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4
             ];
 
-$VERSION        = '0.48_01';
+$VERSION        = '0.52';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -39,6 +39,7 @@ $FORCEIPV4      = 0;
 ### methods available to fetch the file depending on the scheme
 $METHODS = {
     http    => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ],
+    https   => [ qw|lwp wget curl| ],
     ftp     => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
     file    => [ qw|lwp lftp file| ],
     rsync   => [ qw|rsync| ],
@@ -51,6 +52,9 @@ local $Params::Check::VERBOSE               = 1;
 local $Module::Load::Conditional::VERBOSE   = 0;
 local $Module::Load::Conditional::VERBOSE   = 0;
 
+### Fix CVE-2016-1238 ###
+local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
+
 ### see what OS we are on, important for file:// uris ###
 use constant ON_WIN     => ($^O eq 'MSWin32');
 use constant ON_VMS     => ($^O eq 'VMS');
@@ -164,6 +168,7 @@ http://www.abc.net.au/ the contents retrieved may be from a remote file called
         path            => { default => '/' },
         file            => { required => 1 },
         uri             => { required => 1 },
+        userinfo        => { default => '' },
         vol             => { default => '' }, # windows for file:// uris
         share           => { default => '' }, # windows for file:// uris
         file_default    => { default => 'file_default' },
@@ -401,7 +406,7 @@ sub _parse_uri {
     } else {
         ### using anything but qw() in hash slices may produce warnings
         ### in older perls :-(
-        @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
+        @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)$|s;
     }
 
     ### split the path into file + dir ###
@@ -567,8 +572,10 @@ sub _lwp_fetch {
 
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
+    if ($self->scheme eq 'https') {
+        $use_list->{'LWP::Protocol::https'} = '0';
+    }
+
     unless( can_load( modules => $use_list ) ) {
         $METHOD_FAIL->{'lwp'} = 1;
         return;
@@ -582,7 +589,12 @@ sub _lwp_fetch {
     ### special rules apply for file:// uris ###
     $uri->scheme( $self->scheme );
     $uri->host( $self->scheme eq 'file' ? '' : $self->host );
-    $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
+
+    if ($self->userinfo) {
+        $uri->userinfo($self->userinfo);
+    } elsif ($self->scheme ne 'file') {
+        $uri->userinfo("anonymous:$FROM_EMAIL");
+    }
 
     ### set up the useragent object
     my $ua = LWP::UserAgent->new();
@@ -621,8 +633,6 @@ sub _httptiny_fetch {
 
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
     unless( can_load(modules => $use_list) ) {
         $METHOD_FAIL->{'httptiny'} = 1;
         return;
@@ -659,11 +669,9 @@ sub _httplite_fetch {
     ### modules required to download with lwp ###
     my $use_list = {
         'HTTP::Lite'    => '2.2',
-
+        'MIME::Base64'  => '0',
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
     unless( can_load(modules => $use_list) ) {
         $METHOD_FAIL->{'httplite'} = 1;
         return;
@@ -679,6 +687,11 @@ sub _httplite_fetch {
       $http->{timeout} = $TIMEOUT if $TIMEOUT;
       $http->http11_mode(1);
 
+      if ($self->userinfo) {
+          my $encoded = MIME::Base64::encode($self->userinfo, '');
+          $http->add_req_header("Authorization", "Basic $encoded");
+      }
+
       my $fh = FileHandle->new;
 
       unless ( $fh->open($to,'>') ) {
@@ -739,8 +752,6 @@ sub _iosock_fetch {
         'IO::Select'       => '0.0',
     };
 
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
     unless( can_load(modules => $use_list) ) {
         $METHOD_FAIL->{'iosock'} = 1;
         return;
@@ -822,8 +833,6 @@ sub _netftp_fetch {
     check( $tmpl, \%hash ) or return;
 
     ### required modules ###
-    local @INC = @INC;
-    pop @INC if $INC[-1] eq '.';
     my $use_list = { 'Net::FTP' => 0 };
 
     unless( can_load( modules => $use_list ) ) {
@@ -1512,7 +1521,7 @@ Below is a mapping of what utilities will be used in what order
 for what schemes, if available:
 
     file    => LWP, lftp, file
-    http    => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
+    http    => LWP, HTTP::Tiny, wget, curl, lftp, fetch, HTTP::Lite, lynx, iosock
     ftp     => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
     rsync   => rsync
     git     => git
diff --git a/Master/tlpkg/tlperl/lib/File/Glob.pm b/Master/tlpkg/tlperl/lib/File/Glob.pm
index c0b5a4720d9..c619749fa0f 100644
--- a/Master/tlpkg/tlperl/lib/File/Glob.pm
+++ b/Master/tlpkg/tlperl/lib/File/Glob.pm
@@ -37,7 +37,7 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob"
 
 @EXPORT_OK   = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob');
 
-$VERSION = '1.26';
+$VERSION = '1.28';
 
 sub import {
     require Exporter;
@@ -75,6 +75,12 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) {
 # File::Glob::glob() is deprecated because its prototype is different from
 # CORE::glob() (use bsd_glob() instead)
 sub glob {
+    use 5.024;
+    use warnings ();
+    warnings::warnif (deprecated =>
+         "File::Glob::glob() will disappear in perl 5.30. " .
+         "Use File::Glob::bsd_glob() instead.") unless state $warned ++;
+
     splice @_, 1; # no flags
     goto &bsd_glob;
 }
@@ -176,10 +182,15 @@ means this will loop forever:
 =head3 C<bsd_glob>
 
 This function, which is included in the two export tags listed above,
-takes one or two arguments.  The first is the glob pattern.  The second is
-a set of flags ORed together.  The available flags are listed below under
-L</POSIX FLAGS>.  If the second argument is omitted, C<GLOB_CSH> (or
-C<GLOB_CSH|GLOB_NOCASE> on VMS and DOSish systems) is used by default.
+takes one or two arguments.  The first is the glob pattern.  The
+second, if given, is a set of flags ORed together.  The available
+flags and the default set of flags are listed below under L</POSIX FLAGS>.
+
+Remember that to use the named constants for flags you must import
+them, for example with C<:bsd_glob> described above.  If not imported,
+and C<use strict> is not in effect, then the constants will be
+treated as bareword strings, which won't do what you what.
+
 
 =head3 C<:nocase> and C<:case>
 
@@ -196,7 +207,9 @@ uses this internally.
 
 =head2 POSIX FLAGS
 
-The POSIX defined flags for bsd_glob() are:
+If no flags argument is give then C<GLOB_CSH> is set, and on VMS and
+Windows systems, C<GLOB_NOCASE> too.  Otherwise the flags to use are
+determined solely by the flags argument.  The POSIX defined flags are:
 
 =over 4
 
diff --git a/Master/tlpkg/tlperl/lib/File/GlobMapper.pm b/Master/tlpkg/tlperl/lib/File/GlobMapper.pm
index 76d4bed1178..a96cf3e8324 100644
--- a/Master/tlpkg/tlperl/lib/File/GlobMapper.pm
+++ b/Master/tlpkg/tlperl/lib/File/GlobMapper.pm
@@ -149,7 +149,7 @@ sub _parseBit
 
         if ($2 eq ',')
         { 
-            return _unmatched "("
+            return _unmatched("(")
                 if $depth ;
             
             $out .= '|';
@@ -160,7 +160,7 @@ sub _parseBit
         }
         elsif ($2 eq ')')
         { 
-            return _unmatched ")"
+            return _unmatched(")")
                 if ! $depth ;
 
             -- $depth ;
@@ -170,22 +170,22 @@ sub _parseBit
             # TODO -- quotemeta & check no '/'
             # TODO -- check for \]  & other \ within the []
             $string =~ s#(.*?\])##
-                or return _unmatched "[" ;
+                or return _unmatched("[");
             $out .= "$1)" ;
         }
         elsif ($2 eq ']')
         {
-            return _unmatched "]" ;
+            return _unmatched("]");
         }
         elsif ($2 eq '{' || $2 eq '}')
         {
-            return _retError "Nested {} not allowed" ;
+            return _retError("Nested {} not allowed");
         }
     }
 
     $out .= quotemeta $string;
 
-    return _unmatched "("
+    return _unmatched("(")
         if $depth ;
 
     return $out ;
@@ -219,7 +219,7 @@ sub _parseInputGlob
         }
         elsif ($2 eq ')')
         { 
-            return _unmatched ")"
+            return _unmatched(")")
                 if ! $depth ;
 
             -- $depth ;
@@ -229,16 +229,16 @@ sub _parseInputGlob
             # TODO -- quotemeta & check no '/' or '(' or ')'
             # TODO -- check for \]  & other \ within the []
             $string =~ s#(.*?\])##
-                or return _unmatched "[";
+                or return _unmatched("[");
             $out .= "$1)" ;
         }
         elsif ($2 eq ']')
         {
-            return _unmatched "]" ;
+            return _unmatched("]");
         }
         elsif ($2 eq '}')
         {
-            return _unmatched "}" ;
+            return _unmatched("}");
         }
         elsif ($2 eq '{')
         {
@@ -248,7 +248,7 @@ sub _parseInputGlob
             my $tmp ;
             unless ( $string =~ s/(.*?)$noPreBS\}//)
             {
-                return _unmatched "{";
+                return _unmatched("{");
             }
             #$string =~ s#(.*?)\}##;
 
@@ -263,7 +263,7 @@ sub _parseInputGlob
         }
     }
 
-    return _unmatched "("
+    return _unmatched("(")
         if $depth ;
 
     $out .= quotemeta $string ;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec.pm b/Master/tlpkg/tlperl/lib/File/Spec.pm
index 3ef0f339db3..a9a76194701 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec.pm
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 my %module = (MacOS   => 'Mac',
@@ -158,10 +158,13 @@ Returns a string representation of the parent directory.
 
 =item no_upwards
 
-Given a list of file names, strip out those that refer to a parent
-directory. (Does not strip symlinks, only '.', '..', and equivalents.)
+Given a list of files in a directory (such as from C<readdir()>),
+strip out C<'.'> and C<'..'>.
 
-    @paths = File::Spec->no_upwards( @paths );
+B<SECURITY NOTE:> This does NOT filter paths containing C<'..'>, like
+C<'../../../../etc/passwd'>, only literal matches to C<'.'> and C<'..'>.
+
+    @paths = File::Spec->no_upwards( readdir $dirhandle );
 
 =item case_tolerant
 
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/AmigaOS.pm b/Master/tlpkg/tlperl/lib/File/Spec/AmigaOS.pm
index 7a5889cec49..8d3796e1237 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/AmigaOS.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/AmigaOS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm b/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm
index 10b14c4b9a6..745df86ee5e 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Cygwin.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm b/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm
index 9b9e1fae587..959261a58e5 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Epoc.pm
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 require File::Spec::Unix;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm b/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm
index a4e1b1bb338..cb7532e57f4 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Functions.pm
@@ -5,7 +5,7 @@ use strict;
 
 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 require Exporter;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm b/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm
index 22424f32510..192cc8da9b2 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Mac.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
@@ -121,7 +121,7 @@ doesn't alter the path, i.e. these arguments are ignored. (When a ""
 is passed as the first argument, it has a special meaning, see
 (6)). This way, a colon ":" is handled like a "." (curdir) on Unix,
 while an empty string "" is generally ignored (see
-C<Unix-E<gt>canonpath()> ). Likewise, a "::" is handled like a ".."
+L<File::Spec::Unix/canonpath()> ). Likewise, a "::" is handled like a ".."
 (updir), and a ":::" is handled like a "../.." etc.  E.g.
 
     catdir("a",":",":","b")   = ":a:b:"
@@ -168,7 +168,7 @@ their Unix counterparts:
                                                     # (e.g. "HD:a:")
 
 However, this approach is limited to the first arguments following
-"root" (again, see C<Unix-E<gt>canonpath()> ). If there are more
+"root" (again, see L<File::Spec::Unix/canonpath()>. If there are more
 arguments that move up the directory tree, an invalid path going
 beyond root can be created.
 
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm b/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm
index 0119042c9c0..1e201ebade2 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm b/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm
index 9598dbb3621..ff3599acf61 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Unix.pm
@@ -3,7 +3,7 @@ package File::Spec::Unix;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm b/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm
index c0cc1e50434..fb4351f086b 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
@@ -97,7 +97,7 @@ sub canonpath {
 						# [-.-.		==> [--.
 						# .-.-]		==> .--]
 						# [-.-]		==> [--]
-    1 while ($path =~ s/(?<!\^)([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
+    1 while ($path =~ s/(?<!\^)([\[\.])(?:\^.|[^\]\.])+\.-(-+)([\]\.])/$1$2$3/);
 						# That loop does the following
 						# with any amount (minimum 2)
 						# of dashes:
@@ -108,11 +108,11 @@ sub canonpath {
 						#
 						# And then, the remaining cases
     $path =~ s/(?<!\^)\[\.-/[-/;		# [.-		==> [-
-    $path =~ s/(?<!\^)\.[^\]\.]+\.-\./\./g;	# .foo.-.	==> .
-    $path =~ s/(?<!\^)\[[^\]\.]+\.-\./\[/g;	# [foo.-.	==> [
-    $path =~ s/(?<!\^)\.[^\]\.]+\.-\]/\]/g;	# .foo.-]	==> ]
+    $path =~ s/(?<!\^)\.(?:\^.|[^\]\.])+\.-\./\./g;	# .foo.-.	==> .
+    $path =~ s/(?<!\^)\[(?:\^.|[^\]\.])+\.-\./\[/g;	# [foo.-.	==> [
+    $path =~ s/(?<!\^)\.(?:\^.|[^\]\.])+\.-\]/\]/g;	# .foo.-]	==> ]
 						# [foo.-]       ==> [000000]
-    $path =~ s/(?<!\^)\[[^\]\.]+\.-\]/\[000000\]/g;
+    $path =~ s/(?<!\^)\[(?:\^.|[^\]\.])+\.-\]/\[000000\]/g;
 						# []		==>
     $path =~ s/(?<!\^)\[\]// unless $path eq '[]';
     return $unix_rpt ? unixify($path) : $path;
diff --git a/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm b/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm
index 578d61b37f8..17f1c5a1901 100644
--- a/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm
+++ b/Master/tlpkg/tlperl/lib/File/Spec/Win32.pm
@@ -5,7 +5,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.63_01';
+$VERSION = '3.67';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);