Seems like a good idea to pick up the minor update to perl.
The full patch is here, but most of it is documentation and tests:
http://cvs.afresh1.com/~andrew/OpenBSD-perl-5.24.2.patch.txt
I successfully built a release with this on amd64 and unfortunately
broke my other architectures trying to do a remote update without
having tested the serial consoles before I left home. Now building some
test packages so I'll find out if frozen-bubble works soon.
Also going to work on perl 5.26 for after the 6.2 unlock.
Planning to do a single commit for it, unless someone really wants all
the churn of getting stock 5.24.2 in then adding our patches.
OK?
Inline are the three actual changes, as documented in perldelta
https://metacpan.org/pod/release/SHAY/perl-5.24.2/pod/perldelta.pod
The amazingly poorly named "wip" commit that actually is the final
version of the base.pm patch that we had mostly already applied.
https://perl5.git.perl.org/perl.git/commitdiff/1afa2890005f3acdb5794bc9ec34dfd0a7e54c28
Then a fix for perl bug #129038, "Crash with s///l"
https://rt.perl.org/Public/Bug/Display.html?id=129038
https://perl5.git.perl.org/perl.git/commit/93e39480947573cb85e287907a745faf061002f6
And "Fix checks for tainted dir in $ENV{PATH}"
https://perl5.git.perl.org/perl.git/commit/1addf2f85380133ce4aa5f2f1d35bac377e0d90a
Handily, after the previous update, the set list change is simple:
Index: distrib/sets/lists/base/mi
===================================================================
RCS file: /cvs/src/distrib/sets/lists/base/mi,v
retrieving revision 1.850
diff -u -p -r1.850 mi
--- distrib/sets/lists/base/mi 11 Aug 2017 06:16:53 -0000 1.850
+++ distrib/sets/lists/base/mi 11 Aug 2017 22:22:42 -0000
@@ -639,7 +642,7 @@
./usr/lib/libpanel.so.6.0
./usr/lib/libpanelw.so.6.0
./usr/lib/libpcap.so.8.3
-./usr/lib/libperl.so.18.0
+./usr/lib/libperl.so.18.1
./usr/lib/libpthread.so.23.0
./usr/lib/libradius.so.1.0
./usr/lib/libreadline.so.4.0
@@ -1469,8 +1472,10 @@
./usr/libdata/perl5/pod/perl5220delta.pod
./usr/libdata/perl5/pod/perl5221delta.pod
./usr/libdata/perl5/pod/perl5222delta.pod
+./usr/libdata/perl5/pod/perl5223delta.pod
./usr/libdata/perl5/pod/perl5240delta.pod
./usr/libdata/perl5/pod/perl5241delta.pod
+./usr/libdata/perl5/pod/perl5242delta.pod
./usr/libdata/perl5/pod/perl561delta.pod
./usr/libdata/perl5/pod/perl56delta.pod
./usr/libdata/perl5/pod/perl581delta.pod
# 1afa2890005f3acdb5794bc9ec34dfd0a7e54c28
Index: gnu/usr.bin/perl/dist/base/lib/base.pm
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/dist/base/lib/base.pm,v
retrieving revision 1.4
diff -u -p -r1.4 base.pm
--- gnu/usr.bin/perl/dist/base/lib/base.pm 5 Feb 2017 00:33:40 -0000
1.4
+++ gnu/usr.bin/perl/dist/base/lib/base.pm 11 Aug 2017 22:39:16 -0000
@@ -7,10 +7,9 @@ $VERSION = '2.23_01';
$VERSION =~ tr/_//d;
# simplest way to avoid indexing of the package: no package statement
-sub base::__inc_scope_guard::DESTROY {
- my $noop = $_[0][0];
- ref $_ and $_ == $noop and $_ = '.' for @INC;
-}
+sub base::__inc::unhook { @INC = grep !(ref eq 'CODE' && $_ == $_[0]), @INC }
+# instance is blessed array of coderefs to be removed from @INC at scope exit
+sub base::__inc::scope_guard::DESTROY { base::__inc::unhook $_ for @{$_[0]} }
# constant.pm is slow
sub SUCCESS () { 1 }
@@ -103,11 +102,53 @@ sub import {
{
local $SIG{__DIE__};
my $fn = _module_to_filename($base);
- my $dotty = $INC[-1] eq '.' && ( $INC[-1] = sub {()} );
+ my $dot_hidden;
eval {
- my $redotty = $dotty && bless [ $dotty ],
'base::__inc_scope_guard';
+ my $guard;
+ if ($INC[-1] eq '.' && %{"$base\::"}) {
+ # So: the package already exists => this an
optional load
+ # And: there is a dot at the end of @INC => we
want to hide it
+ # However: we only want to hide it during our
*own* require()
+ # (i.e. without affecting nested require()s).
+ # So we add a hook to @INC whose job is to hide
the dot, but which
+ # first checks checks the callstack depth, because
within nested
+ # require()s the callstack is deeper.
+ # Since CORE::GLOBAL::require makes it unknowable
in advance what
+ # the exact relevant callstack depth will be, we
have to record it
+ # inside a hook. So we put another hook just for
that at the front
+ # of @INC, where it's guaranteed to run --
immediately.
+ # The dot-hiding hook does its job by sitting
directly in front of
+ # the dot and removing itself from @INC when
reached. This causes
+ # the dot to move up one index in @INC, causing
the loop inside
+ # pp_require() to skip it.
+ # Loaded coded may disturb this precise
arrangement, but that's OK
+ # because the hook is inert by that time. It is
only active during
+ # the top-level require(), when @INC is in our
control. The only
+ # possible gotcha is if other hooks already in
@INC modify @INC in
+ # some way during that initial require().
+ # Note that this jiggery hookery works just fine
recursively: if
+ # a module loaded via base.pm uses base.pm itself,
there will be
+ # one pair of hooks in @INC per base::import call
frame, but the
+ # pairs from different nestings do not interfere
with each other.
+ my $lvl;
+ unshift @INC, sub { return if defined $lvl;
1 while defined caller ++$lvl; () };
+ splice @INC, -1, 0, sub { return if defined
caller $lvl; ++$dot_hidden, &base::__inc::unhook; () };
+ $guard = bless [ @INC[0,-2] ],
'base::__inc::scope_guard';
+ }
require $fn
};
+ if ($dot_hidden && (my @fn = grep -e && !( -d _ || -b _ ),
$fn.'c', $fn)) {
+ require Carp;
+ Carp::croak(<<ERROR);
+Base class package "$base" is not empty but "$fn[0]" exists in the current
directory.
+ To help avoid security issues, base.pm now refuses to load optional
modules
+ from the current working directory when it is the last entry in \@INC.
+ If your software worked on previous versions of Perl, the best solution
+ is to use FindBin to detect the path properly and to add that path to
+ \@INC. As a last resort, you can re-enable looking in the current working
+ directory by adding "use lib '.'" to your code.
+ERROR
+ }
# Only ignore "Can't locate" errors from our eval require.
# Other fatal errors (syntax etc) must be reported.
#
@@ -120,26 +161,12 @@ sub import {
|| $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*>
(?:line|chunk) [0-9]+)?\.\n\z/;
unless (%{"$base\::"}) {
require Carp;
- my @inc = $dotty ? @INC[0..$#INC-1] : @INC;
local $" = " ";
- my $e = <<ERROR;
+ Carp::croak(<<ERROR);
Base class package "$base" is empty.
(Perhaps you need to 'use' the module which defines that package first,
- or make that module available in \@INC (\@INC contains: @inc).
+ or make that module available in \@INC (\@INC contains: @INC).
ERROR
- if ($dotty && -e $fn) {
- $e .= <<ERROS;
- The file $fn does exist in the current directory. But note
- that base.pm, when loading a module, now ignores the current working
- directory if it is the last entry in \@INC. If your software worked on
- previous versions of Perl, the best solution is to use FindBin to
- detect the path properly and to add that path to \@INC. As a last
- resort, you can re-enable looking in the current working directory by
- adding "use lib '.'" to your code.
-ERROS
- }
- $e =~ s/\n\z/)\n/;
- Carp::croak($e);
}
$sigdie = $SIG{__DIE__} || undef;
}
# 93e39480947573cb85e287907a745faf061002f6
Index: gnu/usr.bin/perl/regexec.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/regexec.c,v
retrieving revision 1.21
diff -u -p -r1.21 regexec.c
--- gnu/usr.bin/perl/regexec.c 5 Feb 2017 00:31:53 -0000 1.21
+++ gnu/usr.bin/perl/regexec.c 11 Aug 2017 22:39:14 -0000
@@ -6191,23 +6191,26 @@ S_regmatch(pTHX_ regmatch_info *reginfo,
if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan), (U8)
nextchr)))) {
sayNO;
}
+
+ locinput++;
+ break;
}
- else if (UTF8_IS_DOWNGRADEABLE_START(nextchr)) {
- if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan),
-
EIGHT_BIT_UTF8_TO_NATIVE(nextchr,
- *(locinput + 1))))))
- {
- sayNO;
- }
- }
- else { /* Here, must be an above Latin-1 code point */
+
+ if (! UTF8_IS_DOWNGRADEABLE_START(nextchr)) { /* An above
Latin-1 code point */
_CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput,
reginfo->strend);
goto utf8_posix_above_latin1;
}
- /* Here, must be utf8 */
- locinput += UTF8SKIP(locinput);
- break;
+ /* Here is a UTF-8 variant code point below 256 and the target is
+ * UTF-8 */
+ if (! (to_complement ^ cBOOL(isFOO_lc(FLAGS(scan),
+ EIGHT_BIT_UTF8_TO_NATIVE(nextchr,
+ *(locinput + 1))))))
+ {
+ sayNO;
+ }
+
+ goto increment_locinput;
case NPOSIXD: /* \W or [:^punct:] etc. under /d */
to_complement = 1;
# 1addf2f85380133ce4aa5f2f1d35bac377e0d90a
Index: gnu/usr.bin/perl/embed.fnc
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/embed.fnc,v
retrieving revision 1.3
diff -u -p -r1.3 embed.fnc
--- gnu/usr.bin/perl/embed.fnc 5 Feb 2017 00:31:52 -0000 1.3
+++ gnu/usr.bin/perl/embed.fnc 11 Aug 2017 22:39:13 -0000
@@ -344,6 +344,10 @@ Ap |I32 |debstackptrs
pR |SV * |defelem_target |NN SV *sv|NULLOK MAGIC *mg
Anp |char* |delimcpy |NN char* to|NN const char* toend|NN const
char* from \
|NN const char* fromend|int delim|NN I32* retlen
+np |char* |delimcpy_no_escape|NN char* to|NN const char* toend \
+ |NN const char* from \
+ |NN const char* fromend|int delim \
+ |NN I32* retlen
: Used in op.c, perl.c
pM |void |delete_eval_scope
Aprd |OP* |die_sv |NN SV *baseex
Index: gnu/usr.bin/perl/embed.h
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/embed.h,v
retrieving revision 1.19
diff -u -p -r1.19 embed.h
--- gnu/usr.bin/perl/embed.h 5 Feb 2017 00:31:52 -0000 1.19
+++ gnu/usr.bin/perl/embed.h 11 Aug 2017 22:39:13 -0000
@@ -1206,6 +1206,7 @@
#define deb_stack_all() Perl_deb_stack_all(aTHX)
#define defelem_target(a,b) Perl_defelem_target(aTHX_ a,b)
#define delete_eval_scope() Perl_delete_eval_scope(aTHX)
+#define delimcpy_no_escape Perl_delimcpy_no_escape
#define die_unwind(a) Perl_die_unwind(aTHX_ a)
#define do_aexec5(a,b,c,d,e) Perl_do_aexec5(aTHX_ a,b,c,d,e)
#define do_dump_pad(a,b,c,d) Perl_do_dump_pad(aTHX_ a,b,c,d)
Index: gnu/usr.bin/perl/mg.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/mg.c,v
retrieving revision 1.22
diff -u -p -r1.22 mg.c
--- gnu/usr.bin/perl/mg.c 5 Feb 2017 00:31:52 -0000 1.22
+++ gnu/usr.bin/perl/mg.c 11 Aug 2017 22:39:13 -0000
@@ -1259,7 +1259,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *m
#else
const char path_sep = ':';
#endif
- s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
+ s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf,
s, strend, path_sep, &i);
s++;
if (i >= (I32)sizeof tmpbuf /* too long -- assume the worst */
Index: gnu/usr.bin/perl/proto.h
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/proto.h,v
retrieving revision 1.19
diff -u -p -r1.19 proto.h
--- gnu/usr.bin/perl/proto.h 5 Feb 2017 00:31:53 -0000 1.19
+++ gnu/usr.bin/perl/proto.h 11 Aug 2017 22:39:13 -0000
@@ -659,6 +659,9 @@ PERL_CALLCONV void Perl_delete_eval_scop
PERL_CALLCONV char* Perl_delimcpy(char* to, const char* toend, const char*
from, const char* fromend, int delim, I32* retlen);
#define PERL_ARGS_ASSERT_DELIMCPY \
assert(to); assert(toend); assert(from); assert(fromend); assert(retlen)
+PERL_CALLCONV char* Perl_delimcpy_no_escape(char* to, const char* toend,
const char* from, const char* fromend, int delim, I32* retlen);
+#define PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE \
+ assert(to); assert(toend); assert(from); assert(fromend); assert(retlen)
PERL_CALLCONV void Perl_despatch_signals(pTHX);
PERL_CALLCONV_NO_RET OP* Perl_die(pTHX_ const char* pat, ...)
__attribute__noreturn__
Index: gnu/usr.bin/perl/util.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/util.c,v
retrieving revision 1.26
diff -u -p -r1.26 util.c
--- gnu/usr.bin/perl/util.c 5 Feb 2017 00:33:38 -0000 1.26
+++ gnu/usr.bin/perl/util.c 11 Aug 2017 22:39:14 -0000
@@ -524,15 +524,17 @@ Free_t Perl_mfree (Malloc_t where)
/* copy a string up to some (non-backslashed) delimiter, if any */
-char *
-Perl_delimcpy(char *to, const char *toend, const char *from, const char
*fromend, int delim, I32 *retlen)
+static char *
+S_delimcpy(char *to, const char *toend, const char *from,
+ const char *fromend, int delim, I32 *retlen,
+ const bool allow_escape)
{
I32 tolen;
PERL_ARGS_ASSERT_DELIMCPY;
for (tolen = 0; from < fromend; from++, tolen++) {
- if (*from == '\\') {
+ if (allow_escape && *from == '\\') {
if (from[1] != delim) {
if (to < toend)
*to++ = *from;
@@ -549,6 +551,23 @@ Perl_delimcpy(char *to, const char *toen
*to = '\0';
*retlen = tolen;
return (char *)from;
+}
+
+char *
+Perl_delimcpy(char *to, const char *toend, const char *from, const char
*fromend, int delim, I32 *retlen)
+{
+ PERL_ARGS_ASSERT_DELIMCPY;
+
+ return S_delimcpy(to, toend, from, fromend, delim, retlen, 1);
+}
+
+char *
+Perl_delimcpy_no_escape(char *to, const char *toend, const char *from,
+ const char *fromend, int delim, I32 *retlen)
+{
+ PERL_ARGS_ASSERT_DELIMCPY_NO_ESCAPE;
+
+ return S_delimcpy(to, toend, from, fromend, delim, retlen, 0);
}
/* return ptr to little string in big string, NULL if not found */
