rpms
/
perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Merge branch 'master' of ssh://pkgs.fedoraproject.org/perl

This commit is contained in:
Marcela Mašláňová 2011-01-26 16:19:29 +01:00
parent b2140d550d dafa5369fe
commit 832f3524dd
11 changed files with 0 additions and 3797 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
perl-5.10.0-disable_test_hosts.patch
View File

@ -1,12 +0,0 @@
diff -up perl-5.10.0/lib/Net/Config.pm.disable_test_hosts perl-5.10.0/lib/Net/Config.pm
--- perl-5.10.0/lib/Net/Config.pm.disable_test_hosts 2007-12-21 11:41:12.000000000 -0500
+++ perl-5.10.0/lib/Net/Config.pm 2007-12-21 11:41:20.000000000 -0500
@@ -29,7 +29,7 @@ eval { local $SIG{__DIE__}; require Net:
ftp_firewall => undef,
ftp_ext_passive => 1,
ftp_int_passive => 1,
- test_hosts => 1,
+ test_hosts => 0,
test_exist => 1,
);

59
perl-5.10.0-reorderINC.patch
View File

@ -1,59 +0,0 @@
diff -up perl-5.10.0/perl.c.BAD perl-5.10.0/perl.c
--- perl-5.10.0/perl.c.BAD 2009-03-09 09:55:05.000000000 -0400
+++ perl-5.10.0/perl.c 2009-03-09 10:00:41.000000000 -0400
@@ -4753,9 +4753,6 @@ S_init_perllib(pTHX)
incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE);
#endif
-#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
-#endif
#ifdef MACOS_TRADITIONAL
{
Stat_t tmpstatbuf;
@@ -4764,6 +4761,10 @@ S_init_perllib(pTHX)
if (!macperl)
macperl = "";
+
+#ifdef ARCHLIB_EXP
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+#endif
Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
@@ -4777,14 +4778,6 @@ S_init_perllib(pTHX)
if (!PL_tainting)
incpush(":", FALSE, FALSE, TRUE, FALSE);
#else
-#ifndef PRIVLIB_EXP
-# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
-#endif
-#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
-#else
- incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
-#endif
#ifdef SITEARCH_EXP
/* sitearch is always relative to sitelib on Windows for
@@ -4828,6 +4821,19 @@ S_init_perllib(pTHX)
incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE);
#endif
+#ifdef ARCHLIB_EXP
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+#endif
+
+#ifndef PRIVLIB_EXP
+# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
+#endif
+#if defined(WIN32)
+ incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
+#else
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+#endif
+
#ifdef PERL_OTHERLIBDIRS
incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE);
#endif

87
perl-5.10.1-CVE_2009_3626.patch
View File

@ -1,87 +0,0 @@
diff -up perl-5.10.1/ext/re/t/regop.t.git perl-5.10.1/ext/re/t/regop.t
--- perl-5.10.1/ext/re/t/regop.t.git 2009-12-21 19:31:07.564141841 +0100
+++ perl-5.10.1/ext/re/t/regop.t 2009-12-21 19:31:55.158142088 +0100
@@ -233,12 +233,12 @@ anchored "ABC" at 0
#Freeing REx: "(\\.COM|\\.EXE|\\.BAT|\\.CMD|\\.VBS|\\.VBE|\\.JS|\\.JSE|\\."......
%MATCHED%
floating ""$ at 3..4 (checking floating)
-1:1[1] 3:2[1] 5:2[64] 45:83[1] 47:84[1] 48:85[0]
-stclass EXACTF <.> minlen 3
-Found floating substr ""$ at offset 30...
-Does not contradict STCLASS...
-Guessed: match at offset 26
-Matching stclass EXACTF <.> against ".exe"
+#1:1[1] 3:2[1] 5:2[64] 45:83[1] 47:84[1] 48:85[0]
+#stclass EXACTF <.> minlen 3
+#Found floating substr ""$ at offset 30...
+#Does not contradict STCLASS...
+#Guessed: match at offset 26
+#Matching stclass EXACTF <.> against ".exe"
---
#Compiling REx "[q]"
#size 12 nodes Got 100 bytes for offset annotations.
@@ -258,4 +258,4 @@ Got 100 bytes for offset annotations.
Offsets: [12]
1:1[3] 3:4[0]
%MATCHED%
-Freeing REx: "[q]"
\ No newline at end of file
+Freeing REx: "[q]"
diff -up perl-5.10.1/regcomp.c.git perl-5.10.1/regcomp.c
--- perl-5.10.1/regcomp.c.git 2009-12-21 19:32:05.893141719 +0100
+++ perl-5.10.1/regcomp.c 2009-12-21 19:33:35.106141384 +0100
@@ -2820,13 +2820,16 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_
}
} else {
/*
- Currently we assume that the trie can handle unicode and ascii
- matches fold cased matches. If this proves true then the following
- define will prevent tries in this situation.
-
- #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
-*/
+ Currently we do not believe that the trie logic can
+ handle case insensitive matching properly when the
+ pattern is not unicode (thus forcing unicode semantics).
+ If/when this is fixed the following define can be swapped
+ in below to fully enable trie logic.
#define TRIE_TYPE_IS_SAFE 1
+
+*/
+#define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
+
if ( last && TRIE_TYPE_IS_SAFE ) {
make_trie( pRExC_state,
startbranch, first, cur, tail, count,
diff -up perl-5.10.1/regexec.c.git perl-5.10.1/regexec.c
--- perl-5.10.1/regexec.c.git 2009-12-21 19:33:50.570141632 +0100
+++ perl-5.10.1/regexec.c 2009-12-21 19:36:41.300142175 +0100
@@ -1006,16 +1006,15 @@ Perl_re_intuit_start(pTHX_ REGEXP * cons
#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, \
uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \
- UV uvc_unfolded = 0; \
switch (trie_type) { \
case trie_utf8_fold: \
if ( foldlen>0 ) { \
- uvc_unfolded = uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
+ uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
foldlen -= len; \
uscan += len; \
len=0; \
} else { \
- uvc_unfolded = uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
+ uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
foldlen -= UNISKIP( uvc ); \
uscan = foldbuf + UNISKIP( uvc ); \
@@ -1054,9 +1053,6 @@ uvc, charid, foldlen, foldbuf, uniflags)
charid = (U16)SvIV(*svpp); \
} \
} \
- if (!charid && trie_type == trie_utf8_fold && !UTF) { \
- charid = trie->charmap[uvc_unfolded]; \
- } \
} STMT_END
#define REXEC_FBC_EXACTISH_CHECK(CoNd) \

112
perl-add-symbols.patch
View File

@ -1,112 +0,0 @@
2009-12-02 Stepan Kasal <skasal@redhat.com>
* add the extra symbols, even though DEBUGGING is not defined
diff -ur perl-5.10.1.orig/hv.c perl-5.10.1/hv.c
--- perl-5.10.1.orig/hv.c 2009-06-10 14:36:34.000000000 +0200
+++ perl-5.10.1/hv.c 2009-12-02 15:05:07.000000000 +0100
@@ -2926,7 +2926,7 @@
=cut
*/
-#ifdef DEBUGGING
+/* #ifdef DEBUGGING */
void
Perl_hv_assert(pTHX_ HV *hv)
@@ -2991,7 +2991,7 @@
HvEITER_set(hv, eiter);
}
-#endif
+/* #endif */
/*
* Local variables:
diff -ur perl-5.10.1.orig/makedef.pl perl-5.10.1/makedef.pl
--- perl-5.10.1.orig/makedef.pl 2009-12-02 14:42:12.000000000 +0100
+++ perl-5.10.1/makedef.pl 2009-12-02 14:42:04.000000000 +0100
@@ -617,7 +617,7 @@
)];
}
-unless ($define{'DEBUGGING'}) {
+unless (1 || $define{'DEBUGGING'}) {
skip_symbols [qw(
Perl_deb_growlevel
Perl_debop
diff -ur perl-5.10.1.orig/pad.c perl-5.10.1/pad.c
--- perl-5.10.1.orig/pad.c 2009-04-22 23:43:43.000000000 +0200
+++ perl-5.10.1/pad.c 2009-12-02 14:39:21.000000000 +0100
@@ -912,7 +912,7 @@
}
-#ifdef DEBUGGING
+/* #ifdef DEBUGGING */
/*
=for apidoc pad_sv
@@ -963,7 +963,7 @@
);
PL_curpad[po] = sv;
}
-#endif
+/* #endif */
diff -ur perl-5.10.1.orig/perl.h perl-5.10.1/perl.h
--- perl-5.10.1.orig/perl.h 2009-07-06 13:18:58.000000000 +0200
+++ perl-5.10.1/perl.h 2009-12-02 15:06:44.000000000 +0100
@@ -4457,7 +4457,7 @@
EXTCONST unsigned char PL_freq[];
#endif
-#ifdef DEBUGGING
+/* #ifdef DEBUGGING */
#ifdef DOINIT
EXTCONST char* const PL_block_type[] = {
"NULL",
@@ -4473,7 +4473,7 @@
#else
EXTCONST char* PL_block_type[];
#endif
-#endif
+/* #endif */
/* These are all the compile time options that affect binary compatibility.
Other compile time options that are binary compatible are in perl.c
diff -ur perl-5.10.1.orig/perlvars.h perl-5.10.1/perlvars.h
--- perl-5.10.1.orig/perlvars.h 2009-02-12 23:58:17.000000000 +0100
+++ perl-5.10.1/perlvars.h 2009-12-02 15:10:39.000000000 +0100
@@ -112,9 +112,9 @@
PERLVARI(Gsig_trapped, int, 0)
#endif
-#ifdef DEBUGGING
+/* #ifdef DEBUGGING */
PERLVAR(Gwatch_pvx, char*)
-#endif
+/* #endif */
#ifdef PERL_GLOBAL_STRUCT
PERLVAR(Gppaddr, Perl_ppaddr_t*) /* or opcode.h */
--- perl-5.10.1/proto.h.kasal 2009-12-02 15:18:39.000000000 +0100
+++ perl-5.10.1/proto.h 2009-12-02 15:29:51.000000000 +0100
@@ -6068,13 +6068,13 @@
#define PERL_ARGS_ASSERT_PAD_CHECK_DUP \
assert(name); assert(ourstash)
-#ifdef DEBUGGING
+/* #ifdef DEBUGGING */
PERL_CALLCONV void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_PAD_SETSV \
assert(sv)
-#endif
+/* #endif */
PERL_CALLCONV void Perl_pad_block_start(pTHX_ int full);
PERL_CALLCONV void Perl_pad_tidy(pTHX_ padtidy_type type);
PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)

246
perl-much-better-swap-logic.patch
View File

@ -1,246 +0,0 @@
Backport of commit e9105d30 in blead perl.
diff -urpN perl-5.10.1.orig/embed.fnc perl-5.10.1/embed.fnc
--- perl-5.10.1.orig/embed.fnc 2009-08-15 18:36:34.000000000 +0200
+++ perl-5.10.1/embed.fnc 2009-11-26 00:12:48.000000000 +0100
@@ -1658,7 +1658,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN
#endif
ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
-Es |void |swap_match_buff|NN regexp * prog
Es |void |to_utf8_substr |NN regexp * prog
Es |void |to_byte_substr |NN regexp * prog
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \
diff -urpN perl-5.10.1.orig/embed.h perl-5.10.1/embed.h
--- perl-5.10.1.orig/embed.h 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/embed.h 2009-11-26 00:12:48.000000000 +0100
@@ -1452,7 +1452,6 @@
#if defined(PERL_CORE) || defined(PERL_EXT)
#define reghopmaybe3 S_reghopmaybe3
#define find_byclass S_find_byclass
-#define swap_match_buff S_swap_match_buff
#define to_utf8_substr S_to_utf8_substr
#define to_byte_substr S_to_byte_substr
#define reg_check_named_buff_matched S_reg_check_named_buff_matched
@@ -3783,7 +3782,6 @@
#if defined(PERL_CORE) || defined(PERL_EXT)
#define reghopmaybe3 S_reghopmaybe3
#define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e)
-#define swap_match_buff(a) S_swap_match_buff(aTHX_ a)
#define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a)
#define to_byte_substr(a) S_to_byte_substr(aTHX_ a)
#define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b)
diff -urpN perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc
--- perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc 2009-11-26 00:12:48.000000000 +0100
@@ -1677,7 +1677,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN
#endif
ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
-Es |void |swap_match_buff|NN regexp * prog
Es |void |to_utf8_substr |NN regexp * prog
Es |void |to_byte_substr |NN regexp * prog
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \
diff -urpN perl-5.10.1.orig/pod/perlreapi.pod perl-5.10.1/pod/perlreapi.pod
--- perl-5.10.1.orig/pod/perlreapi.pod 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/pod/perlreapi.pod 2009-11-26 00:12:48.000000000 +0100
@@ -598,7 +598,7 @@ engine should use something else.
=head2 C<swap>
-TODO: document
+Unused. Left in for compatibility with perl 5.10.0.
=head2 C<offs>
diff -urpN perl-5.10.1.orig/pod/perlreguts.pod perl-5.10.1/pod/perlreguts.pod
--- perl-5.10.1.orig/pod/perlreguts.pod 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/pod/perlreguts.pod 2009-11-26 00:12:48.000000000 +0100
@@ -810,13 +810,12 @@ value to other engine implementations.
=item C<swap>
-C<swap> is an extra set of startp/endp stored in a C<regexp_paren_ofs>
-struct. This is used when the last successful match was from the same pattern
-as the current pattern, so that a partial match doesn't overwrite the
-previous match's results. When this field is data filled the matching
-engine will swap buffers before every match attempt. If the match fails,
-then it swaps them back. If it's successful it leaves them. This field
-is populated on demand and is by default null.
+C<swap> formerly was an extra set of startp/endp stored in a
+C<regexp_paren_ofs> struct. This was used when the last successful match
+was from the same pattern as the current pattern, so that a partial
+match didn't overwrite the previous match's results, but it caused a
+problem with re-entrant code such as trying to build the UTF-8 swashes.
+Currently unused and left for backward compatibility with 5.10.0.
=item C<offsets>
diff -urpN perl-5.10.1.orig/proto.h perl-5.10.1/proto.h
--- perl-5.10.1.orig/proto.h 2009-08-15 18:36:34.000000000 +0200
+++ perl-5.10.1/proto.h 2009-11-26 00:12:48.000000000 +0100
@@ -5445,11 +5445,6 @@ STATIC char* S_find_byclass(pTHX_ regexp
#define PERL_ARGS_ASSERT_FIND_BYCLASS \
assert(prog); assert(c); assert(s); assert(strend)
-STATIC void S_swap_match_buff(pTHX_ regexp * prog)
- __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_SWAP_MATCH_BUFF \
- assert(prog)
-
STATIC void S_to_utf8_substr(pTHX_ regexp * prog)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_TO_UTF8_SUBSTR \
diff -urpN perl-5.10.1.orig/regcomp.c perl-5.10.1/regcomp.c
--- perl-5.10.1.orig/regcomp.c 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/regcomp.c 2009-11-26 00:12:48.000000000 +0100
@@ -9361,7 +9361,6 @@ Perl_pregfree(pTHX_ REGEXP *r)
if (r->saved_copy)
SvREFCNT_dec(r->saved_copy);
#endif
- Safefree(r->swap);
Safefree(r->offs);
Safefree(r);
}
@@ -9413,7 +9412,6 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) {
ret->saved_copy = NULL;
#endif
ret->mother_re = r;
- ret->swap = NULL;
return ret;
}
diff -urpN perl-5.10.1.orig/regexec.c perl-5.10.1/regexec.c
--- perl-5.10.1.orig/regexec.c 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/regexec.c 2009-11-26 00:12:48.000000000 +0100
@@ -1733,28 +1733,6 @@ S_find_byclass(pTHX_ regexp * prog, cons
return s;
}
-static void
-S_swap_match_buff (pTHX_ regexp *prog)
-{
- regexp_paren_pair *t;
-
- PERL_ARGS_ASSERT_SWAP_MATCH_BUFF;
-
- if (!prog->swap) {
- /* We have to be careful. If the previous successful match
- was from this regex we don't want a subsequent paritally
- successful match to clobber the old results.
- So when we detect this possibility we add a swap buffer
- to the re, and switch the buffer each match. If we fail
- we switch it back, otherwise we leave it swapped.
- */
- Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
- }
- t = prog->swap;
- prog->swap = prog->offs;
- prog->offs = t;
-}
-
/*
- regexec_flags - match a regexp against a string
@@ -1783,7 +1761,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
I32 multiline;
RXi_GET_DECL(prog,progi);
regmatch_info reginfo; /* create some info to pass to regtry etc */
- bool swap_on_fail = 0;
+ regexp_paren_pair *swap = NULL;
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_REGEXEC_FLAGS;
@@ -1861,9 +1839,16 @@ Perl_regexec_flags(pTHX_ REGEXP * const
reginfo.ganch = strbeg;
}
if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
- swap_on_fail = 1;
- swap_match_buff(prog); /* do we need a save destructor here for
- eval dies? */
+ /* We have to be careful. If the previous successful match
+ was from this regex we don't want a subsequent partially
+ successful match to clobber the old results.
+ So when we detect this possibility we add a swap buffer
+ to the re, and switch the buffer each match. If we fail
+ we switch it back, otherwise we leave it swapped.
+ */
+ swap = prog->offs;
+ /* do we need a save destructor here for eval dies? */
+ Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
}
if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
re_scream_pos_data d;
@@ -2162,6 +2147,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
goto phooey;
got_it:
+ Safefree(swap);
RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
if (PL_reg_eval_set)
@@ -2207,10 +2193,12 @@ phooey:
PL_colors[4], PL_colors[5]));
if (PL_reg_eval_set)
restore_pos(aTHX_ prog);
- if (swap_on_fail)
+ if (swap) {
/* we failed :-( roll it back */
- swap_match_buff(prog);
-
+ Safefree(prog->offs);
+ prog->offs = swap;
+ }
+
return 0;
}
diff -urpN perl-5.10.1.orig/regexp.h perl-5.10.1/regexp.h
--- perl-5.10.1.orig/regexp.h 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/regexp.h 2009-11-26 00:12:48.000000000 +0100
@@ -88,7 +88,7 @@ typedef struct regexp {
/* Data about the last/current match. These are modified during matching*/
U32 lastparen; /* last open paren matched */
U32 lastcloseparen; /* last close paren matched */
- regexp_paren_pair *swap; /* Swap copy of *offs */
+ regexp_paren_pair *swap; /* Unused: 5.10.1 and later */
regexp_paren_pair *offs; /* Array of offsets for (@-) and (@+) */
char *subbeg; /* saved or original string
diff -urpN perl-5.10.1.orig/t/op/pat.t perl-5.10.1/t/op/pat.t
--- perl-5.10.1.orig/t/op/pat.t 2009-07-27 23:37:52.000000000 +0200
+++ perl-5.10.1/t/op/pat.t 2009-11-26 00:12:48.000000000 +0100
@@ -13,7 +13,7 @@ sub run_tests;
$| = 1;
-my $EXPECTED_TESTS = 4065; # Update this when adding/deleting tests.
+my $EXPECTED_TESTS = 4066; # Update this when adding/deleting tests.
BEGIN {
chdir 't' if -d 't';
@@ -4349,6 +4349,24 @@ sub run_tests {
}
}
+ # This only works under -DEBUGGING because it relies on an assert().
+ {
+ local $BugId = '60508';
+ local $Message = "Check capture offset re-entrancy of utf8 code.";
+
+ sub fswash { $_[0] =~ s/([>X])//g; }
+
+ my $k1 = "." x 4 . ">>";
+ fswash($k1);
+
+ my $k2 = "\x{f1}\x{2022}";
+ $k2 =~ s/([\360-\362])/>/g;
+ fswash($k2);
+
+ iseq($k2, "\x{2022}", "utf8::SWASHNEW doesn't cause capture leaks");
+ }
+
+
{
local $BugId = 65372; # minimal CURLYM limited to 32767 matches
my @pat = (

83
perl-perlio-incorrect-errno.patch
View File

@ -1,83 +0,0 @@
From e57cc2468d765872b20810478b94ead3906f1912 Mon Sep 17 00:00:00 2001
From: Stepan Kasal <skasal@redhat.com>
Date: Wed, 3 Jun 2009 12:03:55 +0200
Subject: [PATCH] fix RT 39060, errno incorrectly set in perlio
---
MANIFEST | 1 +
perlio.c | 12 +++++++-----
t/io/errno.t | 26 ++++++++++++++++++++++++++
3 files changed, 34 insertions(+), 5 deletions(-)
create mode 100644 t/io/errno.t
diff --git a/MANIFEST b/MANIFEST
index b7c9341..be3be43 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3899,6 +3899,7 @@ t/io/binmode.t See if binmode() works
t/io/crlf.t See if :crlf works
t/io/crlf_through.t See if pipe passes data intact with :crlf
t/io/dup.t See if >& works right
+t/io/errno.t See if $! is correctly set
t/io/fflush.t See if auto-flush on fork/exec/system/qx works
t/io/fs.t See if directory manipulations work
t/io/inplace.t See if inplace editing works
diff --git a/perlio.c b/perlio.c
index 0a086a8..e92a32a 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1784,12 +1784,14 @@ PerlIO_has_base(PerlIO *f)
int
PerlIO_fast_gets(PerlIO *f)
{
- if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
- const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
+ if (PerlIOValid(f)) {
+ if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
- if (tab)
- return (tab->Set_ptrcnt != NULL);
- SETERRNO(EINVAL, LIB_INVARG);
+ if (tab)
+ return (tab->Set_ptrcnt != NULL);
+ SETERRNO(EINVAL, LIB_INVARG);
+ }
}
else
SETERRNO(EBADF, SS_IVCHAN);
diff --git a/t/io/errno.t b/t/io/errno.t
new file mode 100644
index 0000000..b55e3db
--- /dev/null
+++ b/t/io/errno.t
@@ -0,0 +1,26 @@
+#!./perl
+# vim: ts=4 sts=4 sw=4:
+
+# $! may not be set if EOF was reached without any error.
+# http://rt.perl.org/rt3/Ticket/Display.html?id=39060
+
+use strict;
+require './test.pl';
+
+plan( tests => 16 );
+
+my $test_prog = 'while(<>){print}; print $!';
+
+for my $perlio ('perlio', 'stdio') {
+ $ENV{PERLIO} = $perlio;
+ for my $test_in ("test\n", "test") {
+ my $test_in_esc = $test_in;
+ $test_in_esc =~ s/\n/\\n/g;
+ for my $rs_code ('', '$/=undef', '$/=\2', '$/=\1024') {
+ is( runperl( prog => "$rs_code; $test_prog",
+ stdin => $test_in, stderr => 1),
+ $test_in,
+ "Wrong errno, PERLIO=$ENV{PERLIO} stdin='$test_in_esc'");
+ }
+ }
+}
--
1.6.2

11
perl-suid-noroot.patch
View File

@ -1,11 +0,0 @@
--- perl-5.10.1/installperl.orig 2009-11-18 15:44:47.000000000 +0100
+++ perl-5.10.1/installperl 2009-11-18 15:50:32.000000000 +0100
@@ -235,7 +235,7 @@
# Do some quick sanity checks.
-if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
+# if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
$installbin || die "No installbin directory in config.sh\n";
-d $installbin || mkpath($installbin, $opts{verbose}, 0777);

1347
perl-update-ExtUtils-CBuilder.patch
View File

File diff suppressed because it is too large Load Diff

287
perl-update-File-Path.patch
View File

@ -1,287 +0,0 @@
File-Path-2.08
diff -urN perl-5.10.1.orig/lib/File/Path.pm perl-5.10.1/lib/File/Path.pm
--- perl-5.10.1.orig/lib/File/Path.pm 2009-06-27 18:14:41.000000000 +0200
+++ perl-5.10.1/lib/File/Path.pm 2009-12-01 11:43:31.000000000 +0100
@@ -17,7 +17,7 @@
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = '2.07_03';
+$VERSION = '2.08';
@ISA = qw(Exporter);
@EXPORT = qw(mkpath rmtree);
@EXPORT_OK = qw(make_path remove_tree);
@@ -81,6 +81,34 @@
$arg->{mode} = delete $arg->{mask} if exists $arg->{mask};
$arg->{mode} = 0777 unless exists $arg->{mode};
${$arg->{error}} = [] if exists $arg->{error};
+ $arg->{owner} = delete $arg->{user} if exists $arg->{user};
+ $arg->{owner} = delete $arg->{uid} if exists $arg->{uid};
+ if (exists $arg->{owner} and $arg->{owner} =~ /\D/) {
+ my $uid = (getpwnam $arg->{owner})[2];
+ if (defined $uid) {
+ $arg->{owner} = $uid;
+ }
+ else {
+ _error($arg, "unable to map $arg->{owner} to a uid, ownership not changed");
+ delete $arg->{owner};
+ }
+ }
+ if (exists $arg->{group} and $arg->{group} =~ /\D/) {
+ my $gid = (getgrnam $arg->{group})[2];
+ if (defined $gid) {
+ $arg->{group} = $gid;
+ }
+ else {
+ _error($arg, "unable to map $arg->{group} to a gid, group ownership not changed");
+ delete $arg->{group};
+ }
+ }
+ if (exists $arg->{owner} and not exists $arg->{group}) {
+ $arg->{group} = -1; # chown will leave group unchanged
+ }
+ if (exists $arg->{group} and not exists $arg->{owner}) {
+ $arg->{owner} = -1; # chown will leave owner unchanged
+ }
$paths = [@_];
}
return _mkpath($arg, $paths);
@@ -107,6 +135,12 @@
print "mkdir $path\n" if $arg->{verbose};
if (mkdir($path,$arg->{mode})) {
push(@created, $path);
+ if (exists $arg->{owner}) {
+ # NB: $arg->{group} guaranteed to be set during initialisation
+ if (!chown $arg->{owner}, $arg->{group}, $path) {
+ _error($arg, "Cannot change ownership of $path to $arg->{owner}:$arg->{group}");
+ }
+ }
}
else {
my $save_bang = $!;
@@ -422,8 +456,8 @@
=head1 VERSION
-This document describes version 2.07 of File::Path, released
-2008-11-09.
+This document describes version 2.08 of File::Path, released
+2009-10-04.
=head1 SYNOPSIS
@@ -505,6 +539,34 @@
a fatal error that will cause the program will halt, unless trapped
in an C<eval> block.
+=item owner => $owner
+
+=item user => $owner
+
+=item uid => $owner
+
+If present, will cause any created directory to be owned by C<$owner>.
+If the value is numeric, it will be interpreted as a uid, otherwise
+as username is assumed. An error will be issued if the username cannot be
+mapped to a uid, or the uid does not exist, or the process lacks the
+privileges to change ownership.
+
+Ownwership of directories that already exist will not be changed.
+
+C<user> and C<uid> are aliases of C<owner>.
+
+=item group => $group
+
+If present, will cause any created directory to be owned by the group C<$group>.
+If the value is numeric, it will be interpreted as a gid, otherwise
+as group name is assumed. An error will be issued if the group name cannot be
+mapped to a gid, or the gid does not exist, or the process lacks the
+privileges to change group ownership.
+
+Group ownwership of directories that already exist will not be changed.
+
+ make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'};
+
=back
=item mkpath( $dir )
@@ -672,6 +734,17 @@
use File::Path qw(remove_tree rmtree);
+=head3 API CHANGES
+
+The API was changed in the 2.0 branch. For a time, C<mkpath> and
+C<rmtree> tried, unsuccessfully, to deal with the two different
+calling mechanisms. This approach was considered a failure.
+
+The new semantics are now only available with C<make_path> and
+C<remove_tree>. The old semantics are only available through
+C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
+to at least 2.08 in order to avoid surprises.
+
=head3 SECURITY CONSIDERATIONS
There were race conditions 1.x implementations of File::Path's
@@ -835,6 +908,20 @@
to restore the permissions on the file to a possibly less permissive
setting. (Permissions given in octal).
+=item unable to map [owner] to a uid, ownership not changed");
+
+C<make_path> was instructed to give the ownership of created
+directories to the symbolic name [owner], but C<getpwnam> did
+not return the corresponding numeric uid. The directory will
+be created, but ownership will not be changed.
+
+=item unable to map [group] to a gid, group ownership not changed
+
+C<make_path> was instructed to give the group ownership of created
+directories to the symbolic name [group], but C<getgrnam> did
+not return the corresponding numeric gid. The directory will
+be created, but group ownership will not be changed.
+
=back
=head1 SEE ALSO
@@ -885,7 +972,7 @@
=head1 COPYRIGHT
This module is copyright (C) Charles Bailey, Tim Bunce and
-David Landgren 1995-2008. All rights reserved.
+David Landgren 1995-2009. All rights reserved.
=head1 LICENSE
diff -urN perl-5.10.1.orig/lib/File/Path.t perl-5.10.1/lib/File/Path.t
--- perl-5.10.1.orig/lib/File/Path.t 2009-06-27 18:14:41.000000000 +0200
+++ perl-5.10.1/lib/File/Path.t 2009-12-01 11:43:48.000000000 +0100
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 121;
+use Test::More tests => 129;
use Config;
BEGIN {
@@ -323,7 +323,7 @@
# test bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319
skip "Don't need Force_Writeable semantics on $^O", 4
if grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
- skip "Symlinks not available", 4 unless $Config{'d_symlink'};
+ skip "Symlinks not available", 4 unless $Config{d_symlink};
$dir = 'bug487319';
$dir2 = 'bug487319-symlink';
@created = make_path($dir, {mask => 0700});
@@ -381,7 +381,7 @@
SKIP: {
skip "extra scenarios not set up, see eg/setup-extra-tests", 14
unless -e $extra;
- skip "Symlinks not available", 14 unless $Config{'d_symlink'};
+ skip "Symlinks not available", 14 unless $Config{d_symlink};
my ($list, $err);
$dir = catdir( 'EXTRA', '1' );
@@ -434,6 +434,78 @@
}
SKIP: {
+ my $skip_count = 8; # DRY
+ skip "getpwent() not implemented on $^O", $skip_count
+ unless $Config{d_getpwent};
+ skip "getgrent() not implemented on $^O", $skip_count
+ unless $Config{d_getgrent};
+ skip 'not running as root', $skip_count
+ unless $< == 0;
+
+ my $dir_stem = $dir = catdir($tmp_base, 'owned-by');
+
+ # find the highest uid ('nobody' or similar)
+ my $max_uid = 0;
+ my $max_user = undef;
+ while (my @u = getpwent()) {
+ if ($max_uid < $u[2]) {
+ $max_uid = $u[2];
+ $max_user = $u[0];
+ }
+ }
+ skip 'getpwent() appears to be insane', $skip_count
+ unless $max_uid > 0;
+
+ # find the highest gid ('nogroup' or similar)
+ my $max_gid = 0;
+ my $max_group = undef;
+ while (my @g = getgrent()) {
+ if ($max_gid < $g[2]) {
+ $max_gid = $g[2];
+ $max_group = $g[0];
+ }
+ }
+ skip 'getgrent() appears to be insane', $skip_count
+ unless $max_gid > 0;
+
+ $dir = catdir($dir_stem, 'aaa');
+ @created = make_path($dir, {owner => $max_user});
+ is(scalar(@created), 2, "created a directory owned by $max_user...");
+ my $dir_uid = (stat $created[0])[4];
+ is($dir_uid, $max_uid, "... owned by $max_uid");
+
+ $dir = catdir($dir_stem, 'aab');
+ @created = make_path($dir, {group => $max_group});
+ is(scalar(@created), 1, "created a directory owned by group $max_group...");
+ my $dir_gid = (stat $created[0])[5];
+ is($dir_gid, $max_gid, "... owned by group $max_gid");
+
+ $dir = catdir($dir_stem, 'aac');
+ @created = make_path($dir, {user => $max_user, group => $max_group});
+ is(scalar(@created), 1, "created a directory owned by $max_user:$max_group...");
+ ($dir_uid, $dir_gid) = (stat $created[0])[4,5];
+ is($dir_uid, $max_uid, "... owned by $max_uid");
+ is($dir_gid, $max_gid, "... owned by group $max_gid");
+
+ SKIP: {
+ skip 'Test::Output not available', 1
+ unless $has_Test_Output;
+
+ # invent a user and group that don't exist
+ do { ++$max_user } while (getpwnam($max_user));
+ do { ++$max_group } while (getgrnam($max_group));
+
+ $dir = catdir($dir_stem, 'aad');
+ stderr_like(
+ sub {make_path($dir, {user => $max_user, group => $max_group})},
+ qr{\Aunable to map $max_user to a uid, ownership not changed: .* at \S+ line \d+
+unable to map $max_group to a gid, group ownership not changed: .* at \S+ line \d+\b},
+ "created a directory not owned by $max_user:$max_group..."
+ );
+ }
+}
+
+SKIP: {
skip 'Test::Output not available', 14
unless $has_Test_Output;
@@ -574,15 +646,15 @@
my $xx = $x . "x";
# setup
- ok(mkpath($xx));
- ok(chdir($xx));
+ ok(mkpath($xx), "make $xx");
+ ok(chdir($xx), "... and chdir $xx");
END {
- ok(chdir($p));
- ok(rmtree($xx));
+ ok(chdir($p), "... now chdir $p");
+ ok(rmtree($xx), "... and finally rmtree $xx");
}
# create and delete directory
my $px = catdir($p, $x);
- ok(mkpath($px));
- ok(rmtree($px), "rmtree"); # fails in File-Path-2.07
+ ok(mkpath($px), 'create and delete directory 2.07');
+ ok(rmtree($px), '.. rmtree fails in File-Path-2.07');
}

1541
perl-update-Module-Build.patch
View File

File diff suppressed because it is too large Load Diff

12
perl-update-Parse-CPAN-Meta.patch
View File

@ -1,12 +0,0 @@
diff -up perl-5.10.1/lib/Parse/CPAN/Meta.pm.old perl-5.10.1/lib/Parse/CPAN/Meta.pm
--- perl-5.10.1/lib/Parse/CPAN/Meta.pm.old 2009-06-10 18:37:40.000000000 +0200
+++ perl-5.10.1/lib/Parse/CPAN/Meta.pm 2009-12-22 13:08:39.089184165 +0100
@@ -15,7 +15,7 @@ BEGIN {
# Class structure
require 5.004;
require Exporter;
- $Parse::CPAN::Meta::VERSION = '1.39';
+ $Parse::CPAN::Meta::VERSION = '1.40';
@Parse::CPAN::Meta::ISA = qw{ Exporter };
@Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
}