jcgruenhage/void-packages
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity
void-packages/srcpkgs/perl/patches/maint-v5.22.patch
Christian Neukirchen 2093f09aeb perl: fix CVE-2015-8607, CVE-2015-8608, CVE-2016-2381.
2016-03-04 13:27:55 +01:00

1378 lines
44 KiB
Diff
Raw Blame History

Generated from "git format-patch --no-prefix --stdout v5.22.1",
then removing hunks related to .gitignore.
From 113acdcec0e3fa4f599e379d46ae03ad363ac209 Mon Sep 17 00:00:00 2001
From: Steve Hay <steve.m.hay@googlemail.com>
Date: Sun, 13 Dec 2015 20:01:10 +0000
Subject: [PATCH 1/9] Add 5.22.1 epigraph
(cherry picked from commit c62e8bc1daa350f25a8a74124e1f429d3ed1007f)
---
Porting/epigraphs.pod | 19 +++++++++++++++++++
1 file changed, 19 insertions(+)
diff --git Porting/epigraphs.pod Porting/epigraphs.pod
index d4e31ad..e1fb55e 100644
--- Porting/epigraphs.pod
+++ Porting/epigraphs.pod
@@ -203,6 +203,25 @@ L<Announced on 2015-06-20 by Ricardo Signes|http://www.nntp.perl.org/group/perl.
They sing while you slave and I just get bored
I ain't gonna work on Maggie's farm no more
+=head2 v5.22.1 - Wilhelm Müller, trans. Anon., "Courage" (No. 22 in Schubert's song-cycle, "Winterreise")
+
+L<Announced on 2015-12-13 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2015/12/msg233318.html>
+
+ If the snow flies in my face,
+ Let me shake it off me!
+ If my heart within me speaks,
+ I'll sing bright and gaily!
+
+ Will not listen what it says,
+ Have no ears for moaning.
+ Do not feel what it complains,--
+ Only fools like groaning!
+
+ Jolly brave into the world,
+ 'Gainst all wind and weather,--
+ If there is no God on earth,
+ Let 's be gods down nether!
+
=head2 v5.22.1-RC4 - Wilhelm Müller, trans. Anon., "The Signpost" (No. 20 in Schubert's song-cycle, "Winterreise")
L<Announced on 2015-12-08 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2015/12/msg233215.html>
--
2.7.2
From d81e27425fae693e2aa4618efe62e26047c12f95 Mon Sep 17 00:00:00 2001
From: Steve Hay <steve.m.hay@googlemail.com>
Date: Sun, 13 Dec 2015 20:12:43 +0000
Subject: [PATCH 2/9] Create new perldelta for 5.22.2
---
MANIFEST | 1 +
Makefile.SH | 8 +-
pod/{perldelta.pod => perl5221delta.pod} | 2 +-
pod/perldelta.pod | 400 ++++++++++++++++++-------------
vms/descrip_mms.template | 2 +-
win32/Makefile | 4 +-
win32/makefile.mk | 4 +-
win32/pod.mak | 4 +
9 files changed, 255 insertions(+), 172 deletions(-)
copy pod/{perldelta.pod => perl5221delta.pod} (99%)
diff --git MANIFEST MANIFEST
index 6af238c..e04fbb2 100644
--- MANIFEST
+++ MANIFEST
@@ -4567,6 +4567,7 @@ pod/perl5201delta.pod Perl changes in version 5.20.1
pod/perl5202delta.pod Perl changes in version 5.20.2
pod/perl5203delta.pod Perl changes in version 5.20.3
pod/perl5220delta.pod Perl changes in version 5.22.0
+pod/perl5221delta.pod Perl changes in version 5.22.1
pod/perl561delta.pod Perl changes in version 5.6.1
pod/perl56delta.pod Perl changes in version 5.6
pod/perl581delta.pod Perl changes in version 5.8.1
diff --git Makefile.SH Makefile.SH
index b6999b2..829d7a3 100755
--- Makefile.SH
+++ Makefile.SH
@@ -492,7 +492,7 @@ mini_obj = $(minindt_obj) $(MINIDTRACE_O)
ndt_obj = $(obj0) $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
obj = $(ndt_obj) $(DTRACE_O)
-perltoc_pod_prereqs = extra.pods pod/perl5221delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
+perltoc_pod_prereqs = extra.pods pod/perl5222delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs)
generated_headers = uudmap.h bitcount.h mg_data.h
@@ -1020,9 +1020,9 @@ pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc
pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST
$(MINIPERL) pod/perlmodlib.PL -q
-pod/perl5221delta.pod: pod/perldelta.pod
- $(RMS) pod/perl5221delta.pod
- $(LNS) perldelta.pod pod/perl5221delta.pod
+pod/perl5222delta.pod: pod/perldelta.pod
+ $(RMS) pod/perl5222delta.pod
+ $(LNS) perldelta.pod pod/perl5222delta.pod
extra.pods: $(MINIPERL_EXE)
-@test ! -f extra.pods || rm -f `cat extra.pods`
diff --git pod/perldelta.pod pod/perl5221delta.pod
similarity index 99%
copy from pod/perldelta.pod
copy to pod/perl5221delta.pod
index 257124a..5d01a4b 100644
--- pod/perldelta.pod
+++ pod/perl5221delta.pod
@@ -2,7 +2,7 @@
=head1 NAME
-perldelta - what is new for perl v5.22.1
+perl5221delta - what is new for perl v5.22.1
=head1 DESCRIPTION
diff --git pod/perldelta.pod pod/perldelta.pod
index 257124a..8d9b771 100644
--- pod/perldelta.pod
+++ pod/perldelta.pod
@@ -2,97 +2,163 @@
=head1 NAME
-perldelta - what is new for perl v5.22.1
+[ this is a template for a new perldelta file. Any text flagged as XXX needs
+to be processed before release. ]
+
+perldelta - what is new for perl v5.22.2
=head1 DESCRIPTION
-This document describes differences between the 5.22.0 release and the 5.22.1
+This document describes differences between the 5.22.1 release and the 5.22.2
release.
-If you are upgrading from an earlier release such as 5.20.0, first read
-L<perl5220delta>, which describes differences between 5.20.0 and 5.22.0.
+If you are upgrading from an earlier release such as 5.22.0, first read
+L<perl5221delta>, which describes differences between 5.22.0 and 5.22.1.
+
+=head1 Notice
+
+XXX Any important notices here
+
+=head1 Core Enhancements
+
+XXX New core language features go here. Summarize user-visible core language
+enhancements. Particularly prominent performance optimisations could go
+here, but most should go in the L</Performance Enhancements> section.
+
+[ List each enhancement as a =head2 entry ]
+
+=head1 Security
+
+XXX Any security-related notices go here. In particular, any security
+vulnerabilities closed should be noted here rather than in the
+L</Selected Bug Fixes> section.
+
+[ List each security issue as a =head2 entry ]
=head1 Incompatible Changes
-There are no changes intentionally incompatible with 5.20.0 other than the
-following single exception, which we deemed to be a sensible change to make in
-order to get the new C<\b{wb}> and (in particular) C<\b{sb}> features sane
-before people decided they're worthless because of bugs in their Perl 5.22.0
-implementation and avoided them in the future.
-If any others exist, they are bugs, and we request that you submit a report.
-See L</Reporting Bugs> below.
+XXX For a release on a stable branch, this section aspires to be:
-=head2 Bounds Checking Constructs
+ There are no changes intentionally incompatible with 5.XXX.XXX
+ If any exist, they are bugs, and we request that you submit a
+ report. See L</Reporting Bugs> below.
-Several bugs, including a segmentation fault, have been fixed with the bounds
-checking constructs (introduced in Perl 5.22) C<\b{gcb}>, C<\b{sb}>, C<\b{wb}>,
-C<\B{gcb}>, C<\B{sb}>, and C<\B{wb}>. All the C<\B{}> ones now match an empty
-string; none of the C<\b{}> ones do.
-L<[perl #126319]|https://rt.perl.org/Ticket/Display.html?id=126319>
+[ List each incompatible change as a =head2 entry ]
-=head1 Modules and Pragmata
+=head1 Deprecations
-=head2 Updated Modules and Pragmata
+XXX Any deprecated features, syntax, modules etc. should be listed here.
+
+=head2 Module removals
+
+XXX Remove this section if inapplicable.
+
+The following modules will be removed from the core distribution in a
+future release, and will at that time need to be installed from CPAN.
+Distributions on CPAN which require these modules will need to list them as
+prerequisites.
+
+The core versions of these modules will now issue C<"deprecated">-category
+warnings to alert you to this fact. To silence these deprecation warnings,
+install the modules in question from CPAN.
+
+Note that these are (with rare exceptions) fine modules that you are encouraged
+to continue to use. Their disinclusion from core primarily hinges on their
+necessity to bootstrapping a fully functional, CPAN-capable Perl installation,
+not usually on concerns over their design.
+
+=over
+
+=item XXX
+
+XXX Note that deprecated modules should be listed here even if they are listed
+as an updated module in the L</Modules and Pragmata> section.
+
+=back
+
+[ List each other deprecation as a =head2 entry ]
+
+=head1 Performance Enhancements
+
+XXX Changes which enhance performance without changing behaviour go here.
+There may well be none in a stable release.
+
+[ List each enhancement as a =item entry ]
=over 4
=item *
-L<Module::CoreList> has been upgraded from version 5.20150520 to 5.20151213.
+XXX
-=item *
+=back
-L<PerlIO::scalar> has been upgraded from version 0.22 to 0.23.
+=head1 Modules and Pragmata
-=item *
+XXX All changes to installed files in F<cpan/>, F<dist/>, F<ext/> and F<lib/>
+go here. If Module::CoreList is updated, generate an initial draft of the
+following sections using F<Porting/corelist-perldelta.pl>. A paragraph summary
+for important changes should then be added by hand. In an ideal world,
+dual-life modules would have a F<Changes> file that could be cribbed.
+
+[ Within each section, list entries as a =item entry ]
-L<POSIX> has been upgraded from version 1.53 to 1.53_01.
+=head2 New Modules and Pragmata
-If C<POSIX::strerror> was passed C<$!> as its argument then it accidentally
-cleared C<$!>. This has been fixed.
-L<[perl #126229]|https://rt.perl.org/Ticket/Display.html?id=126229>
+=over 4
=item *
-L<Storable> has been upgraded from version 2.53 to 2.53_01.
+XXX
-=item *
+=back
-L<warnings> has been upgraded from version 1.32 to 1.34.
+=head2 Updated Modules and Pragmata
-The C<warnings::enabled> example now actually uses C<warnings::enabled>.
-L<[perl #126051]|https://rt.perl.org/Ticket/Display.html?id=126051>
+=over 4
=item *
-L<Win32> has been upgraded from version 0.51 to 0.52.
+L<XXX> has been upgraded from version A.xx to B.yy.
+
+=back
+
+=head2 Removed Modules and Pragmata
-This has been updated for Windows 8.1, 10 and 2012 R2 Server.
+=over 4
+
+=item *
+
+XXX
=back
=head1 Documentation
-=head2 Changes to Existing Documentation
+XXX Changes to files in F<pod/> go here. Consider grouping entries by
+file and be sure to link to the appropriate page, e.g. L<perlfunc>.
-=head3 L<perltie>
+=head2 New Documentation
-=over 4
+XXX Changes which create B<new> files in F<pod/> go here.
-=item *
+=head3 L<XXX>
-The usage of C<FIRSTKEY> and C<NEXTKEY> has been clarified.
+XXX Description of the purpose of the new file here
-=back
+=head2 Changes to Existing Documentation
+
+XXX Changes which significantly change existing files in F<pod/> go here.
+However, any changes to F<pod/perldiag.pod> should go in the L</Diagnostics>
+section.
-=head3 L<perlvar>
+=head3 L<XXX>
=over 4
=item *
-The specific true value of C<$!{E...}> is now documented, noting that it is
-subject to change and not guaranteed.
+XXX Description of the change here
=back
@@ -102,205 +168,217 @@ The following additions or changes have been made to diagnostic output,
including warnings and fatal error messages. For the complete list of
diagnostic messages, see L<perldiag>.
-=head2 Changes to Existing Diagnostics
+XXX New or changed warnings emitted by the core's C<C> code go here. Also
+include any changes in L<perldiag> that reconcile it to the C<C> code.
+
+=head2 New Diagnostics
+
+XXX Newly added diagnostic messages go under here, separated into New Errors
+and New Warnings
+
+=head3 New Errors
=over 4
=item *
-The C<printf> and C<sprintf> builtins are now more careful about the warnings
-they emit: argument reordering now disables the "redundant argument" warning in
-all cases.
-L<[perl #125469]|https://rt.perl.org/Ticket/Display.html?id=125469>
+XXX L<message|perldiag/"message">
=back
-=head1 Configuration and Compilation
+=head3 New Warnings
=over 4
=item *
-Using the C<NO_HASH_SEED> define in combination with the default hash algorithm
-C<PERL_HASH_FUNC_ONE_AT_A_TIME_HARD> resulted in a fatal error while compiling
-the interpreter, since Perl 5.17.10. This has been fixed.
+XXX L<message|perldiag/"message">
+
+=back
+
+=head2 Changes to Existing Diagnostics
+
+XXX Changes (i.e. rewording) of diagnostic messages go here
+
+=over 4
=item *
-Configuring with ccflags containing quotes (e.g.
-C<< -Accflags='-DAPPLLIB_EXP=\"/usr/libperl\"' >>) was broken in Perl 5.22.0
-but has now been fixed again.
-L<[perl #125314]|https://rt.perl.org/Ticket/Display.html?id=125314>
+XXX Describe change here
=back
-=head1 Platform Support
+=head1 Utility Changes
-=head2 Platform-Specific Notes
+XXX Changes to installed programs such as F<perlbug> and F<xsubpp> go here.
+Most of these are built within the directory F<utils>.
-=over 4
+[ List utility changes as a =head2 entry for each utility and =item
+entries for each change
+Use L<XXX> with program names to get proper documentation linking. ]
-=item IRIX
+=head2 L<XXX>
-=over
+=over 4
=item *
-Under some circumstances IRIX stdio fgetc() and fread() set the errno to
-C<ENOENT>, which made no sense according to either IRIX or POSIX docs. Errno
-is now cleared in such cases.
-L<[perl #123977]|https://rt.perl.org/Ticket/Display.html?id=123977>
+XXX
-=item *
+=back
+
+=head1 Configuration and Compilation
-Problems when multiplying long doubles by infinity have been fixed.
-L<[perl #126396]|https://rt.perl.org/Ticket/Display.html?id=126396>
+XXX Changes to F<Configure>, F<installperl>, F<installman>, and analogous tools
+go here. Any other changes to the Perl build process should be listed here.
+However, any platform-specific changes should be listed in the
+L</Platform Support> section, instead.
+
+[ List changes as a =item entry ].
+
+=over 4
=item *
-All tests pass now on IRIX with the default build configuration.
+XXX
=back
-=back
+=head1 Testing
-=head1 Selected Bug Fixes
+XXX Any significant changes to the testing of a freshly built perl should be
+listed here. Changes which create B<new> files in F<t/> go here as do any
+large changes to the testing harness (e.g. when parallel testing was added).
+Changes to existing files in F<t/> aren't worth summarizing, although the bugs
+that they represent may be covered elsewhere.
+
+[ List each test improvement as a =item entry ]
=over 4
=item *
-C<qr/(?[ () ])/> no longer segfaults, giving a syntax error message instead.
-L<[perl #125805]|https://rt.perl.org/Ticket/Display.html?id=125805>
+XXX
-=item *
+=back
-Regular expression possessive quantifier Perl 5.20 regression now fixed.
-C<qr/>I<PAT>C<{>I<min>,I<max>C<}+>C</> is supposed to behave identically to
-C<qr/(?E<gt>>I<PAT>C<{>I<min>,I<max>C<})/>. Since Perl 5.20, this didn't work
-if I<min> and I<max> were equal.
-L<[perl #125825]|https://rt.perl.org/Ticket/Display.html?id=125825>
+=head1 Platform Support
-=item *
+XXX Any changes to platform support should be listed in the sections below.
-Certain syntax errors in
-L<perlrecharclass/Extended Bracketed Character Classes> caused panics instead
-of the proper error message. This has now been fixed.
-L<[perl #126481]|https://rt.perl.org/Ticket/Display.html?id=126481>
+[ Within the sections, list each platform as a =item entry with specific
+changes as paragraphs below it. ]
-=item *
+=head2 New Platforms
-C<< BEGIN <> >> no longer segfaults and properly produces an error message.
-L<[perl #125341]|https://rt.perl.org/Ticket/Display.html?id=125341>
+XXX List any platforms that this version of perl compiles on, that previous
+versions did not. These will either be enabled by new files in the F<hints/>
+directories, or new subdirectories and F<README> files at the top level of the
+source tree.
-=item *
+=over 4
-A regression from Perl 5.20 has been fixed, in which some syntax errors in
-L<C<(?[...])>|perlrecharclass/Extended Bracketed Character Classes> constructs
-within regular expression patterns could cause a segfault instead of a proper
-error message.
-L<[perl #126180]|https://rt.perl.org/Ticket/Display.html?id=126180>
+=item XXX-some-platform
-=item *
+XXX
-Another problem with
-L<C<(?[...])>|perlrecharclass/Extended Bracketed Character Classes>
-constructs has been fixed wherein things like C<\c]> could cause panics.
-L<[perl #126181]|https://rt.perl.org/Ticket/Display.html?id=126181>
+=back
-=item *
+=head2 Discontinued Platforms
-In Perl 5.22.0, the logic changed when parsing a numeric parameter to the -C
-option, such that the successfully parsed number was not saved as the option
-value if it parsed to the end of the argument.
-L<[perl #125381]|https://rt.perl.org/Ticket/Display.html?id=125381>
+XXX List any platforms that this version of perl no longer compiles on.
-=item *
+=over 4
-Warning fatality is now ignored when rewinding the stack. This prevents
-infinite recursion when the now fatal error also causes rewinding of the stack.
-L<[perl #123398]|https://rt.perl.org/Ticket/Display.html?id=123398>
+=item XXX-some-platform
-=item *
+XXX
-A crash with C<< %::=(); J->${\"::"} >> has been fixed.
-L<[perl #125541]|https://rt.perl.org/Ticket/Display.html?id=125541>
+=back
-=item *
+=head2 Platform-Specific Notes
-Nested quantifiers such as C</.{1}??/> should cause perl to throw a fatal
-error, but were being silently accepted since Perl 5.20.0. This has been
-fixed.
-L<[perl #126253]|https://rt.perl.org/Ticket/Display.html?id=126253>
+XXX List any changes for specific platforms. This could include configuration
+and compilation changes or changes in portability/compatibility. However,
+changes within modules for platforms should generally be listed in the
+L</Modules and Pragmata> section.
-=item *
+=over 4
-Regular expression sequences such as C</(?i/> (and similarly with other
-recognized flags or combination of flags) should cause perl to throw a fatal
-error, but were being silently accepted since Perl 5.18.0. This has been
-fixed.
-L<[perl #126178]|https://rt.perl.org/Ticket/Display.html?id=126178>
+=item XXX-some-platform
-=item *
+XXX
+
+=back
-A bug in hexadecimal floating point literal support meant that high-order bits
-could be lost in cases where mantissa overflow was caused by too many trailing
-zeros in the fractional part. This has been fixed.
-L<[perl #126582]|https://rt.perl.org/Ticket/Display.html?id=126582>
+=head1 Internal Changes
+
+XXX Changes which affect the interface available to C<XS> code go here. Other
+significant internal changes for future core maintainers should be noted as
+well.
+
+[ List each change as a =item entry ]
+
+=over 4
=item *
-Another hexadecimal floating point bug, causing low-order bits to be lost in
-cases where the last hexadecimal digit of the mantissa has bits straddling the
-limit of the number of bits allowed for the mantissa, has also been fixed.
-L<[perl #126586]|https://rt.perl.org/Ticket/Display.html?id=126586>
+XXX
+
+=back
+
+=head1 Selected Bug Fixes
+
+XXX Important bug fixes in the core language are summarized here. Bug fixes in
+files in F<ext/> and F<lib/> are best summarized in L</Modules and Pragmata>.
+
+[ List each fix as a =item entry ]
+
+=over 4
=item *
-Further hexadecimal floating point bugs have been fixed: In some circumstances,
-the C<%a> format specifier could variously lose the sign of the negative zero,
-fail to display zeros after the radix point with the requested precision, or
-even lose the radix point after the leftmost hexadecimal digit completely.
+XXX
+
+=back
+
+=head1 Known Problems
+
+XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any
+tests that had to be C<TODO>ed for the release would be noted here. Unfixed
+platform specific bugs also go here.
+
+[ List each fix as a =item entry ]
+
+=over 4
=item *
-A crash caused by incomplete expressions within C<< /(?[ ])/ >> (e.g.
-C<< /(?[[0]+()+])/ >>) has been fixed.
-L<[perl #126615]|https://rt.perl.org/Ticket/Display.html?id=126615>
+XXX
=back
-=head1 Acknowledgements
+=head1 Errata From Previous Releases
-Perl 5.22.1 represents approximately 6 months of development since Perl 5.22.0
-and contains approximately 19,000 lines of changes across 130 files from 27
-authors.
+=over 4
-Excluding auto-generated files, documentation and release tools, there were
-approximately 1,700 lines of changes to 44 .pm, .t, .c and .h files.
+=item *
-Perl continues to flourish into its third decade thanks to a vibrant community
-of users and developers. The following people are known to have contributed
-the improvements that became Perl 5.22.1:
+XXX Add anything here that we forgot to add, or were mistaken about, in
+the perldelta of a previous release.
-Aaron Crane, Abigail, Andy Broad, Aristotle Pagaltzis, Chase Whitener, Chris
-'BinGOs' Williams, Craig A. Berry, Daniel Dragan, David Mitchell, Father
-Chrysostomos, Herbert Breunung, Hugo van der Sanden, James E Keenan, Jan
-Dubois, Jarkko Hietaniemi, Karen Etheridge, Karl Williamson, Lukas Mai, Matthew
-Horsfall, Peter Martini, Rafael Garcia-Suarez, Ricardo Signes, Shlomi Fish,
-Sisyphus, Steve Hay, Tony Cook, Victor Adam.
+=back
-The list above is almost certainly incomplete as it is automatically generated
-from version control history. In particular, it does not include the names of
-the (very much appreciated) contributors who reported issues to the Perl bug
-tracker.
+=head1 Obituary
+
+XXX If any significant core contributor has died, we've added a short obituary
+here.
+
+=head1 Acknowledgements
-Many of the changes included in this version originated in the CPAN modules
-included in Perl's core. We're grateful to the entire CPAN community for
-helping Perl to flourish.
+XXX Generate this with:
-For a more complete list of all of Perl's historical contributors, please see
-the F<AUTHORS> file in the Perl source distribution.
+ perl Porting/acknowledgements.pl v5.22.1..HEAD
=head1 Reporting Bugs
diff --git vms/descrip_mms.template vms/descrip_mms.template
index 9c0cb06..8b04f67 100644
--- vms/descrip_mms.template
+++ vms/descrip_mms.template
@@ -307,7 +307,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5)
extra.pods : miniperl
@ @extra_pods.com
-PERLDELTA_CURRENT = [.pod]perl5221delta.pod
+PERLDELTA_CURRENT = [.pod]perl5222delta.pod
$(PERLDELTA_CURRENT) : [.pod]perldelta.pod
Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT)
diff --git win32/Makefile win32/Makefile
index 7606104..7b36810 100644
--- win32/Makefile
+++ win32/Makefile
@@ -1176,7 +1176,7 @@ utils: $(PERLEXE) ..\utils\Makefile
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perldelta.pod ..\pod\perl5221delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5222delta.pod
cd ..\win32
$(PERLEXE) $(PL2BAT) $(UTILS)
$(MINIPERL) -I..\lib ..\autodoc.pl ..
@@ -1272,7 +1272,7 @@ distclean: realclean
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-cd $(PODDIR) && del /f *.html *.bat roffitall \
- perl5221delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5222delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
diff --git win32/makefile.mk win32/makefile.mk
index f4d7d17..a628c4c 100644
--- win32/makefile.mk
+++ win32/makefile.mk
@@ -1468,7 +1468,7 @@ utils: $(PERLEXE) ..\utils\Makefile
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perldelta.pod ..\pod\perl5221delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5222delta.pod
$(PERLEXE) $(PL2BAT) $(UTILS)
$(MINIPERL) -I..\lib ..\autodoc.pl ..
$(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q ..
@@ -1563,7 +1563,7 @@ distclean: realclean
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-cd $(PODDIR) && del /f *.html *.bat roffitall \
- perl5221delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5222delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
diff --git win32/pod.mak win32/pod.mak
index 7e081d6..cef5d1e 100644
--- win32/pod.mak
+++ win32/pod.mak
@@ -42,6 +42,7 @@ POD = perl.pod \
perl5203delta.pod \
perl5220delta.pod \
perl5221delta.pod \
+ perl5222delta.pod \
perl561delta.pod \
perl56delta.pod \
perl581delta.pod \
@@ -178,6 +179,7 @@ MAN = perl.man \
perl5203delta.man \
perl5220delta.man \
perl5221delta.man \
+ perl5222delta.man \
perl561delta.man \
perl56delta.man \
perl581delta.man \
@@ -314,6 +316,7 @@ HTML = perl.html \
perl5203delta.html \
perl5220delta.html \
perl5221delta.html \
+ perl5222delta.html \
perl561delta.html \
perl56delta.html \
perl581delta.html \
@@ -450,6 +453,7 @@ TEX = perl.tex \
perl5203delta.tex \
perl5220delta.tex \
perl5221delta.tex \
+ perl5222delta.tex \
perl561delta.tex \
perl56delta.tex \
perl581delta.tex \
--
2.7.2
From 796b9b6266671fdab40a84d7a8bcbd43106b160b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 15 Dec 2015 10:56:54 +1100
Subject: [PATCH 3/9] ensure File::Spec::canonpath() preserves taint
Previously the unix specific XS implementation of canonpath() would
return an untainted path when supplied a tainted path.
For the empty string case, newSVpvs() already sets taint as needed on
its result.
This issue was assigned CVE-2015-8607. [perl #126862]
---
dist/PathTools/Cwd.xs | 1 +
dist/PathTools/t/taint.t | 19 ++++++++++++++++++-
2 files changed, 19 insertions(+), 1 deletion(-)
diff --git dist/PathTools/Cwd.xs dist/PathTools/Cwd.xs
index 9d4dcf0..3d018dc 100644
--- dist/PathTools/Cwd.xs
+++ dist/PathTools/Cwd.xs
@@ -535,6 +535,7 @@ THX_unix_canonpath(pTHX_ SV *path)
*o = 0;
SvPOK_on(retval);
SvCUR_set(retval, o - SvPVX(retval));
+ SvTAINT(retval);
return retval;
}
diff --git dist/PathTools/t/taint.t dist/PathTools/t/taint.t
index 309b3e5..48f8c5b 100644
--- dist/PathTools/t/taint.t
+++ dist/PathTools/t/taint.t
@@ -12,7 +12,7 @@ use Test::More;
BEGIN {
plan(
${^TAINT}
- ? (tests => 17)
+ ? (tests => 21)
: (skip_all => "A perl without taint support")
);
}
@@ -34,3 +34,20 @@ foreach my $func (@Functions) {
# Previous versions of Cwd tainted $^O
is !tainted($^O), 1, "\$^O should not be tainted";
+
+{
+ # [perl #126862] canonpath() loses taint
+ my $tainted = substr($ENV{PATH}, 0, 0);
+ # yes, getcwd()'s result should be tainted, and is tested above
+ # but be sure
+ ok tainted(File::Spec->canonpath($tainted . Cwd::getcwd)),
+ "canonpath() keeps taint on non-empty string";
+ ok tainted(File::Spec->canonpath($tainted)),
+ "canonpath() keeps taint on empty string";
+
+ (Cwd::getcwd() =~ /^(.*)/);
+ my $untainted = $1;
+ ok !tainted($untainted), "make sure our untainted value is untainted";
+ ok !tainted(File::Spec->canonpath($untainted)),
+ "canonpath() doesn't add taint to untainted string";
+}
--
2.7.2
From 50f327763faf7b3c01890c40ba53be8d47972899 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@cpan.org>
Date: Mon, 28 Dec 2015 09:58:00 -0500
Subject: [PATCH 4/9] bump version of PathTools for taint issue
---
dist/PathTools/Cwd.pm | 2 +-
dist/PathTools/lib/File/Spec.pm | 2 +-
dist/PathTools/lib/File/Spec/Cygwin.pm | 2 +-
dist/PathTools/lib/File/Spec/Epoc.pm | 2 +-
dist/PathTools/lib/File/Spec/Functions.pm | 2 +-
dist/PathTools/lib/File/Spec/Mac.pm | 2 +-
dist/PathTools/lib/File/Spec/OS2.pm | 2 +-
dist/PathTools/lib/File/Spec/Unix.pm | 2 +-
dist/PathTools/lib/File/Spec/VMS.pm | 2 +-
dist/PathTools/lib/File/Spec/Win32.pm | 2 +-
10 files changed, 10 insertions(+), 10 deletions(-)
diff --git dist/PathTools/Cwd.pm dist/PathTools/Cwd.pm
index 49cc4c1..b4e80c6 100644
--- dist/PathTools/Cwd.pm
+++ dist/PathTools/Cwd.pm
@@ -3,7 +3,7 @@ use strict;
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.56';
+$VERSION = '3.56_01';
my $xs_version = $VERSION;
$VERSION =~ tr/_//;
diff --git dist/PathTools/lib/File/Spec.pm dist/PathTools/lib/File/Spec.pm
index 8c77c98..584a1d0 100644
--- dist/PathTools/lib/File/Spec.pm
+++ dist/PathTools/lib/File/Spec.pm
@@ -3,7 +3,7 @@ package File::Spec;
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
my %module = (MacOS => 'Mac',
diff --git dist/PathTools/lib/File/Spec/Cygwin.pm dist/PathTools/lib/File/Spec/Cygwin.pm
index 1b77e6a..e4d55e1 100644
--- dist/PathTools/lib/File/Spec/Cygwin.pm
+++ dist/PathTools/lib/File/Spec/Cygwin.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
@ISA = qw(File::Spec::Unix);
diff --git dist/PathTools/lib/File/Spec/Epoc.pm dist/PathTools/lib/File/Spec/Epoc.pm
index 7bc3867..d9f2126 100644
--- dist/PathTools/lib/File/Spec/Epoc.pm
+++ dist/PathTools/lib/File/Spec/Epoc.pm
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
require File::Spec::Unix;
diff --git dist/PathTools/lib/File/Spec/Functions.pm dist/PathTools/lib/File/Spec/Functions.pm
index 8eafe24..f34966b 100644
--- dist/PathTools/lib/File/Spec/Functions.pm
+++ dist/PathTools/lib/File/Spec/Functions.pm
@@ -5,7 +5,7 @@ use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
require Exporter;
diff --git dist/PathTools/lib/File/Spec/Mac.pm dist/PathTools/lib/File/Spec/Mac.pm
index 02cae14..20e8374 100644
--- dist/PathTools/lib/File/Spec/Mac.pm
+++ dist/PathTools/lib/File/Spec/Mac.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
@ISA = qw(File::Spec::Unix);
diff --git dist/PathTools/lib/File/Spec/OS2.pm dist/PathTools/lib/File/Spec/OS2.pm
index fb8f101..727032f 100644
--- dist/PathTools/lib/File/Spec/OS2.pm
+++ dist/PathTools/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
@ISA = qw(File::Spec::Unix);
diff --git dist/PathTools/lib/File/Spec/Unix.pm dist/PathTools/lib/File/Spec/Unix.pm
index f76b29e..3525f16 100644
--- dist/PathTools/lib/File/Spec/Unix.pm
+++ dist/PathTools/lib/File/Spec/Unix.pm
@@ -3,7 +3,7 @@ package File::Spec::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '3.56';
+$VERSION = '3.56_01';
my $xs_version = $VERSION;
$VERSION =~ tr/_//;
diff --git dist/PathTools/lib/File/Spec/VMS.pm dist/PathTools/lib/File/Spec/VMS.pm
index 254f524..964b26c 100644
--- dist/PathTools/lib/File/Spec/VMS.pm
+++ dist/PathTools/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
@ISA = qw(File::Spec::Unix);
diff --git dist/PathTools/lib/File/Spec/Win32.pm dist/PathTools/lib/File/Spec/Win32.pm
index 53f3854..9a36847 100644
--- dist/PathTools/lib/File/Spec/Win32.pm
+++ dist/PathTools/lib/File/Spec/Win32.pm
@@ -5,7 +5,7 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.56';
+$VERSION = '3.56_01';
$VERSION =~ tr/_//;
@ISA = qw(File::Spec::Unix);
--
2.7.2
From 9653bc8fae7a2016b17330a621b18a8f8eeeada4 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 16 Dec 2015 11:13:30 +1100
Subject: [PATCH 5/9] avoid invalid memory access in MapPath[AW]
This issue was assigned CVE-2015-8608. [perl #126755]
---
MANIFEST | 1 +
ext/XS-APItest/APItest.xs | 9 +++++++++
ext/XS-APItest/t/win32.t | 39 +++++++++++++++++++++++++++++++++++++++
ext/XS-APItest/typemap | 12 ++++++++++++
win32/vdir.h | 23 ++++++++++++++++-------
5 files changed, 77 insertions(+), 7 deletions(-)
create mode 100644 ext/XS-APItest/t/win32.t
diff --git MANIFEST MANIFEST
index e04fbb2..ddad02b 100644
--- MANIFEST
+++ MANIFEST
@@ -3965,6 +3965,7 @@ ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed}
ext/XS-APItest/t/utf8.t Tests for code in utf8.c
ext/XS-APItest/t/weaken.t XS::APItest: tests for sv_rvweaken() and sv_get_backrefs()
ext/XS-APItest/t/whichsig.t XS::APItest: tests for whichsig() and variants
+ext/XS-APItest/t/win32.t Test Win32 specific APIs
ext/XS-APItest/t/xs_special_subs_require.t for require too
ext/XS-APItest/t/xs_special_subs.t Test that XS BEGIN/CHECK/INIT/END work
ext/XS-APItest/t/xsub_h.t Tests for XSUB.h
diff --git ext/XS-APItest/APItest.xs ext/XS-APItest/APItest.xs
index c78dc7b..5cc63c8 100644
--- ext/XS-APItest/APItest.xs
+++ ext/XS-APItest/APItest.xs
@@ -5067,3 +5067,12 @@ has_backrefs(SV *sv)
OUTPUT:
RETVAL
+#if defined(WIN32) && defined(PERL_IMPLICIT_SYS)
+
+const char *
+PerlDir_mapA(const char *path)
+
+const WCHAR *
+PerlDir_mapW(const WCHAR *wpath)
+
+#endif
diff --git ext/XS-APItest/t/win32.t ext/XS-APItest/t/win32.t
new file mode 100644
index 0000000..a8905c2
--- /dev/null
+++ ext/XS-APItest/t/win32.t
@@ -0,0 +1,39 @@
+#!perl -w
+use strict;
+use Test::More;
+use XS::APItest;
+use Config;
+
+plan skip_all => "Tests only apply on MSWin32"
+ unless $^O eq "MSWin32";
+
+SKIP:
+{
+ # [perl #126755] previous the bad drive tests would crash
+ $Config{ccflags} =~ /(?:\A|\s)-DPERL_IMPLICIT_SYS\b/
+ or skip "need implicit_sys for this test", 1;
+ eval "use Encode; 1"
+ or skip "Can't load Encode", 1;
+ for my $letter ("A" .. "Z", "a" .. "z") {
+ my $good_drive = $letter . ":";
+ my $result = PerlDir_mapA($good_drive);
+ like($result, qr/^$letter:\\/i, "check good drive $letter");
+
+ my $wgood_drive = encode("UTF-16LE", $good_drive . "\0");
+ $result = PerlDir_mapW($wgood_drive);
+ like(decode("UTF16-LE", $result), qr/^$letter:\\/i,
+ "check a good drive (wide)");
+ }
+ for my $bad ('@', '[', '!', '~', '`', '{') {
+ my $bad_drive = "$bad:";
+ my $result = PerlDir_mapA($bad_drive);
+ is($result, $bad_drive, "check bad drive $bad:");
+
+ my $wbad_drive = encode("UTF-16LE", $bad_drive . "\0");
+ $result = PerlDir_mapW($wbad_drive);
+ is(decode("UTF16-LE", $result), "$bad_drive\0",
+ "check bad drive $bad: (wide)");
+ }
+}
+
+done_testing();
diff --git ext/XS-APItest/typemap ext/XS-APItest/typemap
index 035f882..ed86a37 100644
--- ext/XS-APItest/typemap
+++ ext/XS-APItest/typemap
@@ -1 +1,13 @@
XS::APItest::PtrTable T_PTROBJ
+
+const WCHAR * WPV
+
+INPUT
+
+WPV
+ $var = ($type)SvPV_nolen($arg);
+
+OUTPUT
+
+WPV
+ sv_setpvn($arg, (const char *)($var), sizeof(WCHAR) * (1+wcslen($var)));
diff --git win32/vdir.h win32/vdir.h
index 42c306b..b5c6bc6 100644
--- win32/vdir.h
+++ win32/vdir.h
@@ -15,6 +15,7 @@
* and one additional slot for a UNC name
*/
const int driveCount = ('Z'-'A')+1+1;
+const int driveLetterCount = ('Z'-'A')+1;
class VDir
{
@@ -383,6 +384,7 @@ char *VDir::MapPathA(const char *pInName)
* possiblities -- relative path or absolute path with or without drive letter
* OR UNC name
*/
+ int driveIndex;
char szBuffer[(MAX_PATH+1)*2];
char szlBuf[MAX_PATH+1];
int length = strlen(pInName);
@@ -402,15 +404,18 @@ char *VDir::MapPathA(const char *pInName)
}
/* strlen(pInName) is now <= MAX_PATH */
- if (pInName[1] == ':') {
+ if (length > 1 && pInName[1] == ':') {
/* has drive letter */
- if (IsPathSep(pInName[2])) {
+ if (length > 2 && IsPathSep(pInName[2])) {
/* absolute with drive letter */
DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
}
else {
/* relative path with drive letter */
- strcpy(szBuffer, GetDirA(DriveIndex(*pInName)));
+ driveIndex = DriveIndex(*pInName);
+ if (driveIndex < 0 || driveIndex >= driveLetterCount)
+ return (char *)pInName;
+ strcpy(szBuffer, GetDirA(driveIndex));
strcat(szBuffer, &pInName[2]);
if(strlen(szBuffer) > MAX_PATH)
szBuffer[MAX_PATH] = '\0';
@@ -420,7 +425,7 @@ char *VDir::MapPathA(const char *pInName)
}
else {
/* no drive letter */
- if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+ if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
/* UNC name */
DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA);
}
@@ -611,6 +616,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName)
* possiblities -- relative path or absolute path with or without drive letter
* OR UNC name
*/
+ int driveIndex;
WCHAR szBuffer[(MAX_PATH+1)*2];
WCHAR szlBuf[MAX_PATH+1];
int length = wcslen(pInName);
@@ -630,7 +636,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName)
}
/* strlen(pInName) is now <= MAX_PATH */
- if (pInName[1] == ':') {
+ if (length > 1 && pInName[1] == ':') {
/* has drive letter */
if (IsPathSep(pInName[2])) {
/* absolute with drive letter */
@@ -638,7 +644,10 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName)
}
else {
/* relative path with drive letter */
- wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName)));
+ driveIndex = DriveIndex(*pInName);
+ if (driveIndex < 0 || driveIndex >= driveLetterCount)
+ return (WCHAR *)pInName;
+ wcscpy(szBuffer, GetDirW(driveIndex));
wcscat(szBuffer, &pInName[2]);
if(wcslen(szBuffer) > MAX_PATH)
szBuffer[MAX_PATH] = '\0';
@@ -648,7 +657,7 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName)
}
else {
/* no drive letter */
- if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
+ if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) {
/* UNC name */
DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW);
}
--
2.7.2
From cab5bf1fae111cec4e14245c41b8578e015b9748 Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@cpan.org>
Date: Mon, 28 Dec 2015 10:09:13 -0500
Subject: [PATCH 6/9] bump version of XS::APItest
---
ext/XS-APItest/APItest.pm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git ext/XS-APItest/APItest.pm ext/XS-APItest/APItest.pm
index 5e5c311..c4f38ca 100644
--- ext/XS-APItest/APItest.pm
+++ ext/XS-APItest/APItest.pm
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Carp;
-our $VERSION = '0.72';
+our $VERSION = '0.72_01';
require XSLoader;
--
2.7.2
From 0ba44c6301b83c358a9289cfe8c7bfc9cb38130d Mon Sep 17 00:00:00 2001
From: Ricardo Signes <rjbs@cpan.org>
Date: Mon, 11 Jan 2016 09:21:39 -0500
Subject: [PATCH 7/9] perldelta: two CVE notices
---
pod/perldelta.pod | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git pod/perldelta.pod pod/perldelta.pod
index 8d9b771..1d7369a 100644
--- pod/perldelta.pod
+++ pod/perldelta.pod
@@ -29,11 +29,15 @@ here, but most should go in the L</Performance Enhancements> section.
=head1 Security
-XXX Any security-related notices go here. In particular, any security
-vulnerabilities closed should be noted here rather than in the
-L</Selected Bug Fixes> section.
+=head2 fix out of boundary access in Win32 path handling
-[ List each security issue as a =head2 entry ]
+This is CVE-2015-8608. For more information see
+L<[perl #126755]|https://rt.perl.org/Ticket/Display.html?id=126755>
+
+=head2 fix loss of taint in canonpath
+
+This is CVE-2015-8607. For more information see
+L<[perl #126862]|https://rt.perl.org/Ticket/Display.html?id=126862>
=head1 Incompatible Changes
--
2.7.2
From 58eaa1131a38c16ee4a66d0bc36288cfde1a39bf Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 27 Jan 2016 11:52:15 +1100
Subject: [PATCH 8/9] remove duplicate environment variables from environ
If we see duplicate environment variables while iterating over
environ[]:
a) make sure we use the same value in %ENV that getenv() returns.
Previously on a duplicate, %ENV would have the last entry for the name
from environ[], but a typical getenv() would return the first entry.
Rather than assuming all getenv() implementations return the first entry
explicitly call getenv() to ensure they agree.
b) remove duplicate entries from environ
Previously if there was a duplicate definition for a name in environ[]
setting that name in %ENV could result in an unsafe value being passed
to a child process, so ensure environ[] has no duplicates.
---
perl.c | 51 +++++++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 49 insertions(+), 2 deletions(-)
diff --git perl.c perl.c
index 16a6ca4..8ef7474 100644
--- perl.c
+++ perl.c
@@ -4298,23 +4298,70 @@ S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env)
}
if (env) {
char *s, *old_var;
+ STRLEN nlen;
SV *sv;
+ HV *dups = newHV();
+
for (; *env; env++) {
old_var = *env;
if (!(s = strchr(old_var,'=')) || s == old_var)
continue;
+ nlen = s - old_var;
#if defined(MSDOS) && !defined(DJGPP)
*s = '\0';
(void)strupr(old_var);
*s = '=';
#endif
- sv = newSVpv(s+1, 0);
- (void)hv_store(hv, old_var, s - old_var, sv, 0);
+ if (hv_exists(hv, old_var, nlen)) {
+ const char *name = savepvn(old_var, nlen);
+
+ /* make sure we use the same value as getenv(), otherwise code that
+ uses getenv() (like setlocale()) might see a different value to %ENV
+ */
+ sv = newSVpv(PerlEnv_getenv(name), 0);
+
+ /* keep a count of the dups of this name so we can de-dup environ later */
+ if (hv_exists(dups, name, nlen))
+ ++SvIVX(*hv_fetch(dups, name, nlen, 0));
+ else
+ (void)hv_store(dups, name, nlen, newSViv(1), 0);
+
+ Safefree(name);
+ }
+ else {
+ sv = newSVpv(s+1, 0);
+ }
+ (void)hv_store(hv, old_var, nlen, sv, 0);
if (env_is_not_environ)
mg_set(sv);
}
+ if (HvKEYS(dups)) {
+ /* environ has some duplicate definitions, remove them */
+ HE *entry;
+ hv_iterinit(dups);
+ while ((entry = hv_iternext_flags(dups, 0))) {
+ STRLEN nlen;
+ const char *name = HePV(entry, nlen);
+ IV count = SvIV(HeVAL(entry));
+ IV i;
+ SV **valp = hv_fetch(hv, name, nlen, 0);
+
+ assert(valp);
+
+ /* try to remove any duplicate names, depending on the
+ * implementation used in my_setenv() the iteration might
+ * not be necessary, but let's be safe.
+ */
+ for (i = 0; i < count; ++i)
+ my_setenv(name, 0);
+
+ /* and set it back to the value we set $ENV{name} to */
+ my_setenv(name, SvPV_nolen(*valp));
+ }
+ }
+ SvREFCNT_dec_NN(dups);
}
#endif /* USE_ENVIRON_ARRAY */
#endif /* !PERL_MICRO */
--
2.7.2
From 98c63ea9871660ac4a318a412c42adcba6829377 Mon Sep 17 00:00:00 2001
From: "Craig A. Berry" <craig.a.berry@gmail.com>
Date: Sat, 13 Feb 2016 09:12:01 -0500
Subject: [PATCH 9/9] VMS patch for duplicate env entries
---
vms/vms.c | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git vms/vms.c vms/vms.c
index 953d8b8..b6c6d12 100644
--- vms/vms.c
+++ vms/vms.c
@@ -1337,7 +1337,9 @@ prime_env_iter(void)
if (!str$case_blind_compare(env_tables[i],&crtlenv)) {
char *start;
int j;
- for (j = 0; environ[j]; j++) {
+ /* Start at the end, so if there is a duplicate we keep the first one. */
+ for (j = 0; environ[j]; j++);
+ for (j--; j >= 0; j--) {
if (!(start = strchr(environ[j],'='))) {
if (ckWARN(WARN_INTERNAL))
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Ill-formed CRTL environ value \"%s\"\n",environ[j]);
--
2.7.2
Reference in a new issue View git blame Copy permalink